diff --git a/.Rbuildignore b/.Rbuildignore index 91114bf2..1f36c3d3 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,2 +1,20 @@ ^.*\.Rproj$ ^\.Rproj\.user$ +^\.travis\.yml$ +^README\.Rmd$ +^_pkgdown\.yml$ +^\.github$ +^_gitignore$ +^\.gitlab-ci\.yml$ +^_Rbuildignore$ +^\.gitignore$ +^LICENSE\.md$ +^README\.md$ +^drc_3\.3\.0\.tar\.gz$ +^drc_.*\.tar\.gz$ +^news$ +^docs$ +^local_testing$ +^\.vscode$ +^build_pkgdown\.R$ +^CITATION\.cff$ diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml new file mode 100644 index 00000000..a9f9f067 --- /dev/null +++ b/.github/workflows/R-CMD-check.yaml @@ -0,0 +1,56 @@ +# 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, main_beta, dev] + pull_request: + branches: [main, main_beta, dev] + +name: R-CMD-check + +permissions: read-all + +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@v5 + + - 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 + env: + PKG_CPPFLAGS: ${{ matrix.config.r == 'devel' && '-DPREXPR=PRCODE' || '' }} + with: + extra-packages: | + any::rcmdcheck + ${{ matrix.config.r == 'devel' && 'r-lib/rlang' || '' }} + needs: check + + - uses: r-lib/actions/check-r-package@v2 + with: + upload-snapshots: true + build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' diff --git a/.github/workflows/static.yml b/.github/workflows/static.yml new file mode 100644 index 00000000..e814eb71 --- /dev/null +++ b/.github/workflows/static.yml @@ -0,0 +1,45 @@ +# Simple workflow for deploying static content to GitHub Pages +name: Deploy static content to Pages + +on: + # Runs on pushes targeting the default branch + push: + branches: ["dev"] + paths: + - 'docs/**' + + # Allows you to run this workflow manually from the Actions tab + workflow_dispatch: + +# Sets permissions of the GITHUB_TOKEN to allow deployment to GitHub Pages +permissions: + contents: read + pages: write + id-token: write + +# Allow only one concurrent deployment, skipping runs queued between the run in-progress and latest queued. +# However, do NOT cancel in-progress runs as we want to allow these production deployments to complete. +concurrency: + group: "pages" + cancel-in-progress: false + +jobs: + # Single deploy job since we're just deploying + deploy: + environment: + name: github-pages + url: ${{ steps.deployment.outputs.page_url }} + runs-on: ubuntu-latest + steps: + - name: Checkout + uses: actions/checkout@v5 + - name: Setup Pages + uses: actions/configure-pages@v5 + - name: Upload artifact + uses: actions/upload-pages-artifact@v3 + with: + # Upload docs directory where pkgdown builds the site + path: 'docs' + - name: Deploy to GitHub Pages + id: deployment + uses: actions/deploy-pages@v4 diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml new file mode 100644 index 00000000..2ac3cec8 --- /dev/null +++ b/.github/workflows/test-coverage.yaml @@ -0,0 +1,69 @@ +# 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, main_beta, dev] + paths: + - 'tests/**' + - 'R/**' + pull_request: + branches: [main, main_beta, dev] + paths: + - 'tests/**' + - 'R/**' + +name: test-coverage + +permissions: read-all + +jobs: + test-coverage: + runs-on: ubuntu-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + + steps: + - uses: actions/checkout@v4 + + - 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, any::xml2 + needs: coverage + + - name: Test coverage + run: | + cov <- covr::package_coverage( + quiet = FALSE, + clean = FALSE, + install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package") + ) + print(cov) + covr::to_cobertura(cov) + shell: Rscript {0} + + - uses: codecov/codecov-action@v4 + with: + # Fail if error if not on PR, or if on PR and token is given + fail_ci_if_error: ${{ github.event_name != 'pull_request' || secrets.CODECOV_TOKEN }} + files: ./cobertura.xml + plugins: noop + disable_search: true + token: ${{ secrets.CODECOV_TOKEN }} + + - 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@v4 + with: + name: coverage-test-failures + path: ${{ runner.temp }}/package diff --git a/.gitignore b/.gitignore index 5b6a0652..27d27f24 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,56 @@ +# R session files .Rproj.user .Rhistory .RData .Ruserdata + +# R package build artifacts +*.tar.gz +*.tgz +*.zip +*.7z +*.Rcheck/ +*.Rproj +README.Rmd +/pkgdown/ +pkgdown/* + +# Caching +.Rinst +.Rlibs +*~ +*.o +*.so +*.dll + +# Local test repositories +local_testing/* + +# knitr / RMarkdown cache +*_cache/ +/cache/ + +# OAuth token +.httr-oauth + +# Tests output +tests/testthat/_snaps/ +Rplots.pdf +tests/testthat/Rplots.pdf + +# OS-generated files +.DS_Store +Thumbs.db + +# R environment files +.Renviron + +# Quarto +.quarto/ + +# Reference/backup files +_gitignore +_Rbuildignore + +# YAML Package build tests and artifacts +/docs_old/ \ No newline at end of file diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index bfb77457..00000000 --- a/.travis.yml +++ /dev/null @@ -1,16 +0,0 @@ -# R for travis: see documentation at https://docs.travis-ci.com/user/languages/r - -language: R -sudo: false -cache: packages - -r: -- release -- devel - -r_github_packages: - - DoseResponse/drcData - - r-lib/covr - -after_success: - - Rscript -e 'covr::codecov()' diff --git a/CITATION.cff b/CITATION.cff new file mode 100644 index 00000000..70e68af7 --- /dev/null +++ b/CITATION.cff @@ -0,0 +1,55 @@ +cff-version: 1.2.0 +message: "If you use this software, please cite it as below." +authors: +- family-names: "Reinwald" + given-names: "Hannes" + orcid: "https://orcid.org/0000-0003-3133-679X" +- family-names: "Ritz" + given-names: "Christian" + orcid: "https://orcid.org/0000-0002-5095-0624" +- family-names: "Baty" + given-names: "Florent" + orcid: "https://orcid.org/0000-0002-1425-0428" +- family-names: "Streibig" + given-names: "Jens Carl" + orcid: "https://orcid.org/0000-0002-6204-4004" +- family-names: "Gerhard" + given-names: "Daniel" + orcid: "https://orcid.org/0000-0002-9336-3454" +title: "Dose-Response Analysis Using R" +version: 3.3.2 +doi: 10.1371/journal.pone.0146021 +date-released: 2015-12-15 +url: "https://github.com/hreinwald/drc" +references: + - type: article + title: "Dose-Response Analysis Using R" + authors: + - family-names: "Ritz" + given-names: "Christian" + - family-names: "Baty" + given-names: "Florent" + - family-names: "Streibig" + given-names: "Jens C" + - family-names: "Gerhard" + given-names: "Daniel" + journal: "PLoS ONE" + volume: 10 + issue: 12 + pages: "e0146021" + year: 2015 + doi: "10.1371/journal.pone.0146021" + - type: book + title: "Dose-Response Analysis Using R" + authors: + - family-names: "Ritz" + given-names: "C." + - family-names: "Jensen" + given-names: "S. M." + - family-names: "Gerhard" + given-names: "D." + - family-names: "Streibig" + given-names: "J. C." + publisher: + name: "CRC Press" + year: 2019 diff --git a/DESCRIPTION b/DESCRIPTION index c61fc234..0258af8a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,16 +1,25 @@ Package: drc -Version: 3.2-0 -Date: 2021-01-13 +Version: 3.3.2 +Date: 2026-05-22 Title: Analysis of Dose-Response Data -Authors@R: c(person("Christian" , "Ritz", role = c("aut", "cre"), email="ritz@bioassay.dk"), - person("Jens", "Streibig", middle="C.", email="streibig@bioassay.dk", role = "aut")) -Maintainer: Christian Ritz -Depends: R (>= 2.0.0), MASS, stats, drcData -Imports: car, gtools, multcomp, plotrix, sandwich, scales -LazyLoad: yes +Authors@R: c(person("Christian", "Ritz", role = c("aut"), email = "ritz@bioassay.dk"), + person(c("Jens", "C."), "Streibig", email = "streibig@bioassay.dk", role = "aut"), + person("Hannes", "Reinwald", email = "hannes.reinwald@bayer.com", role = c("aut", "cre"))) +Depends: R (>= 4.0.0), MASS, stats +Imports: car, data.table, dplyr, graphics, gtools, multcomp, plotrix, sandwich, scales, utils, lifecycle +Encoding: UTF-8 LazyData: yes -Description: Analysis of dose-response data is made available through a suite of flexible and versatile model fitting and after-fitting functions. -License: GPL-2 -URL: http://www.r-project.org, http://www.bioassay.dk -RoxygenNote: 6.1.1 -BugReports: https://github.com/DoseResponse/drc/issues/ +Description: Analysis of dose-response data is made available through a suite of + flexible and versatile model fitting and after-fitting functions. +License: GPL-2 | file LICENSE +URL: https://hreinwald.github.io/drc, https://github.com/hreinwald/drc, https://www.bioassay.dk, https://www.r-project.org, https://cran.r-project.org/web/packages/drc/index.html +RoxygenNote: 7.3.3 +BugReports: https://github.com/hreinwald/drc/issues/ +Roxygen: list(markdown = TRUE) +Suggests: + testthat (>= 3.0.0), + knitr, + magic, + rmarkdown +VignetteBuilder: knitr +Config/testthat/edition: 3 diff --git a/LICENSE b/LICENSE new file mode 100644 index 00000000..d159169d --- /dev/null +++ b/LICENSE @@ -0,0 +1,339 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Lesser General Public License instead.) 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 +this service 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 make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. 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. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute 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 and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +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 +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the 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 a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, 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. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE 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. + + 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 +convey 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 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. + + You should have received a copy of the GNU General Public License along + with this program; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) year name of author + Gnomovision 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, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +This 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. diff --git a/NAMESPACE b/NAMESPACE index b841b487..6c7047b1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,57 +1,82 @@ ## functions export( + AR.2, AR.3, + baro5, + braincousens, BC.5, BC.4, bcl3, bcl4, -cedergreen, CRS.4a, CRS.4b, CRS.4c, CRS.5a, CRS.5b, CRS.5c, CRS.6, ml3a, ml3b, ml3c, ml4a, ml4b, ml4c, + +cedergreen, cedergreen.ssf, CRS.4a, CRS.4b, CRS.4c, CRS.5, CRS.5a, CRS.5b, CRS.5c, CRS.6, ml3a, ml3b, ml3c, ml4a, ml4b, ml4c, + ucedergreen, UCRS.4a, UCRS.4b, UCRS.4c, UCRS.5a, UCRS.5b, UCRS.5c, uml3a, uml3b, uml3c, uml4a, uml4b, uml4c, + EXD.2, EXD.3, + fplogistic, FPL.4, + gammadr, + gaussian, lgaussian, + gompertz, G.2, G.3, G.3u, G.4, + gompertzd, + logistic, L.3, L.4, L.5, + llogistic, LL.2, LL.3, LL.3u, LL.4, LL.5, l2, l3, l3u, l4, l5, + llogistic2, LL2.2, LL2.3, LL2.3u, LL2.4, LL2.5, + lnormal, LN.2, LN.3, LN.3u, LN.4, + MM.2, MM.3, + multi2, + NEC.2, NEC.3, NEC.4, + twophase, + ursa, + weibull1, W1.2, W1.3, W1.3u, W1.4, w2, w3, w4, + weibull2, W2.2, W2.3, W2.3u, W2.4, + weibull2x, W2x.3, W2x.4, + bread.drc, estfun.drc, -backfit, CIcomp, CIcompX, comped, compParm, drm, drmc, ED, EDcomp, getInitial, getMeanFunctions, isobole, -lin.test, MAX, maED, mixture, modelFit, mr.test, mselect, neill.test, noEffect, plotFACI, PR, rdrm, relpot, searchdrc, + +ED_robust, maED_robust, + +backfit, CIcomp, CIcompX, comped, compParm, confint.basic, drm, drmc, ED, EDcomp, getInitial, getMeanFunctions, isobole, +lin.test, MAX, maED, mixture, modelFit, mr.test, mselect, neill.test, noEffect, plotFACI, PR, rdrm, relpot, Rsq, rss, searchdrc, simDR, yieldLoss) importFrom(car, deltaMethod) +importFrom(data.table, rbindlist) +importFrom(dplyr, rename, mutate, "%>%") importFrom(gtools, combinations) -#importFrom(magic, adiag) -importFrom(MASS, boxcox, ginv, psi.bisquare, psi.huber) +importFrom(lifecycle, deprecated) importFrom(multcomp, parm) importFrom(plotrix, axis.break, dispersion, plotCI) +importFrom(MASS, boxcox, ginv, psi.bisquare, psi.huber) +importFrom(sandwich, estfun, bread, sandwich, vcovCL) importFrom(scales, alpha) -#importFrom(nlme, BIC) -#importFrom(stats, cooks.distance, hatvalues) -#exportMethods(BIC) -import(drcData) + importFrom("graphics", "abline", "axTicks", "axis", "lines", "par", "plot", "points", "polygon", "segments", "text") -importFrom("sandwich", "bread", "estfun") - importFrom("stats", "AIC", "anova", "as.formula", "binomial", "coef", "complete.cases", "cooks.distance", "cutree", "deriv", "deviance", - "df.residual", "dgamma", "dist", "dnorm", "dnbinom", "fitted", + "df.residual", "dgamma", "dist", "dnbinom", "dnorm", "fitted", "fivenum", "formula", "glm", "hatvalues", "hclust", "integrate", "lm", "loess", "logLik", "mad", "median", "model.extract", "model.frame", "model.matrix", "model.response", - "model.weights", "na.omit", "na.pass", "optim", "pchisq", + "model.weights", "na.omit", "na.pass", "optim", "optimize", "pchisq", "pf", "pgamma", "pnorm", "poisson", "ppoints", "predict", "printCoefmat", "pt", "qchisq", "qnorm", "qt", "quantile", "rbinom", "residuals", "rnorm", "sd", "uniroot", "update", @@ -59,22 +84,26 @@ importFrom("stats", "AIC", "anova", "as.formula", "binomial", "coef", importFrom("utils", "head", "tail") + + ## S3 methods S3method(anova, drc) S3method(boxcox, drc) -S3method(bread, drc) S3method(coef, drc) S3method(confint, drc) S3method(cooks.distance, drc) S3method(ED, drc) -S3method(estfun, drc) +S3method(ED, lin) +S3method(ED, mrdrc) S3method(fitted, drc) S3method(hatvalues, drc) S3method(logLik, drc) S3method(plot, drc) +S3method(plot, mrdrc) S3method(predict, drc) S3method(predict, mrdrc) S3method(print, drc) +S3method(print, mrdrc) S3method(print, summary.drc) S3method(residuals, drc) S3method(summary, drc) diff --git a/NEWS.md b/NEWS.md new file mode 100644 index 00000000..2cd6e36e --- /dev/null +++ b/NEWS.md @@ -0,0 +1,474 @@ +# drc 3.3.2 + +## New Features +* Enhanced `plot.drc()`: added `errbar.lwd` parameter for independent control of error bar line width in `type = "bars"` plots. When `NULL` (default), error bars inherit the line width from the `lwd` argument or fall back to `par("lwd")`. + +## Bug Fixes +* Fixed `update.drc()` to fall back to stored data (`object$origData`) when `call$data` cannot be resolved in the calling frame, enabling use of `update()` inside `lapply()`, `purrr::map()`, and other functional programming contexts. +* Fixed `vcDisc()` to validate that the inverse Hessian has non-negative variances before returning, preventing invalid variance-covariance matrices from propagating downstream. + +## Changes +* Tightened default `relTol` in `drmc()` from `1e-7` to `1e-10` for improved cross-platform reproducibility of optimization results. +* Added comparative analysis vignette (`comparative-analysis.Rmd`) documenting differences between `hreinwald/drc` and the original `DoseResponse/drc` package. +* Added "Articles" section to pkgdown navigation in `_pkgdown.yml` with categorized guides and technical reports. +* Fixed flaky `maED` tests that depended on platform-specific convergence behavior. +* Added test suites for `boxcox.drc` (functional programming context), `update.drc` (data resolution fallback), and `vcDisc` (singular Hessian handling). + +--- + +# drc 3.3.1 + +## New Features +* Enhanced `plot.drc()`: error bars in `type = "bars"` plots now match curve colors by default. Added `errbar.col` parameter to allow manual control of error bar colors. Set `errbar.col = "black"` to restore the previous behavior of black error bars. + +## Bug Fixes +* Fixed `summary()` crash for binomial `drm` models when the Hessian is singular (DoseResponse/drc#36): `vcDisc` now uses a robust fallback chain (matching `vcCont`) instead of a bare `solve()` call. When inversion fails, a warning is emitted and standard errors are reported as `NA`. +* Fixed `logistic()` model ED calculation with `type="absolute"`: the `edfct` function now correctly handles absolute-to-relative conversion without applying the incorrect p-swap from `EDhelper()`. The logistic model has opposite b-sign convention from log-logistic (b < 0 means increasing, not decreasing), so `EDhelper`'s p-swap for b < 0 would incorrectly swap ED values. The fix uses inline absolute-to-relative conversion (`p = 100·(d−respl)/(d−c)`) for absolute type and `p = respl` directly for relative type. +* Fixed model-level `edfct` derivatives for absolute ED type in `braincousens()`, `fplogistic()`, `llogistic()`, `llogistic2()`, `lnormal()`, `weibull1()`, and `weibull2()`: when `type = "absolute"`, the gradient functions previously set ∂ED/∂c and ∂ED/∂d to 0, which was incorrect because the absolute-to-relative conversion makes p a function of c and d. The chain rule requires non-zero partials. Now compute ∂ED/∂c and ∂ED/∂d via central differences on a closure that captures the chain-rule contribution through the full ED computation path. + +--- + +# drc 3.3.0.03 + +## New Features +* Enhanced `plot.drc()`: error bars in `type = "bars"` plots now match curve colors by default. Added `errbar.col` parameter to allow manual control of error bar colors. Set `errbar.col = "black"` to restore the previous behavior of black error bars. + +## Bug Fixes +* Fixed `predict()` "incorrect number of dimensions" error for models with many fixed parameters (e.g., `EXD.3(fixed = c(lower, upper, NA))`): when only one parameter is estimated, `indexMat` in the fitted model object is a vector rather than a matrix, causing `predict.drc()` to fail when computing standard errors or confidence intervals. Ensured `indexMat` is always coerced to a matrix before column subsetting. + +## Changes +* Updated package version and date in `DESCRIPTION` and website documentation to `3.3.0.03`. +* Updated logo path in `README.md` to point to `man/figures/logo.png` for consistency with package structure. +* Added favicon and manifest links to HTML documentation files for improved branding and browser integration. +* Added the package website (`https://hreinwald.github.io/drc`) as the primary URL in the `DESCRIPTION` file for better discoverability. +* Added the `rss()` function to the reference index in `_pkgdown.yml`. +* Added logo image to the dose-response workflow vignette and updated the vignette date. +* Simplified labeling of effective dose (ED) estimates in the workflow vignette outputs for clarity, removing the `e:1:` prefix. +* Updated model comparison output in the vignette to include additional columns and more precise values. + +--- + +# drc 3.3.0.02 + +## New Features +* Added `rss()` function for computing the residual sum of squares of a fitted `drc` model. Refactored `Rsq()` to reuse `rss()` internally; both functions are now exported. + +## Bug Fixes +* Fixed `ED()` for exponential decay models (EXD.2, EXD.3, AR.2, AR.3, W1.x, W2.x) with two fixed parameters: when only one parameter is estimated (1×1 variance-covariance matrix), the function previously failed with "incorrect number of dimensions" errors. Enhanced `ED.drc` to defensively coerce scalar/vector `vcov` inputs to proper matrices and to always strip names from gradients for consistent matrix algebra. This fix now allows retrieving ED values from exponential decay models with two fixed parameters, which was previously impossible. +* Fixed gradient handling in `ED()` to ensure model-specific derivative functions always return unnamed numeric vectors, preventing dimension errors in delta-method standard error calculations. +* Fixed boundary detection bugs in `MAX()`: used `unname()` so named return values from cedergreen models are compared correctly with unnamed lower/upper scalars, and added tolerance in boundary check since numerical optimizers return values near but not exactly at boundaries. +* Fixed `PR()` dropping `...` arguments for single-curve models. +* Fixed all 17 issues in `ucedergreen()` function: missing `+c` term in model formula, `edfct` signature mismatch with the drc framework, undefined `xlogx` function call in `deriv1`, missing `match.arg()` validation for `method`, vectorized `|` operators in scalar `if()` guards, missing `useFixed` flag computation, `maxfct` signature mismatch and unsafe parameter indexing, broken self-starter ignoring `alpha`/`method`/`useFixed`, missing `fctName`/`fctText` parameters, `deriv1` excluded from return list, and documentation issues. +* Fixed SE calculation for absolute type `ED()`: the model-specific `edfct` gradient functions treated asymptote parameters as constants when `type="absolute"`, missing the chain-rule contribution from the `absToRel` conversion and underestimating the standard error. Now uses numerical central differences with an improved adaptive step size. Added internal helpers `.centralDiffGradient()`, `.safeConfintBasic()`, and `.computeSE()` to make SE computation more robust: `.computeSE()` guards against non-positive-definite variance-covariance matrix slices (returning `NA` instead of erroring), and `.safeConfintBasic()` validates residual degrees of freedom before calling `confint.basic()`, falling back to a z-distribution when `df.residual()` returns an invalid value. +* Fixed inverted `otrace`/`silentVal` logic in `drmOpt()` where `otrace=TRUE` incorrectly caused `silent=TRUE` in `try(optim())`, suppressing error messages instead of displaying them. +* Fixed `searchdrc()` regex error and convergence failure behavior. +* Fixed citation URL: reordered URLs in DESCRIPTION so `citation('drc')` returns the GitHub repository URL instead of r-project.org. +* Fixed `ED()` "incorrect number of dimensions" error for models with few estimated parameters (e.g., EXD.3 with fixed c and d): ensured `indexMat` is always treated as a matrix before column subsetting. +* Fixed `ED()` returning NaN with warning for LL.5 models with ill-conditioned parameters: added validity check to return `Inf` (indicating EC50 is outside valid range) instead of NaN when `exp(-tempVal/parmVec[5]) - 1` is non-positive. Also fixed NaN handling in the check condition to prevent "missing value where TRUE/FALSE needed" errors in `backfit()` and other functions. +* Fixed additional robustness issues in `ED()` / `ED.drc`: loop now always iterates over all curves and all response levels, filtering by `clevel` after computation rather than before; `invMatList` is grown dynamically to avoid NULL holes; curve label construction uses a single structured object with explicit `match` and `display` fields; variance-covariance matrix slices always use `drop = FALSE` to remain matrices. +* Fixed `mselect()` missing two closing braces that caused a parse error when the function was sourced directly. +* Fixed `ED.lin.R` bugs: removed a duplicate `if`-block (dead code that evaluated the same condition twice), removed a stray debug `print()` statement, and added the missing `parameterNames = c("b0", "b1", "b2")` argument to the `deltaMethod()` call for quadratic models (the omission caused incorrect parameter mapping and wrong confidence intervals). +* Fixed `CRS.4b()` display text: `fctText` incorrectly showed `"alpha="` instead of `"alpha=0.5"`. +* Fixed `gammadr()` first-derivative (`deriv1`) calculation: the gradient with respect to the dose parameter incorrectly used `parmMat[, 1]` (the rate parameter) where `dose` was required, producing wrong gradient values. +* Fixed `maED()` model-averaging: models whose ED estimates are non-finite (`Inf` or `NaN`) are now detected and excluded from the weighted average (with a warning naming the model and the offending values); models that returned a `try-error` during fitting are also excluded. When all candidate models are excluded, the function returns `NA` for all estimates instead of `0` or `NaN`. +* Added warning to `noEffect()` when degrees of freedom difference is ≤ 0, clarifying that the likelihood ratio test may not be meaningful when the dose-response model has no additional parameters compared to the null model (e.g., when most parameters are fixed). + +## Changes +* Added `NEWS.md` version control log. Reformatted legacy news file into properly formatted `NEWS.md` with categorized sections. +* Improved documentation for Weibull starting value `method` parameter across `weibull1()`, `weibull2()`, and all wrapper functions (`W1.2`, `W1.3`, `W1.4`, `W2.2`, `W2.3`, `W2.4`, `AR.2`, `AR.3`, `EXD.2`, `EXD.3`). +* Enhanced roxygen2 documentation for `ED` and `ED.drc` functions with improved parameter descriptions and examples. +* Added comprehensive test suites for ``anova.drclist``,`summary.drc`, `print.summary.drc`, `noEffect`, `searchdrc`, `backfit`, `getInitial`, `drmEMeventtime`, `repChar`, `rdrm`, `gompertzd`, `MAX()`, and `PR()` functions. +* Added comprehensive test suites for `llogistic`/LL.x models, `weibull1`/W1.x/EXD.x models, `logistic.ssf`, `gammadr`, `EDcomp`, `mselect`, `drmOpt`, `modelFunction`, `modelFit`, `anova.drclist`, `rss`, and `ED.lin`. +* Large-scale dead code removal across 70+ R source files: removed commented-out function implementations, stray `print()` debug statements, old code paths, and `if(FALSE){...}` blocks. No logic changes; all roxygen2 documentation and meaningful explanatory comments were preserved. +* Removed dead code `iband.R` and all associated references. +* Removed unused `inst/citation` file, superseded by `CITATION.cff` at repository root. +* Deleted `build_pkgdown.R` build script. +* Added PLoS ONE 2015 article and CRC Press 2019 book references to `CITATION.cff`. +* Updated installation instructions and README documentation. +* Added `magic` to Suggests in DESCRIPTION for test dependency. + +--- + +# drc 3.3.0.01 + +## New Features +* Created comprehensive vignettes: `dose-response-workflow.Rmd` providing a complete tutorial on dose-response analysis, and `nec-models.Rmd` documenting No Effect Concentration modeling with `NEC.2`/`NEC.3`/`NEC.4` function variants. +* Set up pkgdown website infrastructure: added `_pkgdown.yml` with Bootstrap 5 configuration, created `build_pkgdown.R` script for build automation, documented pkgdown build process in README, and generated pkgdown documentation site. +* Added computationally robust (stable) wrapper functions in new `ED_robust.R` module: `ED_robust()` for calculating ED values with proper error handling that returns `NA` instead of failing when an ED value is not estimable, `maED_robust()` for model-averaged ED estimation with the same graceful error handling, and `get_ed_interval()` for recommending appropriate confidence interval methods based on model type. +* Added comprehensive test suite covering ED calculations, predictions, plotting, residuals, model selection, and utility functions. +* Added `drm_name()` helper function to `ED_robust.R`. +* Enhanced package startup message with citations and developer credits. +* Added `drm_legacy()` as an internal reference function preserving the original `drm()` implementation. +* Added testthat infrastructure with tests verifying `drm()` output matches `drm_legacy()` output across continuous, binomial, Poisson, and negative binomial data types. +* Added comprehensive anova tests. + +## Bug Fixes +* Fixed vignette build by removing vignettes from `.Rbuildignore` and correcting incorrect `mselect()` usage in examples. +* Fixed Rd comment warning by escaping the `%*%` operator in documentation. +* Fixed all `devtools::check()` errors and warnings: added roxygen2 `@keywords` and lifecycle deprecation notices for deprecated CRS functions, expanded dataset documentation files with examples, added missing dataset aliases, and fixed Weibull model documentation. +* Fixed division-by-zero in `Rsq()` and `absToRel()`. +* Removed dead `scaleEst()` stub function. +* Fixed `inherits()` bug in `mselect.R`. +* Added edge case handling in `modelFit.R`. +* Added input validation for `comped()` and `compParm()`. +* Fixed unsafe global state modification via `options(warn)`, incorrect `compParm` od/pool handling, and residuals division by zero. +* Fixed NaN warning in `summary.drc` for robust estimation methods (metric trimming, Winsorizing, Tukey's biweight). +* Improved `predict.drc` and `vcov.drc` to resolve 23 test failures. +* Fixed `mselect()` to always compute Lack of fit p-values for all models, not only when `nested=TRUE`. +* Fixed a bug in `anova.drclist` where negative or non-finite F statistics produced NaN p-values; negative F statistics now return p-value of 1 and non-finite F statistics return NA. +* Fixed duplicate aliases and unstated dependencies in examples. +* Fixed package dependency warnings: added `data.table` and `dplyr` to Imports, updated NAMESPACE with required imports. +* Fixed S3 method consistency issues and changed `confint.basic` roxygen tag from `@exportS3Method` to `@export`. +* Fixed escaped LaTeX special characters in roxygen2 documentation and Rd files. +* Fixed escaped percent signs in roxygen docs causing Rd parse warnings. + +## Changes +* Added vignette access information to README. +* Completed comprehensive roxygen2 documentation audit: added missing `@param` tags, removed `dontrun`/`donttest` wrappers to enable automated example testing, and fixed broken examples across documentation files. +* Enhanced dataset documentation: improved descriptions and fixed typos in dataset `.Rd` files, added examples sections to dataset `.Rd` files that were missing them. +* Improved `confint.drc` robustness: added `stop()` fallback to `switch()` in `confint.basic()` to handle unknown `intType` values gracefully instead of returning silent NULL. +* Removed `@export` from `confint.basic()` as internal helpers should not be part of the public API. +* Enhanced roxygen2 documentation for `CRS.5`, convenience functions, and `ED_robust` with improved argument descriptions. +* Updated DESCRIPTION: added Hannes Reinwald as maintainer and co-author, updated package version to 3.3.0.01. +* Removed external `drcData` package dependency; example datasets are now bundled directly in the package `data/` directory. +* Added `.Rd` documentation files for all bundled datasets. +* Renamed internal variables for clarity: `ndRows` to `nRows` in `predict.drc`, `posIdx` to `validVar` in `summary.drc`. +* Added test coverage documentation. +* Renamed all 33 R source files from lowercase `.r` to uppercase `.R` extensions for consistency. +* Updated all `.Rd` documentation files to reference the new file names. +* Added GNU General Public License version 2 file and updated license version from GPL-2 to GPL-2.0 in DESCRIPTION. +* Added Hannes Reinwald as author in the DESCRIPTION file. +* Updated README with revised installation instructions and bug report link. +* Migrated all package documentation to roxygen2-generated Rd files. +* Regenerated NAMESPACE via roxygen2. +* Added `@exportS3Method` tags to S3 methods in `confint.drc.R` and `mrdrm.r`. +* Updated package version format from 3.3-0 to 3.3.0. +* Lowered the minimum R version requirement to 4.0.0. + +## Breaking Changes +* Removed deprecated developmental `cedergreen2` function. + +--- + +# drc 3.3.0 + +## New Features +* Added new `CRS.5` wrapper function and `CRS.6` six-parameter model where the alpha exponent is estimated rather than fixed. + +## Bug Fixes +* Fixed a bug where the `stop()` call for using separate curves with control measurements was inside the `if(!noMessage)` block, meaning it would be silently skipped when messages were suppressed. +* Fixed a bug in `noEffect.R` where the Poisson null model incorrectly referenced `resp` instead of using the response vector from the fitted object. + +## Changes +* Refactored the Cedergreen-Ritz-Streibig hormesis model: extracted `edfct` and `maxfct` into standalone helper functions (`cedergreen_edfct`, `cedergreen_maxfct`), refactored the self-starter function, and improved documentation. +* Cleaned up `drm()` function by removing approximately 900 lines of commented-out dead code, debug print statements, and old experimental implementations. +* Removed unused variable `isfi` and redundant variable `lenData` (identical to `numObs`). +* Removed a dead loop over `pmodelsList2` that could never execute. +* Added roxygen2 documentation headers to all R source files across the package. +* Fixed typos in source code and manual pages: 'insted' to 'instead' in `gaussian.r` and `lgaussian.R`, duplicate parameter name 'e1' to 'e2' in `ursa.r`, 'contain' to 'contents' in `EDcomp.R`, 'mising' to 'missing' and 'reponses' to 'responses' in `drm.Rd`, and 'reponse' to 'response' in `CRS.5a.Rd`. +* Updated DESCRIPTION file: added Encoding field (UTF-8), fixed `Authors@R` to use proper `person()` format, removed deprecated Maintainer and LazyLoad fields, added missing Imports (`graphics`, `utils`), and updated URLs from HTTP to HTTPS. +* Comprehensive repository cleanup and code quality improvements. +* Removed obsolete configuration files (`.travis.yml`, `drc.Rproj`, `_pkgdown.yml`, `README.Rmd`) and redundant reference files (`_gitignore`, `_Rbuildignore`). +* Removed the `/tests` directory containing outdated development artifacts with no testing value. +* Updated `.gitignore` and `.Rbuildignore` with standard R/RStudio settings. +* Rewrote `README.md` with comprehensive documentation including quick-start examples, available models, key functions, and supported data types. +* Removed debug `print()` statements in `drmEMstandard.R` and `findbe.r`. +* Removed dead code block (commented-out experimental code wrapped in `if (FALSE)`) in `drmEMstandard.R` and `llogistic.ssf.R`. +* Replaced unsafe `eval(parse(text=...))` calls with `match.fun()` and `do.call()` in `rdrm.r`. +* Improved `options()` handling in `searchdrc.R` by saving and restoring the original warn setting using `on.exit(add=TRUE)`. + +## Deprecated +* Deprecated old CRS function names (`CRS.4a`, `CRS.4b`, `CRS.4c`, `CRS.5a`, `CRS.5b`, `CRS.5c`) with lifecycle notices in favor of new wrappers. + +--- + +# drc Changes in 2017 + +## New Features +* The argument `checkND` has been added to the predict method, allowing switching off comparison of variable names in the original data frame and the `newdata` data frame; useful for predicting in mixture models (after a report by Evan Palmer-Young). +* Confidence intervals for ED values may now be obtained using inverse regression (`interval = "inv"`). +* Species sensitivity distributions may now be fitted using `drm()` with `type = "ssd"`. The predict method now constrains predicted values to meaningful ranges by default and allows incorporating standard errors of estimates in confidence bands for fitted SSDs. + +## Bug Fixes +* Small bug in `mixture()` resolved (after a report by Andrew Kniss). + +## Changes +* Updated the event-time part of drc, in particular in `drm()` (improved code provided by Andrea Onofri). + +--- + +# drc Changes in 2016 + +## New Features +* Negative binomial distributions may now be fitted using the argument `type` with values `"negbin1"` and `"negbin2"` (after a suggestion from Signe M. Jensen). +* Argument `conCheck` added to `drmc()` to switch on/off handling of control measurements. +* `na.omit()` is now the default in `drm()`. +* New functions `CIcomp()`, `CIcompX()`, and `plotFACI()` for calculating combination indices based on effective doses and effects as described in Martin-Betancor et al. (2015). An accompanying dataset `metals` has also been included. + +## Bug Fixes +* Fixed a small bug in printing confidence intervals (after a report from Johannes Ranke). +* Fixed a small error for binomial data in the function `estfun.drc` for use with the package "sandwich" (after a report from Andrew Kniss). + +## Changes +* Help page for two- and three-parameter Weibull models updated, removing typos (after a report by Mikael Gustavsson). +* Output text for confidence intervals modified slightly. + +--- + +# drc Changes in 2015 + +## New Features +* The plot method extended to provide confidence bands (contribution by Gregory Warnes). + +## Bug Fixes +* Robust estimation is working again (after reports from Kathy Mutambanengwe, Sten Ilmjärv, and Corina Dueñas Roca). +* Minor labelling issue in the plot method resolved (with help from Bert Oosthuyse). + +## Changes +* The predict method has been updated (after a report from Duncan Mackay). +* The function `isobole()` now also propagates graphical arguments to fitted isoboles. +* The `print.summary.drc` method shows a warning message in case of df < 1. +* Calculation of the log likelihood for binomial data has been updated and improved. +* The function `backfit()` has been updated. +* Help page for `EDcomp()` updated. +* Help pages for `ED()` and `isobole()` have been updated. Some code has been tidied up. + +## Breaking Changes +* The function `SI()` has been completely replaced by the function `EDcomp()`. +* The function `diagnostics()` has been removed. + +--- + +# drc Changes in 2014 + +## New Features +* The argument `pshifts` has been added to `drm()` to allow weights on parameters (after a comment from Florent Baty). +* The model functions `gammadr()` and `multi2()` have been added. +* The argument `vcov.` has been added to `compParm()`. +* The argument `vcov.` has been added to `EDcomp()` and `predict()`. +* The argument `vcov.` has been added to `ED()` to allow choosing between the standard vcov method and the sandwich function for robust standard errors. +* Added `fixed` value to output from `logistic()` (after a suggestion from Daniel Gerhard). + +## Bug Fixes +* The argument `control` is now correctly propagated in case `separate = TRUE` in `drm()` (after a report from Andy Liaw). +* Small bug in the plot method (not ordering labels in legend text correctly) has been fixed (after a report by Francois Keck). + +## Changes +* The help page for `ursa()` has been improved (in particular the example section). +* The bread and estfun methods have been extended to event-time data. The help page for `G.aparine` has been improved. +* A number of functions depending on `ED()` and `SI()` have been updated. The predict method and plot functionality for event-time data have been improved (after a report from Eshagh Keshtkar). +* `ED()` and `SI()` now return (invisibly) a list whose second component can be used directly with the package multcomp (after a suggestion by Daniel Gerhard). + +## Breaking Changes +* A number of not fully implemented model functions for mixture data have been removed. +* `SI()` has been renamed to `EDcomp()`. + +--- + +# drc Changes in 2013 + +## New Features +* An argument for specifying the reference for the normalization has been added (after a suggestion from Sunniva Foerster). +* An argument for showing normalized data and fitted curves has been added to the plot method (after a suggestion from Ludwig A. Hothorn). + +## Bug Fixes +* Plot method now works for fits obtained from `drm()` using `separate = TRUE` (after a report from Thomas Kroeber). + +## Changes +* Help page for `germination` has been updated. +* `bread.drc()` and `estfun.drc()` have been updated to handle fits for binomial and Poisson data (after a suggestion by Signe M. Jensen). +* Help page for `plot.drc()` has been improved regarding the explanation on the use of error bars (after an enquiry from Julien Delafontaine). +* Help page for `selenium` has been improved (after a comment from Keith Taulbee). +* Help page for `mselect()` has been improved (after a comment from Sona Jesenska). +* `cedergreen()` has been improved to provide meaningful names (after a suggestion from Dave Smithson). + +--- + +# drc Changes in 2012 + +## New Features +* Model functions `gaussian()` and `lgaussian()` have been included (after a suggestion from Ismael Rodea). +* `hatvalues` and `cooks.distance` methods have been added (after a question from Sunniva Förster). +* `noEffect()` function included for testing the dose-response model against a simpler model with no dose effect (after a suggestion by Ryan Hechinger). +* `backfit()` function added (after a suggestion by Keld Sorensen). +* Poisson models can now be fitted with weights (after a suggestion by Marie Laure Delignette-Muller). +* `ED()` now also works for Gompertz models (after a question from Calvin Odero). The dataset `germination` has been included. +* The dataset `chickweed` has been included. +* The dataset `selenium` has been included. + +## Bug Fixes +* Small bug in `drm()` related to starting values for event-time models resolved. +* Small error in `plot.drc` for event times fixed (after a report from Christian Andreasen). +* Small scaling error in fitted method has been removed (after a report from Andreas Betz). +* Limit in dose scaling has been lifted (after a report from Andreas Wernitznig). + +## Changes +* The method for residuals has been extended to provide residuals on the transformed scale in case a Box-Cox transformation was applied. +* Help page for `maED()` has been extended. +* `vcov.drc()` has been updated. +* Help page of `lettuce` has been revised. +* Help page for the function `modelFit()` has been revised, removing a typo in the title (after a comment from John Lynch). +* Help page for the function `mr.test()` has been updated. +* Summary output for `separate = TRUE` now shows the original labels (levels in the variable curveid) (after a comment from Radu Slobodeanu). +* Help page of `NEC()` has been updated. + +--- + +# drc Changes in 2011 + +## New Features +* The model function `W2x.4()` has been added (after a suggestion by Cécile Cornou). +* `display` and `type` arguments have been added to `maED()`. +* The argument `type` can now also take the value `"event"` for fitting event times. +* The model function `weibull2x()` (a model including a sort of "lag time" parameter) has been added (after a suggestion by Cécile Cornou). +* Functions `iceLoewe1()` and `iceLoewe2.1()` have been added. + +## Bug Fixes +* Error in calculation of ED values for `fplogistic()` has been fixed. +* Error in label ordering and calculation of standard errors in `SI()` have been fixed (bug report by Andrew Kniss). +* Problem with confidence intervals in the predict method has been solved (reported on R-help 2010-11-28). +* Problem with `logDose` argument in `drm()` and subsequent plotting has been solved (reported by Ralf Schäfer). +* Constrained estimation now uses the actual limits provided (bug report by Andrew Kniss). +* Error in ED calculation for the logistic models (e.g., `L.4()`) has been fixed, caused by an update of `deltaMethod()` in alr3 (after a report from Daniel Gerhard). +* A small bug in `ED()` has been fixed (after a report from Nathan Pace). +* The functions `isobole()` and `mixture()` have been modified to fix an error in the plotting of the isoboles (after a report from Andreas Betz). +* The self starter function for llogistic models can now handle infinite dose values (after a report from Marc Weimer). + +## Changes +* Plotting for event-time data has been improved. +* Help page of `drm()` (`type` argument) has been updated (after a comment from Radu Slobodeanu). +* Help page of `mixture()` has been slightly improved. +* The functions `genLoewe()`, `genLoewe2()`, `genBliss()`, `genBliss2()`, and `ursa()` have been improved with respect to starting values. The model specification has also been simplified. +* `genBliss()` and `genBliss2()` have been updated (after suggestions from Hugo Ceulemans). +* Small changes for the anova method; added df for event time and Poisson models. +* Small update in the calculation of confidence intervals (after a suggestion from Scott Ray). +* Small improvement in the calculation of ED values for the log-normal and Weibull type 2 models. +* The help page for `spinach` has been improved. +* Simplified printing in `print.summary.drc()` for model fit summary output. + +## Breaking Changes +* `multdrc()` has been completely removed. +* The BIC method has been removed (after a suggestion from Prof. Brian Ripley). + +--- + +# drc Changes in 2010 + +## New Features +* The model `genursa2()` for fitting the generalized URSA model has been included (after an idea by Hugo Ceulemans). +* The model `genursa()` for fitting the generalized URSA model has been included (after an idea by Hugo Ceulemans). +* The model functions `genBliss()`, `genBliss2()`, and `genLoewe2()` for fitting generalized Bliss independence and Loewe additivity with different maxima have been included (after an idea by Hugo Ceulemans). +* The model function `genLoewe()` for fitting generalized Loewe additivity has been included (after an idea by Hugo Ceulemans). +* `mselect()` has been extended to include an argument for specifying the type of information criterion to use. +* `maED()` has been extended to include simple linear regression. +* `mselect()` has been extended to include a few standard polynomial regression models. +* Studentised residuals are now also available for binomial responses (after an inquiry from Stuart Rosen). +* Studentised residuals are now available (after an inquiry from John). +* The argument `clevel` has been added to `ED()`. The function `maED()` has been extended to handle model fits involving several curves (after a suggestion from Andre Kleensang). +* The `comped()` function has been re-introduced (after a suggestion from Jochen Zubrod). +* `logLik` has been extended with a `nobs` attribute (provided by Tobias Verbeke). An S4 BIC method has been added (also provided by Tobias Verbeke). +* The model function `ursa()` for describing combination effects has been added (after an idea by Hugo Ceulemans). + +## Bug Fixes +* A small bug in `ED()` (mismatch of curve names and parameter estimates) has been fixed (after a report from Andreas Betz). +* A small bug in the plot produced by `isobole()` has been fixed (after an inquiry from Andreas Betz). +* A bug in the calculation of standard errors in `SI()` has been fixed (after a report from Andrea Onofri). +* ED values are now correct for `cedergreen()` models (after a bug report by Claire Della Vedova). +* Small bug in `plot.drc()` related to `xt` and `xtlab` arguments has been fixed (after a comment by Anja Coors). A small bug in `comped()` has also been fixed (after a question from Jochen Zubrod). +* Minor bug in the predict method has been fixed, so `type="bars"` in the plot method now works again (after a bug report by Andy Robinson). +* The model function `cedergreen()` has been updated to ensure correct calculation of ED values (reported by Claire Della Vedova). + +## Changes +* Small improvement in the summary output; the actual curve names are now used. +* The help for `NEC()` has been improved (after a question from Inés González). +* The help page of `drm()` has been improved with respect to the use of weights (after a question by Xuesong Yu). +* A slight modification in `vcov.drc()` to suppress unnecessary error messages (reported by Xuesong Yu). +* A slightly different bisection method has been implemented in `ursa()`. The corresponding help page has also been extended. +* The help page for `MM.2()` and `MM.3()` has been improved. + +## Breaking Changes +* The model function `genursa2()` has been replaced by `actimL()`. +* Dataset `ecvam` has been removed. The `mixdrc()` function has been temporarily removed. + +--- + +# drc Changes in 2009 + +## New Features +* The functions `NEC.2()`, `NEC.3()`, `NEC.4()` for estimation of no effect concentration have been included (after an idea by Ralf Schaefer). +* The argument `extended` has been added to the function `maED()`. +* The model function `twophase()` based on log-logistic models has been added (after an idea by Ida Katarina Auf der Maur Hindrichsen). +* The functions `lin.test()`, `mr.test()`, and `neill.test()` have been added. +* The data frame `etmotc` has been included. +* The argument `display` (with same functionality as in `ED()`) has been added for `compParm()` (after a suggestion from Scott Ray). +* The dataset `ecvam` has been included (migrated from the package 'mrdrc'). +* The function `maED()` for parametric model averaging has been added. +* The functions `fplogistic()` and `FPL.4()` enable fitting dose-response models based on fractional polynomials. +* The function `getInitial()` has been included. +* `drm()` extended to allow fitting models separately for each curve. `confint`, `summary`, `vcov`, `ED`, `MAX`, `SI` have a new argument `pool` to allow pooling of separate fits. +* `modelFit()` now also works for binomial data. +* The dataset `algae` has been included. +* The argument `xsty` has been introduced to control the arrangement of tick marks on the dose axis. +* The function `yieldLoss()` has been included to handle a different parameterization of the Michaelis-Menten model (after a suggestion by Andrew Kniss). +* A new function `modelFit()` has been introduced for assessing the model fit, partly replacing the anova method. +* Argument `fixed` added to `BC.4()` and `BC.5()` (thanks to Nina Cedergreen). +* `mixture()` now also works for binomial data. + +## Bug Fixes +* Small bug in `cedergreen()` and `ucedergreen()` related to calculation of ED values has been fixed (reported by Clare Della Vedova). +* Small bug in the function `modelFit()` has been fixed (after feedback from Heike Schmitt). +* Bug in `ED()` concerning `type="absolute"` and `reference="upper"` has been resolved (reported by Yue Zeng-Li). +* Error in likelihood calculation for some binomial models has been fixed. +* Bug in `mselect()` has been fixed (reported by John Lewis). +* Bug in `boxcox.drc` has been fixed. +* Bug in `predict.drc` fixed (thanks to Mario D'Antuono). + +## Changes +* The help page of `drm()` has been updated. +* `confint` has been improved to automatically use the appropriate reference distribution for the confidence intervals; internal structure of `ED()` has also been modified (reported by Marc Weimer). +* The self starter for `twophase()` has been slightly improved. +* Help page for `CRS.5a` has been improved (after a comment from Claire Della Vedova). +* The help pages for `anova.drc` and `BC.4()`, `BC.5()`, `CRS.5.()` have been improved. +* Structure of self starter functions has been completely revamped. Four initial value procedures are now available for almost all implemented dose-response models. +* Help page for `ED()` has been improved (after a comment from Claire Della Vedova). +* Help page for `gompertz()` has been improved slightly. +* Help page for `earthworms` dataset has been improved. +* Minor internal changes in `drm()` and in the plot method. +* `compParm()`, `ED()`, `SI()` have been restructured. +* `vcov` method has been re-structured. +* The argument `conLevel` now has a more sensible default (no longer hardcoded at 0.01). +* `boxcox.drc` method extended to include functionality previously available through `drm()`. +* `drm()` has been improved with respect to handling extremely small or large dose or response values. +* `mixture()` has been completely revised with a lot of changes to the arguments. +* Redundant encoding removed. + +## Breaking Changes +* The function `comped()` has been removed. +* The convenience functions `b.3()`, `B.3()`, `b.4()`, `B.4()`, `b.5()`, `B.5()`, and `boltzmann` have been removed. Use `L.3()`, `L.4()`, and `L.5()` instead. +* Argument `ci` in `relpot()` and `SI()` has been renamed to `interval`. +* Argument `ci` in `ED()` renamed to `interval`. +* The function `plotraw()` has been removed. Use R's standard plotting functionality instead. +* The argument `fctList` has been removed from `drm()`. +* The model function `richards()` has been removed as it is a different parameterization of the five-parameter log-logistic model. `colFct()` has also been removed. +* `multdrc()` and associated `mdControl` have been taken completely out of use. +* Arguments `lowerc` and `upperc` have been removed in model functions as they were redundant. +* Argument `legendCex` in the plot method renamed to `cex.legend` in line with other cex arguments. + +--- + +# drc Changes in 2008 + +## New Features +* Dataset `H.virescens` added. +* `lnormal` function has been added plus three new datasets. +* `gompertz` function has been added. +* Datasets `lepidium` and `nasturtium` have been added. +* New function `mrdrm()` for model-robust modelling included, with accompanying `ED` and `predict` methods. + +## Bug Fixes +* Error in `level` argument in plot method has been fixed. +* Bug in `level` argument in plot method has been fixed. +* The `lettuce` dataset got correct row numbers. + +## Changes +* Asymptotic regression and exponential decay implemented differently. diff --git a/R/CIcompX.R b/R/CIcompX.R index e1b17f16..da3a62c9 100644 --- a/R/CIcompX.R +++ b/R/CIcompX.R @@ -1,5 +1,29 @@ ## Calculating combination indices for x and y axes +#' Calculation of combination index for binary mixtures +#' +#' For single mixture data, combination indices for effective doses as well as effects +#' may be calculated. This is an extended version of \code{\link{CIcomp}}. +#' +#' @param mixProp a numeric value between 0 and 1 specifying the mixture proportion/ratio. +#' @param modelList a list containing 3 model fits using \code{\link{drm}}: the mixture model fit +#' first, followed by the 2 pure substance model fits. +#' @param EDvec a numeric vector of effect levels (percentages between 0 and 100). +#' @param EDonly logical. If TRUE, only combination indices for effective doses are calculated. +#' +#' @return A list with components \code{Effx}, \code{Effy} (unless \code{EDonly = TRUE}), +#' \code{CAx}, \code{CAy} (unless \code{EDonly = TRUE}), and \code{EDvec}. +#' +#' @references Martin-Betancor, K. and Ritz, C. and Fernandez-Pinas, F. and Leganes, F. and +#' Rodea-Palomares, I. (2015) Defining an additivity framework for mixture research in +#' inducible whole-cell biosensors, \emph{Scientific Reports} \bold{17200}. +#' +#' @author Christian Ritz and Ismael Rodea-Palomares +#' +#' @seealso \code{\link{CIcomp}}, \code{\link{plotFACI}}, \code{\link{mixture}} +#' +#' @keywords models nonlinear +#' @concept antagonism mixture synergy CIcompX <- function(mixProp, modelList, EDvec, EDonly = FALSE) { ## Checking the input @@ -20,12 +44,6 @@ CIcompX <- function(mixProp, modelList, EDvec, EDonly = FALSE) pred1 <- predict(modelList[[2]], data.frame(ese1Vec[, 1]), se.fit = TRUE) pred2 <- predict(modelList[[3]], data.frame(ese2Vec[, 1]), se.fit = TRUE) - ## In case only a single ED level is specified - ## (as predict() then returns a vector, not a matrix) - if (!is.matrix(pred12)) {pred12 <- matrix(pred12, nrow = 1)} - if (!is.matrix(pred1)) {pred1 <- matrix(pred1, nrow = 1)} - if (!is.matrix(pred2)) {pred2 <- matrix(pred2, nrow = 1)} - predMat <- as.matrix(cbind(pred12[, 1], pred1[, 1], pred2[, 1], pred12[, 2], pred1[, 2], pred2[, 2])) rownames(predMat) <- as.character(EDvec) @@ -48,7 +66,6 @@ CIcompX <- function(mixProp, modelList, EDvec, EDonly = FALSE) } derivVec <- derivFct(eseVec[1:3]) diagVec <- diag(eseVec[4:6]^2) - # seCI <- sqrt(as.vector((-derivVec[2:3]) %*% (diagVec[2:3, 2:3]) %*% (-derivVec[2:3]))) seDiff <- sqrt(as.vector(derivVec %*% diagVec %*% derivVec)) derivFct2 <- function(ecVec) @@ -61,7 +78,6 @@ CIcompX <- function(mixProp, modelList, EDvec, EDonly = FALSE) dfRes2 <- derivFct2(eseVec[1:3]) derivVec2 <- dfRes2[2:4] seDiff2 <- sqrt(as.vector(derivVec2 %*% diagVec %*% derivVec2)) -# print(seDiff2) retVec <- c(combInd, seDiff, c(combInd - 1.96 * seDiff, combInd + 1.96 * seDiff), caDiff, 2 * (1 - pnorm(abs(caDiff / seDiff))), dfRes2[1], seDiff2) @@ -91,7 +107,6 @@ CIcompX <- function(mixProp, modelList, EDvec, EDonly = FALSE) } derivVec <- derivFct(eseVec[1:3]) diagVec <- diag(eseVec[4:6]^2) - # seCI <- sqrt(as.vector((-derivVec[2:3]) %*% (diagVec[2:3, 2:3]) %*% (-derivVec[2:3]))) seDiff <- sqrt(as.vector(derivVec %*% diagVec %*% derivVec)) derivFct2 <- function(ecVec) @@ -126,6 +141,41 @@ CIcompX <- function(mixProp, modelList, EDvec, EDonly = FALSE) } } +#' Classical combination index for effective doses +#' +#' Calculates the classical combination index for effective doses in binary mixture experiments. +#' +#' @param mixProp a numeric value between 0 and 1 specifying the mixture proportion/ratio. +#' @param modelList a list containing 3 model fits using \code{\link{drm}}: the mixture model fit +#' first, followed by the 2 pure substance model fits. +#' @param EDvec a numeric vector of effect levels (percentages between 0 and 100). +#' +#' @return A matrix with one row per ED value. Columns contain estimated combination indices, +#' their standard errors and 95% confidence intervals, p-value for testing CI=1, estimated +#' ED values for the mixture data and assuming concentration addition (CA) with corresponding +#' standard errors. +#' +#' @references Martin-Betancor, K. and Ritz, C. and Fernandez-Pinas, F. and Leganes, F. and +#' Rodea-Palomares, I. (2015) Defining an additivity framework for mixture research in +#' inducible whole-cell biosensors, \emph{Scientific Reports} \bold{17200}. +#' +#' @author Christian Ritz and Ismael Rodea-Palomares +#' +#' @seealso \code{\link{CIcompX}}, \code{\link{plotFACI}}, \code{\link{mixture}} +#' +#' @examples +#' ## Fitting marginal models for the 2 pure substances +#' acidiq.0 <- drm(rgr ~ dose, data = subset(acidiq, pct == 999 | pct == 0), fct = LL.4()) +#' acidiq.100 <- drm(rgr ~ dose, data = subset(acidiq, pct == 999 | pct == 100), fct = LL.4()) +#' +#' ## Fitting model for single mixture with ratio 17:83 +#' acidiq.17 <- drm(rgr ~ dose, data = subset(acidiq, pct == 17 | pct == 0), fct = LL.4()) +#' +#' ## Calculation of combination indices based on ED10, ED20, ED50 +#' CIcomp(0.17, list(acidiq.17, acidiq.0, acidiq.100), c(10, 20, 50)) +#' +#' @keywords models nonlinear +#' @concept antagonism mixture synergy CIcomp <- function(mixProp, modelList, EDvec) { resLst <- CIcompX(mixProp, modelList, EDvec, EDonly = FALSE) @@ -135,7 +185,7 @@ CIcomp <- function(mixProp, modelList, EDvec) resMt[3, 1:2] <- resLst[["CAx"]][7:8] resMt[5, ] <- resLst[["CAx"]][c(1:2, 4:6)] - resMt <- cbind(resLst[["CAx"]][, -5], resLst[["Effx"]][, c(1, 4)]) + resMt <- cbind(resLst[["CAx"]][, -5, drop = FALSE], resLst[["Effx"]][, c(1, 4), drop = FALSE]) colnames(resMt)[6:7] <- c("ED.CA", "SE.CA") # colnames(resMt) <- c("Est", "SE", "CIlow", "CIupp", "p-val") @@ -145,17 +195,33 @@ CIcomp <- function(mixProp, modelList, EDvec) } +#' Plot combination index as a function of fraction affected +#' +#' Visualizes the combination index from \code{\link{CIcompX}} as a function of the fraction affected. +#' +#' @param effList a list as returned by \code{\link{CIcompX}}. +#' @param indAxis character string. Either "ED" for effective doses or "EF" for effects. +#' @param caRef logical. If TRUE (default), a reference line for concentration addition is drawn. +#' @param showPoints logical. If TRUE, estimated combination indices are plotted as points. +#' @param add logical. If TRUE, the plot is added to an existing plot. +#' @param ylim numeric vector of length 2 giving the range for the y axis. +#' @param ... additional graphical arguments. +#' +#' @return Invisibly returns the plot matrix of combination index values. +#' +#' @author Christian Ritz and Ismael Rodea-Palomares +#' +#' @seealso \code{\link{CIcompX}}, \code{\link{CIcomp}} +#' +#' @keywords models nonlinear plotFACI <- function(effList, indAxis = c("ED", "EF"), caRef = TRUE, showPoints = FALSE, add = FALSE, ylim, ...) { indAxis <- match.arg(indAxis) -# indMat <- CIcompX(mixProp, modelList, faValues) - faValues <- effList[["EDvec"]] minfa <- min(faValues) faValues[faValues < 0] <- -(100 - abs(faValues[faValues < 0])) -# if (indAxis == "x") {plotMat <- indMat[[1]]} else {plotMat <- indMat[[2]]} plotMat <- switch(indAxis, ED = effList[["CAx"]], EF = effList[["CAy"]]) xVec <- as.numeric(rownames(plotMat)) xVec[faValues < 0] <- rev(xVec[faValues < 0]) diff --git a/R/CRS.6.R b/R/CRS.6.R index f7c20305..80ce149d 100644 --- a/R/CRS.6.R +++ b/R/CRS.6.R @@ -1,8 +1,37 @@ +#' Generalised Cedergreen-Ritz-Streibig Model for Hormesis +#' +#' A six-parameter extension of the Cedergreen-Ritz-Streibig model for +#' describing hormesis, where the alpha parameter is estimated rather than fixed. +#' +#' The model function is: +#' +#' \deqn{f(x) = c + \frac{d-c+f \exp(-1/x^g)}{1+\exp(b(\log(x)-\log(e)))}} +#' +#' This generalises the five-parameter \code{\link{CRS.5a}} model by estimating +#' the alpha exponent (parameter \eqn{g}) instead of fixing it. +#' +#' @param fixed numeric vector. Specifies which parameters are fixed and at what value +#' they are fixed. NAs for parameters that are not fixed. +#' @param names a vector of character strings giving the names of the parameters +#' (should not contain ":"). +#' @param method character string indicating the self starter function to use. +#' @param ssfct a self starter function to be used (optional). +#' +#' @return A list containing the nonlinear model function, the self starter function, +#' and the parameter names. +#' +#' @author Christian Ritz +#' +#' @note This function is for use with \code{\link{drm}}. +#' +#' @seealso \code{\link{CRS.5a}}, \code{\link{cedergreen}} +#' +#' @keywords models nonlinear "CRS.6" <- function( fixed = c(NA, NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f", "g"), -method = c("1", "2", "3", "4"), ssfct = NULL) -{ +method = c("1", "2", "3", "4"), +ssfct = NULL ){ ## Checking arguments numParm <- 6 if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct 'names' argument")} @@ -24,42 +53,6 @@ method = c("1", "2", "3", "4"), ssfct = NULL) } ## Defining self starter function -if (FALSE) -{ - ssfct <- function(dataFra) - { - dose2 <- dataFra[,1] - resp3 <- dataFra[,2] - - startVal <- rep(0, numParm) - -# startVal[3]<-max(resp3)+0.001 # the d parameter -# startVal[2]<-min(resp3)-0.001 # the c parameter - startVal[3] <- 1.05 * resp3[which.min(dose2)] - startVal[2] <- 0.95 * min(resp3) - -# startVal[!notFixed] <- fixed[!notFixed] - - if (length(unique(dose2))==1) {return((c(NA,NA,startVal[3],NA,NA))[notFixed])} - - indexT2<-(dose2>0) - if (!any(indexT2)) {return((rep(NA, numParm))[notFixed])} - dose3<-dose2[indexT2] - resp3<-resp3[indexT2] - - logitTrans<-log((startVal[3]-resp3)/(resp3-startVal[2] + 0.001)) # 0.001 to avoid 0 in the denominator - logitFit<-lm(logitTrans~log(dose3)) - startVal[4]<-exp((-coef(logitFit)[1]/coef(logitFit)[2])) # the e parameter - startVal[1]<-coef(logitFit)[2] # the b parameter - -# startVal[5] <- 0 # the f parameter - ## Solving equation at x=e - startVal[6] <- 0 - startVal[5] <- (2*(median(resp3) - startVal[2]) - (startVal[3] - startVal[2]))*exp(1/(startVal[4]^startVal[6])) - - return(startVal[notFixed]) - } -} if (!is.null(ssfct)) { ssfct <- ssfct diff --git a/R/ED.drc.R b/R/ED.drc.R index eec0988c..d7bc8e86 100644 --- a/R/ED.drc.R +++ b/R/ED.drc.R @@ -1,194 +1,546 @@ -ED <- function (object, ...) UseMethod("ED", object) +#' @title Estimating effective doses +#' +#' @description +#' S3 generic function that dispatches to the appropriate method for estimating +#' effective concentrations (EC) or effective doses (ED) at specified response +#' levels. For objects of class \code{drc}, the default method +#' \code{\link{ED.drc}} is called. +#' +#' @param object an object of class \code{drc}. +#' @param ... additional arguments passed to the method. +#' +#' @return See \code{\link{ED.drc}} for details on the return value. +#' +#' @seealso \code{\link{ED.drc}} for the default method, \code{\link{EDcomp}} for estimating differences and ratios of ED +#' @author Christian Ritz +#' @keywords models nonlinear +#' @export +ED <- function(object, ...) UseMethod("ED", object) -"ED.drc" <- function(object, - respLev, - interval = c("none", "delta", "fls", "tfls", "inv"), - clevel = NULL, - level = ifelse(!(interval == "none"), 0.95, NULL), - reference = c("control", "upper"), - type = c("relative", "absolute"), - lref, uref, bound = TRUE, - vcov. = vcov, - display = TRUE, - logBase = NULL, - multcomp = FALSE, - intType = "confidence", ...) -{ - interval <- match.arg(interval) - reference <- match.arg(reference) - type <- match.arg(type) - - ## Checking 'respLev' vector: it should be numbers between 0 and 100 - if ( (type == "relative") && (bound) ) - { - if (any(respLev <= 0 | respLev >= 100)) - { - stop("Response levels (percentages) outside the interval ]0, 100[ not allowed") - } - } - ## Retrieving relevant quantities - EDlist <- object$fct[["edfct"]] - if (is.null(EDlist)) {stop("ED values cannot be calculated")} - indexMat <- object[["indexMat"]] - parmMat <- object[["parmMat"]] +# FIX #7: internal helper with relative step and absolute fallback +.centralDiffGradient <- function(parmChosen, k, EDlist, respLev, j, + reference, type, ...) { + eps <- .Machine$double.eps + p <- parmChosen[k] + h <- if (abs(p) > sqrt(eps)) abs(p) * eps^(1/3) else eps^(1/3) + pUp <- replace(parmChosen, k, p + h) + pDown <- replace(parmChosen, k, p - h) + edUp <- EDlist(pUp, respLev[j], reference = reference, + type = type, ...)[[1]] + edDown <- EDlist(pDown, respLev[j], reference = reference, + type = type, ...)[[1]] + (edUp - edDown) / (2 * h) +} + +# FIX #8: safe wrapper that validates df before calling confint.basic +.safeConfintBasic <- function(mat, level, type, object) { + df <- tryCatch(df.residual(object), error = function(e) Inf) + if (is.null(df) || length(df) != 1L || !is.finite(df) || df <= 0) { + message( + "ED: 'df.residual' returned ", df, + " \u2014 falling back to z-distribution (df = Inf)." + ) + df <- Inf + } + confint.basic(mat, level, type, df, FALSE) +} - curveNames <- colnames(parmMat) # colnames(object$"parmMat") - options(warn = -1) # switching off warnings caused by coercion in the if statement - if (any(is.na(as.numeric(curveNames)))) - { - curveOrder <- order(curveNames) - } else { # if names are numbers then skip re-ordering - curveOrder <- 1:length(curveNames) +# FIX #10: guard against non-positive-definite vcMat slices +.computeSE <- function(grad, varCov) { + tryCatch({ + val <- as.numeric(grad %*% varCov %*% grad) + if (!is.finite(val) || val < 0) { + warning("Non-positive variance estimate; SE set to NA.") + return(NA_real_) } - options(warn = 0) # normalizing behaviour of warnings - - strParm0 <- curveNames[curveOrder] - indexMat <- indexMat[, curveOrder, drop = FALSE] - parmMat <- parmMat[, curveOrder, drop = FALSE] - - strParm <- strParm0 - #vcMat <- vcov.(object) - if (is.function(vcov.)) # following a suggestion by Andrea Onofri - { - vcMat <- vcov.(object) - } else { - vcMat <- vcov. + sqrt(val) + }, error = function(e) { + warning("SE computation failed: ", conditionMessage(e)) + NA_real_ + }) +} + + +#' @title Estimating effective doses +#' +#' @description +#' Default method for class \code{drc}. \code{ED.drc} estimates effective +#' concentrations (EC) or effective doses (ED) for one or more specified +#' response levels. Response levels may be given as relative percentages of +#' the response range (e.g. ED50 = 50\% effect) or as absolute response +#' values. The function computes point estimates, delta-method standard +#' errors, and optional confidence intervals for each combination of curve and +#' response level in the fitted model. +#' +#' @param object an object of class \code{drc}. +#' @param respLev a numeric vector containing the response levels. +#' @param interval character string specifying the type of confidence intervals +#' to be supplied. The default is \code{"none"}. See Details below for more +#' explanation. +#' @param clevel character string specifying the curve id in case estimates for +#' a specific curve or compound are requested. By default estimates are shown +#' for all curves. +#' @param level numeric. The level for the confidence intervals. Must be a +#' single value strictly between 0 and 1. The default is \code{0.95}. +#' @param reference character string. Is the upper limit or the control level +#' the reference? +#' @param type character string. Whether the specified response levels are +#' absolute or relative (default). +#' @param lref numeric value specifying the lower limit to serve as reference. +#' @param uref numeric value specifying the upper limit to serve as reference +#' (e.g., 100%). +#' @param bound logical. Default is \code{TRUE}, in which case only ED values +#' between 0 and 100% are allowed. Set to \code{FALSE} for hormesis models. +#' @param vcov. function providing the variance-covariance matrix, or a +#' variance-covariance matrix directly. \code{\link{vcov}} is the default, +#' but \code{sandwich} is also an option for obtaining robust standard errors. +#' @param display logical. If \code{TRUE} results are displayed. Otherwise they +#' are not (useful in simulations). +#' @param logBase numeric. The base of the logarithm in case logarithm +#' transformed dose values are used. +#' @param multcomp logical to switch on output for use with the package +#' \pkg{multcomp} (which needs to be activated first). Default is +#' \code{FALSE}. +#' @param intType string specifying the type of interval to use with the +#' predict method in case the type of confidence interval chosen is inverse +#' regression. +#' @param ... additional arguments passed to the ED function in the model. +#' +#' @return An invisible matrix containing the estimates and the corresponding +#' estimated standard errors and possibly lower and upper confidence limits. +#' Or, alternatively, a list with elements that may be plugged directly into +#' \code{parm} in the package \pkg{multcomp} (when \code{multcomp = TRUE}). +#' +#' @details +#' The function carries out the following computational steps: +#' +#' \enumerate{ +#' \item \strong{Input validation.} +#' Arguments are checked for correct types and ranges (e.g. \code{respLev} +#' must be numeric, \code{level} must be in (0, 1), and relative response +#' levels must lie strictly inside the interval (0, 100) when +#' \code{bound = TRUE}). +#' +#' \item \strong{Model component extraction.} +#' The model-specific ED function (\code{edfct}), parameter matrix +#' (\code{parmMat}), and index matrix (\code{indexMat}) are retrieved from +#' the fitted \code{drc} object. The variance-covariance matrix is +#' obtained from \code{vcov.}, which may be a function (e.g. +#' \code{\link{vcov}} or \code{sandwich::vcovHC}) or a pre-computed matrix. +#' +#' \item \strong{Curve ordering.} +#' When multiple curves are present, they are sorted alphabetically by +#' name, unless the names are purely numeric, in which case the original +#' order is preserved. +#' +#' \item \strong{ED estimation and delta-method standard errors.} +#' For each curve and each requested response level, the model-specific +#' \code{edfct} is called to obtain the ED point estimate and its +#' analytical gradient with respect to the model parameters. Standard +#' errors are then computed via the delta method: +#' \eqn{SE = \sqrt{g' V g}}{SE = sqrt(g' V g)}, where \eqn{g} is the +#' gradient vector and \eqn{V} is the relevant sub-matrix of the +#' variance-covariance matrix. +#' +#' \item \strong{Numerical gradient for absolute responses.} +#' When \code{type = "absolute"}, the analytical gradient returned by the +#' model may miss the chain-rule contribution from the asymptote parameters +#' involved in converting absolute to relative response levels. In that +#' case a numerical central-difference gradient is computed to ensure +#' correct standard errors. +#' +#' \item \strong{Log-base back-transformation.} +#' If \code{logBase} is specified (indicating that dose values were +#' log-transformed prior to model fitting), the ED estimates and their +#' derivatives are back-transformed via \eqn{ED^* = b^{ED}}{ED* = b^ED} +#' (where \eqn{b} is the log base) so that results are reported on the +#' original dose scale. +#' +#' \item \strong{Confidence interval construction.} +#' Depending on \code{interval}: +#' \describe{ +#' \item{\code{"delta"}}{Asymptotic Wald-type intervals using the delta +#' method, based on the normal or t-distribution (depending on the +#' response type).} +#' \item{\code{"fls"}}{Intervals obtained by back-transforming from the +#' log scale. Only meaningful when the model parameterises the ED on +#' the log scale (e.g. \code{\link{llogistic2}}).} +#' \item{\code{"tfls"}}{Experimental: intervals obtained by transforming +#' to the log scale, computing Wald intervals there, then +#' back-transforming.} +#' \item{\code{"inv"}}{Intervals derived from inverse regression via +#' \code{\link[=EDinvreg]{EDinvreg}}, where confidence limits on the +#' predicted response are inverted to the dose axis.} +#' } +#' +#' \item \strong{Output.} +#' Results are returned as an invisible matrix with columns for the +#' estimate, standard error, and (optionally) lower and upper confidence +#' limits. When \code{multcomp = TRUE}, a list compatible with +#' \code{\link[multcomp]{parm}} is returned instead, enabling +#' multiple-comparison procedures. +#' } +#' +#' For hormesis models (\code{\link{braincousens}} and +#' \code{\link{cedergreen}}), the additional arguments \code{lower} and +#' \code{upper} may be supplied. These arguments specify the lower and upper +#' limits of the bisection method used to find the ED values. +#' +#' @seealso \code{\link{EDcomp}} for estimating differences and ratios of ED +#' values, \code{\link{compParm}} for comparing other model parameters, and +#' \code{\link{backfit}}. +#' +#' @examples +#' ## Fitting a 4-parameter log-logistic model +#' ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +#' +#' ## Calculating EC/ED values +#' ED(ryegrass.m1, c(10, 50, 90)) +#' +#' ## Displaying 95% confidence intervals using the delta method +#' ED(ryegrass.m1, c(10, 50, 90), interval = "delta") +#' +#' ## Displaying 95% confidence intervals using back-transformation +#' ED(ryegrass.m1, c(10, 50, 90), interval = "fls") +#' +#' ## Displaying 95% confidence intervals using inverse regression +#' ED(ryegrass.m1, c(10, 50, 90), interval = "inv") +#' +#' @author Christian Ritz +#' @keywords models nonlinear +#' @export +"ED.drc" <- function( + object, + respLev = c(10,20,50), + interval = c("none", "delta", "fls", "tfls", "inv"), + clevel = NULL, + level = 0.95, + reference = c("control", "upper"), + type = c("relative", "absolute"), + lref, + uref, + bound = TRUE, + vcov. = vcov, + display = TRUE, + logBase = NULL, + multcomp = FALSE, + intType = "confidence", + ... +) { + + ## --- Input validation ------------------------------------------------------- + + if (!inherits(object, "drc")) { + stop("'object' must be of class 'drc'") + } + if (!is.numeric(respLev) || length(respLev) == 0) { + stop("'respLev' must be a non-empty numeric vector") + } + if (!is.numeric(level) || length(level) != 1L || level <= 0 || level >= 1) { + stop("'level' must be a single numeric value strictly between 0 and 1") + } + if (!is.logical(bound) || length(bound) != 1L) { + stop("'bound' must be a single logical value") + } + if (!is.logical(display) || length(display) != 1L) { + stop("'display' must be a single logical value") + } + if (!is.logical(multcomp) || length(multcomp) != 1L) { + stop("'multcomp' must be a single logical value") + } + + ## --- Resolve enumerated arguments ------------------------------------------- + + interval <- match.arg(interval) + reference <- match.arg(reference) + type <- match.arg(type) + + ## --- Validate response levels ----------------------------------------------- + + # Relative response levels must be strictly inside the open interval (0, 100). + if (identical(type, "relative") && bound) { + if (any(respLev <= 0 | respLev >= 100)) { + stop( + "Response levels (percentages) outside the interval ]0, 100[ ", + "are not allowed" + ) } - - ## Defining vectors and matrices needed - ncolIM <- ncol(indexMat) - indexVec <- 1:ncolIM -# lenEB <- ncolIM - lenPV <- length(respLev) # used twice below - noRows <- ncolIM * lenPV - dimNames <- rep("", noRows) # lenEB*lenPV, 2) - EDmat <- matrix(0, noRows, 2) # lenEB*lenPV, 2) - oriMat <- matrix(0, noRows, 2) # lenEB*lenPV, 2) + } + + ## --- Retrieve relevant model components ------------------------------------- + + EDlist <- object[["fct"]][["edfct"]] + if (is.null(EDlist)) { + stop("ED values cannot be calculated for this model") + } + + indexMat <- object[["indexMat"]] + parmMat <- object[["parmMat"]] - ## Skipping curve id if only one curve is present - if (identical(length(unique(strParm)), 1)) - { - strParm[indexVec] <- rep("", ncolIM) - } else { - strParm <- paste(strParm, ":", sep = "") + # Ensure indexMat is always a matrix, even if it's a single column vector + if (!is.matrix(indexMat)) { + indexMat <- as.matrix(indexMat) + # Set column names to match parmMat if they exist + if (!is.null(colnames(parmMat))) { + colnames(indexMat) <- colnames(parmMat) } + } + + ## --- Determine curve ordering ----------------------------------------------- - ## Calculating estimates and estimated standard errors - rowIndex <- 1 - lenIV <- length(indexVec) - dEDmat <- matrix(0, lenPV * lenIV, nrow(vcMat)) - intMat <- NULL - for (i in indexVec) - { - parmChosen <- parmMat[, i] - parmInd <- indexMat[, i] - varCov <- vcMat[parmInd, parmInd] + curveNames <- colnames(parmMat) - if ((is.null(clevel)) || (strParm0[i] %in% clevel)) - { - for (j in 1:lenPV) - { - EDeval <- EDlist(parmChosen, respLev[j], reference = reference, type = type, ...) - EDval <- EDeval[[1]] - dEDval <- EDeval[[2]] - dEDmat[(i-1)*lenPV + j, parmInd] <- dEDval - - oriMat[rowIndex, 1] <- EDval - oriMat[rowIndex, 2] <- sqrt(dEDval %*% varCov %*% dEDval) - - if (!is.null(logBase)) - { - EDval <- logBase^(EDval) - dEDval <- EDval * log(logBase) * dEDval - } - EDmat[rowIndex, 1] <- EDval - EDmat[rowIndex, 2] <- sqrt(dEDval %*% varCov %*% dEDval) + # When curve names are numeric, retain their original order rather than + # sorting lexicographically. tryCatch is used to detect coercion failures + # without suppressing warnings globally. + namesAreNumeric <- tryCatch( + !anyNA(as.numeric(curveNames)), + warning = function(w) FALSE + ) + curveOrder <- if (!namesAreNumeric) order(curveNames) else seq_along(curveNames) - dimNames[rowIndex] <- paste(strParm[i], respLev[j], sep = "") - rowIndex <- rowIndex + 1 - } - if (interval == "inv") - { - intMat <- rbind(intMat, t(EDinvreg1(object, respLev, strParm0[i], - intType = intType, level = level, type = type))) - } - - } else { - rowsToRemove <- rowIndex:(rowIndex + lenPV - 1) - EDmat <- EDmat[-rowsToRemove, , drop = FALSE] - dimNames <- dimNames[-rowsToRemove] - } - + # FIX #9: single structure with explicit match and display fields + curveLabels <- list( + match = curveNames[curveOrder], + display = if (length(unique(curveNames)) == 1L) { + rep("", length(curveNames[curveOrder])) + } else { + paste0(curveNames[curveOrder], ":") + } + ) + + indexMat <- indexMat[, curveOrder, drop = FALSE] + parmMat <- parmMat[, curveOrder, drop = FALSE] + + ## --- Resolve variance-covariance matrix ------------------------------------- + + # vcov. can be supplied either as a function (e.g. vcov or sandwich) or as a + # pre-computed matrix. Both are supported. + vcMat <- if (is.function(vcov.)) vcov.(object) else vcov. + + # FIX #12: coerce vcov to a matrix when it arrives as a scalar or bare + # numeric vector (e.g. user passes `as.numeric(vcov(obj))` or a scalar + # variance for a single-parameter model). + if (!is.matrix(vcMat)) { + if (is.numeric(vcMat) && length(vcMat) == 1L) { + vcMat <- matrix(vcMat, 1L, 1L) + } else if (is.numeric(vcMat)) { + n <- round(sqrt(length(vcMat))) + if (n * n == length(vcMat)) { + vcMat <- matrix(vcMat, n, n) + } else { + stop("'vcov.' must be a square matrix or a function returning one") + } + } else { + stop("'vcov.' must be a numeric matrix or a function returning one") } + } + + ## --- Pre-allocate result matrices ------------------------------------------- + + ncolIM <- ncol(indexMat) + indexVec <- seq_len(ncolIM) + lenPV <- length(respLev) + noRows <- ncolIM * lenPV + + dimNames <- rep("", noRows) + edMat <- matrix(0, noRows, 2) + oriMat <- matrix(0, noRows, 2) + dEdMat <- matrix(0, lenPV * length(indexVec), nrow(vcMat)) + + # FIX #2: track which rows were actually computed + filledRowFlags <- logical(lenPV * length(indexVec)) + + # Always initialise confidence limit matrices to avoid undefined variable + # errors in the 'kang' / 'inv' result-construction blocks. + intMat <- NULL + + ## --- Interval type for per-model ED calls ----------------------------------- + + # Delta-method intervals are needed for the Kang model-averaging approach. + # For all other interval types, no per-model interval is required at this stage. + interval2 <- if (identical(interval, "kang")) "delta" else "none" + + ## --- Compute ED estimates and standard errors for each curve ---------------- + + # FIX #3: use a growing list to avoid NULL holes + invMatList <- list() + rowIndex <- 0L + + for (i in indexVec) { + parmChosen <- parmMat[, i] + parmInd <- indexMat[, i] + # FIX #10: always return a matrix slice regardless of dimensions + varCov <- vcMat[parmInd, parmInd, drop = FALSE] - ## Defining column names - colNames <- c("Estimate", "Std. Error") - - ## Calculating the confidence intervals - if (interval == "delta") - { - intMat <- confint.basic(EDmat, level, object$"type", df.residual(object), FALSE) - intLabel <- "Delta method" + # FIX #1: always iterate over all curves — filter after loop + for (j in seq_len(lenPV)) { + rowIndex <- rowIndex + 1L + + EDeval <- EDlist(parmChosen, respLev[j], reference = reference, type = type, ...) + EDval <- EDeval[[1]] + dEDval <- EDeval[[2]] + + # FIX #13: ensure gradient is always an unnamed numeric vector. + # Model-specific edfct functions return EDder[notFixed] which may be a + # named scalar when only one parameter is free. Strip names and + # guarantee vector type for consistent matrix algebra downstream. + dEDval <- as.numeric(dEDval) + + # When type is "absolute", the model-specific gradient typically + # treats the (converted) relative response level as a constant, + # missing the chain-rule contribution from the lower and upper + # asymptote parameters (c and d) that enter via the + # absolute-to-relative conversion (absToRel / EDhelper). Use + # numerical central differences to obtain the complete gradient. + if (identical(type, "absolute") && is.finite(EDval)) { + # FIX #7: use helper function with improved step size + dEDval <- vapply( + seq_along(parmChosen), + function(k) .centralDiffGradient( + parmChosen, k, EDlist, respLev, j, reference, type, ... + ), + numeric(1L) + ) + } + + dEdMat[rowIndex, parmInd] <- dEDval + + oriMat[rowIndex, 1] <- EDval + # FIX #10: use .computeSE helper + oriMat[rowIndex, 2] <- .computeSE(dEDval, varCov) + + # Apply log-base transformation to the ED value and its derivative if + # a log-transformed dose axis is in use. + if (!is.null(logBase)) { + EDval <- logBase^EDval + dEDval <- EDval * log(logBase) * dEDval + } + + edMat[rowIndex, 1] <- EDval + # FIX #10: use .computeSE helper + edMat[rowIndex, 2] <- .computeSE(dEDval, varCov) + + # FIX #9: use curveLabels instead of strParm + dimNames[rowIndex] <- paste0(curveLabels$display[i], respLev[j]) + + # FIX #2: mark this row as computed + filledRowFlags[rowIndex] <- TRUE } - if (interval == "tfls") - { - intMat <- exp(confint.basic(matrix(c(log(oriMat[, 1]), oriMat[, 2] / oriMat[, 1]), ncol = 2), - level, object$"type", df.residual(object), FALSE)) - intLabel <- "To and from log scale" + # Inverse regression intervals are computed per-curve, outside the inner + # loop, because EDinvreg1 handles all response levels at once. + if (identical(interval, "inv")) { + # FIX #4: key by curve name so assembly order is explicit + invMatList[[curveLabels$match[i]]] <- t( + EDinvreg1( + object, + respLev, + curveLabels$match[i], + intType = intType, + level = level, + type = type + ) + ) } - - if (interval == "fls") - { - if (is.null(logBase)) - { - logBase <- exp(1) - EDmat[, 1] <- exp(EDmat[, 1]) # back-transforming log ED values - } - - intMat <- logBase^(confint.basic(oriMat, level, object$"type", df.residual(object), FALSE)) - intLabel <- "Back-transformed from log scale" - - ## Dropping estimated standard errors (not relevant after back transformation) - EDmat <- EDmat[, -2, drop = FALSE] - colNames <- colNames[-2] -# colNames <- c(colNames[-2], "Lower", "Upper") # standard errors not relevant + } + + # FIX #1: filter excluded curves after the loop, not during it + if (!is.null(clevel)) { + curveIncludedVec <- rep(curveLabels$match %in% clevel, each = lenPV) + edMat <- edMat[curveIncludedVec, , drop = FALSE] + oriMat <- oriMat[curveIncludedVec, , drop = FALSE] + dimNames <- dimNames[curveIncludedVec] + dEdMat <- dEdMat[curveIncludedVec, , drop = FALSE] + filledRowFlags <- filledRowFlags[curveIncludedVec] # FIX #2 + } + + # FIX #4: reconstruct in the same order as edMat rows + if (identical(interval, "inv")) { + orderedCurves <- if (!is.null(clevel)) { + curveLabels$match[curveLabels$match %in% clevel] + } else { + curveLabels$match } - - if (interval == "inv") - { - EDmat <- EDmat[, -2, drop = FALSE] - colNames <- colNames[-2] - intLabel <- "Inverse regression" + intMat <- do.call(rbind, invMatList[orderedCurves]) + # FIX #3: row-count safety check + if (nrow(intMat) != nrow(edMat)) { + stop( + "Internal error: inverse regression result rows (", nrow(intMat), + ") do not match ED estimate rows (", nrow(edMat), ")." + ) } + } + + ## --- Column names ----------------------------------------------------------- + + edColNames <- c("Estimate", "Std. Error") + + ## --- Compute confidence intervals ------------------------------------------- + + # intLabel is initialised to NULL so that a missing branch cannot cause an + # "object not found" error at the resPrint call below. + intLabel <- NULL + + if (identical(interval, "delta")) { + # FIX #8: use safe wrapper + intMat <- .safeConfintBasic(edMat, level, object[["type"]], object) + intLabel <- "Delta method" - if (identical(interval, "none")) - { - intLabel <- NULL - } else { - EDmat <- as.matrix(cbind(EDmat, intMat)) - colNames <- c(colNames, "Lower", "Upper") - } - dimnames(EDmat) <- list(dimNames, colNames) - rownames(EDmat) <- paste("e", rownames(EDmat), sep = ":") - resPrint(EDmat, "Estimated effective doses", interval, intLabel, display = display) + } else if (identical(interval, "tfls")) { + # FIX #8: use safe wrapper + intMat <- exp( + .safeConfintBasic( + matrix(c(log(oriMat[, 1]), oriMat[, 2] / oriMat[, 1]), ncol = 2), + level, + object[["type"]], + object + ) + ) + intLabel <- "To and from log scale" - if(multcomp) - { - EDmat1 <- EDmat[, 1] - namesVec <- names(EDmat1) # paste("e", names(EDmat1), sep = ":") -# names(EDmat1) <- namesVec - - EDmat1VC <- (dEDmat %*% vcMat %*% t(dEDmat))[1:nrow(EDmat), 1:nrow(EDmat), drop = FALSE] - colnames(EDmat1VC) <- namesVec - rownames(EDmat1VC) <- namesVec - - invisible(list(#EDdisplay = EDmat, -# EDmultcomp = parm(EDmat[, 1], (dEDmat %*% vcMat %*% t(dEDmat))[1:nrow(EDmat), 1:nrow(EDmat), drop = FALSE]))) - EDmultcomp = parm(EDmat1, EDmat1VC))) - } else { - invisible(EDmat) - } -} - + } else if (identical(interval, "fls")) { + # FIX #5: always derive point estimate from oriMat to avoid double-transformation + flsBase <- if (is.null(logBase)) exp(1) else logBase + edMat[, 1] <- flsBase^oriMat[, 1] + # FIX #8: use safe wrapper + intMat <- flsBase^(.safeConfintBasic(oriMat, level, object[["type"]], object)) + intLabel <- "Back-transformed from log scale" + + } else if (identical(interval, "inv")) { + intLabel <- "Inverse regression" + } + + ## --- Assemble final ED matrix ----------------------------------------------- + + if (!identical(interval, "none")) { + edMat <- as.matrix(cbind(edMat, intMat)) + edColNames <- c(edColNames, "Lower", "Upper") + } + + dimnames(edMat) <- list(paste0("e:", dimNames), edColNames) + + # FIX #11: suppress printing entirely when multcomp = TRUE + if (!multcomp) { + resPrint(edMat, "Estimated effective doses", interval, intLabel, display = display) + } + + ## --- Return ----------------------------------------------------------------- + + if (multcomp) { + EDmat1 <- edMat[, 1] + namesVec <- names(EDmat1) + + # FIX #2: use explicit tracking vector instead of zero-row heuristic + dEdMatFilled <- dEdMat[filledRowFlags, , drop = FALSE] + EDmat1VC <- dEdMatFilled %*% vcMat %*% t(dEdMatFilled) + + colnames(EDmat1VC) <- namesVec + rownames(EDmat1VC) <- namesVec + + return(invisible(list(EDmultcomp = parm(EDmat1, EDmat1VC)))) + } + + return(invisible(edMat)) +} \ No newline at end of file diff --git a/R/ED.lin.R b/R/ED.lin.R index ef78078c..4ce41f6c 100644 --- a/R/ED.lin.R +++ b/R/ED.lin.R @@ -1,88 +1,67 @@ -"ED.lin" <- function(lmObject, respLev) -{ - parCoef <- coef(lmObject) - lparco <- length(parCoef) - -# yVal <- lmObject$"model"[, 1] - xVal <- lmObject$"model"[, 2] - fittedVal <- fitted(lmObject) -# maxDose <- max(xVal) - - decreasing <- ((lparco == 2) && (parCoef[lparco] < 0)) || ((lparco == 3) && (parCoef[lparco] > 0)) - -# if (parCoef[lparco] < 0) # decreasing trend - if (decreasing) - { - cVal <- fittedVal[which.max(xVal)] - dVal <- fittedVal[which.min(xVal)] - } else { - cVal <- fittedVal[which.min(xVal)] - dVal <- fittedVal[which.max(xVal)] - -# respLev <- 100 - respLev - } - ## Truncating in case the lower limit is negative - cVal <- pmax(0, cVal) - -# -# if (cVal < 0) -# { -# cVal <- 0 # as.numeric(polyroot(coef(lmObject))) -# } -# print(c(cVal, dVal)) - - ## Defining apply() function to handle vector "respLev" arguments - - if (lparco == 2) - { - if (!decreasing) {respLev <- 100 - respLev} - - appFct <- function(respLev) - { -# deltaMethod(lmObject, paste("(", cVal, "-b0+", (100 - respLev)/(100), "*(", dVal - cVal, "))/b1", collapse = "")) - deltaMethod(lmObject, paste("(", cVal, "-b0+", (100 - respLev)/(100), "*(", dVal - cVal, "))/b1", collapse = ""), - parameterNames=c("b0", "b1")) - } - } - if (lparco == 3) - { - if (parCoef[3] < 0) {respLev <- 100 - respLev} - - print(c(max(xVal), (-parCoef[2] / (2*parCoef[3])))) - - ## Deciding which leg of parabola - if ((-parCoef[2] / (2*parCoef[3])) > max(xVal) && (parCoef[3] < 0)) - { - signVal <- 1 - } - - if ((-parCoef[2] / (2*parCoef[3])) > max(xVal) && (parCoef[3] < 0)) - { - signVal <- 1 - } - - - else { - signVal <- -1 - } - - ## Deciding whether the parabola is a cap or a cup - if (parCoef[3] < 0) - { - decreasing <- 1 - } else { - decreasing <- -1 - } - signVal <- signVal * decreasing - - - -# print(paste("(-b1+", signVal, "*sqrt(b1*b1 - 4*b2*(b0-", cVal + ((100 - respLev)/100) * (dVal - cVal), ")))/(2*b2)", collapse = "")) - appFct <- function(respLev) - { - deltaMethod(lmObject, paste("(-b1+", signVal, "*sqrt(b1*b1 - 4*b2*(b0-", cVal + ((100 - respLev)/100) * (dVal - cVal), ")))/(2*b2)", - collapse = "")) - } - } - t(sapply(respLev, appFct)) -} +#' @title ED calculation for linear models +#' @keywords internal +"ED.lin" <- function(object, respLev, ...) +{ + parCoef <- coef(object) + lparco <- length(parCoef) + + xVal <- object$"model"[, 2] + fittedVal <- fitted(object) + + decreasing <- ((lparco == 2) && (parCoef[lparco] < 0)) || ((lparco == 3) && (parCoef[lparco] > 0)) + + if (decreasing) + { + cVal <- fittedVal[which.max(xVal)] + dVal <- fittedVal[which.min(xVal)] + } else { + cVal <- fittedVal[which.min(xVal)] + dVal <- fittedVal[which.max(xVal)] + } + ## Truncating in case the lower limit is negative + cVal <- pmax(0, cVal) + + ## Defining apply() function to handle vector "respLev" arguments + + if (lparco == 2) + { + if (!decreasing) {respLev <- 100 - respLev} + + appFct <- function(respLev) + { + deltaMethod(object, paste("(", cVal, "-b0+", (100 - respLev)/(100), "*(", dVal - cVal, "))/b1", collapse = ""), + parameterNames=c("b0", "b1")) + } + } + if (lparco == 3) + { + if (parCoef[3] < 0) {respLev <- 100 - respLev} + + ## Deciding which leg of parabola + if ((-parCoef[2] / (2*parCoef[3])) > max(xVal) && (parCoef[3] < 0)) + { + signVal <- 1 + } else { + signVal <- -1 + } + + ## Deciding whether the parabola is a cap or a cup + if (parCoef[3] < 0) + { + decreasing <- 1 + } else { + decreasing <- -1 + } + signVal <- signVal * decreasing + + + + appFct <- function(respLev) + { + deltaMethod(object, paste("(-b1+", signVal, "*sqrt(b1*b1 - 4*b2*(b0-", cVal + ((100 - respLev)/100) * (dVal - cVal), ")))/(2*b2)", + collapse = ""), + parameterNames=c("b0", "b1", "b2")) + } + } + t(sapply(respLev, appFct)) +} diff --git a/R/ED_robust.R b/R/ED_robust.R new file mode 100644 index 00000000..991f7314 --- /dev/null +++ b/R/ED_robust.R @@ -0,0 +1,329 @@ +#' Select Appropriate Confidence Interval Method for a drc Model +#' +#' This function determines the recommended confidence interval calculation method +#' ('type' argument in drc::ED) based on the model family of a 'drc' object. +#' +#' @param model A drc model object or a character string specifying the model name (e.g., "LL.4"). +#' @param small_n A logical value. If TRUE, the t-distribution-based Fieller's method ("tfls") +#' is used for small samples for applicable models. If FALSE, the normal-distribution-based +#' method ("fls") is used. Defaults to TRUE. +#' @param fls_pattern A regular expression character string. This pattern is used to identify +#' model families for which the "fls" or "tfls" method is appropriate. The default +#' covers standard log-logistic, log-normal, Brain-Cousens, and Cedergreen-Ritz-Streibig models. +#' @param verbose A logical value. If TRUE, a message is printed when the function +#' resorts to its default choice because the model type was not explicitly matched. +#' Defaults to TRUE. +#' +#' @return A character string: "tfls", "fls", or "delta", representing the +#' recommended interval type for use in `drc::ED()`. +#' +#' @author Hannes Reinwald +#' +#' @keywords internal +#' +#' @examples +#' ryegrass_model <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +#' drc:::get_ed_interval(ryegrass_model) +#' drc:::get_ed_interval("LL.4") +#' drc:::get_ed_interval("W1.4") +#' +get_ed_interval <- function( + model, + small_n = TRUE, + fls_pattern = "^LL|^LN|^BC|^CRS", + verbose = FALSE +) { + # --- Input Validation and Name Extraction --- + if (inherits(model, "drc")) { + # If 'model' is a drc object, extract the function name + model_name <- as.character(model$call$fct)[1] + } else if (is.character(model) && length(model) == 1) { + # If 'model' is a character string + model_name <- model + } else { + stop("Input 'model' must be a 'drc' object or a single character string.") + } + + # --- Core Logic --- + if (grepl(fls_pattern, model_name, ignore.case = TRUE)) { + # Log-logistic, Log-normal, and other user-defined families + return(ifelse(small_n, "tfls", "fls")) + } else if (grepl("^W", model_name, ignore.case = TRUE)) { + # Weibull models + return("delta") + } else { + # Default for other models (e.g., linear, quadratic) + if (verbose) { + message(paste("Defaulting to 'tfls' for model type:", model_name)) + } + return("tfls") + } +} + + +#' Get the name of a dose-response model +#' +#' @param mod A model object returned by [drc::drm()]. +#' +#' @return A single character string combining the model function name and its +#' parameter names, separated by a colon and dashes, +#' e.g. `"LL.4:b-c-d-e"`. +#' @author Hannes Reinwald +#' @noRd +drm_name = function(mod){ + if (!inherits(mod, "drc")) { + stop("`mod` must be a `drc` object returned by `drc::drm()`.") + } + paste0(mod$fct$name,":", paste(mod$fct$names, collapse = "-")) +} + + +#' Robust Calculation of Effective Doses (ED) +#' +#' @description +#' This function serves as a robust wrapper for `drc::ED`. It calculates +#' effective doses (EDs) for multiple specified response levels. Its primary +#' feature is the ability to gracefully handle cases where an ED value is not +#' mathematically estimable from the model (e.g., the requested response is +#' outside the model's asymptotes). Instead of throwing an error, it returns a +#' row of `NA` values for that specific response level, ensuring the overall +#' analysis can proceed. +#' +#' @param mod An object of class 'drc', representing the fitted dose-response model. +#' @param respLev A numeric vector specifying the response levels for which to +#' calculate ED values (e.g., `c(10, 50)` for ED10 and ED50). +#' @param interval A character string specifying the method for calculating +#' confidence intervals. Defaults to the output of `get_ed_interval()`. +#' Common options include "delta", "tfls", or "buckland". +#' @param CI_level A numeric value between 0 and 1 indicating the confidence +#' level for the intervals (e.g., 0.95 for a 95% CI). +#' @param verbose A logical value. If `TRUE`, the function will print status +#' messages about the calculation progress and any errors encountered for each +#' response level. Default is `FALSE`. +#' @param ... Additional arguments to be passed directly to `drc::ED`. +#' +#' @return +#' A `data.table` where each row corresponds to a requested response level. +#' The table includes the ED estimate, standard error, confidence interval +#' (Lower, Upper), and metadata about the calculation (confidence level, method, +#' model name, and EC level). Rows for non-estimable EDs are populated with `NA`. +#' +#' @author Hannes Reinwald +#' +#' @export +#' +#' @examples +#' data(lettuce) +#' m <- drm(weight ~ conc, data = lettuce, fct = BC.4()) +#' ED_robust(m, respLev = c(10, 50), CI_level = 0.95) +#' +ED_robust <- function(mod, respLev = c(10, 20, 50), + interval = get_ed_interval(mod$fct$name, small_n = TRUE), + CI_level = 0.95, verbose = FALSE, ...) { + # Use lapply to iterate over each response level. + # This will return a list of data frames (one for each level). + results_list <- lapply(respLev, function(ec) { + #message("Calculating ED for response level: ", ec, "%") + + # This is the structure of a row for a failed calculation + na_row <- data.frame( + Estimate = NA_real_, + stderr = NA_real_, + Lower = NA_real_, + Upper = NA_real_, + confint_level = CI_level, + confint_method = interval, + model = drm_name(mod), + EC = ec + ) + + # Use tryCatch to run ED() and capture any errors + ed_result = tryCatch({ + + # Attempt to calculate the ED value + res = drc::ED(mod, respLev = ec, interval = interval, + level = CI_level, display = FALSE, ... ) + + # Additional check: Is the estimate positive or NA? + if (is.na(res[1, "Estimate"]) || res[1, "Estimate"] <= 0) { + NULL + } else { + # If successful and positive, return the result + if(verbose) message("Successfully calculated ED for response level: ", ec, "%") + res # Return the result to be processed into a data frame + } + }, error = function(e) { + # If an error occurs (like the uniroot error), return NULL + if(verbose) message("Error calculating ED for response level: ", ec, "% - ", e$message) + NULL + }) # end of tryCatch + + + # If ed_result is NULL (due to error or non-positive estimate), return the NA row + if ( is.null(ed_result) ) { + return(na_row) + } else { + # If successful, process the result into a clean data frame + if(verbose) message("Appending info ...") + ed_df <- as.data.frame(ed_result) + # Handle interval types that don't include "Std. Error" (e.g., "fls", "tfls", "inv") + if ("Std. Error" %in% colnames(ed_df)) { + ed_df <- dplyr::rename(ed_df, stderr = "Std. Error") + } else { + ed_df$stderr <- NA_real_ + } + ed_df %>% + dplyr::mutate( + confint_level = CI_level, + confint_method = interval, + model = drm_name(mod), + EC = as.numeric(sub("^e.*[:]", "", rownames(ed_result))) + ) + } + }) + + # Combine the list of single-row data frames into one final data frame + return( data.table::rbindlist(results_list, use.names = TRUE) ) +} + + + +#' Robust Calculation of Model-Averaged Effective Doses +#' +#' @description +#' This function serves as a robust wrapper for `drc::maED`. It calculates +#' model-averaged effective doses (EDs) for specified response levels. The key +#' feature is its resilience to errors; it iterates through each response level +#' individually and handles failures gracefully by returning `NA` values for that +#' level, rather than terminating the entire operation. +#' +#' @details +#' The function enhances `drc::maED` by introducing a robust calculation loop. +#' It iterates over each element of `respLev` and calls `drc::maED` within a +#' `tryCatch` block. This approach isolates failures, preventing an error at one +#' response level (e.g., an EC99 that cannot be estimated) from halting the +#' calculation of others. +#' +#' Furthermore, after a successful calculation, the function checks if the +#' resulting 'Estimate' is positive. If the estimate is `NA`, non-positive, or +#' if the `tryCatch` block catches an error, the function returns a structured +#' row of `NA`s for that response level, ensuring a consistent output format. +#' +#' @param mod A model object of class 'drc', which serves as the base model for +#' the averaging. +#' @param fct_ls A list of alternative dose-response functions (e.g., `LL.3()`, +#' `W1.4()`) to be used in the model averaging process. The list should be +#' named. +#' @param respLev A numeric vector specifying the response levels (in +#' percentages) for which to calculate the EDs (e.g., `c(10, 50)` for EC10 +#' and EC50). +#' @param interval A character string specifying the type of confidence interval +#' to be supplied. The default is "buckland". See `drc::maED` for other options. +#' @param CI_level A numeric value between 0 and 1 specifying the confidence +#' level for the confidence intervals. Default is 0.95. +#' @param verbose A logical value. If `TRUE`, the function will print status +#' messages about the calculation progress and any errors encountered for each +#' response level. Default is `FALSE`. +#' @param ... Additional arguments to be passed to the underlying `drc::maED` +#' function. +#' +#' @return A `data.frame` with one row for each response level specified in +#' `respLev`. The columns are: +#' \item{Estimate}{The estimated model-averaged effective dose.} +#' \item{stderr}{The standard error of the estimate.} +#' \item{Lower}{The lower bound of the confidence interval.} +#' \item{Upper}{The upper bound of the confidence interval.} +#' \item{confint_level}{The confidence level used for the interval.} +#' \item{confint_method}{The method used for the confidence interval calculation.} +#' \item{model}{A character string listing the models used for averaging.} +#' \item{EC}{The response level (as a percentage).} +#' If the calculation for a specific response level fails or results in a +#' non-positive estimate, the corresponding row will contain `NA` values for +#' `Estimate`, `stderr`, `Lower`, and `Upper`. +#' +#' @seealso \code{\link[drc]{maED}} +#' +#' @author Hannes Reinwald +#' +#' @export +#' @importFrom dplyr %>% rename mutate +#' @importFrom data.table rbindlist +#' +#' @examples +#' data(lettuce) +#' base_model <- drm(weight ~ conc, data = lettuce, fct = BC.5()) +#' model_list <- list(W2.4 = W2.4()) +#' maED_robust(base_model, fct_ls = model_list, respLev = c(10, 50)) +#' +maED_robust <- function(mod, fct_ls = NULL, respLev = c(10, 20, 50), + interval = "buckland", + CI_level = 0.95, verbose = FALSE, ...) { + + # Use lapply to iterate over each response level. + # This will return a list of data frames (one for each level). + results_list <- lapply(respLev, function(ec) { + + # Pre-calculate the model name string, as it's needed for the NA row. + # This logic is taken directly from your original my_maED function. + model_name <- paste0(sub("[:].*$", "", c(mod$fct$name, names(fct_ls))), collapse = "/") + + # This is the structure of a row for a failed calculation. + na_row <- data.frame( + Estimate = NA_real_, + stderr = NA_real_, + Lower = NA_real_, + Upper = NA_real_, + confint_level = CI_level, + confint_method = interval, + model = model_name, + EC = ec + ) + + # Use tryCatch to run maED() and capture any errors. + ma_ed_result <- tryCatch({ + + # Attempt to calculate the model-averaged ED value for the single response level. + res <- drc::maED(mod, fctList = fct_ls, respLev = ec, interval = interval, + level = CI_level, display = FALSE, na.rm = TRUE, ...) + + # Additional check: Is the estimate positive and not NA? + if (is.na(res[1, "Estimate"]) || res[1, "Estimate"] <= 0) { + NULL + } else { + # If successful and positive, return the result. + if (verbose) message("Successfully calculated maED for response level: ", ec, "%") + res # Return the result to be processed into a data frame. + } + + }, error = function(e) { + # If an error occurs, return NULL. + if (verbose) message("Error calculating maED for response level: ", ec, "% - ", e$message) + NULL + }) # end of tryCatch + + # If ma_ed_result is NULL (due to error or non-positive estimate), return the NA row. + if (is.null(ma_ed_result)) { + return(na_row) + } else { + # If successful, process the result into a clean data frame. + if (verbose) message("Appending info ...") + ma_df <- as.data.frame(ma_ed_result) + # Handle interval types that don't include "Std. Error" (e.g., "fls", "tfls", "inv") + if ("Std. Error" %in% colnames(ma_df)) { + ma_df <- dplyr::rename(ma_df, stderr = "Std. Error") + } else { + ma_df$stderr <- NA_real_ + } + ma_df %>% + dplyr::mutate( + confint_level = CI_level, + confint_method = interval, + model = model_name, + EC = as.numeric(sub("^e.*[:]", "", rownames(ma_ed_result))) + ) + } + }) + + # Combine the list of single-row data frames into one final data frame. + return(data.table::rbindlist(results_list, use.names = TRUE)) +} \ No newline at end of file diff --git a/R/EDcomp.R b/R/EDcomp.R index 1cdb5a11..4e0fa109 100644 --- a/R/EDcomp.R +++ b/R/EDcomp.R @@ -1,3 +1,57 @@ +#' @title Comparison of relative potencies between dose-response curves +#' +#' @description +#' Relative potencies (also called selectivity indices) for arbitrary doses are compared between +#' fitted dose-response curves. +#' +#' @param object an object of class 'drc'. +#' @param percVec a numeric vector of dosage values. +#' @param percMat a matrix with 2 columns providing the pairs of indices of \code{percVec} to be +#' compared. By default all pairs are compared. +#' @param compMatch an optional character vector of names of assays to be compared. If not specified +#' all comparisons are supplied. +#' @param od logical. If TRUE adjustment for over-dispersion is used. This argument only makes a +#' difference for binomial data. +#' @param vcov. function providing the variance-covariance matrix. \code{\link{vcov}} is the default, +#' but \code{sandwich} is also an option (for obtaining robust standard errors). +#' @param reverse logical. If TRUE the order of comparison of two curves is reversed. +#' @param interval character string specifying the type of confidence intervals to be supplied. +#' The default is \code{"none"}. Use \code{"delta"} for asymptotics-based confidence intervals, +#' \code{"fieller"} for confidence intervals based on Fieller's theorem, or \code{"fls"} for +#' confidence intervals back-transformed from logarithm scale. +#' @param level numeric. The level for the confidence intervals. Default is 0.95. +#' @param reference character string. Is the upper limit or the control level the reference? +#' @param type character string specifying whether absolute or relative response levels are supplied. +#' @param display logical. If TRUE results are displayed. Otherwise they are not (useful in simulations). +#' @param pool logical. If TRUE curves are pooled. Otherwise they are not. This argument only works +#' for models with independently fitted curves as specified in \code{\link{drm}}. +#' @param logBase numeric. The base of the logarithm in case logarithm transformed dose values are used. +#' @param multcomp logical to switch on output for use with the package \pkg{multcomp}. Default is FALSE. +#' @param ... additional arguments passed to the function doing the calculations. +#' +#' @return An invisible matrix containing the estimates and the corresponding estimated standard +#' errors and possibly lower and upper confidence limits. Or, alternatively, a list with elements +#' that may be plugged directly into \code{parm} in the package \pkg{multcomp} (when \code{multcomp} +#' is TRUE). +#' +#' @details +#' Fieller's theorem is incorporated using the formulas provided by Kotz and Johnson (1983) and +#' Finney (1978). +#' +#' For objects of class 'braincousens' or 'mlogistic' the additional argument may be the 'upper' +#' argument or the 'interval' argument specifying limits for the bisection method. +#' +#' @seealso \code{\link{ED.drc}} for calculating effective doses. +#' +#' @examples +#' spinach.LL.4 <- drm(SLOPE~DOSE, CURVE, data = spinach, fct = LL.4()) +#' +#' EDcomp(spinach.LL.4, c(50, 50)) +#' EDcomp(spinach.LL.4, c(10, 50)) +#' EDcomp(spinach.LL.4, c(10, 50), reverse = TRUE) +#' +#' @author Christian Ritz +#' @keywords models nonlinear "EDcomp" <- function(object, percVec, percMat = NULL, compMatch = NULL, od = FALSE, vcov. = vcov, reverse = FALSE, interval = c("none", "delta", "fieller", "fls"), level = ifelse(!(interval == "none"), 0.95, NULL), @@ -13,9 +67,8 @@ display = TRUE, pool = TRUE, logBase = NULL, multcomp = FALSE, ...) { stop("Argument 'logBase' not specified for interval = 'fls'") } -# sifct <- createsifct(object$"fct"$"edfct", logBase, identical(interval, "fls"), object$"indexMat", length(coef(object))) - ## Checking contain of percVec vector ... should be numbers between 0 and 100 + ## Checking contents of percVec vector ... should be numbers between 0 and 100 if ( (type == "relative") && any(percVec<=0 | percVec>=100) ) { stop("Percentages outside the interval [0, 100] not allowed") @@ -27,22 +80,16 @@ display = TRUE, pool = TRUE, logBase = NULL, multcomp = FALSE, ...) ## Retrieving relevant quantities indexMat <- object$"indexMat" -# lenEB <- ncol(indexMat) parmMat <- object$"parmMat" -# strParm <- colnames(parmMat) -# varMat <- vcov(object, od = od, pool = pool) -## compNames <- as.character(strParm) # converting a factor curveNames <- colnames(object$"parmMat") - options(warn = -1) # switching off warnings caused by coercion in the if statement - if (any(is.na(as.numeric(curveNames)))) + if (any(suppressWarnings(is.na(as.numeric(curveNames))))) { curveOrder <- order(curveNames) } else { # if names are numbers then skip re-ordering curveOrder <- 1:length(curveNames) } - options(warn = 0) # normalizing behaviour of warnings strParm0 <- curveNames[curveOrder] indexMat <- indexMat[, curveOrder, drop = FALSE] @@ -52,30 +99,17 @@ display = TRUE, pool = TRUE, logBase = NULL, multcomp = FALSE, ...) parmMat <- parmMat[, curveOrder, drop = FALSE] strParm <- strParm0 -# varMat <- vcov(object, od = od, pool = pool) - varMat <- vcov.(object) + varMat <- vcov.(object) ## Calculating SI values numComp <- (lenPV*(lenPV-1)/2)*(lenEB * (lenEB - 1) / 2) - -# if (!identical(interval, "none")) -# { -# siMat <- matrix(0, numComp, 3) -# cNames <- c("Estimate", "Lower", "Upper") -# -# } else { -# siMat <- matrix(0, numComp, 4) -# cNames <- c("Estimate", "Std. Error", "t-value", "p-value") -# } matchVec <- rep(TRUE, numComp) rNames <- rep("", numComp) oriMat <- matrix(0, numComp, 2) degfree <- df.residual(object) rowIndex <- 1 - -# require(gtools, quietly = TRUE) - - pairsMat <- combinations(lenEB, 2) # canonical "2" as pairs are considered + + pairsMat <- combinations(lenEB, 2)# canonical "2" as pairs are considered if (is.null(percMat)) { percMat <- combinations(lenPV, 2) # canonical "2" as pairs are considered @@ -84,10 +118,7 @@ display = TRUE, pool = TRUE, logBase = NULL, multcomp = FALSE, ...) { pairsMat <- pairsMat[, 2:1, drop = FALSE] percMat <- percMat[, 2:1, drop = FALSE] -# strParm <- rev(strParm) } -# print(strParm) -# print(pairsMat) appFct1 <- function(percVal) { @@ -96,18 +127,13 @@ display = TRUE, pool = TRUE, logBase = NULL, multcomp = FALSE, ...) } SImat0 <- matrix(apply(percMat, 1, appFct1), nrow = nrow(pairsMat) * nrow(percMat), byrow = TRUE) SImat <- SImat0[, 1:4, drop = FALSE] -# print(SImat) - dSImat <- SImat0[, 5:ncol(SImat0), drop = FALSE] - -# matchVec[rowIndex] <- (is.null(compMatch) || all(c(strParm[j], strParm[k]) %in% compMatch)) - -# strParm0 <- sort(colnames(object$"parmMat")) + dSImat <- SImat0[, 5:ncol(SImat0), drop = FALSE] + appFct2 <- function(percVal) { apply(pairsMat, 1, function(indPair, percVal) { -# paste(strParm0[indPair[1]], "/", strParm0[indPair[2]], ":", percVec[percVal[1]], "/", percVec[percVal[2]], sep = "") paste(strParm[indPair[1]], "/", strParm[indPair[2]], ":", percVec[percVal[1]], "/", percVec[percVal[2]], sep = "") }, percVal = percVal) } @@ -118,7 +144,6 @@ display = TRUE, pool = TRUE, logBase = NULL, multcomp = FALSE, ...) apply(pairsMat, 1, function(indPair, percVal) { -# (is.null(compMatch) || all(c(strParm0[indPair[1]], strParm0[indPair[2]]) %in% compMatch)) (is.null(compMatch) || all(c(strParm[indPair[1]], strParm[indPair[2]]) %in% compMatch)) }) } @@ -126,16 +151,13 @@ display = TRUE, pool = TRUE, logBase = NULL, multcomp = FALSE, ...) if (!identical(interval, "none")) { - # siMat <- matrix(0, numComp, 3) SImat <- SImat[, -4, drop = FALSE] cNames <- c("Estimate", "Lower", "Upper") } else { -# siMat <- matrix(0, numComp, 4) cNames <- c("Estimate", "Std. Error", "t-value", "p-value") } - colnames(SImat) <- cNames -# print(SImat) + colnames(SImat) <- cNames ciLabel <- switch(interval, "delta" = "Delta method", @@ -143,15 +165,9 @@ display = TRUE, pool = TRUE, logBase = NULL, multcomp = FALSE, ...) "fls" = "From log scale", "fieller" = "Fieller") -# resPrint(SImat, "Estimated ratios of effect doses\n", interval, ciLabel, display = display) resPrint(SImat, "Estimated ratios of effect doses", interval, ciLabel, display = display) ## invisible(SImat) -# ## require(multcomp, quietly = TRUE) -## invisible(list(SImat, SImultcomp = list(EDest = EDmat[, 1], EDvcov = dEDmat %*% vcMat %*% t(dEDmat)))) -## these lines are older - -# invisible(list(SIdisplay = SImat, SImultcomp = list(SImat[, 1], dSImat %*% varMat %*% t(dSImat)))) if(multcomp) { @@ -161,150 +177,16 @@ display = TRUE, pool = TRUE, logBase = NULL, multcomp = FALSE, ...) colnames(SImat1VC) <- namesVec rownames(SImat1VC) <- namesVec -# invisible(list(multcomp = list(SImat[, 1], dSImat %*% varMat %*% t(dSImat)))) invisible(list(multcomp = parm(SImat1, SImat1VC))) } else { invisible(SImat) } - -# -# if (FALSE) -# { -# for (i in 1:lenPV) -# { -# for (ii in 1:lenPV) -# { -# if (i>=ii) {next} -# pVec <- percVec[c(i, ii)] -# -# for (j in 1:lenEB) -# { -# for (k in 1:lenEB) -# { -# if (j>=k) {next} -# matchVec[rowIndex] <- (is.null(compMatch) || all(c(strParm[j], strParm[k]) %in% compMatch)) -# -# jInd <- j -# kInd <- k -# if (reverse) -# { -# jInd <- k; kInd <- j; pVec <- pVec[c(2, 1)] -# } -# -# parmInd1 <- indexMat[, jInd] -# parmInd2 <- indexMat[, kInd] -# -# splInd <- splitInd(parmInd1, parmInd2) -# -# parmChosen1 <- parmMat[, jInd] -# parmChosen2 <- parmMat[, kInd] -# -# SIeval <- -# sifct(parmChosen1, parmChosen2, pVec, -# splInd[[1]][, 1], splInd[[2]][, 1], splInd[[3]][, 1], splInd[[3]][, 2], reference, type, jInd, kInd, ...) -# -# indInOrder <- c(splInd[[1]][, 2], splInd[[2]][, 2], splInd[[3]][, 3]) -# -# SIval <- SIeval$"val" # SIeval[[1]] -# dSIval <- SIeval$"der" # SIeval[[2]] -## print(dSIval) -# -# oriMat[rowIndex, 1] <- SIval -## oriMat[rowIndex, 2] <- sqrt(dSIval %*% varMat[indInOrder, indInOrder] %*% dSIval) # sqrt(dSIval%*%varCov%*%dSIval) -# oriMat[rowIndex, 2] <- sqrt(t(dSIval) %*% varMat %*% dSIval) -# -# siMat[rowIndex, 1] <- SIval -# rNames[rowIndex] <- paste(strParm[jInd], "/", strParm[kInd], ":", pVec[1], "/", pVec[2], sep="") -# -# ## Using t-distribution for continuous data -# ## only under the normality assumption -# if (identical(object$"type", "continuous")) -# { -# qFct <- function(x) {qt(x, degfree)} -# pFct <- function(x) {pt(x, degfree)} -# } else { -# qFct <- qnorm -# pFct <- pnorm -# } -# -# if (identical(interval, "none")) -# { -# siMat[rowIndex, 2] <- oriMat[rowIndex, 2] # sqrt(dSIval%*%varCov%*%dSIval) -# -# ## Testing SI equal to 1 -# tempStat <- (siMat[rowIndex, 1] - 1)/siMat[rowIndex, 2] -# siMat[rowIndex, 3] <- tempStat -# siMat[rowIndex, 4] <- pFct(-abs(tempStat)) + (1 - pFct(abs(tempStat))) -# } -# if ( (identical(interval, "delta")) || (identical(interval, "fls")) ) -# { -# stErr <- oriMat[rowIndex, 2] # sqrt(derEval%*%varCov%*%derEval) -# tquan <- qFct(1 - (1 - level)/2) -# -# siMat[rowIndex, 2] <- siMat[rowIndex, 1] - tquan * stErr -# siMat[rowIndex, 3] <- siMat[rowIndex, 1] + tquan * stErr -# ciLabel <- "Delta method" -# } -# if (identical(interval, "tfls")) -# { -# lsVal <- log(oriMat[rowIndex, 1]) -# lsdVal <- oriMat[rowIndex, 2]/oriMat[rowIndex, 1] -# tquan <- qFct(1 - (1 - level)/2) -# -# siMat[rowIndex, 2] <- exp(lsVal - tquan * lsdVal) -# siMat[rowIndex, 3] <- exp(lsVal + tquan * lsdVal) -# ciLabel <- "To and from log scale" -# } -# if ((!is.null(logBase)) && (identical(interval, "fls"))) -# { -# siMat[rowIndex, 1] <- logBase^(siMat[rowIndex, 1]) -# siMat[rowIndex, 2] <- logBase^(siMat[rowIndex, 2]) -# siMat[rowIndex, 3] <- logBase^(siMat[rowIndex, 3]) -# ciLabel <- "From log scale" -# } -# if (identical(interval, "fieller")) # using t-distribution -# { -# vcMat <- matrix(NA, 2, 2) -# vcMat[1, 1] <- SIeval$"der1"%*%varMat[parmInd1, parmInd1]%*%SIeval$"der1" -# vcMat[2, 2] <- SIeval$"der2"%*%varMat[parmInd2, parmInd2]%*%SIeval$"der2" -# vcMat[1, 2] <- SIeval$"der1"%*%varMat[parmInd1, parmInd2]%*%SIeval$"der2" -# vcMat[2, 1] <- vcMat[1, 2] -# muVec <- c(SIeval$"valnum", SIeval$"valden") -# -# siMat[rowIndex, 2:3] <- fieller(muVec, degfree, vcMat, level = level) -# ciLabel <- "Fieller" -# } -# -# -# rowIndex <- rowIndex+1 -# } -# } -# } -# } -# dimnames(siMat) <- list(rNames, cNames) -# siMat <- siMat[matchVec, , drop = FALSE] -# -# resPrint(siMat, "Estimated ratios of effect doses\n", interval, ciLabel, display = display) - -# if (display) -# { -# cat("\n") -# cat("Estimated ratios of effect doses\n") -# if (!(ci == "none")) -# { -# ciText <- paste("(", ciLabel, "-based confidence interval(s))\n", sep = "") -# cat(ciText) -# } -# cat("\n") -# printCoefmat(siMat) -# } -# invisible(siMat) } -#SI <- EDcomp - +#' @title Fieller's confidence interval +#' @keywords internal "fieller" <- function(mu, df, vcMat, level = 0.95, finney = FALSE, resVar) { @@ -351,13 +233,12 @@ function(mu, df, vcMat, level = 0.95, finney = FALSE, resVar) return(c(lowerL, upperL)) } +#' @title Split index vectors into shared and unique components +#' @keywords internal "splitInd" <- function(ind1, ind2) { - matchVec1 <- ind1%in%ind2 - matchVec2 <- ind2%in%ind1 - -# inCommon <- list(pos1 = (1:length(ind1))[matchVec1], pos2 = (1:length(ind2))[matchVec2], val = ind1[matchVec1]) -# + matchVec1 <- ind1 %in% ind2 + matchVec2 <- ind2 %in% ind1 lmv1 <- sum(matchVec1) if (lmv1 > 0.01) { @@ -366,15 +247,15 @@ function(mu, df, vcMat, level = 0.95, finney = FALSE, resVar) inCommon <- NULL } -# only1 <- list(pos = (1:length(ind1))[!matchVec1], val = ind1[!matchVec1]) only1 <- matrix( c( (1:length(ind1))[!matchVec1], ind1[!matchVec1] ), sum(!matchVec1), 2) - -# only2 <- list(pos = (1:length(ind2))[!matchVec2], val = ind2[!matchVec2]) + only2 <- matrix( c( (1:length(ind2))[!matchVec2], ind2[!matchVec2] ), sum(!matchVec2), 2) return(list(only1, only2, inCommon)) } +#' @title Create selectivity index function +#' @keywords internal createsifct <- function(edfct, logBase = NULL, fls = FALSE, indexMat, lenCoef) { if (is.null(edfct)) @@ -387,38 +268,20 @@ createsifct <- function(edfct, logBase = NULL, fls = FALSE, indexMat, lenCoef) if (is.null(logBase)) # this clause has been updated October 12 2010 { "sifct" <- function(parm1, parm2, pair, jInd, kInd, reference, type, ...) - ## ind1, ind2, cmonInd1, cmonInd2 not used { -# print(parm1) -# print(parm2) -# print(indexMat) - ED1 <- edfct(parm1, pair[1], reference = reference, type = type, ...) ED1v <- ED1[[1]] ED1d <- rep(0, lenCoef) -# print(indexMat[, jInd]) -# print(ED1[[2]]) ED1d[indexMat[, jInd]] <- ED1[[2]] -# print(ED1v) -# print(ED1d) ED2 <- edfct(parm2, pair[2], reference = reference, type = type, ...) ED2v <- ED2[[1]] ED2d <- rep(0, lenCoef) ED2d[indexMat[, kInd]] <- ED2[[2]] -# print(ED2v) -# print(ED2d) - - SIpair <- ED1v / ED2v # calculating the SI value - SIder <- (ED1d - SIpair * ED2d) / ED2v # calculating the derivative of SI + SIpair <- ED1v / ED2v + SIder <- (ED1d - SIpair * ED2d) / ED2v -# SIder1 <- ED1d/ED2v -# SIder2 <- (-ED2d/ED2v)*SIpair -# SIder12 <- commonParm(SIder1, SIder2, cmonInd1, cmonInd2) -# SIder12 <- ED1d/ED2v - (ED2d/ED2v)*SIpair - -# return(list(val = SIpair, der = c(SIder1[ind1], SIder2[ind2], SIder12), return(list(val = SIpair, der = SIder, der1 = ED1d, der2 = ED2d, valnum = ED1v, valden = ED2v)) } @@ -436,21 +299,9 @@ createsifct <- function(edfct, logBase = NULL, fls = FALSE, indexMat, lenCoef) ED2d <- rep(0, lenCoef) ED2d[indexMat[, kInd]] <- ED2[[2]] -# ED1 <- edfct(parm1, pair[1], reference = reference, type = type, ...) -# ED1v <- ED1[[1]] -# ED1d <- ED1[[2]] -# ED2 <- edfct(parm2, pair[2], reference = reference, type = type, ...) -# ED2v <- ED2[[1]] -# ED2d <- ED2[[2]] - - SIpair <- logBase^(ED1v - ED2v) # calculating the SI value + SIpair <- logBase^(ED1v - ED2v) SIder <- SIpair * log(logBase) * (ED1d - ED2d) - -# SIder1 <- SIpair*log(logBase)*ED1d -# SIder2 <- SIpair*log(logBase)*(-ED2d) -# SIder12 <- commonParm(SIder1, SIder2, cmonInd1, cmonInd2) -# return(list(val = SIpair, der = c(SIder1[ind1], SIder2[ind2], SIder12), return(list(val = SIpair, der = SIder, der1 = (log(logBase)*logBase^ED1v)*ED1d, der2 = (log(logBase)*logBase^ED2v)*ED2d, valnum = logBase^ED1v, valden = logBase^ED2v)) @@ -470,21 +321,9 @@ createsifct <- function(edfct, logBase = NULL, fls = FALSE, indexMat, lenCoef) ED2d <- rep(0, lenCoef) ED2d[indexMat[, kInd]] <- ED2[[2]] -# ED1 <- edfct(parm1, pair[1], reference = reference, type = type, ...) -# ED1v <- ED1[[1]] -# ED1d <- ED1[[2]] -# ED2 <- edfct(parm2, pair[2], reference = reference, type = type, ...) -# ED2v <- ED2[[1]] -# ED2d <- ED2[[2]] - - SIpair <- ED1v - ED2v # calculating the log SI value + SIpair <- ED1v - ED2v SIder <- ED1d - ED2d - -# SIder1 <- ED1d -# SIder2 <- -ED2d -# SIder12 <- commonParm(SIder1, SIder2, cmonInd1, cmonInd2) -# return(list(val = SIpair, der = c(SIder1[ind1], SIder2[ind2], SIder12), return(list(val = SIpair, der = SIder, der1 = ED1d, der2 = ED2d, valnum = ED1v, valden = ED2v)) } @@ -493,16 +332,3 @@ createsifct <- function(edfct, logBase = NULL, fls = FALSE, indexMat, lenCoef) } } -#commonParm <- function(SIder1, SIder2, cmonInd1, cmonInd2) -#{ -# lind1 <- length(cmonInd1) -# retVec <- rep(NA, lind1) -# for (i in 1:lind1) -# { -# retVec[i] <- SIder1[cmonInd1[i]] + SIder2[cmonInd2[i]] -# -# } -# return(retVec) -#} -# - diff --git a/R/EDhelper.R b/R/EDhelper.R index 9675a7df..aa3a769c 100644 --- a/R/EDhelper.R +++ b/R/EDhelper.R @@ -1,3 +1,5 @@ +#' @title Helper function for ED calculations +#' @keywords internal "EDhelper" <- function(parmVec, respl, reference, typeCalc, cond = TRUE) { ## Works for log-logistic type dose-response models @@ -6,7 +8,6 @@ if (typeCalc == "absolute") { p <- 100 * ((parmVec[3] - respl) / (parmVec[3] - parmVec[2])) -# typeCalc <- "relative" } else { p <- respl } diff --git a/R/EDinvreg.R b/R/EDinvreg.R index 82b25e42..7c4ceab7 100644 --- a/R/EDinvreg.R +++ b/R/EDinvreg.R @@ -1,54 +1,56 @@ -"EDinvreg" <- function(object, respLev, catLev = NA, intType = "confidence", level, type, extFactor = 10) -{ - if (!is.na(catLev)) - { - EDval <- ED(object, respLev, clevel = catLev, type = type, display = FALSE) - } else { - EDval <- ED(object, respLev, type = type, display = FALSE) - } - EDval1.1 <- EDval[1, 1] - newData0 <- data.frame(EDval[, 1], catLev) - - objDL <- object[["dataList"]][["names"]] - colnames(newData0) <- c(objDL[["dName"]], objDL[["cName"]]) - yval <- predict(object, newData0) - # print(yval) - - rootFct1 <- function(x) - { - newData <- data.frame(x, catLev) - colnames(newData) <- c(objDL[["dName"]], objDL[["cName"]]) -# print(c(x, predict(object, newData, interval = intType, level = level)[2] - yval)) - predict(object, newData, interval = intType, level = level)[2] - yval - } - - rootFct2 <- function(x) - { - newData <- data.frame(x, catLev) - colnames(newData) <- c(objDL[["dName"]], objDL[["cName"]]) -# print(c(x, predict(object, newData, interval = intType, level = level)[3] - yval)) - predict(object, newData, interval = intType, level = level)[3] - yval - } - - maxdose <- extFactor * max(object[["dataList"]][["dose"]]) - uroot1 <- try(uniroot(rootFct1, c(EDval1.1, maxdose)), silent = TRUE) - if (inherits(uroot1, "try-error")) # an error happens in case of a decreasing curve - { - # print(c(0, EDval1.1)) - uroot2 <- try(uniroot(rootFct1, c(0, EDval1.1)), silent = TRUE) - #if (inherits(uroot2, "try-error")) {lowlim <- 0} else {lowlim <- uroot2[["root"]]} - uroot1 <- try(uniroot(rootFct2, c(EDval1.1, maxdose)), silent = TRUE) - #if (inherits(uroot1, "try-error")) {uplim <- Inf} else {uplim <- uroot2[["root"]]} - } else { - uroot2 <- try(uniroot(rootFct2, c(0, EDval1.1)), silent = TRUE) - } - if (inherits(uroot1, "try-error")) {uplim <- Inf} else {uplim <- uroot1[["root"]]} - if (inherits(uroot2, "try-error")) {lowlim <- 0} else {lowlim <- uroot2[["root"]]} - - - #return(c(uroot2[["root"]], uroot1[["root"]])) - return(c(lowlim, uplim)) -} - - -EDinvreg1 <- Vectorize(EDinvreg, "respLev") +#' @title Inverse regression for ED estimation +#' @keywords internal +"EDinvreg" <- function(object, respLev, catLev = NA, intType = "confidence", level, type, extFactor = 10) +{ + if (!is.na(catLev)) + { + EDval <- ED(object, respLev, clevel = catLev, type = type, display = FALSE) + } else { + EDval <- ED(object, respLev, type = type, display = FALSE) + } + EDval1.1 <- EDval[1, 1] + newData0 <- data.frame(EDval[, 1], catLev) + + objDL <- object[["dataList"]][["names"]] + colnames(newData0) <- c(objDL[["dName"]], objDL[["cName"]]) + yval <- predict(object, newData0) + # print(yval) + + rootFct1 <- function(x) + { + newData <- data.frame(x, catLev) + colnames(newData) <- c(objDL[["dName"]], objDL[["cName"]]) +# print(c(x, predict(object, newData, interval = intType, level = level)[2] - yval)) + predict(object, newData, interval = intType, level = level)[2] - yval + } + + rootFct2 <- function(x) + { + newData <- data.frame(x, catLev) + colnames(newData) <- c(objDL[["dName"]], objDL[["cName"]]) +# print(c(x, predict(object, newData, interval = intType, level = level)[3] - yval)) + predict(object, newData, interval = intType, level = level)[3] - yval + } + + maxdose <- extFactor * max(object[["dataList"]][["dose"]]) + uroot1 <- try(uniroot(rootFct1, c(EDval1.1, maxdose)), silent = TRUE) + if (inherits(uroot1, "try-error")) # an error happens in case of a decreasing curve + { + # print(c(0, EDval1.1)) + uroot2 <- try(uniroot(rootFct1, c(0, EDval1.1)), silent = TRUE) + #if (inherits(uroot2, "try-error")) {lowlim <- 0} else {lowlim <- uroot2[["root"]]} + uroot1 <- try(uniroot(rootFct2, c(EDval1.1, maxdose)), silent = TRUE) + #if (inherits(uroot1, "try-error")) {uplim <- Inf} else {uplim <- uroot2[["root"]]} + } else { + uroot2 <- try(uniroot(rootFct2, c(0, EDval1.1)), silent = TRUE) + } + if (inherits(uroot1, "try-error")) {uplim <- Inf} else {uplim <- uroot1[["root"]]} + if (inherits(uroot2, "try-error")) {lowlim <- 0} else {lowlim <- uroot2[["root"]]} + + + #return(c(uroot2[["root"]], uroot1[["root"]])) + return(c(lowlim, uplim)) +} + + +EDinvreg1 <- Vectorize(EDinvreg, "respLev") diff --git a/R/Rsq.R b/R/Rsq.R index c15787ed..dada2787 100644 --- a/R/Rsq.R +++ b/R/Rsq.R @@ -1,3 +1,22 @@ +#' R-squared for dose-response models +#' +#' Calculates and displays R-squared values for a fitted dose-response model. For models +#' with multiple curves, per-curve and total R-squared values are returned. +#' +#' R-squared is computed as \eqn{1 - RSS / TSS} where RSS is the residual sum of squares +#' (obtained via [rss()]) and TSS is the total sum of squares. +#' +#' @param object an object of class 'drc'. +#' +#' @return Invisibly returns a matrix of R-squared values. For single-curve models, a 1x1 matrix. +#' For multi-curve models, includes per-curve values and a total R-squared. +#' +#' @seealso [rss()] for the underlying residual sum of squares. +#' +#' @author Christian Ritz +#' +#' @keywords models nonlinear +#' @export "Rsq" <- function(object) { response <- object$data[,2] @@ -5,20 +24,26 @@ uniCurve <- unique(curve) lenUC <- length(uniCurve) - numerator <- tapply( residuals(object)^2, curve, sum) # residual ss + ## Use rss() for the residual sum of squares + rssMat <- rss(object, print = FALSE) + numerator <- rssMat[seq_len(lenUC), 1] denominator <- tapply( (response - mean(response))^2, curve, sum) # total SS - totnum <- sum(residuals(object)^2) + totnum <- if (lenUC == 1) numerator else rssMat[lenUC + 1, 1] totden <- sum((response - mean(response))^2) + ## Handle zero denominator (constant response) to avoid NaN + rsqVals <- ifelse(denominator == 0, NA_real_, 1 - numerator / denominator) + totRsq <- ifelse(totden == 0, NA_real_, 1 - totnum / totden) + if (lenUC==1) { hText <- "\nR-square value\n" - rsq <- matrix(c(1 - numerator/denominator), 1, 1) + rsq <- matrix(rsqVals, 1, 1) rownames(rsq) <- "" } else { hText <- "\nR-square values\n" - rsq <- matrix(c(1 - numerator/denominator, 1-totnum/totden), lenUC+1, 1) + rsq <- matrix(c(rsqVals, totRsq), lenUC+1, 1) rownames(rsq) <- c(as.character(uniCurve), "Total") } colnames(rsq) <- "" diff --git a/R/absToRel.R b/R/absToRel.R index d6debccd..d9f0a357 100644 --- a/R/absToRel.R +++ b/R/absToRel.R @@ -1,9 +1,28 @@ +#' Convert absolute to relative response levels +#' +#' Internal helper that converts an absolute response level to a relative (percentage) scale +#' based on the upper and lower asymptotes of a dose-response curve. +#' +#' @param parmVec numeric vector of model parameters where the third element is the upper +#' asymptote and the second element is the lower asymptote. +#' @param respl numeric response level to convert. +#' @param typeCalc character string. If "absolute", the conversion is performed; +#' otherwise the input \code{respl} is returned unchanged. +#' +#' @return A numeric value representing the (possibly converted) response level as a percentage. +#' +#' @keywords internal "absToRel" <- function(parmVec, respl, typeCalc) { ## Converting absolute to relative if (typeCalc == "absolute") { - p <- 100 * ((parmVec[3] - respl) / (parmVec[3] - parmVec[2])) + denom <- parmVec[3] - parmVec[2] + if (denom == 0) + { + stop("Cannot convert absolute to relative response: upper and lower asymptotes are equal") + } + p <- 100 * ((parmVec[3] - respl) / denom) } else { p <- respl } diff --git a/R/anova.drc.R b/R/anova.drc.R index 404c97ee..64e4b346 100644 --- a/R/anova.drc.R +++ b/R/anova.drc.R @@ -1,3 +1,61 @@ +#' @title ANOVA Model Comparison for Dose-Response Models +#' +#' @description +#' Compares two nested dose-response model fits using a likelihood-ratio test +#' (for binomial data) or an F-test (for continuous data). Two \code{drc} +#' objects must be provided. For a lack-of-fit test of a single model, use +#' \code{\link{modelFit}} instead. +#' +#' @param object an object of class \sQuote{drc}. +#' @param ... a second object of class \sQuote{drc} to compare against +#' \code{object}. Exactly two models must be supplied; passing a single +#' model will result in an error directing the user to +#' \code{\link{modelFit}}. +#' @param details logical indicating whether or not details on the models +#' compared should be displayed. Default is \code{TRUE} (details are +#' displayed). +#' @param test a character string specifying the test statistic to be applied. +#' For continuous data the default is \code{"F"} (F-test); for binomial data +#' the default is \code{"Chisq"} (likelihood-ratio test). Use \code{"Chisq"} +#' to force a likelihood-ratio test for continuous data. +#' +#' @return An object of class \sQuote{anova} (inheriting from +#' \code{data.frame}) with columns for model degrees of freedom, residual +#' sum of squares (or log-likelihood), the difference in degrees of freedom, +#' the test statistic, and the p-value. +#' +#' @details +#' Two \code{drc} objects must be specified. The function performs a test for +#' reduction from the larger to the smaller model. This only makes statistical +#' sense if the models are nested, that is: one model is a submodel of the +#' other model. +#' +#' For continuous data an F-test is used by default. For binomial data a +#' likelihood-ratio (chi-square) test is used by default. +#' +#' If a single model is passed, the function raises an error. To assess the +#' fit of a single dose-response model (lack-of-fit test comparing the model +#' to a more general ANOVA model), use \code{\link{modelFit}} instead. +#' +#' @examples +#' ## Comparing two nested models (two-model comparison) +#' ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) +#' ryegrass.m2 <- drm(rootl ~ conc, data = ryegrass, fct = W1.3()) +#' anova(ryegrass.m2, ryegrass.m1) +#' +#' anova(ryegrass.m2, ryegrass.m1, details = FALSE) # without details +#' +#' ## For a lack-of-fit test on a single model, use modelFit(): +#' modelFit(ryegrass.m1) +#' +#' @seealso \code{\link{modelFit}} for lack-of-fit testing of a single model, +#' \code{\link{drm}} for fitting dose-response models, +#' \code{\link{logLik.drc}} for log-likelihood extraction, +#' \code{\link{summary.drc}} for model summaries. +#' +#' @author Christian Ritz, Hannes Reinwald +#' +#' @keywords models nonlinear "anova.drc" <- function(object, ..., details = TRUE, test = NULL) { @@ -5,201 +63,6 @@ function(object, ..., details = TRUE, test = NULL) { return(anova.drclist(object, ..., details = details, test = test)) } else { -# obj1 <- object - stop("Use the function modelFit()") -# modelFit(object, test = test) + stop("Only a single model provided! This function requires at least two model objects. Use the function modelFit() instead") } - -# if (inherits(object, "bindrc")) -# { -# loglik <- object$loglik[c(1, 3)] -# dfModel <- object$loglik[c(2, 4)] -# dfDiff <- c(NA, (dfModel[2] - dfModel[1])) -# -# testStat <- 2*(loglik[1] - loglik[2]) -# pVal <- c(NA, 1 - pchisq(testStat, dfDiff[2])) -# testStat <- c(NA, testStat) -# -# headName<-"Analysis of deviance table\n" -# rowNames<-c("Saturated model", "DRC model") -# colNames<-c("ModelDf", "Loglik", "Df", "LR value", "p value") -# -# dataFra <- data.frame(dfModel, loglik, dfDiff, testStat, pVal) -# -# dimnames(dataFra) <- list(rowNames, colNames) -# structure(dataFra, heading=headName, class=c("anova", "data.frame")) -# -# } else { - - ## Testing against ANOVA -# listElt <- obj1[[4]] -# -# wayStr <- obj1$"sumList"$"alternative" -# if (wayStr == 1) {wayStr <- "One-way"} -# if (wayStr == 2) {wayStr <- "Two-way"} - - -# anovaSS <- listElt[3] -# anovaDF <- listElt[4] -# nlsSS <- listElt[5] -# nlsDF <- listElt[6] - - -# anovaModel <- obj1$"anova" -# if ( (!is.null(anovaModel)) && (is.null(test)) ) -# { -# anovaDF <- df.residual(anovaModel$"anovaFit") -# nlsDF <- df.residual(obj1) -# dfModel <- c(anovaDF, nlsDF) -# dfDiff <- c(NA, (nlsDF - anovaDF)) -# -# if (anovaModel$"test"=="F") -# { -# anovaSS <- deviance(anovaModel$"anovaFit") -# anovaDF <- df.residual(anovaModel$"anovaFit") -# dfModel <- c(anovaDF, nlsDF) -# nlsSS <- obj1$"fit"$"value" -## nlsDF <- df.residual(obj1) -# -# loglik <- c(anovaSS, nlsSS) -## dfModel <- c(anovaDF, nlsDF) -## dfDiff <- c(NA, (nlsDF-anovaDF)) -# -# testStat <- (nlsSS-anovaSS)/dfDiff[2]/(anovaSS/anovaDF) -# pVal <- c(NA, pf(testStat,dfDiff[2], anovaDF, lower.tail=FALSE)) -# testStat <- c(NA, testStat) -# -# headName<-"Lack-of-fit test\n" -# rowNames<-c(paste(wayStr, "ANOVA"), "DRC model") -# colNames<-c("ModelDf", "RSS", "Df", "F value", "p value") -# } -# -# if (anovaModel$"test"=="lr") -# { -# anovaDF <- anovaDF + (obj1$"sumList"$"lenData" - dim(anovaModel$"anovaFit"$"data")[1]) -# dfModel <- c(anovaDF, nlsDF) -# dfDiff <- c(NA, (nlsDF - anovaDF)) -# -# loglik <- c(logLik(anovaModel$"anovaFit"), logLik(obj1)) -# -# testStat <- 2*(loglik[1]-loglik[2]) -# pVal <- c(NA, 1 - pchisq(testStat, dfDiff[2])) -# testStat <- c(NA, testStat) -# -# headName <- "Goodness-of-fit test\n" -# rowNames <- c(paste(wayStr, "ANOVA"), "DRC model") -# colNames <- c("ModelDf", "Log lik", "Df", "Chisq value", "p value") -# } -# } -# if ( (is.null(anovaModel)) || ( (!is.null(test)) && (test == "od") ) ) -# { -## else { -## gof <- (obj1$"fct"$"gofTest")(obj1) -# gofTest <- obj1$"gofTest" -# if (!is.null(gofTest)) -# { -## gof <- gofTest(obj1) -# -# lenData <- obj1$"sumList"$"lenData" -# dfModel <- c(NA, NA) -# loglik <- c(NA, NA) -# dfDiff <- c(NA, gofTest[2]) -# testStat <- c(NA, gofTest[1]) -# pVal <- c(NA, 1 - pchisq(testStat[2], dfDiff[2])) -# -# headName <- "Goodness-of-fit test\n" -# rowNames <- c("", "DRC model") -# colNames <- c("", "", "Df", "Chisq value", "p value") -# } else { # in case no test is available -# dfModel <- c(NA, NA) -# loglik <- c(NA, NA) -# dfDiff <- c(NA, NA) -# testStat <- c(NA, NA) -# pVal <- c(NA, NA) -# headName <- "No test available\n" -# rowNames <- c("", "DRC model") -# colNames <- c("ModelDf", "Log lik", "Df", "Chisq value", "p value") -# } -# -## headName<-"Goodness-of-fit test\n" -## rowNames<-c("", "DRC model") -## colNames<-c("ModelDf", "", "Df", "Chisq value", "p value") -# } -# if ( (!is.null(anovaModel)) && (!is.null(test)) && (test == "Chisq") ) # overruling any previous calculations! -# { -# lv1 <- logLik(anovaModel$"anovaFit") -# lv2 <- logLik(obj1) -# -# dfModel <- c(attr(lv1, "df"), attr(lv2, "df")) -# loglik <- c(lv1, lv2) -# dfDiff <- c(NA, diff(dfModel)) # dfModel[1] - dfModel[2]) -# -# testStat <- -2*(lv2 - lv1) -# pVal <- c(NA, pchisq(testStat, dfDiff[2], lower.tail = FALSE)) -# testStat <- c(NA, testStat) -# -# headName <- "Lack-of-fit test\n" -# rowNames <- c(paste(wayStr, "ANOVA"), "DRC model") -# colNames <- c("ModelDf", "Log lik", "Df", "Chisq value", "p value") -# } - - -# loglik <- c(anovaSS, nlsSS) -# dfModel <- c(anovaDF, nlsDF) -# dfDiff <- c(NA, (nlsDF-anovaDF)) - -# testStat <- (nlsSS-anovaSS)/dfDiff[2]/(anovaSS/anovaDF) -# pVal <- c(NA, pf(testStat,dfDiff[2], anovaDF, lower.tail=FALSE)) -# testStat <- c(NA, testStat) - -# headName<-"ANOVA table\n" -# rowNames<-c(paste(wayStr, "ANOVA"), "DRC model") -# colNames<-c("ModelDf", "RSS", "Df", "F value", "p value") - -# dataFra <- data.frame(dfModel, loglik, dfDiff, testStat, pVal) -# -# dimnames(dataFra) <- list(rowNames, colNames) -# structure(dataFra, heading = headName, class = c("anova", "data.frame")) -# } - -# ## Testing two models against each other -# if (!anovaTest) -# { -# rowNames <- c(deparse(substitute(obj1)), deparse(substitute(obj2))) -# -# sumObj1 <- summary(obj1) -# sumObj2 <- summary(obj2) -# -# if (!Ftest) -# { -# loglik <- c(sumObj1[[4]][1],sumObj2[[4]][1]) -# dfModel <- c(sumObj1[[4]][2],sumObj2[[4]][2]) -# testStat <- (2*abs(loglik[1]-loglik[2])) -# dfDiff <- c(NA,abs(dfModel[1]-dfModel[2])) -# -# pVal <- c(NA,1-pchisq(testStat,dfDiff[2])) -# testStat <- c(NA,testStat) -# -# headName <- "ANOVA-like table\n" -# colNames <- c("ModelDf", "Loglik", "Df", "LR value", "p value") -# } else { -# -# sumVec1 <- obj1[[4]] -# sumVec2 <- obj2[[4]] -# -# if (sumVec2[6]>sumVec1[6]) {sumTemp <- sumVec1; sumVec1 <- sumVec2; sumVec2 <- sumTemp; rowNames <- rowNames[c(2,1)]} -# -# loglik <- c(sumVec1[5],sumVec2[5]) -# dfModel <- c(sumVec1[6],sumVec2[6]) -# dfDiff <- c((loglik[1]-loglik[2])/(dfModel[1]-dfModel[2]), loglik[2]/dfModel[2]) -# testStat <- dfDiff[1]/dfDiff[2] -# -# pVal <- c(NA,1-pf(testStat, dfModel[1]-dfModel[2], dfModel[2])) -# testStat <- c(NA,testStat) -# -# headName <- "ANOVA table\n" -# colNames <- c("Df", "Sum Sq", "Mean Sq", "F value", "p value") -# } -# } - } diff --git a/R/anova.drclist.R b/R/anova.drclist.R index cc04a470..dffd0083 100644 --- a/R/anova.drclist.R +++ b/R/anova.drclist.R @@ -1,215 +1,161 @@ -"anova.drclist" <- function(object, ..., details = TRUE, test = NULL) -{ - objects <- list(object, ...) - if (length(objects) > 2) {stop("Only two models can be compared")} - -# if (inherits(object, "bindrc")) # the argument 'test="F"' is not used -# { -# obj1 <- objects[[1]]$loglik -# obj2 <- objects[[2]]$loglik -# rowNames <- c("Model 1", "Model 2") -# -# -# loglik <- c(obj1[3], obj2[3]) -# dfModel <- c(obj1[4], obj2[4]) -# testStat <- (2*abs(loglik[1] - loglik[2])) -# dfDiff <- c(NA, abs(dfModel[1] - dfModel[2])) -# -# pVal <- c(NA, 1 - pchisq(testStat, dfDiff[2])) -# testStat <- c(NA, testStat) -# -# headName <- "Analysis of deviance table\n" -# colNames <- c("ModelDf", "Loglik", "Df", "LR value", "p value") -# -# } else { - - ## Testing two models against each other - obj1 <- objects[[1]] - obj2 <- objects[[2]] - rowNames <- c("1st model", "2nd model") - -# sumObj1 <- summary(obj1) -# sumObj2 <- summary(obj2) - - if ( !(obj1$"type"==obj2$"type") ) {stop("The two models are based on different types on data")} - if (obj1$"type" == "binomial" && (is.null(test)) ) {test <- "Chisq"} - if (obj1$"type" == "continuous" && (is.null(test)) ) {test <- "F"} - - if (!(test == "F")) # chis-square based test - { - loglik <- c(logLik(obj1), logLik(obj2)) # c(sumObj1[[4]][1], sumObj2[[4]][1]) - dfModel <- c(attr(logLik(obj1), "df"), attr(logLik(obj2), "df")) # c(sumObj1[[4]][2], sumObj2[[4]][2]) - testStat <- (2*abs(loglik[1] - loglik[2])) - dfDiff <- c(NA, abs(dfModel[1] - dfModel[2])) - - pVal <- c(NA, 1 - pchisq(testStat, dfDiff[2])) - testStat <- c(NA, testStat) - - headName <- "ANOVA-like table\n" - colNames <- c("ModelDf", "Loglik", "Df", "LR value", "p value") - - } else { # F-test -# sumVec1 <- obj1$"summary" -# sumVec2 <- obj2$"summary" - - df1 <- df.residual(obj1) - df2 <- df.residual(obj2) - if (df2 > df1) - { - objTemp <- obj1 - obj1 <- obj2 - obj2 <- objTemp - df1 <- df.residual(obj1) - df2 <- df.residual(obj2) - - rowNames <- rowNames[c(2, 1)] - } -# if (sumVec2[6]>sumVec1[6]) -# {sumTemp <- sumVec1; sumVec1 <- sumVec2; sumVec2 <- sumTemp; rowNames <- rowNames[c(2,1)]} - -# loglik <- c(sumVec1[5],sumVec2[5]) - loglik <- c(obj1$"summary"[4], obj2$"summary"[4]) # use an extractor "rss()" instead? -# dfModel <- c(sumVec1[6], sumVec2[6]) - dfModel <- c(df1, df2) - -# loglikTemp <- c(sumVec1[5], sumVec2[5]) -# loglik <- c((loglikTemp[1]-loglikTemp[2])/(dfModel[1]-dfModel[2]), loglikTemp[2]/dfModel[2]) -# dfModel <- c(sumVec1[6], sumVec2[6]) -# dfDiff <- c((loglik[1]-loglik[2])/(dfModel[1]-dfModel[2]), loglik[2]/dfModel[2]) - -# dfDiff <- c(NA, dfModel[1] - dfModel[2]) - dfDiff <- c(NA, df1 - df2) - -# testStat <- dfDiff[1]/dfDiff[2] - testStat <- ((loglik[1] - loglik[2]) / dfDiff[2]) / (loglik[2] / df2) - pVal <- c(NA, 1 - pf(testStat, dfDiff[2], df2)) - testStat <- c(NA, testStat) - - headName <- "ANOVA table\n" - colNames <- c("ModelDf", "RSS", "Df", "F value", "p value") - } -# dataFra <- data.frame(dfModel, loglik, dfDiff, testStat, pVal) - - - if (details) - { - ## Specifying the models - cat("\n") - - collapse1 <- obj1[[8]]$collapse - if (is.null(collapse1)) {collapse1 <- obj1[[8]]$pmodels} - if (!is.null(obj1$"pmodelsText")) {collapse1 <- obj1$"pmodelsText"} -# print(collapse1) - -# if (is.null(collapse1)) {collapse1 <- paste(deparse(obj1[[8]]$assayNo), "(for all parameters)")} else {collapse1 <- deparse(obj1[[8]]$collapse)} - if (is.null(collapse1)) - { - if (is.null(obj1[[8]]$curve)) - { - collapse1 <- "1 (for all parameters)" - } else { - collapse1 <- paste(deparse(obj1[[8]]$curve), "(for all parameters)") - } - } else { -# collapse1 <- paste(deparse(obj1[[8]]$collapse), collapse="") - if (!is.character(collapse1)) - { - collapse1 <- paste(deparse(collapse1), collapse = "") - } -# collapse1 <- paste(deparse(collapse1), collapse = "") - collapse1 <- gsub(" ", "", collapse1, fixed = TRUE) # removing extra spaces - } - -# pos <- 1 -# if (is.data.frame(eval(collapse1))) - pos <- regexpr("data.frame(", collapse1, fixed = TRUE) - if (pos > 0) - { -# collapse1 <- deparse(obj1[[8]]$collapse) -# collapse1 <- substring(collapse1, pos+11, nchar(collapse1)-1) - collapse1 <- substring(collapse1, 12, nchar(collapse1)-1) - } -# if (is.list(eval(collapse1))) - pos <- regexpr("list(", collapse1, fixed=TRUE) - if (pos > 0) - { -# collapse1 <- deparse(obj1[[8]]$collapse) -# collapse1 <- substring(collapse1, pos+5, nchar(collapse1)-1) - collapse1 <- substring(collapse1, 6, nchar(collapse1)-1) - } - - collapse2 <- obj2[[8]]$collapse - if (is.null(collapse2)) {collapse2 <- obj2[[8]]$pmodels} - if (!is.null(obj2$"pmodelsText")) {collapse2 <- obj2$"pmodelsText"} -# print(collapse2) - -# if (is.null(collapse2)) {collapse2 <- paste(deparse(obj2[[8]]$assayNo), "(for all parameters)")} else {collapse2 <- deparse(obj2[[8]]$collapse)} - if (is.null(collapse2)) - { - if (is.null(obj2[[8]]$curve)) - { - collapse2 <- "1 (for all parameters)" - } else { - collapse2 <- paste(deparse(obj2[[8]]$curve), "(for all parameters)") - } - } else { -# collapse2 <- paste(deparse(obj2[[8]]$collapse), collapse = "") - if (!is.character(collapse2)) - { - collapse2 <- paste(deparse(collapse2), collapse = "") - } -# collapse2 <- paste(deparse(collapse2), collapse = "") - collapse2 <- gsub(" ", "", collapse2, fixed = TRUE) # removing extra spaces - } - -# if (is.data.frame(eval(collapse2))) - pos <- regexpr("data.frame(", collapse2, fixed = TRUE) - if (pos > 0) - { -# collapse2 <- deparse(obj2[[8]]$collapse) -# collapse2 <- substring(collapse2, pos+11, nchar(collapse2)-1) - collapse2 <- substring(collapse2, 12, nchar(collapse2) - 1) - } - -# if (is.list(eval(collapse2))) - pos <- regexpr("list(", collapse2, fixed = TRUE) - if (pos > 0) - { -# collapse2 <- deparse(obj2[[8]]$collapse) -# collapse2 <- substring(collapse2, pos+5, nchar(collapse2)-1) - collapse2 <- substring(collapse2, 6, nchar(collapse2) - 1) - } - - - ## Omitting collapse line if content is the same in both lines - if (identical(collapse1, collapse2)) {colLine <- FALSE} else {colLine <- TRUE} - - if ( (!is.null(obj1[[8]]$pmodels)) || (!is.null(obj2[[8]]$pmodels)) ) - { - fctStart <- " fct: " - colStart <- " pmodels: " - } else { - fctStart <- " fct: " - colStart <- " pmodels: " - # changed July 4 2011 - } - cat("1st model\n") - fctInfo <- ifelse(is.null(obj1$"text"), deparse(obj1[[8]]$fct), obj1$"text") - cat(paste(fctStart, fctInfo, "\n", sep = "")) -# cat(paste(fctStart, deparse(obj1[[8]]$fct), "\n", sep = "")) -# if (colLine) {cat(paste(" collapse: ", collapse1, "\n", sep=""))} - if (colLine) {cat(paste(colStart, collapse1, "\n", sep = ""))} - cat("2nd model\n") - fctInfo <- ifelse(is.null(obj2$"text"), deparse(obj2[[8]]$fct), obj2$"text") - cat(paste(fctStart, fctInfo, "\n", sep = "")) -# cat(paste(fctStart, deparse(obj2[[8]]$fct), "\n", sep = "")) -# if (colLine) {cat(paste(" collapse: ", collapse2, "\n", sep=""))} - if (colLine) {cat(paste(colStart, collapse2, "\n", sep = ""))} - cat("\n") - } -# } - - dataFra <- data.frame(dfModel, loglik, dfDiff, testStat, pVal) - dimnames(dataFra) <- list(rowNames, colNames) - structure(dataFra, heading = headName, class = c("anova", "data.frame")) -} +#' @title ANOVA for list of drc objects +#' @keywords internal +"anova.drclist" <- function(object, ..., details = TRUE, test = NULL) +{ + objects <- list(object, ...) + if (length(objects) > 2) {stop("Only two models can be compared")} + + ## Testing two models against each other + obj1 <- objects[[1]] + obj2 <- objects[[2]] + rowNames <- c("1st model", "2nd model") + + if ( !(obj1$"type"==obj2$"type") ) {stop("The two models are based on different types on data")} + if (obj1$"type" == "binomial" && (is.null(test)) ) {test <- "Chisq"} + if (obj1$"type" == "continuous" && (is.null(test)) ) {test <- "F"} + + if (!(test == "F")) # chis-square based test + { + loglik <- c(logLik(obj1), logLik(obj2)) # c(sumObj1[[4]][1], sumObj2[[4]][1]) + dfModel <- c(attr(logLik(obj1), "df"), attr(logLik(obj2), "df")) # c(sumObj1[[4]][2], sumObj2[[4]][2]) + testStat <- (2*abs(loglik[1] - loglik[2])) + dfDiff <- c(NA, abs(dfModel[1] - dfModel[2])) + + pVal <- c(NA, 1 - pchisq(testStat, dfDiff[2])) + testStat <- c(NA, testStat) + + headName <- "ANOVA-like table\n" + colNames <- c("ModelDf", "Loglik", "Df", "LR value", "p value") + + } else { # F-test + df1 <- df.residual(obj1) + df2 <- df.residual(obj2) + if (df2 > df1) + { + objTemp <- obj1 + obj1 <- obj2 + obj2 <- objTemp + df1 <- df.residual(obj1) + df2 <- df.residual(obj2) + + rowNames <- rowNames[c(2, 1)] + } + loglik <- c(obj1$"summary"[4], obj2$"summary"[4]) + dfModel <- c(df1, df2) + + dfDiff <- c(NA, df1 - df2) + + testStat <- ((loglik[1] - loglik[2]) / dfDiff[2]) / (loglik[2] / df2) + # Handle edge cases for the F-test p-value + if (is.nan(testStat)) { + # Undefined test statistic (e.g. 0/0), test is meaningless + pVal <- c(NA, NA) + } else if (testStat < 0) { + # Negative F (including -Inf): the simpler model fits better, + # so there is no evidence for the more complex model + pVal <- c(NA, 1) + } else if (is.infinite(testStat)) { + # +Inf: test is undefined (e.g. models have equal df) + pVal <- c(NA, NA) + } else { + pVal <- c(NA, 1 - pf(testStat, dfDiff[2], df2)) + } + testStat <- c(NA, testStat) + + headName <- "ANOVA table\n" + colNames <- c("ModelDf", "RSS", "Df", "F value", "p value") + } + if (details) + { + ## Specifying the models + cat("\n") + + collapse1 <- obj1[[8]]$collapse + if (is.null(collapse1)) {collapse1 <- obj1[[8]]$pmodels} + if (!is.null(obj1$"pmodelsText")) {collapse1 <- obj1$"pmodelsText"} + if (is.null(collapse1)) + { + if (is.null(obj1[[8]]$curve)) + { + collapse1 <- "1 (for all parameters)" + } else { + collapse1 <- paste(deparse(obj1[[8]]$curve), "(for all parameters)") + } + } else { + if (!is.character(collapse1)) + { + collapse1 <- paste(deparse(collapse1), collapse = "") + } + collapse1 <- gsub(" ", "", collapse1, fixed = TRUE) # removing extra spaces + } + + pos <- regexpr("data.frame(", collapse1, fixed = TRUE) + if (pos > 0) + { + collapse1 <- substring(collapse1, 12, nchar(collapse1)-1) + } + pos <- regexpr("list(", collapse1, fixed=TRUE) + if (pos > 0) + { + collapse1 <- substring(collapse1, 6, nchar(collapse1)-1) + } + + collapse2 <- obj2[[8]]$collapse + if (is.null(collapse2)) {collapse2 <- obj2[[8]]$pmodels} + if (!is.null(obj2$"pmodelsText")) {collapse2 <- obj2$"pmodelsText"} + if (is.null(collapse2)) + { + if (is.null(obj2[[8]]$curve)) + { + collapse2 <- "1 (for all parameters)" + } else { + collapse2 <- paste(deparse(obj2[[8]]$curve), "(for all parameters)") + } + } else { + if (!is.character(collapse2)) + { + collapse2 <- paste(deparse(collapse2), collapse = "") + } + collapse2 <- gsub(" ", "", collapse2, fixed = TRUE) # removing extra spaces + } + + pos <- regexpr("data.frame(", collapse2, fixed = TRUE) + if (pos > 0) + { + collapse2 <- substring(collapse2, 12, nchar(collapse2) - 1) + } + + pos <- regexpr("list(", collapse2, fixed = TRUE) + if (pos > 0) + { + collapse2 <- substring(collapse2, 6, nchar(collapse2) - 1) + } + + + ## Omitting collapse line if content is the same in both lines + if (identical(collapse1, collapse2)) {colLine <- FALSE} else {colLine <- TRUE} + + if ( (!is.null(obj1[[8]]$pmodels)) || (!is.null(obj2[[8]]$pmodels)) ) + { + fctStart <- " fct: " + colStart <- " pmodels: " + } else { + fctStart <- " fct: " + colStart <- " pmodels: " + # changed July 4 2011 + } + cat("1st model\n") + fctInfo <- ifelse(is.null(obj1$"text"), deparse(obj1[[8]]$fct), obj1$"text") + cat(paste(fctStart, fctInfo, "\n", sep = "")) + if (colLine) {cat(paste(colStart, collapse1, "\n", sep = ""))} + cat("2nd model\n") + fctInfo <- ifelse(is.null(obj2$"text"), deparse(obj2[[8]]$fct), obj2$"text") + cat(paste(fctStart, fctInfo, "\n", sep = "")) + if (colLine) {cat(paste(colStart, collapse2, "\n", sep = ""))} + cat("\n") + } + + dataFra <- data.frame(dfModel, loglik, dfDiff, testStat, pVal) + dimnames(dataFra) <- list(rowNames, colNames) + structure(dataFra, heading = headName, class = c("anova", "data.frame")) +} diff --git a/R/arandaordaz.R b/R/arandaordaz.R index 2e0ad51b..2c650c35 100644 --- a/R/arandaordaz.R +++ b/R/arandaordaz.R @@ -1,121 +1,176 @@ -"arandaordaz" <- function( -fixed = c(NA, NA, NA), names = c("a", "b", "c"), fctName, fctText) -{ - ## Checking arguments - numParm <- 3 - if (!is.character(names) | !(length(names) == numParm)) {stop("Not correct 'names' argument")} - if ( !(length(fixed) == numParm) ) {stop("Not correct 'fixed' argument")} - - ## Handling 'fixed' argument - notFixed <- is.na(fixed) - parmVec <- rep(0, numParm) - parmVec[!notFixed] <- fixed[!notFixed] +#' Asymptotic Regression Model +#' +#' The base function for the asymptotic regression model, providing the mean +#' function and self starter for a three-parameter model. +#' +#' The asymptotic regression model is a three-parameter model with mean function: +#' +#' \deqn{f(x) = c + (d-c)(1-\exp(-x/e))} +#' +#' The parameter \eqn{c} is the lower limit (at \eqn{x=0}), \eqn{d} is the upper limit, +#' and \eqn{e>0} determines the steepness of the increase. +#' +#' @param fixed numeric vector. Specifies which parameters are fixed and at what +#' value they are fixed. Use \code{NA} for parameters that are not fixed. +#' Must be of length 3. +#' @param names character vector of length 3 giving the names of the parameters +#' (should not contain ":"). +#' @param fctName optional character string used internally by convenience +#' functions. Defaults to \code{"arandaordaz"} if not provided. +#' @param fctText optional character string used internally by convenience +#' functions. Defaults to \code{"Asymptotic regression"} if not provided. +#' +#' @return A list of class \code{drcMean} with the following components: +#' \describe{ +#' \item{fct}{The mean function taking arguments \code{dose} and \code{parm}.} +#' \item{ssfct}{Self-starter function for generating initial parameter +#' estimates from data.} +#' \item{names}{Character vector of non-fixed parameter names.} +#' \item{deriv1}{Reserved first derivative slot (currently \code{NULL}).} +#' \item{deriv2}{Reserved second derivative slot (currently \code{NULL}).} +#' \item{derivx}{Reserved derivative-with-respect-to-x slot (currently +#' \code{NULL}).} +#' \item{edfct}{Function for calculating effective dose (ED) values and +#' their derivatives.} +#' \item{inversion}{Inverse mean function for back-calculating dose from +#' response.} +#' \item{name}{Character string identifying the model function name.} +#' \item{text}{Character string with a human-readable model description.} +#' \item{noParm}{Integer giving the number of non-fixed parameters.} +#' } +#' +#' @author Christian Ritz, Hannes Reinwald +#' +#' @seealso \code{\link{AR.2}}, \code{\link{AR.3}}, \code{\link{EXD.2}}, +#' \code{\link{EXD.3}} +#' +#' @keywords models nonlinear +#' @export +arandaordaz <- function( + fixed = c(NA, NA, NA), + names = c("a", "b", "c"), + fctName, + fctText +) { + + ## --- Input validation + numParm <- 3 - ## Defining the non-linear function - fct <- function(dose, parm) - { - parmMat <- matrix(parmVec, nrow(parm), numParm, byrow=TRUE) - parmMat[, notFixed] <- parm - - parmMat[, 1] + (parmMat[, 2] - parmMat[, 1]) * (1 - exp( -parmMat[, 3] * dose)) - } - - ## Defining the self starter function - ssfct <- function(dataf) - { - x <- dataf[, 1] - y <- dataf[, 2] + if (length(fixed) != numParm) { + stop("'fixed' must have length ", numParm) + } + if (is.list(fixed) || (!is.numeric(fixed) && !all(is.na(fixed)))) { + stop("'fixed' must be a numeric vector") + } + if (!is.character(names) || length(names) != numParm) { + stop("'names' must be a character vector of length ", numParm) + } - aPar <- min(y) * 0.95 - bPar <- max(y) * 1.05 - - ## Linear regression on pseudo y values through origin - ## to determine the parameter c - pseudoY <- log(- ( (y - aPar)/(bPar - aPar) - 1 ) ) - cPar <- coef(lm(pseudoY ~ I(-x) - 1)) - return(c(aPar, bPar, cPar)[notFixed]) + ## --- Handling 'fixed' argument + # Convert to numeric if all NA (default c(NA, NA, NA) is logical) + if (all(is.na(fixed))) { + fixed <- as.numeric(fixed) + } + notFixed <- is.na(fixed) + parmVec <- rep(0, numParm) + parmVec[!notFixed] <- fixed[!notFixed] + + ## --- Mean function + fct <- function(dose, parm) { + parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE) + parmMat[, notFixed] <- parm + + parmMat[, 1] + (parmMat[, 2] - parmMat[, 1]) * (1 - exp(-parmMat[, 3] * dose)) + } + + ## --- Self-starter function + # Nudge factors keep initial bounds just outside the observed data range, + # preventing boundary issues in log transformations during starting-value + # estimation. + LOWER_SHRINK <- 0.95 + UPPER_EXPAND <- 1.05 + + ssfct <- function(dataf) { + x <- dataf[, 1] + y <- dataf[, 2] + + aPar <- min(y) * LOWER_SHRINK + bPar <- max(y) * UPPER_EXPAND + + # Compute pseudo-y values for log-linearisation; guard against + # non-positive values that would produce NaN or -Inf from log(). + innerVal <- -((y - aPar) / (bPar - aPar) - 1) + if (any(innerVal <= 0)) { + warning( + "Self-starter encountered invalid log argument; ", + "initial estimates may be unreliable." + ) + innerVal <- pmax(innerVal, .Machine$double.eps) } - - ## Defining names - names <- names[notFixed] - - ## Defining the ED function - edfct <- function(parm, respl, reference, type, ...) - { - ## Creating the full parameter vector - ## containing both estimated and fixed parameters - parmVec[notFixed] <- parm - - ## Converting to relative scale - if (type == "absolute") - { - p <- 100*((parmVec[2] - respl)/(parmVec[2] - parmVec[1])) - } else { - p <- respl - } - - ## Calculating ED value relative to the control - if (reference == "control") - { - p <- 100 - p - } - tempVal <- log((100-p)/100) -# EDp <- parmVec[4]*(exp(-tempVal/parmVec[5])-1)^(1/parmVec[1]) - pProp <- p / 100 - EDp <- -log(pProp)/parmVec[3] - - EDder <- -# EDp*c(-log(exp(-tempVal/parmVec[5])-1)/(parmVec[1]^2), -# 0, 0, 1/parmVec[4], -# exp(-tempVal/parmVec[5])*tempVal/(parmVec[5]^2)*(1/parmVec[1])*((exp(-tempVal/parmVec[5])-1)^(-1))) - c(0, 0, log(pProp) / (parmVec[3]^2)) - - return(list(EDp, EDder[notFixed])) + pseudoY <- log(innerVal) + + # Linear regression through the origin on pseudo-y values to + # estimate the rate parameter. + cPar <- coef(lm(pseudoY ~ I(-x) - 1)) + + c(aPar, bPar, cPar)[notFixed] + } + + ## --- Subset names to non-fixed parameters + names <- names[notFixed] + + ## --- Effective dose function + edfct <- function(parm, respl, reference, type, ...) { + + # Build the full parameter vector from estimated and fixed components. + localParmVec <- parmVec + localParmVec[notFixed] <- parm + + # Convert to relative scale if the type is absolute. + if (type == "absolute") { + p <- 100 * ((localParmVec[2] - respl) / (localParmVec[2] - localParmVec[1])) + } else { + p <- respl } - ## Defining the inverse function - invfct <- function(y, parm) - { - parmVec[notFixed] <- parm - - log(- ( (y - parmVec[1]) / (parmVec[2] - parmVec[1]) - 1 ) ) / (-parmVec[3]) - } + # Adjust reference direction if calculated relative to the control. + if (reference == "control") { + p <- 100 - p + } - ## Returning the function components - returnList <- - list(fct = fct, ssfct = ssfct, names = names, deriv1 = NULL, deriv2 = NULL, derivx = NULL, - edfct = edfct, inversion = invfct, - name = ifelse(missing(fctName), as.character(match.call()[[1]]), fctName), - text = ifelse(missing(fctText), "Asymptotic regression", fctText), - noParm = sum(is.na(fixed))) - - class(returnList) <- "drcMean" - invisible(returnList) -} - -"AR.2" <- -function(fixed = c(NA, NA), names = c("b", "c")) -{ - ## Checking arguments - numParm <- 2 - if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct 'names' argument")} - if (!(length(fixed)==numParm)) {stop("Not correct length of 'fixed' argument")} - - return( asymreg(fixed = c(0, fixed[1:2]), - names = c("a", names[1:2]), - fctName = as.character(match.call()[[1]]), - fctText = "Asymptotic regression with lower limit fixed at 0") ) -} - -"AR.3" <- -function(fixed = c(NA, NA, NA), names = c("a", "b", "c")) -{ - ## Checking arguments - numParm <- 3 - if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct 'names' argument")} - if (!(length(fixed)==numParm)) {stop("Not correct length of 'fixed' argument")} - - return( asymreg(fixed, names, - fctName = as.character(match.call()[[1]])) ) + pProp <- p / 100 + EDp <- -log(pProp) / localParmVec[3] + + EDder <- c(0, 0, log(pProp) / (localParmVec[3]^2)) + + list(EDp, EDder[notFixed]) + } + + ## --- Inverse function + invfct <- function(y, parm) { + localParmVec <- parmVec + localParmVec[notFixed] <- parm + + log(-((y - localParmVec[1]) / (localParmVec[2] - localParmVec[1]) - 1)) / + (-localParmVec[3]) + } + + ## --- Assemble and return the model object + returnList <- list( + fct = fct, + ssfct = ssfct, + names = names, + deriv1 = NULL, + deriv2 = NULL, + derivx = NULL, + edfct = edfct, + inversion = invfct, + name = if (missing(fctName)) "arandaordaz" else fctName, + text = if (missing(fctText)) "Asymptotic regression" else fctText, + noParm = sum(is.na(fixed)) + ) + + class(returnList) <- "drcMean" + invisible(returnList) } diff --git a/R/backfit.R b/R/backfit.R new file mode 100644 index 00000000..3fe1824b --- /dev/null +++ b/R/backfit.R @@ -0,0 +1,35 @@ +#' Calculation of backfit values from a fitted dose-response model +#' +#' By inverse regression backfitted dose values are calculated for the mean response per dose. +#' +#' @param drcObject an object of class 'drc'. +#' +#' @return Two columns with the original dose values and the corresponding backfitted values +#' using the fitted dose-response model. For extreme dose values (e.g., high dose) the +#' backfitted values may not be well-defined. +#' +#' @author Christian Ritz after a suggestion from Keld Sorensen. +#' +#' @seealso A related function is \code{\link{ED.drc}}. +#' +#' @examples +#' ryegrass.LL.4 <- drm(rootl~conc, data=ryegrass, fct=LL.4()) +#' +#' backfit(ryegrass.LL.4) +#' +#' @keywords models nonlinear +backfit <- function(drcObject) +{ + DL <- drcObject$dataList + DLdose <- DL$dose + meansVec <- tapply(DL$origResp, DLdose, mean, na.rm = TRUE) + # arranged according to ascending dose values + # therefore unique doses are sorted below + + backfitValues <- ED(drcObject, meansVec, type = "absolute", + display = FALSE, multcomp = FALSE)[, 1, drop = FALSE] + + retMat <- cbind(dose = sort(unique(DLdose)), backfit = backfitValues) + rownames(retMat) <- NULL + return(retMat) +} \ No newline at end of file diff --git a/R/backfit.r b/R/backfit.r deleted file mode 100644 index 0390fb4a..00000000 --- a/R/backfit.r +++ /dev/null @@ -1,19 +0,0 @@ -backfit <- function(drcObject) -{ - DL <- drcObject$dataList - DLdose <- DL$dose - meansVec <- tapply(DL$origResp, DLdose, mean, na.rm = TRUE) - # arranged according to ascending dose values - # therefore unique doses are sorted below - - backfitValues <- ED(drcObject, meansVec, type = "absolute", - display = FALSE, multcomp = FALSE)[, 1, drop = FALSE] - -# colnames(backfitValues) <- "backfit" -# rownames(backfitValues) <- sort(unique(DLdose)) -# backfitValues - - retMat <- cbind(dose = sort(unique(DLdose)), backfit = backfitValues) - rownames(retMat) <- NULL - return(retMat) -} \ No newline at end of file diff --git a/R/baro5.R b/R/baro5.R new file mode 100644 index 00000000..8384a0d6 --- /dev/null +++ b/R/baro5.R @@ -0,0 +1,97 @@ +#' The Baroreflex Five-Parameter Dose-Response Model +#' +#' \code{baro5} provides the five-parameter baroreflex model function, allowing +#' specification under various parameter constraints. The model accommodates +#' asymmetric dose-response curves. +#' +#' The five-parameter function is given by: +#' +#' \deqn{y = c + \frac{d-c}{1+f\exp(b1(\log(x)-\log(e))) + (1-f)\exp(b2(\log(x)-\log(e)))}} +#' +#' \deqn{f = 1/(1 + \exp((2b1 b2/|b1+b2|)(\log(x)-\log(e))))} +#' +#' If the difference between b1 and b2 is nonzero, the function is asymmetric. +#' +#' @param fixed numeric vector. Specifies which parameters are fixed and at what value +#' they are fixed. NAs for parameters that are not fixed. +#' @param names a vector of character strings giving the names of the parameters +#' (should not contain ":"). The order is: b1, b2, c, d, e. +#' @param method character string indicating the self starter function to use. +#' @param ssfct a self starter function to be used. +#' +#' @return A list containing the nonlinear model function, the self starter function, +#' and the parameter names. +#' +#' @references Ricketts, J. H. and Head, G. A. (1999) +#' A five-parameter logistic equation for investigating asymmetry of curvature +#' in baroreflex studies. +#' \emph{Am. J. Physiol. (Regulatory Integrative Comp. Physiol. 46)}, \bold{277}, 441--454. +#' +#' @author Christian Ritz +#' +#' @keywords models nonlinear +"baro5" <- function( +fixed = c(NA, NA, NA, NA, NA), names = c("b1", "b2", "c", "d", "e"), +method = c("1", "2", "3", "4"), ssfct = NULL) +{ + ## Checking arguments + numParm <- 5 + if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct 'names' argument")} + if (!(length(fixed)==numParm)) {stop("Not correct 'fixed' argument")} + + notFixed <- is.na(fixed) + parmVec <- rep(0, numParm) + parmVec[!notFixed] <- fixed[!notFixed] + + ## Defining the non-linear function + fct <- function(dose, parm) + { + parmMat <- matrix(parmVec, nrow(parm), numParm, byrow=TRUE) + parmMat[, notFixed] <- parm + + c <- 2*parmMat[, 1]*parmMat[, 2]/abs(parmMat[, 1]+parmMat[, 2]) + + tempVal <- log(dose) - log(parmMat[, 5]) + f <- 1/(1+exp(c*tempVal)) + g <- exp(parmMat[, 1]*tempVal) + h <- exp(parmMat[, 2]*tempVal) + parmMat[, 3]+((parmMat[,4]-parmMat[,3])/(1+f*g+(1-f)*h)) + + } + + ## Defining self starter function + if (!is.null(ssfct)) + { + ssfct <- ssfct + } else { + ssfct <- function(dframe) + { + initval <- (llogistic()$ssfct(dframe))[c(1, 1:4)] + + return(initval[notFixed]) + } + } + + ## Defining names + names <- names[notFixed] + + ## Defining derivatives + deriv1 <- NULL + deriv2 <- NULL + + ## Defining the ED function + edfct <- NULL + + ## Defining the SI function + sifct <- NULL + + returnList <- + list(fct = fct, ssfct = ssfct, names = names, deriv1 = deriv1, deriv2 = deriv2, + edfct=edfct, sifct=sifct, + name = "baro5", + text = "Baroreflex", + noParm = sum(is.na(fixed))) + + class(returnList) <- "baro5" + invisible(returnList) +} diff --git a/R/baro5.r b/R/baro5.r deleted file mode 100644 index c6e189b3..00000000 --- a/R/baro5.r +++ /dev/null @@ -1,133 +0,0 @@ -"baro5" <- function( -fixed = c(NA, NA, NA, NA, NA), names = c("b1", "b2", "c", "d", "e"), -method = c("1", "2", "3", "4"), ssfct = NULL) -{ - ## Checking arguments - numParm <- 5 - if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct 'names' argument")} - if (!(length(fixed)==numParm)) {stop("Not correct 'fixed' argument")} - -# if (!is.logical(useDer)) {stop("Not logical useDer argument")} -# if (useDer) {stop("Derivatives not available")} - - notFixed <- is.na(fixed) - parmVec <- rep(0, numParm) - parmVec[!notFixed] <- fixed[!notFixed] - parmVec1 <- parmVec - parmVec2 <- parmVec - - ## Defining the non-linear function - fct <- function(dose, parm) - { - parmMat <- matrix(parmVec, nrow(parm), numParm, byrow=TRUE) - parmMat[, notFixed] <- parm - -# c <- 2*parmMat[, 3]*parmMat[, 5]/abs(parmMat[, 3]+parmMat[, 5]) -# f <- 1/(1+exp(-c*(log(parmMat[, 4]) - log(dose)))) -# g <- exp(parmMat[, 3]*(log(parmMat[, 4]) - log(dose))) -# h <- exp(parmMat[, 5]*(log(parmMat[, 4]) - log(dose))) -# parmMat[, 1]+((parmMat[,2]-parmMat[,1])/(1+f*g+(1-f)*h)) - - c <- 2*parmMat[, 1]*parmMat[, 2]/abs(parmMat[, 1]+parmMat[, 2]) - - tempVal <- log(dose) - log(parmMat[, 5]) - f <- 1/(1+exp(c*tempVal)) - g <- exp(parmMat[, 1]*tempVal) - h <- exp(parmMat[, 2]*tempVal) - parmMat[, 3]+((parmMat[,4]-parmMat[,3])/(1+f*g+(1-f)*h)) - - } - -# ## Defining value for control measurements (dose=0) -# confct <- function(drcSign) -# { -# if (drcSign>0) {conPos <- 1} else {conPos <- 2} -# confct2 <- function(parm) -# { -# parmMat <- matrix(parmVec, nrow(parm), numParm, byrow=TRUE) -# parmMat[, notFixed] <- parm -# parmMat[, conPos] -# } -# return(list(pos=conPos, fct=confct2)) -# } -# -# ## Defining flag to indicate if more general ANOVA model is available as alternative -# anovaYes <- TRUE - - ## Defining self starter function -if (FALSE) -{ - ssfct <- function(dataFra) - { - dose2 <- dataFra[,1] - resp3 <- dataFra[,2] - - startVal <- rep(0, numParm) - - startVal[4] <- max(resp3)+0.001 # the d parameter - startVal[3] <- min(resp3)-0.001 # the c parameter -# startVal[!notFixed] <- fixed[!notFixed] - - if (length(unique(dose2))==1) {return((c(NA, NA, NA, startVal[4], NA))[notFixed])} # only estimate of upper limit if a single unique dose value - - indexT2 <- (dose2>0) - if (!any(indexT2)) {return((rep(NA, numParm))[notFixed])} # for negative dose value - dose3 <- dose2[indexT2] - resp3 <- resp3[indexT2] - - logitTrans <- log((startVal[4]-resp3)/(resp3-startVal[3]+0.001)) # 0.001 to avoid 0 in the denominator - logitFit <- lm(logitTrans~log(dose3)) - startVal[5] <- exp((-coef(logitFit)[1]/coef(logitFit)[2])) # the e parameter - startVal[1] <- coef(logitFit)[2] # the b parameter - startVal[2] <- startVal[1] - - return(startVal[notFixed]) - } -} - if (!is.null(ssfct)) - { - ssfct <- ssfct - } else { - ssfct <- function(dframe) - { - initval <- (llogistic()$ssfct(dframe))[c(1, 1:4)] - - return(initval[notFixed]) - } - } - - ## Defining names - names <- names[notFixed] - -# ## Defining parameter to be scaled -# if ( (scaleDose) && (is.na(fixed[5])) ) -# { -# scaleInd <- sum(is.na(fixed[1:5])) -# } else { -# scaleInd <- NULL -# } - - ## Defining derivatives - deriv1 <- NULL - deriv2 <- NULL - -# ## Limits -# if (length(lowerc)==numParm) {lowerLimits <- lowerc[notFixed]} else {lowerLimits <- lowerc} -# if (length(upperc)==numParm) {upperLimits <- upperc[notFixed]} else {upperLimits <- upperc} - - ## Defining the ED function - edfct <- NULL - - ## Defining the SI function - sifct <- NULL - - returnList <- - list(fct = fct, ssfct = ssfct, names = names, deriv1 = deriv1, deriv2 = deriv2, - edfct=edfct, sifct=sifct, - name = "baro5", - text = "Baroflex", - noParm = sum(is.na(fixed))) - - class(returnList) <- "baro5" - invisible(returnList) -} diff --git a/R/boxcox.drc.R b/R/boxcox.drc.R index 92eaf080..2b3092b5 100644 --- a/R/boxcox.drc.R +++ b/R/boxcox.drc.R @@ -1,3 +1,49 @@ +#' @title Transform-both-sides Box-Cox transformation +#' +#' @description +#' Finds the optimal Box-Cox transformation for non-linear regression. +#' +#' @param object object of class \code{drc}. +#' @param lambda numeric vector of lambda values; the default is (-2, 2) in steps of 0.25. +#' @param plotit logical which controls whether the result should be plotted. +#' @param bcAdd numeric value specifying the constant to be added on both sides prior to +#' Box-Cox transformation. The default is 0. +#' @param method character string specifying the estimation method for lambda: maximum +#' likelihood or ANOVA-based (optimal lambda inherited from more general ANOVA model fit). +#' @param level numeric value: the confidence level required. +#' @param eps numeric value: the tolerance for lambda = 0; defaults to 0.02. +#' @param xlab character string: the label on the x axis, defaults to "lambda". +#' @param ylab character string: the label on the y axis, defaults to "log-likelihood". +#' @param ... additional graphical parameters. +#' +#' @details +#' The optimal lambda value is determined using a profile likelihood approach: +#' For each lambda value the dose-response regression model is fitted and the lambda value +#' (and corresponding model fit) resulting in the largest value of the log likelihood function +#' is chosen. +#' +#' @return An object of class "drc" (returned invisibly). If plotit = TRUE a plot of +#' loglik vs lambda is shown indicating a confidence interval (by default 95%) about +#' the optimal lambda value. +#' +#' @references +#' Carroll, R. J. and Ruppert, D. (1988) \emph{Transformation and Weighting in Regression}, +#' New York: Chapman and Hall (Chapter 4). +#' +#' @author Christian Ritz +#' +#' @seealso For linear regression the analogue is \code{\link[MASS]{boxcox}}. +#' +#' @examples +#' ## Fitting log-logistic model without transformation +#' ryegrass.m1 <- drm(ryegrass, fct = LL.4()) +#' summary(ryegrass.m1) +#' +#' ## Fitting the same model with the optimal Box-Cox transformation +#' ryegrass.m2 <- boxcox(ryegrass.m1) +#' summary(ryegrass.m2) +#' +#' @keywords models nonlinear "boxcox.drc" <- function(object, lambda = seq(-2, 2, by = 0.25), plotit = TRUE, bcAdd = 0, method = c("ml", "anova"), level = 0.95, eps = 1/50, xlab = expression(lambda), ylab = "log-Likelihood", ...) @@ -5,7 +51,7 @@ xlab = expression(lambda), ylab = "log-Likelihood", ...) method <- match.arg(method) ## Identifying the conditional or fixed-lambda approach - if (identical(length(lambda), 1)) + if (identical(length(lambda), 1L)) { method <- "fixed" } @@ -36,12 +82,10 @@ xlab = expression(lambda), ylab = "log-Likelihood", ...) if (!inherits(drcTemp, "try-error")) { llVec[i] <- llFct(drcTemp, lambda[i]) # logLik(drcTemp) -# print(llVec[i]) } } lv <- lambda[which.max(llVec)] ci <- boxcoxCI(lambda, llVec, level) -# llv <- max(llVec, na.rm = TRUE) ## Plotting the profile log-likelihood if (plotit) # based on boxcox.default @@ -96,8 +140,7 @@ xlab = expression(lambda), ylab = "log-Likelihood", ...) retFit$"boxcox" <- list(lambda = lv, ci = ci, bcAdd = bcAdd) retFit$call$bcVal <- lv retFit$call$bcAdd <- bcAdd -# retFit$boxcox[c(2, 3)] <- ci - ## future: make boxcox and lambda into one component in the fit + ## future: make boxcox and lambda into one component in the fit ## Returning the result invisible(retFit) diff --git a/R/braincousens.R b/R/braincousens.R index 775b8fe9..2d241fd4 100644 --- a/R/braincousens.R +++ b/R/braincousens.R @@ -1,3 +1,36 @@ +#' @title The Brain-Cousens hormesis models +#' +#' @description +#' \code{braincousens} provides a very general way of specifying Brain-Cousens' +#' modified log-logistic model for describing hormesis, under various constraints on the parameters. +#' +#' @param fixed numeric vector. Specifies which parameters are fixed and at what value they are fixed. +#' NAs for parameters that are not fixed. +#' @param names a vector of character strings giving the names of the parameters (should not contain ":"). +#' The order of the parameters is: b, c, d, e, f. +#' @param method character string indicating the self starter function to use. +#' @param ssfct a self starter function to be used. +#' @param fctName optional character string used internally by convenience functions. +#' @param fctText optional character string used internally by convenience functions. +#' +#' @details +#' The Brain-Cousens model is given by the expression +#' \deqn{f(x) = c + \frac{d-c+fx}{1+\exp(b(\log(x)-\log(e)))}} +#' which is a five-parameter model. +#' +#' @return A list containing the non-linear function, the self starter function, +#' the parameter names and additional model specific objects. +#' +#' @references +#' Brain, P. and Cousens, R. (1989) An equation to describe dose responses +#' where there is stimulation of growth at low doses, +#' \emph{Weed Research}, \bold{29}, 93--96. +#' +#' @author Christian Ritz +#' +#' @seealso \code{\link{BC.4}}, \code{\link{BC.5}}, \code{\link{drm}} +#' +#' @keywords models nonlinear "braincousens" <- function( fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), method = c("1", "2", "3", "4"), ssfct = NULL, @@ -8,9 +41,6 @@ fctName, fctText) if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct 'names' argument")} if (!(length(fixed)==numParm)) {stop("Not correct 'fixed' argument")} -# if (!is.logical(useDer)) {stop("Not logical useDer argument")} -# if (useDer) {stop("Derivatives not available")} - notFixed <- is.na(fixed) parmVec <- rep(0, numParm) @@ -28,64 +58,11 @@ fctName, fctText) } -# ## Defining value for control measurements (dose=0) -# confct <- function(drcSign) -# { -# if (drcSign>0) {conPos <- 2} else {conPos <- 3} -# confct2 <- function(parm) -# { -# parmMat <- matrix(parmVec, nrow(parm), numParm, byrow=TRUE) -# parmMat[, notFixed] <- parm -# parmMat[, conPos] -# } -# return(list(pos=conPos, fct=confct2)) -# } -# -# -# ## Defining flag to indicate if more general ANOVA model -## anovaYes <- TRUE -# binVar <- all(fixed[c(2, 3, 5)]==c(0, 1, 1)) -# if (is.na(binVar)) {binVar <- FALSE} -# if (!binVar) {binVar <- NULL} -# anovaYes <- list(bin = binVar, cont = TRUE) - - ## Defining the self starter function -if (FALSE) -{ - ssfct <- function(dataFra) - { - dose2 <- dataFra[,1] - resp3 <- dataFra[,2] - - startVal <- rep(0, numParm) - startVal[3] <- max(resp3)+0.001 # the d parameter -# startVal[3] <- resp3[which.min(dose2)] - startVal[2] <- min(resp3)-0.001 # the c parameter - startVal[5] <- 0 # better choice may be possible! -# startVal[5] <- max(resp3) + 0.001 - startVal[3] -# startVal[!notFixed] <- fixed[!notFixed] - - if (length(unique(dose2))==1) {return((c(NA, NA, startVal[3], NA, NA))[notFixed])} # only estimate of upper limit if a single unique dose value - - indexT2 <- (dose2>0) - if (!any(indexT2)) {return((rep(NA, numParm))[notFixed])} # for negative dose value - dose3 <- dose2[indexT2] - resp3 <- resp3[indexT2] - - logitTrans <- log((startVal[3]-resp3)/(resp3-startVal[2] + 0.001)) # 0.001 to avoid 0 in the denominator - logitFit <- lm(logitTrans~log(dose3)) - startVal[4] <- exp((-coef(logitFit)[1]/coef(logitFit)[2])) # the e parameter - startVal[1] <- coef(logitFit)[2] # the b parameter - - return(startVal[notFixed]) - } -} if (!is.null(ssfct)) { ssfct <- ssfct } else { -# ssfct <- braincousens.ssf(method, fixed) ssfct <- function(dframe) { initval <- llogistic()$ssfct(dframe) @@ -99,14 +76,6 @@ if (FALSE) names <- names[notFixed] -# ## Defining parameter to be scaled -# if ( (scaleDose) && (is.na(fixed[4])) ) -# { -# scaleInd <- sum(is.na(fixed[1:4])) -# } else { -# scaleInd <- NULL -# } - ## Defining derivatives deriv1 <- function(dose, parm) { @@ -128,15 +97,9 @@ if (FALSE) deriv2 <- NULL - ## Limits -# if (length(lowerc)==numParm) {lowerLimits <- lowerc[notFixed]} else {lowerLimits <- lowerc} -# if (length(upperc)==numParm) {upperLimits <- upperc[notFixed]} else {upperLimits <- upperc} - - ## Defining the ED function edfct <- function(parm, respl, reference, type, lower = 1e-3, upper = 1000, ...) { -# if (is.missing(upper)) {upper <- 1000} interval <- c(lower, upper) parmVec[notFixed] <- parm @@ -163,69 +126,41 @@ if (FALSE) derDose <- tempVal*tempVal1*parmVec[1]/EDdose-parmVec[5]/tempVal2 EDder <- derParm/derDose - - return(list(EDp, EDder[notFixed])) - } + ## Fix: correct c and d derivatives for absolute type using central differences. + ## The analytical derivatives above miss the chain-rule contribution from + ## the absolute-to-relative conversion (EDhelper), where p depends on c and d. + if (identical(type, "absolute")) { + .edval <- function(pv) { + p0 <- EDhelper(pv, respl, reference, type) + tv0 <- (100 - p0) / 100 + helpEqn0 <- function(dose) { + ev <- exp(pv[1] * (log(dose) - log(pv[4]))) + pv[5] * (1 + ev * (1 - pv[1])) - (pv[3] - pv[2]) * ev * pv[1] / dose + } + maxAt0 <- uniroot(helpEqn0, interval)$root + eqn0 <- function(dose) { + tv0 * (1 + exp(pv[1] * (log(dose) - log(pv[4])))) - + (1 + pv[5] * dose / (pv[3] - pv[2])) + } + uniroot(eqn0, lower = maxAt0, upper = upper)$root + } + .eps <- .Machine$double.eps + for (.i in c(2, 3)) { + .h <- if (abs(parmVec[.i]) > sqrt(.eps)) abs(parmVec[.i]) * .eps^(1/3) else .eps^(1/3) + .pvUp <- replace(parmVec, .i, parmVec[.i] + .h) + .pvDn <- replace(parmVec, .i, parmVec[.i] - .h) + EDder[.i] <- (.edval(.pvUp) - .edval(.pvDn)) / (2 * .h) + } + } -# ## Defining the SI function -# sifct <- function(parm1, parm2, pair, upper=1000, interval=c(1e-3, 1000)) -# { -# parmVec1[notFixed] <- parm1 -# parmVec2[notFixed] <- parm2 -# -# tempVal1 <- (100-pair[1])/100 -# tempVal2 <- (100-pair[2])/100 -# -# helpEqn1 <- function(dose) -# { -# expVal <- exp(parmVec1[1]*(log(dose)-log(parmVec1[4]))) -# parmVec1[5]*(1+expVal*(1-parmVec1[1]))-(parmVec1[3]-parmVec1[2])*expVal*parmVec1[1]/dose -# } -# maxAt1 <- uniroot(helpEqn1, interval)$root -# helpEqn2 <- function(dose) -# { -# expVal <- exp(parmVec2[1]*(log(dose)-log(parmVec2[4]))) -# parmVec2[5]*(1+expVal*(1-parmVec2[1]))-(parmVec2[3]-parmVec2[2])*expVal*parmVec2[1]/dose} -# maxAt2 <- uniroot(helpEqn2, interval)$root -# -# eqn1 <- function(dose) {tempVal1*(1+exp(parmVec1[1]*(log(dose)-log(parmVec1[4]))))-(1+parmVec1[5]*dose/(parmVec1[3]-parmVec1[2]))} -# EDp1 <- uniroot(eqn1, lower=maxAt1, upper=upper)$root -# eqn2 <- function(dose) {tempVal2*(1+exp(parmVec2[1]*(log(dose)-log(parmVec2[4]))))-(1+parmVec2[5]*dose/(parmVec2[3]-parmVec2[2]))} -# EDp2 <- uniroot(eqn2, lower=maxAt2, upper=upper)$root -# -# SIpair <- EDp1/EDp2 -# -# EDdose1 <- EDp1 -# EDdose2 <- EDp2 -# tempVal11 <- exp(parmVec1[1]*(log(EDdose1)-log(parmVec1[4]))) -# tempVal12 <- parmVec1[3]-parmVec1[2] -# derParm1 <- c(tempVal1*tempVal11*(log(EDdose1)-log(parmVec1[4])), -parmVec1[5]*EDdose1/((tempVal12)^2), -# parmVec1[5]*EDdose1/((tempVal12)^2), -tempVal1*tempVal11*parmVec1[1]/parmVec1[4], -# -EDdose1/tempVal12) -# derDose1 <- tempVal1*tempVal11*parmVec1[1]/EDdose1-parmVec1[5]/tempVal12 -# -# SIder1 <- (derParm1/derDose1)/EDp2 -# -# tempVal21 <- exp(parmVec2[1]*(log(EDdose2)-log(parmVec2[4]))) -# tempVal22 <- parmVec2[3]-parmVec2[2] -# derParm2 <- c(tempVal2*tempVal21*(log(EDdose2)-log(parmVec2[4])), -parmVec2[5]*EDdose2/((tempVal22)^2), -# parmVec2[5]*EDdose2/((tempVal22)^2), -tempVal2*tempVal21*parmVec2[1]/parmVec2[4], -# -EDdose2/tempVal22) -# derDose2 <- tempVal2*tempVal21*parmVec2[1]/EDdose2-parmVec2[5]/tempVal22 -# -# SIder2 <- (derParm2/derDose2)*(-EDp1/(EDp2*EDp2)) -# -# return(list(SIpair, SIder1[notFixed], SIder2[notFixed])) -# } + return(list(EDp, EDder[notFixed])) + } ## Finding the maximal hormesis maxfct <- function(parm, lower = 1e-3, upper = 1000) { -# if (is.null(upper)) {upper <- 1000} -# if (is.null(interval)) {interval <- c(1e-3, 1000)} -# alpha <- 0.5 parmVec[notFixed] <- parm if (parmVec[1]<1) {stop("Brain-Cousens model with b<1 not meaningful")} if (parmVec[5]<0) {stop("Brain-Cousens model with f<0 not meaningful")} @@ -241,7 +176,6 @@ if (FALSE) ED1 <- edfct(parm, 1, lower, upper)[[1]] doseVec <- exp(seq(log(1e-6), log(ED1), length = 100)) -# print((doseVec[optfct(doseVec)>0])[1]) maxDose <- uniroot(optfct, c((doseVec[optfct(doseVec)>0])[1], ED1))$root return(c(maxDose, fct(maxDose, matrix(parm, 1, length(names))))) @@ -250,23 +184,42 @@ if (FALSE) returnList <- list(fct = fct, ssfct = ssfct, names = names, deriv1 = deriv1, deriv2 = deriv2, -# lowerc = lowerLimits, upperc = upperLimits, confct = confct, edfct = edfct, maxfct = maxfct, -# scaleInd = scaleInd, anovaYes = anovaYes, name = ifelse(missing(fctName), as.character(match.call()[[1]]), fctName), text = ifelse(missing(fctText), "Brain-Cousens (hormesis)", fctText), noParm = sum(is.na(fixed))) -# returnList <- switch(return, "fct+ss" = list(fct,ssfct,names), -# "fct+ss+der" = list(fct,ssfct,names,deriv1,deriv2), -# "ED" = list(edparm, edfct), -# "SI" = list(siparm, sifct)) - class(returnList) <- "braincousens" invisible(returnList) } +#' @title Four-parameter Brain-Cousens hormesis model +#' +#' @description +#' \code{BC.4} provides the Brain-Cousens modified log-logistic model with the lower limit fixed at 0. +#' +#' @param fixed numeric vector of length 4 specifying fixed parameters (NAs for free parameters). +#' @param names a vector of character strings giving the names of the parameters. +#' @param ... additional arguments passed to \code{\link{braincousens}}. +#' +#' @return A list (see \code{\link{braincousens}}). +#' +#' @references +#' van Ewijk, P. H. and Hoekstra, J. A. (1993) +#' Calculation of the EC50 and its Confidence Interval When Subtoxic Stimulus Is Present, +#' \emph{Ecotoxicology and Environmental Safety}, \bold{25}, 25--32. +#' +#' @author Christian Ritz +#' +#' @seealso \code{\link{braincousens}}, \code{\link{BC.5}} +#' +#' @examples +#' lettuce.bcm2 <- drm(weight ~ conc, data = lettuce, fct = BC.4()) +#' summary(lettuce.bcm2) +#' ED(lettuce.bcm2, c(50)) +#' +#' @keywords models nonlinear "BC.4" <- function( fixed = c(NA, NA, NA, NA), names = c("b", "d", "e", "f"), ...) { @@ -278,8 +231,37 @@ fixed = c(NA, NA, NA, NA), names = c("b", "d", "e", "f"), ...) fctText = "Brain-Cousens (hormesis) with lower limit fixed at 0", ...)) } +#' @title Alias for BC.4 +#' @description \code{bcl3} is an alias for \code{\link{BC.4}}. +#' @param fixed numeric vector of length 4 specifying fixed parameters (NAs for free parameters). +#' @param names a vector of character strings giving the names of the parameters. +#' @param ... additional arguments passed to \code{\link{braincousens}}. +#' @seealso \code{\link{BC.4}} +#' @keywords models nonlinear bcl3 <- BC.4 +#' @title Five-parameter Brain-Cousens hormesis model +#' +#' @description +#' \code{BC.5} provides the full five-parameter Brain-Cousens modified log-logistic model +#' for describing hormesis. +#' +#' @param fixed numeric vector of length 5 specifying fixed parameters (NAs for free parameters). +#' @param names a vector of character strings giving the names of the parameters. +#' @param ... additional arguments passed to \code{\link{braincousens}}. +#' +#' @return A list (see \code{\link{braincousens}}). +#' +#' @author Christian Ritz +#' +#' @seealso \code{\link{braincousens}}, \code{\link{BC.4}} +#' +#' @examples +#' lettuce.bcm1 <- drm(weight ~ conc, data = lettuce, fct = BC.5()) +#' modelFit(lettuce.bcm1) +#' plot(lettuce.bcm1) +#' +#' @keywords models nonlinear "BC.5" <- function( fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...) { @@ -290,4 +272,11 @@ fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...) fctName = as.character(match.call()[[1]]), ...)) } +#' @title Alias for BC.5 +#' @description \code{bcl4} is an alias for \code{\link{BC.5}}. +#' @param fixed numeric vector of length 5 specifying fixed parameters (NAs for free parameters). +#' @param names a vector of character strings giving the names of the parameters. +#' @param ... additional arguments passed to \code{\link{braincousens}}. +#' @seealso \code{\link{BC.5}} +#' @keywords models nonlinear bcl4 <- BC.5 diff --git a/R/braincousens.ssf.R b/R/braincousens.ssf.R index f20c368d..c0e8c2c2 100644 --- a/R/braincousens.ssf.R +++ b/R/braincousens.ssf.R @@ -1,36 +1,38 @@ -"braincousens.ssf" <- function(method = c("1", "2", "3", "4"), fixed, useFixed = FALSE) -{ - method <- match.arg(method) - - ## Defining helper functions (used below) - ytrans <- function(y, cVal, dVal) {log((dVal - y)/(y - cVal))} - bfct <- function(x, y, cVal, dVal, eVal) {ytrans(y, cVal, dVal) / log(x / eVal)} - efct <- function(x, y, bVal, cVal, dVal) {x * exp(-ytrans(y, cVal, dVal)/bVal)} - - ## Assigning function for finding initial b and e parameter values - findbe <- switch(method, - "1" = findbe1(function(x) {rVec <- log(x); rVec[!x>0] <- NA; rVec}, ytrans), - "2" = findbe2(bfct, efct, "Anke"), - "3" = findbe3(), - "4" = findbe2(bfct, efct, "Normolle")) - - function(dframe) - { - x <- dframe[, 1] - y <- dframe[, 2] - - ## Finding initial values for c and d parameters - cdVal <- findcd(x, y) - if (useFixed) {} # not implemented at the moment - - ## Finding initial values for b and e parameters - beVal <- findbe(x, y, cdVal[1], cdVal[2]) - - ## Finding initial value for f parameter - fVal <- 0 - # better choice than 0 may be possible! - # the f parameter, however, is very rarely a magnitude of 10 larger or smaller - - return(c(beVal[1], cdVal, beVal[2], fVal)[is.na(fixed)]) - } -} +#' @title Self-starter for Brain-Cousens model +#' @keywords internal +"braincousens.ssf" <- function(method = c("1", "2", "3", "4"), fixed, useFixed = FALSE) +{ + method <- match.arg(method) + + ## Defining helper functions (used below) + ytrans <- function(y, cVal, dVal) {log((dVal - y)/(y - cVal))} + bfct <- function(x, y, cVal, dVal, eVal) {ytrans(y, cVal, dVal) / log(x / eVal)} + efct <- function(x, y, bVal, cVal, dVal) {x * exp(-ytrans(y, cVal, dVal)/bVal)} + + ## Assigning function for finding initial b and e parameter values + findbe <- switch(method, + "1" = findbe1(function(x) {rVec <- log(x); rVec[!x>0] <- NA; rVec}, ytrans), + "2" = findbe2(bfct, efct, "Anke"), + "3" = findbe3(), + "4" = findbe2(bfct, efct, "Normolle")) + + function(dframe) + { + x <- dframe[, 1] + y <- dframe[, 2] + + ## Finding initial values for c and d parameters + cdVal <- findcd(x, y) + if (useFixed) {} # not implemented at the moment + + ## Finding initial values for b and e parameters + beVal <- findbe(x, y, cdVal[1], cdVal[2]) + + ## Finding initial value for f parameter + fVal <- 0 + # better choice than 0 may be possible! + # the f parameter, however, is very rarely a magnitude of 10 larger or smaller + + return(c(beVal[1], cdVal, beVal[2], fVal)[is.na(fixed)]) + } +} diff --git a/R/cedergreen.R b/R/cedergreen.R index 9b25e67b..9b402092 100644 --- a/R/cedergreen.R +++ b/R/cedergreen.R @@ -1,377 +1,1139 @@ -"cedergreen" <- function( -fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), -method = c("1", "2", "3", "4"), ssfct = NULL, -alpha, fctName, fctText) -{ - ## Checking arguments - numParm <- 5 - if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct 'names' argument")} - if (!(length(fixed)==numParm)) {stop("Not correct 'fixed' argument")} +# HELPER ------------------------------------------------------------------- -# if (!is.logical(useD)) {stop("Not logical useD argument")} -# if (useD) {stop("Derivatives not available")} +# Define the edfct and maxfct helper functions here. Needed for the cedergreen function to work properly. +# These functions are used for calculating effective doses and finding the maximum hormesis, respectively. - if (missing(alpha)) {stop("'alpha' argument must be specified")} +## -- Defining the edfct (Refactored) -- ## +#' Calculate Effective Dose for the Cedergreen-Ritz Hormesis Model +#' +#' @description +#' An internal helper function to calculate the effective dose (ED) and its +#' derivatives for the Cedergreen-Ritz five-parameter hormesis model. It uses +#' `uniroot` to find the dose for a given response level. +#' +#' @param parm A numeric vector of the non-fixed model parameters. +#' @param all_params A numeric vector template for all model parameters (b,c,d,e,f). +#' @param not_fixed A logical or integer vector indicating the non-fixed parameters. +#' @param alpha A numeric value for the hormesis model's alpha shape parameter. +#' @param respl The response level to calculate the dose for (e.g., 50 for ED50). +#' @param reference A character string ("control" or "absolute") for calculating the response. +#' @param type A character string specifying the type of ED calculation. +#' @param lower The lower bound of the dose interval for the root-finding search. +#' @param upper The upper bound of the dose interval for the root-finding search. +#' +#' @return A list containing the calculated effective dose and a vector of its +#' partial derivatives with respect to the non-fixed parameters. +#' +#' @author Hannes Reinwald +#' +#' @keywords internal +#' +cedergreen_edfct <- function( + parm, # Vector of non-fixed parameters + all_params, # Full parameter vector (template) + not_fixed, # Index/logical of non-fixed params + alpha, # Hormesis shape parameter + respl, # Response level (e.g., 50) + reference, # Reference for EDhelper + type, # Type for EDhelper + lower = 1e-4, + upper = 10000 +){ + # 1. Self-contained: Reconstruct the full parameter vector + all_params[not_fixed] <- parm + + # 2. Readability: Use named parameters + p_named <- list(b = all_params[1], c = all_params[2], d = all_params[3], + e = all_params[4], f = all_params[5]) + + # Calculate the target response proportion + p_percent <- EDhelper(all_params, respl, reference, type, TRUE) + target_prop <- (100 - p_percent) / 100 + + # Define the dose-response model with clear names + response_model <- function(dose, p, alpha) { + p$c + (p$d - p$c + p$f * exp(-1 / (dose^alpha))) / (1 + exp(p$b * (log(dose) - log(p$e)))) + } + + # Find the dose at which the maximum response occurs to handle non-monotonicity + dose_grid <- exp(seq(log(lower), log(upper), length.out = 1000)) + response_values <- response_model(dose_grid, p_named, alpha) + dose_at_max_resp <- dose_grid[which.max(response_values)] + + # Define the equation to solve for the effective dose (ED) + root_eqn <- function(dose) { + # Rearranged model: F(dose, params) = 0 + target_prop * (1 + exp(p_named$b * (log(dose) - log(p_named$e)))) - + (1 + p_named$f * exp(-1 / (dose^alpha)) / (p_named$d - p_named$c)) + } + + # 3. Robustness: Solve for ED with error handling + effective_dose <- tryCatch({ + uniroot(root_eqn, lower = dose_at_max_resp, upper = upper)$root + }, error = function(e) { + warning(paste("Root finding failed for ED", respl, ". Returning NA.", sep="")) + return(NA) + }) + + if (is.na(effective_dose)) { + return(list(NA, rep(NA, sum(not_fixed)))) + } + + # 4. Clarity in Derivatives: Calculate derivatives for the Delta Method + # (This part remains complex, but breaking it down would be the next step) + # Note: The derivative calculation is kept brief here for demonstration. + # In a real refactoring, each term of derParm and derDose would be calculated separately. + tempVal1 <- exp(p_named$b * (log(effective_dose) - log(p_named$e))) + tempVal2 <- p_named$d - p_named$c + + derParm <- c(target_prop*tempVal1*(log(effective_dose)-log(p_named$e)), + -p_named$f*exp(-1/(effective_dose^alpha))/((tempVal2)^2), + p_named$f*exp(-1/(effective_dose^alpha))/((tempVal2)^2), + -target_prop*tempVal1*p_named$b/p_named$e, + -exp(-1/(effective_dose^alpha))/tempVal2) + + derDose <- target_prop*tempVal1*p_named$b/effective_dose - p_named$f/tempVal2*exp(-1/(effective_dose^alpha))/(effective_dose^(1+alpha))*alpha + + # Correct application of Implicit Function Theorem + ed_derivatives <- -derParm / derDose + return(list(effective_dose, ed_derivatives[not_fixed])) +} - notFixed <- is.na(fixed) - parmVec <- rep(0, numParm) - parmVec[!notFixed] <- fixed[!notFixed] - parmVec1 <- parmVec - parmVec2 <- parmVec - - - ## Defining the non-linear function - fct <- function(dose, parm) - { - parmMat <- matrix(parmVec, nrow(parm), numParm, byrow=TRUE) - parmMat[, notFixed] <- parm - - parmMat[,2] + (parmMat[,3] - parmMat[,2] + parmMat[,5]*exp(-1/(dose^alpha)))/(1 + exp(parmMat[,1]*(log(dose) - log(parmMat[,4])))) - } +## -- Defining the maxfct function (Refactored) -- ## +#' Find the Dose and Response at Maximum Hormesis +#' +#' @description +#' This function finds the dose that elicits the maximum hormetic (stimulatory) +#' response for the Cedergreen-Ritz model and the response value at that dose. +#' +#' @param all_params A named list of all model parameters (b, c, d, e, f). +#' @param alpha The hormesis alpha shape parameter. +#' @param lower The lower bound of the dose interval to search for the maximum. +#' @param upper The upper bound of the dose interval to search for the maximum. +#' +#' @return A numeric vector containing two values: the dose at the maximum +#' response, and the maximum response value itself. Returns `c(NA, NA)` on failure. +#' +#' @author Hannes Reinwald +#' +#' @keywords internal +#' +#' @importFrom stats optimize +cedergreen_maxfct <- function(all_params, alpha, lower = 1e-6, upper = 1000, .optimize_fn = stats::optimize) +{ + # Define the dose-response model using named parameters for clarity + response_model <- function(dose, p, alpha) { + p$c + (p$d - p$c + p$f * exp(-1 / (dose^alpha))) / (1 + exp(p$b * (log(dose) - log(p$e)))) + } + + # Use optimize() to directly find the dose that maximizes the response. + # It is more robust than finding the root of the derivative. + # We search for the maximum by telling optimize to maximize=TRUE. + opt_result <- tryCatch({ + .optimize_fn( + f = response_model, + interval = c(lower, upper), + p = all_params, + alpha = alpha, + maximum = TRUE + ) + }, error = function(e) { + warning("Optimization failed to find a maximum hormesis dose.") + return(NULL) + }) -# ## Defining value for control measurements (dose=0) -# confct <- function(drcSign) -# { -# if (drcSign>0) {conPos <- 2} else {conPos <- 3} -# confct2 <- function(parm) -# { -# parmMat <- matrix(parmVec, nrow(parm), numParm, byrow=TRUE) -# parmMat[, notFixed] <- parm -# parmMat[, conPos] -# } -# return(list(pos=conPos, fct=confct2)) -# } -# -# -# ## Defining flag to indicate if more general ANOVA model -## anovaYes <- TRUE -# binVar <- all(fixed[c(2, 3, 5)]==c(0, 1, 1)) -# if (is.na(binVar)) {binVar <- FALSE} -# if (!binVar) {binVar <- NULL} -# anovaYes <- list(bin = binVar, cont = TRUE) - - ## Defining self starter function -if (FALSE) -{ - ssfct <- function(dataFra) - { - dose2 <- dataFra[,1] - resp3 <- dataFra[,2] - - startVal <- rep(0, numParm) - -# startVal[3]<-max(resp3)+0.001 # the d parameter -# startVal[2]<-min(resp3)-0.001 # the c parameter - startVal[3] <- 1.05 * resp3[which.min(dose2)] - startVal[2] <- 0.95 * min(resp3) - -# startVal[!notFixed] <- fixed[!notFixed] - - if (length(unique(dose2))==1) {return((c(NA,NA,startVal[3],NA,NA))[notFixed])} - - indexT2<-(dose2>0) - if (!any(indexT2)) {return((rep(NA, numParm))[notFixed])} - dose3<-dose2[indexT2] - resp3<-resp3[indexT2] - - logitTrans<-log((startVal[3]-resp3)/(resp3-startVal[2] + 0.001)) # 0.001 to avoid 0 in the denominator - logitFit<-lm(logitTrans~log(dose3)) - startVal[4]<-exp((-coef(logitFit)[1]/coef(logitFit)[2])) # the e parameter - startVal[1]<-coef(logitFit)[2] # the b parameter - -# startVal[5] <- 0 # the f parameter - ## Solving equation at x=e - startVal[5] <- (2*(median(resp3) - startVal[2]) - (startVal[3] - startVal[2]))*exp(1/(startVal[4]^alpha)) - - return(startVal[notFixed]) - } + if (is.null(opt_result)) { + return(c(maxDose = NA, maxResponse = NA)) + } + + # Return the dose at the maximum and the value of the function at that maximum + return(c(maxDose = opt_result$maximum, maxResponse = opt_result$objective)) } - if (!is.null(ssfct)) - { - ssfct <- ssfct - } else { -# ssfct <- cedergreen.ssf(method, fixed, alpha) - ssfct <- function(dframe) - { - initval <- llogistic()$ssfct(dframe) - initval[5] <- (2*(median(dframe[, 2])-initval[2])-(initval[3]-initval[2]))*exp(1/(initval[4]^alpha)) - - return(initval[notFixed]) - } - } - - ## Defining names - names <- names[notFixed] -# ## Defining parameter to be scaled -# if ( (scaleDose) && (is.na(fixed[4])) ) -# { -# scaleInd <- sum(is.na(fixed[1:4])) -# } else { -# scaleInd <- NULL -# } +# MAIN --------------------------------------------------------------------- - ## Defining derivatives +#' @title Cedergreen-Ritz-Streibig Model +#' @description Provides the Cedergreen-Ritz-Streibig function, a five-parameter model +#' for describing dose-response curves that exhibit hormesis (a stimulatory or +#' beneficial effect at low doses). This function generates a model object suitable +#' for use with non-linear regression functions like \code{\link[drc]{drm}}. +#' +#' @details +#' The Cedergreen-Ritz-Streibig model is defined by the following equation: +#' \deqn{f(x) = c + \frac{d - c + f \exp(-1/x^{\alpha})}{1 + \exp(b(\log(x) - \log(e)))}} +#' The parameter \eqn{f} determines the size of the hormetic effect (stimulation). +#' If \eqn{f=0}, the model simplifies to the standard four-parameter log-logistic model. +#' The parameter \eqn{\alpha} is a shape parameter that must be specified by the user. +#' +#' @param fixed A numeric vector of length 5 specifying any parameters to be held fixed +#' during the estimation. The order is \code{c(b, c, d, e, f)}. Use \code{NA} for +#' parameters that should be estimated. The default is to estimate all parameters. +#' @param names A character vector of length 5 providing names for the parameters. +#' The default is \code{c("b", "c", "d", "e", "f")}. +#' @param method A character string specifying the method for the self-starter function +#' to use for finding initial parameter values. Options are \code{"loglinear"}, +#' \code{"anke"}, \code{"method3"}, and \code{"normolle"}. This is only used if \code{ssfct} is \code{NULL}. +#' @param ssfct A custom self-starter function. If \code{NULL} (the default), a +#' self-starter is automatically generated by calling \code{\link{cedergreen.ssf}} +#' with the specified \code{method}, \code{fixed}, and \code{alpha} arguments. +#' @param alpha A mandatory numeric value specifying the fixed shape parameter \eqn{\alpha}. +#' The function will stop if this is not provided. +#' @param fctName An optional character string to name the function object. +#' @param fctText An optional character string providing a descriptive text for the model. +#' +#' @return A list of class \code{mllogistic}, containing the model function (\code{fct}), +#' the self-starter function (\code{ssfct}), parameter names (\code{names}), and other +#' components required for use with modeling functions like \code{\link[drc]{drm}}. +#' +#' @seealso \code{\link[drc]{drm}} for model fitting, and \code{\link{cedergreen.ssf}} for the +#' underlying self-starter function. +#' +#' @author Christian Ritz, Hannes Reinwald +#' +#' @keywords models nonlinear +#' +#' @examples +#' dose <- c(0, 0.1, 0.5, 1, 5, 10, 20) +#' response <- c(100, 102, 95, 80, 40, 25, 20) +#' my_data <- data.frame(dose = dose, response = response) +#' model_fit <- drm(response ~ dose, data = my_data, +#' fct = cedergreen(alpha = 0.5)) +#' summary(model_fit) +#' +#' @export +"cedergreen" <- function( + fixed = c(NA, NA, NA, NA, NA), + names = c("b", "c", "d", "e", "f"), + method = c("loglinear", "anke", "method3", "normolle"), + ssfct = NULL, + alpha, + fctName, + fctText +){ + ## Checking arguments and setting up fixed parameter logic + numParm <- 5 + if (!is.character(names) || !(length(names) == numParm)) {stop("Not correct 'names' argument")} + if (!(length(fixed) == numParm)) {stop("Not correct 'fixed' argument")} + if (missing(alpha)) {stop("'alpha' argument must be specified")} + + # Determine if fixed parameters are being used. This will be passed to ssfct. + useFixed <- !all(is.na(fixed)) + + # Match the method argument + method <- match.arg(method) + notFixed <- is.na(fixed) + parmVec <- rep(0, numParm) + parmVec[!notFixed] <- fixed[!notFixed] + + ## Defining the non-linear function + fct <- function(dose, parm){ + parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE) + parmMat[, notFixed] <- parm + # The Cedergreen-Ritz-Streibig model equation + parmMat[,2] + (parmMat[,3] - parmMat[,2] + parmMat[,5] * exp(-1 / (dose^alpha))) / + (1 + exp(parmMat[,1] * (log(dose) - log(parmMat[,4])))) + } + + ## --- Correctly defining the self-starter --- + # If a custom self-starter is not provided, use our robust cedergreen.ssf + if (is.null(ssfct)) { + # This is the correct way to call the external self-starter. + # It passes the method, the fixed vector, alpha, and the useFixed flag. + ssfct <- cedergreen.ssf(method = method, fixed = fixed, alpha = alpha, useFixed = useFixed) + } + + ## Defining names for the parameters to be estimated + names <- names[notFixed] + + ## Specifying the derivatives (derivatives code is kept as is) + deriv1 <- function(dose, parm) + { + parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE) + parmMat[, notFixed] <- parm -# ## Constructing a helper function -# xlogx <- function(x, p) -# { -# lv <- (x < 1e-12) -# nlv <- !lv -# -# rv <- rep(0, length(x)) -# -# xlv <- x[lv] -# rv[lv] <- log(xlv^(xlv^p[lv])) -# -# xnlv <- x[nlv] -# rv[nlv] <- (xnlv^p[nlv])*log(xnlv) -# -# rv -# } + t0 <- exp(-1/(dose^alpha)) + t1 <- parmMat[, 3] - parmMat[, 2] + parmMat[, 5]*t0 + t2 <- exp(parmMat[, 1]*(log(dose) - log(parmMat[, 4]))) + t3 <- 1 + t2 + t4 <- (1 + t2)^(-2) - ## Specifying the derivatives - deriv1 <- function(dose, parm) - { - parmMat <- matrix(parmVec, nrow(parm), numParm, byrow=TRUE) - parmMat[, notFixed] <- parm - - t0 <- exp(-1/(dose^alpha)) - t1 <- parmMat[, 3] - parmMat[, 2] + parmMat[, 5]*t0 - t2 <- exp(parmMat[, 1]*(log(dose) - log(parmMat[, 4]))) - t3 <- 1 + t2 - t4 <- (1 + t2)^(-2) - - cbind( -t1*xlogx(dose/parmMat[, 4], parmMat[, 1])*t4, - 1 - 1/t3, - 1/t3, - t1*t2*(parmMat[, 1]/parmMat[, 4])*t4, - t0/t3 )[, notFixed] - } - - deriv2 <- NULL - - - ## Limits -# if (length(lowerc)==numParm) {lowerLimits <- lowerc[notFixed]} else {lowerLimits <- lowerc} -# if (length(upperc)==numParm) {upperLimits <- upperc[notFixed]} else {upperLimits <- upperc} - - - ## Defining the ED function -# edfct <- function(parm, p, lower = 1e-4, upper = 10000, ...) # upper2=1000) - edfct <- function(parm, respl, reference, type, lower = 1e-4, upper = 10000, ...) # upper2=1000) - { -# if (is.null(upper)) {upper <- 1000} -# if (missing(upper2)) {upper2 <- 1000} - interval <- c(lower, upper) - parmVec[notFixed] <- parm - p <- EDhelper(parmVec, respl, reference, type, TRUE) # FALSE) Changed 2010-06-02 after e-mail from Claire - tempVal <- (100-p)/100 - - helpFct <- function(dose) {parmVec[2]+(parmVec[3]-parmVec[2]+parmVec[5]*exp(-1/(dose^alpha)))/(1+exp(parmVec[1]*(log(dose)-log(parmVec[4]))))} -# doseVec <- exp(seq(-upper2, upper2, length=1000)) - doseVec <- exp(seq(log(interval[1]), log(interval[2]), length=1000)) - maxAt <- doseVec[which.max(helpFct(doseVec))] -# print(maxAt) -# print(upper) - - eqn <- function(dose) {tempVal*(1+exp(parmVec[1]*(log(dose)-log(parmVec[4]))))-(1+parmVec[5]*exp(-1/(dose^alpha))/(parmVec[3]-parmVec[2]))} - EDp <- uniroot(eqn, lower=maxAt, upper=upper)$root - - EDdose <- EDp - tempVal1 <- exp(parmVec[1]*(log(EDdose)-log(parmVec[4]))) - tempVal2 <- parmVec[3]-parmVec[2] - derParm <- c(tempVal*tempVal1*(log(EDdose)-log(parmVec[4])), -parmVec[5]*exp(-1/(EDdose^alpha))/((tempVal2)^2), - parmVec[5]*exp(-1/(EDdose^alpha))/((tempVal2)^2), -tempVal*tempVal1*parmVec[1]/parmVec[4], - -exp(-1/(EDdose^alpha))/tempVal2) - derDose <- tempVal*tempVal1*parmVec[1]/EDdose-parmVec[5]/tempVal2*exp(-1/(EDdose^alpha))/(EDdose^(1+alpha))*alpha - - EDder <- derParm/derDose - - return(list(EDp, EDder[notFixed])) - } + # A helper function 'xlogx' would need to be defined for this to work + cbind( + -t1*xlogx(dose/parmMat[, 4], parmMat[, 1])*t4, + 1 - 1/t3, + 1/t3, + 1*t2*(parmMat[, 1]/parmMat[, 4])*t4, + t0/t3 + )[, notFixed] + } + + + ## Defining the ED function: wrapper closure that delegates to cedergreen_edfct + ## The framework calls edfct(parm, respl, reference, type, ...) so we bind + ## parmVec, notFixed, and alpha from the enclosing scope. + edfct <- function(parm, respl, reference, type, lower = 1e-4, upper = 10000, ...) + { + cedergreen_edfct(parm, parmVec, notFixed, alpha, respl, reference, type, lower, upper) + } + + ## Finding the maximal hormesis: wrapper closure that delegates to cedergreen_maxfct + ## The framework calls maxfct(parm, lower, upper) where parm is the non-fixed + ## parameter vector. We reconstruct the full named-list and bind alpha. + maxfct <- function(parm, lower = 1e-3, upper = 1000, .optimize_fn = stats::optimize) + { + parmVec[notFixed] <- parm + all_params <- list(b = parmVec[1], c = parmVec[2], d = parmVec[3], + e = parmVec[4], f = parmVec[5]) + cedergreen_maxfct(all_params, alpha, lower, upper, .optimize_fn) + } + + # Return results + returnList <- list( + fct = fct, + ssfct = ssfct, + names = names, + deriv1 = deriv1, # Note: deriv1 is incomplete without xlogx + deriv2 = NULL, + edfct = edfct, + maxfct = maxfct, + name = ifelse(missing(fctName), as.character(match.call()[[1]]), fctName), + text = ifelse(missing(fctText), "Cedergreen-Ritz-Streibig", fctText), + noParm = sum(is.na(fixed)) + ) + class(returnList) <- "mllogistic" + invisible(returnList) +} -# -# ## Defining the SI function -# sifct <- function(parm1, parm2, pair, upper = 10000, interval = c(1e-4, 10000)) -# { -## if (is.null(upper)) {upper <- 1000} -## if (missing(upper2)) {upper2 <- 1000} -# -# parmVec1[notFixed] <- parm1 -# parmVec2[notFixed] <- parm2 -# -# tempVal1 <- (100-pair[1])/100 -# tempVal2 <- (100-pair[2])/100 -# -## doseVec <- exp(seq(-upper2, upper2, length=max(c(1000, upper2)))) -# doseVec <- exp(seq(log(interval[1]), log(interval[2]), length=1000)) -# helpFct1 <- function(dose) -# { -# parmVec1[2]+(parmVec1[3]-parmVec1[2]+parmVec1[5]*exp(-1/(dose^alpha)))/(1+exp(parmVec1[1]*(log(dose)-log(parmVec1[4])))) -# } -# maxAt1 <- doseVec[which.max(helpFct1(doseVec))] -# -# helpFct2 <- function(dose) -# { -# parmVec2[2]+(parmVec2[3]-parmVec2[2]+parmVec2[5]*exp(-1/(dose^alpha)))/(1+exp(parmVec2[1]*(log(dose)-log(parmVec2[4])))) -# } -# maxAt2 <- doseVec[which.max(helpFct2(doseVec))] -# -# eqn1 <- function(dose) {tempVal1*(1+exp(parmVec1[1]*(log(dose)-log(parmVec1[4]))))-(1+parmVec1[5]*exp(-1/(dose^alpha))/(parmVec1[3]-parmVec1[2]))} -# EDp1 <- uniroot(eqn1, lower=maxAt1, upper=upper)$root -# eqn2 <- function(dose) {tempVal2*(1+exp(parmVec2[1]*(log(dose)-log(parmVec2[4]))))-(1+parmVec2[5]*exp(-1/(dose^alpha))/(parmVec2[3]-parmVec2[2]))} -# EDp2 <- uniroot(eqn2, lower=maxAt2, upper=upper)$root -# -# SIpair <- EDp1/EDp2 -# -# EDdose1 <- EDp1 -# EDdose2 <- EDp2 -# tempVal11 <- exp(parmVec1[1]*(log(EDdose1)-log(parmVec1[4]))) -# tempVal12 <- parmVec1[3]-parmVec1[2] -# derParm1 <- c(tempVal1*tempVal11*(log(EDdose1)-log(parmVec1[4])), -parmVec1[5]*exp(-1/(EDdose1^alpha))/((tempVal12)^2), -# parmVec1[5]*exp(-1/(EDdose1^alpha))/((tempVal12)^2), -tempVal1*tempVal11*parmVec1[1]/parmVec1[4], -# -exp(-1/(EDdose1^alpha))/tempVal12) -# derDose1 <- tempVal1*tempVal11*parmVec1[1]/EDdose1-parmVec1[5]/tempVal12*exp(-1/(EDdose1^alpha))/(EDdose1^(1+alpha))*alpha -# -# SIder1 <- (derParm1/derDose1)/EDp2 -# -# tempVal21 <- exp(parmVec2[1]*(log(EDdose2)-log(parmVec2[4]))) -# tempVal22 <- parmVec2[3]-parmVec2[2] -# derParm2 <- c(tempVal2*tempVal21*(log(EDdose2)-log(parmVec2[4])), -parmVec2[5]*exp(-1/(EDdose2^alpha))/((tempVal22)^2), -# parmVec2[5]*exp(-1/(EDdose2^alpha))/((tempVal22)^2), -tempVal2*tempVal21*parmVec2[1]/parmVec2[4], -# -exp(-1/(EDdose2^alpha))/tempVal22) -# derDose2 <- tempVal2*tempVal21*parmVec2[1]/EDdose2-parmVec2[5]/tempVal22*exp(-1/(EDdose2^alpha))/(EDdose2^(1+alpha))*alpha -# -# SIder2 <- (derParm2/derDose2)*(-EDp1/(EDp2*EDp2)) -# -# return(list(SIpair, SIder1[notFixed], SIder2[notFixed])) -# } - - - ## Finding the maximal hormesis - maxfct <- function(parm, lower = 1e-3, upper = 1000) - { -# if (is.null(upper)) {upper <- 1000} -# if (is.null(interval)) {interval <- c(1e-3, 1000)} -# alpha <- 0.5 - parmVec[notFixed] <- parm - - optfct <- function(t) - { - expTerm1 <- parmVec[5]*exp(-1/(t^alpha)) - expTerm2 <- exp(parmVec[1]*(log(t)-log(parmVec[4]))) - - return(expTerm1*alpha/(t^(alpha+1))*(1+expTerm2)-(parmVec[3]-parmVec[2]+expTerm1)*expTerm2*parmVec[1]/t) - } - - ED1 <- edfct(parm, 1, lower, upper)[[1]] - - doseVec <- exp(seq(log(1e-6), log(ED1), length = 100)) -# print((doseVec[optfct(doseVec)>0])[1]) - maxDose <- uniroot(optfct, c((doseVec[optfct(doseVec)>0])[1], ED1))$root - return(c(maxDose, fct(maxDose, matrix(parm, 1, length(names))))) - } +# WRAPPER ------------------------------------------------------------------- - - returnList <- - list(fct=fct, ssfct=ssfct, names=names, deriv1=deriv1, deriv2=deriv2, # lowerc=lowerLimits, upperc=upperLimits, - edfct=edfct, maxfct=maxfct, -# scaleInd=scaleInd, anovaYes=anovaYes, confct=confct, -# name = "cedergreen", -# text = "Cedergreen-Ritz-Streibig", - name = ifelse(missing(fctName), as.character(match.call()[[1]]), fctName), - text = ifelse(missing(fctText), "Cedergreen-Ritz-Streibig", fctText), - noParm = sum(is.na(fixed))) - - class(returnList) <- "mllogistic" - invisible(returnList) +#' Wrapper for 5-parameter Cedergreen-Ritz-Streibig Model +#' +#' @author Hannes Reinwald +#' +#' @description +#' A convenience wrapper for the \code{drc::cedergreen} function, preset for a +#' 5-parameter model. It provides flexible handling for the alpha parameter. +#' +#' @details +#' This function simplifies the creation of a 5-parameter Cedergreen-Ritz-Streibig +#' model by setting sensible defaults for the parameter names. It allows the +#' alpha parameter to be specified either by a predefined character shortcut +#' ('a', 'b', 'c') or by a direct numeric value. +#' +#' By default the function runs with `alpha=1`, which corresponds to the `CRS.4a` model. +#' Setting `alpha=0.5` corresponds to the `CRS.4b` model, and `alpha=0.25` corresponds to the `CRS.4c` model. +#' +#' By default, all parameters are set to be estimated (i.e., \code{fixed} is all \code{NA}), +#' but users can specify any parameters to be held constant during estimation. +#' The self-starter function is automatically generated based on the specified method and +#' fixed parameters, ensuring that initial values are appropriately calculated for the model fitting process. +#' +#' The function automatically generates a model name (`fctName`) and description +#' (`fctText`) unless they are explicitly provided by the user. +#' +#' @param names A character vector of length 5 specifying the names of the model +#' parameters. Default is \code{c("b", "c", "d", "e", "f")}. +#' @param fixed A numeric vector of length 5. Use \code{NA} for parameters to be +#' estimated and a numeric value for parameters to be fixed. Default is all +#' \code{NA}. +#' @param alpha_type A character or a numeric value. Can be one of 'a' (alpha=1), +#' 'b' (alpha=0.5), 'c' (alpha=0.25), or a specific numeric value for alpha. +#' @param fctName An optional character string to name the model function. If +#' \code{NULL} (the default), a name is generated automatically. +#' @param fctText An optional character string describing the model. If +#' \code{NULL} (the default), a description is generated automatically. +#' @param ... Additional arguments to be passed to \code{drc::cedergreen}, such +#' as \code{data}. +#' +#' @return A \code{drc} model object of class \code{cedergreen}. If the underlying +#' \code{drc::cedergreen} call fails, it issues a warning and returns \code{NULL}. +#' +#' @examples +#' # Create a CRS.5 model specification +#' crs_model_a <- CRS.5() +#' +#' # Fix the lower limit to 0 and use a custom numeric alpha +#' crs_model_custom <- CRS.5( +#' fixed = c(NA, 0, NA, NA, NA), alpha_type = 0.75 +#' ) +#' +#' @export +CRS.5 <- function(names = c("b", "c", "d", "e", "f"), + fixed = c(NA, NA, NA, NA, NA), + alpha_type = "a", # one of 'a', 'b' or 'c' or a numeric value specifiying alpha + fctName = NULL, + fctText = NULL, + ... ){ + + # Input sanity check + if (!is.character(names) | !(length(names) == 5)) { + stop("Not correct 'names' argument") + } + + # Specify respective alpha values + alpha_value <- list(a = 1, b = 0.5, c = 0.25) + + # Check alpha_type and calculate the numeric alpha value 'a' + if (!is.numeric(alpha_type)){ + # --- STABILITY IMPROVEMENT --- + # Check if the provided character is a valid key before trying to access it + if (!(alpha_type %in% names(alpha_value))) { + stop("Invalid 'alpha_type'. Must be one of 'a', 'b', 'c', or a numeric value.") + } + a <- alpha_value[[alpha_type]] + } else { + a <- alpha_type + alpha_type <- paste0(".alpha:", alpha_type) + } + stopifnot(is.numeric(a)) # This check is now safe + + # Propper variable handling for optional arguments + if (is.null(fctName)) fctName <- paste0(as.character(match.call()[[1]]), alpha_type) + if (is.null(fctText)) fctText <- paste0("Cedergreen-Ritz-Streibig (alpha=", a, ")") + + # Run cedergreen() within tryCatch for proper error handling + res <- tryCatch({ + drc::cedergreen(fixed = fixed, names = names, alpha = a, + fctName = fctName, fctText = fctText, ...) + }, error = function(e) { + warning(paste("The cedergreen() model call failed with an error:", conditionMessage(e))) + return(NULL) + }) + + return(res) } -"CRS.4a" <- -function(names = c("b", "d", "e", "f"), ...) -{ - ## Checking arguments - if (!is.character(names) | !(length(names)==4)) {stop("Not correct 'names' argument")} - return(cedergreen(fixed = c(NA, 0, NA, NA, NA), names = c(names[1], "c", names[2:4]), alpha = 1, - fctName = as.character(match.call()[[1]]), - fctText = "Cedergreen-Ritz-Streibig with lower limit 0 (alpha=1)", - ...)) +# DEPRECATED ----------------------------------------------------------- + +## 4 Parametric -------------------------------------------------------- + +#' @title Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 1 +#' (Deprecated) +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' This function is deprecated as of version 3.3.0. Please use [CRS.5()] instead, +#' which provides a more general and flexible interface. +#' +#' A four-parameter Cedergreen-Ritz-Streibig (CRS) hormesis model where the lower +#' asymptote (`c`) is fixed at 0 and the alpha parameter controlling the steepness +#' of the hormetic component is fixed at 1. The four free parameters are `b`, `d`, +#' `e`, and `f`. +#' +#' @param names A character vector of length 5 specifying the names of the model +#' parameters in the following order: +#' \describe{ +#' \item{`b`}{Hill slope (steepness of the dose-response curve).} +#' \item{`c`}{Lower asymptote (fixed at 0 via the `fixed` argument).} +#' \item{`d`}{Upper asymptote.} +#' \item{`e`}{Effective dose producing a response midway between `c` and `d` +#' (ED50).} +#' \item{`f`}{Hormesis parameter controlling the magnitude of the stimulatory +#' effect at low doses.} +#' } +#' Defaults to `c("b", "c", "d", "e", "f")`. +#' +#' @param fixed A numeric vector of length 5 specifying fixed (non-estimated) +#' parameter values. Use `NA` for parameters that should be estimated freely. +#' Defaults to `c(NA, 0, NA, NA, NA)`, which fixes the lower asymptote `c` +#' at 0. +#' +#' @param ... Additional arguments passed to [cedergreen()]. +#' +#' @return A list of class `"drcMean"` as returned by [cedergreen()], containing +#' the model definition including the mean function, its gradient, parameter +#' names, and fixed values. This object is intended for use as the `fct` +#' argument in [drm()]. +#' +#' @author Christian Ritz, Hannes Reinwald +#' +#' @seealso +#' * [CRS.5()] — the recommended replacement for this deprecated function. +#' * [cedergreen()] — the underlying model constructor. +#' * [CRS.5a()] — the five-parameter CRS model with alpha = 1. +#' * [UCRS.4a()] — the unconstrained four-parameter CRS model with alpha = 1. +#' +#' @examples +#' # NOTE: CRS.4a() is deprecated. Use CRS.5() instead. +#' # The example below is retained for backward compatibility illustration only. +#' +#' lettuce.crsm1 <- drm( lettuce[, c(2, 1)], fct = CRS.4a() ) +#' summary(lettuce.crsm1) +#' ED(lettuce.crsm1, c(50)) +#' +#' # Recommended replacement: +#' fct_spec <- CRS.5(alpha_type = "a", fixed = c(NA, 0, NA, NA, NA)) +#' lettuce.crs5 <- drm(lettuce[, c(2, 1)], fct = fct_spec) +#' summary(lettuce.crs5) +#' ED(lettuce.crs5, c(50)) +#' +#' @keywords models nonlinear +#' @export +"CRS.4a" <- function( + names = c("b", "c", "d", "e", "f"), + fixed = c(NA, 0, NA, NA, NA), # fixed c = 0 + ... ){ + + # Deprecated warning + lifecycle::deprecate_warn( + when = "3.3.0", + what = "CRS.4a()", + with = "CRS.5()" + ) + + return( + cedergreen( + fixed = fixed, names = names, alpha = 1, + fctName = as.character(match.call()[[1]]), + fctText = "Cedergreen-Ritz-Streibig with lower limit 0 (alpha=1)", + ... + ) + ) } + +#' @title Alias for CRS.4a (Deprecated) +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' This function is a deprecated alias for [CRS.4a()], itself deprecated as of +#' version 3.3.0. Please use [CRS.5()] instead, which provides a more general +#' and flexible interface. +#' +#' @inherit CRS.4a params return +#' +#' @author Christian Ritz, Hannes Reinwald +#' +#' @seealso +#' * [CRS.5()] — the recommended replacement for this deprecated function. +#' * [CRS.4a()] — the function this alias points to. +#' * [cedergreen()] — the underlying model constructor. +#' +#' @examples +#' # NOTE: ml3a() is a deprecated alias for CRS.4a(). Use CRS.5() instead. +#' # The example below is retained for backward compatibility illustration only. +#' +#' lettuce.crsm1 <- drm( lettuce[, c(2, 1)], fct = ml3a() ) +#' summary(lettuce.crsm1) +#' ED(lettuce.crsm1, c(50)) +#' +#' # Recommended replacement: +#' fct_spec <- CRS.5(alpha_type = "a", fixed = c(NA, 0, NA, NA, NA)) +#' lettuce.crs5 <- drm(lettuce[, c(2, 1)], fct = fct_spec) +#' summary(lettuce.crs5) +#' ED(lettuce.crs5, c(50)) +#' +#' @keywords models nonlinear +#' @export ml3a <- CRS.4a -"CRS.4b" <- -function(names = c("b", "d", "e", "f"), ...) -{ - ## Checking arguments - if (!is.character(names) | !(length(names)==4)) {stop("Not correct 'names' argument")} - return(cedergreen(fixed = c(NA, 0, NA, NA, NA), names = c(names[1], "c", names[2:4]), alpha = 0.5, - fctName = as.character(match.call()[[1]]), - fctText = "Cedergreen-Ritz-Streibig with lower limit 0 (alpha=.5)", - ...)) +#' @title Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 0.5 +#' (Deprecated) +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' This function is deprecated as of version 3.3.0. Please use [CRS.5()] instead, +#' which provides a more general and flexible interface. +#' +#' A four-parameter Cedergreen-Ritz-Streibig (CRS) hormesis model where the lower +#' asymptote (`c`) is fixed at 0 and the alpha parameter controlling the steepness +#' of the hormetic component is fixed at 0.5. The four free parameters are `b`, `d`, +#' `e`, and `f`. +#' +#' @param names A character vector of length 5 specifying the names of the model +#' parameters in the following order: +#' \describe{ +#' \item{`b`}{Hill slope (steepness of the dose-response curve).} +#' \item{`c`}{Lower asymptote (fixed at 0 via the `fixed` argument).} +#' \item{`d`}{Upper asymptote.} +#' \item{`e`}{Effective dose producing a response midway between `c` and `d` +#' (ED50).} +#' \item{`f`}{Hormesis parameter controlling the magnitude of the stimulatory +#' effect at low doses.} +#' } +#' Defaults to `c("b", "c", "d", "e", "f")`. +#' +#' @param fixed A numeric vector of length 5 specifying fixed (non-estimated) +#' parameter values. Use `NA` for parameters that should be estimated freely. +#' Defaults to `c(NA, 0, NA, NA, NA)`, which fixes the lower asymptote `c` +#' at 0. +#' +#' @param ... Additional arguments passed to [cedergreen()]. +#' +#' @return A list of class `"drcMean"` as returned by [cedergreen()], containing +#' the model definition including the mean function, its gradient, parameter +#' names, and fixed values. This object is intended for use as the `fct` +#' argument in [drm()]. +#' +#' @author Christian Ritz, Hannes Reinwald +#' +#' @seealso +#' * [CRS.5()] — the recommended replacement for this deprecated function. +#' * [cedergreen()] — the underlying model constructor. +#' * [CRS.4a()] — the four-parameter CRS model with lower limit fixed at 0 and alpha = 1. +#' * [CRS.5b()] — the five-parameter CRS model with alpha = 0.5. +#' +#' @examples +#' # NOTE: CRS.4b() is deprecated. Use CRS.5() instead. +#' # The example below is retained for backward compatibility illustration only. +#' +#' lettuce.crsm2 <- drm( lettuce[, c(2, 1)], fct = CRS.4b() ) +#' summary(lettuce.crsm2) +#' ED(lettuce.crsm2, c(50)) +#' +#' # Recommended replacement: +#' fct_spec <- CRS.5(alpha_type = "b", fixed = c(NA, 0, NA, NA, NA)) +#' lettuce.crs5 <- drm(lettuce[, c(2, 1)], fct = fct_spec) +#' summary(lettuce.crs5) +#' ED(lettuce.crs5, c(50)) +#' +#' @keywords models nonlinear +#' @export +"CRS.4b" <- function( + names = c("b", "c", "d", "e", "f"), + fixed = c(NA, 0, NA, NA, NA), # fixed c = 0 + ... ){ + + # Deprecated warning + lifecycle::deprecate_warn( + when = "3.3.0", + what = "CRS.4b()", + with = "CRS.5()" + ) + + return( + cedergreen( + fixed = fixed, names = names, alpha = 0.5, + fctName = as.character(match.call()[[1]]), + fctText = "Cedergreen-Ritz-Streibig with lower limit 0 (alpha=0.5)", + ... + ) + ) } +#' @title Alias for CRS.4b (Deprecated) +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' This function is a deprecated alias for [CRS.4b()], itself deprecated as of +#' version 3.3.0. Please use [CRS.5()] instead, which provides a more general +#' and flexible interface. +#' +#' @inherit CRS.4b params return +#' +#' @author Christian Ritz, Hannes Reinwald +#' +#' @seealso +#' * [CRS.5()] — the recommended replacement for this deprecated function. +#' * [CRS.4b()] — the function this alias points to. +#' * [cedergreen()] — the underlying model constructor. +#' +#' @examples +#' # NOTE: ml3b() is a deprecated alias for CRS.4b(). Use CRS.5() instead. +#' # The example below is retained for backward compatibility illustration only. +#' +#' lettuce.crsm2 <- drm( lettuce[, c(2, 1)], fct = ml3b() ) +#' summary(lettuce.crsm2) +#' ED(lettuce.crsm2, c(50)) +#' +#' # Recommended replacement: +#' fct_spec <- CRS.5(alpha_type = "b", fixed = c(NA, 0, NA, NA, NA)) +#' lettuce.crs5 <- drm(lettuce[, c(2, 1)], fct = fct_spec) +#' summary(lettuce.crs5) +#' ED(lettuce.crs5, c(50)) +#' +#' @keywords models nonlinear +#' @export ml3b <- CRS.4b -"CRS.4c" <- -function(names = c("b", "d", "e", "f"), ...) -{ - ## Checking arguments - if (!is.character(names) | !(length(names)==4)) {stop("Not correct 'names' argument")} - return(cedergreen(fixed = c(NA, 0, NA, NA, NA), names = c(names[1], "c", names[2:4]), alpha = 0.25, - fctName = as.character(match.call()[[1]]), - fctText = "Cedergreen-Ritz-Streibig with lower limit 0 (alpha=.25)", - ...)) +#' @title Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 0.25 +#' (Deprecated) +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' This function is deprecated as of version 3.3.0. Please use [CRS.5()] instead, +#' which provides a more general and flexible interface. +#' +#' A four-parameter Cedergreen-Ritz-Streibig (CRS) hormesis model where the lower +#' asymptote (`c`) is fixed at 0 and the alpha parameter controlling the steepness +#' of the hormetic component is fixed at 0.25. The four free parameters are `b`, `d`, +#' `e`, and `f`. +#' +#' @param names A character vector of length 5 specifying the names of the model +#' parameters in the following order: +#' \describe{ +#' \item{`b`}{Hill slope (steepness of the dose-response curve).} +#' \item{`c`}{Lower asymptote (fixed at 0 via the `fixed` argument).} +#' \item{`d`}{Upper asymptote.} +#' \item{`e`}{Effective dose producing a response midway between `c` and `d` +#' (ED50).} +#' \item{`f`}{Hormesis parameter controlling the magnitude of the stimulatory +#' effect at low doses.} +#' } +#' Defaults to `c("b", "c", "d", "e", "f")`. +#' +#' @param fixed A numeric vector of length 5 specifying fixed (non-estimated) +#' parameter values. Use `NA` for parameters that should be estimated freely. +#' Defaults to `c(NA, 0, NA, NA, NA)`, which fixes the lower asymptote `c` +#' at 0. +#' +#' @param ... Additional arguments passed to [cedergreen()]. +#' +#' @return A list of class `"drcMean"` as returned by [cedergreen()], containing +#' the model definition including the mean function, its gradient, parameter +#' names, and fixed values. This object is intended for use as the `fct` +#' argument in [drm()]. +#' +#' @author Christian Ritz, Hannes Reinwald +#' +#' @seealso +#' * [CRS.5()] — the recommended replacement for this deprecated function. +#' * [cedergreen()] — the underlying model constructor. +#' * [CRS.4a()] — the four-parameter CRS model with lower limit fixed at 0 and alpha = 1. +#' * [CRS.5c()] — the five-parameter CRS model with alpha = 0.25. +#' +#' @examples +#' # NOTE: CRS.4c() is deprecated. Use CRS.5() instead. +#' # The example below is retained for backward compatibility illustration only. +#' +#' lettuce.crsm3 <- drm( lettuce[, c(2, 1)], fct = CRS.4c() ) +#' summary(lettuce.crsm3) +#' ED(lettuce.crsm3, c(50)) +#' +#' # Recommended replacement: +#' fct_spec <- CRS.5(alpha_type = "c", fixed = c(NA, 0, NA, NA, NA)) +#' lettuce.crs5 <- drm(lettuce[, c(2, 1)], fct = fct_spec) +#' summary(lettuce.crs5) +#' ED(lettuce.crs5, c(50)) +#' +#' @keywords models nonlinear +#' @export +"CRS.4c" <- function( + names = c("b", "c", "d", "e", "f"), + fixed = c(NA, 0, NA, NA, NA), # fixed c = 0 + ... ){ + + # Deprecated warning + lifecycle::deprecate_warn( + when = "3.3.0", + what = "CRS.4c()", + with = "CRS.5()" + ) + + return( + cedergreen( + fixed = fixed, names = names, alpha = 0.25, + fctName = as.character(match.call()[[1]]), + fctText = "Cedergreen-Ritz-Streibig with lower limit 0 (alpha=0.25)", + ... + ) + ) } +#' @title Alias for CRS.4c (Deprecated) +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' This function is a deprecated alias for [CRS.4c()], itself deprecated as of +#' version 3.3.0. Please use [CRS.5()] instead, which provides a more general +#' and flexible interface. +#' +#' @inherit CRS.4c params return +#' +#' @author Christian Ritz, Hannes Reinwald +#' +#' @seealso +#' * [CRS.5()] — the recommended replacement for this deprecated function. +#' * [CRS.4c()] — the function this alias points to. +#' * [cedergreen()] — the underlying model constructor. +#' +#' @examples +#' # NOTE: ml3c() is a deprecated alias for CRS.4c(). Use CRS.5() instead. +#' # The example below is retained for backward compatibility illustration only. +#' +#' lettuce.crsm3 <- drm( lettuce[, c(2, 1)], fct = ml3c() ) +#' summary(lettuce.crsm3) +#' ED(lettuce.crsm3, c(50)) +#' +#' # Recommended replacement: +#' fct_spec <- CRS.5(alpha_type = "c", fixed = c(NA, 0, NA, NA, NA)) +#' lettuce.crs5 <- drm(lettuce[, c(2, 1)], fct = fct_spec) +#' summary(lettuce.crs5) +#' ED(lettuce.crs5, c(50)) +#' +#' @keywords models nonlinear +#' @export ml3c <- CRS.4c -"CRS.5a" <- -function(names = c("b", "c", "d", "e", "f"), ...) -{ - ## Checking arguments - if (!is.character(names) | !(length(names)==5)) {stop("Not correct 'names' argument")} - - return(cedergreen(fixed = c(NA, NA, NA, NA, NA), names = names, alpha = 1, - fctName = as.character(match.call()[[1]]), - fctText = "Cedergreen-Ritz-Streibig (alpha=1)", - ...)) + +## 5 Parametric -------------------------------------------------------- + +#' @title Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 1 +#' (Deprecated) +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' This function is deprecated as of version 3.3.0. Please use [CRS.5()] instead, +#' which provides a more general and flexible interface. +#' +#' A five-parameter Cedergreen-Ritz-Streibig (CRS) hormesis model where the alpha +#' parameter controlling the steepness of the hormetic component is fixed at 1. +#' All five parameters `b`, `c`, `d`, `e`, and `f` are freely estimated. +#' +#' @param names A character vector of length 5 specifying the names of the model +#' parameters in the following order: +#' \describe{ +#' \item{`b`}{Hill slope (steepness of the dose-response curve).} +#' \item{`c`}{Lower asymptote (freely estimated).} +#' \item{`d`}{Upper asymptote.} +#' \item{`e`}{Effective dose producing a response midway between `c` and `d` +#' (ED50).} +#' \item{`f`}{Hormesis parameter controlling the magnitude of the stimulatory +#' effect at low doses.} +#' } +#' Defaults to `c("b", "c", "d", "e", "f")`. +#' +#' @param fixed A numeric vector of length 5 specifying fixed (non-estimated) +#' parameter values. Use `NA` for parameters that should be estimated freely. +#' Defaults to `c(NA, NA, NA, NA, NA)`, meaning all five parameters are +#' freely estimated. +#' +#' @param ... Additional arguments passed to [cedergreen()]. +#' +#' @return A list of class `"drcMean"` as returned by [cedergreen()], containing +#' the model definition including the mean function, its gradient, parameter +#' names, and fixed values. This object is intended for use as the `fct` +#' argument in [drm()]. +#' +#' @author Christian Ritz, Hannes Reinwald +#' +#' @seealso +#' * [CRS.5()] — the recommended replacement for this deprecated function. +#' * [cedergreen()] — the underlying model constructor. +#' * [CRS.4a()] — the four-parameter CRS model with lower limit fixed at 0 and alpha = 1. +#' * [UCRS.5a()] — the unconstrained five-parameter CRS model with alpha = 1. +#' +#' @examples +#' # NOTE: CRS.5a() is deprecated. Use CRS.5() instead. +#' # The example below is retained for backward compatibility illustration only. +#' +#' lettuce.m1 <- drm( lettuce[, c(2, 1)], fct = CRS.5a() ) +#' summary(lettuce.m1) +#' ED(lettuce.m1, c(50)) +#' +#' # Recommended replacement: +#' lettuce.crs5 <- drm( lettuce[, c(2, 1)], fct = CRS.5(alpha_type = "a") ) +#' summary(lettuce.crs5) +#' ED(lettuce.crs5, c(50)) +#' +#' @keywords models nonlinear +#' @export +"CRS.5a" <- function( + names = c("b", "c", "d", "e", "f"), + fixed = c(NA, NA, NA, NA, NA), + ... ){ + + # Deprecated warning + lifecycle::deprecate_warn( + when = "3.3.0", + what = "CRS.5a()", + with = "CRS.5()" + ) + + return( + cedergreen( + fixed = fixed, names = names, alpha = 1, + fctName = as.character(match.call()[[1]]), + fctText = "Cedergreen-Ritz-Streibig (alpha=1)", + ... + ) + ) } + +#' @title Alias for CRS.5a (Deprecated) +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' This function is a deprecated alias for [CRS.5a()], itself deprecated as of +#' version 3.3.0. Please use [CRS.5()] instead, which provides a more general +#' and flexible interface. +#' +#' @inherit CRS.5a params return +#' +#' @author Christian Ritz, Hannes Reinwald +#' +#' @seealso +#' * [CRS.5()] — the recommended replacement for this deprecated function. +#' * [CRS.5a()] — the function this alias points to. +#' * [cedergreen()] — the underlying model constructor. +#' +#' @examples +#' # NOTE: ml4a() is a deprecated alias for CRS.5a(). Use CRS.5() instead. +#' # The example below is retained for backward compatibility illustration only. +#' +#' lettuce.m1 <- drm( lettuce[, c(2, 1)], fct = ml4a() ) +#' summary(lettuce.m1) +#' ED(lettuce.m1, c(50)) +#' +#' # Recommended replacement: +#' lettuce.crs5 <- drm( lettuce[, c(2, 1)], fct = CRS.5(alpha_type = "a") ) +#' summary(lettuce.crs5) +#' ED(lettuce.crs5, c(50)) +#' +#' @keywords models nonlinear +#' @export ml4a <- CRS.5a -"CRS.5b" <- -function(names = c("b", "c", "d", "e", "f"), ...) -{ - ## Checking arguments - if (!is.character(names) | !(length(names)==5)) {stop("Not correct 'names' argument")} - return(cedergreen(fixed = c(NA, NA, NA, NA, NA), names = names, alpha = 0.5, - fctName = as.character(match.call()[[1]]), - fctText = "Cedergreen-Ritz-Streibig (alpha=.5)", - ...)) +#' @title Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 0.5 +#' (Deprecated) +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' This function is deprecated as of version 3.3.0. Please use [CRS.5()] instead, +#' which provides a more general and flexible interface. +#' +#' A five-parameter Cedergreen-Ritz-Streibig (CRS) hormesis model where the alpha +#' parameter controlling the steepness of the hormetic component is fixed at 0.5. +#' All five parameters `b`, `c`, `d`, `e`, and `f` are freely estimated. +#' +#' @param names A character vector of length 5 specifying the names of the model +#' parameters in the following order: +#' \describe{ +#' \item{`b`}{Hill slope (steepness of the dose-response curve).} +#' \item{`c`}{Lower asymptote (freely estimated).} +#' \item{`d`}{Upper asymptote.} +#' \item{`e`}{Effective dose producing a response midway between `c` and `d` +#' (ED50).} +#' \item{`f`}{Hormesis parameter controlling the magnitude of the stimulatory +#' effect at low doses.} +#' } +#' Defaults to `c("b", "c", "d", "e", "f")`. +#' +#' @param fixed A numeric vector of length 5 specifying fixed (non-estimated) +#' parameter values. Use `NA` for parameters that should be estimated freely. +#' Defaults to `c(NA, NA, NA, NA, NA)`, meaning all five parameters are +#' freely estimated. +#' +#' @param ... Additional arguments passed to [cedergreen()]. +#' +#' @return A list of class `"drcMean"` as returned by [cedergreen()], containing +#' the model definition including the mean function, its gradient, parameter +#' names, and fixed values. This object is intended for use as the `fct` +#' argument in [drm()]. +#' +#' @author Christian Ritz, Hannes Reinwald +#' +#' @seealso +#' * [CRS.5()] — the recommended replacement for this deprecated function. +#' * [cedergreen()] — the underlying model constructor. +#' * [CRS.4b()] — the four-parameter CRS model with lower limit fixed at 0 and alpha = 0.5. +#' * [CRS.5a()] — the five-parameter CRS model with alpha = 1. +#' +#' @examples +#' # NOTE: CRS.5b() is deprecated. Use CRS.5() instead. +#' # The example below is retained for backward compatibility illustration only. +#' +#' lettuce.m2 <- drm( lettuce[, c(2, 1)], fct = CRS.5b() ) +#' summary(lettuce.m2) +#' ED(lettuce.m2, c(50)) +#' +#' # Recommended replacement: +#' lettuce.crs5 <- drm( lettuce[, c(2, 1)], fct = CRS.5(alpha_type = "b") ) +#' summary(lettuce.crs5) +#' ED(lettuce.crs5, c(50)) +#' +#' @keywords models nonlinear +#' @export +"CRS.5b" <- function( + names = c("b", "c", "d", "e", "f"), + fixed = c(NA, NA, NA, NA, NA), + ... ){ + + # Deprecated warning + lifecycle::deprecate_warn( + when = "3.3.0", + what = "CRS.5b()", + with = "CRS.5()" + ) + + return( + cedergreen( + fixed = fixed, names = names, alpha = 0.5, + fctName = as.character(match.call()[[1]]), + fctText = "Cedergreen-Ritz-Streibig (alpha=0.5)", + ... + ) + ) } + +#' @title Alias for CRS.5b (Deprecated) +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' This function is a deprecated alias for [CRS.5b()], itself deprecated as of +#' version 3.3.0. Please use [CRS.5()] instead, which provides a more general +#' and flexible interface. +#' +#' @inherit CRS.5b params return +#' +#' @author Christian Ritz, Hannes Reinwald +#' +#' @seealso +#' * [CRS.5()] — the recommended replacement for this deprecated function. +#' * [CRS.5b()] — the function this alias points to. +#' * [cedergreen()] — the underlying model constructor. +#' +#' @examples +#' # NOTE: ml4b() is a deprecated alias for CRS.5b(). Use CRS.5() instead. +#' # The example below is retained for backward compatibility illustration only. +#' +#' lettuce.m2 <- drm( lettuce[, c(2, 1)], fct = ml4b() ) +#' summary(lettuce.m2) +#' ED(lettuce.m2, c(50)) +#' +#' # Recommended replacement: +#' lettuce.crs5 <- drm( lettuce[, c(2, 1)], fct = CRS.5(alpha_type = "b") ) +#' summary(lettuce.crs5) +#' ED(lettuce.crs5, c(50)) +#' +#' @keywords models nonlinear +#' @export ml4b <- CRS.5b -"CRS.5c" <- -function(names = c("b", "c", "d", "e", "f"), ...) -{ - ## Checking arguments - if (!is.character(names) | !(length(names)==5)) {stop("Not correct 'names' argument")} - return(cedergreen(fixed = c(NA, NA, NA, NA, NA), names = names, alpha = 0.25, - fctName = as.character(match.call()[[1]]), - fctText = "Cedergreen-Ritz-Streibig (alpha=.25)", - ...)) +#' @title Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 0.25 +#' (Deprecated) +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' This function is deprecated as of version 3.3.0. Please use [CRS.5()] instead, +#' which provides a more general and flexible interface. +#' +#' A five-parameter Cedergreen-Ritz-Streibig (CRS) hormesis model where the alpha +#' parameter controlling the steepness of the hormetic component is fixed at 0.25. +#' All five parameters `b`, `c`, `d`, `e`, and `f` are freely estimated. +#' +#' @param names A character vector of length 5 specifying the names of the model +#' parameters in the following order: +#' \describe{ +#' \item{`b`}{Hill slope (steepness of the dose-response curve).} +#' \item{`c`}{Lower asymptote (freely estimated).} +#' \item{`d`}{Upper asymptote.} +#' \item{`e`}{Effective dose producing a response midway between `c` and `d` +#' (ED50).} +#' \item{`f`}{Hormesis parameter controlling the magnitude of the stimulatory +#' effect at low doses.} +#' } +#' Defaults to `c("b", "c", "d", "e", "f")`. +#' +#' @param fixed A numeric vector of length 5 specifying fixed (non-estimated) +#' parameter values. Use `NA` for parameters that should be estimated freely. +#' Defaults to `c(NA, NA, NA, NA, NA)`, meaning all five parameters are +#' freely estimated. +#' +#' @param ... Additional arguments passed to [cedergreen()]. +#' +#' @return A list of class `"drcMean"` as returned by [cedergreen()], containing +#' the model definition including the mean function, its gradient, parameter +#' names, and fixed values. This object is intended for use as the `fct` +#' argument in [drm()]. +#' +#' @author Christian Ritz, Hannes Reinwald +#' +#' @seealso +#' * [CRS.5()] — the recommended replacement for this deprecated function. +#' * [cedergreen()] — the underlying model constructor. +#' * [CRS.4c()] — the four-parameter CRS model with lower limit fixed at 0 and alpha = 0.25. +#' * [CRS.5b()] — the five-parameter CRS model with alpha = 0.5. +#' +#' @examples +#' # NOTE: CRS.5c() is deprecated. Use CRS.5() instead. +#' # The example below is retained for backward compatibility illustration only. +#' +#' lettuce.m3 <- drm( lettuce[, c(2, 1)], fct = CRS.5c() ) +#' summary(lettuce.m3) +#' ED(lettuce.m3, c(50)) +#' +#' # Recommended replacement: +#' lettuce.crs5 <- drm( lettuce[, c(2, 1)], fct = CRS.5(alpha_type = "c") ) +#' summary(lettuce.crs5) +#' ED(lettuce.crs5, c(50)) +#' +#' @keywords models nonlinear +#' @export +"CRS.5c" <- function( + names = c("b", "c", "d", "e", "f"), + fixed = c(NA, NA, NA, NA, NA), + ... ){ + + # Deprecated warning + lifecycle::deprecate_warn( + when = "3.3.0", + what = "CRS.5c()", + with = "CRS.5()" + ) + + return( + cedergreen( + fixed = fixed, names = names, alpha = 0.25, + fctName = as.character(match.call()[[1]]), + fctText = "Cedergreen-Ritz-Streibig (alpha=0.25)", + ... + ) + ) } -ml4c <- CRS.5c - +#' @title Alias for CRS.5c (Deprecated) +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' This function is a deprecated alias for [CRS.5c()], itself deprecated as of +#' version 3.3.0. Please use [CRS.5()] instead, which provides a more general +#' and flexible interface. +#' +#' @inherit CRS.5c params return +#' +#' @author Christian Ritz, Hannes Reinwald +#' +#' @seealso +#' * [CRS.5()] — the recommended replacement for this deprecated function. +#' * [CRS.5c()] — the function this alias points to. +#' * [cedergreen()] — the underlying model constructor. +#' +#' @examples +#' # NOTE: ml4c() is a deprecated alias for CRS.5c(). Use CRS.5() instead. +#' # The example below is retained for backward compatibility illustration only. +#' +#' lettuce.m3 <- drm( lettuce[, c(2, 1)], fct = ml4c() ) +#' summary(lettuce.m3) +#' ED(lettuce.m3, c(50)) +#' +#' # Recommended replacement: +#' lettuce.crs5 <- drm( lettuce[, c(2, 1)], fct = CRS.5(alpha_type = "c") ) +#' summary(lettuce.crs5) +#' ED(lettuce.crs5, c(50)) +#' +#' @keywords models nonlinear +#' @export +ml4c <- CRS.5c \ No newline at end of file diff --git a/R/cedergreen.ssf.R b/R/cedergreen.ssf.R index 415e1f0d..04a11fed 100644 --- a/R/cedergreen.ssf.R +++ b/R/cedergreen.ssf.R @@ -1,34 +1,111 @@ -"cedergreen.ssf" <- function(method = c("1", "2", "3", "4"), fixed, alpha, useFixed = FALSE) -{ - method <- match.arg(method) - - ## Defining helper functions (used below) - ytrans <- function(y, cVal, dVal) {log((dVal - y)/(y - cVal))} - bfct <- function(x, y, cVal, dVal, eVal) {ytrans(y, cVal, dVal) / log(x / eVal)} - efct <- function(x, y, bVal, cVal, dVal) {x * exp(-ytrans(y, cVal, dVal)/bVal)} - - ## Assigning function for finding initial b and e parameter values - findbe <- switch(method, - "1" = findbe1(function(x) {rVec <- log(x); rVec[!x>0] <- NA; rVec}, ytrans), - "2" = findbe2(bfct, efct, "Anke"), - "3" = findbe3(), - "4" = findbe2(bfct, efct, "Normolle")) - - function(dframe) - { - x <- dframe[, 1] - y <- dframe[, 2] - - ## Finding initial values for c and d parameters - cdVal <- findcd(x, y) - if (useFixed) {} # not implemented at the moment - - ## Finding initial values for b and e parameters - beVal <- findbe(x, y, cdVal[1], cdVal[2]) - - ## Finding initial value for f parameter - fVal <- (2*(median(y) - cdVal[1]) - (cdVal[2] - cdVal[1])) * exp(1/(beVal[2]^alpha)) - - return(c(beVal[1], cdVal, beVal[2], fVal)[is.na(fixed)]) - } -} +#' @title Self-starter for the Cedergreen-Ritz-Streibig Dose-Response Model +#' @description A self-starting function for the Cedergreen-Ritz-Streibig model, +#' used to find initial parameter estimates for non-linear regression (e.g., with `nls` or `drc`). +#' +#' @details This function is a closure that returns another function. The returned +#' function takes a data frame and calculates initial values for the model parameters +#' (b, c, d, e, f). This self-starter relies on several helper functions +#' (e.g., `findcd`, `findbe1`, `findbe2`, `findbe3`) which must be available in the +#' calling environment. +#' +#' @param method A character string specifying the method for estimating initial +#' 'b' and 'e' parameters. Using descriptive names is preferred. +#' @param fixed A numeric vector of fixed parameter values, with `NA` for +#' parameters that need to be estimated. The required order is `c(b, c, d, e, f)`. +#' @param alpha A numeric value for the alpha parameter, which is treated as a known +#' constant during the estimation of the other initial parameters. +#' @param useFixed A logical value. If `TRUE`, the function will use the non-NA +#' values provided in the `fixed` argument as fixed parameters and only estimate the others. +#' +#' @return A numeric vector of initial parameter estimates for the model parameters +#' that were not specified as `fixed`. +#' @keywords internal +#' @export +"cedergreen.ssf" <- function(method = c("loglinear", "anke", "method3", "normolle"), fixed, alpha, useFixed = FALSE) { + # Note: The dot (.) has a special meaning in R. It is used to separate a generic function from its method in the S3 object-oriented system. + # Therefore it is not recomended to use the "." string in function naming. The make sure that R does not falsly interpret the "." symbol I put + # the function asignment into quotes here. Hoping this makes it more robut. + method <- match.arg(method) + + ## Helper functions for transformations and calculations + # Transformation of the response variable + y_transform <- function(y, c_val, d_val) { + log((d_val - y) / (y - c_val)) + } + # Function to calculate the 'b' parameter + b_function <- function(x, y, c_val, d_val, e_val) { + y_transform(y, c_val, d_val) / log(x / e_val) + } + # Function to calculate the 'e' parameter (ED50) + e_function <- function(x, y, b_val, c_val, d_val) { + x * exp(-y_transform(y, c_val, d_val) / b_val) + } + + ## Assign the chosen method for finding initial 'b' and 'e' parameter values. + ## This relies on external helper functions: findbe1, findbe2, findbe3. + find_be_method <- switch(method, + "loglinear" = findbe1(function(x) { + # Safely calculate log of dose, returning NA for non-positive values + log_dose <- rep(NA, length(x)) + log_dose[x > 0] <- log(x[x > 0]) + log_dose + }, y_transform), + "anke" = findbe2(b_function, e_function, "Anke"), + "method3" = findbe3(), + "normolle" = findbe2(b_function, e_function, "Normolle") + ) + + # This is the actual self-starter function returned by the closure + function(dframe) { + dose <- dframe[, 1] + response <- dframe[, 2] + + # --- Parameter Initialization --- + # The 'fixed' vector order is c(b, c, d, e, f) + + # Initial values for c (lower limit) and d (upper limit) + if (useFixed && !is.na(fixed[2]) && !is.na(fixed[3])) { + c_init <- fixed[2] + d_init <- fixed[3] + } else { + # Calculate if not fixed. Relies on external findcd(). + initial_cd <- findcd(dose, response) + c_init <- if (useFixed && !is.na(fixed[2])) fixed[2] else initial_cd[1] + d_init <- if (useFixed && !is.na(fixed[3])) fixed[3] else initial_cd[2] + } + + # --- Robustness Check --- + # The y_transform requires response values to be strictly between c and d. + if (any(response <= c_init) || any(response >= d_init)) { + warning("Response values detected outside the initial (c, d) asymptotes. Adjusting asymptotes slightly to prevent math errors.") + # Adjust c and d to encompass all data points, with a small buffer + c_init <- min(c_init, min(response) - 0.01 * abs(min(response))) + d_init <- max(d_init, max(response) + 0.01 * abs(max(response))) + } + + # Initial values for b and e + if (useFixed && !is.na(fixed[1]) && !is.na(fixed[4])) { + b_init <- fixed[1] + e_init <- fixed[4] + } else { + initial_be <- find_be_method(dose, response, c_init, d_init) + b_init <- if (useFixed && !is.na(fixed[1])) fixed[1] else initial_be[1] + e_init <- if (useFixed && !is.na(fixed[4])) fixed[4] else initial_be[2] + } + + # Initial value for f + if (useFixed && !is.na(fixed[5])) { + f_init <- fixed[5] + } else { + # This calculation is based on the model's properties at a specific point. + # It ensures the curve shape is reasonable based on the median response. + f_init <- (2 * (median(response) - c_init) - (d_init - c_init)) * exp(1 / (e_init^alpha)) + } + + # Assemble a named vector of all initial parameter estimates + initial_estimates <- c(b = b_init, c = c_init, d = d_init, e = e_init, f = f_init) + + # Return only the estimates for parameters that are NOT fixed (i.e., are NA in the 'fixed' vector) + return(initial_estimates[is.na(fixed)]) + } +} diff --git a/R/coef.drc.R b/R/coef.drc.R index fbf52280..33e9e6b9 100644 --- a/R/coef.drc.R +++ b/R/coef.drc.R @@ -1,3 +1,22 @@ +#' @title Extract Model Coefficients +#' +#' @description +#' Extract parameter estimates. +#' +#' @param object an object of class 'drc'. +#' @param ... additional arguments. +#' +#' @return A vector of parameter coefficients which are extracted from the +#' model object \code{object}. +#' +#' @examples +#' ## Fitting a four-parameter log-logistic model +#' ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +#' coef(ryegrass.m1) +#' +#' @author Christian Ritz +#' +#' @keywords models nonlinear "coef.drc" <- function(object, ...) { diff --git a/R/commatFct.R b/R/commatFct.R index b1525f4d..7ccf90a8 100644 --- a/R/commatFct.R +++ b/R/commatFct.R @@ -1,11 +1,13 @@ -commatFct <- function(object, compMatch) -{ - parmMat <- object$parmMat - - if (!is.null(compMatch)) - { - return(parmMat[, (colnames(parmMat) %in% c(compMatch[1], compMatch[2])), drop = FALSE ]) - } else { - parmMat - } +#' @title Construct contrast matrix +#' @keywords internal +commatFct <- function(object, compMatch) +{ + parmMat <- object$parmMat + + if (!is.null(compMatch)) + { + return(parmMat[, (colnames(parmMat) %in% c(compMatch[1], compMatch[2])), drop = FALSE ]) + } else { + parmMat + } } \ No newline at end of file diff --git a/R/compParm.R b/R/compParm.R index eacc8b28..abe15aab 100644 --- a/R/compParm.R +++ b/R/compParm.R @@ -1,9 +1,51 @@ +#' @title Comparison of parameters +#' +#' @description +#' Compare parameters from different assays, either by means of ratios or differences. +#' +#' @param object an object of class 'drc'. +#' @param strVal a name of parameter to compare. +#' @param operator a character. If equal to \code{"/"} (default) parameter ratios are compared. +#' If equal to \code{"-"} parameter differences are compared. +#' @param vcov. function providing the variance-covariance matrix. \code{\link{vcov}} is the default, +#' but \code{sandwich} is also an option (for obtaining robust standard errors). +#' @param od logical. If TRUE adjustment for over-dispersion is used. +#' @param pool logical. If TRUE curves are pooled. Otherwise they are not. This argument only works +#' for models with independently fitted curves as specified in \code{\link{drm}}. +#' @param display logical. If TRUE results are displayed. Otherwise they are not (useful in simulations). +#' +#' @return A matrix with columns containing the estimates, estimated standard errors, values of +#' t-statistics and p-values for the null hypothesis that the ratio equals 1 or that the difference +#' equals 0 (depending on the \code{operator} argument). +#' +#' @seealso \code{\link{ED.drc}} for calculating effective doses and \code{\link{EDcomp}} for +#' comparing effective doses. +#' +#' @examples +#' spinach.m1 <- drm(SLOPE~DOSE, CURVE, data = spinach, +#' fct = LL.4(names = c("b", "lower", "upper", "ed50"))) +#' +#' ## Calculating ratios of parameter estimates for "ed50" +#' compParm(spinach.m1, "ed50") +#' +#' ## Calculating differences between parameter estimates for "ed50" +#' compParm(spinach.m1, "ed50", "-") +#' +#' @author Christian Ritz +#' @keywords models nonlinear "compParm" <- function(object, strVal, operator = "/", vcov. = vcov, od = FALSE, pool = TRUE, display = TRUE) { -# if (inherits(object, "mixdrc")) {sep <- ".{1}"} else {sep <- ":{1}"} + ## Input validation + if (!is.character(strVal) || length(strVal) != 1) { + stop("'strVal' must be a single character string") + } + if (!identical(operator, "/") && !identical(operator, "-")) { + stop("'operator' must be either '/' or '-'") + } + sep <- ":{1}" - presentVec <- grep(paste("^", strVal, sep, sep = ""), object$"parNames"[[1]]) # strParm) + presentVec <- grep(paste("^", strVal, sep, sep = ""), object$"parNames"[[1]]) # strParm) lenPV <- length(presentVec) if (lenPV < 2) @@ -12,17 +54,12 @@ function(object, strVal, operator = "/", vcov. = vcov, od = FALSE, pool = TRUE, } ## Extracting information from model fit -# if (inherits(object, "mixdrc")) -# { -# sumObj <- summary(object) -# parm <- sumObj$"coefficients" -# varMat <- sumObj$"varMat" -# } else { -# parm <- as.vector(coef(object)) -# varMat <- vcov(object, od = od, pool = pool) -# } parm <- as.vector(coef(object)) - varMat <- vcov.(object) + if (identical(vcov., vcov)) { + varMat <- vcov.(object, od = od, pool = pool) + } else { + varMat <- vcov.(object) + } ## Defining comparison function and its derivative if (identical(operator, "/")) diff --git a/R/comped.R b/R/comped.R new file mode 100644 index 00000000..7bd9b09f --- /dev/null +++ b/R/comped.R @@ -0,0 +1,101 @@ +#' @title Comparison of effective dose values +#' +#' @description +#' Comparison of a pair of effective dose values from independent experiments where only the +#' estimates and their standard errors are reported. +#' +#' @param est a numeric vector of length 2 containing the two estimated ED values. +#' @param se a numeric vector of length 2 containing the two standard errors. +#' @param log logical indicating whether or not estimates and standard errors are on log scale. +#' @param interval logical indicating whether or not a confidence interval should be returned. +#' @param operator character string taking one of the two values \code{"-"} (default) or \code{"/"} +#' corresponding to a comparison based on the difference or the ratio. +#' @param level numeric value giving the confidence level. +#' @param df numeric value specifying the degrees of freedom for the percentile used in the +#' confidence interval (optional). By default confidence interval relies on the normal distribution. +#' +#' @return A matrix with the estimated difference or ratio and the associated standard error and the +#' resulting confidence interval (unless not requested). +#' +#' @examples +#' ## Comparing ED50 values as a ratio +#' comped(c(28.396, 65.573), c(1.875, 5.619), log = FALSE, operator = "/") +#' +#' ## Comparing ED50 values as a difference +#' comped(c(28.396, 65.573), c(1.875, 5.619), log = FALSE, operator = "-") +#' +#' @author Christian Ritz +#' @keywords models nonlinear +"comped" <- function(est, se, log = TRUE, interval = TRUE, operator = c("-", "/"), level = 0.95, df = NULL) +{ + operator <- match.arg(operator) + + ## Input validation + if (!is.numeric(est) || length(est) != 2) { + stop("'est' must be a numeric vector of length 2") + } + if (!is.numeric(se) || length(se) != 2) { + stop("'se' must be a numeric vector of length 2") + } + if (any(se < 0, na.rm = TRUE)) { + stop("'se' must contain non-negative values") + } + if (!is.numeric(level) || length(level) != 1 || level <= 0 || level >= 1) { + stop("'level' must be a single numeric value between 0 and 1") + } + + if (identical(operator, "-")) + { + opText <- "difference" + } else { + opText <- "ratio" + } + + vcMat <- diag(se^2) + if (!log) + { + if (identical(operator, "-")) + { + derivVec <- c(1, -1) + estVal <- est[1] - est[2] + } else { + derivVec <- c(1 / est[2], -est[1] / (est[2]^2)) + estVal <- est[1] / est[2] + } + } else { + derivVec <- c(1, -1) + estVal <- est[1] - est[2] + } + resList <- list(estimate = estVal, se = sqrt(as.numeric(derivVec %*% vcMat %*% derivVec))) + colNames <- c("Estimate", "Std. Error") + + edMat <- matrix(c(resList$estimate, resList$se), nrow = 1) + if (interval) + { + colNames <- c(colNames, "Lower", "Upper") + + ## Setting degrees of freedom (by default based on normality) + if (is.null(df)) + { + quanVal <- qnorm(1 - (1 - level)/2) + } else { + quanVal <- qt(1 - (1 - level)/2, df) + } + ciMat <- matrix(c(edMat[1, 1] - quanVal * edMat[1, 2], edMat[1, 1] + quanVal * edMat[1, 2]), nrow = 1) + + if (log && (identical(operator, "/"))) + { + ciMat <- exp(ciMat) + } + edMat <- cbind(edMat, ciMat) + } + colnames(edMat) <- colNames + + cat("\n") + cat("Estimated", opText, "of effective doses\n") + if (interval && log && (identical(operator, "/"))) {cat("(confidence interval on original scale)\n")} + cat("\n") + + printCoefmat(edMat) + invisible(edMat) +} \ No newline at end of file diff --git a/R/comped.r b/R/comped.r deleted file mode 100644 index 657cd54b..00000000 --- a/R/comped.r +++ /dev/null @@ -1,64 +0,0 @@ -"comped" <- function(est, se, log = TRUE, interval = TRUE, operator = c("-", "/"), level = 0.95, df = NULL) -{ - operator <- match.arg(operator) - if (identical(operator, "-")) - { - opText <- "difference" - } else { - opText <- "ratio" - } - - vcMat <- diag(se^2) - if (!log) - { - if (identical(operator, "-")) - { -# resList <- compute.delta.method(vcMat, expression(b1-b2), est, c("b1", "b2"), print = FALSE) - - derivVec <- c(1, -1) - estVal <- est[1] - est[2] - } else { -# resList <- compute.delta.method(vcMat, expression(b1/b2), est, c("b1", "b2"), print = FALSE) - - derivVec <- c(1 / est[2], -est[1] / (est[2]^2)) - estVal <- est[1] / est[2] - } - } else { - # resList <- compute.delta.method(vcMat, expression(b1-b2), est, c("b1", "b2"), print = FALSE) - - derivVec <- c(1, -1) - estVal <- est[1] - est[2] - } - resList <- list(estimate = estVal, se = sqrt(as.numeric(derivVec %*% vcMat %*% derivVec))) - colNames <- c("Estimate", "Std. Error") - - edMat <- matrix(c(resList$estimate, resList$se), nrow = 1) - if (interval) - { - colNames <- c(colNames, "Lower", "Upper") - - ## Setting degrees of freedom (by default based on normality) - if (is.null(df)) - { - quanVal <- qnorm(1 - (1 - level)/2) - } else { - quanVal <- qt(1 - (1 - level)/2, df) - } - ciMat <- matrix(c(edMat[1, 1] - quanVal * edMat[1, 2], edMat[1, 1] + quanVal * edMat[1, 2]), nrow = 1) - - if (log && (identical(operator, "/"))) - { - ciMat <- exp(ciMat) - } - edMat <- cbind(edMat, ciMat) - } - colnames(edMat) <- colNames - - cat("\n") - cat("Estimated", opText, "of effective doses\n") - if (interval && log && (identical(operator, "/"))) {cat("(confidence interval on original scale)\n")} - cat("\n") - - printCoefmat(edMat) - invisible(edMat) -} \ No newline at end of file diff --git a/R/confint.drc.R b/R/confint.drc.R index b4270809..79f117c6 100644 --- a/R/confint.drc.R +++ b/R/confint.drc.R @@ -1,62 +1,128 @@ +#' @title Confidence Intervals for Model Parameters +#' +#' @description +#' Computes confidence intervals for one or more parameters in a fitted +#' dose-response model of class `"drc"`. Confidence intervals are constructed +#' using either a t-distribution (for continuous response models) or a standard +#' normal distribution (for all other response types). +#' +#' @param object A fitted model object of class `"drc"`. +#' @param parm A specification of which parameters are to be given confidence +#' intervals, either a vector of indices or a vector of parameter name strings. +#' If missing, all parameters are considered. +#' @param level The confidence level required. Defaults to `0.95`. +#' @param pool Logical. If `TRUE` (default), curves are pooled. Otherwise they +#' are not. This argument only works for models with independently fitted +#' curves as specified in [drm()]. +#' @param ... Additional arguments for methods. Currently not used. +#' +#' @return A numeric matrix with two columns giving the lower and upper +#' confidence limits for each parameter. Columns are labelled as +#' \eqn{\frac{(1 - \text{level})}{2} \times 100\%} and +#' \eqn{\left(1 - \frac{(1 - \text{level})}{2}\right) \times 100\%} +#' (by default \code{2.5 \%} and \code{97.5 \%}). +#' +#' @author Christian Ritz, Hannes Reinwald +#' +#' @seealso +#' * [drm()] — for fitting dose-response models. +#' * [confint.basic()] — the internal helper used to construct the intervals. +#' * [summary.drc()] — for a full summary of model coefficients. +#' +#' @examples +#' ## Fitting a four-parameter log-logistic model +#' ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +#' +#' ## Confidence intervals for all parameters +#' confint(ryegrass.m1) +#' +#' ## Confidence interval for a single parameter +#' confint(ryegrass.m1, "e") +#' +#' @keywords models nonlinear +#' @export "confint.drc" <- function(object, parm, level = 0.95, pool = TRUE, ...) -#"confint.drc" <- function(object, parm, level = 0.95, type = "t", pool = TRUE, ...) { - ## Matching parameter names - if (!missing(parm)) + ## Matching parameter names + if (!missing(parm)) + { + matchVec <- object$"parNames"[[2]] %in% parm + if (!any(matchVec)) { - matchVec <- object$"parNames"[[2]] %in% parm - if (!any(matchVec)) {stop("The 'parm' argument does not match an actual parameter")} - } else { - matchVec <- rep(TRUE, length(object$"parNames"[[2]])) + stop("The 'parm' argument does not match an actual parameter name.") } - - ## Constructing matrix of confidence intervals - confint.basic(summary(object, pool = pool)$"coefficients"[matchVec, 1:2, drop = FALSE], - level, object$"type", df.residual(object)) - -# ## Retrieving estimates and estimated standard errors -# estMat <- summary(object, pool = pool)$"coefficients"[matchVec, 1:2, drop = FALSE] -# -# ## Constructing matrix of confidence intervals -# confMat <- matrix(0, dim(estMat)[1], 2) -# -# alphah <- (1 - level)/2 -# if (type == "u") {two <- qnorm(1 - alphah)} -# if (type == "t") {two <- qt(1 - alphah, df.residual(object))} -# confMat[, 1] <- estMat[, 1] - two * estMat[, 2] -# confMat[, 2] <- estMat[, 1] + two * estMat[, 2] -# -# ## Formatting matrix -# colnames(confMat) <- c(paste(format(100 * alphah), "%", sep = " "), paste(format(100*(1 - alphah)), "%", sep = " ") ) -# rownames(confMat) <- rownames(estMat) -# -# return(confMat) + } else { + matchVec <- rep(TRUE, length(object$"parNames"[[2]])) + } + + ## Constructing matrix of confidence intervals + confint.basic( + summary(object, pool = pool)$"coefficients"[matchVec, 1:2, drop = FALSE], + level, + object$"type", + df.residual(object) + ) } -## Defining basic function for providing confidence intervals + +#' @title Basic Confidence Interval Calculation +#' +#' @description +#' An internal helper function that constructs a confidence interval matrix +#' from a matrix of parameter estimates and their standard errors. A +#' t-distribution quantile is used for continuous response models; a standard +#' normal quantile is used for all other response types (binomial, event, +#' Poisson, negbin1, negbin2). +#' +#' @param estMat A numeric matrix with two columns: the first column contains +#' parameter estimates and the second column contains their standard errors. +#' @param level The confidence level required (e.g., `0.95` for 95% intervals). +#' @param intType A character string specifying the response type of the model. +#' One of `"binomial"`, `"continuous"`, `"event"`, `"Poisson"`, +#' `"negbin1"`, or `"negbin2"`. Determines whether a normal or t-distribution +#' quantile is used. For `"continuous"` models a t-distribution with `dfres` +#' degrees of freedom is used; all other types use the standard normal. +#' @param dfres The residual degrees of freedom. Only used when +#' `intType = "continuous"`. +#' @param formatting Logical. If `TRUE` (default), row and column names are +#' added to the returned matrix. +#' +#' @return A numeric matrix with two columns giving the lower and upper +#' confidence limits for each parameter. +#' +#' @seealso [confint.drc()] — the user-facing function that calls this helper. +#' +#' @keywords internal "confint.basic" <- function(estMat, level, intType, dfres, formatting = TRUE) { - alphah <- (1 - level)/2 -# if (type == "u") {two <- qnorm(1 - alphah)} -# if (type == "t") {two <- qt(1 - alphah, df.residual(object))} - tailPercentile <- switch(intType, - binomial = qnorm(1 - alphah), - continuous = qt(1 - alphah, dfres), - event = qnorm(1 - alphah), - Poisson = qnorm(1 - alphah), - negbin1 = qnorm(1 - alphah), - negbin2 = qnorm(1 - alphah)) - - estVec <- estMat[, 1] - halfLength <- tailPercentile * estMat[, 2] - confMat <- matrix(c(estVec - halfLength, estVec + halfLength), ncol = 2) - - ## Formatting matrix - if (formatting) - { - colnames(confMat) <- c(paste(format(100 * alphah), "%", sep = " "), paste(format(100*(1 - alphah)), "%", sep = " ")) - rownames(confMat) <- rownames(estMat) - } - - return(confMat) -} + alphah <- (1 - level) / 2 + + tailPercentile <- switch(intType, + binomial = qnorm(1 - alphah), + continuous = qt(1 - alphah, dfres), + event = qnorm(1 - alphah), + Poisson = qnorm(1 - alphah), + negbin1 = qnorm(1 - alphah), + negbin2 = qnorm(1 - alphah), + stop(paste0( + "Unknown intType '", intType, "'. ", + "Must be one of: 'binomial', 'continuous', 'event', ", + "'Poisson', 'negbin1', 'negbin2'." + )) + ) + + estVec <- estMat[, 1] + halfLength <- tailPercentile * estMat[, 2] + confMat <- matrix(c(estVec - halfLength, estVec + halfLength), ncol = 2) + + if (formatting) + { + colnames(confMat) <- c( + paste(format(100 * alphah), "%", sep = " "), + paste(format(100 * (1 - alphah)), "%", sep = " ") + ) + rownames(confMat) <- rownames(estMat) + } + + return(confMat) +} \ No newline at end of file diff --git a/R/cooks.distance.drc.R b/R/cooks.distance.drc.R index 2aa0e45a..8c189735 100644 --- a/R/cooks.distance.drc.R +++ b/R/cooks.distance.drc.R @@ -1,3 +1,23 @@ +#' @title Cook's distance for nonlinear dose-response models +#' +#' @description +#' Cook's distance values are provided for nonlinear dose-response model fits using the +#' same formulas as in linear regression but based on the corresponding approximate quantities +#' available for nonlinear models. +#' +#' @param model an object of class 'drc'. +#' @param ... additional arguments (not used). +#' +#' @return A vector of Cook's distance values, one value per observation. +#' +#' @author Christian Ritz +#' +#' @examples +#' ryegrass.LL.4 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +#' +#' cooks.distance(ryegrass.LL.4) +#' +#' @keywords models nonlinear cooks.distance.drc <- function(model, ...) { hatVal <- hatvalues(model) diff --git a/R/drc-package.R b/R/drc-package.R new file mode 100644 index 00000000..425b3c1c --- /dev/null +++ b/R/drc-package.R @@ -0,0 +1,7 @@ +#' @keywords internal +"_PACKAGE" + +## usethis namespace: start +#' @importFrom lifecycle deprecated +## usethis namespace: end +NULL diff --git a/R/drm.R b/R/drm.R index 255c04c6..d34e747f 100644 --- a/R/drm.R +++ b/R/drm.R @@ -1,3 +1,78 @@ +#' @title Fitting dose-response models +#' +#' @description A general model fitting function for analysis of various types of dose-response data. +#' +#' @param formula a symbolic description of the model to be fit. Either of the form +#' \code{response ~ dose} or as a data frame with response values in first column and dose +#' values in second column. +#' @param curveid a numeric vector or factor containing the grouping of the data. +#' @param pmodels a data frame with as many columns as there are parameters in the non-linear +#' function. Or a list containing a formula for each parameter in the nonlinear function. +#' @param weights a numeric vector containing weights. For continuous/quantitative responses, +#' inverse weights are multiplied inside the squared errors (weights should have the same unit +#' as the response). For binomial responses weights provide information about the total number +#' of binary observations used to obtain the response. +#' @param data an optional data frame containing the variables in the model. +#' @param subset an optional vector specifying a subset of observations to be used in the +#' fitting process. +#' @param fct a list with three or more elements specifying the non-linear function, the +#' accompanying self starter function, the names of the parameters in the non-linear function +#' and, optionally, the first and second derivatives as well as information used for +#' calculation of ED values. Use \code{\link{getMeanFunctions}} for a full list. +#' @param type a character string specifying the distribution of the data. The default is +#' \code{"continuous"}, corresponding to a normal distribution. Other choices include +#' \code{"binomial"}, \code{"Poisson"}, \code{"negbin1"}, \code{"negbin2"}, \code{"event"}, +#' and \code{"ssd"}. +#' @param bcVal a numeric value specifying the lambda parameter to be used in the Box-Cox +#' transformation. +#' @param bcAdd a numeric value specifying the constant to be added on both sides prior to +#' Box-Cox transformation. The default is 0. +#' @param start an optional numeric vector containing starting values for all mean parameters +#' in the model. Overrules any self starter function. +#' @param na.action a function for treating missing values (\code{NA}s). Default is +#' \code{\link{na.omit}}. +#' @param robust a character string specifying the rho function for robust estimation. +#' Default is non-robust least squares estimation (\code{"mean"}). Available robust methods +#' are: \code{"median"}, \code{"lms"}, \code{"lts"}, \code{"trimmed"}, \code{"winsor"}, and +#' \code{"tukey"}. +#' @param logDose a numeric value or \code{NULL}. If log dose values are provided the base of +#' the logarithm should be specified (e.g., \code{exp(1)} for natural logarithm, \code{10} +#' for base 10). +#' @param control a list of arguments controlling constrained optimisation, maximum iterations, +#' relative tolerance, and warnings. See \code{\link{drmc}}. +#' @param lowerl a numeric vector of lower limits for all parameters in the model (the default +#' corresponds to minus infinity for all parameters). +#' @param upperl a numeric vector of upper limits for all parameters in the model (the default +#' corresponds to plus infinity for all parameters). +#' @param separate logical value indicating whether curves should be fit separately +#' (independent of each other). +#' @param pshifts a matrix of constants to be added to the matrix of parameters. Default is no +#' shift for all parameters. +#' @param varcov an optional user-defined known variance-covariance matrix for the responses. +#' Default is the identity matrix (\code{NULL}), corresponding to independent response values +#' with a common standard deviation estimated from the data. +#' +#' @return An object of (S3) class \code{"drc"}. +#' +#' @details This function relies on \code{\link{optim}} for minimisation of the negative log +#' likelihood function. For a continuous response this reduces to least squares estimation. +#' Response values are assumed to be mutually independent unless \code{varcov} is specified. +#' For robust estimation MAD (median absolute deviance) is used to estimate the residual +#' variance. Setting \code{lowerl} and/or \code{upperl} automatically invokes constrained +#' optimisation. Control arguments may be specified using \code{\link{drmc}}. +#' +#' @seealso \code{\link{drmc}}, \code{\link{LL.4}}, \code{\link{getMeanFunctions}} +#' +#' @examples +#' ## Fitting a four-parameter log-logistic model to the ryegrass data +#' model <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +#' summary(model) +#' +#' @author Christian Ritz, Jens C. Streibig and Hannes Reinwald +#' +#' @keywords models nonlinear +#' @export +#' "drm" <- function( formula, curveid, pmodels, weights, data = NULL, subset, fct, type = c("continuous", "binomial", "Poisson", "negbin1", "negbin2", "event", "ssd"), bcVal = NULL, bcAdd = 0, @@ -5,14 +80,8 @@ start, na.action = na.omit, robust = "mean", logDose = NULL, control = drmc(), lowerl = NULL, upperl = NULL, separate = FALSE, pshifts = NULL, varcov = NULL) { -# ## Matching 'adjust' argument -# adjust <- match.arg(adjust) - ## Matching argument values type <- match.arg(type) - - ## Loading MASS -# require(MASS, quietly = TRUE) # used for boxcox and ginv ## Setting na.action option op1 <- options(na.action = deparse(substitute(na.action))) @@ -21,18 +90,13 @@ pshifts = NULL, varcov = NULL) ## Setting control parameters useD <- control$"useD" constrained <- control$"constr" -# maxDose <- control$"maxDose" maxIt <- control$"maxIt" optMethod <- control$"method" relTol <- control$"relTol" warnVal <- control$"warnVal" -# zeroTol <- control$"zeroTol" -# bcConstant <- bcAdd - rmNA <- control$"rmNA" # in drmEM... - errorMessage <- control$"errorm" # in drmOpt - noMessage <- control$"noMessage" # reporting finding control measurements? -# trace <- control$"trace" -# otrace <- control$"otrace" + rmNA <- control$"rmNA" + errorMessage <- control$"errorm" + noMessage <- control$"noMessage" dscaleThres <- control$"dscaleThres" rscaleThres <- control$"rscaleThres" conCheck <- control$"conCheck" @@ -40,19 +104,6 @@ pshifts = NULL, varcov = NULL) ## Setting warnings policy op2 <- options(warn = warnVal) on.exit(options(op2), add=TRUE) - -# ## Setting adjustment -# if (adjust == "none") {boxcox <- FALSE; varPower <- FALSE} -# if (adjust == "bc1") {boxcox <- TRUE; varPower <- FALSE} -# if (adjust == "vp") {boxcox <- FALSE; varPower <- TRUE} - -# if ( (!is.null(bcVal)) && (is.numeric(bcVal))) {boxcox <- bc} - -# if (!(robust == "mean")) -# { -# boxcox <- FALSE -# varPower <- FALSE -# } ## Handling 'start' argument if (missing(start)) {selfStart <- TRUE} else {selfStart <- FALSE} @@ -89,22 +140,12 @@ pshifts = NULL, varcov = NULL) parNames <- fct$"names" numNames <- length(parNames) } - -# ## Coercing two arguments in 'ssfct' into one argument -# lenASS <- length(formals(ssfct)) -# if (lenASS > 1) -# { -# stop("Self starter function should only have one argument, which takes a data frame") -## ssTemp <- ssfct -## ssfct <- function(dataset) {ssTemp(dataset[, head(1:lenASS, -1)], dataset[, lenASS])} -# } ## Checking whether or not first derivates are supplied isDF <- is.function(fct$"deriv1") if ( (useD) && (isDF) ) { - dfct1 <- fct$"deriv1" # deriv1 # [[4]] -# drcDer2 <- fct$deriv2 # [[5]] + dfct1 <- fct$"deriv1" } else { dfct1 <- NULL } @@ -116,8 +157,6 @@ pshifts = NULL, varcov = NULL) } else { dfct2 <- NULL } -# fct$"anovaYes"$"bin" <- NULL -# fct$"anovaYes"$"cont" <- TRUE ## Storing call details callDetail <- match.call() @@ -152,34 +191,14 @@ pshifts = NULL, varcov = NULL) } origDose <- dose origResp <- resp # in case of transformation of the response - lenData <- length(resp) numObs <- length(resp) -# xDim <- ncol(as.matrix(dose)) - -# if (xDim > 1) -# { -# stop("drm() is only designed for 1-dim. dose vectors") -# } - -# dimData <- xDim + 1 # dimension of dose plus 1 dimensional response - -# varNames <- names(mf) -# varNames <- varNames[c(2:dimData,1)] - -# print(names(mf)) -# print(model.extract(mf, "weights")) -# print(model.weights(mf)) - ## Retrieving weights wVec <- model.weights(mf) if (is.null(wVec)) { wVec <- rep(1, numObs) } - -# ## Extracting variable for heterogeneous variances -# vvar <- model.extract(mf, "hetvar") ## Finding indices for missing values missingIndices <- attr(mf, "na.action") @@ -193,13 +212,10 @@ pshifts = NULL, varcov = NULL) } uniqueNames <- unique(assayNo) colOrder <- order(uniqueNames) -# print(colOrder) uniqueNames <- as.character(uniqueNames) ## Re-enumerating the levels in 'assayNo' and 'pmodels' assayNoOld <- assayNo -# ciOrigIndex <- uniqueNames # unique(assayNo) -# ciOrigLength <- length(unique(assayNoOld)) ## Detecting control measurements @@ -219,77 +235,7 @@ pshifts = NULL, varcov = NULL) assayNames <- as.character(unique(assayNoOld)) numAss <- length(assayNames) -# lenDose <- unlist(lapply(tapply(dose, assayNoOld, unique), length)) -# conDose <- names(lenDose)[lenDose == 1] -# nconDose <- names(lenDose)[lenDose > 1] -# if (length(conDose) > 0) -# { -# if (!noMessage) -# { -# cat(paste("Control measurements detected for level: ", conDose, "\n", sep = "")) -# } -# -# assayNo[assayNoOld %in% conDose] <- nconDose[1] -# ciOrigIndex <- unique(assayNo) -## ciOrigLength <- length(unique(assayNoOld)) # numAss -# -# -# ## Updating names, number of curves and the enumeration (starting from 1) -# assayNames <- nconDose -## numAss <- length(assayNames) -# assayNo <- colConvert(assayNo) -# -# cm <- NULL -## } -# -# uniqueDose <- lapply(tapply(dose, assayNoOld, unique), length) -# udNames <- names(uniqueDose[uniqueDose == 1]) -# if (length(udNames) > 0) -# { -# cm <- udNames -# if (!noMessage) {cat(paste("Control measurements detected for level: ", udNames, "\n", sep = ""))} -# ## add a check to see if at least one component in pmodels results in a single column - -## conInd <- assayNoOld%in%udNames -## assayNo[conInd] <- (assayNo[!conInd])[1] -## cm <- NULL -##assayNew <- assayNo -##assayNew[conInd] <- (assayNo[!conInd])[1] -##print(assayNew) -## -# conInd <- assayNoOld%in%udNames -# assayNo[conInd] <- (assayNo[!conInd])[1] -# ciOrigIndex <- unique(assayNo) -# ciOrigLength <- numAss -# -# ## Updating names, number of curves and the enumeration (starting from 1) -# assayNames <- as.character(unique(assayNoOld[!conInd])) -# numAss <- length(assayNames) -# assayNo <- colConvert(assayNo) -# -# cm <- NULL -# - -## New -commented out -# } else { -# cm <- NULL -# ciOrigIndex <- unique(assayNo) -## ciOrigLength <- numAss -# -# assayNames <- as.character(unique(assayNoOld)) -# assayNo <- colConvert(assayNoOld) # re-enumerating from 1 to numAss -# } -# numAss <- length(assayNames) -# print(ciOrigIndex) -# print(ciOrigLength) - -# print(xDim) -# print(cbind(dose, assayNoOld)) - if (xDim > 1) {tempDoseVec <- dose[, 1]} else {tempDoseVec <- dose} -# print(tempDoseVec) -# print(assayNoOld) -# uniqueDose <- lapply(tapply(dose, assayNoOld, unique), length) uniqueDose <- lapply(tapply(tempDoseVec, assayNoOld, unique), length) udNames <- names(uniqueDose[uniqueDose == 1]) if ( (conCheck) && (length(udNames) > 0) ) @@ -298,12 +244,13 @@ pshifts = NULL, varcov = NULL) if (!noMessage) { cat(paste("Control measurements detected for level: ", udNames, "\n", sep = "")) - - if (separate) - { - stop("Having a common control when fitting separate models does not make sense!\n") - } } + + if (separate) + { + stop("Having a common control when fitting separate models does not make sense!\n") + } + conInd <- assayNoOld %in% udNames assayNo[conInd] <- (assayNo[!conInd])[1] ciOrigIndex <- unique(assayNo) @@ -319,12 +266,10 @@ pshifts = NULL, varcov = NULL) ciOrigIndex <- unique(assayNo) ciOrigLength <- numAss } -# print(assayNo) ## Pooling data from different curves if ((separate) && (numAss < 2)) { -# warning("Nothing to pool", call. = FALSE) warning("Only one level: separate = TRUE has no effect", call. = FALSE) separate <- FALSE } @@ -335,7 +280,6 @@ pshifts = NULL, varcov = NULL) } if (separate) { -# return(idrm(dose, resp, assayNo, wVec, fct, type)) return(idrm(dose, resp, assayNoOld, wVec, fct, type, control)) } @@ -343,8 +287,6 @@ pshifts = NULL, varcov = NULL) pmodelsList <- list() if (missing(pmodels)) { -# pmodels <- as.data.frame(matrix(assayNo, numObs, numNames)) -# if (length(unique(assayNo)) == 1) { for (i in 1:numNames) @@ -357,8 +299,6 @@ pshifts = NULL, varcov = NULL) for (i in 1:numNames) { pmodelsList[[i]] <- modelMat -# print(head(modelMat)) -# pmodelsList[[i]] <- pmodelsList[[i]][, colOrder] } } } else { @@ -421,10 +361,7 @@ pshifts = NULL, varcov = NULL) } } } -# pmodelsOld <- pmodels -# pmodels <- as.data.frame(pmodelsMat) # pmodelsMat not used any more } -# for (i in 1:numNames) {pmodels[, i] <- colConvert(pmodels[, i])} ## Re-setting na.action @@ -438,222 +375,8 @@ pshifts = NULL, varcov = NULL) dose <- logDose^dose } -# ## Handling one-dimensional x -# if (xDim == 1) -# { - ## Defining ANOVA model -# bcc <- rep(bcAdd, numObs) -# if (numAss > 1) -# { -# anovaFormula <- (resp + bcc) ~ offset(bcc) + doseFactor*factor(assayNo) -# alternative <- 2 -# } else { -# anovaFormula <- (resp + bcc) ~ offset(bcc) + doseFactor -# alternative <- 1 -# } - - -# ## Checking whether there is enough df to perform Box-Cox transformation -# if ( boxcox && ( (numObs - numAss*length(unique(dose))) < numObs/10) ) -# { -# if (boxcox) {warning("Box-Cox transformation based on clustering of dose values", call. = FALSE)} -# doseFactor <- factor(cutree(hclust(dist(dose), method = "average"), numObs/3)) -# # constructing groups containing roughly 3 observations -# -# ## Re-defining ANOVA model -# if (numAss > 1) -# { -# anovaFormula <- (resp + bcc) ~ offset(bcc) + doseFactor*factor(assayNo) -# dset <- data.frame(doseFactor, resp, assayNo, bcc) -# alternative <- 2 -# } else { -# anovaFormula <- (resp + bcc) ~ offset(bcc) + doseFactor -# dset <- data.frame(doseFactor, resp, bcc) -# alternative <- 1 -# } -# } else { -# doseFactor <- factor(dose) -# } - -# ## Fitting ANOVA model -# if (type == "continuous") -# { -# testList <- drmLOFls() -## if (varPower) {testList <- drmLOFvp()} -## if (!is.null(vvar)) {testList <- drmLOFhv()} -# } -# if (type == "binomial") -# { -# testList <- drmLOFbinomial() -# } -# if (type == "Poisson") -# { -# testList <- drmLOFPoisson() -# } -# -## if (varPower) {testList <- mdrcVp(anovaYes = TRUE)} else {testList <- drmEMls(anovaYes = TRUE)} -## if (!is.null(vvar)) {testList <- mdrcHetVar(anovaYes = TRUE)} -# -# gofTest <- testList$"gofTest" -# lofTest <- testList$"anovaTest" -# if (!is.null(lofTest)) -# { -# dset <- data.frame(dose, factor(dose), resp, assayNo, bcc) -# anovaModel0 <- lofTest(anovaFormula, dset) -# } else { -# anovaModel0 <- NULL -# alternative <- 0 -# } - -# ## Fitting ANOVA model -# testList <- switch(type, -# "continuous" = drmLOFls(), -# "binomial" = drmLOFbinomial(), -# "Poisson" = drmLOFPoisson()) -# -# gofTest <- testList$"gofTest" -# lofTest <- testList$"anovaTest" -# if (!is.null(lofTest)) -# { -# afList <- anovaFormula(dose, resp, assayNo, bcAdd) -# anovaForm <- afList$"anovaFormula" -# anovaData <- afList$"anovaData" -# -# anovaModel0 <- lofTest(anovaForm, anovaData) -# } else { -# anovaModel0 <- NULL -# } - - -# ## Applying the Box-Cox transformation (lambda is defined here!) -# bcResult <- drmBoxcox(boxcox, anovaFormula, dset) -# lambda <- bcResult[[1]] -# boxcoxci <- bcResult[[2]] -# boxcox <- bcResult[[3]] - -# lambda <- 0 -# isNumeric <- is.numeric(boxcox) -# if ( (isNumeric) || (is.logical(boxcox) && boxcox) ) -# { -# if (!isNumeric) -# { -# profLik <- boxcox(anovaFormula, lambda = seq(-2.6, 2.6, 1/10), plotit = FALSE, data = dset) -# # boxcox in MASS -# -# maxIndex <- which.max(profLik$y) -# lambda <- (profLik$x)[maxIndex] -# boxcoxci <- drmBoxcoxCI(profLik) -# } -# if (isNumeric) -# { -# lambda <- boxcox -# boxcoxci <- c(NA, NA) -# } -# } else { -# lambda <- NA -# boxcoxci <- c(NA, NA) -# } - - -# ## Using self starter -# if (!noSSfct) -# { -# ## Calculating initial estimates for the parameters using the self starter -# startMat <- matrix(0, numAss, numNames) -# doseresp <- data.frame(dose, origResp) -# -# for (i in 1:numAss) -# { -# indexT1 <- (assayNo == i) -# if (any(indexT1)) -# { -# isfi <- is.finite(dose) # removing infinite dose values -# logVec <- indexT1 & isfi -# startMat[i, ] <- ssfct(doseresp[logVec, ]) # ssfct(dose[logVec], origResp[logVec] ) -# } else { -# startMat[i, ] <- rep(NA, numNames) -# } -# -# ## Identifying a dose response curve only consisting of control measurements -# if (sum(!is.na(startMat[i, ])) == 1) {upperPos <- (1:numNames)[!is.na(startMat[i, ])]} -# } -## colMat <- matrix(0, numNames, numAss) -## maxParm <- rep(0, numNames) # storing the max number of parameters -# } - - -# ## Handling multi-dimensional x -# } else { -# stop("Currently multi-dimensional dose values are not supported") -# alternative <- NULL -# anovaModel0 <- NULL -# anovaModel <- NULL -# gofTest <- NULL - -# if (!is.null(bcVal)) -# { -# lambda <- boxcox -# boxcoxci <- c(NA, NA) -# } else { -# lambda <- NA -# boxcoxci <- NULL -# } - -# ## Using self starter -# if (!noSSfct) -# { -# ## Calculating initial estimates for the parameters using the self starter -# startMat <- matrix(0, numAss, numNames) -# doseresp <- data.frame(dose, origResp) -# -# for (i in 1:numAss) -# { -# indexT1 <- (assayNo == i) -# if (any(indexT1)) -# { -# startMat[i, ] <- ssfct(doseresp[indexT1, ]) # ssfct(dose[indexT1], origResp[indexT1]) -# } else { -# startMat[i, ] <- rep(NA, numNames) -# } -# -# ## Identifying a dose response curve only consisting of control measurements -# if (sum(!is.na(startMat[i,]))==1) {upperPos <- (1:numNames)[!is.na(startMat[i,])]} -# } -# colMat <- matrix(0, numNames, numAss) -# maxParm <- rep(0, numNames) # storing the max number of parameters -# } -# } - - ## Finding parameters for the control measurements which will not be estimated + ## Constructing pmodelsList2 from pmodelsList pmodelsList2 <- list() - for (i in 1:numNames) - { - colNames <- colnames(pmodelsList[[i]]) - - if ( (!is.null(cm)) && (!is.null(colNames)) ) - { - accm <- as.character(cm) - pos <- grep(accm, colNames) - if (length(pos) == 0) - { - candCol <- pmodelsList[[i]][, 1] - if ( !(length(assayNoOld[candCol==1])==0) && (all(assayNoOld[candCol==1] == accm)) ) - { - pos <- 1 # the control measurements correspond to the "Intercept" term - } - } - } else {pos <- numeric(0)} - - - ## Defining 'pmodelsList2' from 'pmodelsList' - if ((length(pos) > 0) && !(upperPos == i) ) - { - pmodelsList2[[i]] <- as.matrix(pmodelsList[[i]][, -pos]) # column is removed - } else { - pmodelsList2[[i]] <- as.matrix(pmodelsList[[i]]) # column is kept - } - } - for (i in 1:numNames) { if (ncol(pmodelsList[[i]]) > numAss) @@ -661,7 +384,7 @@ pshifts = NULL, varcov = NULL) pmodelsList2[[i]] <- model.matrix(~factor(assayNo) - 1) colnames(pmodelsList2[[i]]) <- assayNames } else { - pmodelsList2[[i]] <- as.matrix(pmodelsList[[i]]) # columns are kept + pmodelsList2[[i]] <- as.matrix(pmodelsList[[i]]) } } @@ -669,7 +392,7 @@ pshifts = NULL, varcov = NULL) ncclVec <- rep(0, numNames) for (i in 1:numNames) { - ncclVec[i] <- ncol(pmodelsList2[[i]]) # ncol(as.matrix(pmodelsList2[[i]])) + ncclVec[i] <- ncol(pmodelsList2[[i]]) } parmPos <- c(0, cumsum(ncclVec)[-numNames]) @@ -688,30 +411,20 @@ pshifts = NULL, varcov = NULL) ## Scaling of dose and response values scaleFct <- fct$"scaleFct" - if (!is.null(scaleFct)) # && (is.null(lowerl)) && (is.null(upperl)) ) - # currently the scaling interferes with constraining optimization + if (!is.null(scaleFct)) { # Defining scaling for dose and response values doseScaling <- 10^(floor(log10(median(dose)))) -# if ( (is.na(doseScaling)) || (doseScaling < 1e-10) ) # changed May 16 2012 if ( (is.na(doseScaling)) || (doseScaling < dscaleThres) ) { doseScaling <- 1 } respScaling <- 10^(floor(log10(median(resp)))) -# if ( (is.na(respScaling)) || (respScaling < 1e-10) || (!identical(type, "continuous")) || (!is.null(bcVal)) ) # changed May 16 2012 if ( (is.na(respScaling)) || (respScaling < rscaleThres) || (!identical(type, "continuous")) || (!is.null(bcVal)) ) { respScaling <- 1 } -# print(resp) -# print(median(resp)) - -# doseScaling <- 1 -# respScaling <- 1 - -## Starting values need to be calculated after BC transformation!!! # Retrieving scaling vector longScaleVec <- rep(scaleFct(doseScaling, respScaling), @@ -722,21 +435,12 @@ pshifts = NULL, varcov = NULL) respScaling <- 1 longScaleVec <- 1 -# -# startVecSc <- startVec } -# print(c(doseScaling, respScaling, longScaleVec)) ## Constructing vector of initial parameter values startVecList <- list() ## Calculating initial estimates for the parameters using the self starter - -# if (identical(type, "ssd") & inherits(fct, "llogistic")) -# { -# ssFct <- function(dframe) {c(-1, 1, 1, 1, 1) * fct[["ssfct"]](dframe)} -# } - if(!noSSfct) { startMat <- matrix(0, numAss, numNames) @@ -752,27 +456,14 @@ pshifts = NULL, varcov = NULL) doseresp <- data.frame(x = dose / doseScaling, y = origResp / respScaling) ssFct <- ssfct } -# doseresp <- data.frame(x = dose / doseScaling, y = origResp / respScaling) -# doseresp <- data.frame(dose, origResp) -# Not sure this indicator is needed?! Only used once below! -# Note is.finite() only works with vectors! -# Commented out 2010-12-13 - isfi <- is.finite(dose) # removing infinite dose values - if (identical(type, "event")) { dr2 <- doseresp[, 3] -# print(doseresp[, 2:3]) isFinite <- is.finite(doseresp[, 2]) respVec <- rep(NA, length(dr2)) respVec[isFinite] <- cumsum(dr2[isFinite]) / sum(dr2) -# doseresp[, 3] <- cumsum(dr2[isFinite]) / sum(dr2) -## doseresp[!is.finite(doseresp[, 2]), 1] <- NA -# doseresp <- doseresp[isFinite, c(1, 3)] -# names(doseresp) <- c("x", "y") doseresp <- (data.frame(x = doseresp[, 1], y = respVec))[isFinite, ] -# print(doseresp) } else { isFinite <- is.finite(doseresp[, 2]) } @@ -783,12 +474,7 @@ pshifts = NULL, varcov = NULL) indexT1 <- (assayNo[isFinite] == i) if (any(indexT1)) { -# Commented out 2010-12-13 -# logVec <- indexT1 & isfi logVec <- indexT1 - -# startMat[i, ] <- ssfct(doseresp[logVec, ]) # ssfct(dose[logVec], origResp[logVec] ) -# startMat[i, ] <- ssfct(doseresp[logVec, ], doseScaling, respScaling) startMat[i, ] <- ssFct(doseresp[logVec, ]) } else { startMat[i, ] <- rep(NA, numNames) @@ -798,29 +484,9 @@ pshifts = NULL, varcov = NULL) if (sum(!is.na(startMat[i, ])) == 1) { upperPos <- (1:numNames)[!is.na(startMat[i, ])] -# print(upperPos) } } -# print(startMat) - -# startMat2 <- matrix(unlist(lapply(split(doseresp, assayNo[isFinite]), ssFct)), nrow = numAss, byrow = TRUE) -# upperPos2 <- c(rep(1:numNames, numAss))[t(is.na(startMat))] -# print(upperPos2) -# print(startMat2) - - -# New approach? -# timeUsed <- 0 -# ssFctWrapper <- function(dframeSubset) -# { -# ssFct(dframeSubset[is.finite(dframeSubset[1, ]), ]) -# timeUsed <- timeUsed + system.time(ssFct(dframeSubset[is.finite(dframeSubset[1, ]), ]))[3] -# } -# startMat2 <- matrix(as.vector(unlist(lapply(split(doseresp, assayNo), ssFctWrapper))), -# numAss, numNames, byrow = TRUE) -# print(startMat2) # for comparison - - + ## Transforming matrix of starting values into a vector nrsm <- nrow(startMat) for (i in 1:numNames) @@ -834,11 +500,10 @@ pshifts = NULL, varcov = NULL) sv[isZero] <- mean(sv) startVecList[[i]] <- sv[indVec] -# print(startVecList[[i]]) } startVec <- unlist(startVecList) } else { - startVec <- start # no checking if no self starter function is provided!!! + startVec <- start } ## Checking the number of start values provided @@ -859,118 +524,23 @@ pshifts = NULL, varcov = NULL) startVec <- drmConvertParm(startVec, startMat, assayNo, pmodelsList2) } - # Scaling starting values (currently not done in drmEMls) -# startVecSc <- startVec / longScaleVec startVecSc <- startVec -# print(startVecSc) ## Defining function which converts parameter vector to parameter matrix parmMatrix <- matrix(0, numObs, numNames) parm2mat <- function(parm) { -# parmMatrix <- matrix(0, lenData, numNames) for (i in 1:numNames) { -# print(as.matrix(pmodelsList2[[i]])) -# print(parmPos[i] + 1:ncclVec[i]) -# print(parm[parmPos[i] + 1:ncclVec[i]]) -# parmMatrix[, i] <- pmodelsList2[[i]] %*% parm[parmPos[i] + 1:ncclVec[i]] parmMatrix[, i] <- pmodelsList2[[i]] %*% parm[parmIndex[[i]]] } return(parmMatrix) } - ## Defining non-linear function -# if (!is.null(fctList)) -# { -# ivList <- list() -# ivList2 <- list() -# matList <- list() -# svList <- list() -# for (i in 1:numAss) -# { -# indexT1 <- (assayNo == i) -# isfi <- is.finite(dose) # removing infinite dose values -# -# ivList[[i]] <- indexT1 -## svList[[i]] <- fctList[[i]]$"ssfct"( doseresp[(indexT1 & isfi), ] ) -# logVec <- indexT1 & isfi -# svList[[i]] <- fctList[[i]]$"ssfct"(doseresp[logVec, ]) # dose[logVec], origResp[logVec]) -# matList[[i]] <- c( sum(indexT1), length(svList[[i]]) ) -# -# ivList2[[i]] <- match(fctList[[i]]$names, fct$names) -# } -# -# -# posVec <- rep(0, numAss) -# for (i in 1:numAss) -# { -# posVec[i] <- matList[[i]][2] -# } -# posVec <- cumsum(posVec) -# posVec <- c(0, posVec) -## print(posVec) -# -# drcFct1 <- function(dose, parm) -# { -# retVec <- rep(0, numObs) -# for (i in 1:numAss) -# { -# iVec <- ivList[[i]] -# pMat <- matrix(parm[(posVec[i]+1):posVec[i+1]], matList[[i]][1], matList[[i]][2], byrow = TRUE) -# retVec[iVec] <- fctList[[i]]$"fct"( dose[iVec], pMat ) -# } -# return(retVec) -# } -# -# startVec <- as.vector(unlist(svList)) -# } else { - ## Defining model function multCurves <- modelFunction(dose, parm2mat, drcFct, cm, assayNoOld, upperPos, fct$"retFct", - doseScaling, respScaling, isFinite = rep(TRUE, lenData), pshifts) - -# drcFct1 <- function(dose, parm) -# { -# drcFct(dose, parm2mat(parm)) -# } -## } -# -# -# ## Defining model function -# if (!is.null(fct$"retFct")) -# { -# drcFct <- fct$"retFct"(doseScaling, respScaling) #, numObs) -# drcFct1 <- function(dose, parm) -# { -# drcFct(dose, parm2mat(parm)) -# } -# } -# -# if (is.null(cm)) -# { -# multCurves <- function(dose, parm) -# { -# drcFct1(dose, parm) # fctList -# } -# } else { -# iv <- assayNoOld == cm -# niv <- !iv -# fctEval <- rep(0, numObs) -# -# multCurves <- function(dose, parm) -# { -# parmVal <- parm2mat(parm) -# fctEval[iv] <- parmVal[iv, upperPos, drop = FALSE] -# fctEval[niv] <- drcFct(dose[niv], parmVal[niv, , drop = FALSE]) -# -# fctEval -# } -# } -## print(startVec) -## print(multCurves(dose, startVec)) + doseScaling, respScaling, isFinite = rep(TRUE, numObs), pshifts) - ## Defining first derivative (if available) ... used once in drmEMls() if (!is.null(dfct1)) { @@ -983,10 +553,8 @@ pshifts = NULL, varcov = NULL) } ## Box-Cox transformation is applied - if (!is.null(bcVal)) # (boxcox) + if (!is.null(bcVal)) { -# varPower <- FALSE # not both boxcox and varPower at the same time - ## Defining Box-Cox transformation function bcfct <- function(x, lambda, bctol, add = bcAdd) { @@ -1002,7 +570,6 @@ pshifts = NULL, varcov = NULL) ## (same as in boxcox.default in MASS package) bcTol <- 0.02 -# resp <- bcfct(resp, lambda, bcTol) resp <- bcfct(resp, bcVal, bcTol) multCurves2 <- function(dose, parm) @@ -1010,11 +577,8 @@ pshifts = NULL, varcov = NULL) bcfct(multCurves(dose, parm), bcVal, bcTol) } } else {multCurves2 <- multCurves} -# print(startVec) -# print(multCurves2(dose, startVec)) - ## Defining estimation method -- perhaps working for continuous data -# robustFct <- drmRobust(robust, match.call(), numObs, length(startVec)) + ## Defining estimation method robustFct <- drmRobust(robust, callDetail, numObs, length(startVec)) if (type == "continuous") @@ -1022,35 +586,6 @@ pshifts = NULL, varcov = NULL) ## Ordinary least squares estimation estMethod <- drmEMls(dose, resp, multCurves2, startVecSc, robustFct, wVec, rmNA, dmf = dmatfct, doseScaling = doseScaling, respScaling = respScaling, varcov = varcov) - -# if (adjust == "vp") #(varPower) -# { -# estMethod <- drmEMvp(dose, resp, multCurves2) # mdrcVp(dose, resp, multCurves2) -# lenStartVec <- length(startVec) -# -# start2ss <- estMethod$"ssfct"(cbind(dose, resp)) -# if (missing(start2)) -# { -# startVec <- c(startVec, start2ss) -# } else { -# if (length(start2) == 2) # canonical 2? -# { -# startVec <- c(startVec, start2) -# } -# } -## startVec <- c(startVec, estMethod$"ssfct"(cbind(dose, resp))) -# parmVec <- c(parmVec, "Sigma", "Power") -# -# startVecSc <- startVec -# } - -# if (!is.null(vvar)) -# { -# estMethod <- mdrcHetVar(dose, resp, multCurves2, vvar) -# lenStartVec <- length(startVec) -# startVec <- c(startVec, estMethod$"ssfct"(cbind(dose, resp))) -# parmVec <- c(parmVec, as.character(unique(vvar))) -# } } if (identical(type, "binomial")) { @@ -1074,41 +609,19 @@ pshifts = NULL, varcov = NULL) } if (identical(type, "ssd")) { -# if (is.null(fct[["retFctDx"]])) {fct[["retFct"]] <- NULL} else {fct[["retFct"]] <- fct[["retFctDx"]]} -# fct[["retFct"]] <- NULL -# print(doseScaling) -# print(respScaling) doseScaling <- 1 # dose is the response! respScaling <- 1 # no response variable longScaleVec <- rep(1, length(longScaleVec)) multCurves2loc <- modelFunction(dose, parm2mat, fct$"derivx", cm, assayNoOld, upperPos, - retFct = fct[["retFctDx"]], #NULL, + retFct = fct[["retFctDx"]], doseScaling = doseScaling, respScaling = respScaling, - isFinite = rep(TRUE, lenData), pshifts) + isFinite = rep(TRUE, numObs), pshifts) estMethod <- drmEMssd(dose, resp, multCurves2loc, doseScaling = doseScaling, multCurves2 = multCurves2) } -# if (identical(type, "standard")) -# { -# estMethod <- drmEMstandard(dose, resp, multCurves2, doseScaling = doseScaling) -# } opfct <- estMethod$opfct - - ## Re-fitting the ANOVA model to incorporate Box-Cox transformation (if necessary) -# if (type == "continuous") -# { -# if (!is.na(lambda)) -# { -# dset <- data.frame(dose, doseFactor, resp, assayNo, bcc) # dataset with new resp values -# anovaModel0 <- (testList$"anovaTest")(anovaFormula, dset) -## anovaModel <- anovaModel0$"anovaFit" -# } -# } - ## Defining lower and upper limits of parameters -# if (constrained) -# { if (!is.null(lowerl)) { if (!is.numeric(lowerl) || !((length(lowerl) == sum(ncclVec)) || (length(lowerl) == numNames))) @@ -1149,12 +662,6 @@ pshifts = NULL, varcov = NULL) lowerLimits <- lowerLimits / longScaleVec upperLimits <- upperLimits / longScaleVec - -# if (all(!is.finite(lowerLimits)) && all(!is.finite(upperLimits))) -# { -# stop("No constraints are imposed via 'lowerl' and 'upperl' arguments") -# } -# } ## Optimisation @@ -1166,111 +673,12 @@ pshifts = NULL, varcov = NULL) { opdfct1 <- function(parm) { -# print(as.vector(apply(opdfctTemp(parm), 2, appFct, assayNo))) as.vector(apply(opdfctTemp(parm), 2, appFct, assayNo)) } } else { opdfct1 <- NULL } - ## Manipulating before optimisation - -# ## Scaling x values -#if (FALSE) -#{ -# sxInd <- fct$"sxInd" -# sxYN <- !is.null(sxInd) && ((max(dose)<1e-2) || (min(dose)>1e2) || (diff(range(dose))>1e2) ) -# if ( sxYN && (is.null(fctList)) ) -# { -## if (!is.null(fctList)) -## { -## parmIndX <- rep(0, numAss) -## for (i in 1:numAss) -## { -## parmIndX[i] <- fctList[[i]]$"sxInd" -## } -## parmIndX <- cumsum(parmIndX) -## } else { -# parmIndX <- parmPos[sxInd] + 1:ncclVec[sxInd] -## } -# -# scaleXConstant <- median(dose) -# sxFct <- scaleX(scaleXConstant) # , scaleX(dose, maxDose) -# if (adjust == "vp") -# { -# dose <- sxFct(dose) -# opfct <- drmEMvp(dose, resp, multCurves2)$"opfct" -# } -# -# startVec[parmIndX] <- sxFct(startVec[parmIndX]) -# } -## print(startVec) # 2 -#} - -# ## Scaling y values -# ## based on the original response value -# ## not the transformed values -# syInd <- fct$"syInd" -# lensy <- length(syInd) -# parmIndY <- list() -# -# lyLim <- 1e-2 -# uyLim <- 1e2 -# syYN <- !is.null(syInd) && ((max(origResp)uyLim) || (diff(range(origResp))>uyLim)) -# if ( syYN && (is.null(fctList)) ) -# { -## if (!is.null(fctList)) -## { -## parmIndY <- rep(0, numAss) -## for (i in 1:numAss) -## { -## parmIndY[[i]] <- fctList[[i]]$"syInd" -## } -## parmIndY <- cumsum(as.vector(unlist(parmIndY))) -## } else { -# for (i in 1:lensy) -# { -# parmIndY[[i]] <- parmPos[syInd[i]] + c(1:ncclVec[syInd[i]]) -# } -# tempPIY <- as.vector(unlist(parmIndY)) -# parmIndY <- tempPIY -## } -# if (adjust == "bc1") -# { -# scaleYConstant <- bcfct(median(origResp), lambda, bcTol) # median(origResp) -# } else { -# scaleYConstant <- median(origResp) -# } -# syFct <- scaleY(median(origResp)) # scaleY(scaleYConstant) -# startVec[parmIndY] <- syFct(startVec[parmIndY]) -# } -# # scaling of y values through 'opfct' definition -## print(startVec) # 3 - - - ## Testing nonlinear function -# print(startVecSc) -# print(multCurves2(dose, startVecSc)) -# print(opfct(startVecSc)) -## print(dose) -## print(resp) - - ## Scaling objective function -# if (type == "continuous") -# { -# ofVal <- opfct(startVec) -# if ( !is.nan(ofVal) && ( (ofVal < 1e-2) || (ofVal >1e2) ) ) -# { -# opfct2 <- function(c){opfct(c)/opfct(startVec)} -# } else { -# opfct2 <- opfct -# } -# } else { -# opfct2 <- opfct -# } -# opfct2 <- opfct # only used once below - - ## Updating starting values startVecSc <- as.vector(startVecSc) # removing names if (identical(type, "negbin1") || identical(type, "negbin2")) @@ -1279,16 +687,12 @@ pshifts = NULL, varcov = NULL) parmVec <- c(parmVec, "O:(Intercept)") parmVecA <- c(parmVecA, "O") parmVecB <- c(parmVecB, "(Intercept)") - -# print(opfct(startVecSc)) } - ## Optimising the objective function previously defined nlsFit <- drmOpt(opfct, opdfct1, startVecSc, optMethod, constrained, warnVal, upperLimits, lowerLimits, errorMessage, maxIt, relTol, parmVec = parmVec, traceVal = control$"trace", - matchCall = callDetail, silentVal = control$"otrace") -# matchCall = match.call()) + matchCall = callDetail, silentVal = !control$"otrace") if (!nlsFit$convergence) {return(nlsFit)} @@ -1296,17 +700,10 @@ pshifts = NULL, varcov = NULL) if (identical(type, "negbin1") || identical(type, "negbin2")) { longScaleVec <- c(longScaleVec, 1) - } if (identical(type, "event")) { -# dose <- dose[isFinite, 2] -# resp <- (as.vector(unlist(tapply(resp, assayNo, function(x){cumsum(x) / sum(x)}))))[isFinite] - -# orderDose <- order(dose0) -# dose1 <- dose0[orderDose] - assayNo0 <- assayNo[isFinite] dose0 <- dose[, 2] dose1 <- dose0[isFinite] @@ -1314,7 +711,6 @@ pshifts = NULL, varcov = NULL) ## Rescaling per curve id idList <- split(data.frame(dose0, resp), assayNo) -# print(idList) respFct <- function(idListElt) { @@ -1331,15 +727,10 @@ pshifts = NULL, varcov = NULL) dose <- as.vector(unlist(lapList)) resp <- as.vector(unlist(lapply(drList, function(x){x[, 2]}))) -# listCI <- split(assayNoOld[isFinite], assayNoOld[isFinite]) -# splitFactor <- factor(assayNoOld[isFinite], exclude = NULL) splitFactor <- factor(assayNo, exclude = NULL) listCI <- split(splitFactor, splitFactor) lenVec <- as.vector(unlist(lapply(lapList, length))) -# print(listCI) -# print(lenVec) plotid <- as.factor(as.vector(unlist(mapply(function(x,y){x[1:y]}, listCI, lenVec)))) -# plotid <- plotid[complete.cases(plotid)] levels(plotid) <- unique(assayNoOld) } else { plotid <- NULL @@ -1360,9 +751,6 @@ pshifts = NULL, varcov = NULL) } } - - -# print(nlsFit$par) ## Adjusting for pre-fit scaling if (!is.null(scaleFct)) { @@ -1370,83 +758,18 @@ pshifts = NULL, varcov = NULL) nlsFit$value <- nlsFit$value * (respScaling^2) # Scaling estimates and Hessian back -# print(longScaleVec) nlsFit$par <- nlsFit$par * longScaleVec nlsFit$hessian <- nlsFit$hessian * (1/outer(longScaleVec/respScaling, longScaleVec/respScaling)) } - if (!is.null(fct$"retFct")) #&& (!identical(type, "ssd"))) + if (!is.null(fct$"retFct")) { - drcFct <- fct$"retFct"(1, 1) #, numObs) # resetting the scaling + drcFct <- fct$"retFct"(1, 1) # resetting the scaling drcFct1 <- function(dose, parm) { drcFct(dose, parm2mat(parm)[isFinite, , drop = FALSE]) } } - - -# print(nlsFit$par) -# nlsFit$value <- opfct(nlsFit$par) # used in the residual variance - - ## Manipulating after optimisation - -# ## Adjusting for scaling of y values -# if ( syYN && (is.null(fctList)) ) -# { -# nlsFit$value <- syFct(syFct(nlsFit$value, down = FALSE), down = FALSE) -# startVec[parmIndY] <- syFct(startVec[parmIndY], down = FALSE) -# nlsFit$par[parmIndY] <- syFct(nlsFit$par[parmIndY], down = FALSE) -# -# scaleFct1 <- function(hessian) -# { -# newHessian <- hessian -# newHessian[, parmIndY] <- syFct(newHessian[, parmIndY], down = FALSE) -# newHessian[parmIndY, ] <- syFct(newHessian[parmIndY, ], down = FALSE) -# return(newHessian) -# } -# } else { -# scaleFct1 <- function(x) {x} -# } - - -# ## Adjusting for scaling of x values -#if (FALSE) -#{ -# if ( sxYN && (is.null(fctList)) ) # (!is.null(sxInd)) -# { -# if (adjust == "vp") -# { -# dose <- sxFct(dose, down = FALSE) -# } -# startVec[parmIndX] <- sxFct(startVec[parmIndX], down = FALSE) -# nlsFit$par[parmIndX] <- sxFct(nlsFit$par[parmIndX], down = FALSE) -# -# scaleFct2 <- function(hessian) -# { -# newHessian <- scaleFct1(hessian) -# newHessian[, parmIndX] <- sxFct(newHessian[, parmIndX], down = FALSE) -# newHessian[parmIndX, ] <- sxFct(newHessian[parmIndX, ], down = FALSE) -# return(newHessian) -# } -# } else { -# scaleFct2 <- function(hessian) -# { -# scaleFct1(hessian) -# } -# } -#} - -# ## Handling variance parameters -# varParm <- NULL -# -# if (varPower) -# { -# varParm <- list(type = "varPower", index = 1:lenStartVec) -# } -# if (!is.null(vvar)) -# { -# varParm <- list(type = "hetvar", index = 1:lenStartVec) -# } # Testing against the ANOVA (F-test) nlsSS <- nlsFit$value @@ -1465,26 +788,13 @@ pshifts = NULL, varcov = NULL) parmMat <- matrix(NA, numAss, numNames) fixedParm <- (estMethod$"parmfct")(nlsFit) -# print(nlsFit$par) -# print(fixedParm) parmMat[iVec, ] <- (parm2mat(fixedParm))[pickCurve, ] indexMat2 <- parm2mat(1:length(fixedParm)) indexMat2 <- indexMat2[!duplicated(indexMat2), ] - -# if(!is.null(fctList)) -# { -# parmMat <- matrix(NA, numAss, numNames) -# for (i in 1:numAss) -# { -# parmMat[i, ivList2[[i]]] <- fixedParm[(posVec[i]+1):posVec[i+1]] -# } -# } if (!is.null(cm)) { -# conPos <- upperPos -# print(conPos) parmMat[-iVec, upperPos] <- (parm2mat(fixedParm))[assayNoOld == cm, , drop = FALSE][1, upperPos] # 1: simply picking the first row } @@ -1497,7 +807,6 @@ pshifts = NULL, varcov = NULL) if (!is.null(cm)) { -# conPos <- conList$"pos" parmMat[-iVec, upperPos] <- (parm2mat(fixedParm))[assayNoOld == cm, , drop = FALSE][1, upperPos] # 1: simply picking the first row } @@ -1505,97 +814,28 @@ pshifts = NULL, varcov = NULL) return(parmMat) } - parmMat <- pmFct(fixedParm) # (estMethod$"parmfct")(nlsFit) ) -# print(parmMat) -# print(pmFct(1:length(fixedParm))) - -# ## Scaling parameters -# if (!is.null(fct$scaleFct)) -# { -# scaleFct <- function(parm) -# { -# fct$scaleFct(parm, xScaling, yScaling) -# } -# -# parmMat <- apply(parmMat, 1, scaleFct) -# } -# - - ## Constructing design matrix allowing calculations for each curve -# colPos <- 1 -# rowPos <- 1 -# Xmat <- matrix(0, numAss*numNames, length(nlsFit$par)) -# Xmat <- matrix(0, numAss*numNames, length(fixedParm)) - - -# if (!is.null(fctList)) {omitList <- list()} -# for (i in 1:numNames) -# { -# indVec <- iVec -# lenIV <- length(indVec) -# -# nccl <- ncol(pmodelsList2[[i]]) # min(maxParm[i], ncol(pmodelsList2[[i]])) -# -# XmatPart <- matrix(0, lenIV, nccl) -# k <- 1 -# if (!is.null(fctList)) {omitVec <- rep(TRUE, lenIV)} -# for (j in indVec) -# { -# if (!is.null(fctList)) -# { -# parPresent <- !is.na(match(i, ivList2[[j]])) -# omitVec[k] <- parPresent -# } -# -# XmatPart[k, ] <- (pmodelsList2[[i]])[(1:lenData)[assayNo == j][1], 1:nccl] -# k <- k + 1 -# } -# if (!is.null(fctList)) -# { -# XmatPart <- XmatPart[omitVec, , drop = FALSE] -# nccl <- nccl - sum(!omitVec) -# omitList[[i]] <- omitVec -# } -# -# Xmat[rowPos:(rowPos+lenIV-1), colPos:(colPos+nccl-1)] <- XmatPart -# colPos <- colPos + nccl -# rowPos <- rowPos + lenIV -# } -# Xmat <- Xmat[1:(rowPos-1), 1:(colPos-1)] - + parmMat <- pmFct(fixedParm) ## Defining the plot function pfFct <- function(parmMat) { plotFct <- function(dose) { -# if (xDim == 1) {lenPts <- length(dose)} else {lenPts <- nrow(dose)} if (is.vector(dose)) { lenPts <- length(dose) } else { lenPts <- nrow(dose) } -# print(lenPts) -# print(ciOrigLength) - curvePts <- matrix(NA, lenPts, ciOrigLength) # numAss) + curvePts <- matrix(NA, lenPts, ciOrigLength) for (i in 1:numAss) { -# if (!is.null(fctList)) -# { -# drcFct <- fctList[[i]]$"fct" -# numNames <- matList[[i]][2] -# } - if (i %in% iVec) { -# parmChosen <- parmMat[i, ] parmChosen <- parmMat[i, complete.cases(parmMat[i, ])] # removing NAs -# print(parmChosen) parmMat2 <- matrix(parmChosen, lenPts, numNames, byrow = TRUE) -# print(parmMat2) curvePts[, ciOrigIndex[i]] <- drcFct(dose, parmMat2) } else { curvePts[, i] <- rep(NA, lenPts)} } @@ -1604,9 +844,7 @@ pshifts = NULL, varcov = NULL) return(plotFct) } -# print(parmMat) plotFct <- pfFct(parmMat) -# plotFct(0:10) ## Computation of fitted values and residuals @@ -1628,17 +866,12 @@ pshifts = NULL, varcov = NULL) { nlsFit$value <- (mad(resVec, 0)^2)*nlsDF } -# if (robust=="winsor") -# { -# K <- 1 + length(startVec)*var(psi.huber(resVec/s, deriv=1)) -# } if (robust%in%c("lms", "lts")) # p. 202 i Rousseeuw and Leroy: Robust Regression and Outlier Detection { scaleEst <- 1.4826*(1+5/(numObs-length(nlsFit$par)))*sqrt(median(resVec^2)) w <- (resVec/scaleEst < 2.5) nlsFit$value <- sum(w*resVec^2)/(sum(w)-length(nlsFit$par)) } - ## Adding meaningful names for robust methods robust <- switch(robust, median="median", trimmed="metric trimming", tukey="Tukey's biweight", @@ -1647,17 +880,11 @@ pshifts = NULL, varcov = NULL) ## Collecting summary output - sumVec <- c(NA, NA, NA, nlsSS, nlsDF, numObs) # , alternative) + sumVec <- c(NA, NA, NA, nlsSS, nlsDF, numObs) sumList <- list(lenData = numObs, - alternative = NULL, # alternative, + alternative = NULL, df.residual = numObs - length(startVec)) - - ## The function call -# callDetail <- match.call() -# if (is.null(callDetail$fct)) {callDetail$fct <- substitute(l4())} - - ## The data set if (!is.null(logDose)) { @@ -1665,7 +892,6 @@ pshifts = NULL, varcov = NULL) } dataSet <- data.frame(origDose, origResp, assayNo, assayNoOld, wVec) -# print(varNames0) if (identical(type, "event")) { names(dataSet) <- c(varNames0[c(2, 3, 1)], anName, paste("orig.", anName, sep = ""), "weights") @@ -1673,66 +899,13 @@ pshifts = NULL, varcov = NULL) names(dataSet) <- c(varNames0[c(2, 1)], anName, paste("orig.", anName, sep = ""), "weights") } - -# ## Box-Cox information -# bcVec <- c(lambda, boxcoxci) -# if (all(is.na(bcVec))) {bcVec <- NULL} -# if (!is.null(bcVec)) {bcVec <- c(bcVec, bcAdd)} - - - ## Evaluating goodness-of-fit test -# if (!is.null(gofTest)) {gofTest <- gofTest(resp, weights, predVec, sumList$"df.residual")} - - -# ## Adjusting in case 'fctList' is specified -# if (!is.null(fctList)) -# { -# omitAllVec <- as.vector(unlist(omitList)) -# -# parmVec <- parmVec[omitAllVec] -# parmVecA <- parmVecA[omitAllVec] -# parmVecB <- parmVecB[omitAllVec] -# -# orderVec <- match(as.vector(parmMat), nlsFit$par) -# orderVec <- orderVec[complete.cases(orderVec)] -# -# nlsFit$par <- nlsFit$par[orderVec] -# nlsFit$hessian <- nlsFit$hessian[orderVec, orderVec] -# } - - - ## Constructing an index matrix for use in ED and SI -# (commented out Dec 7 2011, replaced by definition below of the index matrix) -# hfct1 <- function(x) # helper function -# { -# uniVec <- unique(x[!is.na(x)]) -# rv <- rep(NA, length(x)) -# for (i in 1:length(uniVec)) -# { -# rv[abs(x-uniVec[i]) < 1e-12] <- i -# } -# rv -# } -# hfct2 <- function(x) -# { -# length(unique(x)) -# } -## parmMat <- t(parmMat) -# mat1 <- t(apply(t(parmMat), 1, hfct1)) # , 1:ncol(parmMat))) -# cnccl <- head(cumsum(ncclVec), -1) -## mat2 <- mat1 -# if (nrow(mat1) == 1) {mat1 <- t(mat1)} # in case of only one curve -# mat1[-1, ] <- mat1[-1, ] + cnccl - ## Matrix of first derivatives evaluated at the parameter estimates if (isDF) { -# print((parmMat[assayNo, , drop = FALSE])[isFinite, , drop = FALSE]) deriv1Mat <- fct$"deriv1"(dose, (parmMat[assayNo, , drop = FALSE])[isFinite, , drop = FALSE]) } else { deriv1Mat <- NULL } -# deriv1Mat <- NULL ## Box-Cox information if (!is.null(bcVal)) @@ -1747,10 +920,9 @@ pshifts = NULL, varcov = NULL) names(coefVec) <- parmVec ## Constructing the index matrix -# parmMat <- t(parmMat) indexMat <- apply(t(parmMat), 2, function(x){match(x, coefVec)}) - ## Constructing data list ... where is it used? + ## Constructing data list wName <- callDetail[["weights"]] if (is.null(wName)) { @@ -1758,7 +930,6 @@ pshifts = NULL, varcov = NULL) } else { wName <- deparse(wName) } -# dataList <- list(dose = as.vector(origDose), origResp = as.vector(origResp), weights = wVec, dataList <- list(dose = origDose, origResp = as.vector(origResp), weights = wVec, curveid = assayNoOld, resp = as.vector(resp), names = list(dName = varNames[1], orName = varNames[2], wName = wName, cNames = anName, rName = "")) @@ -1776,17 +947,10 @@ pshifts = NULL, varcov = NULL) wName = wName, cNames = anName, rName = "")) } - - ## What about naming the vector of weights? - ## Returning the fit -# returnList <- list(varParm, nlsFit, list(plotFct, logDose), sumVec, startVec, list(parmVec, parmVecA, parmVecB), returnList <- list(NULL, nlsFit, list(plotFct, logDose), sumVec, startVecSc * longScaleVec, -# returnList <- list(nlsFit, list(plotFct, logDose), sumVec, startVecSc * longScaleVec, list(parmVec, parmVecA, parmVecB), diagMat, callDetail, dataSet, t(parmMat), fct, robust, estMethod, numObs - length(startVec), -# anovaModel0, gofTest, -# sumList, NULL, pmFct, pfFct, type, mat1, logDose, cm, deriv1Mat, sumList, NULL, pmFct, pfFct, type, indexMat, logDose, cm, deriv1Mat, anName, data, wVec, dataList, @@ -1795,14 +959,11 @@ pshifts = NULL, varcov = NULL) names(returnList) <- c("varParm", "fit", "curve", "summary", "start", "parNames", "predres", "call", "data", -# names(returnList) <- c("fit", "curve", "summary", "start", "parNames", "predres", "call", "data", "parmMat", "fct", "robust", "estMethod", "df.residual", -# "anova", "gofTest", "sumList", "scaleFct", "pmFct", "pfFct", "type", "indexMat", "logDose", "cm", "deriv1", "curveVarNam", "origData", "weights", "dataList", "coefficients", "boxcox", "indexMat2") - ## Argument "scaleFct" not used anymore - class(returnList) <- c("drc") # , class(fct)) + class(returnList) <- c("drc") return(returnList) } diff --git a/R/drmConvertParm.R b/R/drmConvertParm.R index 1d1de569..3f195fd9 100644 --- a/R/drmConvertParm.R +++ b/R/drmConvertParm.R @@ -1,53 +1,36 @@ -"drmConvertParm" <- -function(startVec, startMat, factor1, colList) -{ -#print(startMat) - startMat2 <- startMat -# print(factor1) - if (length(unique(factor1)) == 1) {return(startVec)} - - mmat <- model.matrix(~factor(factor1) - 1) -# print(dim(mmat)) - - pm <- list() - for (i in 1:length(colList)) - { - clElt <- colList[[i]] - ncclElt <- dim(clElt)[2] - - indVec <- !is.na(startMat2[, i, drop = FALSE]) - indVal <- min(c(sum(indVec), dim(clElt)[2])) -# print(indVec) -# print(indVal) - - indVec2 <- (1:ncclElt)[indVec] - if (length(indVec2) > ncclElt) {indVec2 <- 1:ncclElt} -# print(indVec2) -# pm[[i]] <- (ginv(t(clElt)%*%clElt)%*%t(clElt))[indVec2, ,drop=FALSE]%*%mmat[,indVec]%*%startMat2[indVec, i, drop=FALSE] -# then cabanne works - - -# print( ((ginv(t(clElt)%*%clElt)%*%t(clElt))[, ,drop=FALSE]%*%mmat[,indVec]%*%startMat2[indVec, i, drop=FALSE])[1:length(indVec2)] ) - - pm[[i]] <- (ginv(t(clElt)%*%clElt)%*%t(clElt))[1:indVal, ,drop = FALSE]%*%mmat[,indVec]%*%startMat2[indVec, i, drop = FALSE] -# print( (ginv(t(clElt)%*%clElt)%*%t(clElt))[1:indVal, ,drop = FALSE]%*%mmat[,indVec]%*%startMat2[indVec, i, drop = FALSE] ) -# print(pm[[i]]) - - -# if ((length(posVec[[i]])>0) && !(upperPos==i)) {pm[[i]] <- pm[[i]][-pos]} - } - tempVec <- unlist(pm) - tempVec <- tempVec[!is.na(tempVec)] -# print(tempVec) - - - ## Checking whether the intercept column has been removed - indVec3 <- ( abs(tempVec)<1e-10 ) - if (any(indVec3)) - { -# tempVec[indVec3] <- startVec[indVec3] - tempVec <- startVec - } - - return(tempVec) -} +#' @title Convert parameter vectors to matrices +#' @keywords internal +"drmConvertParm" <- +function(startVec, startMat, factor1, colList) +{ + startMat2 <- startMat + if (length(unique(factor1)) == 1) {return(startVec)} + + mmat <- model.matrix(~factor(factor1) - 1) + + pm <- list() + for (i in 1:length(colList)) + { + clElt <- colList[[i]] + ncclElt <- dim(clElt)[2] + + indVec <- !is.na(startMat2[, i, drop = FALSE]) + indVal <- min(c(sum(indVec), dim(clElt)[2])) + + indVec2 <- (1:ncclElt)[indVec] + if (length(indVec2) > ncclElt) {indVec2 <- 1:ncclElt} + + pm[[i]] <- (ginv(t(clElt)%*%clElt)%*%t(clElt))[1:indVal, , drop = FALSE]%*%mmat[, indVec]%*%startMat2[indVec, i, drop = FALSE] + } + tempVec <- unlist(pm) + tempVec <- tempVec[!is.na(tempVec)] + + ## Checking whether the intercept column has been removed + indVec3 <- ( abs(tempVec)<1e-10 ) + if (any(indVec3)) + { + tempVec <- startVec + } + + return(tempVec) +} diff --git a/R/drmEMPoisson.R b/R/drmEMPoisson.R index 50e32238..0806fb77 100644 --- a/R/drmEMPoisson.R +++ b/R/drmEMPoisson.R @@ -1,58 +1,52 @@ -"drmEMPoisson" <- -function(dose, resp, multCurves, startVec, weightsVec, doseScaling = 1) -{ - - ## Finding indices for doses that give contribution to likelihood function -# iv <- ( (multCurves(dose, startVec) > zeroTol) & (multCurves(dose, startVec) < 1-zeroTol) ) - - - ## Defining the objective function - opfct <- function(c) # dose, resp and weights are fixed - { - lambda <- weightsVec * multCurves(dose / doseScaling, c) - return( -sum(-lambda + resp*log(lambda))) - } - - - ## Defining self starter function - ssfct <- NULL - - - ## Defining the log likelihood function - llfct <- function(object) - { -# total <- (object$"data")[iv, 5] -# success <- total*(object$"data")[iv, 2] -# c( sum(log(choose(total, success))) - object$"fit"$"ofvalue", object$"sumList"$"df.residual" ) - - c( - -object$"fit"$value + sum(log(gamma(resp+1))), - object$"sumList"$"df.residual" - ) # adding scale constant - } - - - ## Defining functions returning the residual variance, the variance-covariance and the fixed effects estimates - rvfct <- NULL - - vcovfct <- function(object) - { - solve(object$fit$hessian) - } - - parmfct <- function(fit, fixed = TRUE) - { - fit$par - } - - - ## Returning list of functions - return(list(llfct = llfct, opfct = opfct, ssfct = ssfct, rvfct = rvfct, vcovfct = vcovfct, - parmfct = parmfct)) -} - - -"drmLOFPoisson" <- function() -{ - return(list(anovaTest = NULL, gofTest = NULL)) -} +"drmEMPoisson" <- +function(dose, resp, multCurves, startVec, weightsVec, doseScaling = 1) +{ + + ## Defining the objective function + opfct <- function(c) # dose, resp and weights are fixed + { + lambda <- weightsVec * multCurves(dose / doseScaling, c) + return( -sum(-lambda + resp*log(lambda))) + } + + + ## Defining self starter function + ssfct <- NULL + + + ## Defining the log likelihood function + llfct <- function(object) + { + c( + -object$"fit"$value + sum(log(gamma(resp+1))), + object$"sumList"$"df.residual" + ) # adding scale constant + } + + + ## Defining functions returning the residual variance, the variance-covariance and the fixed effects estimates + rvfct <- NULL + + vcovfct <- function(object) + { + solve(object$fit$hessian) + } + + parmfct <- function(fit, fixed = TRUE) + { + fit$par + } + + + ## Returning list of functions + return(list(llfct = llfct, opfct = opfct, ssfct = ssfct, rvfct = rvfct, vcovfct = vcovfct, + parmfct = parmfct)) +} + + +#' @title EM algorithm for Poisson response +#' @keywords internal +"drmLOFPoisson" <- function() +{ + return(list(anovaTest = NULL, gofTest = NULL)) +} diff --git a/R/drmEMbinomial.R b/R/drmEMbinomial.R index 0102473c..f0436146 100644 --- a/R/drmEMbinomial.R +++ b/R/drmEMbinomial.R @@ -1,70 +1,51 @@ -"drmEMbinomial" <- -function(dose, resp, multCurves, startVec, robustFct, weights, rmNA, zeroTol = 1e-12, -doseScaling = 1, respScaling = 1) -{ - ## Finding indices for doses that give contribution to likelihood function - iv <- ( (multCurves(dose/doseScaling, startVec) > zeroTol) & (multCurves(dose/doseScaling, startVec) < 1-zeroTol) ) - - ## Defining the objective function - opfct <- function(c) # dose, resp and weights are fixed - { -# prob <- (multCurves(dose / doseScaling, c))[iv] -# prob <- multCurves(dose, c) - -# prob0 <- (multCurves(dose / doseScaling, c)) -# iv <- (prob0 > zeroTol) & (prob0 < (1 - zeroTol)) -# prob <- prob0[iv] - -# print(log(prob/(1-prob[]))) -# print(-sum((resp*weights)[iv]*log(prob/(1-prob))+weights[iv]*log(1-prob))) -# return( -sum((resp2*weights2)*log(prob/(1-prob))+weights2*log(1-prob)) ) - - prob <- multCurves(dose / doseScaling, c) - omZT <- 1 - zeroTol - prob[prob > omZT] <- omZT - prob[prob < zeroTol] <- zeroTol - -sum((resp * weights) * log(prob / (1 - prob)) + (weights * log(1 - prob))) - -# -sum((resp * weights) * log(prob) + ((weights - resp * weights) * log(1 - prob))) - } - - ## Defining self starter function - ssfct <- NULL - - ## Defining the log likelihood function - llfct <- function(object) - { -# total <- (object$"data")[iv, 5] -# success <- total*(object$"data")[iv, 2] - total <- (object$"data")[, 5] - success <- total*(object$"data")[, 2] - - - c(sum(log(choose(total, success))) - object$"fit"$"ovalue", # object$"fit"$"ofvalue", - object$"sumList"$"lenData" - df.residual(object)) # object$"sumList"$"df.residual") - } - - ## Defining functions returning the residual variance, the variance-covariance and the fixed effects estimates - rvfct <- NULL - - vcovfct <- function(object) - { - solve(object$fit$hessian) - } - - parmfct <- function(fit, fixed = TRUE) - { - fit$par - } - -# -# ## Modifying ANOVA test (removing dose=0 and dose=Inf) -# anovaTest2 <- function(formula, ds) {anovaTest(formula, ds[iv, ])} - - - ## Returning list of functions - return(list(llfct = llfct, opfct = opfct, ssfct = ssfct, rvfct = rvfct, - vcovfct = vcovfct, parmfct = parmfct)) # , anovaTest2=anovaTest2)) -} - - +"drmEMbinomial" <- +function(dose, resp, multCurves, startVec, robustFct, weights, rmNA, zeroTol = 1e-12, +doseScaling = 1, respScaling = 1) +{ + ## Finding indices for doses that give contribution to likelihood function + iv <- ( (multCurves(dose/doseScaling, startVec) > zeroTol) & (multCurves(dose/doseScaling, startVec) < 1-zeroTol) ) + + ## Defining the objective function +#' @title EM algorithm for binomial response +#' @keywords internal + opfct <- function(c) # dose, resp and weights are fixed + { + prob <- multCurves(dose / doseScaling, c) + omZT <- 1 - zeroTol + prob[prob > omZT] <- omZT + prob[prob < zeroTol] <- zeroTol + -sum((resp * weights) * log(prob / (1 - prob)) + (weights * log(1 - prob))) + } + + ## Defining self starter function + ssfct <- NULL + + ## Defining the log likelihood function + llfct <- function(object) + { + total <- (object$"data")[, 5] + success <- total*(object$"data")[, 2] + + c(sum(log(choose(total, success))) - object$"fit"$"ovalue", + object$"sumList"$"lenData" - df.residual(object)) + } + + ## Defining functions returning the residual variance, the variance-covariance and the fixed effects estimates + rvfct <- NULL + + vcovfct <- function(object) + { + solve(object$fit$hessian) + } + + parmfct <- function(fit, fixed = TRUE) + { + fit$par + } + + ## Returning list of functions + return(list(llfct = llfct, opfct = opfct, ssfct = ssfct, rvfct = rvfct, + vcovfct = vcovfct, parmfct = parmfct)) +} + + diff --git a/R/drmEMeventtime.r b/R/drmEMeventtime.R similarity index 66% rename from R/drmEMeventtime.r rename to R/drmEMeventtime.R index dc28c4d7..2bb16a4a 100644 --- a/R/drmEMeventtime.r +++ b/R/drmEMeventtime.R @@ -2,18 +2,6 @@ function(dose, resp, multCurves, doseScaling = 1) { ## Defining the objective function -# opfct <- function(c) # dose, resp and weights are fixed -# { -# Fstart <- multCurves(dose[, 1] / doseScaling, c) -# dose2 <- dose[, 2] -# # IsFinite <- is.finite(dose2) -# # Fend <- rep(1, length(dose2)) -# # Fend <- multCurves(dose[, 2] / doseScaling, c) -# Fend <- multCurves(dose2 / doseScaling, c) -# Fend[!is.finite(dose2)] <- 1 -# return( -sum(resp * log(Fend - Fstart)) ) -# # minus in front of sum() as maximization is done as minimization -# } opfct <- function(c) # dose, resp and weights are fixed { Fstart <- multCurves(dose[, -2] / doseScaling, c) @@ -39,10 +27,6 @@ function(dose, resp, multCurves, doseScaling = 1) ## Defining the log likelihood function llfct <- function(object) { -# total <- (object$"data")[iv, 5] -# success <- total*(object$"data")[iv, 2] -# c( sum(log(choose(total, success))) - object$"fit"$"ofvalue", object$"sumList"$"df.residual" ) - c( -object$"fit"$value, # oops a constant is missing! object$"sumList"$"df.residual" @@ -70,6 +54,8 @@ function(dose, resp, multCurves, doseScaling = 1) } +#' @title EM algorithm for event time data +#' @keywords internal "drmLOFeventtime" <- function() { return(list(anovaTest = NULL, gofTest = NULL)) diff --git a/R/drmEMls.R b/R/drmEMls.R index 771c71f9..85de6621 100644 --- a/R/drmEMls.R +++ b/R/drmEMls.R @@ -3,6 +3,8 @@ function(dose, resp, multCurves, startVec, robustFct, weights, rmNA, dmf = NULL, doseScaling = 1, respScaling = 1, varcov = NULL) { ## Defining the objective function and its derivative +#' @title EM algorithm for least squares +#' @keywords internal opfct <- function(parm) { sum(robustFct(((resp / respScaling) - multCurves((dose / doseScaling), parm)) / weights), @@ -24,9 +26,6 @@ doseScaling = 1, respScaling = 1, varcov = NULL) { opdfct1 <- function(parm) { -# apply(-2*(resp - multCurves(dose, parm))*dmf(dose, parm), 2, sum) -# apply(-2*(resp - multCurves(dose, parm))*dmf(dose, parm), 2, appFct, cid) - -2*((resp / respScaling) - multCurves((dose / doseScaling), parm)) * dmf((dose / doseScaling), parm) } } else { @@ -42,7 +41,6 @@ doseScaling = 1, respScaling = 1, varcov = NULL) degfre <- object$"sumList"$"lenData" # "df.residual" # object$summary[6] c( -(degfre/2)*(log(2*pi)+log(object$"fit"$"value")-log(degfre)+1), object$"sumList"$"lenData" - object$"sumList"$"df.residual" + 1) -# length(object$"fit"$"par") + 1 ) } ## Defining functions returning the residual variance, the variance-covariance matrix and the fixed effects estimates @@ -53,7 +51,6 @@ doseScaling = 1, respScaling = 1, varcov = NULL) vcovfct <- function(object) { -# scaledH <- (object$"fit"$"hessian")*(1/(2*object$"fit"$"ovalue"/object$"sumList"$"df.residual")) # /2 scaledH <- (object$"fit"$"hessian") / (2 * rvfct(object)) invMat <- try(solve(scaledH), silent = TRUE) @@ -70,8 +67,6 @@ doseScaling = 1, respScaling = 1, varcov = NULL) } else { return(invMat) } -# solve((object$"fit"$"hessian")*(1/rvfct(object))/2) -# solve((object$"fit"$"hessian")*(1/(object$"fit"$"ovalue"/object$"sumList"$"df.residual"))/2) } parmfct <- function(fit, fixed = TRUE) diff --git a/R/drmEMnegbin.R b/R/drmEMnegbin.R index 6794efee..b06955fd 100644 --- a/R/drmEMnegbin.R +++ b/R/drmEMnegbin.R @@ -1,72 +1,66 @@ -"drmEMnegbin" <- -function(dose, resp, multCurves, startVec, weightsVec, doseScaling = 1, dist.type = 1) -{ - - ## Finding indices for doses that give contribution to likelihood function -# iv <- ( (multCurves(dose, startVec) > zeroTol) & (multCurves(dose, startVec) < 1-zeroTol) ) - - - ## Defining the objective function - if (dist.type == 1) - { - opfct <- function(cVal) - { - sizeVal <- tail(cVal, 1) - pVal <- 1 / (1 + weightsVec * multCurves(dose / doseScaling, head(cVal, -1)) * exp(sizeVal)) -# print(c(sizeVal, pVal, -sum(dnbinom(resp, exp(-sizeVal), pVal, log = TRUE)))) - -sum(dnbinom(resp, exp(-sizeVal), pVal, log = TRUE)) - } - } - - if (dist.type == 2) - { - opfct <- function(cVal) - { - sizeVal <- tail(cVal, 1) - pVal <- 1 / (1 + weightsVec * exp(sizeVal)) - -sum(dnbinom(resp, exp(-sizeVal) * multCurves(dose / doseScaling, head(cVal, -1)), - pVal, log = TRUE)) - } - } - - - ## Defining self starter function - ssfct <- NULL - - - ## Defining the log likelihood function - llfct <- function(object) - { -# total <- (object$"data")[iv, 5] -# success <- total*(object$"data")[iv, 2] -# c( sum(log(choose(total, success))) - object$"fit"$"ofvalue", object$"sumList"$"df.residual" ) - - c(-object$"fit"$value, object$"sumList"$"df.residual" - ) # adding scale constant - } - - - ## Defining functions returning the residual variance, the variance-covariance and the fixed effects estimates - rvfct <- NULL - - vcovfct <- function(object) - { - solve(object$fit$hessian) - } - - parmfct <- function(fit, fixed = TRUE) - { - fit$par - } - - - ## Returning list of functions - return(list(llfct = llfct, opfct = opfct, ssfct = ssfct, rvfct = rvfct, vcovfct = vcovfct, - parmfct = parmfct)) -} - - -"drmLOFnegbin" <- function() -{ - return(list(anovaTest = NULL, gofTest = NULL)) -} +#' @importFrom stats dnbinom +"drmEMnegbin" <- +function(dose, resp, multCurves, startVec, weightsVec, doseScaling = 1, dist.type = 1) +{ + + ## Defining the objective function + if (dist.type == 1) + { + opfct <- function(cVal) + { + sizeVal <- tail(cVal, 1) + pVal <- 1 / (1 + weightsVec * multCurves(dose / doseScaling, head(cVal, -1)) * exp(sizeVal)) + -sum(dnbinom(resp, exp(-sizeVal), pVal, log = TRUE)) + } + } + + if (dist.type == 2) + { + opfct <- function(cVal) + { + sizeVal <- tail(cVal, 1) + pVal <- 1 / (1 + weightsVec * exp(sizeVal)) + -sum(dnbinom(resp, exp(-sizeVal) * multCurves(dose / doseScaling, head(cVal, -1)), + pVal, log = TRUE)) + } + } + + + ## Defining self starter function + ssfct <- NULL + + + ## Defining the log likelihood function + llfct <- function(object) + { + c(-object$"fit"$value, object$"sumList"$"df.residual" + ) # adding scale constant + } + + + ## Defining functions returning the residual variance, the variance-covariance and the fixed effects estimates + rvfct <- NULL + + vcovfct <- function(object) + { + solve(object$fit$hessian) + } + + parmfct <- function(fit, fixed = TRUE) + { + fit$par + } + + + ## Returning list of functions + return(list(llfct = llfct, opfct = opfct, ssfct = ssfct, rvfct = rvfct, vcovfct = vcovfct, + parmfct = parmfct)) +} + + +#' @title EM algorithm for negative binomial +#' @keywords internal +"drmLOFnegbin" <- function() +{ + return(list(anovaTest = NULL, gofTest = NULL)) +} diff --git a/R/drmEMssd.R b/R/drmEMssd.R index 4a9f8f13..d256d7aa 100644 --- a/R/drmEMssd.R +++ b/R/drmEMssd.R @@ -1,70 +1,65 @@ -"drmEMssd" <- -function(dose, resp, multCurves, startVec, weightsVec, doseScaling = 1, multCurves2 = NULL) -{ - censYes <- (ncol(as.matrix(dose)) > 1) #(!is.null(ncol(dose))) & (ncol(dose == 2)) - if (censYes) - { - dose1 <- dose[, 1] - dose2 <- dose[, 2] - notCens <- dose1 == dose2 - } - - ## Defining the objective function - opfct <- function(cVal) - { -# -sum(log(multCurves(dose / doseScaling, cVal))) - # not using resp - - # Handling censoring - if (censYes) - { - fValues <- multCurves(dose1 / doseScaling, cVal)[notCens] - Fvalues1 <- multCurves2(dose1 / doseScaling, cVal)[!notCens] - Fvalues2 <- multCurves2(dose2 / doseScaling, cVal)[!notCens] - #print(multCurves(dose1 / doseScaling, cVal)) -# print(fValues) -# print(Fvalues1) -# print(Fvalues2) - -sum(log(fValues)) + (-sum(log(Fvalues2 - Fvalues1))) - } else { - -sum(log(multCurves(dose / doseScaling, cVal))) - - } - } - - - ## Defining self starter function - ssfct <- NULL - - - ## Defining the log likelihood function - llfct <- function(object) - { - c(-object$"fit"$value, object$"sumList"$"df.residual") - } - - - ## Defining functions returning the residual variance, the variance-covariance and the fixed effects estimates - rvfct <- NULL - - vcovfct <- function(object) - { - solve(object$fit$hessian) - } - - parmfct <- function(fit, fixed = TRUE) - { - fit$par - } - - - ## Returning list of functions - return(list(llfct = llfct, opfct = opfct, ssfct = ssfct, rvfct = rvfct, vcovfct = vcovfct, - parmfct = parmfct)) -} - - -"drmLOFssd" <- function() -{ - return(list(anovaTest = NULL, gofTest = NULL)) -} +"drmEMssd" <- +function(dose, resp, multCurves, startVec, weightsVec, doseScaling = 1, multCurves2 = NULL) +{ + censYes <- (ncol(as.matrix(dose)) > 1) #(!is.null(ncol(dose))) & (ncol(dose == 2)) + if (censYes) + { + dose1 <- dose[, 1] + dose2 <- dose[, 2] + notCens <- dose1 == dose2 + } + + ## Defining the objective function + opfct <- function(cVal) + { + # Handling censoring + if (censYes) + { + fValues <- multCurves(dose1 / doseScaling, cVal)[notCens] + Fvalues1 <- multCurves2(dose1 / doseScaling, cVal)[!notCens] + Fvalues2 <- multCurves2(dose2 / doseScaling, cVal)[!notCens] + -sum(log(fValues)) + (-sum(log(Fvalues2 - Fvalues1))) + } else { + -sum(log(multCurves(dose / doseScaling, cVal))) + + } + } + + + ## Defining self starter function + ssfct <- NULL + + + ## Defining the log likelihood function + llfct <- function(object) + { + c(-object$"fit"$value, object$"sumList"$"df.residual") + } + + + ## Defining functions returning the residual variance, the variance-covariance and the fixed effects estimates + rvfct <- NULL + + vcovfct <- function(object) + { + solve(object$fit$hessian) + } + + parmfct <- function(fit, fixed = TRUE) + { + fit$par + } + + + ## Returning list of functions + return(list(llfct = llfct, opfct = opfct, ssfct = ssfct, rvfct = rvfct, vcovfct = vcovfct, + parmfct = parmfct)) +} + + +#' @title EM algorithm for species sensitivity distribution +#' @keywords internal +"drmLOFssd" <- function() +{ + return(list(anovaTest = NULL, gofTest = NULL)) +} diff --git a/R/drmEMstandard.R b/R/drmEMstandard.R index c2fce16d..696d6977 100644 --- a/R/drmEMstandard.R +++ b/R/drmEMstandard.R @@ -1,298 +1,88 @@ -"drmEMstandard" <- -function(dose, resp, multCurves, doseScaling = 1) -{ - - ## Defining a helper function for calculating the variance-covariance matrix -# vcFct <- function(beta0, beta, sigma2, len0) -# { -# vc <- (sigma2 / len0) * (beta %o% beta) / (beta0^4) -# diag(vc) <- diag(vc) + sigma2 / (beta0^2) -# -# return(vc) -# } - vcFct <- function(beta0, beta, len0) - { - vc <- (1 / len0) * (beta %o% beta) / (beta0^4) - diag(vc) <- diag(vc) + (1 / (beta0^2)) - - return(vc) - } - - zeroDose <- dose < 1e-15 # hardcoded tolerance of 1e-15 - len0 <- sum(zeroDose) - vcFct2 <- function(beta0, betaVec) - { -# len0 <- weightVec[1] # in case len0 is a vector - - vc <- (1 / len0) * (betaVec %o% betaVec) / (beta0^4) - diag(vc) <- diag(vc) + (1 / (beta0^2)) - -# zeroDose <- dose < doseTol -# print(vc[!zeroDose, zeroDose]) -# print((1 / len0) * (-betaVec / (beta0^3))) -# print(vc[!zeroDose, zeroDose] + (1 / len0) * (-betaVec[!zeroDose] / (beta0^3))) - - vc[!zeroDose, zeroDose] <- vc[!zeroDose, zeroDose] + (1 / len0) * (-betaVec[!zeroDose] / (beta0^3)) - vc[zeroDose, !zeroDose] <- vc[zeroDose, !zeroDose] + (1 / len0) * (-betaVec[!zeroDose] / (beta0^3)) -# print(vc[zeroDose, zeroDose]) -# print(diag(vc[zeroDose, zeroDose]) + (1 / (len0 * beta0^2)) - (1 / (beta0^2))) - diag(vc[zeroDose, zeroDose]) <- diag(vc[zeroDose, zeroDose]) + (1 / (len0 * beta0^2)) - (1 / (beta0^2)) - - return(vc) - } - - - ## Defining the objective function - opfct <- function(c) # dose, resp and weights are fixed - { - print(c) - f0 <- multCurves(0, c)[1] - print(f0) - fVec <- multCurves(dose / doseScaling, c) - print(fVec) -# vcMat <- vcFct(f0, fVec, weightVec) - vcMat <- vcFct2(f0, fVec) - print(solve(vcMat)[1:6, 1:6]) - - sum( (resp - fVec) %*% solve(vcMat) %*% (resp - fVec)) - } - - - ## Defining self starter function - ssfct <- NULL - - - ## Defining the log likelihood function - llfct <- function(object) - { -# total <- (object$"data")[iv, 5] -# success <- total*(object$"data")[iv, 2] -# c( sum(log(choose(total, success))) - object$"fit"$"ofvalue", object$"sumList"$"df.residual" ) - - c( - -object$"fit"$value + sum(log(gamma(resp+1))), - object$"sumList"$"df.residual" - ) # adding scale constant - } - - - ## Defining functions returning the residual variance, the variance-covariance matrix, and the parameter estimates -# rvfct <- function(object) -# { -# object$"fit"$"value" / df.residual(object) # object$"sumList"$"df.residual" -# } -# -# vcovfct <- function(object) -# { -# solve(object$fit$hessian) -# } -# - - # copied from drmEMls.R - rvfct <- function(object) - { - object$"fit"$"value" / df.residual(object) - } - - vcovfct <- function(object) - { - scaledH <- (object$"fit"$"hessian") / (2 * rvfct(object)) - invMat <- try(solve(scaledH), silent = TRUE) - - if (inherits(invMat, "try-error")) - { - ## More stable than 'solve' (suggested by Nicholas Lewin-Koh - 2007-02-12) - ch <- try(chol(scaledH)) - if(inherits(ch, "try-error")) - { - ch <- try(chol(0.99 * object$fit$hessian + 0.01 * diag(dim(object$fit$hessian)[1]))) - } - ## Try regularizing if the varcov is unstable - if(!inherits(ch, "try-error")) return(chol2inv(ch)) - } else { - return(invMat) - } - } - - parmfct <- function(fit, fixed = TRUE) - { - fit$par - } - - - ## Returning list of functions - return(list(llfct = llfct, opfct = opfct, ssfct = ssfct, rvfct = rvfct, vcovfct = vcovfct, - parmfct = parmfct)) -} - - -"drmLOFstandard" <- function() -{ - return(list(anovaTest = NULL, gofTest = NULL)) -} - - - -if (FALSE) -{ - - -covFct <- function(sigma0, sigma, myVec, dose) -{ - zeroDose <- dose < 1e-15 # hardcoded tolerance of 1e-15 - len0 <- sum(zeroDose) - - my0 <- (myVec[zeroDose])[1] - n0 <- sum(zeroDose) - - lenMy <- length(myVec) - derMat <- matrix(0, lenMy, lenMy+1) - diag(derMat) <- 1 / my0 - derMat[, lenMy+1] <- -myVec / (my0^2) - - lenY <- lenMy + 1 - origVCmat <- matrix(0, lenY, lenY) - sigma0mean <- sigma0^2/n0 - origVCmat[zeroDose, zeroDose] <- sigma0mean - - diag(origVCmat)[!zeroDose] <- sigma^2 - diag(origVCmat)[zeroDose] <- sigma0^2 - - origVCmat[lenY, lenY] <- sigma0mean - - list(my0, n0, derMat, origVCmat, derMat %*% origVCmat %*% t(derMat)) -} - - -resList<-covFct(0.52, 0.52, fitted(ryegrass.m1)[1:10], ryegrass$conc[1:10]) -resList[[5]] / (outVec %o% outVec) - - -varOptim1 <- function(varpar) -{ - resList <- covFct(varpar[1], varpar[2], fitted(ryegrass.m1), ryegrass$conc)[[5]] - resVec <- residuals(ryegrass.m1) -# resVec <- fitted(ryegrass.m1) + rnorm(24, 0, c(rep(3,6), rep(1, 18)) - resVec%*%solve(resList)%*%resVec + log(abs(det(resList))) - -} - -optim(c(1, 0.1), varOptim1) - - -varOptim1b <- function(par, const = 1) -{ - fittedVec <- par[2]+(1-par[2])/(1+(ryegrass$conc/par[3])^par[1]) - resList <- covFct(1, par[4], fittedVec, ryegrass$conc)[[5]] - resVec <- (ryegrass$rootl / 7.75) - fittedVec - resVec%*%solve(resList)%*%resVec + const * log(abs(det(resList))) -} - -rg.optim <- optim(c(2,0.05,3,0.5), varOptim1b, hessian = TRUE) - -sqrt(diag(solve(rg.optim$hessian))) - -sqrt(varOptim1b(rg.optim$par, 0) / 20) - - - -## S.alba -varOptim1b2 <- function(par, const = 1) -{ - fittedVec <- par[2]+(1-par[2])/(1+(S.alba$Dose[1:32]/par[3])^par[1]) - resList <- covFct(1, par[4], fittedVec, S.alba$Dose[1:32])[[5]] - resVec <- (S.alba$DryMatter[1:32] / 7.75) - fittedVec - resVec%*%solve(resList)%*%resVec + const * log(abs(det(resList))) -} - -rg.optim2 <- optim(c(2,0.05,3,0.5), varOptim1b2, hessian = TRUE) -rg.optim2$par - -sqrt(diag(solve(rg.optim2$hessian))) - -sqrt(varOptim1b2(rg.optim2$par, 0) / 28) - -sa.drm1 <- drm(DryMatter~Dose, data=S.alba[1:32,], fct=LL.4()) -summary(sa.drm1) -sa.drm2 <- drm(DryMatter/mean(S.alba$DryMatter[1:8])~Dose, data=S.alba[1:32,], fct=LL.4(fixed=c(NA,NA,1,NA))) -summary(sa.drm2) -sa.drm3 <- drm(DryMatter/mean(S.alba$DryMatter[1:8])~Dose, data=S.alba[1:32,], fct=LL.4(fixed=c(NA,NA,NA,NA))) -summary(sa.drm3) - - -#yVec <- fitted(ryegrass.m1) + rnorm(24, 0, c(rep(3,6), rep(1, 18))) -yVec <- fitted(ryegrass.m1) + rnorm(24, 0, c(rep(10,6), rep(1, 18))) -xVec <- ryegrass$conc -varOptim1c <- function(par, const = 1) -{ - fittedVec <- par[2]+(1-par[2])/(1+(xVec/par[3])^par[1]) - resList <- covFct(1, par[4], fittedVec, xVec)[[5]] - resVec <- (yVec / mean(yVec[1:4])) - fittedVec - resVec%*%solve(resList)%*%resVec + const * log(det(resList)) -} - -ratioVec <- rep(NA, 100) -sigmaVec <- rep(NA, 100) -ec50Vec <- rep(NA, 100) -seVec1 <- rep(NA, 100) -seVec2 <- rep(NA, 100) - -xVec <- rep(ryegrass$conc, rep(3, 24)) -xVec <- xVec[-c(1:14)] -for (i in 1:100) -{ - yVec <- rep(fitted(ryegrass.m1), rep(3, 24)) + rnorm(72, 0, c(rep(3,18), rep(1, 54))) - yVec <- yVec[-c(1:14)] - -# varOptim1c <- function(par, const = 1) -# { -# fittedVec <- par[2]+(1-par[2])/(1+(xVec/par[3])^par[1]) -# resList <- covFct(1, par[4], fittedVec, xVec)[[5]] -# resVec <- (yVec / mean(yVec[1:6])) - fittedVec -# resVec%*%solve(resList)%*%resVec + const * log(det(resList)) -# } -# seVec1[i] <- coef(summary(drm(yVec/mean(yVec[1:4])~xVec, fct=LL.4(fixed=c(NA,NA,NA,NA)))))[4,2] - seVec1[i] <- coef(summary(drm(yVec/mean(yVec[1:4])~xVec, fct=LL.4(fixed=c(NA,NA,1,NA)))))[3,2] - optimRes <- optim(c(1.7,0.01,2.5,0.1), varOptim1c, hessian=TRUE) - seVec2[i] <- sqrt(diag(solve(optimRes$hessian)))[3] - parem <- optimRes$par - ratioVec[i] <- parem[4] - ec50Vec[i] <- parem[3] - sigmaVec[i] <- sqrt(varOptim1c(parem, 0)/68) -} - -cbind(seVec1, seVec2) - -ratioVec -sigmaVec -hist(ratioVec) -hist(sigmaVec) - - - - - - -varOptim2 <- function(varpar) -{ - resList<-covFct(varpar[1], varpar[2], fitted(ryegrass.m1), ryegrass$conc)[[5]] - resVec <-residuals(ryegrass.m1) - resVec%*%solve(resList)%*%resVec+log(abs(det(resList))) - -} - -#resVec2 <- ryegrass$rootl - (fitted(ryegrass.m1) + rnorm(24, 0, c(rep(3,6), rep(1, 18)))) -varOptim3 <- function(varpar, const=1) -{ - resList<-covFct(1, varpar[1], fitted(ryegrass.m1), ryegrass$conc)[[5]] - resVec <- residuals(ryegrass.m1) -# resVec <- resVec2 - resVec%*%solve(resList)%*%resVec + const * log(abs(det(resList))) - -} - -optimize(varOptim3, lower=0, upper=100) - - - -} \ No newline at end of file +"drmEMstandard" <- +function(dose, resp, multCurves, doseScaling = 1) +{ + zeroDose <- dose < 1e-15 # hardcoded tolerance of 1e-15 + len0 <- sum(zeroDose) + vcFct2 <- function(beta0, betaVec) + { + vc <- (1 / len0) * (betaVec %o% betaVec) / (beta0^4) + diag(vc) <- diag(vc) + (1 / (beta0^2)) + + vc[!zeroDose, zeroDose] <- vc[!zeroDose, zeroDose] + (1 / len0) * (-betaVec[!zeroDose] / (beta0^3)) + vc[zeroDose, !zeroDose] <- vc[zeroDose, !zeroDose] + (1 / len0) * (-betaVec[!zeroDose] / (beta0^3)) + diag(vc[zeroDose, zeroDose]) <- diag(vc[zeroDose, zeroDose]) + (1 / (len0 * beta0^2)) - (1 / (beta0^2)) + + return(vc) + } + + + ## Defining the objective function + opfct <- function(c) # dose, resp and weights are fixed + { + f0 <- multCurves(0, c)[1] + fVec <- multCurves(dose / doseScaling, c) + vcMat <- vcFct2(f0, fVec) + + sum( (resp - fVec) %*% solve(vcMat) %*% (resp - fVec)) + } + + + ## Defining self starter function + ssfct <- NULL + + + ## Defining the log likelihood function + llfct <- function(object) + { + c( + -object$"fit"$value + sum(log(gamma(resp+1))), + object$"sumList"$"df.residual" + ) # adding scale constant + } + + + ## Defining functions returning the residual variance, the variance-covariance matrix, and the parameter estimates + # copied from drmEMls.R + rvfct <- function(object) + { + object$"fit"$"value" / df.residual(object) + } + + vcovfct <- function(object) + { + scaledH <- (object$"fit"$"hessian") / (2 * rvfct(object)) + invMat <- try(solve(scaledH), silent = TRUE) + + if (inherits(invMat, "try-error")) + { + ## More stable than 'solve' (suggested by Nicholas Lewin-Koh - 2007-02-12) + ch <- try(chol(scaledH)) + if(inherits(ch, "try-error")) + { + ch <- try(chol(0.99 * object$fit$hessian + 0.01 * diag(dim(object$fit$hessian)[1]))) + } + ## Try regularizing if the varcov is unstable + if(!inherits(ch, "try-error")) return(chol2inv(ch)) + } else { + return(invMat) + } + } + + parmfct <- function(fit, fixed = TRUE) + { + fit$par + } + + + ## Returning list of functions + return(list(llfct = llfct, opfct = opfct, ssfct = ssfct, rvfct = rvfct, vcovfct = vcovfct, + parmfct = parmfct)) +} + + +#' @title Standard EM algorithm +#' @keywords internal +"drmLOFstandard" <- function() +{ + return(list(anovaTest = NULL, gofTest = NULL)) +} diff --git a/R/drmLOFbinomial.R b/R/drmLOFbinomial.R index 52c33ece..8971d475 100644 --- a/R/drmLOFbinomial.R +++ b/R/drmLOFbinomial.R @@ -1,35 +1,36 @@ -"drmLOFbinomial" <- function() -{ - ## Defining a goodness-of-fit test - gofTest <- function(resp, weights, fitted, dfres) - { - ## Removing 0s and 1s in fitted values - zeroTol <- 1e-12 # no global constant - indVec <- ( (fitted < zeroTol) | (fitted > 1-zeroTol) ) - dfReduc <- sum(indVec) - - total <- weights # (object$"data")[, 5] - success <- resp*weights # total*(object$"data")[, 2] - expected <- total*fitted # fitted(object) - - ## Pearson's statistic (sum of squared Pearson residuals) - c( sum( ((success - expected)^2 / (expected*(1 - fitted)))[!indVec] ), dfres - dfReduc) # df.residual(object)) - } - - - ## Defining goodness-of-fit function - anovaTest <- function(formula, ds) - { -# count <- resp*weights - anovaFit <- glm(formula, family=binomial(link = "logit"), data=ds) - if (df.residual(anovaFit)>0) - { - return(list(test = "lr", anovaFit = anovaFit)) - } else { - return(NULL) - } - } - anovaTest <- NULL # lack-of-fit test not meaningful in most situations - - return(list(anovaTest = anovaTest, gofTest = gofTest)) -} +#' @title Lack-of-fit test for binomial response +#' @keywords internal +"drmLOFbinomial" <- function() +{ + ## Defining a goodness-of-fit test + gofTest <- function(resp, weights, fitted, dfres) + { + ## Removing 0s and 1s in fitted values + zeroTol <- 1e-12 # no global constant + indVec <- ( (fitted < zeroTol) | (fitted > 1-zeroTol) ) + dfReduc <- sum(indVec) + + total <- weights + success <- resp*weights + expected <- total*fitted + + ## Pearson's statistic (sum of squared Pearson residuals) + c( sum( ((success - expected)^2 / (expected*(1 - fitted)))[!indVec] ), dfres - dfReduc) + } + + + ## Defining goodness-of-fit function + anovaTest <- function(formula, ds) + { + anovaFit <- glm(formula, family=binomial(link = "logit"), data=ds) + if (df.residual(anovaFit)>0) + { + return(list(test = "lr", anovaFit = anovaFit)) + } else { + return(NULL) + } + } + anovaTest <- NULL # lack-of-fit test not meaningful in most situations + + return(list(anovaTest = anovaTest, gofTest = gofTest)) +} diff --git a/R/drmLOFls.R b/R/drmLOFls.R index a2510ec5..5f01d553 100644 --- a/R/drmLOFls.R +++ b/R/drmLOFls.R @@ -1,18 +1,20 @@ -"drmLOFls" <- function() -{ - ## Defining lack-of-fit/goodness-of-fit tests - anovaTest <- function(formula, ds) - { - anovaFit <- lm(formula, data = ds) - if (df.residual(anovaFit) > 0) - { - return(list(test = "F", anovaFit = anovaFit)) - } else { - return(NULL) - } - } - - gofTest <- NULL - - return(list(anovaTest = anovaTest, gofTest = gofTest)) +#' @title Lack-of-fit test for least squares +#' @keywords internal +"drmLOFls" <- function() +{ + ## Defining lack-of-fit/goodness-of-fit tests + anovaTest <- function(formula, ds) + { + anovaFit <- lm(formula, data = ds) + if (df.residual(anovaFit) > 0) + { + return(list(test = "F", anovaFit = anovaFit)) + } else { + return(NULL) + } + } + + gofTest <- NULL + + return(list(anovaTest = anovaTest, gofTest = gofTest)) } \ No newline at end of file diff --git a/R/drmOpt.R b/R/drmOpt.R index a8bb0d2e..0b365b4c 100644 --- a/R/drmOpt.R +++ b/R/drmOpt.R @@ -1,98 +1,79 @@ -"drmOpt" <- -function(opfct, opdfct1, startVec, optMethod, constrained, warnVal, -upperLimits, lowerLimits, errorMessage, maxIt, relTol, opdfct2 = NULL, parmVec, traceVal, silentVal = TRUE, -matchCall) -## propagate "silentVal" from calling function? -{ - ## Controlling the warnings - options(warn = warnVal) - - ## Calculating hessian - if (is.null(opdfct2)) {hes <- TRUE} else {hes <- FALSE} - - ## Setting scaling parameters for optim() - psVec <- abs(startVec) - psVec[psVec < 1e-4] <- 1 - - ## Derivatives are used - {if (!is.null(opdfct1)) - { - if (constrained) - { - nlsObj <- try(optim(startVec, opfct, opdfct1, hessian = hes, method = "L-BFGS-B", - lower = lowerLimits, upper = upperLimits, - control = list(maxit = maxIt, reltol = relTol, parscale = psVec)), silent = silentVal) - } else { - nlsObj <- try(optim(startVec, opfct, opdfct1, hessian = hes, method = optMethod, - control = list(maxit = maxIt, reltol = relTol, parscale = psVec)), silent = silentVal) - } - options(warn = 0) - - if (!inherits(nlsObj, "try-error")) - { - nlsFit <- nlsObj - nlsFit$convergence <- TRUE - } else { -# stop("Convergence failed") - warning("Convergence failed. The model was not fitted!", call. = FALSE) - -# callDetail <- match.call() -# if (is.null(callDetail$fct)) {callDetail$fct <- substitute(l4())} - return(list(call = matchCall, parNames = parmVec, startVal = startVec, convergence = FALSE)) - } - if (!hes) {nlsFit$hessian <- opdfct2(nlsFit$par)} - - ## Derivatives are not used - } else { - - if (constrained) - { -# print(lowerLimits) -# print(upperLimits) -# print(startVec) -# print(opfct) -# print(opfct(startVec)) - nlsObj <- try(optim(startVec, opfct, hessian = TRUE, method = "L-BFGS-B", - lower = lowerLimits, upper = upperLimits, - control = list(maxit = maxIt, parscale = psVec, reltol = relTol, trace = traceVal)), silent = silentVal) - # parscale is needed for the example in methionine.Rd - } else { -# psVec <- abs(startVec) -# psVec[psVec<1e-4] <- 1 - - nlsObj <- try(optim(startVec, opfct, hessian = TRUE, method = optMethod, - control = list(maxit = maxIt, reltol = relTol, parscale = psVec, trace = traceVal)), silent = silentVal) - -# nlsObj0 <- try(optim(startVec, opfct, method=optMethod, -# control=list(maxit=maxIt, reltol=relTol, parscale=psVec)), silent=TRUE) -# nlsObj <- try(optim(nlsObj0$par, opfct, hessian=TRUE, method=optMethod, -# control=list(maxit=maxIt, reltol=relTol)), silent=TRUE) - } - options(warn = 0) - - if (!inherits(nlsObj, "try-error")) - { - nlsFit <- nlsObj - nlsFit$convergence <- TRUE - } else { # to avoid an error if used in a loop - if (errorMessage) - { - stop("Convergence failed") - } else { - warning("Convergence failed. The model was not fitted!", call. = FALSE) - } - -# callDetail <- match.call() -# if (is.null(callDetail$fct)) {callDetail$fct <- substitute(LL.4())} - return(list(call = matchCall, parNames = parmVec, startVal = startVec, convergence = FALSE)) - } - }} - -# nlsFit$ofvalue <- nlsFit$value - nlsFit$ovalue <- nlsFit$value # used in the var-cov matrix ... check -# nlsFit$value <- opfct(nlsFit$par, scaling = FALSE) # used in the residual variance ... check - nlsFit$value <- opfct(nlsFit$par) - - ## Returning the fit - return(nlsFit) -} +#' @title Optimisation wrapper for drm +#' @keywords internal +"drmOpt" <- +function(opfct, opdfct1, startVec, optMethod, constrained, warnVal, +upperLimits, lowerLimits, errorMessage, maxIt, relTol, opdfct2 = NULL, parmVec, traceVal, silentVal = TRUE, +matchCall) +{ + ## Controlling the warnings + options(warn = warnVal) + + ## Calculating hessian + if (is.null(opdfct2)) {hes <- TRUE} else {hes <- FALSE} + + ## Setting scaling parameters for optim() + psVec <- abs(startVec) + psVec[psVec < 1e-4] <- 1 + + ## Derivatives are used + {if (!is.null(opdfct1)) + { + if (constrained) + { + nlsObj <- try(optim(startVec, opfct, opdfct1, hessian = hes, method = "L-BFGS-B", + lower = lowerLimits, upper = upperLimits, + control = list(maxit = maxIt, reltol = relTol, parscale = psVec)), silent = silentVal) + } else { + nlsObj <- try(optim(startVec, opfct, opdfct1, hessian = hes, method = optMethod, + control = list(maxit = maxIt, reltol = relTol, parscale = psVec)), silent = silentVal) + } + options(warn = 0) + + if (!inherits(nlsObj, "try-error")) + { + nlsFit <- nlsObj + nlsFit$convergence <- TRUE + } else { + warning("Convergence failed. The model was not fitted!", call. = FALSE) + + return(list(call = matchCall, parNames = parmVec, startVal = startVec, convergence = FALSE)) + } + if (!hes) {nlsFit$hessian <- opdfct2(nlsFit$par)} + + ## Derivatives are not used + } else { + + if (constrained) + { + nlsObj <- try(optim(startVec, opfct, hessian = TRUE, method = "L-BFGS-B", + lower = lowerLimits, upper = upperLimits, + control = list(maxit = maxIt, parscale = psVec, reltol = relTol, trace = traceVal)), silent = silentVal) + # parscale is needed for the example in methionine.Rd + } else { + nlsObj <- try(optim(startVec, opfct, hessian = TRUE, method = optMethod, + control = list(maxit = maxIt, reltol = relTol, parscale = psVec, trace = traceVal)), silent = silentVal) + } + options(warn = 0) + + if (!inherits(nlsObj, "try-error")) + { + nlsFit <- nlsObj + nlsFit$convergence <- TRUE + } else { # to avoid an error if used in a loop + if (errorMessage) + { + stop("Convergence failed") + } else { + warning("Convergence failed. The model was not fitted!", call. = FALSE) + } + + return(list(call = matchCall, parNames = parmVec, startVal = startVec, convergence = FALSE)) + } + }} + + nlsFit$ovalue <- nlsFit$value # used in the var-cov matrix ... check + nlsFit$value <- opfct(nlsFit$par) + + ## Returning the fit + return(nlsFit) +} diff --git a/R/drmPNsplit.R b/R/drmPNsplit.R index e4962ace..0b4284e1 100644 --- a/R/drmPNsplit.R +++ b/R/drmPNsplit.R @@ -1,17 +1,19 @@ -"drmPNsplit" <- -function(parmVec, sep) -{ - lenPV <- length(parmVec) - parmVecA <- rep(0, lenPV) - parmVecB <- rep(0, lenPV) - - splitList <- strsplit(parmVec, sep, fixed = TRUE) - for (i in 1:lenPV) - { - parmVecA[i] <- splitList[[i]][1] - - lenSL <- length(splitList[[i]]) - parmVecB[i] <- paste(splitList[[i]][2:lenSL], collapse = "") # 'paste' is needed in case several ":" occur - } - return(list(parmVec, parmVecA, parmVecB)) -} +#' @title Split parameter names +#' @keywords internal +"drmPNsplit" <- +function(parmVec, sep) +{ + lenPV <- length(parmVec) + parmVecA <- rep(0, lenPV) + parmVecB <- rep(0, lenPV) + + splitList <- strsplit(parmVec, sep, fixed = TRUE) + for (i in 1:lenPV) + { + parmVecA[i] <- splitList[[i]][1] + + lenSL <- length(splitList[[i]]) + parmVecB[i] <- paste(splitList[[i]][2:lenSL], collapse = "") # 'paste' is needed in case several ":" occur + } + return(list(parmVec, parmVecA, parmVecB)) +} diff --git a/R/drmParNames.R b/R/drmParNames.R index d2b7485a..e390bd7a 100644 --- a/R/drmParNames.R +++ b/R/drmParNames.R @@ -1,38 +1,38 @@ -"drmParNames" <- -function(numNames, parNames, collapseList2, repStr1 = "factor(pmodels[, i])", repStr2 = "factor(assayNo)") -{ - ## Retrieving names for parameters - parmVecList <- list() - for (i in 1:numNames) - { - colNames1 <- colnames(collapseList2[[i]]) - if (is.null(colNames1)) - { - parmVecList[[i]] <- paste(parNames[i], "(Intercept)", sep = ":") - } else { - parmVecList[[i]] <- paste(parNames[i], colNames1, sep = ":") - } - parmVecList[[i]] <- (parmVecList[[i]])[1:ncol(collapseList2[[i]])] # min(maxParm[i], length(colNames1))] - } - parmVec <- unlist(parmVecList) - - parmVec2 <- parmVec -# print(parmVec2) - for (i in 1:length(parmVec)) - { - pos <- regexpr(repStr1, parmVec[i], fixed = TRUE) - if (pos > 0) - { - parmVec2[i] <- paste(substring(parmVec[i], 1, pos-1), substring(parmVec[i], pos + 20), sep = "") - } - - pos <- regexpr(repStr2, parmVec[i], fixed = TRUE) - if (pos > 0) - { - parmVec2[i] <- paste(substring(parmVec[i], 1, pos-1), substring(parmVec[i], pos + 15), sep = "") - } - } - -# print(parmVec2) - return(drmPNsplit(parmVec2, ":")) -} +#' @title Generate parameter names for drm +#' @keywords internal +"drmParNames" <- +function(numNames, parNames, collapseList2, repStr1 = "factor(pmodels[, i])", repStr2 = "factor(assayNo)") +{ + ## Retrieving names for parameters + parmVecList <- list() + for (i in 1:numNames) + { + colNames1 <- colnames(collapseList2[[i]]) + if (is.null(colNames1)) + { + parmVecList[[i]] <- paste(parNames[i], "(Intercept)", sep = ":") + } else { + parmVecList[[i]] <- paste(parNames[i], colNames1, sep = ":") + } + parmVecList[[i]] <- (parmVecList[[i]])[1:ncol(collapseList2[[i]])] # min(maxParm[i], length(colNames1))] + } + parmVec <- unlist(parmVecList) + + parmVec2 <- parmVec + for (i in 1:length(parmVec)) + { + pos <- regexpr(repStr1, parmVec[i], fixed = TRUE) + if (pos > 0) + { + parmVec2[i] <- paste(substring(parmVec[i], 1, pos-1), substring(parmVec[i], pos + 20), sep = "") + } + + pos <- regexpr(repStr2, parmVec[i], fixed = TRUE) + if (pos > 0) + { + parmVec2[i] <- paste(substring(parmVec[i], 1, pos-1), substring(parmVec[i], pos + 15), sep = "") + } + } + + return(drmPNsplit(parmVec2, ":")) +} diff --git a/R/drmRobust.R b/R/drmRobust.R index c7dcd61f..c45db726 100644 --- a/R/drmRobust.R +++ b/R/drmRobust.R @@ -1,94 +1,75 @@ -"drmRobust" <- function(robust, fctCall, lenData, lenPar) -{ - - ## Finding robust scale estimate for trimmed and winsorised means and tukey - if (robust%in%c("trimmed", "tukey", "winsor")) - { - call1 <- fctCall - call1$"robust" <- "lts" - - scaleEst <- mad(residuals(eval(call1, parent.frame())), 0) - } - - - ## Defining distance functions - quadratic <- function(x) {x*x} - - lms <- function(x) {median(x*x)} - - noRes <- floor((lenData+lenPar+1)/2) - lts <- function(x) {sum(((x[order(x)])[1:noRes])^2)} - - metricTrim <- function(x) - { - if (all(is.na(x))) {return(x)} - - x <- x/scaleEst - - cVal <- 1.345 - retVal <- x*x - -# indexVec <- abs(x) > cVal -# print(x) -# sumVec <- sum(indexVec) -# print(sumVec) -# -# if (sumVec>0) {retVal[indexVec] <- rep(cVal * cVal, sumVec)} - retVal[abs(x) > cVal] <- cVal^2 - retVal - } - - metricWinsor <- function(x) - { - if (all(is.na(x))) {return(x)} - - cVal <- 1.345 - -# print(mad(x,0)) -# scaleEst <- (median(abs(x))/0.6745) # overrules general scale estimate - -# scaleEst <- 9.03 # 9.055 for phones data set - - x <- x/scaleEst - - retVal <- x*x - - indexVec <- abs(x) > cVal -# sumVec <- sum(indexVec) - -# if (sumVec>0) {retVal[indexVec] <- (cVal * (2 * abs(x) - cVal))[indexVec]} - retVal[indexVec] <- (cVal * (2 * abs(x) - cVal))[indexVec] -# retVal[abs(x)>c] <- (c*(2*abs(x)-c))[abs(x)>c] - retVal - } - - tukeyBiweight <- function(x) - { - if (all(is.na(x))) {return(x)} - - x <- x/scaleEst - - Rval <- 4.685 - retVal <- (x^6)/(Rval^4) - 3*(x^4)/(Rval^2) + 3*x*x - -# indexVec <- abs(x) > Rval -# sumVec <- sum(indexVec) -# -# if (sumVec>0) {retVal[indexVec] <- rep(Rval * Rval, sumVec)} - retVal[abs(x) > Rval] <- Rval * Rval - retVal - } - - - ## Assigning objective function - robustFct <- switch(robust, - mean = quadratic, - median = abs, - trimmed = metricTrim, - tukey = tukeyBiweight, - winsor = metricWinsor, - lms = lms, - lts = lts) - - return(robustFct) -} +#' @title Robust estimation functions for drm +#' @keywords internal +"drmRobust" <- function(robust, fctCall, lenData, lenPar) +{ + + ## Finding robust scale estimate for trimmed and winsorised means and tukey + if (robust%in%c("trimmed", "tukey", "winsor")) + { + call1 <- fctCall + call1$"robust" <- "lts" + + scaleEst <- mad(residuals(eval(call1, parent.frame())), 0) + } + + + ## Defining distance functions + quadratic <- function(x) {x*x} + + lms <- function(x) {median(x*x)} + + noRes <- floor((lenData+lenPar+1)/2) + lts <- function(x) {sum(((x[order(x)])[1:noRes])^2)} + + metricTrim <- function(x) + { + if (all(is.na(x))) {return(x)} + + x <- x/scaleEst + + cVal <- 1.345 + retVal <- x*x + retVal[abs(x) > cVal] <- cVal^2 + retVal + } + + metricWinsor <- function(x) + { + if (all(is.na(x))) {return(x)} + + cVal <- 1.345 + + x <- x/scaleEst + + retVal <- x*x + + indexVec <- abs(x) > cVal + retVal[indexVec] <- (cVal * (2 * abs(x) - cVal))[indexVec] + retVal + } + + tukeyBiweight <- function(x) + { + if (all(is.na(x))) {return(x)} + + x <- x/scaleEst + + Rval <- 4.685 + retVal <- (x^6)/(Rval^4) - 3*(x^4)/(Rval^2) + 3*x*x + retVal[abs(x) > Rval] <- Rval * Rval + retVal + } + + + ## Assigning objective function + robustFct <- switch(robust, + mean = quadratic, + median = abs, + trimmed = metricTrim, + tukey = tukeyBiweight, + winsor = metricWinsor, + lms = lms, + lts = lts) + + return(robustFct) +} diff --git a/R/drm_legacy.R b/R/drm_legacy.R new file mode 100644 index 00000000..3bdfcba3 --- /dev/null +++ b/R/drm_legacy.R @@ -0,0 +1,1822 @@ +#' @title Legacy dose-response model fitting (internal) +#' +#' @description +#' This is the legacy implementation of the dose-response model fitting function. +#' It is kept only as an internal reference point in case questions or errors +#' might occur with the current [drm()] implementation. +#' +#' @inheritParams drm +#' +#' @return An object of (S3) class `"drc"`. +#' +#' @seealso [drm()] for the current implementation. +#' +#' @keywords internal +"drm_legacy" <- function( + formula, curveid, pmodels, weights, data = NULL, subset, fct, + type = c("continuous", "binomial", "Poisson", "negbin1", "negbin2", "event", "ssd"), bcVal = NULL, bcAdd = 0, + start, na.action = na.omit, robust = "mean", logDose = NULL, + control = drmc(), lowerl = NULL, upperl = NULL, separate = FALSE, + pshifts = NULL, varcov = NULL) +{ + # ## Matching 'adjust' argument + # adjust <- match.arg(adjust) + + ## Matching argument values + type <- match.arg(type) + + ## Loading MASS + # require(MASS, quietly = TRUE) # used for boxcox and ginv + + ## Setting na.action option + op1 <- options(na.action = deparse(substitute(na.action))) + on.exit(options(op1), add=TRUE) + + ## Setting control parameters + useD <- control$"useD" + constrained <- control$"constr" + # maxDose <- control$"maxDose" + maxIt <- control$"maxIt" + optMethod <- control$"method" + relTol <- control$"relTol" + warnVal <- control$"warnVal" + # zeroTol <- control$"zeroTol" + # bcConstant <- bcAdd + rmNA <- control$"rmNA" # in drmEM... + errorMessage <- control$"errorm" # in drmOpt + noMessage <- control$"noMessage" # reporting finding control measurements? + # trace <- control$"trace" + # otrace <- control$"otrace" + dscaleThres <- control$"dscaleThres" + rscaleThres <- control$"rscaleThres" + conCheck <- control$"conCheck" + + ## Setting warnings policy + op2 <- options(warn = warnVal) + on.exit(options(op2), add=TRUE) + + # ## Setting adjustment + # if (adjust == "none") {boxcox <- FALSE; varPower <- FALSE} + # if (adjust == "bc1") {boxcox <- TRUE; varPower <- FALSE} + # if (adjust == "vp") {boxcox <- FALSE; varPower <- TRUE} + + # if ( (!is.null(bcVal)) && (is.numeric(bcVal))) {boxcox <- bc} + + # if (!(robust == "mean")) + # { + # boxcox <- FALSE + # varPower <- FALSE + # } + + ## Handling 'start' argument + if (missing(start)) {selfStart <- TRUE} else {selfStart <- FALSE} + + ## Handling 'fct' argument + if ( (!is.list(fct)) && (!is.function(fct)) ) {stop("No function or list given in argument 'fct'")} + if (is.function(fct)) + { + fct <- fct2list(fct, 2) + } + + ## Converting a user specified list + if (is.null(names(fct))) {fct$"fct" <- fct[[1]]; fct$"ssfct" <- fct[[2]]; fct$"names" <- fct[[3]]} + + if (!is.function(fct$"fct")) + { + stop("First entry in list to 'fct' NOT a function") + } else { + drcFct <- fct$"fct" + } + + if (is.null(fct$"ssfct")) {noSSfct <- TRUE} else {noSSfct <- FALSE} + if ((!is.function(fct$"ssfct")) && selfStart) + { + stop("Neither self starter function nor starting values provided") + } else { + ssfct <- fct$"ssfct" + } + + if (is.null(fct$"names") || (!is.character(fct$"names"))) + { + stop("Parameter names (as vector a strings) are NOT supplied") + } else { + parNames <- fct$"names" + numNames <- length(parNames) + } + + # ## Coercing two arguments in 'ssfct' into one argument + # lenASS <- length(formals(ssfct)) + # if (lenASS > 1) + # { + # stop("Self starter function should only have one argument, which takes a data frame") + ## ssTemp <- ssfct + ## ssfct <- function(dataset) {ssTemp(dataset[, head(1:lenASS, -1)], dataset[, lenASS])} + # } + + ## Checking whether or not first derivates are supplied + isDF <- is.function(fct$"deriv1") + if ( (useD) && (isDF) ) + { + dfct1 <- fct$"deriv1" # deriv1 # [[4]] + # drcDer2 <- fct$deriv2 # [[5]] + } else { + dfct1 <- NULL + } + + ## Checking whether or not second derivates are supplied + if ( (useD) && (is.function(fct$"deriv2")) ) + { + dfct2 <- fct$"deriv2" + } else { + dfct2 <- NULL + } + # fct$"anovaYes"$"bin" <- NULL + # fct$"anovaYes"$"cont" <- TRUE + + ## Storing call details + callDetail <- match.call() + + ## Handling the 'formula', 'curveid' and 'data' arguments + anName <- deparse(substitute(curveid)) # storing name for later use + if (length(anName) > 1) {anName <- anName[1]} # to circumvent the behaviour of 'substitute' in do.call("multdrc", ...) + if (nchar(anName) < 1) {anName <- "1"} # in case only one curve is analysed + + + mf <- match.call(expand.dots = FALSE) + nmf <- names(mf) + mnmf <- match(c("formula", "curveid", "data", "subset", "na.action", "weights"), nmf, 0) + + mf[[1]] <- as.name("model.frame") + mf <- eval(mf[c(1,mnmf)], parent.frame()) #, globalenv()) + mt <- attr(mf, "terms") + + varNames <- names(mf)[c(2, 1)] + varNames0 <- names(mf) + # only used once, but mf is overwritten later on + + dose <- model.matrix(mt, mf)[,-c(1)] # with no intercept + xDim <- ncol(as.matrix(dose)) + resp <- model.response(mf, "numeric") + if (is.null(resp)) + { + if (xDim > 1) {doseForResp <- dose[, 1]} else {doseForResp <- dose} + resp <- ppoints(doseForResp, 0.5)[order(doseForResp)] # just one option + varNames[1] <- varNames[2] + varNames[2] <- "proportion" + } + origDose <- dose + origResp <- resp # in case of transformation of the response + lenData <- length(resp) + numObs <- length(resp) + + # xDim <- ncol(as.matrix(dose)) + + # if (xDim > 1) + # { + # stop("drm() is only designed for 1-dim. dose vectors") + # } + + # dimData <- xDim + 1 # dimension of dose plus 1 dimensional response + + # varNames <- names(mf) + # varNames <- varNames[c(2:dimData,1)] + + # print(names(mf)) + # print(model.extract(mf, "weights")) + # print(model.weights(mf)) + + ## Retrieving weights + wVec <- model.weights(mf) + if (is.null(wVec)) + { + wVec <- rep(1, numObs) + } + + # ## Extracting variable for heterogeneous variances + # vvar <- model.extract(mf, "hetvar") + + ## Finding indices for missing values + missingIndices <- attr(mf, "na.action") + if (is.null(missingIndices)) {removeMI <- function(x){x}} else {removeMI <- function(x){x[-missingIndices,]}} + + ## Handling "curveid" argument + assayNo <- model.extract(mf, "curveid") + if (is.null(assayNo)) # in case not supplied + { + assayNo <- rep(1, numObs) + } + uniqueNames <- unique(assayNo) + colOrder <- order(uniqueNames) + # print(colOrder) + uniqueNames <- as.character(uniqueNames) + + ## Re-enumerating the levels in 'assayNo' and 'pmodels' + assayNoOld <- assayNo + # ciOrigIndex <- uniqueNames # unique(assayNo) + # ciOrigLength <- length(unique(assayNoOld)) + + ## Detecting control measurements + + ## Defining helper function + colConvert <- function(vec) + { + len <- length(vec) + assLev <- unique(vec) + + retVec <- rep(0,len) + j <- 1 + for (i in 1:length(assLev)) {retVec[vec == assLev[i]] <- j; j <- j + 1} + + return(retVec) + } + assayNo <- colConvert(assayNoOld) + assayNames <- as.character(unique(assayNoOld)) + numAss <- length(assayNames) + + # lenDose <- unlist(lapply(tapply(dose, assayNoOld, unique), length)) + # conDose <- names(lenDose)[lenDose == 1] + # nconDose <- names(lenDose)[lenDose > 1] + # if (length(conDose) > 0) + # { + # if (!noMessage) + # { + # cat(paste("Control measurements detected for level: ", conDose, "\n", sep = "")) + # } + # + # assayNo[assayNoOld %in% conDose] <- nconDose[1] + # ciOrigIndex <- unique(assayNo) + ## ciOrigLength <- length(unique(assayNoOld)) # numAss + # + # + # ## Updating names, number of curves and the enumeration (starting from 1) + # assayNames <- nconDose + ## numAss <- length(assayNames) + # assayNo <- colConvert(assayNo) + # + # cm <- NULL + ## } + # + # uniqueDose <- lapply(tapply(dose, assayNoOld, unique), length) + # udNames <- names(uniqueDose[uniqueDose == 1]) + # if (length(udNames) > 0) + # { + # cm <- udNames + # if (!noMessage) {cat(paste("Control measurements detected for level: ", udNames, "\n", sep = ""))} + # ## add a check to see if at least one component in pmodels results in a single column + + ## conInd <- assayNoOld%in%udNames + ## assayNo[conInd] <- (assayNo[!conInd])[1] + ## cm <- NULL + ##assayNew <- assayNo + ##assayNew[conInd] <- (assayNo[!conInd])[1] + ##print(assayNew) + ## + # conInd <- assayNoOld%in%udNames + # assayNo[conInd] <- (assayNo[!conInd])[1] + # ciOrigIndex <- unique(assayNo) + # ciOrigLength <- numAss + # + # ## Updating names, number of curves and the enumeration (starting from 1) + # assayNames <- as.character(unique(assayNoOld[!conInd])) + # numAss <- length(assayNames) + # assayNo <- colConvert(assayNo) + # + # cm <- NULL + # + + ## New -commented out + # } else { + # cm <- NULL + # ciOrigIndex <- unique(assayNo) + ## ciOrigLength <- numAss + # + # assayNames <- as.character(unique(assayNoOld)) + # assayNo <- colConvert(assayNoOld) # re-enumerating from 1 to numAss + # } + # numAss <- length(assayNames) + # print(ciOrigIndex) + # print(ciOrigLength) + + # print(xDim) + # print(cbind(dose, assayNoOld)) + + if (xDim > 1) {tempDoseVec <- dose[, 1]} else {tempDoseVec <- dose} + # print(tempDoseVec) + # print(assayNoOld) + # uniqueDose <- lapply(tapply(dose, assayNoOld, unique), length) + uniqueDose <- lapply(tapply(tempDoseVec, assayNoOld, unique), length) + udNames <- names(uniqueDose[uniqueDose == 1]) + if ( (conCheck) && (length(udNames) > 0) ) + { + cm <- udNames + if (!noMessage) + { + cat(paste("Control measurements detected for level: ", udNames, "\n", sep = "")) + + if (separate) + { + stop("Having a common control when fitting separate models does not make sense!\n") + } + } + conInd <- assayNoOld %in% udNames + assayNo[conInd] <- (assayNo[!conInd])[1] + ciOrigIndex <- unique(assayNo) + ciOrigLength <- numAss + + ## Updating names, number of curves and the enumeration (starting from 1) + assayNames <- as.character(unique(assayNoOld[!conInd])) + numAss <- length(assayNames) + assayNo <- colConvert(assayNo) + cm <- NULL + } else { + cm <- NULL + ciOrigIndex <- unique(assayNo) + ciOrigLength <- numAss + } + # print(assayNo) + + ## Pooling data from different curves + if ((separate) && (numAss < 2)) + { + # warning("Nothing to pool", call. = FALSE) + warning("Only one level: separate = TRUE has no effect", call. = FALSE) + separate <- FALSE + } + if ((separate) && (!missing(pmodels))) + { + warning("Separate fitting switched off", call. = FALSE) + separate <- FALSE + } + if (separate) + { + # return(idrm(dose, resp, assayNo, wVec, fct, type)) + return(idrm(dose, resp, assayNoOld, wVec, fct, type, control)) + } + + ## Handling "pmodels" argument + pmodelsList <- list() + if (missing(pmodels)) + { + # pmodels <- as.data.frame(matrix(assayNo, numObs, numNames)) + # + if (length(unique(assayNo)) == 1) + { + for (i in 1:numNames) + { + pmodelsList[[i]] <- matrix(1, numObs, 1) + } + } else { + modelMat <- model.matrix(~ factor(assayNo) - 1, level = unique(assayNo)) # no intercept term + colnames(modelMat) <- assayNames + for (i in 1:numNames) + { + pmodelsList[[i]] <- modelMat + # print(head(modelMat)) + # pmodelsList[[i]] <- pmodelsList[[i]][, colOrder] + } + } + } else { + ## Handling a list or data.frame argument of "pmodels" + if (is.null(data)) + { + pmodels <- eval(substitute(pmodels), envir = .GlobalEnv) + } else { + pmodels <- eval(substitute(pmodels), envir = data, enclos = parent.frame()) + } + + if (is.data.frame(pmodels)) + { + lenCol <- ncol(pmodels) + pmodelsMat <- matrix(0, numObs, lenCol) + + for (i in 1:lenCol) + { + if (length(unique(pmodels[,i])) == 1) + { + pmodelsList[[i]] <- matrix(1, numObs, 1) + pmodelsMat[,i] <- rep(1, numObs) + } else { + mf <- eval(model.frame(~factor(pmodels[,i]) - 1), parent.frame()) # converting to factors + mt <- attr(mf, "terms") + + mf2 <- model.matrix(mt, mf) + ncmf2 <- ncol(mf2) + + mf3 <- removeMI(mf2) + pmodelsList[[i]] <- mf3 + pmodelsMat[, i] <- mf3 %*% c(1:ncmf2) + } + } + } else { + + if (is.list(pmodels)) + { + lenCol <- length(pmodels) + pmodelsMat <- matrix(0, length(resp), lenCol) + + for (i in 1:lenCol) + { + if (paste(as.character(pmodels[[i]]), collapse = "") == "~1") + { + pmodelsList[[i]] <- matrix(1, numObs, 1) + pmodelsMat[,i] <- rep(1, numObs) + } else { + mf <- eval(model.frame(pmodels[[i]], data=data), parent.frame()) + mt <- attr(mf, "terms") + + mf2 <- model.matrix(mt, mf) + ncmf2 <- ncol(mf2) + + mf3 <- removeMI(mf2) + pmodelsList[[i]] <- mf3 + + pmodelsMat[,i] <- mf3%*%c(1:ncmf2) + } + } + } + } + # pmodelsOld <- pmodels + # pmodels <- as.data.frame(pmodelsMat) # pmodelsMat not used any more + } + # for (i in 1:numNames) {pmodels[, i] <- colConvert(pmodels[, i])} + + + ## Re-setting na.action + op3 <- options(na.action = "na.omit") # the default + on.exit(options(op3), add=TRUE) + + ## Transforming dose value if they are provided as log dose + if ( !is.null(logDose) && is.numeric(logDose) ) + { + origDose <- dose + dose <- logDose^dose + } + + # ## Handling one-dimensional x + # if (xDim == 1) + # { + ## Defining ANOVA model + # bcc <- rep(bcAdd, numObs) + # if (numAss > 1) + # { + # anovaFormula <- (resp + bcc) ~ offset(bcc) + doseFactor*factor(assayNo) + # alternative <- 2 + # } else { + # anovaFormula <- (resp + bcc) ~ offset(bcc) + doseFactor + # alternative <- 1 + # } + + + # ## Checking whether there is enough df to perform Box-Cox transformation + # if ( boxcox && ( (numObs - numAss*length(unique(dose))) < numObs/10) ) + # { + # if (boxcox) {warning("Box-Cox transformation based on clustering of dose values", call. = FALSE)} + # doseFactor <- factor(cutree(hclust(dist(dose), method = "average"), numObs/3)) + # # constructing groups containing roughly 3 observations + # + # ## Re-defining ANOVA model + # if (numAss > 1) + # { + # anovaFormula <- (resp + bcc) ~ offset(bcc) + doseFactor*factor(assayNo) + # dset <- data.frame(doseFactor, resp, assayNo, bcc) + # alternative <- 2 + # } else { + # anovaFormula <- (resp + bcc) ~ offset(bcc) + doseFactor + # dset <- data.frame(doseFactor, resp, bcc) + # alternative <- 1 + # } + # } else { + # doseFactor <- factor(dose) + # } + + # ## Fitting ANOVA model + # if (type == "continuous") + # { + # testList <- drmLOFls() + ## if (varPower) {testList <- drmLOFvp()} + ## if (!is.null(vvar)) {testList <- drmLOFhv()} + # } + # if (type == "binomial") + # { + # testList <- drmLOFbinomial() + # } + # if (type == "Poisson") + # { + # testList <- drmLOFPoisson() + # } + # + ## if (varPower) {testList <- mdrcVp(anovaYes = TRUE)} else {testList <- drmEMls(anovaYes = TRUE)} + ## if (!is.null(vvar)) {testList <- mdrcHetVar(anovaYes = TRUE)} + # + # gofTest <- testList$"gofTest" + # lofTest <- testList$"anovaTest" + # if (!is.null(lofTest)) + # { + # dset <- data.frame(dose, factor(dose), resp, assayNo, bcc) + # anovaModel0 <- lofTest(anovaFormula, dset) + # } else { + # anovaModel0 <- NULL + # alternative <- 0 + # } + + # ## Fitting ANOVA model + # testList <- switch(type, + # "continuous" = drmLOFls(), + # "binomial" = drmLOFbinomial(), + # "Poisson" = drmLOFPoisson()) + # + # gofTest <- testList$"gofTest" + # lofTest <- testList$"anovaTest" + # if (!is.null(lofTest)) + # { + # afList <- anovaFormula(dose, resp, assayNo, bcAdd) + # anovaForm <- afList$"anovaFormula" + # anovaData <- afList$"anovaData" + # + # anovaModel0 <- lofTest(anovaForm, anovaData) + # } else { + # anovaModel0 <- NULL + # } + + + # ## Applying the Box-Cox transformation (lambda is defined here!) + # bcResult <- drmBoxcox(boxcox, anovaFormula, dset) + # lambda <- bcResult[[1]] + # boxcoxci <- bcResult[[2]] + # boxcox <- bcResult[[3]] + + # lambda <- 0 + # isNumeric <- is.numeric(boxcox) + # if ( (isNumeric) || (is.logical(boxcox) && boxcox) ) + # { + # if (!isNumeric) + # { + # profLik <- boxcox(anovaFormula, lambda = seq(-2.6, 2.6, 1/10), plotit = FALSE, data = dset) + # # boxcox in MASS + # + # maxIndex <- which.max(profLik$y) + # lambda <- (profLik$x)[maxIndex] + # boxcoxci <- drmBoxcoxCI(profLik) + # } + # if (isNumeric) + # { + # lambda <- boxcox + # boxcoxci <- c(NA, NA) + # } + # } else { + # lambda <- NA + # boxcoxci <- c(NA, NA) + # } + + + # ## Using self starter + # if (!noSSfct) + # { + # ## Calculating initial estimates for the parameters using the self starter + # startMat <- matrix(0, numAss, numNames) + # doseresp <- data.frame(dose, origResp) + # + # for (i in 1:numAss) + # { + # indexT1 <- (assayNo == i) + # if (any(indexT1)) + # { + # isfi <- is.finite(dose) # removing infinite dose values + # logVec <- indexT1 & isfi + # startMat[i, ] <- ssfct(doseresp[logVec, ]) # ssfct(dose[logVec], origResp[logVec] ) + # } else { + # startMat[i, ] <- rep(NA, numNames) + # } + # + # ## Identifying a dose response curve only consisting of control measurements + # if (sum(!is.na(startMat[i, ])) == 1) {upperPos <- (1:numNames)[!is.na(startMat[i, ])]} + # } + ## colMat <- matrix(0, numNames, numAss) + ## maxParm <- rep(0, numNames) # storing the max number of parameters + # } + + + # ## Handling multi-dimensional x + # } else { + # stop("Currently multi-dimensional dose values are not supported") + # alternative <- NULL + # anovaModel0 <- NULL + # anovaModel <- NULL + # gofTest <- NULL + + # if (!is.null(bcVal)) + # { + # lambda <- boxcox + # boxcoxci <- c(NA, NA) + # } else { + # lambda <- NA + # boxcoxci <- NULL + # } + + # ## Using self starter + # if (!noSSfct) + # { + # ## Calculating initial estimates for the parameters using the self starter + # startMat <- matrix(0, numAss, numNames) + # doseresp <- data.frame(dose, origResp) + # + # for (i in 1:numAss) + # { + # indexT1 <- (assayNo == i) + # if (any(indexT1)) + # { + # startMat[i, ] <- ssfct(doseresp[indexT1, ]) # ssfct(dose[indexT1], origResp[indexT1]) + # } else { + # startMat[i, ] <- rep(NA, numNames) + # } + # + # ## Identifying a dose response curve only consisting of control measurements + # if (sum(!is.na(startMat[i,]))==1) {upperPos <- (1:numNames)[!is.na(startMat[i,])]} + # } + # colMat <- matrix(0, numNames, numAss) + # maxParm <- rep(0, numNames) # storing the max number of parameters + # } + # } + + ## Finding parameters for the control measurements which will not be estimated + pmodelsList2 <- list() + for (i in 1:numNames) + { + colNames <- colnames(pmodelsList[[i]]) + + if ( (!is.null(cm)) && (!is.null(colNames)) ) + { + accm <- as.character(cm) + pos <- grep(accm, colNames) + if (length(pos) == 0) + { + candCol <- pmodelsList[[i]][, 1] + if ( !(length(assayNoOld[candCol==1])==0) && (all(assayNoOld[candCol==1] == accm)) ) + { + pos <- 1 # the control measurements correspond to the "Intercept" term + } + } + } else {pos <- numeric(0)} + + + ## Defining 'pmodelsList2' from 'pmodelsList' + if ((length(pos) > 0) && !(upperPos == i) ) + { + pmodelsList2[[i]] <- as.matrix(pmodelsList[[i]][, -pos]) # column is removed + } else { + pmodelsList2[[i]] <- as.matrix(pmodelsList[[i]]) # column is kept + } + } + + for (i in 1:numNames) + { + if (ncol(pmodelsList[[i]]) > numAss) + { + pmodelsList2[[i]] <- model.matrix(~factor(assayNo) - 1) + colnames(pmodelsList2[[i]]) <- assayNames + } else { + pmodelsList2[[i]] <- as.matrix(pmodelsList[[i]]) # columns are kept + } + } + + ## Constructing vectors 'ncclVec' and 'parmPos' used below + ncclVec <- rep(0, numNames) + for (i in 1:numNames) + { + ncclVec[i] <- ncol(pmodelsList2[[i]]) # ncol(as.matrix(pmodelsList2[[i]])) + } + parmPos <- c(0, cumsum(ncclVec)[-numNames]) + + ## Constructing parameter names + pnList <- drmParNames(numNames, parNames, pmodelsList2) + parmVec <- pnList[[1]] + parmVecA <- pnList[[2]] + parmVecB <- pnList[[3]] + + ## Defining with indices for the individual parameters in the model + parmIndex <- list() + for (i in 1:numNames) + { + parmIndex[[i]] <- parmPos[i] + 1:ncclVec[i] + } + + ## Scaling of dose and response values + scaleFct <- fct$"scaleFct" + if (!is.null(scaleFct)) # && (is.null(lowerl)) && (is.null(upperl)) ) + # currently the scaling interferes with constraining optimization + { + # Defining scaling for dose and response values + doseScaling <- 10^(floor(log10(median(dose)))) + # if ( (is.na(doseScaling)) || (doseScaling < 1e-10) ) # changed May 16 2012 + if ( (is.na(doseScaling)) || (doseScaling < dscaleThres) ) + { + doseScaling <- 1 + } + + respScaling <- 10^(floor(log10(median(resp)))) + # if ( (is.na(respScaling)) || (respScaling < 1e-10) || (!identical(type, "continuous")) || (!is.null(bcVal)) ) # changed May 16 2012 + if ( (is.na(respScaling)) || (respScaling < rscaleThres) || (!identical(type, "continuous")) || (!is.null(bcVal)) ) + { + respScaling <- 1 + } + # print(resp) + # print(median(resp)) + + # doseScaling <- 1 + # respScaling <- 1 + + ## Starting values need to be calculated after BC transformation!!! + + # Retrieving scaling vector + longScaleVec <- rep(scaleFct(doseScaling, respScaling), + as.vector(unlist(lapply(parmIndex, length)))) + + } else { + doseScaling <- 1 + respScaling <- 1 + + longScaleVec <- 1 + # + # startVecSc <- startVec + } + # print(c(doseScaling, respScaling, longScaleVec)) + + ## Constructing vector of initial parameter values + startVecList <- list() + + ## Calculating initial estimates for the parameters using the self starter + + # if (identical(type, "ssd") & inherits(fct, "llogistic")) + # { + # ssFct <- function(dframe) {c(-1, 1, 1, 1, 1) * fct[["ssfct"]](dframe)} + # } + + if(!noSSfct) + { + startMat <- matrix(0, numAss, numNames) + lenASS <- length(formals(ssfct)) + if (lenASS > 1) + # in case doseScaling and respScaling arguments are available + # scaling is done inside ssfct() + { + doseresp <- data.frame(x = dose, y = origResp) + ssFct <- function(dframe){ssfct(dframe, doseScaling, respScaling)} + } else { + # scaling is explicitly applied to the dose and response values + doseresp <- data.frame(x = dose / doseScaling, y = origResp / respScaling) + ssFct <- ssfct + } + # doseresp <- data.frame(x = dose / doseScaling, y = origResp / respScaling) + # doseresp <- data.frame(dose, origResp) + + # Not sure this indicator is needed?! Only used once below! + # Note is.finite() only works with vectors! + # Commented out 2010-12-13 + isfi <- is.finite(dose) # removing infinite dose values + + if (identical(type, "event")) + { + dr2 <- doseresp[, 3] + # print(doseresp[, 2:3]) + isFinite <- is.finite(doseresp[, 2]) + respVec <- rep(NA, length(dr2)) + respVec[isFinite] <- cumsum(dr2[isFinite]) / sum(dr2) + # doseresp[, 3] <- cumsum(dr2[isFinite]) / sum(dr2) + ## doseresp[!is.finite(doseresp[, 2]), 1] <- NA + # doseresp <- doseresp[isFinite, c(1, 3)] + # names(doseresp) <- c("x", "y") + doseresp <- (data.frame(x = doseresp[, 1], y = respVec))[isFinite, ] + # print(doseresp) + } else { + isFinite <- is.finite(doseresp[, 2]) + } + + ## Finding starting values for each curve + for (i in 1:numAss) + { + indexT1 <- (assayNo[isFinite] == i) + if (any(indexT1)) + { + # Commented out 2010-12-13 + # logVec <- indexT1 & isfi + logVec <- indexT1 + + # startMat[i, ] <- ssfct(doseresp[logVec, ]) # ssfct(dose[logVec], origResp[logVec] ) + # startMat[i, ] <- ssfct(doseresp[logVec, ], doseScaling, respScaling) + startMat[i, ] <- ssFct(doseresp[logVec, ]) + } else { + startMat[i, ] <- rep(NA, numNames) + } + + ## Identifying a dose response curve only consisting of control measurements + if (sum(!is.na(startMat[i, ])) == 1) + { + upperPos <- (1:numNames)[!is.na(startMat[i, ])] + # print(upperPos) + } + } + # print(startMat) + + # startMat2 <- matrix(unlist(lapply(split(doseresp, assayNo[isFinite]), ssFct)), nrow = numAss, byrow = TRUE) + # upperPos2 <- c(rep(1:numNames, numAss))[t(is.na(startMat))] + # print(upperPos2) + # print(startMat2) + + + # New approach? + # timeUsed <- 0 + # ssFctWrapper <- function(dframeSubset) + # { + # ssFct(dframeSubset[is.finite(dframeSubset[1, ]), ]) + # timeUsed <- timeUsed + system.time(ssFct(dframeSubset[is.finite(dframeSubset[1, ]), ]))[3] + # } + # startMat2 <- matrix(as.vector(unlist(lapply(split(doseresp, assayNo), ssFctWrapper))), + # numAss, numNames, byrow = TRUE) + # print(startMat2) # for comparison + + + ## Transforming matrix of starting values into a vector + nrsm <- nrow(startMat) + for (i in 1:numNames) + { + sv <- rep(0, max(nrsm, ncclVec[i])) + indVec <- 1:ncclVec[i] + sv[1:nrsm] <- startMat[, i] + sv <- sv[!is.na(sv)] + + isZero <- (sv == 0) + sv[isZero] <- mean(sv) + + startVecList[[i]] <- sv[indVec] + # print(startVecList[[i]]) + } + startVec <- unlist(startVecList) + } else { + startVec <- start # no checking if no self starter function is provided!!! + } + + ## Checking the number of start values provided + if (!selfStart && !noSSfct) + { + lenReq <- length(startVec) # generated from self starter + if (length(start) == lenReq) + { + startVec <- start / longScaleVec + } else { + stop(paste("Wrong number of initial parameter values. ", lenReq, " values should be supplied", sep = "")) + } + } + + ## Converting parameters + if (selfStart) + { + startVec <- drmConvertParm(startVec, startMat, assayNo, pmodelsList2) + } + + # Scaling starting values (currently not done in drmEMls) + # startVecSc <- startVec / longScaleVec + startVecSc <- startVec + # print(startVecSc) + + ## Defining function which converts parameter vector to parameter matrix + parmMatrix <- matrix(0, numObs, numNames) + parm2mat <- function(parm) + { + # parmMatrix <- matrix(0, lenData, numNames) + for (i in 1:numNames) + { + # print(as.matrix(pmodelsList2[[i]])) + # print(parmPos[i] + 1:ncclVec[i]) + # print(parm[parmPos[i] + 1:ncclVec[i]]) + # parmMatrix[, i] <- pmodelsList2[[i]] %*% parm[parmPos[i] + 1:ncclVec[i]] + parmMatrix[, i] <- pmodelsList2[[i]] %*% parm[parmIndex[[i]]] + } + return(parmMatrix) + } + + ## Defining non-linear function + # if (!is.null(fctList)) + # { + # ivList <- list() + # ivList2 <- list() + # matList <- list() + # svList <- list() + # for (i in 1:numAss) + # { + # indexT1 <- (assayNo == i) + # isfi <- is.finite(dose) # removing infinite dose values + # + # ivList[[i]] <- indexT1 + ## svList[[i]] <- fctList[[i]]$"ssfct"( doseresp[(indexT1 & isfi), ] ) + # logVec <- indexT1 & isfi + # svList[[i]] <- fctList[[i]]$"ssfct"(doseresp[logVec, ]) # dose[logVec], origResp[logVec]) + # matList[[i]] <- c( sum(indexT1), length(svList[[i]]) ) + # + # ivList2[[i]] <- match(fctList[[i]]$names, fct$names) + # } + # + # + # posVec <- rep(0, numAss) + # for (i in 1:numAss) + # { + # posVec[i] <- matList[[i]][2] + # } + # posVec <- cumsum(posVec) + # posVec <- c(0, posVec) + ## print(posVec) + # + # drcFct1 <- function(dose, parm) + # { + # retVec <- rep(0, numObs) + # for (i in 1:numAss) + # { + # iVec <- ivList[[i]] + # pMat <- matrix(parm[(posVec[i]+1):posVec[i+1]], matList[[i]][1], matList[[i]][2], byrow = TRUE) + # retVec[iVec] <- fctList[[i]]$"fct"( dose[iVec], pMat ) + # } + # return(retVec) + # } + # + # startVec <- as.vector(unlist(svList)) + # } else { + + ## Defining model function + multCurves <- modelFunction(dose, parm2mat, drcFct, cm, assayNoOld, upperPos, fct$"retFct", + doseScaling, respScaling, isFinite = rep(TRUE, lenData), pshifts) + + # drcFct1 <- function(dose, parm) + # { + # drcFct(dose, parm2mat(parm)) + # } + ## } + # + # + # ## Defining model function + # if (!is.null(fct$"retFct")) + # { + # drcFct <- fct$"retFct"(doseScaling, respScaling) #, numObs) + # drcFct1 <- function(dose, parm) + # { + # drcFct(dose, parm2mat(parm)) + # } + # } + # + # if (is.null(cm)) + # { + # multCurves <- function(dose, parm) + # { + # drcFct1(dose, parm) # fctList + # } + # } else { + # iv <- assayNoOld == cm + # niv <- !iv + # fctEval <- rep(0, numObs) + # + # multCurves <- function(dose, parm) + # { + # parmVal <- parm2mat(parm) + # fctEval[iv] <- parmVal[iv, upperPos, drop = FALSE] + # fctEval[niv] <- drcFct(dose[niv], parmVal[niv, , drop = FALSE]) + # + # fctEval + # } + # } + ## print(startVec) + ## print(multCurves(dose, startVec)) + + + ## Defining first derivative (if available) ... used once in drmEMls() + if (!is.null(dfct1)) + { + dmatfct <- function(dose, parm) + { + dfct1(dose, parm2mat(parm)) + } + } else { + dmatfct <-NULL + } + + ## Box-Cox transformation is applied + if (!is.null(bcVal)) # (boxcox) + { + # varPower <- FALSE # not both boxcox and varPower at the same time + + ## Defining Box-Cox transformation function + bcfct <- function(x, lambda, bctol, add = bcAdd) + { + if (abs(lambda) > bctol) + { + return(((x + add)^lambda - 1)/lambda) + } else { + return(log(x + add)) + } + } + + ## Setting the tolerance for Box-Cox transformation being the logarithm transformation + ## (same as in boxcox.default in MASS package) + bcTol <- 0.02 + + # resp <- bcfct(resp, lambda, bcTol) + resp <- bcfct(resp, bcVal, bcTol) + + multCurves2 <- function(dose, parm) + { + bcfct(multCurves(dose, parm), bcVal, bcTol) + } + } else {multCurves2 <- multCurves} + # print(startVec) + # print(multCurves2(dose, startVec)) + + ## Defining estimation method -- perhaps working for continuous data + # robustFct <- drmRobust(robust, match.call(), numObs, length(startVec)) + robustFct <- drmRobust(robust, callDetail, numObs, length(startVec)) + + if (type == "continuous") + { + ## Ordinary least squares estimation + estMethod <- drmEMls(dose, resp, multCurves2, startVecSc, robustFct, wVec, rmNA, dmf = dmatfct, + doseScaling = doseScaling, respScaling = respScaling, varcov = varcov) + + # if (adjust == "vp") #(varPower) + # { + # estMethod <- drmEMvp(dose, resp, multCurves2) # mdrcVp(dose, resp, multCurves2) + # lenStartVec <- length(startVec) + # + # start2ss <- estMethod$"ssfct"(cbind(dose, resp)) + # if (missing(start2)) + # { + # startVec <- c(startVec, start2ss) + # } else { + # if (length(start2) == 2) # canonical 2? + # { + # startVec <- c(startVec, start2) + # } + # } + ## startVec <- c(startVec, estMethod$"ssfct"(cbind(dose, resp))) + # parmVec <- c(parmVec, "Sigma", "Power") + # + # startVecSc <- startVec + # } + + # if (!is.null(vvar)) + # { + # estMethod <- mdrcHetVar(dose, resp, multCurves2, vvar) + # lenStartVec <- length(startVec) + # startVec <- c(startVec, estMethod$"ssfct"(cbind(dose, resp))) + # parmVec <- c(parmVec, as.character(unique(vvar))) + # } + } + if (identical(type, "binomial")) + { + estMethod <- drmEMbinomial(dose, resp, multCurves2, startVecSc, robustFct, wVec, rmNA, + doseScaling = doseScaling) + } + if (identical(type, "Poisson")) + { + estMethod <- drmEMPoisson(dose, resp, multCurves2, startVecSc, weightsVec = wVec, + doseScaling = doseScaling) + } + if (identical(type, "negbin1") || identical(type, "negbin2")) + { + estMethod <- drmEMnegbin(dose, resp, multCurves2, startVecSc, weightsVec = wVec, + doseScaling = doseScaling, + dist.type = ifelse(type == "negbin1", 1, 2)) + } + if (identical(type, "event")) + { + estMethod <- drmEMeventtime(dose, resp, multCurves2, doseScaling = doseScaling) + } + if (identical(type, "ssd")) + { + # if (is.null(fct[["retFctDx"]])) {fct[["retFct"]] <- NULL} else {fct[["retFct"]] <- fct[["retFctDx"]]} + # fct[["retFct"]] <- NULL + # print(doseScaling) + # print(respScaling) + doseScaling <- 1 # dose is the response! + respScaling <- 1 # no response variable + longScaleVec <- rep(1, length(longScaleVec)) + multCurves2loc <- modelFunction(dose, parm2mat, fct$"derivx", cm, assayNoOld, upperPos, + retFct = fct[["retFctDx"]], #NULL, + doseScaling = doseScaling, respScaling = respScaling, + isFinite = rep(TRUE, lenData), pshifts) + estMethod <- drmEMssd(dose, resp, multCurves2loc, doseScaling = doseScaling, multCurves2 = multCurves2) + } + # if (identical(type, "standard")) + # { + # estMethod <- drmEMstandard(dose, resp, multCurves2, doseScaling = doseScaling) + # } + + opfct <- estMethod$opfct + + + ## Re-fitting the ANOVA model to incorporate Box-Cox transformation (if necessary) + # if (type == "continuous") + # { + # if (!is.na(lambda)) + # { + # dset <- data.frame(dose, doseFactor, resp, assayNo, bcc) # dataset with new resp values + # anovaModel0 <- (testList$"anovaTest")(anovaFormula, dset) + ## anovaModel <- anovaModel0$"anovaFit" + # } + # } + + ## Defining lower and upper limits of parameters + # if (constrained) + # { + if (!is.null(lowerl)) + { + if (!is.numeric(lowerl) || !((length(lowerl) == sum(ncclVec)) || (length(lowerl) == numNames))) + { + stop("Not correct 'lowerl' argument") + } else { + if (length(lowerl) == numNames) + { + lowerLimits <- rep(lowerl, ncclVec) + } else { + lowerLimits <- lowerl + } + } + constrained <- TRUE + + } else { ## In case lower limits are not specified + lowerLimits <- rep(-Inf, length(startVec)) + } + + if (!is.null(upperl)) + { + if (!is.numeric(upperl) || !((length(upperl) == sum(ncclVec)) || (length(upperl) == numNames))) + { + stop("Not correct 'upperl' argument") + } else { + if (length(upperl) == numNames) + { + upperLimits <- rep(upperl, ncclVec) + } else { + upperLimits <- upperl + } + } + constrained <- TRUE + + } else { ## In case upper limits are not specified + upperLimits <- rep(Inf, length(startVec)) + } + + lowerLimits <- lowerLimits / longScaleVec + upperLimits <- upperLimits / longScaleVec + + # if (all(!is.finite(lowerLimits)) && all(!is.finite(upperLimits))) + # { + # stop("No constraints are imposed via 'lowerl' and 'upperl' arguments") + # } + # } + + ## Optimisation + + ## Setting derivatives + opdfctTemp <- estMethod$"opdfct1" + appFct <- function(x, y){tapply(x, y, sum)} + + if (!is.null(opdfctTemp)) + { + opdfct1 <- function(parm) + { + # print(as.vector(apply(opdfctTemp(parm), 2, appFct, assayNo))) + as.vector(apply(opdfctTemp(parm), 2, appFct, assayNo)) + } + } else { + opdfct1 <- NULL + } + + ## Manipulating before optimisation + + # ## Scaling x values + #if (FALSE) + #{ + # sxInd <- fct$"sxInd" + # sxYN <- !is.null(sxInd) && ((max(dose)<1e-2) || (min(dose)>1e2) || (diff(range(dose))>1e2) ) + # if ( sxYN && (is.null(fctList)) ) + # { + ## if (!is.null(fctList)) + ## { + ## parmIndX <- rep(0, numAss) + ## for (i in 1:numAss) + ## { + ## parmIndX[i] <- fctList[[i]]$"sxInd" + ## } + ## parmIndX <- cumsum(parmIndX) + ## } else { + # parmIndX <- parmPos[sxInd] + 1:ncclVec[sxInd] + ## } + # + # scaleXConstant <- median(dose) + # sxFct <- scaleX(scaleXConstant) # , scaleX(dose, maxDose) + # if (adjust == "vp") + # { + # dose <- sxFct(dose) + # opfct <- drmEMvp(dose, resp, multCurves2)$"opfct" + # } + # + # startVec[parmIndX] <- sxFct(startVec[parmIndX]) + # } + ## print(startVec) # 2 + #} + + # ## Scaling y values + # ## based on the original response value + # ## not the transformed values + # syInd <- fct$"syInd" + # lensy <- length(syInd) + # parmIndY <- list() + # + # lyLim <- 1e-2 + # uyLim <- 1e2 + # syYN <- !is.null(syInd) && ((max(origResp)uyLim) || (diff(range(origResp))>uyLim)) + # if ( syYN && (is.null(fctList)) ) + # { + ## if (!is.null(fctList)) + ## { + ## parmIndY <- rep(0, numAss) + ## for (i in 1:numAss) + ## { + ## parmIndY[[i]] <- fctList[[i]]$"syInd" + ## } + ## parmIndY <- cumsum(as.vector(unlist(parmIndY))) + ## } else { + # for (i in 1:lensy) + # { + # parmIndY[[i]] <- parmPos[syInd[i]] + c(1:ncclVec[syInd[i]]) + # } + # tempPIY <- as.vector(unlist(parmIndY)) + # parmIndY <- tempPIY + ## } + # if (adjust == "bc1") + # { + # scaleYConstant <- bcfct(median(origResp), lambda, bcTol) # median(origResp) + # } else { + # scaleYConstant <- median(origResp) + # } + # syFct <- scaleY(median(origResp)) # scaleY(scaleYConstant) + # startVec[parmIndY] <- syFct(startVec[parmIndY]) + # } + # # scaling of y values through 'opfct' definition + ## print(startVec) # 3 + + + ## Testing nonlinear function + # print(startVecSc) + # print(multCurves2(dose, startVecSc)) + # print(opfct(startVecSc)) + ## print(dose) + ## print(resp) + + ## Scaling objective function + # if (type == "continuous") + # { + # ofVal <- opfct(startVec) + # if ( !is.nan(ofVal) && ( (ofVal < 1e-2) || (ofVal >1e2) ) ) + # { + # opfct2 <- function(c){opfct(c)/opfct(startVec)} + # } else { + # opfct2 <- opfct + # } + # } else { + # opfct2 <- opfct + # } + # opfct2 <- opfct # only used once below + + + ## Updating starting values + startVecSc <- as.vector(startVecSc) # removing names + if (identical(type, "negbin1") || identical(type, "negbin2")) + { + startVecSc <- c(startVecSc, 1) + parmVec <- c(parmVec, "O:(Intercept)") + parmVecA <- c(parmVecA, "O") + parmVecB <- c(parmVecB, "(Intercept)") + + # print(opfct(startVecSc)) + } + + + ## Optimising the objective function previously defined + nlsFit <- drmOpt(opfct, opdfct1, startVecSc, optMethod, constrained, warnVal, + upperLimits, lowerLimits, errorMessage, maxIt, relTol, parmVec = parmVec, traceVal = control$"trace", + matchCall = callDetail, silentVal = !control$"otrace") + # matchCall = match.call()) + + if (!nlsFit$convergence) {return(nlsFit)} + + ## Manipulating after optimisation + if (identical(type, "negbin1") || identical(type, "negbin2")) + { + longScaleVec <- c(longScaleVec, 1) + + } + + if (identical(type, "event")) + { + # dose <- dose[isFinite, 2] + # resp <- (as.vector(unlist(tapply(resp, assayNo, function(x){cumsum(x) / sum(x)}))))[isFinite] + + # orderDose <- order(dose0) + # dose1 <- dose0[orderDose] + + assayNo0 <- assayNo[isFinite] + dose0 <- dose[, 2] + dose1 <- dose0[isFinite] + dose <- as.vector(unlist(tapply(dose1, assayNo0, function(x){unique(sort(x))}))) + + ## Rescaling per curve id + idList <- split(data.frame(dose0, resp), assayNo) + # print(idList) + + respFct <- function(idListElt) + { + doseVec <- idListElt[, 1] + dose2 <- unique(sort(doseVec)) + orderDose <- order(doseVec) + resp1 <- tapply(idListElt[orderDose, 2], doseVec[orderDose], sum) # obtaining one count per time interval + resp2 <- cumsum(resp1) / sum(resp1) + + cbind(dose2, resp2)[is.finite(dose2), , drop = FALSE] + } + drList <- lapply(idList, respFct) + lapList <- lapply(drList, function(x){x[, 1]}) + dose <- as.vector(unlist(lapList)) + resp <- as.vector(unlist(lapply(drList, function(x){x[, 2]}))) + + # listCI <- split(assayNoOld[isFinite], assayNoOld[isFinite]) + # splitFactor <- factor(assayNoOld[isFinite], exclude = NULL) + splitFactor <- factor(assayNo, exclude = NULL) + listCI <- split(splitFactor, splitFactor) + lenVec <- as.vector(unlist(lapply(lapList, length))) + # print(listCI) + # print(lenVec) + plotid <- as.factor(as.vector(unlist(mapply(function(x,y){x[1:y]}, listCI, lenVec)))) + # plotid <- plotid[complete.cases(plotid)] + levels(plotid) <- unique(assayNoOld) + } else { + plotid <- NULL + } + + + if (identical(type, "ssd")) + { + if (ncol(as.matrix(dose)) > 1) + { + dose2 <- dose[, 2] + ifDose2 <- is.finite(dose2) + dose <- dose2[ifDose2] + resp <- resp[ifDose2] + } else { + ifDose2 <- is.finite(dose) # in case of no censoring + + } + } + + + + # print(nlsFit$par) + ## Adjusting for pre-fit scaling + if (!is.null(scaleFct)) + { + # Scaling the sums of squares value back + nlsFit$value <- nlsFit$value * (respScaling^2) + + # Scaling estimates and Hessian back + # print(longScaleVec) + nlsFit$par <- nlsFit$par * longScaleVec + nlsFit$hessian <- nlsFit$hessian * (1/outer(longScaleVec/respScaling, longScaleVec/respScaling)) + } + + if (!is.null(fct$"retFct")) #&& (!identical(type, "ssd"))) + { + drcFct <- fct$"retFct"(1, 1) #, numObs) # resetting the scaling + drcFct1 <- function(dose, parm) + { + drcFct(dose, parm2mat(parm)[isFinite, , drop = FALSE]) + } + } + + + # print(nlsFit$par) + # nlsFit$value <- opfct(nlsFit$par) # used in the residual variance + + ## Manipulating after optimisation + + # ## Adjusting for scaling of y values + # if ( syYN && (is.null(fctList)) ) + # { + # nlsFit$value <- syFct(syFct(nlsFit$value, down = FALSE), down = FALSE) + # startVec[parmIndY] <- syFct(startVec[parmIndY], down = FALSE) + # nlsFit$par[parmIndY] <- syFct(nlsFit$par[parmIndY], down = FALSE) + # + # scaleFct1 <- function(hessian) + # { + # newHessian <- hessian + # newHessian[, parmIndY] <- syFct(newHessian[, parmIndY], down = FALSE) + # newHessian[parmIndY, ] <- syFct(newHessian[parmIndY, ], down = FALSE) + # return(newHessian) + # } + # } else { + # scaleFct1 <- function(x) {x} + # } + + + # ## Adjusting for scaling of x values + #if (FALSE) + #{ + # if ( sxYN && (is.null(fctList)) ) # (!is.null(sxInd)) + # { + # if (adjust == "vp") + # { + # dose <- sxFct(dose, down = FALSE) + # } + # startVec[parmIndX] <- sxFct(startVec[parmIndX], down = FALSE) + # nlsFit$par[parmIndX] <- sxFct(nlsFit$par[parmIndX], down = FALSE) + # + # scaleFct2 <- function(hessian) + # { + # newHessian <- scaleFct1(hessian) + # newHessian[, parmIndX] <- sxFct(newHessian[, parmIndX], down = FALSE) + # newHessian[parmIndX, ] <- sxFct(newHessian[parmIndX, ], down = FALSE) + # return(newHessian) + # } + # } else { + # scaleFct2 <- function(hessian) + # { + # scaleFct1(hessian) + # } + # } + #} + + # ## Handling variance parameters + # varParm <- NULL + # + # if (varPower) + # { + # varParm <- list(type = "varPower", index = 1:lenStartVec) + # } + # if (!is.null(vvar)) + # { + # varParm <- list(type = "hetvar", index = 1:lenStartVec) + # } + + # Testing against the ANOVA (F-test) + nlsSS <- nlsFit$value + nlsDF <- numObs - length(startVec) + + ## Constructing a plot function + + ## Picking parameter estimates for each curve. Does only work for factors not changing within a curve! + if (!is.null(cm)) {iVec <- (1:numAss)[!(uniqueNames==cm)]} else {iVec <- 1:numAss} + + pickCurve <- rep(0, length(iVec)) + for (i in iVec) + { + pickCurve[i] <- (1:numObs)[assayNo == i][1] + } + parmMat <- matrix(NA, numAss, numNames) + + fixedParm <- (estMethod$"parmfct")(nlsFit) + # print(nlsFit$par) + # print(fixedParm) + parmMat[iVec, ] <- (parm2mat(fixedParm))[pickCurve, ] + + indexMat2 <- parm2mat(1:length(fixedParm)) + indexMat2 <- indexMat2[!duplicated(indexMat2), ] + + # if(!is.null(fctList)) + # { + # parmMat <- matrix(NA, numAss, numNames) + # for (i in 1:numAss) + # { + # parmMat[i, ivList2[[i]]] <- fixedParm[(posVec[i]+1):posVec[i+1]] + # } + # } + + if (!is.null(cm)) + { + # conPos <- upperPos + # print(conPos) + parmMat[-iVec, upperPos] <- (parm2mat(fixedParm))[assayNoOld == cm, , drop = FALSE][1, upperPos] + # 1: simply picking the first row + } + rownames(parmMat) <- assayNames + + + pmFct <- function(fixedParm) + { + if (!is.null(cm)) {iVec <- (1:numAss)[!(uniqueNames == cm)]} else {iVec <- 1:numAss} + + if (!is.null(cm)) + { + # conPos <- conList$"pos" + parmMat[-iVec, upperPos] <- (parm2mat(fixedParm))[assayNoOld == cm, , drop = FALSE][1, upperPos] + # 1: simply picking the first row + } + rownames(parmMat) <- assayNames + + return(parmMat) + } + parmMat <- pmFct(fixedParm) # (estMethod$"parmfct")(nlsFit) ) + # print(parmMat) + # print(pmFct(1:length(fixedParm))) + + # ## Scaling parameters + # if (!is.null(fct$scaleFct)) + # { + # scaleFct <- function(parm) + # { + # fct$scaleFct(parm, xScaling, yScaling) + # } + # + # parmMat <- apply(parmMat, 1, scaleFct) + # } + # + + ## Constructing design matrix allowing calculations for each curve + # colPos <- 1 + # rowPos <- 1 + # Xmat <- matrix(0, numAss*numNames, length(nlsFit$par)) + # Xmat <- matrix(0, numAss*numNames, length(fixedParm)) + + + # if (!is.null(fctList)) {omitList <- list()} + # for (i in 1:numNames) + # { + # indVec <- iVec + # lenIV <- length(indVec) + # + # nccl <- ncol(pmodelsList2[[i]]) # min(maxParm[i], ncol(pmodelsList2[[i]])) + # + # XmatPart <- matrix(0, lenIV, nccl) + # k <- 1 + # if (!is.null(fctList)) {omitVec <- rep(TRUE, lenIV)} + # for (j in indVec) + # { + # if (!is.null(fctList)) + # { + # parPresent <- !is.na(match(i, ivList2[[j]])) + # omitVec[k] <- parPresent + # } + # + # XmatPart[k, ] <- (pmodelsList2[[i]])[(1:lenData)[assayNo == j][1], 1:nccl] + # k <- k + 1 + # } + # if (!is.null(fctList)) + # { + # XmatPart <- XmatPart[omitVec, , drop = FALSE] + # nccl <- nccl - sum(!omitVec) + # omitList[[i]] <- omitVec + # } + # + # Xmat[rowPos:(rowPos+lenIV-1), colPos:(colPos+nccl-1)] <- XmatPart + # colPos <- colPos + nccl + # rowPos <- rowPos + lenIV + # } + # Xmat <- Xmat[1:(rowPos-1), 1:(colPos-1)] + + + ## Defining the plot function + pfFct <- function(parmMat) + { + plotFct <- function(dose) + { + # if (xDim == 1) {lenPts <- length(dose)} else {lenPts <- nrow(dose)} + if (is.vector(dose)) + { + lenPts <- length(dose) + } else { + lenPts <- nrow(dose) + } + # print(lenPts) + # print(ciOrigLength) + + curvePts <- matrix(NA, lenPts, ciOrigLength) # numAss) + for (i in 1:numAss) + { + # if (!is.null(fctList)) + # { + # drcFct <- fctList[[i]]$"fct" + # numNames <- matList[[i]][2] + # } + + if (i %in% iVec) + { + # parmChosen <- parmMat[i, ] + parmChosen <- parmMat[i, complete.cases(parmMat[i, ])] # removing NAs + # print(parmChosen) + + parmMat2 <- matrix(parmChosen, lenPts, numNames, byrow = TRUE) + # print(parmMat2) + curvePts[, ciOrigIndex[i]] <- drcFct(dose, parmMat2) + } else { curvePts[, i] <- rep(NA, lenPts)} + } + return(curvePts) + } + + return(plotFct) + } + # print(parmMat) + plotFct <- pfFct(parmMat) + # plotFct(0:10) + + + ## Computation of fitted values and residuals + if (identical(type, "event") || identical(type, "ssd")) + { + multCurves2 <- modelFunction(dose, parm2mat, drcFct, cm, assayNoOld, upperPos, fct$"retFct", + doseScaling, respScaling, isFinite) + } + predVec <- multCurves2(dose, fixedParm) + resVec <- resp - predVec + resVec[is.nan(predVec)] <- 0 + + diagMat <- matrix(c(predVec, resVec), length(dose), 2) + colnames(diagMat) <- c("Predicted values", "Residuals") + + + ## Adjusting for robust estimation: MAD based on residuals, centered at 0, is used as scale estimate + if (robust%in%c("median", "trimmed", "tukey", "winsor")) + { + nlsFit$value <- (mad(resVec, 0)^2)*nlsDF + } + # if (robust=="winsor") + # { + # K <- 1 + length(startVec)*var(psi.huber(resVec/s, deriv=1)) + # } + if (robust%in%c("lms", "lts")) # p. 202 i Rousseeuw and Leroy: Robust Regression and Outlier Detection + { + scaleEst <- 1.4826*(1+5/(numObs-length(nlsFit$par)))*sqrt(median(resVec^2)) + w <- (resVec/scaleEst < 2.5) + nlsFit$value <- sum(w*resVec^2)/(sum(w)-length(nlsFit$par)) + } + + + ## Adding meaningful names for robust methods + robust <- switch(robust, median="median", trimmed="metric trimming", tukey="Tukey's biweight", + winsor="metric Winsorizing", lms="least median of squares", + lts="least trimmed squares") + + + ## Collecting summary output + sumVec <- c(NA, NA, NA, nlsSS, nlsDF, numObs) # , alternative) + sumList <- list(lenData = numObs, + alternative = NULL, # alternative, + df.residual = numObs - length(startVec)) + + + ## The function call + # callDetail <- match.call() + # if (is.null(callDetail$fct)) {callDetail$fct <- substitute(l4())} + + + ## The data set + if (!is.null(logDose)) + { + dose <- origDose + } + dataSet <- data.frame(origDose, origResp, assayNo, assayNoOld, wVec) + + # print(varNames0) + if (identical(type, "event")) + { + names(dataSet) <- c(varNames0[c(2, 3, 1)], anName, paste("orig.", anName, sep = ""), "weights") + } else { + names(dataSet) <- c(varNames0[c(2, 1)], anName, paste("orig.", anName, sep = ""), "weights") + } + + + # ## Box-Cox information + # bcVec <- c(lambda, boxcoxci) + # if (all(is.na(bcVec))) {bcVec <- NULL} + # if (!is.null(bcVec)) {bcVec <- c(bcVec, bcAdd)} + + + ## Evaluating goodness-of-fit test + # if (!is.null(gofTest)) {gofTest <- gofTest(resp, weights, predVec, sumList$"df.residual")} + + + # ## Adjusting in case 'fctList' is specified + # if (!is.null(fctList)) + # { + # omitAllVec <- as.vector(unlist(omitList)) + # + # parmVec <- parmVec[omitAllVec] + # parmVecA <- parmVecA[omitAllVec] + # parmVecB <- parmVecB[omitAllVec] + # + # orderVec <- match(as.vector(parmMat), nlsFit$par) + # orderVec <- orderVec[complete.cases(orderVec)] + # + # nlsFit$par <- nlsFit$par[orderVec] + # nlsFit$hessian <- nlsFit$hessian[orderVec, orderVec] + # } + + + ## Constructing an index matrix for use in ED and SI + # (commented out Dec 7 2011, replaced by definition below of the index matrix) + # hfct1 <- function(x) # helper function + # { + # uniVec <- unique(x[!is.na(x)]) + # rv <- rep(NA, length(x)) + # for (i in 1:length(uniVec)) + # { + # rv[abs(x-uniVec[i]) < 1e-12] <- i + # } + # rv + # } + # hfct2 <- function(x) + # { + # length(unique(x)) + # } + ## parmMat <- t(parmMat) + # mat1 <- t(apply(t(parmMat), 1, hfct1)) # , 1:ncol(parmMat))) + # cnccl <- head(cumsum(ncclVec), -1) + ## mat2 <- mat1 + # if (nrow(mat1) == 1) {mat1 <- t(mat1)} # in case of only one curve + # mat1[-1, ] <- mat1[-1, ] + cnccl + + ## Matrix of first derivatives evaluated at the parameter estimates + if (isDF) + { + # print((parmMat[assayNo, , drop = FALSE])[isFinite, , drop = FALSE]) + deriv1Mat <- fct$"deriv1"(dose, (parmMat[assayNo, , drop = FALSE])[isFinite, , drop = FALSE]) + } else { + deriv1Mat <- NULL + } + # deriv1Mat <- NULL + + ## Box-Cox information + if (!is.null(bcVal)) + { + bcVec <- list(lambda = bcVal, ci = c(NA, NA), bcAdd = bcAdd) + } else { + bcVec <- NULL + } + + ## Parameter estimates + coefVec <- nlsFit$par + names(coefVec) <- parmVec + + ## Constructing the index matrix + # parmMat <- t(parmMat) + indexMat <- apply(t(parmMat), 2, function(x){match(x, coefVec)}) + + ## Constructing data list ... where is it used? + wName <- callDetail[["weights"]] + if (is.null(wName)) + { + wName <- "weights" + } else { + wName <- deparse(wName) + } + # dataList <- list(dose = as.vector(origDose), origResp = as.vector(origResp), weights = wVec, + dataList <- list(dose = origDose, origResp = as.vector(origResp), weights = wVec, + curveid = assayNoOld, resp = as.vector(resp), + names = list(dName = varNames[1], orName = varNames[2], wName = wName, cNames = anName, rName = "")) + if (identical(type, "event")) + { + dataList <- list(dose = dose, origResp = resp, weights = wVec[isFinite], + curveid = assayNoOld[isFinite], plotid = plotid, resp = resp, + names = list(dName = varNames[1], orName = varNames[2], wName = wName, cNames = anName, rName = "")) + } + if (identical(type, "ssd")) + { + dataList <- list(dose = dose, origResp = resp, weights = wVec[ifDose2], + curveid = assayNoOld[ifDose2], resp = resp, + names = list(dName = varNames[1], orName = varNames[2], + wName = wName, cNames = anName, rName = "")) + } + + + ## What about naming the vector of weights? + + ## Returning the fit + # returnList <- list(varParm, nlsFit, list(plotFct, logDose), sumVec, startVec, list(parmVec, parmVecA, parmVecB), + returnList <- list(NULL, nlsFit, list(plotFct, logDose), sumVec, startVecSc * longScaleVec, + # returnList <- list(nlsFit, list(plotFct, logDose), sumVec, startVecSc * longScaleVec, + list(parmVec, parmVecA, parmVecB), + diagMat, callDetail, dataSet, t(parmMat), fct, robust, estMethod, numObs - length(startVec), + # anovaModel0, gofTest, + # sumList, NULL, pmFct, pfFct, type, mat1, logDose, cm, deriv1Mat, + sumList, NULL, pmFct, pfFct, type, indexMat, logDose, cm, deriv1Mat, + anName, data, wVec, + dataList, + coefVec, bcVec, + indexMat2) + + names(returnList) <- c("varParm", "fit", "curve", "summary", "start", "parNames", + "predres", "call", "data", + # names(returnList) <- c("fit", "curve", "summary", "start", "parNames", "predres", "call", "data", + "parmMat", "fct", "robust", "estMethod", "df.residual", + # "anova", "gofTest", + "sumList", "scaleFct", "pmFct", "pfFct", "type", "indexMat", "logDose", "cm", "deriv1", + "curveVarNam", "origData", "weights", + "dataList", "coefficients", "boxcox", "indexMat2") + ## Argument "scaleFct" not used anymore + class(returnList) <- c("drc") # , class(fct)) + + return(returnList) +} \ No newline at end of file diff --git a/R/drmc.R b/R/drmc.R new file mode 100644 index 00000000..343b99a8 --- /dev/null +++ b/R/drmc.R @@ -0,0 +1,65 @@ +#' @title Sets control arguments +#' +#' @description Set control arguments in the control argument in the function \code{\link{drm}}. +#' +#' @param constr logical. If \code{TRUE} optimisation is constrained, only yielding non-negative +#' parameters. +#' @param errorm logical specifying whether failed convergence in \code{\link{drm}} should +#' result in an error or only a warning. +#' @param maxIt numeric. The maximum number of iterations in the optimisation procedure. +#' @param method character string. The method used in the optimisation procedure. See +#' \code{\link{optim}} for available methods. +#' @param noMessage logical, specifying whether or not messages should be displayed. +#' @param relTol numeric. The relative tolerance in the optimisation procedure. A tighter +#' tolerance (smaller value) improves cross-platform reproducibility of results by ensuring +#' the optimiser converges closer to the true optimum regardless of platform-specific +#' floating-point behaviour. Default is \code{1e-10}. +#' @param rmNA logical. Should \code{NA}s be removed from sum of squares used for estimation? +#' Default is \code{FALSE} (not removed). +#' @param useD logical. If \code{TRUE} derivatives are used for estimation (if available). +#' @param trace logical. If \code{TRUE} the trace from \code{\link{optim}} is displayed. +#' @param otrace logical. If \code{TRUE} error messages from the optimisation are displayed. +#' @param warnVal numeric. If equal to 0 then the warnings are stored and displayed at the end. +#' See under \sQuote{warn} in \code{\link{options}}. The default results in suppression of +#' warnings. +#' @param dscaleThres numeric value specifying the threshold for dose scaling. +#' @param rscaleThres numeric value specifying the threshold for response scaling. +#' @param conCheck logical, switching on/off handling of control measurements. +#' +#' @return A list with components corresponding to each of the above arguments. +#' +#' @seealso \code{\link{drm}}, \code{\link{optim}} +#' +#' @examples +#' ## Displaying the default settings +#' drmc() +#' +#' ## Using the 'method' argument +#' model1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +#' model2 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4(), +#' control = drmc(method = "Nelder-Mead")) +#' +#' @author Christian Ritz +#' +#' @keywords models nonlinear +"drmc" <- function(constr = FALSE, errorm = TRUE, maxIt = 500, method = "BFGS", +noMessage = FALSE, relTol = 1e-10, rmNA = FALSE, useD = FALSE, trace = FALSE, +otrace = FALSE, warnVal = -1, dscaleThres = 1e-15, rscaleThres = 1e-15, conCheck = TRUE) +{ + return(list( + constr = constr, + errorm = errorm, + maxIt = maxIt, + method = method, + noMessage = noMessage, + relTol = relTol, + rmNA = rmNA, + useD = useD, + trace = trace, + otrace = otrace, + warnVal = warnVal, + dscaleThres = dscaleThres, + rscaleThres = rscaleThres, + conCheck = conCheck + )) +} diff --git a/R/drmc.r b/R/drmc.r deleted file mode 100644 index 22903185..00000000 --- a/R/drmc.r +++ /dev/null @@ -1,21 +0,0 @@ -"drmc" <- function(constr = FALSE, errorm = TRUE, maxIt = 500, method = "BFGS", -noMessage = FALSE, relTol = 1e-7, rmNA = FALSE, useD = FALSE, trace = FALSE, -otrace = FALSE, warnVal = -1, dscaleThres = 1e-15, rscaleThres = 1e-15, conCheck = TRUE) -{ - return(list( - constr = constr, - errorm = errorm, - maxIt = maxIt, - method = method, - noMessage = noMessage, - relTol = relTol, - rmNA = rmNA, - useD = useD, - trace = trace, - otrace = otrace, - warnVal = warnVal, - dscaleThres = dscaleThres, - rscaleThres = rscaleThres, - conCheck = conCheck - )) -} diff --git a/R/fct2list.r b/R/fct2list.R similarity index 96% rename from R/fct2list.r rename to R/fct2list.R index 4ca83bef..6ee45213 100644 --- a/R/fct2list.r +++ b/R/fct2list.R @@ -1,130 +1,132 @@ -"vec2mat" <- function(fct, no) -{ - parName <- names(formals(fct)[no]) - if (is.na(parName)) {stop("Argument number does not exist")} - parName1 <- paste(parName, "[", sep = "") - parName2 <- paste(parName, "[,", sep = "") - -# bodyStr <- as.character(body(fct)) -# if (bodyStr[1] == "{") {bodyStr <- bodyStr[-1]} # else {bodyStr <- bodyStr[1]} - bodyStr <- deparse(body(fct)) - if (bodyStr[1] == "{") {bodyStr <- paste(head(tail(bodyStr, -1), -1), collapse = "")} # else {bodyStr <- bodyStr[1]} - - lenbs <- length(bodyStr) - bsList <- list() -# options(warn = -1) - for (i in 1:lenbs) - { - tempText <- gsub(parName1, parName2, bodyStr[i], fixed = TRUE) - bsList[[i]] <- paste(tempText, ";", sep = "") - } -# options(warn = 0) - bodyStr2 <- paste("{", paste(as.vector(unlist(bsList)), collapse = ""), "}") - bodyStr3 <- parse(text = bodyStr2) - - newfct <- fct - body(newfct) <- bodyStr3 # bodyStr2 - - return(list(newfct, bodyStr2, parName)) -} - -"nParm" <- function(bodyStr) -{ - gregObj <- gregexpr("(\\[,){1}[[:digit:]]+\\]{1}", bodyStr)[[1]] - posVec <- gregObj - lenVec <- attr(gregObj, "match.length") - - lenpv <- length(posVec) - numVec <- rep(0, lenpv) - for (i in 1:lenpv) - { - numVec[i] <- as.numeric(substr(bodyStr, posVec[i] + 2, posVec[i] + lenVec[i] - 2)) - } - return(length(unique(numVec))) -} - -"fParm" <- function(fct, no, fixed) -{ - v2m <- vec2mat(fct, no) - if (all(is.na(fixed))) {return(v2m[[1]])} - - bodyStr <- v2m[[2]] - - fStr <- paste("{ f <- c(", paste(fixed[!is.na(fixed)], collapse = ", "), ");") - bodyStr <- paste(fStr, substr(bodyStr, 2, nchar(bodyStr))) - parName <- v2m[[3]] - - gregObj <- gregexpr("(\\[,){1}[[:digit:]]+\\]{1}", bodyStr)[[1]] - posVec <- gregObj - lenVec <- attr(gregObj, "match.length") - - lenpv <- length(posVec) - numVec <- rep(0, lenpv) - - realPos <- rep(NA, length(fixed)) - realPos[is.na(fixed)] <- 1:sum(is.na(fixed)) - - fixPos <- rep(NA, length(fixed)) - fixPos[!is.na(fixed)] <- 1:sum(!is.na(fixed)) - -# options(warn = -1) - for (i in 1:lenpv) - { - numVec[i] <- as.numeric(substr(bodyStr, posVec[i] + 2, posVec[i] + lenVec[i] - 2)) - - if (is.na(realPos[numVec[i]])) - { - inStr0 <- paste("f[", as.character(fixPos[numVec[i]]), "]", sep = "") - - lenBl <- nchar(parName) + lenVec[numVec[i]] - nchar(inStr0) - inStr1 <- paste(rep(" ", nchar(parName) + lenVec[numVec[i]] - nchar(inStr0)), collapse = "") - inStr2 <- paste(inStr0, inStr1, sep = "") - - substr(bodyStr, posVec[i] - nchar(parName), posVec[i] + lenVec[i] - 1) <- inStr2 - - - -# inStr0 <- as.character(fixed[numVec[i]]) -# -# lenBl <- nchar(parName) + lenVec[numVec[i]] - nchar(inStr0) -# if (lenBl > 0) -# { -# inStr1 <- paste(rep(" ", lenBl), collapse = "") -# inStr2 <- paste(inStr0, inStr1, sep = "") -# } else { -# inStr2 <- inStr0 -# } -# substr(bodyStr, posVec[i] - nchar(parName), posVec[i] + lenVec[i] - 1) <- inStr2 - - } else { - - inStr3 <- as.character(realPos[numVec[i]]) - - ## In case the number changes from 10 to 9, 100 to 99 and so on - if (nchar(inStr3) < nchar(as.character(numVec[i])) ) - { - numSpaces <- nchar(as.character(numVec[i])) - nchar(inStr3) - tempStr <- paste(rep(" ", numSpaces), collapse = "") - - inStr3 <- paste(tempStr, inStr3, sep = "") - } - substr(bodyStr, posVec[i] + 2, posVec[i] + lenVec[i] - 3) <- inStr3 - } - } -# options(warn = 0) - # to avoid warnings when the replacement is shorter or longer: 1 or 10000 to replace x[,1] - - - bodyStr2 <- parse(text = bodyStr) - newfct <- fct - body(newfct) <- bodyStr2 - - return(newfct) -} - - -fct2list <- function(fct, no) -{ - v2m <- vec2mat(fct, no) - list(v2m[[1]], NULL, letters[1:nParm(v2m[[2]])]) -} +#' @title Convert function specification to list +#' @keywords internal +"vec2mat" <- function(fct, no) +{ + parName <- names(formals(fct)[no]) + if (is.na(parName)) {stop("Argument number does not exist")} + parName1 <- paste(parName, "[", sep = "") + parName2 <- paste(parName, "[,", sep = "") + +# bodyStr <- as.character(body(fct)) +# if (bodyStr[1] == "{") {bodyStr <- bodyStr[-1]} # else {bodyStr <- bodyStr[1]} + bodyStr <- deparse(body(fct)) + if (bodyStr[1] == "{") {bodyStr <- paste(head(tail(bodyStr, -1), -1), collapse = "")} # else {bodyStr <- bodyStr[1]} + + lenbs <- length(bodyStr) + bsList <- list() +# options(warn = -1) + for (i in 1:lenbs) + { + tempText <- gsub(parName1, parName2, bodyStr[i], fixed = TRUE) + bsList[[i]] <- paste(tempText, ";", sep = "") + } +# options(warn = 0) + bodyStr2 <- paste("{", paste(as.vector(unlist(bsList)), collapse = ""), "}") + bodyStr3 <- parse(text = bodyStr2) + + newfct <- fct + body(newfct) <- bodyStr3 # bodyStr2 + + return(list(newfct, bodyStr2, parName)) +} + +"nParm" <- function(bodyStr) +{ + gregObj <- gregexpr("(\\[,){1}[[:digit:]]+\\]{1}", bodyStr)[[1]] + posVec <- gregObj + lenVec <- attr(gregObj, "match.length") + + lenpv <- length(posVec) + numVec <- rep(0, lenpv) + for (i in 1:lenpv) + { + numVec[i] <- as.numeric(substr(bodyStr, posVec[i] + 2, posVec[i] + lenVec[i] - 2)) + } + return(length(unique(numVec))) +} + +"fParm" <- function(fct, no, fixed) +{ + v2m <- vec2mat(fct, no) + if (all(is.na(fixed))) {return(v2m[[1]])} + + bodyStr <- v2m[[2]] + + fStr <- paste("{ f <- c(", paste(fixed[!is.na(fixed)], collapse = ", "), ");") + bodyStr <- paste(fStr, substr(bodyStr, 2, nchar(bodyStr))) + parName <- v2m[[3]] + + gregObj <- gregexpr("(\\[,){1}[[:digit:]]+\\]{1}", bodyStr)[[1]] + posVec <- gregObj + lenVec <- attr(gregObj, "match.length") + + lenpv <- length(posVec) + numVec <- rep(0, lenpv) + + realPos <- rep(NA, length(fixed)) + realPos[is.na(fixed)] <- 1:sum(is.na(fixed)) + + fixPos <- rep(NA, length(fixed)) + fixPos[!is.na(fixed)] <- 1:sum(!is.na(fixed)) + +# options(warn = -1) + for (i in 1:lenpv) + { + numVec[i] <- as.numeric(substr(bodyStr, posVec[i] + 2, posVec[i] + lenVec[i] - 2)) + + if (is.na(realPos[numVec[i]])) + { + inStr0 <- paste("f[", as.character(fixPos[numVec[i]]), "]", sep = "") + + lenBl <- nchar(parName) + lenVec[numVec[i]] - nchar(inStr0) + inStr1 <- paste(rep(" ", nchar(parName) + lenVec[numVec[i]] - nchar(inStr0)), collapse = "") + inStr2 <- paste(inStr0, inStr1, sep = "") + + substr(bodyStr, posVec[i] - nchar(parName), posVec[i] + lenVec[i] - 1) <- inStr2 + + + +# inStr0 <- as.character(fixed[numVec[i]]) +# +# lenBl <- nchar(parName) + lenVec[numVec[i]] - nchar(inStr0) +# if (lenBl > 0) +# { +# inStr1 <- paste(rep(" ", lenBl), collapse = "") +# inStr2 <- paste(inStr0, inStr1, sep = "") +# } else { +# inStr2 <- inStr0 +# } +# substr(bodyStr, posVec[i] - nchar(parName), posVec[i] + lenVec[i] - 1) <- inStr2 + + } else { + + inStr3 <- as.character(realPos[numVec[i]]) + + ## In case the number changes from 10 to 9, 100 to 99 and so on + if (nchar(inStr3) < nchar(as.character(numVec[i])) ) + { + numSpaces <- nchar(as.character(numVec[i])) - nchar(inStr3) + tempStr <- paste(rep(" ", numSpaces), collapse = "") + + inStr3 <- paste(tempStr, inStr3, sep = "") + } + substr(bodyStr, posVec[i] + 2, posVec[i] + lenVec[i] - 3) <- inStr3 + } + } +# options(warn = 0) + # to avoid warnings when the replacement is shorter or longer: 1 or 10000 to replace x[,1] + + + bodyStr2 <- parse(text = bodyStr) + newfct <- fct + body(newfct) <- bodyStr2 + + return(newfct) +} + + +fct2list <- function(fct, no) +{ + v2m <- vec2mat(fct, no) + list(v2m[[1]], NULL, letters[1:nParm(v2m[[2]])]) +} diff --git a/R/findbe.r b/R/findbe.R similarity index 71% rename from R/findbe.r rename to R/findbe.R index a98374a5..bbdccd6f 100644 --- a/R/findbe.r +++ b/R/findbe.R @@ -1,162 +1,125 @@ -## Defining functions for finding initial values of the b and e parameter - -## Finding b and e based on linear regression after logit transformation (classical approach) -findbe1 <- function(doseTr, respTr, sgnb = 1, back = exp) -{ - function(x, y, cVal, dVal) - { -# lmFit <- lm(log((dVal - y)/(y - cVal)) ~ log(x), subset = x > 0) - -#respTr <- function(y, cVal, dVal) {log((dVal - y)/(y - cVal))} -#doseTr <- function(x) {rVec <- log(x); rVec[!x>0] <- NA; rVec} - lmFit <- lm(respTr(y, cVal, dVal) ~ doseTr(x)) - coefVec <- coef(lmFit) - bVal <- sgnb * coefVec[2] - eVal <- back(-coefVec[1] / (sgnb * bVal)) - - return(as.vector(c(bVal, eVal))) - } -} - -## Anke's procedure -findbe2 <- function(bfct, efct, method, sgnb = 1) -{ - ## Helper functions used below - # bfct <- function(x, y, cVal, dVal, eVal) {log((dVal - y) / (y - cVal)) / log(x / eVal)} - bFct <- function(x, y, cVal, dVal, eVal) - { - median(bfct(x, y, cVal, dVal, eVal), na.rm = TRUE) - } - # efct <- function(x, y, bVal, cVal, dVal) {x * (((dVal - y) / (y - cVal))^(-1 / bVal))} - eFct <- function(x, y, bVal, cVal, dVal) - { - median(efct(x, y, bVal, cVal, dVal), na.rm = TRUE) - } - - switch(method, - "Anke" = - function(x, y, cVal, dVal) - { - ## Finding initial value for e - midResp <- (dVal - cVal) / 2 - - ## Largest dose with all responses above - aboveVec <- x[y > midResp] - uniAbove <- unique(aboveVec) - - if (length(aboveVec) < sum(x %in% uniAbove)) - { - uniAbove <- head(uniAbove, -1) - } - maxDose <- max(x[x %in% uniAbove]) -# print(maxDose) - - ## Smallest dose with all responses below - belowVec <- x[y < midResp] - uniBelow <- unique(belowVec) - if (length(belowVec) < sum(x %in% uniBelow)) - { - uniBelow <- tail(uniBelow, -1) - } - minDose <- min(x[x %in% uniBelow]) -# print(minDose) - - subsetInd <- (x > maxDose) & (x < minDose) -# print(subsetInd) - eVal <- mean((1 / (1 + (abs(y[subsetInd] - midResp)/15)^2)) * x[subsetInd]) - if (is.nan(eVal)) # in case subsetInd are all FALSE - { - eVal <- (minDose + maxDose) / 2 - } - sort1 <- sort(unique(x))[2] - if (eVal < sort1) - { - eVal <- sort1 - } - sort2 <- sort(unique(x), decreasing = TRUE)[2] - if (eVal > sort2) - { - eVal <- sort2 - } -# print(eVal) - - ## Finding initial value for b -# bVal <- median(log((dVal - y) / (y - cVal)) / log(x / eVal), na.rm = TRUE) - bVal <- bFct(x, y, cVal, dVal, eVal) -# print(bVal) - - ## Checking sign of b and possibly take action if it's wrong - regSlope <- as.vector(coef(lm(y ~ x)))[2] - if ((!is.na(bVal)) && ((sgnb * regSlope / bVal) > 0)) - { -# bVal <- -bVal -# eVal <- median(x * (((dVal - y) / (y - cVal))^(-1/bVal)), na.rm = TRUE) - eVal <- eFct(x, y, -bVal, cVal, dVal) - bVal <- bFct(x, y, cVal, dVal, eVal) - } - if (is.na(bVal)) - { - bVal <- (sgnb) * (-regSlope) - } - print(c(bVal, eVal)) - return(c(bVal, eVal)) - }, - "Normolle" = - function(x, y, cVal, dVal) - { - bVal <- bFct(x, y, cVal, dVal, mean(range(x))) - eVal <- eFct(x, y, bVal, cVal, dVal) - - return(c(bVal, eVal)) - }) -} - -## Finding b and e based on stepwise increments -findbe3 <- function(sgnb = 1) -{ - function(x, y, cVal, dVal) - { - unix <- unique(x) - uniy <- tapply(y, x, mean) - lenx <- length(unix) - - j <- 2 - for (i in 2:lenx) - { - crit1 <- (uniy[i] > (cVal + dVal)/2) && (uniy[i-1] < (cVal + dVal)/2) - crit2 <- (uniy[i] < (cVal + dVal)/2) && (uniy[i-1] > (cVal + dVal)/2) - if (crit1 || crit2) break - j <- j + 1 - } - eVal <- (unix[j] + unix[j-1]) / 2 - bVal <- (sgnb) * (-sign(uniy[j] - uniy[j-1])) # -(uniy[j] - uniy[j-1]) / (unix[j] - unix[j-1]) - - return(as.vector(c(bVal, eVal))) - } -} - - -## Normolle's procedure -#findbe4 <- function(bfct, efct) -#{ -# ## Helper functions used below -# # bfct <- function(x, y, cVal, dVal, eVal) {log((dVal - y) / (y - cVal)) / log(x / eVal)} -# bFct <- function(x, y, cVal, dVal, eVal) -# { -# median(bfct(x, y, cVal, dVal, eVal), na.rm = TRUE) -# } -# # efct <- function(x, y, bVal, cVal, dVal) {x * (((dVal - y) / (y - cVal))^(-1 / bVal))} -# eFct <- function(x, y, bVal, cVal, dVal) -# { -# median(efct(x, y, bVal, cVal, dVal), na.rm = TRUE) -# } -# -# function(x, y, cVal, dVal) -# { -## initeVal <- mean(range(x)) -# bVal <- bFct(x, y, cVal, dVal, mean(range(x))) -# eVal <- eFct(x, y, bVal, cVal, dVal) -# -# return(c(bVal, eVal)) -# } -#} +## Defining functions for finding initial values of the b and e parameter + +## Finding b and e based on linear regression after logit transformation (classical approach) +#' @title Find initial parameter estimates +#' @keywords internal +findbe1 <- function(doseTr, respTr, sgnb = 1, back = exp) +{ + function(x, y, cVal, dVal) + { + lmFit <- lm(respTr(y, cVal, dVal) ~ doseTr(x)) + coefVec <- coef(lmFit) + bVal <- sgnb * coefVec[2] + eVal <- back(-coefVec[1] / (sgnb * bVal)) + + return(as.vector(c(bVal, eVal))) + } +} + +## Anke's procedure +findbe2 <- function(bfct, efct, method, sgnb = 1) +{ + ## Helper functions used below + # bfct <- function(x, y, cVal, dVal, eVal) {log((dVal - y) / (y - cVal)) / log(x / eVal)} + bFct <- function(x, y, cVal, dVal, eVal) + { + median(bfct(x, y, cVal, dVal, eVal), na.rm = TRUE) + } + # efct <- function(x, y, bVal, cVal, dVal) {x * (((dVal - y) / (y - cVal))^(-1 / bVal))} + eFct <- function(x, y, bVal, cVal, dVal) + { + median(efct(x, y, bVal, cVal, dVal), na.rm = TRUE) + } + + switch(method, + "Anke" = + function(x, y, cVal, dVal) + { + ## Finding initial value for e + midResp <- (dVal - cVal) / 2 + + ## Largest dose with all responses above + aboveVec <- x[y > midResp] + uniAbove <- unique(aboveVec) + + if (length(aboveVec) < sum(x %in% uniAbove)) + { + uniAbove <- head(uniAbove, -1) + } + maxDose <- max(x[x %in% uniAbove]) + ## Smallest dose with all responses below + belowVec <- x[y < midResp] + uniBelow <- unique(belowVec) + if (length(belowVec) < sum(x %in% uniBelow)) + { + uniBelow <- tail(uniBelow, -1) + } + minDose <- min(x[x %in% uniBelow]) + subsetInd <- (x > maxDose) & (x < minDose) + eVal <- mean((1 / (1 + (abs(y[subsetInd] - midResp)/15)^2)) * x[subsetInd]) + if (is.nan(eVal)) # in case subsetInd are all FALSE + { + eVal <- (minDose + maxDose) / 2 + } + sort1 <- sort(unique(x))[2] + if (eVal < sort1) + { + eVal <- sort1 + } + sort2 <- sort(unique(x), decreasing = TRUE)[2] + if (eVal > sort2) + { + eVal <- sort2 + } + ## Finding initial value for b + bVal <- bFct(x, y, cVal, dVal, eVal) + + ## Checking sign of b and possibly take action if it's wrong + regSlope <- as.vector(coef(lm(y ~ x)))[2] + if ((!is.na(bVal)) && ((sgnb * regSlope / bVal) > 0)) + { + eVal <- eFct(x, y, -bVal, cVal, dVal) + bVal <- bFct(x, y, cVal, dVal, eVal) + } + if (is.na(bVal)) + { + bVal <- (sgnb) * (-regSlope) + } + return(c(bVal, eVal)) + }, + "Normolle" = + function(x, y, cVal, dVal) + { + bVal <- bFct(x, y, cVal, dVal, mean(range(x))) + eVal <- eFct(x, y, bVal, cVal, dVal) + + return(c(bVal, eVal)) + }) +} + +## Finding b and e based on stepwise increments +findbe3 <- function(sgnb = 1) +{ + function(x, y, cVal, dVal) + { + unix <- unique(x) + uniy <- tapply(y, x, mean) + lenx <- length(unix) + + j <- 2 + for (i in 2:lenx) + { + crit1 <- (uniy[i] > (cVal + dVal)/2) && (uniy[i-1] < (cVal + dVal)/2) + crit2 <- (uniy[i] < (cVal + dVal)/2) && (uniy[i-1] > (cVal + dVal)/2) + if (crit1 || crit2) break + j <- j + 1 + } + eVal <- (unix[j] + unix[j-1]) / 2 + bVal <- (sgnb) * (-sign(uniy[j] - uniy[j-1])) # -(uniy[j] - uniy[j-1]) / (unix[j] - unix[j-1]) + + return(as.vector(c(bVal, eVal))) + } +} + + + diff --git a/R/findcd.r b/R/findcd.R similarity index 57% rename from R/findcd.r rename to R/findcd.R index 53ad2145..33174d1c 100644 --- a/R/findcd.r +++ b/R/findcd.R @@ -1,9 +1,9 @@ -"findcd" <- function(x, y, scaleInc = 0.001) -{ - yRange <- range(y) - lenyRange <- scaleInc * diff(yRange) -# cVal <- yRange[1] - lenyRange # the c parameter -# dVal <- yRange[2] + lenyRange # the d parameter - - c(yRange[1] - lenyRange, yRange[2] + lenyRange) +#' @title Find c and d parameters +#' @keywords internal +"findcd" <- function(x, y, scaleInc = 0.001) +{ + yRange <- range(y) + lenyRange <- scaleInc * diff(yRange) + + c(yRange[1] - lenyRange, yRange[2] + lenyRange) } \ No newline at end of file diff --git a/R/fitted.drc.R b/R/fitted.drc.R index 550a83cb..0207ebb5 100644 --- a/R/fitted.drc.R +++ b/R/fitted.drc.R @@ -1,12 +1,22 @@ +#' @title Extract fitted values from model +#' +#' @description +#' Extracts fitted values from an object of class 'drc'. +#' +#' @param object an object of class 'drc'. +#' @param ... additional arguments. +#' +#' @return Fitted values extracted from \code{object}. +#' +#' @examples +#' ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +#' plot(fitted(ryegrass.m1), residuals(ryegrass.m1)) # a residual plot +#' +#' @author Christian Ritz +#' +#' @keywords models nonlinear "fitted.drc" <- function(object, ...) { -# if (missing(...)) -# { -# return(object$"predres"[, 1]) -# } else { -# predict(object, ...) -# } predict(object, ...) -## return(object$"predres"[, 1]) } diff --git a/R/fplogistic.R b/R/fplogistic.R index c70626d0..a40c325c 100644 --- a/R/fplogistic.R +++ b/R/fplogistic.R @@ -1,3 +1,37 @@ +#' @title Fractional polynomial-logistic dose-response model +#' +#' @description +#' Model function for specifying dose-response models that are a combination of a logistic model +#' and an appropriate class of fractional polynomials. +#' +#' @param p1 numeric denoting the negative power of log(dose+1) in the fractional polynomial. +#' @param p2 numeric denoting the positive power of log(dose+1) in the fractional polynomial. +#' @param fixed numeric vector. Specifies which parameters are fixed and at what value they are fixed. +#' NAs for parameters that are not fixed. +#' @param names a vector of character strings giving the names of the parameters (should not contain ":"). +#' The order of the parameters is: b, c, d, e. +#' @param method character string indicating the self starter function to use. +#' @param ssfct a self starter function to be used. +#' @param fctName optional character string used internally by convenience functions. +#' @param fctText optional character string used internally by convenience functions. +#' +#' @details +#' The fractional polynomial dose-response models introduced by Namata et al. (2008) are implemented +#' using the logistic model as base. +#' +#' @return A list containing the nonlinear function, the self starter function +#' and the parameter names. +#' +#' @references +#' Namata, Harriet and Aerts, Marc and Faes, Christel and Teunis, Peter (2008) +#' Model Averaging in Microbial Risk Assessment Using Fractional Polynomials, +#' \emph{Risk Analysis} \bold{28}, 891--905. +#' +#' @author Christian Ritz +#' +#' @seealso \code{\link{FPL.4}}, \code{\link{maED}}, \code{\link{drm}} +#' +#' @keywords models nonlinear "fplogistic" <- function( p1, p2, fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), method = c("1", "2", "3", "4"), ssfct = NULL, @@ -112,37 +146,36 @@ fctName, fctText) invfp(log((100-p)/p), b, e) } -# ## deriv(~b*(log(dose+1)^p1) + e*(log(dose+1)^p2), c("b", "c", "d", "e"), function(dose, b,c,d,e){}) -# ## note: c and d parameters need not be included -# derfp <- function (dose, b, c, d, e) -# { -# .expr2 <- log(dose + 1) -# .expr3 <- .expr2^p1 -# .expr5 <- .expr2^p2 -# .value <- b * .expr3 + e * .expr5 -# .grad <- array(0, c(length(.value), 4L), list(NULL, c("b", "c", "d", "e"))) -# .grad[, "b"] <- .expr3 -# .grad[, "c"] <- 0 -# .grad[, "d"] <- 0 -# .grad[, "e"] <- .expr5 -# attr(.value, "gradient") <- .grad -# .value -# } - EDp <- EDfct(parmVec[1], parmVec[2], parmVec[3], parmVec[4]) logEDp <- log(EDp+1) denVal <- parmVec[1] * p1 * (logEDp)^(p1-1) + parmVec[4] * p2 * (logEDp)^(p2-1) derVec <- (EDp+1) * c(logEDp^p1, logEDp^p2) / denVal EDder <- c(derVec[1], 0, 0, derVec[2]) + + ## Fix: correct c and d derivatives for absolute type using central differences. + ## The analytical derivatives above miss the chain-rule contribution from + ## the absolute-to-relative conversion (EDhelper2), where p depends on c and d. + if (identical(type, "absolute")) { + .edval <- function(pv) { + p0 <- EDhelper2(pv, respl, reference, type, pv[1] > 0) + invfp(log((100 - p0) / p0), pv[1], pv[4]) + } + .eps <- .Machine$double.eps + for (.i in c(2, 3)) { + .h <- if (abs(parmVec[.i]) > sqrt(.eps)) abs(parmVec[.i]) * .eps^(1/3) else .eps^(1/3) + .pvUp <- replace(parmVec, .i, parmVec[.i] + .h) + .pvDn <- replace(parmVec, .i, parmVec[.i] - .h) + EDder[.i] <- (.edval(.pvUp) - .edval(.pvDn)) / (2 * .h) + } + } + if (loged) { EDder <- EDder / EDp EDp <- log(EDp) } -# EDder <- 1 / attr(derfp(EDp, parmVec[1], parmVec[2], parmVec[3], parmVec[4]), "gradient") -# EDder <- c(EDder[1], 0, 0, EDder[4]) return(list(EDp, EDder[notFixed])) } @@ -158,6 +191,22 @@ fctName, fctText) invisible(returnList) } +#' @title Four-parameter fractional polynomial-logistic model +#' +#' @description +#' Convenience function for the four-parameter fractional polynomial-logistic model. +#' +#' @param p1 numeric denoting the negative power of log(dose+1) in the fractional polynomial. +#' @param p2 numeric denoting the positive power of log(dose+1) in the fractional polynomial. +#' @param fixed numeric vector of length 4 specifying fixed parameters (NAs for free parameters). +#' @param names character vector of parameter names. +#' @param ... additional arguments passed to \code{\link{fplogistic}}. +#' +#' @return A list (see \code{\link{fplogistic}}). +#' +#' @seealso \code{\link{fplogistic}}, \code{\link{maED}} +#' +#' @keywords models nonlinear "FPL.4" <- function(p1, p2, fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) { diff --git a/R/gammadr.r b/R/gammadr.R similarity index 67% rename from R/gammadr.r rename to R/gammadr.R index 9313cd8a..4ec3c514 100644 --- a/R/gammadr.r +++ b/R/gammadr.R @@ -1,3 +1,29 @@ +#' Gamma Dose-Response Model +#' +#' A four-parameter dose-response model derived from the cumulative distribution +#' function of the gamma distribution. Only suitable for increasing dose-response data. +#' +#' Following Wheeler and Bailer (2009) the model function is: +#' +#' \deqn{f(x) = c + (d-c) \cdot \mathrm{pgamma}(b \cdot x, e, 1)} +#' +#' @param fixed numeric vector specifying which parameters are fixed and at what value +#' they are fixed. NAs are used for parameters that are not fixed. +#' @param names a vector of character strings giving the names of the parameters +#' (should not contain ":"). The default is reasonable. +#' @param fctName optional character string used internally by convenience functions. +#' @param fctText optional character string used internally by convenience functions. +#' +#' @return A list containing the nonlinear function, the self starter function, +#' and the parameter names. +#' +#' @references Wheeler, M. W., Bailer, A. J. (2009) +#' Comparing model averaging with other model selection strategies for benchmark +#' dose estimation, \emph{Environmental and Ecological Statistics}, \bold{16}, 37--51. +#' +#' @author Christian Ritz +#' +#' @keywords models nonlinear "gammadr" <- function( fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), fctName, fctText) @@ -19,7 +45,6 @@ fctName, fctText) parmMat[, notFixed] <- parm cParm <- parmMat[, 2] -# cParm + (parmMat[, 3] - cParm)/((1+exp(parmMat[, 1]*(log(dose)-log(parmMat[, 4]))))^parmMat[, 5]) cParm + (parmMat[, 3] - cParm) * pgamma(parmMat[, 1] * dose, parmMat[, 4], 1) } @@ -40,7 +65,6 @@ fctName, fctText) for (i in 1:lenX) { intFct <- function(t){dgamma(t, y[i], 1) * log(t)} -# print(ifelse(x[i] < 1e-10, 0, integrate(intFct, 0, x[i])[[1]])) retVec[i] <- ifelse(x[i] < 1e-10, 0, integrate(intFct, 0, x[i])[[1]]) } retVec @@ -55,11 +79,10 @@ fctName, fctText) t2 <- pgamma(parmMat[, 1] * dose, parmMat[, 4], 1) cbind( - t1 * dgamma(parmMat[, 1] * dose, parmMat[, 4], 1) * parmMat[, 1], + t1 * dgamma(parmMat[, 1] * dose, parmMat[, 4], 1) * dose, 1 - t2, t2, t1 * logGamma(parmMat[, 1] * dose, parmMat[, 4]) -# t1 * (parmMat[, 4] - 1) * pgamma(parmMat[, 1] * dose, parmMat[, 4] - 1, 1) )[, notFixed] } deriv2 <- NULL diff --git a/R/gaussian.r b/R/gaussian.R similarity index 68% rename from R/gaussian.r rename to R/gaussian.R index 90cf4601..3201ea5d 100644 --- a/R/gaussian.r +++ b/R/gaussian.R @@ -1,3 +1,28 @@ +#' @title Normal (Gaussian) biphasic dose-response model +#' +#' @description +#' Model function for fitting symmetric or skewed bell-shaped/biphasic dose-response patterns +#' using the Gaussian (normal distribution) model. +#' +#' @param fixed numeric vector. Specifies which parameters are fixed and at what value they are fixed. +#' NAs for parameters that are not fixed. +#' @param names a vector of character strings giving the names of the parameters (should not contain ":"). +#' The order of the parameters is: b, c, d, e, f. +#' @param method character string indicating the self starter function to use. +#' @param ssfct a self starter function to be used. +#' @param fctName optional character string used internally by convenience functions. +#' @param fctText optional character string used internally by convenience functions. +#' @param loge logical indicating whether or not e or log(e) should be a parameter in the model. +#' By default e is a model parameter. +#' +#' @return The value returned is a list containing the nonlinear function, the self starter function +#' and the parameter names. +#' +#' @author Christian Ritz +#' +#' @seealso \code{\link{lgaussian}}, \code{\link{drm}} +#' +#' @keywords models nonlinear "gaussian" <- function( fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), method = c("1", "2", "3", "4"), ssfct = NULL, @@ -14,8 +39,6 @@ fctName, fctText, loge = FALSE) parmVec[!notFixed] <- fixed[!notFixed] ## Mean function and first derivative -# y0+a*exp(-0.5*abs((x-x0)/b)^c) - ## deriv(~c+(d-c)*exp(-0.5 * ((dose-e)/b)^f), c("b", "c", "d", "e", "f"), function(dose, b,c,d,e,f){}) ## deriv(~c+(d-c)*exp(-0.5 * (sqrt(((dose-e)/b)^2))^f), c("b", "c", "d", "e", "f"), function(dose, b,c,d,e,f){}) fd <- function (dose, b, c, d, e, f) @@ -96,16 +119,6 @@ fctName, fctText, loge = FALSE) edfct <- function(parm, respl, reference, type, ...) { parmVec[notFixed] <- parm -# if (type == "absolute") -# { -# p <- 100*((parmVec[3] - respl)/(parmVec[3] - parmVec[2])) -# } else { -# p <- respl -# } -# if ( (parmVec[1] < 0) && (reference == "control") ) -# { -# p <- 100 - p -# } p <- absToRel(parmVec, abs(respl), type) ## Reversing p @@ -121,10 +134,9 @@ fctName, fctText, loge = FALSE) pProp <- 1 - (100-p) / 100 ## deriv(~b*(-2*22)^(1 / f)+e, c("b", "c", "d", "e", "f"), function(b,c,d,e,f){}) - ## using "22" insted of log(pProp) + ## using "22" instead of log(pProp) EDfct <- function (b, c, d, e, f) { -# .expr2 <- -2 * 22 .expr2 <- -2 * log(pProp) .expr4 <- sign(respl) * .expr2^(1/f) .value <- b * .expr4 + e @@ -157,65 +169,4 @@ fctName, fctText, loge = FALSE) class(returnList) <- "gaussian" invisible(returnList) -} - - -if (FALSE) -{ - -"LN.2" <- -function(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) -{ - ## Checking arguments - numParm <- 2 - if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct 'names' argument")} - if (!(length(fixed)==numParm)) {stop("Not correct length of 'fixed' argument")} - - return( lnormal(fixed = c(fixed[1], 0, upper, fixed[2]), - names = c(names[1], "c", "d", names[2]), - fctName = as.character(match.call()[[1]]), - fctText = lowupFixed("Log-normal", upper), ...) ) -} - -"LN.3" <- -function(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) -{ - ## Checking arguments - numParm <- 3 - if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct 'names' argument")} - if (!(length(fixed)==numParm)) {stop("Not correct length of 'fixed' argument")} - - return( lnormal(fixed = c(fixed[1], 0, fixed[2:3]), - names = c(names[1], "c", names[2:3]), - fctName = as.character(match.call()[[1]]), - fctText = lowFixed("Log-normal"), ...) ) -} - -"LN.3u" <- -function(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...) -{ - ## Checking arguments - numParm <- 3 - if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct 'names' argument")} - if (!(length(fixed)==numParm)) {stop("Not correct length of 'fixed' argument")} - - return( lnormal(fixed = c(fixed[1:2], upper, fixed[3]), - names = c(names[1:2], "d", names[3]), - fctName = as.character(match.call()[[1]]), - fctText = upFixed("Log-normal", upper), - ...) ) -} - -"LN.4" <- -function(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) -{ - ## Checking arguments - numParm <- 4 - if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct names argument")} - if (!(length(fixed)==numParm)) {stop("Not correct length of 'fixed' argument")} - - return( lnormal(fixed = fixed, names = names, - fctName = as.character(match.call()[[1]]), ...) ) -} - } \ No newline at end of file diff --git a/R/gaussian.ssf.R b/R/gaussian.ssf.R index c9dcf64a..530d5c2e 100644 --- a/R/gaussian.ssf.R +++ b/R/gaussian.ssf.R @@ -1,26 +1,28 @@ -"gaussian.ssf" <- function(method = c("1", "2", "3", "4"), fixed, logg = FALSE, useFixed = FALSE) -{ - method <- match.arg(method) - - function(dframe) - { - x <- dframe[, 1] - y <- dframe[, 2] - - ## Finding initial values for c and d parameters - cdVal <- findcd(x, y) - if (useFixed) {} # not implemented at the moment - - ## Finding initial values for b, e, and f parameters - if (logg) - { - bVal <- 0.75 * sd(log(x[y > quantile(y, .75)])) - } else { - bVal <- 0.75 * sd(x[y > quantile(y, .75)]) - } - befVal <- c(bVal, x[which.max(y)], 1) -# befVal <- c(sd(x), mean(x), 1) - - return(c(befVal[1], cdVal, befVal[2:3])[is.na(fixed)]) - } +#' @title Self-starter for Gaussian model +#' @keywords internal +"gaussian.ssf" <- function(method = c("1", "2", "3", "4"), fixed, logg = FALSE, useFixed = FALSE) +{ + method <- match.arg(method) + + function(dframe) + { + x <- dframe[, 1] + y <- dframe[, 2] + + ## Finding initial values for c and d parameters + cdVal <- findcd(x, y) + if (useFixed) {} # not implemented at the moment + + ## Finding initial values for b, e, and f parameters + if (logg) + { + bVal <- 0.75 * sd(log(x[y > quantile(y, .75)])) + } else { + bVal <- 0.75 * sd(x[y > quantile(y, .75)]) + } + befVal <- c(bVal, x[which.max(y)], 1) +# befVal <- c(sd(x), mean(x), 1) + + return(c(befVal[1], cdVal, befVal[2:3])[is.na(fixed)]) + } } \ No newline at end of file diff --git a/R/genRetFct.R b/R/genRetFct.R deleted file mode 100644 index 36207a04..00000000 --- a/R/genRetFct.R +++ /dev/null @@ -1,17 +0,0 @@ -"genRetFct" <- function(fct, parmVec, notFixed) -{ -# ## Defining the model function adjusted for scaling -# retFct <- function(doseScaling, respScaling, lenData) -# { -# parmMat <- matrix(parmVec / c(1, respScaling, respScaling, doseScaling, 1), lenData, numParm, byrow = TRUE) -# -# fct <- function(dose, parm) -# { -# parmMat[, notFixed] <- parm -# cParm <- parmMat[, 2] -# cParm + (parmMat[, 3] - cParm)/((1+exp(parmMat[, 1]*(log(dose/parmMat[, 4]))))^parmMat[, 5]) -# } -# fct -# } -# retFct -} \ No newline at end of file diff --git a/R/getInitial.R b/R/getInitial.R index d4f0ec56..bf5b089b 100644 --- a/R/getInitial.R +++ b/R/getInitial.R @@ -1,3 +1,17 @@ +#' Showing starting values used +#' +#' Returns the starting values of the model parameters used when fitting a dose-response model. +#' +#' @param object object of class 'drc'. +#' +#' @return A vector of starting values for the model parameters used to initialize the +#' estimation procedure. +#' +#' @author Christian Ritz +#' +#' @note This function is masking the standard function in the stats package. +#' +#' @keywords models nonlinear "getInitial" <- function(object) { initval <- object$"start" diff --git a/R/getMeanFunctions.R b/R/getMeanFunctions.R index 0984656e..7801b505 100644 --- a/R/getMeanFunctions.R +++ b/R/getMeanFunctions.R @@ -1,3 +1,34 @@ +#' Display available dose-response models +#' +#' Display information about available, built-in dose-response models. +#' The arguments \code{noParm} and \code{fname} can be combined. +#' +#' @param noParm numeric specifying the number of parameters of the models to be displayed. +#' The default (NA) results in display of all models, regardless of number of parameters. +#' @param fname character string or vector of character strings specifying the short name(s) +#' of the models to be displayed (need to match exactly). +#' @param flist list of built-in functions to be displayed. +#' @param display logical indicating whether or not the requested models should be displayed +#' on the R console. +#' +#' @return An invisible list of functions or a list of strings with brief function descriptions. +#' +#' @author Christian Ritz +#' +#' @examples +#' ## Listing all functions +#' getMeanFunctions() +#' +#' ## Listing all functions with 4 parameters +#' getMeanFunctions(4) +#' +#' ## Listing all (log-)logistic functions +#' getMeanFunctions(fname = "L") +#' +#' ## Listing all three-parameter (log-)logistic or Weibull functions +#' getMeanFunctions(3, fname = c("LL", "W")) +#' +#' @keywords models nonlinear "getMeanFunctions" <- function(noParm = NA, fname = NULL, flist = NULL, display = TRUE) { if (is.null(flist)) @@ -10,47 +41,28 @@ LL2.2(), LL2.3(), LL2.3u(), LL2.4(), LL2.5(), AR.2(), AR.3(), MM.2(), MM.3() -# baro5(), -# boltzmann(), -# CRS.4a(), CRS.4b(), CRS.4c(), # cedergreen(alpha = 1) -# CRS.6(), expDecay(), gompertzd(), -# L.3(), L.4(), L.5(), -# richards(), -# UCRS.4a(), UCRS.4b(), UCRS.4c(), UCRS.5a(), UCRS.5b(), UCRS.5c(), # ucedergreen(alpha = 1), ) } else { fctList <- flist } -# grepFct <- function(x){grep(x, "Weibull")} textVec <- NULL lapFct <- function(x) {c(x$"name", x$"text")} if (!is.null(fname)) { - textVec <- fname - sapFct <- function(x, object){grep(x, object$"name", fixed = TRUE)} + textVec <- fname } -# if (!is.null(ftext)) -# { -# textVec <- ftext -# lapFct <- function(x) {x$"text"} -# sapFct <- function(x, object){grep(x, object$"text", fixed = TRUE)} -# } displayFunction <- function(object) { -# && (is.null(ftext) || (length(grep(ftext, object$"text")) > 0)) ) if ( ((is.na(noParm)) || (noParm == object$"noParm")) && (is.null(textVec) || (any(textVec %in% object$"name"))) ) -# && (is.null(textVec) || (sum(unlist(sapply(textVec, sapFct, object = object))) > 0)) ) { if (display) { cat(object$"text", "\n") cat(paste("(", object$"noParm", " parameters)", sep = ""), "\n") -# cat("Equation: ", object$"equation", "\n") # duplicate with help page ... skip -# cat("Reference:", object$"reference", "\n") # duplicate with help page ... skip cat("In 'drc': ", object$"name", "\n\n") } return(object) @@ -74,15 +86,8 @@ if (!is.null(textVec) || !is.na(noParm)) { -# invisible(lapply(fctList, displayFunction)) invisible(lapList2) } else { invisible(lapply(lapList2, lapFct)) } } - - -#"getDatasets" <- function() -#{ -# data(package = "drc") -#} diff --git a/R/gompertz.r b/R/gompertz.R similarity index 59% rename from R/gompertz.r rename to R/gompertz.R index 787b96fb..ab4c6e8f 100644 --- a/R/gompertz.r +++ b/R/gompertz.R @@ -1,3 +1,35 @@ +#' @title Gompertz dose-response or growth curve model +#' +#' @description +#' Provides a very general way of specifying the mean function of the decreasing or increasing +#' Gompertz dose-response or growth curve models. +#' +#' @param fixed numeric vector. Specifies which parameters are fixed and at what value they are fixed. +#' NAs for parameters that are not fixed. +#' @param names vector of character strings giving the names of the parameters (should not contain ":"). +#' The order of the parameters is: b, c, d, e. +#' @param method character string indicating the self starter function to use. +#' @param ssfct a self starter function to be used. +#' @param fctName optional character string used internally by convenience functions. +#' @param fctText optional character string used internally by convenience functions. +#' +#' @details +#' The Gompertz model is given by the mean function +#' \deqn{f(x) = c + (d-c)(\exp(-\exp(b(x-e))))} +#' +#' If \eqn{b<0} the mean function is increasing; it is decreasing for \eqn{b>0}. +#' +#' @return A list containing the non-linear function, the self starter function +#' and the parameter names. +#' +#' @references +#' Seber, G. A. F. and Wild, C. J. (1989) \emph{Nonlinear Regression}, New York: Wiley & Sons (p. 331). +#' +#' @author Christian Ritz +#' +#' @seealso The Weibull model \code{\link{weibull2}} is closely related to the Gompertz model. +#' +#' @keywords models nonlinear "gompertz" <- function( fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), method = c("1", "2", "3", "4"), ssfct = NULL, @@ -37,43 +69,10 @@ fctName, fctText) parmMat <- matrix(parmVec, nrow(parm), numParm, byrow=TRUE) parmMat[, notFixed] <- parm -# parmMat[,2] + (parmMat[,3] - parmMat[,2]) * exp(-exp(parmMat[,1] *(dose - parmMat[,4]))) fd(dose, parmMat[, 1], parmMat[, 2], parmMat[, 3], parmMat[, 4]) } ## Defining self starter function -if (FALSE) -{ - ssfct <- function(dframe) - { - x <- dframe[, 1] - y <- dframe[, 2] - - cVal <- ifelse(notFixed[2], 0.99*min(y), fixed[2]) - dVal <- ifelse(notFixed[3], 1.01*max(y), fixed[3]) - - ## Finding b and e based on linear regression - findbe <- function(x, y, - transx = function(x){x}, - transy = function(y) {log(-log((dVal-y)/(dVal-cVal)))}) - { - transY <- transy(y) - transX <- transx(x) - - lmFit <- lm(transY ~ transX) - coefVec <- coef(lmFit) -# bVal <- coefVec[2] - bVal <- ifelse(notFixed[1], coefVec[2], fixed[1]) -# eVal <- -coefVec[1] / bVal - eVal <- ifelse(notFixed[4], -coefVec[1] / bVal, fixed[4]) - - return(as.vector(c(bVal, eVal))) - } - beVec <- findbe(x, y) - - c(beVec[1], cVal, dVal, beVec[2])[notFixed] - } -} if (!is.null(ssfct)) { ssfct <- ssfct @@ -144,6 +143,21 @@ if (FALSE) invisible(returnList) } +#' @title Two-parameter Gompertz model +#' +#' @description +#' Convenience function for the Gompertz model with lower limit fixed at 0 and upper limit fixed. +#' +#' @param upper numeric specifying the fixed upper horizontal asymptote. Default is 1. +#' @param fixed numeric vector of length 2 specifying fixed parameters (NAs for free parameters). +#' @param names character vector of parameter names. +#' @param ... additional arguments passed to \code{\link{gompertz}}. +#' +#' @return A list (see \code{\link{gompertz}}). +#' +#' @seealso \code{\link{gompertz}}, \code{\link{G.3}}, \code{\link{G.4}} +#' +#' @keywords models nonlinear "G.2" <- function(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) { @@ -158,6 +172,20 @@ function(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) fctText = lowupFixed("Gompertz", upper), ...)) } +#' @title Three-parameter Gompertz model +#' +#' @description +#' Convenience function for the Gompertz model with the lower limit fixed at 0. +#' +#' @param fixed numeric vector of length 3 specifying fixed parameters (NAs for free parameters). +#' @param names character vector of parameter names. +#' @param ... additional arguments passed to \code{\link{gompertz}}. +#' +#' @return A list (see \code{\link{gompertz}}). +#' +#' @seealso \code{\link{gompertz}}, \code{\link{G.2}}, \code{\link{G.4}} +#' +#' @keywords models nonlinear "G.3" <- function(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) { @@ -172,6 +200,21 @@ function(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) fctText = lowFixed("Gompertz"), ...)) } +#' @title Three-parameter Gompertz model with upper limit fixed +#' +#' @description +#' Convenience function for the Gompertz model with the upper limit fixed. +#' +#' @param upper numeric specifying the fixed upper horizontal asymptote. Default is 1. +#' @param fixed numeric vector of length 3 specifying fixed parameters (NAs for free parameters). +#' @param names character vector of parameter names. +#' @param ... additional arguments passed to \code{\link{gompertz}}. +#' +#' @return A list (see \code{\link{gompertz}}). +#' +#' @seealso \code{\link{gompertz}}, \code{\link{G.2}}, \code{\link{G.3}}, \code{\link{G.4}} +#' +#' @keywords models nonlinear "G.3u" <- function(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...) { @@ -186,6 +229,20 @@ function(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...) fctText = upFixed("Gompertz", upper), ...)) } +#' @title Four-parameter Gompertz model +#' +#' @description +#' Convenience function for the full four-parameter Gompertz model. +#' +#' @param fixed numeric vector of length 4 specifying fixed parameters (NAs for free parameters). +#' @param names character vector of parameter names. +#' @param ... additional arguments passed to \code{\link{gompertz}}. +#' +#' @return A list (see \code{\link{gompertz}}). +#' +#' @seealso \code{\link{gompertz}}, \code{\link{G.2}}, \code{\link{G.3}} +#' +#' @keywords models nonlinear "G.4" <- function(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) { diff --git a/R/gompertz.ssf.R b/R/gompertz.ssf.R index 4e88d1ca..bd8b73a6 100644 --- a/R/gompertz.ssf.R +++ b/R/gompertz.ssf.R @@ -1,31 +1,33 @@ -"gompertz.ssf" <- function(method = c("1", "2", "3", "4"), fixed, useFixed = FALSE) -{ - method <- match.arg(method) - - ## Defining helper functions (used below) - ytrans <- function(y, cVal, dVal) {log(-log((dVal - y)/(dVal - cVal)))} - bfct <- function(x, y, cVal, dVal, eVal) {ytrans(y, cVal, dVal) / (x - eVal)} - efct <- function(x, y, bVal, cVal, dVal) {x - ytrans(y, cVal, dVal) / bVal} - - ## Assigning function for finding initial b and e parameter values - findbe <- switch(method, - "1" = findbe1(function(x){x}, ytrans, back = I), - "2" = findbe2(bfct, efct, "Anke"), - "3" = findbe3(), - "4" = findbe2(bfct, efct, "Normolle")) - - function(dframe) - { - x <- dframe[, 1] - y <- dframe[, 2] - - ## Finding initial values for the c and d parameters - cdVal <- findcd(x, y) - if (useFixed) {} # not implemented at the moment - - ## Finding initial values for the b and e parameters - beVal <- findbe(x, y, cdVal[1], cdVal[2]) - - return(c( (-1) * beVal[1], cdVal * c(0.8, 1.2), beVal[2])[is.na(fixed)]) - } +#' @title Self-starter for Gompertz model +#' @keywords internal +"gompertz.ssf" <- function(method = c("1", "2", "3", "4"), fixed, useFixed = FALSE) +{ + method <- match.arg(method) + + ## Defining helper functions (used below) + ytrans <- function(y, cVal, dVal) {log(-log((dVal - y)/(dVal - cVal)))} + bfct <- function(x, y, cVal, dVal, eVal) {ytrans(y, cVal, dVal) / (x - eVal)} + efct <- function(x, y, bVal, cVal, dVal) {x - ytrans(y, cVal, dVal) / bVal} + + ## Assigning function for finding initial b and e parameter values + findbe <- switch(method, + "1" = findbe1(function(x){x}, ytrans, back = I), + "2" = findbe2(bfct, efct, "Anke"), + "3" = findbe3(), + "4" = findbe2(bfct, efct, "Normolle")) + + function(dframe) + { + x <- dframe[, 1] + y <- dframe[, 2] + + ## Finding initial values for the c and d parameters + cdVal <- findcd(x, y) + if (useFixed) {} # not implemented at the moment + + ## Finding initial values for the b and e parameters + beVal <- findbe(x, y, cdVal[1], cdVal[2]) + + return(c( (-1) * beVal[1], cdVal * c(0.8, 1.2), beVal[2])[is.na(fixed)]) + } } \ No newline at end of file diff --git a/R/gompertzd.R b/R/gompertzd.R index 56d8051d..52aec4ad 100644 --- a/R/gompertzd.R +++ b/R/gompertzd.R @@ -1,3 +1,28 @@ +#' @title Derivative of the Gompertz function +#' +#' @description +#' \code{gompertzd} provides a way of specifying the derivative of the Gompertz function +#' as a dose-response model. +#' +#' @param fixed numeric vector. Specifies which parameters are fixed and at what value they are fixed. +#' NAs for parameters that are not fixed. +#' @param names a vector of character strings giving the names of the parameters (should not contain ":"). +#' The default is (notice the order): a, b. +#' +#' @details +#' The derivative of the Gompertz function is defined as +#' \deqn{f(x) = a \exp(bx-a/b(\exp(bx)-1))} +#' For \eqn{a>0} and \eqn{b} not 0, the function is decreasing, equaling \eqn{a} at \eqn{x=0} +#' and approaching 0 at plus infinity. +#' +#' @return A list containing the model function, the self starter function +#' and the parameter names. +#' +#' @author Christian Ritz +#' +#' @seealso \code{\link{gompertz}}, \code{\link{drm}} +#' +#' @keywords models nonlinear "gompertzd" <- function( fixed = c(NA, NA), names = c("a", "b")) { diff --git a/R/hatvalues.drc.R b/R/hatvalues.drc.R index d26fb78f..802463a1 100644 --- a/R/hatvalues.drc.R +++ b/R/hatvalues.drc.R @@ -1,3 +1,37 @@ +#' @title Model diagnostics for nonlinear dose-response models +#' +#' @description +#' Hat values (leverage values) are provided for nonlinear dose-response model fits using the +#' same formulas as in linear regression but based on the corresponding approximate quantities +#' available for nonlinear models. +#' +#' @param model an object of class 'drc'. +#' @param ... additional arguments (not used). +#' +#' @details +#' Hat values are calculated using the formula given by Cook et al. (1986) and +#' McCullagh and Nelder (1989). The output values can be assessed in the same way as +#' in linear regression. +#' +#' @return A vector of leverage values (hat values), one value per observation. +#' +#' @references +#' Cook, R. D. and Tsai, C.-L. and Wei, B. C. (1986) +#' Bias in Nonlinear Regression, +#' \emph{Biometrika} \bold{73}, 615--623. +#' +#' McCullagh, P. and Nelder, J. A. (1989) +#' \emph{Generalized Linear Models}, +#' Second edition, Chapman & Hall/CRC. +#' +#' @author Christian Ritz +#' +#' @examples +#' ryegrass.LL.4 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +#' +#' hatvalues(ryegrass.LL.4) +#' +#' @keywords models nonlinear hatvalues.drc <- function(model, ...) { xmat <- model$der diff --git a/R/hewlett.r b/R/hewlett.R similarity index 57% rename from R/hewlett.r rename to R/hewlett.R index cd818688..aac9924f 100644 --- a/R/hewlett.r +++ b/R/hewlett.R @@ -1,3 +1,24 @@ +#' Hewlett Mixture Model +#' +#' Provides the Hewlett model for describing the joint action of two compounds +#' in binary mixture experiments. Used internally by \code{\link{mixture}}. +#' +#' @param fixed numeric vector. Specifies which parameters are fixed and at what value +#' they are fixed. NAs for parameters that are not fixed. +#' @param names a vector of character strings giving the names of the parameters +#' (should not contain ":"). +#' @param method character string indicating the self starter function to use. +#' @param ssfct a self starter function to be used (optional). +#' @param eps numeric tolerance for handling zero dose values. +#' +#' @return A list containing the nonlinear model function, the self starter function, +#' and the parameter names. +#' +#' @author Christian Ritz +#' +#' @seealso \code{\link{mixture}}, \code{\link{voelund}} +#' +#' @keywords internal "hewlett" <- function( fixed = c(NA, NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f", "g"), method = c("1", "2", "3", "4"), ssfct = NULL, @@ -23,10 +44,8 @@ eps = 1e-10 parmMat[, notFixed] <- parm loge <- -parmMat[, 6] * log((1/parmMat[, 4])^(1/parmMat[, 6]) + (1/parmMat[, 5])^(1/parmMat[, 6])) -# loge <- -parm[, 6]*log((1/parm[, 4])^(1/parm[, 6]) + (1/parm[, 5])^(1/parm[, 6])) -## old loge <- -parm[, 6]*log((parm[, 4])^(1/parm[, 6]) + (parm[, 5])^(1/parm[, 6])) - retVec <- parmMat[, 2] + (parmMat[, 3] - parmMat[, 2]) / (1 + exp(parmMat[, 1] * (log(dose) - loge))) + retVec<- parmMat[, 2] + (parmMat[, 3] - parmMat[, 2]) / (1 + exp(parmMat[, 1] * (log(dose) - loge))) ## Handling the case dose=0 where "loge" may become NaN due to the mixture encoding (pct in glymet) zeroInd <- dose < eps retVec[zeroInd] <- ifelse(parmMat[zeroInd, 1] < 0, parmMat[zeroInd, 2], parmMat[zeroInd, 3]) @@ -34,38 +53,6 @@ eps = 1e-10 } ## Defining self starter function -if (FALSE) -{ - ssfct <- function(dataFra) - { - dose2 <- dataFra[,1] - resp3 <- dataFra[,2] - - startVal <- rep(0, numParm) - - startVal[3] <- max(resp3)+0.001 # the d parameter - startVal[2] <- min(resp3)-0.001 # the c parameter - startVal[5] <- 1 # better choice may be possible! -# startVal[!notFixed] <- fixed[!notFixed] - - if (length(unique(dose2))==1) {return((c(NA, NA, startVal[3], NA, NA))[notFixed])} # only estimate of upper limit if a single unique dose value - - indexT2 <- (dose2>0) - if (!any(indexT2)) {return((rep(NA, numParm))[notFixed])} # for negative dose value - dose3 <- dose2[indexT2] - resp3 <- resp3[indexT2] - - logitTrans <- log((startVal[3]-resp3)/(resp3-startVal[2]+0.001)) # 0.001 to avoid 0 in the denominator - logitFit <- lm(logitTrans~log(dose3)) - startVal[4] <- exp((-coef(logitFit)[1]/coef(logitFit)[2])) # the e parameter - startVal[1] <- coef(logitFit)[2] # the b parameter - - startVal[5] <- startVal[4] - startVal[6] <- 1 - - return(startVal[notFixed]) - } -} if (!is.null(ssfct)) { ssfct <- ssfct diff --git a/R/iband.r b/R/iband.r deleted file mode 100644 index 270c67b3..00000000 --- a/R/iband.r +++ /dev/null @@ -1,19 +0,0 @@ -"iband" <- function(object) -{ - -if (FALSE) -{ - -## Defining a vector of a fine grid of concentrations -concVec<- with(ryegrass, seq(min(conc), max(conc), length.out=150)) - -## Calculating predicted values including confidence intervals -predictMatrix<-predict(ryegrass.m1, newdata = data.frame(conc = concVec), -interval="confidence") - -## Adding confidence limits to the plot -plot(ryegrass.m1, broken = TRUE) -lines(concVec, predictMatrix[, 2], lty = 2) -lines(concVec, predictMatrix[, 3], lty = 2) -} -} \ No newline at end of file diff --git a/R/idrm.r b/R/idrm.R similarity index 77% rename from R/idrm.r rename to R/idrm.R index d414a938..0d3126b6 100644 --- a/R/idrm.r +++ b/R/idrm.R @@ -1,126 +1,93 @@ -"idrm" <- function(x, y, curveid, weights, fct, type, control) -{ - oneFunction <- !is.list(fct[[1]]) - - ## Fitting models for each curve - fitList <- list() - uniCur <- unique(curveid) - numCur <- length(uniCur) - for (i in 1:numCur) - { - if (oneFunction) - { - fitList[[i]] <- drm(y~x, curveid, weights = weights, fct = fct, type = type, - subset = curveid == uniCur[i], separate = FALSE, control = control) - } else { - tempFitlist <- list() - for (j in 1:length(fct)) - { - tempFitlist[[j]] <- drm(y~x, curveid, weights = weights, fct = fct[[j]], - type = type, subset = curveid == uniCur[i], separate = FALSE, control = control) - } - fitList[[i]] <- tempFitlist - } - } - - retList <- fitList[[1]] - if (oneFunction) - { - dataMat <- fitList[[1]]$"data" - tdataList <- fitList[[1]]$"dataList" - - parmMat <- fitList[[1]]$"parmMat" - nlsFit <- fitList[[1]]$"nlsFit" - - parNames <- fitList[[1]]$"parNames" - numPar <- length(parNames[[1]]) - parNames[[3]] <- rep(uniCur[i], numPar) - - if (numCur > 1) - { - nlsFit[[1]] <- nlsFit - pnList <- list() - pnList[[1]] <- parNames - pnList[[1]][[3]] <- rep(uniCur[1], numPar) - - for (i in 2:numCur) - { - parmMat <- cbind(parmMat, fitList[[i]]$"parmMat") - dataMat <- rbind(dataMat, fitList[[i]]$"data") - tdataList <- mapply(c, tdataList, fitList[[i]]$"dataList", SIMPLIFY = FALSE) - nlsFit[[i]] <- fitList[[i]]$"nlsFit" - pnList[[i]] <- fitList[[i]]$"parNames" - pnList[[i]][[3]] <- rep(uniCur[i], numPar) - } - } - retList$"dataList" <- tdataList - retList$"dataList"$"names" <- fitList[[1]]$"dataList"$"names" - retList$"data" <- dataMat - retList$"parmMat" <- parmMat - - plotFct <- function(x) {matrix(unlist(lapply(fitList, function(y)y$"curve"[[1]](x))), ncol = numCur)} - retList$"curve" <- list(plotFct, fitList[[1]]$"curve"[[2]]) - - bVec <- as.vector(unlist(lapply(pnList, function(x){x[[2]]}))) - cVec <- as.vector(unlist(lapply(pnList, function(x){x[[3]]}))) - aVec <- paste(bVec, cVec, sep = ":") - retList$"parNames" <- list(aVec, bVec, cVec) - - retList$"indexMat" <- matrix(c(1:(numCur * numPar)), numPar, numCur) - names(fitList) <- uniCur - retList$"objList" <- fitList - - coefVec <- as.vector(unlist(lapply(fitList, function(x){x$"fit"$"par"}))) - names(coefVec) <- aVec - retList$"coefficients" <- coefVec - - retList$"df.residual" <- sum(unlist(lapply(fitList, function(x){x$"df.residual"}))) - retList$"minval" <- sum(unlist(lapply(fitList, function(x){x$"fit"$"value"}))) - - retList$"fit" <- nlsFit - - - } else { - - } - - class(retList) <- c("drc") - return(retList) -} - -# -#"summary.idrm" <- function(object) -#{ -# -# -#} -# -# -#"coef.idrm" <- function(object) -#{ -# lappFct <- function(t) -# { -# coefVec <- coef(t) -# retVec <- c(coefVec, summary(t)$resVar) -# names(retVec) <- c(names(coefVec), "Res var") -# -# retVec -# } -# -## coefList <- lapply(object$"fitList", function(t) {c(coef(t), summary(t)$resVar)}) -# coefList <- lapply(object$"fitList", lappFct) -# -# if (!is.list(object$"fctList"[[1]])) -# { -# cl1 <- coefList[[1]] -# coefMat <- matrix(unlist(coefList), ncol = length(cl1), byrow = TRUE) -# colnames(coefMat) <- names(cl1) -# rownames(coefMat) <- object$"curveId" -# -# return(coefMat) -# } else { -# names(coefList) <- object$"curveId" -# return(coefList) -# } -#} - +#' @title Interactive dose-response modelling +#' @keywords internal +"idrm" <- function(x, y, curveid, weights, fct, type, control) +{ + oneFunction <- !is.list(fct[[1]]) + + ## Fitting models for each curve + fitList <- list() + uniCur <- unique(curveid) + numCur <- length(uniCur) + for (i in 1:numCur) + { + if (oneFunction) + { + fitList[[i]] <- drm(y~x, curveid, weights = weights, fct = fct, type = type, + subset = curveid == uniCur[i], separate = FALSE, control = control) + } else { + tempFitlist <- list() + for (j in 1:length(fct)) + { + tempFitlist[[j]] <- drm(y~x, curveid, weights = weights, fct = fct[[j]], + type = type, subset = curveid == uniCur[i], separate = FALSE, control = control) + } + fitList[[i]] <- tempFitlist + } + } + + retList <- fitList[[1]] + if (oneFunction) + { + dataMat <- fitList[[1]]$"data" + tdataList <- fitList[[1]]$"dataList" + + parmMat <- fitList[[1]]$"parmMat" + nlsFit <- fitList[[1]]$"nlsFit" + + parNames <- fitList[[1]]$"parNames" + numPar <- length(parNames[[1]]) + parNames[[3]] <- rep(uniCur[i], numPar) + + if (numCur > 1) + { + nlsFit[[1]] <- nlsFit + pnList <- list() + pnList[[1]] <- parNames + pnList[[1]][[3]] <- rep(uniCur[1], numPar) + + for (i in 2:numCur) + { + parmMat <- cbind(parmMat, fitList[[i]]$"parmMat") + dataMat <- rbind(dataMat, fitList[[i]]$"data") + tdataList <- mapply(c, tdataList, fitList[[i]]$"dataList", SIMPLIFY = FALSE) + nlsFit[[i]] <- fitList[[i]]$"nlsFit" + pnList[[i]] <- fitList[[i]]$"parNames" + pnList[[i]][[3]] <- rep(uniCur[i], numPar) + } + } + retList$"dataList" <- tdataList + retList$"dataList"$"names" <- fitList[[1]]$"dataList"$"names" + retList$"data" <- dataMat + retList$"parmMat" <- parmMat + + plotFct <- function(x) {matrix(unlist(lapply(fitList, function(y)y$"curve"[[1]](x))), ncol = numCur)} + retList$"curve" <- list(plotFct, fitList[[1]]$"curve"[[2]]) + + bVec <- as.vector(unlist(lapply(pnList, function(x){x[[2]]}))) + cVec <- as.vector(unlist(lapply(pnList, function(x){x[[3]]}))) + aVec <- paste(bVec, cVec, sep = ":") + retList$"parNames" <- list(aVec, bVec, cVec) + + retList$"indexMat" <- matrix(c(1:(numCur * numPar)), numPar, numCur) + names(fitList) <- uniCur + retList$"objList" <- fitList + + coefVec <- as.vector(unlist(lapply(fitList, function(x){x$"fit"$"par"}))) + names(coefVec) <- aVec + retList$"coefficients" <- coefVec + + retList$"df.residual" <- sum(unlist(lapply(fitList, function(x){x$"df.residual"}))) + retList$"minval" <- sum(unlist(lapply(fitList, function(x){x$"fit"$"value"}))) + + retList$"fit" <- nlsFit + + + } else { + + } + + class(retList) <- c("drc") + return(retList) +} + + diff --git a/R/isobole.r b/R/isobole.R similarity index 71% rename from R/isobole.r rename to R/isobole.R index 20b40e08..7958d698 100644 --- a/R/isobole.r +++ b/R/isobole.R @@ -1,3 +1,33 @@ +#' Creating isobolograms +#' +#' \code{isobole} displays isobole based on EC/ED50 estimates from a log-logistic model. +#' Additionally isoboles determined by the concentration addition model, Hewlett's model +#' and Voelund's model can be added to the plot. +#' +#' The model fits to be supplied as first and optionally second argument are obtained +#' using \code{\link{mixture}} and \code{\link{drm}}. +#' +#' @param object1 object of class 'drc' where EC/ED50 parameters vary freely. +#' @param object2 object of class 'drc' where EC/ED50 parameters vary according to Hewlett's model. +#' @param exchange numeric. The exchange rate between the two substances. +#' @param cifactor numeric. The factor to be used in the confidence intervals. Default is 2, +#' but 1 has been used in publications. +#' @param ename character string. The name of the EC/ED50 variable. +#' @param xaxis character string. Is the mixture "0:100" or "100:0" on the x axis? +#' @param xlab an optional label for the x axis. +#' @param ylab an optional label for the y axis. +#' @param xlim a numeric vector of length two, containing the lower and upper limit for the x axis. +#' @param ylim a numeric vector of length two, containing the lower and upper limit for the y axis. +#' @param ... Additional graphical parameters. +#' +#' @return No value is returned. Only used for the side effect: the isobologram shown. +#' +#' @references Ritz, C. and Streibig, J. C. (2014) From additivity to synergism - A +#' modelling perspective \emph{Synergy}, \bold{1}, 22--29. +#' +#' @author Christian Ritz +#' +#' @keywords models nonlinear "isobole" <- function(object1, object2, exchange = 1, cifactor = 2, ename = "e", xaxis = "100", xlab, ylab, xlim, ylim, ...) @@ -5,59 +35,27 @@ xlab, ylab, xlim, ylim, ...) parmVec <- coef(object1) namesPV <- names(parmVec) -# lenNPV <- length(namesPV) indVec <- regexpr(paste(ename, ":", sep = ""), namesPV, fixed = TRUE) > 0 eVec <- parmVec[indVec] seVec <- (summary(object1)$"coefficients")[indVec, 2] -# edMat <- ED(object1, 50, display = FALSE, multcomp = TRUE)[["EDdisplay"]] edMat <- ED(object1, 50, display = FALSE) eVec <- (as.vector(edMat[, 1])) # stripping off names seVec <- (as.vector(edMat[, 2])) # stripping off names mixProp <- unique(object1$data[, 4]) mixProp <- mixProp[ (mixProp >= 0) & (mixProp <= 100) ] / 100 # removing control level -# print(mixProp) - -# posOnRay <- function(len, slope) -# { -# xPos <- sqrt( len^2 / (1+slope^2) ) -# yPos <- slope*xPos -# -# yPos[!is.finite(slope)] <- len[!is.finite(slope)] -# -# list(xPos, yPos) -# } - -# if (identical(xaxis, "0")) -# { -# eVec <- rev(eVec) -# seVec <- rev(seVec) -# mixProp <- rev(mixProp) -# } Ex <- eVec * mixProp Ey <- eVec * (1-mixProp) * exchange -# print(Ex) -# print(Ey) lowerE <- eVec - cifactor * seVec -# lowerEx <- lowerE*mixProp -# lowerEx <- lowerE*cos(mixProp*pi/2) -# lowerEy <- lowerE*(1-mixProp)*exchange -# lowerEy <- lowerE*sin(mixProp*pi/2)*exchange upperE <- eVec + cifactor * seVec -# upperEx <- upperE*mixProp -# upperEx <- upperE*cos(mixProp*pi/2) -# upperEy <- upperE*(1-mixProp)*exchange -# upperEy <- upperE*sin(mixProp*pi/2)*exchange -# lowerE <- eVec - 2 * seVec lowerEx <- lowerE * mixProp lowerEy <- lowerE * (1 - mixProp) * exchange -# upperE <- eVec + 2 * seVec upperEx <- upperE * mixProp upperEy <- upperE * (1 - mixProp) * exchange @@ -96,30 +94,12 @@ xlab, ylab, xlim, ylim, ...) ## Plotting rays in first quadrant raySlopes <- (1 - mixProp) / mixProp -# raySlopes <- mixProp/(1 - mixProp) -# raySlopes <- tan(mixProp * pi/2) for (i in raySlopes[is.finite(raySlopes)]) {abline(0, exchange*i, lty = 3)} abline(v = 0, lty = 3) # adding vertical line (for infinite slope) -# raySlopes <- mixProp/(1 - mixProp) -# for (i in raySlopes[is.finite(raySlopes)]) -# { -# abline(0, exchange * i, lty = 3) -# } - ## Plotting ED50 values with confidence intervals points(Ex, Ey, pch = 19) segments(lowerEx, lowerEy, upperEx, upperEy, lwd = 2) - -# points(eVec*cos(mixProp*pi/2), eVec*sin(mixProp*pi/2)*exchange, pch = 19) - -# katx <- function(eVal, slope) {cos(atan(slope))*eVal} -# katy <- function(eVal, slope) {sin(atan(slope))*eVal} - -# points(katx(eVec, raySlopes), katy(eVec, raySlopes)*exchange, pch = 19) -# segments(lowerEx, lowerEy, upperEx, upperEy, lwd = 2) -# old segments(katx(lowerE, raySlopes), katy(lowerE, raySlopes)*exchange, -# katx(upperE, raySlopes), katy(upperE, raySlopes)*exchange, lwd = 2) if (!missing(object2)) { @@ -127,7 +107,6 @@ xlab, ylab, xlim, ylim, ...) ## Retrieving parameter estimates from fit of Hewlett's model parmVec <- coef(object2) namesPV <- names(parmVec) -# lenNPV <- length(namesPV) curveStr1 <- paste("I(1/(", object1$curveVarNam, "/100))", sep = "") curveStr2 <- paste("I(1/(1 - ", object1$curveVarNam, "/100))", sep = "") @@ -190,5 +169,4 @@ xlab, ylab, xlim, ylim, ...) } lines(xVal, yVal, ...) } -# invisible() } diff --git a/R/lgaussian.R b/R/lgaussian.R index bb156422..03ef2384 100644 --- a/R/lgaussian.R +++ b/R/lgaussian.R @@ -1,3 +1,28 @@ +#' @title Log-normal (log-Gaussian) biphasic dose-response model +#' +#' @description +#' Model function for fitting symmetric or skewed bell-shaped/biphasic dose-response patterns +#' using the log-Gaussian model. This is the log-transformed variant of the \code{\link{gaussian}} model. +#' +#' @param fixed numeric vector. Specifies which parameters are fixed and at what value they are fixed. +#' NAs for parameters that are not fixed. +#' @param names a vector of character strings giving the names of the parameters (should not contain ":"). +#' The order of the parameters is: b, c, d, e, f. +#' @param method character string indicating the self starter function to use. +#' @param ssfct a self starter function to be used. +#' @param fctName optional character string used internally by convenience functions. +#' @param fctText optional character string used internally by convenience functions. +#' @param loge logical indicating whether or not e or log(e) should be a parameter in the model. +#' By default e is a model parameter. +#' +#' @return The value returned is a list containing the nonlinear function, the self starter function +#' and the parameter names. +#' +#' @author Christian Ritz +#' +#' @seealso \code{\link{gaussian}}, \code{\link{drm}} +#' +#' @keywords models nonlinear "lgaussian" <- function( fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), method = c("1", "2", "3", "4"), ssfct = NULL, @@ -94,16 +119,6 @@ fctName, fctText, loge = FALSE) edfct <- function(parm, respl, reference, type, ...) { parmVec[notFixed] <- parm -# if (type == "absolute") -# { -# p <- 100*((parmVec[3] - respl)/(parmVec[3] - parmVec[2])) -# } else { -# p <- respl -# } -# if ( (parmVec[1] < 0) && (reference == "control") ) -# { -# p <- 100 - p -# } p <- absToRel(parmVec, abs(respl), type) ## Reversing p @@ -119,10 +134,9 @@ fctName, fctText, loge = FALSE) pProp <- 1 - (100-p) / 100 ## deriv(~exp(b*(-2*22)^(1 / f))*e, c("b", "c", "d", "e", "f"), function(b,c,d,e,f){}) - ## using "22" insted of log(pProp) + ## using "22" instead of log(pProp) EDfct <- function (b, c, d, e, f) { -# .expr2 <- -2 * 22 .expr2 <- -2 * log(pProp) .expr4 <- .expr2^(1/f) .expr6 <- exp(sign(respl) * b * .expr4) @@ -156,65 +170,4 @@ fctName, fctText, loge = FALSE) class(returnList) <- "lgaussian" invisible(returnList) -} - - -if (FALSE) -{ - -"LN.2" <- -function(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) -{ - ## Checking arguments - numParm <- 2 - if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct 'names' argument")} - if (!(length(fixed)==numParm)) {stop("Not correct length of 'fixed' argument")} - - return( lnormal(fixed = c(fixed[1], 0, upper, fixed[2]), - names = c(names[1], "c", "d", names[2]), - fctName = as.character(match.call()[[1]]), - fctText = lowupFixed("Log-normal", upper), ...) ) -} - -"LN.3" <- -function(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) -{ - ## Checking arguments - numParm <- 3 - if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct 'names' argument")} - if (!(length(fixed)==numParm)) {stop("Not correct length of 'fixed' argument")} - - return( lnormal(fixed = c(fixed[1], 0, fixed[2:3]), - names = c(names[1], "c", names[2:3]), - fctName = as.character(match.call()[[1]]), - fctText = lowFixed("Log-normal"), ...) ) -} - -"LN.3u" <- -function(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...) -{ - ## Checking arguments - numParm <- 3 - if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct 'names' argument")} - if (!(length(fixed)==numParm)) {stop("Not correct length of 'fixed' argument")} - - return( lnormal(fixed = c(fixed[1:2], upper, fixed[3]), - names = c(names[1:2], "d", names[3]), - fctName = as.character(match.call()[[1]]), - fctText = upFixed("Log-normal", upper), - ...) ) -} - -"LN.4" <- -function(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) -{ - ## Checking arguments - numParm <- 4 - if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct names argument")} - if (!(length(fixed)==numParm)) {stop("Not correct length of 'fixed' argument")} - - return( lnormal(fixed = fixed, names = names, - fctName = as.character(match.call()[[1]]), ...) ) -} - } \ No newline at end of file diff --git a/R/lin.test.R b/R/lin.test.R index ea3f6ce3..ab0a0c98 100644 --- a/R/lin.test.R +++ b/R/lin.test.R @@ -1,3 +1,48 @@ +#' Lack-of-fit test for the mean structure based on cumulated residuals +#' +#' The function provides a lack-of-fit test for the mean structure based on cumulated +#' residuals from the model fit. +#' +#' The function provides a graphical model checking of the mean structure in a dose-response +#' model. The graphical display is supplemented by a p-value based on a supremum-type test. +#' +#' The test is applicable even in cases where data are non-normal or exhibit variance +#' heterogeneity. +#' +#' @param object object of class 'drc'. +#' @param noksSim numeric specifying the number of simulations used to obtain the p-value. +#' @param seed numeric specifying the seed value for the random number generator. +#' @param plotit logical indicating whether or not the observed cumulated residual process +#' should be plotted. Default is to plot the process. +#' @param log character string which should contain \code{"x"} if the x axis is to be +#' logarithmic, \code{"y"} if the y axis is to be logarithmic and \code{"xy"} or +#' \code{"yx"} if both axes are to be logarithmic. The empty string \code{""} yields +#' the original axes. +#' @param bp numeric value specifying the break point below which the dose is zero. +#' @param xlab character string specifying an optional label for the x axis. +#' @param ylab character string specifying an optional label for the y axis. +#' @param ylim numeric vector of length two, containing the lower and upper limit for the y axis. +#' @param ... additional arguments to be passed further to the basic \code{\link{plot}} method. +#' +#' @return A p-value for test of the null hypothesis that the mean structure is appropriate. +#' Ritz and Martinussen (2009) provide the details. +#' +#' @references Ritz, C and Martinussen, T. (2009) Lack-of-fit tests for assessing mean +#' structures for continuous dose-response data, \emph{Submitted manuscript} +#' +#' @author Christian Ritz +#' +#' @seealso Other available lack-of-fit tests are the Neill test (\code{\link{neill.test}}) +#' and ANOVA-based test (\code{\link{modelFit}}). +#' +#' @examples +#' ## Fitting a log-logistic model to the dataset 'etmotc' +#' etmotc.m1<-drm(rgr1~dose1, data=etmotc[1:15,], fct=LL.4()) +#' +#' ## Test based on cumulated residuals +#' lin.test(etmotc.m1, 1000) +#' +#' @keywords models nonlinear "lin.test" <- function(object, noksSim = 20, seed = 20070325, plotit = TRUE, log = "", bp = 1e-2, xlab, ylab, ylim, ...) { @@ -26,7 +71,6 @@ xlab, ylab, ylim, ...) { eta[, i] <- cumsum(derVec[, i]) # /lenxv } -# term2 <- eta %*% vcov(object) %*% t(matrix(resVec/resVar, 1, lenxv) %*% derVec) ## Adjusting in case of replicates lenuxv <- length(unique(xVec)) @@ -52,16 +96,12 @@ xlab, ylab, ylim, ...) for (i in 1:noksSim) { rnVec <- rnorm(noObs) -# wtMat[, i] <- (cumsum(resVec * rnVec) - term2 * rnVec)/sqrt(noObs) if (repAdjust) { term1 <- as.vector(unlist(tapply(cumsum(resVec * rnVec), xVec, tail, 1))) } else { term1 <- cumsum(resVec * rnVec) } -# print(dim(tempMat)) -# print(dim(matrix(resVec*rnVec/resVar, 1, noObs))) -# print(dim(derVec)) term2 <- tempMat %*% t(matrix(resVec*rnVec/resVar, 1, noObs) %*% derVec) wti <- (term1 - term2)/sqrt(noObs) wtMat[, i] <- wti diff --git a/R/llogistic.R b/R/llogistic.R index 3e92c804..618e43b0 100644 --- a/R/llogistic.R +++ b/R/llogistic.R @@ -1,3 +1,34 @@ +#' The log-logistic function +#' +#' A very general way of specifying log-logistic models under various +#' constraints on parameters. +#' +#' The five-parameter log-logistic function is given by the expression +#' \deqn{f(x) = c + \frac{d-c}{(1+\exp(b(\log(x)-\log(e))))^f}} +#' +#' @param fixed numeric vector of length 5, specifying fixed parameters +#' (use NA for non-fixed parameters). +#' @param names character vector of length 5, specifying the names of the +#' parameters: b, c, d, e, f. +#' @param method character string indicating the self starter function to use. +#' @param ssfct a self starter function to be used. +#' @param fctName optional character string used internally. +#' @param fctText optional character string used internally. +#' +#' @return A list containing the nonlinear function, the self starter function, +#' and the parameter names. +#' +#' @author Christian Ritz +#' +#' @references +#' Finney, D. J. (1979). +#' +#' Seber, G. A. F. and Wild, C. J. (1989). +#' +#' @seealso \code{\link{LL.2}}, \code{\link{LL.3}}, \code{\link{LL.4}}, +#' \code{\link{LL.5}} +#' +#' @keywords models nonlinear "llogistic" <- function( fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), method = c("1", "2", "3", "4"), ssfct = NULL, @@ -16,12 +47,6 @@ fctName, fctText) parmVec <- rep(0, numParm) parmVec[!notFixed] <- fixed[!notFixed] -# ## Defining the basic non-linear function -# bfct <- function(x, parm) -# { -# parm[2] + (parm[3]-parm[2])/((1+(x/parm[4])^parm[1]))^parm[5] -# } - ## Defining the model function fct <- function(dose, parm) { @@ -29,7 +54,6 @@ fctName, fctText) parmMat[, notFixed] <- parm cParm <- parmMat[, 2] -# cParm + (parmMat[, 3] - cParm)/((1+exp(parmMat[, 1]*(log(dose)-log(parmMat[, 4]))))^parmMat[, 5]) cParm + (parmMat[, 3] - cParm)/((1+exp(parmMat[, 1]*(log(dose/parmMat[, 4]))))^parmMat[, 5]) } @@ -53,43 +77,23 @@ fctName, fctText) { fct <- function(dose, parm) { -# print(dose[1:10]) parmMat <- matrix(parmVec / c(1, respScaling, respScaling, doseScaling, 1), nrow(parm), numParm, byrow = TRUE) parmMat[, notFixed] <- parm -# bNeg <- parmMat[, 1] < 0 -# parmMat[bNeg, 1] <- -parmMat[bNeg, 1] - temp1 <- dose/parmMat[, 4] + temp1 <- dose/parmMat[, 4] temp2 <- 1 + (temp1)^parmMat[, 1] temp3 <- parmMat[, 5]*(temp2^(parmMat[, 5] - 1))*(parmMat[, 1]/parmMat[, 4])*temp1^(parmMat[, 1] - 1) temp4 <- temp2^(2*parmMat[, 5]) (-(parmMat[, 3] - parmMat[, 2])*temp3)/temp4 retVec <- (-(parmMat[, 3] - parmMat[, 2])*temp3)/temp4 -# retVec[bNeg] <- -retVec[bNeg] retVec } fct } -if (FALSE) { ## will work once plotFct does not depend on drcFct - ## Defining the model function adjusted for scaling - retFct <- function(doseScaling, respScaling, numObs) - { - parmMat <- matrix(parmVec / c(1, respScaling, respScaling, doseScaling, 1), numObs, numParm, byrow = TRUE) - - fct <- function(dose, parm) - { - parmMat[, notFixed] <- parm - cParm <- parmMat[, 2] - cParm + (parmMat[, 3] - cParm)/((1 + exp(parmMat[, 1]*(log(dose / parmMat[, 4]))))^parmMat[, 5]) - } - fct - } -} - ## Defining the scale function scaleFct <- function(doseScaling, respScaling) { @@ -108,9 +112,6 @@ if (FALSE) { ## will work once plotFct does not depend on drcFct names <- names[notFixed] ##Defining the first derivatives (in the parameters) -# if (useD) -# { - deriv1 <- function(dose, parm) { parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE) @@ -118,24 +119,16 @@ if (FALSE) { ## will work once plotFct does not depend on drcFct t1 <- parmMat[, 3] - parmMat[, 2] t2 <- exp(parmMat[, 1]*(log(dose) - log(parmMat[, 4]))) -# t3 <- (1 + t2)^(2*parmMat[, 5]) -# t4 <- parmMat[, 5]*((1 + t2)^(parmMat[, 5] - 1)) -## t3 <- parmMat[, 5]*((1 + t2)^(-parmMat[, 5] - 1)) t5 <- (1 + t2)^parmMat[, 5] - cbind( -t1 * xlogx(dose/parmMat[, 4], parmMat[, 1], parmMat[, 5] + 1) * parmMat[, 5], # *t4/t3, + cbind( -t1 * xlogx(dose/parmMat[, 4], parmMat[, 1], parmMat[, 5] + 1) * parmMat[, 5], 1 - 1/t5, 1/t5, -# t1*t2*t4*parmMat[, 1]/parmMat[, 4]/t3, t1 * parmMat[, 5] * divAtInf(t2, (1 + t2)^(parmMat[, 5] + 1)) * parmMat[, 1] / parmMat[, 4], -t1 * divAtInf(log(1+t2), t5) )[, notFixed] } deriv2 <- NULL -# } else { -# deriv1 <- NULL -# deriv2 <- NULL -# } ##Defining the first derivative (in the dose) @@ -143,123 +136,65 @@ if (FALSE) { ## will work once plotFct does not depend on drcFct { parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE) parmMat[, notFixed] <- parm -# bNeg <- parmMat[, 1] < 0 -# parmMat[bNeg, 1] <- -parmMat[bNeg, 1] - temp1 <- x/parmMat[, 4] + temp1 <- x/parmMat[, 4] temp2 <- 1 + (temp1)^parmMat[, 1] temp3 <- parmMat[, 5]*(temp2^(parmMat[, 5] - 1))*(parmMat[, 1]/parmMat[, 4])*temp1^(parmMat[, 1] - 1) temp4 <- temp2^(2*parmMat[, 5]) (-(parmMat[, 3] - parmMat[, 2])*temp3)/temp4 retVec <- (-(parmMat[, 3] - parmMat[, 2])*temp3)/temp4 -# retVec[bNeg] <- -retVec[bNeg] retVec } -# ## Setting the limits -# if (length(lowerc) == numParm) {lowerLimits <- lowerc[notFixed]} else {lowerLimits <- lowerc} -# if (length(upperc) == numParm) {upperLimits <- upperc[notFixed]} else {upperLimits <- upperc} - - - ## The three definitions below are not needed in future ('drm') - -# ## Defining parameter to be scaled -# if (is.na(fixed[4])) # (scaleDose) && (is.na(fixed[4])) ) -# { -# scaleInd <- sum(is.na(fixed[1:4])) -# } else { -# scaleInd <- NULL -# } -# ## Defining value for control measurements (dose=0) -# confct <- function(drcSign) -# { -# if (drcSign>0) {conPos <- 2} else {conPos <- 3} -# confct2 <- function(parm) -# { -# parmMat <- matrix(parmVec, nrow(parm), numParm, byrow=TRUE) -# parmMat[, notFixed] <- parm -# parmMat[, conPos] -# } -# return(list(pos=conPos, fct=confct2)) -# } -# ## Defining flag to indicate if more general ANOVA model -## anovaYes <- list(bin = !any(is.na(fixed[c(2,3,5)])) , cont = TRUE) -# binVar <- all(fixed[c(2, 3, 5)]==c(0, 1, 1)) -# if (is.na(binVar)) {binVar <- FALSE} -# if (!binVar) {binVar <- NULL} -# anovaYes <- list(bin = binVar, cont = TRUE) - ## Defining the ED function edfct <- function(parm, respl, reference, type, ...) { parmVec[notFixed] <- parm -# if (type == "absolute") -# { -# p <- 100*((parmVec[3] - respl)/(parmVec[3] - parmVec[2])) -# } else { -# p <- respl -# } -# ## Swapping p for increasing curve -# if ( (type == "relative") && (parmVec[1] < 0) && (reference == "control") ) -# { -# p <- 100 - p -# } p <- EDhelper(parmVec, respl, reference, type) - + tempVal <- log((100-p)/100) - EDp <- parmVec[4]*(exp(-tempVal/parmVec[5])-1)^(1/parmVec[1]) - - EDder <- - EDp*c(-log(exp(-tempVal/parmVec[5])-1)/(parmVec[1]^2), - 0, 0, 1/parmVec[4], - exp(-tempVal/parmVec[5])*tempVal/(parmVec[5]^2)*(1/parmVec[1])*((exp(-tempVal/parmVec[5])-1)^(-1))) - -# The next lines are not needed because the lower/upper limits are independent of the parameters -# governing the ED values -# if (type == "absolute") -# { -# denom <- (parmVec[3] - parmVec[2])^2 -# EDder <- EDder*c(1, (parmVec[3] - respl)/denom, (respl - parmVec[2])/denom, 1, 1) -# } + expTerm <- exp(-tempVal/parmVec[5]) + + # Check if expTerm - 1 is valid (must be positive for log) + # Handle NaN from tempVal or expTerm being invalid + if (is.na(expTerm) || expTerm <= 1) { + # ED value is outside the valid range or model is ill-conditioned + EDp <- Inf + EDder <- rep(NA, 5) + } else { + EDp <- parmVec[4]*(expTerm-1)^(1/parmVec[1]) + + EDder <- + EDp*c(-log(expTerm-1)/(parmVec[1]^2), + 0, 0, 1/parmVec[4], + expTerm*tempVal/(parmVec[5]^2)*(1/parmVec[1])*((expTerm-1)^(-1))) + + ## Fix: correct c and d derivatives for absolute type using central differences. + ## The analytical derivatives above miss the chain-rule contribution from + ## the absolute-to-relative conversion (EDhelper), where p depends on c and d. + if (identical(type, "absolute")) { + .edval <- function(pv) { + p0 <- EDhelper(pv, respl, reference, type) + tv0 <- log((100 - p0) / 100) + et0 <- exp(-tv0 / pv[5]) + if (is.na(et0) || et0 <= 1) return(Inf) + pv[4] * (et0 - 1)^(1 / pv[1]) + } + .eps <- .Machine$double.eps + for (.i in c(2, 3)) { + .h <- if (abs(parmVec[.i]) > sqrt(.eps)) abs(parmVec[.i]) * .eps^(1/3) else .eps^(1/3) + .pvUp <- replace(parmVec, .i, parmVec[.i] + .h) + .pvDn <- replace(parmVec, .i, parmVec[.i] - .h) + EDder[.i] <- (.edval(.pvUp) - .edval(.pvDn)) / (2 * .h) + } + } + } + return(list(EDp, EDder[notFixed])) } - -# ## Defining the SI function -# sifct <- function(parm1, parm2, pair) -# { -# ED1 <- edfct(parm1, pair[1]) -# ED2 <- edfct(parm2, pair[2]) -# SIpair <- ED1[[1]]/ED2[[1]] # calculating the SI value -# SIder1 <- ED1[[2]]/ED1[[1]]*SIpair -# SIder2 <- ED2[[2]]/ED2[[1]]*SIpair -# -# return(list(SIpair, SIder1, SIder2)) -# } - -#if (FALSE) -#{ -# ## Identifying parameters that are on the same scale as x and y -# ## not used in 'multdrc', but in 'drm' -# if (is.na(fixed[4])) -# { -# sxInd <- sum(is.na(fixed[1:4])) # sxInd <- c(4) -# } else { -# sxInd <- NULL -# } -# if ( (is.na(fixed[2])) || (is.na(fixed[3])) ) -# { -# syInd <- c(sum(is.na(fixed[1:2])), sum(is.na(fixed[1:3]))) # syInd <- c(2, 3) -# if (syInd[2] == 0) {syInd <- syInd[1]} -# if (syInd[1] == 0) {syInd <- syInd[2]} -# if (is.na(syInd)) {syInd <- NULL} -# } else { -# syInd <- NULL -# } -#} - ## Defining the inverse function invfct <- function(y, parm) { @@ -277,18 +212,43 @@ if (FALSE) { ## will work once plotFct does not depend on drcFct returnList <- list(fct = fct, ssfct = ssfct, names = names, deriv1 = deriv1, deriv2 = deriv2, derivx = derivx, edfct = edfct, inversion = invfct, scaleFct = scaleFct, -# scaleInd = scaleInd, confct=confct, anovaYes=anovaYes, lowerc=lowerLimits, upperc=upperLimits, name = ifelse(missing(fctName), as.character(match.call()[[1]]), fctName), text = ifelse(missing(fctText), "Log-logistic (ED50 as parameter)", fctText), noParm = sum(is.na(fixed)), lowerAs = lowerAs, upperAs = upperAs, monoton = monoton, retFct = retFct, fixed = fixed, retFctDx = retFctDx) - # the 4th last line is not needed in the future ('drm') - # , sxInd = sxInd, syInd = syInd, class(returnList) <- "llogistic" invisible(returnList) } +#' Two-parameter log-logistic function +#' +#' A two-parameter log-logistic function with lower limit fixed at 0 and +#' upper limit fixed (default 1), primarily for use with binomial/quantal +#' dose-response data. +#' +#' The two-parameter log-logistic function is given by the expression +#' \deqn{f(x) = \frac{upper}{1+\exp(b(\log(x)-\log(e)))}} +#' +#' @param upper numeric value, the fixed upper limit (default 1). +#' @param fixed numeric vector of length 2, specifying fixed parameters +#' (use NA for non-fixed parameters). +#' @param names character vector of length 2, specifying the names of the +#' parameters (default: b, e). +#' @param ... additional arguments to \code{\link{llogistic}}. +#' +#' @return See \code{\link{llogistic}}. +#' +#' @author Christian Ritz +#' +#' @seealso \code{\link{LL.3}}, \code{\link{LL.4}}, \code{\link{LL.5}}, +#' \code{\link{llogistic}} +#' +#' @examples +#' earthworms.m1 <- drm(number/total~dose, weights=total, +#' data = earthworms, fct = LL.2(), type = "binomial") +#' +#' @keywords models nonlinear "LL.2" <- function(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) { @@ -304,8 +264,33 @@ function(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) ...) ) } +#' @rdname LL.2 l2 <- LL.2 +#' Three-parameter log-logistic function +#' +#' A three-parameter log-logistic function with lower limit fixed at 0. +#' +#' The three-parameter log-logistic function is given by the expression +#' \deqn{f(x) = \frac{d}{1+\exp(b(\log(x)-\log(e)))}} +#' +#' @param fixed numeric vector of length 3, specifying fixed parameters +#' (use NA for non-fixed parameters). +#' @param names character vector of length 3, specifying the names of the +#' parameters (default: b, d, e). +#' @param ... additional arguments to \code{\link{llogistic}}. +#' +#' @return See \code{\link{llogistic}}. +#' +#' @author Christian Ritz +#' +#' @seealso \code{\link{LL.2}}, \code{\link{LL.4}}, \code{\link{LL.5}}, +#' \code{\link{llogistic}} +#' +#' @examples +#' ryegrass.model1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.3()) +#' +#' @keywords models nonlinear "LL.3" <- function(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) { @@ -321,8 +306,32 @@ function(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) ...) ) } +#' @rdname LL.3 l3 <- LL.3 +#' Three-parameter log-logistic function with upper limit fixed +#' +#' A three-parameter log-logistic function with upper limit fixed (default 1), +#' primarily for use with binomial/quantal dose-response data. +#' +#' The three-parameter log-logistic function with upper limit fixed is given by +#' \deqn{f(x) = c + \frac{upper-c}{1+\exp(b(\log(x)-\log(e)))}} +#' +#' @param upper numeric value, the fixed upper limit (default 1). +#' @param fixed numeric vector of length 3, specifying fixed parameters +#' (use NA for non-fixed parameters). +#' @param names character vector of length 3, specifying the names of the +#' parameters (default: b, c, e). +#' @param ... additional arguments to \code{\link{llogistic}}. +#' +#' @return See \code{\link{llogistic}}. +#' +#' @author Christian Ritz +#' +#' @seealso \code{\link{LL.2}}, \code{\link{LL.3}}, \code{\link{LL.4}}, +#' \code{\link{llogistic}} +#' +#' @keywords models nonlinear "LL.3u" <- function(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...) { @@ -338,8 +347,32 @@ function(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...) ...) ) } +#' @rdname LL.3u l3u <- LL.3u +#' Four-parameter log-logistic function +#' +#' A four-parameter log-logistic function. +#' +#' The four-parameter log-logistic function is given by the expression +#' \deqn{f(x) = c + \frac{d-c}{1+\exp(b(\log(x)-\log(e)))}} +#' +#' @param fixed numeric vector of length 4, specifying fixed parameters +#' (use NA for non-fixed parameters). +#' @param names character vector of length 4, specifying the names of the +#' parameters (default: b, c, d, e). +#' @param ... additional arguments to \code{\link{llogistic}}. +#' +#' @return See \code{\link{llogistic}}. +#' +#' @author Christian Ritz and Jens C. Streibig +#' +#' @seealso \code{\link{LL.3}}, \code{\link{LL.5}}, \code{\link{llogistic}} +#' +#' @examples +#' spinach.m1 <- drm(SLOPE~DOSE, CURVE, data = spinach, fct = LL.4()) +#' +#' @keywords models nonlinear "LL.4" <- function(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) { @@ -352,8 +385,33 @@ function(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) fctName = as.character(match.call()[[1]]), ...) ) } +#' @rdname LL.4 l4 <- LL.4 +#' Five-parameter log-logistic function +#' +#' A five-parameter (generalized) log-logistic function. The function is +#' asymmetric when f differs from 1. +#' +#' The five-parameter log-logistic function is given by the expression +#' \deqn{f(x) = c + \frac{d-c}{(1+\exp(b(\log(x)-\log(e))))^f}} +#' +#' @param fixed numeric vector of length 5, specifying fixed parameters +#' (use NA for non-fixed parameters). +#' @param names character vector of length 5, specifying the names of the +#' parameters (default: b, c, d, e, f). +#' @param ... additional arguments to \code{\link{llogistic}}. +#' +#' @return See \code{\link{llogistic}}. +#' +#' @author Christian Ritz +#' +#' @seealso \code{\link{LL.3}}, \code{\link{LL.4}}, \code{\link{llogistic}} +#' +#' @examples +#' ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.5()) +#' +#' @keywords models nonlinear "LL.5" <- function(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...) { @@ -362,8 +420,34 @@ function(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...) fctText = "Generalized log-logistic (ED50 as parameter)", ...) ) } +#' @rdname LL.5 l5 <- LL.5 +#' Two-parameter Michaelis-Menten function +#' +#' A two-parameter Michaelis-Menten function where b is fixed at -1, c at 0, +#' and f at 1. Commonly used for enzyme kinetics and weed density studies. +#' +#' The two-parameter Michaelis-Menten function is +#' \deqn{f(x) = \frac{d \cdot x}{e + x}} +#' which is equivalent to \eqn{d/(1+(e/x))}. +#' +#' @param fixed numeric vector of length 2, specifying fixed parameters +#' (use NA for non-fixed parameters). +#' @param names character vector of length 2, specifying the names of the +#' parameters (default: d, e). +#' @param ... additional arguments to \code{\link{llogistic}}. +#' +#' @return See \code{\link{llogistic}}. +#' +#' @author Christian Ritz +#' +#' @seealso \code{\link{MM.3}}, \code{\link{AR.2}}, \code{\link{AR.3}} +#' +#' @examples +#' met.mm.m1 <- drm(gain~dose, product, data = methionine, fct = MM.2()) +#' +#' @keywords models nonlinear "MM.2" <- function(fixed = c(NA, NA), names = c("d", "e"), ...) { @@ -378,6 +462,30 @@ function(fixed = c(NA, NA), names = c("d", "e"), ...) ...) ) } +#' Three-parameter Michaelis-Menten function +#' +#' A three-parameter (shifted) Michaelis-Menten function where b is fixed +#' at -1 and f at 1. +#' +#' The three-parameter Michaelis-Menten function is +#' \deqn{f(x) = c + \frac{d-c}{1+(e/x)}} +#' +#' @param fixed numeric vector of length 3, specifying fixed parameters +#' (use NA for non-fixed parameters). +#' @param names character vector of length 3, specifying the names of the +#' parameters (default: c, d, e). +#' @param ... additional arguments to \code{\link{llogistic}}. +#' +#' @return See \code{\link{llogistic}}. +#' +#' @author Christian Ritz +#' +#' @seealso \code{\link{MM.2}}, \code{\link{AR.2}}, \code{\link{AR.3}} +#' +#' @examples +#' met.mm.m1 <- drm(gain~dose, product, data = methionine, fct = MM.3()) +#' +#' @keywords models nonlinear "MM.3" <- function(fixed = c(NA, NA, NA), names = c("c", "d", "e"), ...) { @@ -391,226 +499,3 @@ function(fixed = c(NA, NA, NA), names = c("c", "d", "e"), ...) fctText = "Shifted Michaelis-Menten", ...) ) } - - -#if (FALSE) -#{ -# -# ## Version 1 (default) -# if (ss == "1") -# { -# ssfct <- function(dframe) -# { -# x <- dframe[, 1] -# y <- dframe[, 2] -# -# startVal <- rep(0, numParm) -# -# startVal[3] <- max(y) + 0.001 # the d parameter -# startVal[2] <- min(y) - 0.001 # the c parameter -# startVal[5] <- 1 # better choice may be possible! -# -# if (length(unique(x))==1) {return((c(NA, NA, startVal[3], NA, NA))[notFixed])} -# # only estimate of upper limit if a single unique dose value -# -# indexT2 <- (x > 0) -## if (!any(indexT2)) {return((rep(NA, numParm))[notFixed])} # for negative dose value -# x2 <- x[indexT2] -# y2 <- y[indexT2] -# -# startVal[c(1,4)] <- find.be2(x2, y2, startVal[2] - 0.001, startVal[3]) -# # 0.001 to avoid 0 in the denominator -# -## logitTrans <- log((startVal[3]-resp3)/(resp3-startVal[2]+0.001)) -## logitFit <- lm(logitTrans ~ log(dose3)) -## startVal[4] <- exp((-coef(logitFit)[1]/coef(logitFit)[2])) # the e parameter -## startVal[1] <- coef(logitFit)[2] # the b parameter -# -# return(startVal[notFixed]) -# } -# } -# -# if (ss == "1") -# { -# ssfct <- function(dframe) -# { -# x <- dframe[, 1] -# y <- dframe[, 2] -# -# startVal <- rep(0, numParm) -# -# lenyRange <- 0.001 * diff(range(y)) -# startVal[3] <- max(y) + lenyRange # the d parameter -# startVal[2] <- min(y) - lenyRange # the c parameter -# startVal[5] <- 1 # better choice may be possible! -# -## if (length(unique(x))==1) {return((c(NA, NA, startVal[3], NA, NA))[notFixed])} -## # only estimate of upper limit if a single unique dose value -# -## indexT2 <- (x > 0) -### if (!any(indexT2)) {return((rep(NA, numParm))[notFixed])} # for negative dose value -## x2 <- x[indexT2] -## y2 <- y[indexT2] -# -## startVal[c(1,4)] <- find.be2(x2, y2, startVal[2] - lenyRange, startVal[3]) -# startVal[c(1, 4)] <- find.be3(x, y, startVal[2], startVal[3]) -# # 0.001 to avoid 0 in the denominator -# -## logitTrans <- log((startVal[3]-resp3)/(resp3-startVal[2]+0.001)) -## logitFit <- lm(logitTrans ~ log(dose3)) -## startVal[4] <- exp((-coef(logitFit)[1]/coef(logitFit)[2])) # the e parameter -## startVal[1] <- coef(logitFit)[2] # the b parameter -# -# return(startVal[notFixed]) -# } -# } -# -# ## Version 2 -# if (ss == "2") -# { -# ssfct <- function(dframe, doseScaling, respScaling) -# { -# x <- dframe[, 1] / doseScaling -# y <- dframe[, 2] / respScaling -# -## startVal <- rep(0, numParm) -# -## startVal[3] <- max(resp3) + 0.001 # the d parameter -## startVal[3] <- ifelse(notFixed[3], 1.05*max(y), fixed[3]) -## startVal[3] <- mean(resp3[dose2 == max(dose2)]) + 0.001 -# -## startVal[2] <- min(resp3) - 0.001 # the c parameter -## startVal[2] <- ifelse(notFixed[2], 0.95*min(y), fixed[2]) -## startVal[2] <- mean(resp3[dose2 == min(dose2)]) + (1e-8)*((max(resp3) - min(resp3))/max(resp3)) -# -## miny <- min(y) -## if (all.equal(miny, 0)) -## { -## miny <- min(y[y > miny]) -## } -# cVal <- ifelse(notFixed[2], 0.99 * min(y), fixed[2] / respScaling) -# dVal <- ifelse(notFixed[3], 1.01 * max(y), fixed[3] / respScaling) -# -## if (reps) -## { -## cVal0 <- median(y[x == min(x)]) -## dVal0 <- median(y[x == max(x)]) -## if (cVal0 > dVal0) # making dVal0 the largest -## { -## tval <- cVal0 -## cVal0 <- dVal0 -## dVal0 <- tval -## } -## -## cVal <- ifelse(notFixed[2], 0.95*cVal0, fixed[2]) -## dVal <- ifelse(notFixed[3], 1.05*dVal0, fixed[3]) -## } -# -## startVal[5] <- 1 -# fVal <- 1 # need not be updated with value in 'fixed[5]' -# # better choice than 1 may be possible! -# # the f parameter, however, is very rarely a magnitude of 10 larger or smaller -# -# if ( length(unique(x)) == 1 ) {return((c(NA, NA, dVal, NA, NA))[notFixed])} -# # only estimate of upper limit if a single unique dose value -# -# # Cutting away response values close to d -# indexT1a <- x > 0 -## indexT1b <- !(y > 0.95*max(y)) -## indexT2 <- c(max((1:length(y))[!(indexT1a | indexT1b)]):length(y)) -## x2 <- x[indexT2] -## y2 <- y[indexT2] -# x2 <- x[indexT1a] -# y2 <- y[indexT1a] -# -# print(c(cVal, dVal)) -# beVec <- find.be2(x2, y2, cVal, dVal) -## These lines are not needed as the b and e parameters are not used in further calculations -## bVal <- ifelse(notFixed[1], beVec[1], fixed[1]) -## eVal <- ifelse(notFixed[4], beVec[2], fixed[4] / doseScaling) -# bVal <- beVec[1] -# eVal <- beVec[2] -# -## logitTrans <- log((dVal - y2)/(y2 - cVal)) -## logitFit <- lm(logitTrans ~ log(x2)) -## coefVec <- coef(logitFit) -## bVal <- coefVec[2] -## eVal <- exp(-coefVec[1]/bVal) -## -# return(as.vector(c(bVal, cVal, dVal, eVal, fVal)[notFixed])) -# } -# } -# -# ## Version 3 -# if (ss == "3") -# { -# ssfct <- function(dframe) -# { -# x <- dframe[, 1] -# y <- dframe[, 2] -# -# cVal <- ifelse(notFixed[2], 0.99 * min(y), fixed[2]) -# dVal <- ifelse(notFixed[3], 1.01 * max(y), fixed[3]) -# fVal <- 1 # need not be updated with value in 'fixed[5]' -# -# if ( length(unique(x)) == 1 ) {return((c(NA, NA, dVal, NA, NA))[notFixed])} -# # only estimate of upper limit if a single unique dose value -# -# beVec <- find.be1(x, y, cVal, dVal) -# bVal <- beVec[1] -# eVal <- beVec[2] -# -# return(as.vector(c(bVal, cVal, dVal, eVal, fVal)[notFixed])) -# } -# } -# -# ## Finding b and e based on stepwise increments -# find.be1 <- function(x, y, c, d) -# { -# unix <- unique(x) -# uniy <- tapply(y, x, mean) -# lenx <- length(unix) -# -# j <- 2 -# for (i in 2:lenx) -# { -# crit1 <- (uniy[i] > (d + c)/2) && (uniy[i-1] < (d + c)/2) -# crit2 <- (uniy[i] < (d + c)/2) && (uniy[i-1] > (d + c)/2) -# if (crit1 || crit2) break -# j <- j + 1 -# } -# eVal <- (unix[j] + unix[j-1])/2 -# bVal <- -sign(uniy[j] - uniy[j-1]) # -(uniy[j] - uniy[j-1]) / (unix[j] - unix[j-1]) -# return(as.vector(c(bVal, eVal))) -# } -# -# ## Finding b and e based on linear regression -# find.be2 <- function(x, y, c, d) -# { -# logitTrans <- log((d - y)/(y - c)) -# -# lmFit <- lm(logitTrans ~ log(x)) -## eVal <- exp((-coef(logitFit)[1]/coef(logitFit)[2])) -## bVal <- coef(logitFit)[2] -# -# coefVec <- coef(lmFit) -# bVal <- coefVec[2] -# eVal <- exp(-coefVec[1]/bVal) -# -# return(as.vector(c(bVal, eVal))) -# } -# -# ## Finding b and e based on linear regression -# find.be3 <- function(x, y, c, d) -# { -# logitTrans <- log((d - y)/(y - c)) -# -# lmFit <- lm(logitTrans ~ log(x), subset = x > 0) -# coefVec <- coef(lmFit) -# bVal <- coefVec[2] -# eVal <- exp(-coefVec[1] / bVal) -# -# print(as.vector(c(bVal, eVal))) -# return(as.vector(c(bVal, eVal))) -# } -#} \ No newline at end of file diff --git a/R/llogistic.ssf.R b/R/llogistic.ssf.R index b5fea3c1..6caaa3a8 100644 --- a/R/llogistic.ssf.R +++ b/R/llogistic.ssf.R @@ -1,250 +1,39 @@ -"llogistic.ssf" <- function(method = c("1", "2", "3", "4"), fixed, useFixed = FALSE) -{ - method <- match.arg(method) - - ## Defining helper functions (used below) - ytrans <- function(y, cVal, dVal) {log((dVal - y)/(y - cVal))} - bfct <- function(x, y, cVal, dVal, eVal) {ytrans(y, cVal, dVal) / log(x / eVal)} -# efct <- function(x, y, bVal, cVal, dVal) {x * (((dVal - y) / (y - cVal))^(-1 / bVal))} - efct <- function(x, y, bVal, cVal, dVal) {x * exp(-ytrans(y, cVal, dVal)/bVal)} - - ## Assigning function for finding initial b and e parameter values - findbe <- switch(method, - "1" = findbe1(function(x) {rVec <- log(x); rVec[!x>0 | !is.finite(x)] <- NA; rVec}, ytrans), - "2" = findbe2(bfct, efct, "Anke"), - "3" = findbe3(), - "4" = findbe2(bfct, efct, "Normolle")) - - function(dframe) - { - ncoldf <- ncol(dframe) - x <- dframe[, 1] -# x <- dframe[, -ncoldf] - y <- dframe[, ncoldf] - -# x <- dframe[, 1] -# y <- dframe[, 2] - - ## Finding initial values for c and d parameters - cdVal <- findcd(x, y) -# if (useFixed) { # not implemented at the moment -# cdVal <- c(ifelse(notFixed[2], cdVal[1], fixed[2] / respScaling), -# ifelse(notFixed[3], cdVal[2], fixed[3] / respScaling))} - - ## Finding initial values for b and e parameters - beVal <- findbe(x, y, cdVal[1], cdVal[2]) - - ## Finding initial value for f parameter - fVal <- 1 - # better choice than 1 may be possible! - # the f parameter, however, is very rarely a magnitude of 10 larger or smaller - - return(c(beVal[1], cdVal, beVal[2], fVal)[is.na(fixed)]) - } -} - -if (FALSE) -{ - -"llogistic.ssf" <- function(method = c("1", "2", "3", "4"), fixed) -{ - method <- match.arg(method) - numParm <- length(fixed) - notFixed <- is.na(fixed) - - ## Version 1 (default) - ssFct <- switch(method, - "1" = - function(dframe) - { - x <- dframe[, 1] - y <- dframe[, 2] - - yRange <- range(y) - lenyRange <- 0.001 * diff(yRange) - cVal <- yRange[1] - lenyRange # the c parameter - dVal <- yRange[2] + lenyRange # the d parameter - fVal <- 1 # better choice may be possible! - - beVal <- find.be1(x, y, cVal, dVal) - - return(c(beVal[1], cVal, dVal, beVal[2], fVal)[notFixed]) - }, - "2" = - function(dframe, doseScaling, respScaling) - { - x <- dframe[, 1] / doseScaling - y <- dframe[, 2] / respScaling - - cVal <- ifelse(notFixed[2], 0.99 * min(y), fixed[2] / respScaling) - dVal <- ifelse(notFixed[3], 1.01 * max(y), fixed[3] / respScaling) - - fVal <- 1 # need not be updated with value in 'fixed[5]' - # better choice than 1 may be possible! - # the f parameter, however, is very rarely a magnitude of 10 larger or smaller - -# # Cutting away response values close to d -# indexT1a <- x > 0 -# x2 <- x[indexT1a] -# y2 <- y[indexT1a] - - beVal <- find.be1(x, y, cVal, dVal) -# These lines are not needed as the b and e parameters are not used in further calculations -# bVal <- ifelse(notFixed[1], beVec[1], fixed[1]) -# eVal <- ifelse(notFixed[4], beVec[2], fixed[4] / doseScaling) - -# bVal <- beVec[1] -# eVal <- beVec[2] -# return(as.vector(c(bVal, cVal, dVal, eVal, fVal)[notFixed])) - - return(c(beVal[1], cVal, dVal, beVal[2], fVal)[notFixed]) - }, - "3" = - function(dframe) - { - x <- dframe[, 1] - y <- dframe[, 2] - - cVal <- ifelse(notFixed[2], 0.99 * min(y), fixed[2]) - dVal <- ifelse(notFixed[3], 1.01 * max(y), fixed[3]) - fVal <- 1 # need not be updated with value in 'fixed[5]' - -# if ( length(unique(x)) == 1 ) {return((c(NA, NA, dVal, NA, NA))[notFixed])} -# # only estimate of upper limit if a single unique dose value -# no longer needed - - beVec <- find.be2(x, y, cVal, dVal) - bVal <- beVec[1] - eVal <- beVec[2] - - return(as.vector(c(bVal, cVal, dVal, eVal, fVal)[notFixed])) - }) - - ## Finding b and e based on linear regression - find.be1 <- function(x, y, cVal, dVal) - { -# logitTrans <- log((d - y)/(y - c)) - lmFit <- lm(log((dVal - y)/(y - cVal)) ~ log(x), subset = x > 0) - coefVec <- coef(lmFit) - bVal <- coefVec[2] - eVal <- exp(-coefVec[1] / bVal) - - return(as.vector(c(bVal, eVal))) - } - - ## Finding b and e based on stepwise increments - find.be2 <- function(x, y, cVal, dVal) - { - unix <- unique(x) - uniy <- tapply(y, x, mean) - lenx <- length(unix) - - j <- 2 - for (i in 2:lenx) - { - crit1 <- (uniy[i] > (cVal + dVal)/2) && (uniy[i-1] < (cVal + dVal)/2) - crit2 <- (uniy[i] < (cVal + dVal)/2) && (uniy[i-1] > (cVal + dVal)/2) - if (crit1 || crit2) break - j <- j + 1 - } - eVal <- (unix[j] + unix[j-1]) / 2 - bVal <- -sign(uniy[j] - uniy[j-1]) # -(uniy[j] - uniy[j-1]) / (unix[j] - unix[j-1]) - return(as.vector(c(bVal, eVal))) - } - -# ## Finding b and e based on linear regression -# find.be2 <- function(x, y, c, d) -# { -# logitTrans <- log((d - y)/(y - c)) -# -# lmFit <- lm(logitTrans ~ log(x)) -## eVal <- exp((-coef(logitFit)[1]/coef(logitFit)[2])) -## bVal <- coef(logitFit)[2] -# -# coefVec <- coef(lmFit) -# bVal <- coefVec[2] -# eVal <- exp(-coefVec[1]/bVal) -# -# return(as.vector(c(bVal, eVal))) -# } - - ## Defining function for finding initial values of the b and e parameter - - ## Helper functions used below - bFct <- function(x, y, cVal, dVal, eVal) - { - median(log((dVal - y) / (y - cVal)) / log(x / eVal), na.rm = TRUE) - } - - eFct <- function(x, y, cVal, dVal, bVal) - { -# print((dVal - y) / (cVal - y)) - median(x * (((dVal - y) / (y - cVal))^(-1 / bVal)), na.rm = TRUE) - } - - ## Anke's procedure - find.be3 <- function(x, y, cVal, dVal) - { - ## Finding initial value for e - midResp <- (dVal - cVal) / 2 - - ## Largest dose with all responses above - aboveVec <- x[y > midResp] - uniAbove <- unique(aboveVec) - - if (length(aboveVec) < sum(x %in% uniAbove)) - { - uniAbove <- head(uniAbove, -1) - } - maxDose <- max(x[x %in% uniAbove]) - print(maxDose) - - ## Smallest dose with all responses below - belowVec <- x[y < midResp] - uniBelow <- unique(belowVec) - if (length(belowVec) < sum(x %in% uniBelow)) - { - uniBelow <- tail(uniBelow, -1) - } - minDose <- min(x[x %in% uniBelow]) - print(minDose) - - subsetInd <- (x > maxDose) & (x < minDose) - eVal <- mean((1 / (1 + (abs(y[subsetInd] - midResp)/15)^2)) * x[subsetInd]) - - ## Finding initial value for b -# bVal <- median(log((dVal - y) / (y - cVal)) / log(x / eVal), na.rm = TRUE) - bVal <- bFct(x, y, cVal, dVal, eVal) - - ## Checking sign of b and possibly take action if it's wrong - if ((coef(lm(y ~ x))[2] / bVal) > 0) - { -# bVal <- -bVal -# eVal <- median(x * (((dVal - y) / (y - cVal))^(-1/bVal)), na.rm = TRUE) - eVal <- eFct(x, y, cVal, dVal, -bVal) - bVal <- bFct(x, y, cVal, dVal, eVal) - } - - return(c(bVal, eVal)) - } - - ## Normolle's procedure - find.be4 <- function(x, y, cVal, dVal) - { - initeVal <- mean(range(x)) - bVal <- bFct(x, y, cVal, dVal, initeVal) - eVal <- eFct(x, y, cVal, dVal, bVal) - -# bVal <- bFct(x, y, cVal, dVal, eVal) -# eVal <- eFct(x, y, cVal, dVal, bVal) - - return(c(bVal, eVal)) - } - - ## Returning self starter function - ssFct -} - -LL.ssf <- llogistic.ssf -} - +#' @title Self-starter for log-logistic model +#' @keywords internal +"llogistic.ssf" <- function(method = c("1", "2", "3", "4"), fixed, useFixed = FALSE) +{ + method <- match.arg(method) + + ## Defining helper functions (used below) + ytrans <- function(y, cVal, dVal) {log((dVal - y)/(y - cVal))} + bfct <- function(x, y, cVal, dVal, eVal) {ytrans(y, cVal, dVal) / log(x / eVal)} + efct <- function(x, y, bVal, cVal, dVal) {x * exp(-ytrans(y, cVal, dVal)/bVal)} + + ## Assigning function for finding initial b and e parameter values + findbe <- switch(method, + "1" = findbe1(function(x) {rVec <- log(x); rVec[!x>0 | !is.finite(x)] <- NA; rVec}, ytrans), + "2" = findbe2(bfct, efct, "Anke"), + "3" = findbe3(), + "4" = findbe2(bfct, efct, "Normolle")) + + function(dframe) + { + ncoldf <- ncol(dframe) + x <- dframe[, 1] + y <- dframe[, ncoldf] + + ## Finding initial values for c and d parameters + cdVal <- findcd(x, y) + + ## Finding initial values for b and e parameters + beVal <- findbe(x, y, cdVal[1], cdVal[2]) + + ## Finding initial value for f parameter + fVal <- 1 + # better choice than 1 may be possible! + # the f parameter, however, is very rarely a magnitude of 10 larger or smaller + + return(c(beVal[1], cdVal, beVal[2], fVal)[is.na(fixed)]) + } +} + diff --git a/R/llogistic2.R b/R/llogistic2.R index 0893fb65..d041e893 100644 --- a/R/llogistic2.R +++ b/R/llogistic2.R @@ -1,3 +1,32 @@ +#' Five-Parameter Log-Logistic Model with log(ED50) as Parameter +#' +#' A five-parameter log-logistic model where the ED50 is parameterised on the +#' log scale. The mean function is: +#' \deqn{f(x) = c + \frac{d - c}{(1 + \exp(b(\log(x) - e)))^f}}{f(x) = c + (d-c)/(1+exp(b(log(x)-e)))^f} +#' where \code{e} is the logarithm of the ED50 (not exponentiated). +#' +#' @param fixed numeric vector of length 5. Specifies which parameters are +#' fixed and at what value. Use \code{NA} for parameters that should be +#' estimated. +#' @param names character vector of length 5 giving the names of the +#' parameters \code{b}, \code{c}, \code{d}, \code{e}, and \code{f}. +#' @param ss character string indicating the self-starter version to use. +#' One of \code{"1"} (default), \code{"2"}, or \code{"3"}. +#' @param ssfct optional self-starter function. If provided, overrides the +#' built-in self-starter selected by \code{ss}. +#' @param fctName optional character string specifying the name of the function. +#' @param fctText optional character string providing a short description of +#' the function. +#' +#' @return A list of class \code{"llogistic"} containing the nonlinear function, +#' self-starter function, parameter names, and related helper functions. +#' +#' @author Christian Ritz +#' +#' @seealso \code{\link{llogistic}}, \code{\link{LL2.2}}, \code{\link{LL2.3}}, +#' \code{\link{LL2.4}}, \code{\link{LL2.5}} +#' +#' @keywords models nonlinear "llogistic2" <- function( fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ss = c("1", "2", "3"), ssfct = NULL, fctName, fctText) @@ -58,7 +87,6 @@ fctName, fctText) # only estimate of upper limit if a single unique dose value indexT2 <- (x > 0 & is.finite(x)) -# if (!any(indexT2)) {return((rep(NA, numParm))[notFixed])} # for negative dose value x2 <- x[indexT2] y2 <- y[indexT2] @@ -197,27 +225,12 @@ fctName, fctText) } -# ## Setting the limits -# if (length(lowerc) == numParm) {lowerLimits <- lowerc[notFixed]} else {lowerLimits <- lowerc} -# if (length(upperc) == numParm) {upperLimits <- upperc[notFixed]} else {upperLimits <- upperc} - - ## Defining the ED function ## (returning ED values and corresponding standard errors on log scale) edfct <- function(parm, respl, reference, type, ...) { parmVec[notFixed] <- parm -# if (type == "absolute") -# { -# p <- 100*((parmVec[3] - respl)/(parmVec[3] - parmVec[2])) -# } else { -# p <- respl -# } -# if ( (parmVec[1] < 0) && (reference == "control") ) -# { -# p <- 100 - p -# } - p <- EDhelper(parmVec, respl, reference, type) + p <- EDhelper(parmVec, respl, reference, type) tempVal1 <- 100/(100-p) tempVal2 <- log(tempVal1^(1/parmVec[5]) - 1) @@ -228,6 +241,25 @@ fctName, fctText) 0, 0, 1, tempVal1^(1/parmVec[5]-1)/(parmVec[1]*parmVec[5]*(tempVal1^(1/parmVec[5]-1)))) + ## Fix: correct c and d derivatives for absolute type using central differences. + ## The analytical derivatives above miss the chain-rule contribution from + ## the absolute-to-relative conversion (EDhelper), where p depends on c and d. + if (identical(type, "absolute")) { + .edval <- function(pv) { + p0 <- EDhelper(pv, respl, reference, type) + tv1 <- 100 / (100 - p0) + tv2 <- log(tv1^(1 / pv[5]) - 1) + pv[4] + tv2 / pv[1] + } + .eps <- .Machine$double.eps + for (.i in c(2, 3)) { + .h <- if (abs(parmVec[.i]) > sqrt(.eps)) abs(parmVec[.i]) * .eps^(1/3) else .eps^(1/3) + .pvUp <- replace(parmVec, .i, parmVec[.i] + .h) + .pvDn <- replace(parmVec, .i, parmVec[.i] - .h) + lEDder[.i] <- (.edval(.pvUp) - .edval(.pvDn)) / (2 * .h) + } + } + return(list(lEDp, lEDder[notFixed])) } @@ -259,7 +291,6 @@ fctName, fctText) returnList <- list(fct = fct, ssfct = ssfct, names = names, deriv1 = deriv1, deriv2 = deriv2, derivx = derivx, edfct = edfct, bfct = bfct, inversion = invfct, -# lowerc=lowerLimits, upperc=upperLimits, name = fctName, text = fctText, noParm = sum(is.na(fixed)), @@ -271,21 +302,78 @@ fctName, fctText) invisible(returnList) } +#' Construct Text for Model with Fixed Lower and Upper Limits +#' +#' Helper function that appends lower and upper limit information to a model +#' description string. +#' +#' @param modelStr character string with the base model description. +#' @param upper numeric value for the fixed upper limit. +#' +#' @return A character string describing the model with its fixed limits. +#' +#' @keywords internal lowupFixed <- function(modelStr, upper) { paste(modelStr, "with lower limit at 0 and upper limit at", upper) } +#' Construct Text for Model with Fixed Lower Limit +#' +#' Helper function that appends lower limit information to a model description +#' string. +#' +#' @param modelStr character string with the base model description. +#' +#' @return A character string describing the model with its fixed lower limit. +#' +#' @keywords internal lowFixed <- function(modelStr) { paste(modelStr, "with lower limit at 0") } +#' Construct Text for Model with Fixed Upper Limit +#' +#' Helper function that appends upper limit information to a model description +#' string. +#' +#' @param modelStr character string with the base model description. +#' @param upper numeric value for the fixed upper limit. +#' +#' @return A character string describing the model with its fixed upper limit. +#' +#' @keywords internal upFixed <- function(modelStr, upper) { paste(modelStr, "with upper limit at", upper) } +#' Two-Parameter Log-Logistic Model with log(ED50) as Parameter +#' +#' A two-parameter log-logistic model where the lower limit is fixed at 0 and +#' the upper limit is fixed at a specified value (default 1). The estimated +#' parameters are the slope \code{b} and the log(ED50) \code{e}. +#' +#' @param upper numeric value giving the fixed upper limit. Defaults to 1. +#' @param fixed numeric vector of length 2. Specifies which parameters are +#' fixed and at what value. Use \code{NA} for parameters that should be +#' estimated. +#' @param names character vector of length 2 giving the names of the +#' parameters \code{b} and \code{e}. +#' @param \dots additional arguments passed to \code{\link{llogistic2}}. +#' +#' @return A list of class \code{"llogistic"} with the nonlinear function, +#' self-starter, and related components. +#' +#' @seealso \code{\link{llogistic2}}, \code{\link{LL2.3}}, \code{\link{LL2.4}}, +#' \code{\link{LL2.5}} +#' +#' @examples +#' earthworms.m1 <- drm(number/total ~ dose, weights = total, +#' data = earthworms, fct = LL2.2(), type = "binomial") +#' +#' @keywords models nonlinear "LL2.2" <- function(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) { @@ -301,6 +389,28 @@ function(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) ...) ) } +#' Three-Parameter Log-Logistic Model with log(ED50) and Lower Limit at 0 +#' +#' A three-parameter log-logistic model where the lower limit is fixed at 0. +#' The estimated parameters are the slope \code{b}, the upper limit \code{d}, +#' and the log(ED50) \code{e}. +#' +#' @param fixed numeric vector of length 3. Specifies which parameters are +#' fixed and at what value. Use \code{NA} for parameters that should be +#' estimated. +#' @param names character vector of length 3 giving the names of the +#' parameters \code{b}, \code{d}, and \code{e}. +#' @param \dots additional arguments passed to \code{\link{llogistic2}}. +#' +#' @return A list of class \code{"llogistic"} with the nonlinear function, +#' self-starter, and related components. +#' +#' @seealso \code{\link{llogistic2}}, \code{\link{LL2.2}}, \code{\link{LL2.4}} +#' +#' @examples +#' ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL2.3()) +#' +#' @keywords models nonlinear "LL2.3" <- function(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) { @@ -316,6 +426,26 @@ function(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) ...) ) } +#' Three-Parameter Log-Logistic Model with log(ED50) and Fixed Upper Limit +#' +#' A three-parameter log-logistic model where the upper limit is fixed at a +#' specified value (default 1). The estimated parameters are the slope \code{b}, +#' the lower limit \code{c}, and the log(ED50) \code{e}. +#' +#' @param upper numeric value giving the fixed upper limit. Defaults to 1. +#' @param fixed numeric vector of length 3. Specifies which parameters are +#' fixed and at what value. Use \code{NA} for parameters that should be +#' estimated. +#' @param names character vector of length 3 giving the names of the +#' parameters \code{b}, \code{c}, and \code{e}. +#' @param \dots additional arguments passed to \code{\link{llogistic2}}. +#' +#' @return A list of class \code{"llogistic"} with the nonlinear function, +#' self-starter, and related components. +#' +#' @seealso \code{\link{llogistic2}}, \code{\link{LL2.2}}, \code{\link{LL2.3}} +#' +#' @keywords models nonlinear "LL2.3u" <- function(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...) { @@ -331,6 +461,29 @@ function(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...) ...) ) } +#' Four-Parameter Log-Logistic Model with log(ED50) as Parameter +#' +#' A four-parameter log-logistic model where the ED50 is parameterised on the +#' log scale. The asymmetry parameter \code{f} is fixed at 1. The estimated +#' parameters are the slope \code{b}, the lower limit \code{c}, the upper +#' limit \code{d}, and the log(ED50) \code{e}. +#' +#' @param fixed numeric vector of length 4. Specifies which parameters are +#' fixed and at what value. Use \code{NA} for parameters that should be +#' estimated. +#' @param names character vector of length 4 giving the names of the +#' parameters \code{b}, \code{c}, \code{d}, and \code{e}. +#' @param \dots additional arguments passed to \code{\link{llogistic2}}. +#' +#' @return A list of class \code{"llogistic"} with the nonlinear function, +#' self-starter, and related components. +#' +#' @seealso \code{\link{llogistic2}}, \code{\link{LL2.3}}, \code{\link{LL2.5}} +#' +#' @examples +#' spinach.m1 <- drm(SLOPE ~ DOSE, CURVE, data = spinach, fct = LL2.4()) +#' +#' @keywords models nonlinear "LL2.4" <- function(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) { @@ -343,6 +496,28 @@ function(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) fctName = as.character(match.call()[[1]]), ...) ) } +#' Five-Parameter Generalised Log-Logistic Model with log(ED50) as Parameter +#' +#' A five-parameter generalised log-logistic model where the ED50 is +#' parameterised on the log scale. All five parameters (\code{b}, \code{c}, +#' \code{d}, \code{e}, \code{f}) are estimated. +#' +#' @param fixed numeric vector of length 5. Specifies which parameters are +#' fixed and at what value. Use \code{NA} for parameters that should be +#' estimated. +#' @param names character vector of length 5 giving the names of the +#' parameters \code{b}, \code{c}, \code{d}, \code{e}, and \code{f}. +#' @param \dots additional arguments passed to \code{\link{llogistic2}}. +#' +#' @return A list of class \code{"llogistic"} with the nonlinear function, +#' self-starter, and related components. +#' +#' @seealso \code{\link{llogistic2}}, \code{\link{LL2.3}}, \code{\link{LL2.4}} +#' +#' @examples +#' ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL2.5()) +#' +#' @keywords models nonlinear "LL2.5" <- function(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...) { diff --git a/R/lnormal.r b/R/lnormal.R similarity index 60% rename from R/lnormal.r rename to R/lnormal.R index 4bea32ae..aeeaffb0 100644 --- a/R/lnormal.r +++ b/R/lnormal.R @@ -1,3 +1,42 @@ +#' @title Log-normal dose-response model +#' +#' @description +#' \code{lnormal} provides a general framework for specifying the mean function of the +#' decreasing or increasing log-normal dose-response model. +#' +#' @param fixed numeric vector. Specifies which parameters are fixed and at what value they are fixed. +#' NAs for parameters that are not fixed. +#' @param names vector of character strings giving the names of the parameters (should not contain ":"). +#' The order of the parameters is: b, c, d, e. +#' @param method character string indicating the self starter function to use. +#' @param ssfct a self starter function to be used. +#' @param fctName optional character string used internally by convenience functions. +#' @param fctText optional character string used internally by convenience functions. +#' @param loge logical indicating whether or not ED50 or log(ED50) should be a parameter in the model. +#' By default ED50 is a model parameter. +#' +#' @details +#' For the case where log(ED50) is a parameter in the model, the mean function is: +#' \deqn{f(x) = c + (d-c)(\Phi(b(\log(x)-e)))} +#' and in case ED50 is a parameter: +#' \deqn{f(x) = c + (d-c)(\Phi(b(\log(x)-\log(e))))} +#' +#' For \eqn{c=0} and \eqn{d=1}, the model reduces to the classic probit model. +#' +#' @return A list containing the non-linear function, the self starter function +#' and the parameter names. +#' +#' @references +#' Finney, D. J. (1971) \emph{Probit analysis}, London: Cambridge University Press. +#' +#' Bruce, R. D. and Versteeg, D. J. (1992) A statistical procedure for modeling continuous toxicity data, +#' \emph{Environ. Toxicol. Chem.}, \bold{11}, 1485--1494. +#' +#' @author Christian Ritz +#' +#' @seealso The log-logistic model \code{\link{llogistic}} is very similar to the log-normal model. +#' +#' @keywords models nonlinear "lnormal" <- function( fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), method = c("1", "2", "3", "4"), ssfct = NULL, @@ -30,7 +69,6 @@ fctName, fctText, loge = FALSE) tempVec <- .expr9 * .expr4 tempVec[!is.finite(tempVec)] <- 0 .grad[, "b"] <- .expr1 * tempVec -# .grad[, "b"] <- .expr1 * (.expr9 * .expr4) .grad[, "c"] <- 1 - .expr6 .grad[, "d"] <- .expr6 .grad[, "e"] <- -(.expr1 * (.expr9 * (b * (1/e)))) @@ -56,7 +94,6 @@ fctName, fctText, loge = FALSE) tempVec <- .expr8 * .expr3 tempVec[!is.finite(tempVec)] <- 0 .grad[, "b"] <- .expr1 * tempVec -# .grad[, "b"] <- .expr1 * (.expr8 * .expr3) .grad[, "c"] <- 1 - .expr5 .grad[, "d"] <- .expr5 .grad[, "e"] <- -(.expr1 * (.expr8 * b)) @@ -73,54 +110,10 @@ fctName, fctText, loge = FALSE) parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE) parmMat[, notFixed] <- parm -# parmMat[,2] + (parmMat[,3] - parmMat[,2]) * exp(-exp(parmMat[,1] *(dose - parmMat[,4]))) fd(dose, parmMat[, 1], parmMat[, 2], parmMat[, 3], parmMat[, 4]) } ## Defining the self starter function -#if (FALSE) -#{ -# ssfct <- function(dframe) -# { -# x <- dframe[, 1] -# y <- dframe[, 2] -# -# zeroVal <- 1e-12 -# cVal <- 0.99 * ifelse(notFixed[2], min(y), fixed[2]) -# dVal <- 1.01 * ifelse(notFixed[3], max(y), fixed[3]) -# -# ## Finding b and e based on linear regression -# findbe <- function(x, y, -# transx = function(x) -# { -# xVec <- log(x) -# xVec[!is.finite(xVec)] <- NA -# xVec -# }, -# transy = function(y) -# { -# denomVal <- 1.01 * max(dVal - y) -# qnorm((dVal - y) / denomVal) -## qnorm((dVal - y)/(dVal - cVal)) -# }) -# { -# transY <- transy(y) -# transX <- transx(x) -# -# lmFit <- lm(transY ~ transX) -# coefVec <- coef(lmFit) -## bVal <- coefVec[2] -# bVal <- ifelse(notFixed[1], -coefVec[2], fixed[1]) -## eVal <- -coefVec[1] / bVal -# eVal <- ifelse(notFixed[4], backe(coefVec[1] / bVal), fixed[4]) -# -# return(as.vector(c(bVal, eVal))) -# } -# beVec <- findbe(x, y) -# -# c(beVec[1], cVal, dVal, beVec[2])[notFixed] -# } -#} if (!is.null(ssfct)) { ssfct <- ssfct # in case it is explicitly provided @@ -164,16 +157,6 @@ fctName, fctText, loge = FALSE) edfct <- function(parm, respl, reference, type, ...) { parmVec[notFixed] <- parm -# if (type == "absolute") -# { -# p <- 100*((parmVec[3] - respl)/(parmVec[3] - parmVec[2])) -# } else { -# p <- respl -# } -# if ( (parmVec[1] < 0) && (reference == "control") ) -# { -# p <- 100 - p -# } p <- absToRel(parmVec, respl, type) ## Reversing p @@ -187,7 +170,6 @@ fctName, fctText, loge = FALSE) } pProp <- 1 - (100-p) / 100 -# EDp <- parmVec[4] * exp(qnorm(1-p) / parmVec[1]) if (!loge) { @@ -206,24 +188,6 @@ fctName, fctText, loge = FALSE) .value } } else { -# -# ## Calculating ED on the original scale -# ## deriv(~exp(e) * exp(22 / b), c("b", "c", "d", "e"), function(b,c,d,e){}) -# ## using "22" instead of qnorm(pProp) -# EDfct <- function (b, c, d, e) -# { -# .expr1 <- exp(e) -# .expr3 <- exp(qnorm(pProp) / b) -# .expr4 <- .expr1 * .expr3 -# .value <- .expr4 -# .grad <- array(0, c(length(.value), 4L), list(NULL, c("b", "c", "d", "e"))) -# .grad[, "b"] <- -(.expr1 * (.expr3 * (qnorm(pProp) / (b^2)))) -# .grad[, "c"] <- 0 -# .grad[, "d"] <- 0 -# .grad[, "e"] <- .expr4 -# attr(.value, "gradient") <- .grad -# .value -# } ## Calculating ED on the log scale ## deriv(~e + 22 / b, c("b", "c", "d", "e"), function(b,c,d,e){}) ## using "22" instead of qnorm(pProp) @@ -241,6 +205,30 @@ fctName, fctText, loge = FALSE) } EDp <- EDfct(parmVec[1], parmVec[2], parmVec[3], parmVec[4]) EDder <- attr(EDfct(parmVec[1], parmVec[2], parmVec[3], parmVec[4]), "gradient") + + ## Fix: correct c and d derivatives for absolute type using central differences. + ## The analytical derivatives above miss the chain-rule contribution from + ## the absolute-to-relative conversion (absToRel), where p depends on c and d. + if (identical(type, "absolute")) { + .edval <- function(pv) { + p0 <- absToRel(pv, respl, type) + p0 <- 100 - p0 # reversal for absolute type + pProp0 <- 1 - (100 - p0) / 100 + if (!loge) { + pv[4] * exp(qnorm(pProp0) / pv[1]) + } else { + pv[4] + qnorm(pProp0) / pv[1] + } + } + .eps <- .Machine$double.eps + for (.i in c(2, 3)) { + .h <- if (abs(parmVec[.i]) > sqrt(.eps)) abs(parmVec[.i]) * .eps^(1/3) else .eps^(1/3) + .pvUp <- replace(parmVec, .i, parmVec[.i] + .h) + .pvDn <- replace(parmVec, .i, parmVec[.i] - .h) + EDder[.i] <- (.edval(.pvUp) - .edval(.pvDn)) / (2 * .h) + } + } + return(list(EDp, EDder[notFixed])) } @@ -261,6 +249,22 @@ fctName, fctText, loge = FALSE) invisible(returnList) } +#' @title Two-parameter log-normal dose-response model +#' +#' @description +#' \code{LN.2} is a convenience function for the log-normal model with lower limit fixed at 0 +#' and upper limit fixed (default 1), corresponding to the classic probit model. +#' +#' @param upper numeric specifying the fixed upper horizontal asymptote. Default is 1. +#' @param fixed numeric vector of length 2 specifying fixed parameters (NAs for free parameters). +#' @param names character vector of parameter names. +#' @param ... additional arguments passed to \code{\link{lnormal}}. +#' +#' @return A list (see \code{\link{lnormal}}). +#' +#' @seealso \code{\link{lnormal}}, \code{\link{LN.3}}, \code{\link{LN.4}} +#' +#' @keywords models nonlinear "LN.2" <- function(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) { @@ -275,6 +279,20 @@ function(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) fctText = lowupFixed("Log-normal", upper), ...) ) } +#' @title Three-parameter log-normal dose-response model +#' +#' @description +#' \code{LN.3} is a convenience function for the log-normal model with the lower limit fixed at 0. +#' +#' @param fixed numeric vector of length 3 specifying fixed parameters (NAs for free parameters). +#' @param names character vector of parameter names. +#' @param ... additional arguments passed to \code{\link{lnormal}}. +#' +#' @return A list (see \code{\link{lnormal}}). +#' +#' @seealso \code{\link{lnormal}}, \code{\link{LN.2}}, \code{\link{LN.4}} +#' +#' @keywords models nonlinear "LN.3" <- function(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) { @@ -289,6 +307,21 @@ function(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) fctText = lowFixed("Log-normal"), ...) ) } +#' @title Three-parameter log-normal model with upper limit fixed +#' +#' @description +#' \code{LN.3u} is a convenience function for the log-normal model with the upper limit fixed (default 1). +#' +#' @param upper numeric specifying the fixed upper horizontal asymptote. Default is 1. +#' @param fixed numeric vector of length 3 specifying fixed parameters (NAs for free parameters). +#' @param names character vector of parameter names. +#' @param ... additional arguments passed to \code{\link{lnormal}}. +#' +#' @return A list (see \code{\link{lnormal}}). +#' +#' @seealso \code{\link{lnormal}}, \code{\link{LN.2}}, \code{\link{LN.3}}, \code{\link{LN.4}} +#' +#' @keywords models nonlinear "LN.3u" <- function(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...) { @@ -304,6 +337,20 @@ function(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...) ...) ) } +#' @title Four-parameter log-normal dose-response model +#' +#' @description +#' \code{LN.4} is a convenience function for the full four-parameter log-normal model. +#' +#' @param fixed numeric vector of length 4 specifying fixed parameters (NAs for free parameters). +#' @param names character vector of parameter names. +#' @param ... additional arguments passed to \code{\link{lnormal}}. +#' +#' @return A list (see \code{\link{lnormal}}). +#' +#' @seealso \code{\link{lnormal}}, \code{\link{LN.2}}, \code{\link{LN.3}} +#' +#' @keywords models nonlinear "LN.4" <- function(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) { diff --git a/R/lnormal.ssf.R b/R/lnormal.ssf.R index e5ef06fa..bab55e7b 100644 --- a/R/lnormal.ssf.R +++ b/R/lnormal.ssf.R @@ -1,33 +1,35 @@ -"lnormal.ssf" <- function(method = c("1", "2", "3", "4"), fixed, loge, useFixed = FALSE) -{ - method <- match.arg(method) - - ## Defining helper functions (used below) - ytrans <- function(y, cVal, dVal) {qnorm((y-cVal)/(dVal-cVal))} - bfct <- function(x, y, cVal, dVal, eVal) {ytrans(y, cVal, dVal)/log(x/eVal)} - efct <- function(x, y, bVal, cVal, dVal) {x * exp(-ytrans(y, cVal, dVal)/bVal)} - - ## Assigning function for finding initial b and e parameter values - findbe <- switch(method, - "1" = findbe1(function(x) {rVec <- log(x); rVec[!x>0] <- NA; rVec}, - function(y, cVal, dVal) {qnorm((dVal - y) / (1.01 * max(dVal - y)))}, -1), - "2" = findbe2(bfct, efct, "Anke", -1), - "3" = findbe3(-1), - "4" = findbe2(bfct, efct, "Normolle", -1)) - - function(dframe) - { - x <- dframe[, 1] - y <- dframe[, 2] - - ## Finding initial values for c and d parameters - cdVal <- findcd(x, y) - if (useFixed) {} # not implemented at the moment - - ## Finding initial values for b and e parameters - beVal <- findbe(x, y, cdVal[1], cdVal[2]) - if (loge) {beVal[2] <- log(beVal[2])} - - return(c(beVal[1], cdVal, beVal[2])[is.na(fixed)]) - } +#' @title Self-starter for log-normal model +#' @keywords internal +"lnormal.ssf" <- function(method = c("1", "2", "3", "4"), fixed, loge, useFixed = FALSE) +{ + method <- match.arg(method) + + ## Defining helper functions (used below) + ytrans <- function(y, cVal, dVal) {qnorm((y-cVal)/(dVal-cVal))} + bfct <- function(x, y, cVal, dVal, eVal) {ytrans(y, cVal, dVal)/log(x/eVal)} + efct <- function(x, y, bVal, cVal, dVal) {x * exp(-ytrans(y, cVal, dVal)/bVal)} + + ## Assigning function for finding initial b and e parameter values + findbe <- switch(method, + "1" = findbe1(function(x) {rVec <- log(x); rVec[!x>0] <- NA; rVec}, + function(y, cVal, dVal) {qnorm((dVal - y) / (1.01 * max(dVal - y)))}, -1), + "2" = findbe2(bfct, efct, "Anke", -1), + "3" = findbe3(-1), + "4" = findbe2(bfct, efct, "Normolle", -1)) + + function(dframe) + { + x <- dframe[, 1] + y <- dframe[, 2] + + ## Finding initial values for c and d parameters + cdVal <- findcd(x, y) + if (useFixed) {} # not implemented at the moment + + ## Finding initial values for b and e parameters + beVal <- findbe(x, y, cdVal[1], cdVal[2]) + if (loge) {beVal[2] <- log(beVal[2])} + + return(c(beVal[1], cdVal, beVal[2])[is.na(fixed)]) + } } \ No newline at end of file diff --git a/R/logLik.drc.R b/R/logLik.drc.R index 3e8cfe42..2a7614e1 100644 --- a/R/logLik.drc.R +++ b/R/logLik.drc.R @@ -1,3 +1,24 @@ +#' @title Extracting the log likelihood +#' +#' @description +#' \code{logLik} extracts the value of the log likelihood function evaluated +#' at the parameter estimates. +#' +#' @param object an object of class 'drc'. +#' @param ... additional arguments. +#' +#' @return The evaluated log likelihood as a numeric value and the +#' corresponding degrees of freedom as well as the number of observations +#' as attributes. +#' +#' @examples +#' ## Fitting a four-parameter log-logistic model +#' ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +#' logLik(ryegrass.m1) +#' +#' @author Christian Ritz +#' +#' @keywords models nonlinear "logLik.drc" <- function(object, ...) { ## Retrieving the value of the log likelihood function evaluated at the parameter estimates diff --git a/R/logistic.R b/R/logistic.R new file mode 100644 index 00000000..6a9fe5a8 --- /dev/null +++ b/R/logistic.R @@ -0,0 +1,280 @@ +#' The general asymmetric five-parameter logistic model +#' +#' The five-parameter logistic model given by the expression +#' \deqn{f(x) = c + \frac{d - c}{(1 + \exp(b(x - e)))^f}} +#' +#' This model differs from the log-logistic in that it uses \code{x} directly +#' rather than \code{log(x)}. It is sometimes referred to as the Boltzmann model. +#' +#' @param fixed numeric vector of length 5. Specifies which parameters are fixed +#' and at what value they are fixed. \code{NA} indicates that the corresponding +#' parameter is not fixed. +#' @param names character vector of length 5 giving the names of the parameters +#' \code{(b, c, d, e, f)}. Default is \code{c("b", "c", "d", "e", "f")}. +#' @param method character string indicating the self starter function to use +#' (\code{"1"}, \code{"2"}, \code{"3"}, or \code{"4"}). +#' @param ssfct a self starter function to be used. If \code{NULL} (default), +#' a built-in self starter is selected via \code{method}. +#' @param fctName optional character string used internally to overwrite the +#' function name. +#' @param fctText optional character string used internally to overwrite the +#' description text. +#' +#' @return A list of class \code{"Boltzmann"} containing the nonlinear function, +#' self starter function, and parameter names. +#' +#' @author Christian Ritz +#' +#' @seealso \code{\link{L.3}}, \code{\link{L.4}}, \code{\link{L.5}}, +#' \code{\link{llogistic}} +#' +#' @keywords models nonlinear +#' +#' @examples +#' ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = L.4()) +"logistic" <- function( +fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), +method = c("1", "2", "3", "4"), ssfct = NULL, +fctName, fctText) +{ + ## Checking arguments + numParm <- 5 + if (!is.character(names) | !(length(names) == numParm)) {stop("Not correct 'names' argument")} + if (!(length(fixed) == numParm)) {stop("Not correct 'fixed' argument")} + + ## Handling 'fixed' argument + notFixed <- is.na(fixed) + parmVec <- rep(0, numParm) + parmVec[!notFixed] <- fixed[!notFixed] + + ## Defining the non-linear function + fct <- function(dose, parm) + { + parmMat <- matrix(parmVec, nrow(parm), numParm, byrow=TRUE) + parmMat[, notFixed] <- parm + + parmMat[,2]+(parmMat[,3]-parmMat[,2])/((1+exp(parmMat[,1]*(dose-parmMat[,4])))^parmMat[,5]) + } + + ## Defining self starter function + if (!is.null(ssfct)) + { + ssfct <- ssfct + } else { + ssfct <- logistic.ssf(method, fixed) + } + + ## Defining names + names <- names[notFixed] + + ##Defining the first derivatives (in the parameters) + deriv1 <- function(dose, parm) + { + parmMat <- matrix(parmVec, nrow(parm), numParm, byrow=TRUE) + parmMat[, notFixed] <- parm + + t1 <- parmMat[, 3] - parmMat[, 2] + t2 <- exp(parmMat[, 1]*(dose - parmMat[, 4])) + t3 <- (1 + t2)^(2*parmMat[, 5]) + t4 <- parmMat[, 5]*((1 + t2)^(-parmMat[, 5] - 1)) + t5 <- (1 + t2)^(parmMat[, 5]) + + cbind( -t1*t2*t4*(dose - parmMat[ , 4]), + 1 - 1/t5, + 1/t5, + t1*t2*t4*parmMat[, 1], + -t1*log(1+t2)/t5 )[, notFixed] + } + + deriv2 <- NULL + + ##Defining the first derivatives (in x) + derivx <- function(x, parm) + { + parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE) + parmMat[, notFixed] <- parm + + temp1 <- exp(parmMat[, 1]*(x - parmMat[, 4])) + + (-parmMat[, 5]*(parmMat[, 3] - parmMat[, 2])*temp1*parmMat[, 1])/((1 + temp1)^(parmMat[, 5] + 1)) + } + + ## Defining the ED function + edfct <- function(parm, respl, reference = "control", type = "relative", ...) + { + parmVec[notFixed] <- parm + + ## Convert absolute response level to relative. + ## Note: unlike log-logistic models where b < 0 means decreasing, + ## the logistic model has b < 0 = increasing. EDhelper's p-swap + ## (for b < 0, relative type) would be wrong here, so we perform + ## only the absolute-to-relative conversion inline. + if (identical(type, "absolute")) { + p <- 100 * ((parmVec[3] - respl) / (parmVec[3] - parmVec[2])) + } else { + p <- respl + } + + ## deriv(~e + log((100/(100-p))^(1/f) - 1) / b, c("b", "c", "d", "e", "f"), function(b,c,d,e,f){}) + ## evaluated at the R prompt + EDderFct <- + function (b, c, d, e, f) + { + .expr2 <- 100/p + .expr4 <- .expr2^(1/f) + .expr5 <- .expr4 - 1 + .expr6 <- log(.expr5) + .value <- e + .expr6/b + .grad <- array(0, c(length(.value), 5L), list(NULL, c("b", "c", "d", "e", "f"))) + .grad[, "b"] <- -(.expr6/b^2) + .grad[, "c"] <- 0 + .grad[, "d"] <- 0 + .grad[, "e"] <- 1 + .grad[, "f"] <- -(.expr4 * (log(.expr2) * (1/f^2))/.expr5/b) + attr(.value, "gradient") <- .grad + .value + } + EDcalc <- EDderFct(parmVec[1], parmVec[2], parmVec[3], parmVec[4], parmVec[5]) + EDp <- as.numeric(EDcalc) + EDder <- attr(EDcalc, "gradient") + + ## Fix: correct c and d derivatives for absolute type using central differences. + ## The analytical derivatives above miss the chain-rule contribution from + ## the absolute-to-relative conversion, where p depends on c and d. + if (identical(type, "absolute")) { + .edval <- function(pv) { + p0 <- 100 * ((pv[3] - respl) / (pv[3] - pv[2])) + .expr2 <- 100 / p0 + .expr4 <- .expr2^(1 / pv[5]) + .expr5 <- .expr4 - 1 + pv[4] + log(.expr5) / pv[1] + } + .eps <- .Machine$double.eps + for (.i in c(2, 3)) { + .h <- if (abs(parmVec[.i]) > sqrt(.eps)) abs(parmVec[.i]) * .eps^(1/3) else .eps^(1/3) + .pvUp <- replace(parmVec, .i, parmVec[.i] + .h) + .pvDn <- replace(parmVec, .i, parmVec[.i] - .h) + EDder[.i] <- (.edval(.pvUp) - .edval(.pvDn)) / (2 * .h) + } + } + + return(list(EDp, EDder[notFixed])) + } + + ## Defining the inverse function + invfct <- function(y, parm) + { + parmVec[notFixed] <- parm + + log(((parmVec[3] - parmVec[2])/(y - parmVec[2]))^(1/parmVec[5]) - 1)/parmVec[1] + parmVec[4] + } + + ## Defining return list + returnList <- list(fct = fct, ssfct = ssfct, names = names, + deriv1 = deriv1, deriv2 = deriv2, derivx = derivx, edfct = edfct, + inversion = invfct, + name = ifelse(missing(fctName), as.character(match.call()[[1]]), fctName), + text = ifelse(missing(fctText), "Logistic (ED50 as parameter)", fctText), + noParm = sum(is.na(fixed)), fixed = fixed) + + class(returnList) <- "Boltzmann" + invisible(returnList) +} + +#' Three-parameter logistic model +#' +#' A three-parameter logistic model with the lower limit fixed at 0, given by +#' \deqn{f(x) = \frac{d}{1 + \exp(b(x - e))}} +#' +#' @param fixed numeric vector of length 3. Specifies which parameters are fixed +#' and at what value they are fixed. \code{NA} indicates that the corresponding +#' parameter is not fixed. +#' @param names character vector of length 3 giving the names of the parameters +#' \code{(b, d, e)}. Default is \code{c("b", "d", "e")}. +#' @param ... additional arguments passed to \code{\link{logistic}}. +#' +#' @return A list of class \code{"Boltzmann"} containing the nonlinear function, +#' self starter function, and parameter names. +#' +#' @seealso \code{\link{logistic}}, \code{\link{L.4}}, \code{\link{L.5}} +#' +#' @keywords models nonlinear +#' +#' @examples +#' ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = L.3()) +"L.3" <- +function(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) +{ + ## Checking arguments + numParm <- 3 + if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct names argument")} + if (!(length(fixed)==numParm)) {stop("Not correct length of 'fixed' argument")} + + return(logistic(fixed = c(fixed[1], 0, fixed[2:3], 1), names = c(names[1], "c", names[2:3], "f"), + fctName = as.character(match.call()[[1]]), + fctText = "Logistic (ED50 as parameter) with lower limit fixed at 0", ...)) +} + +#' Four-parameter logistic model +#' +#' A four-parameter logistic model (symmetric, with \code{f = 1}), given by +#' \deqn{f(x) = c + \frac{d - c}{1 + \exp(b(x - e))}} +#' +#' @param fixed numeric vector of length 4. Specifies which parameters are fixed +#' and at what value they are fixed. \code{NA} indicates that the corresponding +#' parameter is not fixed. +#' @param names character vector of length 4 giving the names of the parameters +#' \code{(b, c, d, e)}. Default is \code{c("b", "c", "d", "e")}. +#' @param ... additional arguments passed to \code{\link{logistic}}. +#' +#' @return A list of class \code{"Boltzmann"} containing the nonlinear function, +#' self starter function, and parameter names. +#' +#' @seealso \code{\link{logistic}}, \code{\link{L.3}}, \code{\link{L.5}} +#' +#' @keywords models nonlinear +#' +#' @examples +#' ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = L.4()) +"L.4" <- +function(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) +{ + ## Checking arguments + numParm <- 4 + if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct names argument")} + if (!(length(fixed)==numParm)) {stop("Not correct length of 'fixed' argument")} + + return(logistic(fixed = c(fixed, 1), names = c(names, "f"), + fctName = as.character(match.call()[[1]]), + fctText = "Logistic (ED50 as parameter)", ...)) +} + +#' Five-parameter generalized logistic model +#' +#' A five-parameter generalized logistic model (asymmetric when \code{f != 1}), +#' given by +#' \deqn{f(x) = c + \frac{d - c}{(1 + \exp(b(x - e)))^f}} +#' +#' @param fixed numeric vector of length 5. Specifies which parameters are fixed +#' and at what value they are fixed. \code{NA} indicates that the corresponding +#' parameter is not fixed. +#' @param names character vector of length 5 giving the names of the parameters +#' \code{(b, c, d, e, f)}. Default is \code{c("b", "c", "d", "e", "f")}. +#' @param ... additional arguments passed to \code{\link{logistic}}. +#' +#' @return A list of class \code{"Boltzmann"} containing the nonlinear function, +#' self starter function, and parameter names. +#' +#' @seealso \code{\link{logistic}}, \code{\link{L.3}}, \code{\link{L.4}} +#' +#' @keywords models nonlinear +#' +#' @examples +#' ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = L.5()) +"L.5" <- +function(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...) +{ + return(logistic(fixed = fixed, names = names, + fctName = as.character(match.call()[[1]]), + fctText = "Generalised logistic (ED50 as parameter)", ...)) +} diff --git a/R/logistic.r b/R/logistic.r deleted file mode 100644 index 12037b00..00000000 --- a/R/logistic.r +++ /dev/null @@ -1,256 +0,0 @@ -"logistic" <- function( -fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), -method = c("1", "2", "3", "4"), ssfct = NULL, -fctName, fctText) -{ - ## Checking arguments - numParm <- 5 - if (!is.character(names) | !(length(names) == numParm)) {stop("Not correct 'names' argument")} - if (!(length(fixed) == numParm)) {stop("Not correct 'fixed' argument")} - - ## Handling 'fixed' argument - notFixed <- is.na(fixed) - parmVec <- rep(0, numParm) - parmVec[!notFixed] <- fixed[!notFixed] -# parmVec1 <- parmVec -# parmVec2 <- parmVec - - - ## Defining the non-linear function - fct <- function(dose, parm) - { - parmMat <- matrix(parmVec, nrow(parm), numParm, byrow=TRUE) - parmMat[, notFixed] <- parm - - parmMat[,2]+(parmMat[,3]-parmMat[,2])/((1+exp(parmMat[,1]*(dose-parmMat[,4])))^parmMat[,5]) - } - - ## Defining self starter function -if (FALSE) -{ - ssfct <- function(dataFra) - { - dose2 <- dataFra[,1] - resp3 <- dataFra[,2] - - startVal <- rep(0, numParm) - - startVal[3] <- max(resp3) + 0.001 # the d parameter -# startVal[3] <- mean(resp3[dose2 == max(dose2)]) + 0.001 - - startVal[2] <- min(resp3) - 0.001 # the c parameter -# startVal[2] <- mean(resp3[dose2 == min(dose2)]) + (1e-8)*((max(resp3) - min(resp3))/max(resp3)) - - startVal[5] <- 1 # better choice may be possible! -# startVal[!notFixed] <- fixed[!notFixed] - - if (length(unique(dose2))==1) {return((c(NA, NA, startVal[3], NA, NA))[notFixed])} # only estimate of upper limit if a single unique dose value - - logitTrans <- log((startVal[3] - resp3)/(resp3 - startVal[2])) # 0.001 to avoid 0 in the denominator -# print(logitTrans) - - logitFit <- lm(logitTrans ~ dose2) - startVal[4] <- -coef(logitFit)[1]/coef(logitFit)[2] # the e parameter - startVal[1] <- coef(logitFit)[2] # the b parameter - - return(startVal[notFixed]) - } -} - if (!is.null(ssfct)) - { - ssfct <- ssfct - } else { - ssfct <- logistic.ssf(method, fixed) - } - - ## Defining names - names <- names[notFixed] - - ##Defining the first derivatives (in the parameters) - deriv1 <- function(dose, parm) - { - parmMat <- matrix(parmVec, nrow(parm), numParm, byrow=TRUE) - parmMat[, notFixed] <- parm - - t1 <- parmMat[, 3] - parmMat[, 2] - t2 <- exp(parmMat[, 1]*(dose - parmMat[, 4])) - t3 <- (1 + t2)^(2*parmMat[, 5]) - t4 <- parmMat[, 5]*((1 + t2)^(-parmMat[, 5] - 1)) - t5 <- (1 + t2)^(parmMat[, 5]) - - cbind( -t1*t2*t4*(dose - parmMat[ , 4]), - 1 - 1/t5, - 1/t5, - t1*t2*t4*parmMat[, 1], - -t1*log(1+t2)/t5 )[, notFixed] - } - - deriv2 <- NULL - - ##Defining the first derivatives (in x) - derivx <- function(x, parm) - { - parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE) - parmMat[, notFixed] <- parm - - temp1 <- exp(parmMat[, 1]*(x - parmMat[, 4])) - - (-parmMat[, 5]*(parmMat[, 3] - parmMat[, 2])*temp1*parmMat[, 1])/((1 + temp1)^(parmMat[, 5] + 1)) - } - - ## Defining the ED function - edfct <- function(parm, p, ...) - { - parmVec[notFixed] <- parm - -# if (parmVec[1] > 0) -# { -# tempVal <- (100 - p) / 100 -# old=wrong EDp <- parmVec[4] + log( (1 + exp(-parmVec[1]*parmVec[4])) / (tempVal^(1/parmVec[5])) - 1)/parmVec[1] - -# old=wrong ## deriv(~e + log( (1 + exp(-b*e)) / (((100 - p) / 100)^(1/f)) - 1)/b, c("b", "c", "d", "e", "f"), function(b,c,d,e,f){}) - - ## deriv(~e + log((100/(100-p))^(1/f) - 1) / b, c("b", "c", "d", "e", "f"), function(b,c,d,e,f){}) - ## evaluated at the R prompt - EDderFct <- - function (b, c, d, e, f) - { - .expr2 <- 100/p - .expr4 <- .expr2^(1/f) - .expr5 <- .expr4 - 1 - .expr6 <- log(.expr5) - .value <- e + .expr6/b - .grad <- array(0, c(length(.value), 5L), list(NULL, c("b", "c", "d", "e", "f"))) - .grad[, "b"] <- -(.expr6/b^2) - .grad[, "c"] <- 0 - .grad[, "d"] <- 0 - .grad[, "e"] <- 1 - .grad[, "f"] <- -(.expr4 * (log(.expr2) * (1/f^2))/.expr5/b) - attr(.value, "gradient") <- .grad - .value - } - EDcalc <- EDderFct(parmVec[1], parmVec[2], parmVec[3], parmVec[4], parmVec[5]) - EDp <- as.numeric(EDcalc) - EDder <- attr(EDcalc, "gradient") - -# old = wrong -# function (b, c, d, e, f) -# { -# .expr3 <- exp(-b * e) -# .expr4 <- 1 + .expr3 -# .expr6 <- (100 - p)/100 -# .expr8 <- .expr6^(1/f) -# .expr10 <- .expr4/.expr8 - 1 -# .expr11 <- log(.expr10) -# .value <- e + .expr11/b -# .grad <- array(0, c(length(.value), 5L), list(NULL, c("b", "c", "d", "e", "f"))) -# .grad[, "b"] <- -(.expr3 * e/.expr8/.expr10/b + .expr11/b^2) -# .grad[, "c"] <- 0 -# .grad[, "d"] <- 0 -# .grad[, "e"] <- 1 - .expr3 * b/.expr8/.expr10/b -# .grad[, "f"] <- .expr4 * (.expr8 * (log(.expr6) * (1/f^2)))/.expr8^2/.expr10/b -# attr(.value, "gradient") <- .grad -# .value -# } -# EDder <- attr(EDderFct(parmVec[1], parmVec[2], parmVec[3], parmVec[4], parmVec[5]), "gradient") - - -# } else { -# tempVal1 <- p / 100 -# tempVal2 <- (1 / (tempVal1 / ((1 + exp(-parmVec[1]*parmVec[4]))^parmVec[5]) + 1 - tempVal1))^(1/parmVec[5]) -# EDp <- parmVec[4] + log(tempVal2 - 1) / parmVec[1] -# EDder <- NULL -# } - -# tempVal <- -log((100-p)/100) -# EDp <- parmVec[4] + log(exp(tempVal/parmVec[5])-1)/parmVec[1] -# -# EDder <- c(-log(exp(tempVal/parmVec[5])-1)/(parmVec[1]^2), -# 0, -# 0, -# 1, -# -exp(tempVal/parmVec[5])*tempVal/(parmVec[5]^2)*(1/parmVec[1])*((exp(tempVal/parmVec[5])-1)^(-1))) -# - return(list(EDp, EDder[notFixed])) - } - -# ## Defining the SI function -# sifct <- function(parm1, parm2, pair) -# { -# ED1 <- edfct(parm1, pair[1]) -# ED2 <- edfct(parm2, pair[2]) -# SIpair <- ED1[[1]] - ED2[[1]] # SI value on log scale -# SIder1 <- ED1[[2]] -# SIder2 <- ED2[[2]] -# -## SIpair <- ED1[[1]]/ED2[[1]] # calculating the SI value -## SIder1 <- ED1[[2]]/ED1[[1]]*SIpair -## SIder2 <- ED2[[2]]/ED2[[1]]*SIpair -# -# return(list(SIpair, SIder1, SIder2)) -# } - - ## Defining the inverse function - invfct <- function(y, parm) - { - parmVec[notFixed] <- parm - - log(((parmVec[3] - parmVec[2])/(y - parmVec[2]))^(1/parmVec[5]) - 1)/parmVec[1] + parmVec[4] - } - - ## Defining return list - returnList <- list(fct = fct, ssfct = ssfct, names = names, - deriv1 = deriv1, deriv2 = deriv2, derivx = derivx, edfct = edfct, - inversion = invfct, - name = ifelse(missing(fctName), as.character(match.call()[[1]]), fctName), - text = ifelse(missing(fctText), "Logistic (ED50 as parameter)", fctText), - noParm = sum(is.na(fixed)), fixed = fixed) - - class(returnList) <- "Boltzmann" - invisible(returnList) -} - -#"boltzmann" <- logistic - -"L.3" <- -function(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) -{ - ## Checking arguments - numParm <- 3 - if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct names argument")} - if (!(length(fixed)==numParm)) {stop("Not correct length of 'fixed' argument")} - - return(logistic(fixed = c(fixed[1], 0, fixed[2:3], 1), names = c(names[1], "c", names[2:3], "f"), - fctName = as.character(match.call()[[1]]), - fctText = "Logistic (ED50 as parameter) with lower limit fixed at 0", ...)) -} - -#b3 <- B.3 -#L.3 <- B.3 - -"L.4" <- -function(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) -{ - ## Checking arguments - numParm <- 4 - if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct names argument")} - if (!(length(fixed)==numParm)) {stop("Not correct length of 'fixed' argument")} - - return(logistic(fixed = c(fixed, 1), names = c(names, "f"), - fctName = as.character(match.call()[[1]]), - fctText = "Logistic (ED50 as parameter)", ...)) -} - -#b4 <- B.4 -#L.4 <- B.4 - -"L.5" <- -function(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...) -{ - return(logistic(fixed = fixed, names = names, - fctName = as.character(match.call()[[1]]), - fctText = "Generalised logistic (ED50 as parameter)", ...)) -} - -#b5 <- B.5 -#L.5 <- B.5 diff --git a/R/logistic.ssf.R b/R/logistic.ssf.R index ad15384c..be83adf9 100644 --- a/R/logistic.ssf.R +++ b/R/logistic.ssf.R @@ -1,34 +1,35 @@ -"logistic.ssf" <- function(method = c("1", "2", "3", "4"), fixed, useFixed = FALSE) -{ - method <- match.arg(method) - - ## Defining helper functions (used below) - ytrans <- function(y, cVal, dVal) {log((dVal - y)/(y - cVal))} - bfct <- function(x, y, cVal, dVal, eVal) {ytrans(y, cVal, dVal) / (x - eVal)} - efct <- function(x, y, bVal, cVal, dVal) {x - ytrans(y, cVal, dVal) / bVal} - - ## Assigning function for finding initial b and e parameter values - findbe <- switch(method, - "1" = findbe1(function(x){x}, ytrans, back = I), - "2" = findbe2(bfct, efct, "Anke"), - "3" = findbe3(), - "4" = findbe2(bfct, efct, "Normolle")) - - function(dframe) - { - x <- dframe[, 1] - y <- dframe[, 2] - - ## Finding initial values for c and d parameters - cdVal <- findcd(x, y) -# if (useFixed) {} # not implemented at the moment - - ## Finding initial values for b and e parameters - beVal <- findbe(x, y, cdVal[1], cdVal[2]) - - ## Finding initial value for f parameter - fVal <- 1 # better choice than 1 may be possible! - - return(c(beVal[1], cdVal, beVal[2], fVal)[is.na(fixed)]) - } -} +#' @title Self-starter for logistic model +#' @keywords internal +"logistic.ssf" <- function(method = c("1", "2", "3", "4"), fixed, useFixed = FALSE) +{ + method <- match.arg(method) + + ## Defining helper functions (used below) + ytrans <- function(y, cVal, dVal) {log((dVal - y)/(y - cVal))} + bfct <- function(x, y, cVal, dVal, eVal) {ytrans(y, cVal, dVal) / (x - eVal)} + efct <- function(x, y, bVal, cVal, dVal) {x - ytrans(y, cVal, dVal) / bVal} + + ## Assigning function for finding initial b and e parameter values + findbe <- switch(method, + "1" = findbe1(function(x){x}, ytrans, back = I), + "2" = findbe2(bfct, efct, "Anke"), + "3" = findbe3(), + "4" = findbe2(bfct, efct, "Normolle")) + + function(dframe) + { + x <- dframe[, 1] + y <- dframe[, 2] + + ## Finding initial values for c and d parameters + cdVal <- findcd(x, y) + + ## Finding initial values for b and e parameters + beVal <- findbe(x, y, cdVal[1], cdVal[2]) + + ## Finding initial value for f parameter + fVal <- 1 # better choice than 1 may be possible! + + return(c(beVal[1], cdVal, beVal[2], fVal)[is.na(fixed)]) + } +} diff --git a/R/maED.R b/R/maED.R index 5740b2ea..06a1314b 100644 --- a/R/maED.R +++ b/R/maED.R @@ -1,169 +1,372 @@ -"maED" <- function(object, fctList = NULL, respLev, interval = c("none", "buckland", "kang"), linreg = FALSE, -clevel = NULL, level = 0.95, type = c("relative", "absolute"), display = TRUE, na.rm = FALSE, extended = FALSE) -{ - interval <- match.arg(interval) - type <- match.arg(type) -# print(linreg) -# print(level) +#' Estimation of ED values using model-averaging +#' +#' Estimates and confidence intervals for ED values are estimated using +#' model-averaging. +#' +#' Model-averaging of individual estimates is carried out as described by +#' Buckland \emph{et al.} (1997) and Kang \emph{et al.} (2000) using +#' AIC-based weights. The two approaches differ w.r.t. the calculation of +#' confidence intervals: Buckland \emph{et al.} (1997) provide an approximate +#' variance formula under the assumption of perfectly correlated estimates +#' (so, confidence intervals will tend to be too wide). Kang \emph{et al.} +#' (2000) use the model weights to calculate confidence limits as weighted +#' means of the confidence limits for the individual fits. +#' +#' @param object an object of class \code{drc}. +#' @param fctList a list of non-linear functions to be compared. +#' @param respLev a numeric vector containing the response levels. +#' @param interval character string specifying the type of confidence intervals +#' to be supplied. The default is \code{"none"}. The choices \code{"buckland"} +#' and \code{"kang"} are explained in the Details section. +#' @param linreg logical indicating whether or not additionally a simple linear +#' regression model should be fitted. +#' @param clevel character string specifying the curve id in case estimates for +#' a specific curve or compound are requested. By default estimates are shown +#' for all curves. +#' @param level numeric. The confidence level. Must be a single value strictly +#' between 0 and 1. The default is \code{0.95}. +#' @param type character string. Whether the specified response levels are +#' absolute or relative (default). +#' @param display logical. If \code{TRUE} results are displayed. Otherwise they +#' are not (useful in simulations). +#' @param na.rm logical indicating whether or not \code{NA} values occurring +#' during model fitting should be excluded from subsequent calculations. +#' @param extended logical specifying whether or not an extended output +#' (including fit summaries) should be returned. +#' +#' @return If \code{extended = FALSE}, a matrix with two or more columns +#' containing the model-averaged estimates and the corresponding estimated +#' standard errors and, optionally, lower and upper confidence limits. +#' If \code{extended = TRUE}, a list with components: +#' \describe{ +#' \item{estimates}{Matrix of model-averaged ED estimates and intervals.} +#' \item{fits}{Matrix of per-model ED estimates and AIC-based weights.} +#' } +#' +#' @references +#' Buckland, S. T. and Burnham, K. P. and Augustin, N. H. (1997) +#' Model Selection: An Integral Part of Inference, +#' \emph{Biometrics} \bold{53}, 603--618. +#' +#' Kang, Seung-Ho and Kodell, Ralph L. and Chen, James J. (2000) +#' Incorporating Model Uncertainties along with Data Uncertainties in +#' Microbial Risk Assessment, +#' \emph{Regulatory Toxicology and Pharmacology} \bold{32}, 68--72. +#' +#' @author Christian Ritz, Hannes Reinwald +#' +#' @seealso The function \code{\link{mselect}} provides a summary of fit +#' statistics for several models fitted to the same data. +#' +#' @examples +#' ## Fitting an example dose-response model +#' ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +#' +#' ## Model-averaging with default settings (no confidence intervals) +#' maED( +#' ryegrass.m1, +#' list(LL.5(), LN.4(), W1.4(), W2.4(), FPL.4(-1, 1), FPL.4(-2, 3), FPL.4(-0.5, 0.5)), +#' c(10, 50, 90) +#' ) +#' +#' ## Model-averaging with Buckland confidence intervals +#' maED( +#' ryegrass.m1, +#' list(LL.5(), LN.4(), W1.4(), W2.4()), +#' c(10, 50, 90), +#' interval = "buckland" +#' ) +#' +#' ## Model-averaging with Kang confidence intervals +#' maED( +#' ryegrass.m1, +#' list(LL.5(), LN.4(), W1.4(), W2.4()), +#' c(10, 50, 90), +#' interval = "kang" +#' ) +#' +#' @keywords models nonlinear +#' @export +maED <- function( + object, + fctList = NULL, + respLev = c(10,20,50), + interval = c("none", "buckland", "kang"), + linreg = FALSE, + clevel = NULL, + level = 0.95, + type = c("relative", "absolute"), + display = TRUE, + na.rm = FALSE, + extended = FALSE +) { + + ## --- Input validation ------------------------------------------------------- + + if (!inherits(object, "drc")) { + stop("'object' must be of class 'drc'") + } + if (!is.numeric(respLev) || length(respLev) == 0) { + stop("'respLev' must be a non-empty numeric vector") + } + if (!is.numeric(level) || length(level) != 1 || level <= 0 || level >= 1) { + stop("'level' must be a single numeric value strictly between 0 and 1") + } + if (!is.logical(linreg) || length(linreg) != 1) { + stop("'linreg' must be a single logical value") + } + if (!is.logical(display) || length(display) != 1) { + stop("'display' must be a single logical value") + } + if (!is.logical(na.rm) || length(na.rm) != 1) { + stop("'na.rm' must be a single logical value") + } + if (!is.logical(extended) || length(extended) != 1) { + stop("'extended' must be a single logical value") + } + + ## --- Resolve enumerated arguments ------------------------------------------- + + interval <- match.arg(interval) + type <- match.arg(type) + + ## --- Handling multiple curves in a single dataset --------------------------- + + # When the parameter matrix has more than one column (i.e., multiple curves) + # and no specific curve has been requested, recurse over each curve + # individually and bind the results. + ncolPM <- ncol(object[["parmMat"]]) + + if (!identical(ncolPM, 1L) && is.null(clevel)) { + curveIds <- colnames(object[["parmMat"]]) + resultList <- vector("list", ncolPM) - ## Handling multiple curves in a single dataset - ncolPM <- ncol(object$"parmMat") - if ((!identical(ncolPM, 1)) && (is.null(clevel))) # is also TRUE for a single curve!!! - { - retMat <- NULL - for (i in 1:ncolPM) - { -# print((colnames(object$"parmMat"))[i]) - curveId <- (colnames(object$"parmMat"))[i] -# cat(curveId, "\n") - retMat <- rbind(retMat, - maED(object, fctList, respLev, interval, linreg = linreg, clevel = curveId, level = level, - type = type, display = display, na.rm = na.rm, extended = extended)) - } - return(retMat) - } else { # May 6 2010 - - interval <- match.arg(interval) - - msMat <- do.call("mselect", list(object = object, fctList = fctList, sorted = "no")) - -# expVec <- as.vector(exp(-msMat[, 2] / 2)) -# wVec <- expVec / sum(expVec, na.rm = na.rm) - # maybe better "combined" na.rm approach for edEst and wVec - -# ## Removing poor fits completely via a threshold (good approach?) -# wVec[wVec < 0.01] <- 0 - - lenfl <- length(fctList) - lenrl <- length(respLev) -# uniCID <- unique(S.alba.m1$data[, 4]) -# lenuniCID <- length(uniCID) - - numRows <- lenfl + 1 - numCols <- lenrl -# numCols <- lenrl * lenuniCID - - edEst <- matrix(NA, numRows + linreg, numCols) - edSe <- matrix(NA, numRows + linreg, numCols) -# print(c(numRows, numRows + linreg)) -# print(linreg) - - ## Defining 'interval' argument for ED - if (identical(interval, "kang")) - { - interval2 <- "delta" - } else { - interval2 <- "none" + for (i in seq_len(ncolPM)) { + resultList[[i]] <- maED( + object = object, + fctList = fctList, + respLev = respLev, + interval = interval, + linreg = linreg, + clevel = curveIds[i], + level = level, + type = type, + display = display, + na.rm = na.rm, + extended = extended + ) } - ## Calculating estimated ED values -# edMat <- ED(object, respLev, interval2, clevel, type = type, display = FALSE, multcomp = TRUE)[["EDdisplay"]] - edMat <- ED(object, respLev, interval2, clevel, type = type, display = FALSE) - edEst[1, ] <- as.vector((edMat)[, 1]) - edSe[1, ] <- as.vector((edMat)[, 2]) + return(do.call(rbind, resultList)) + } + + ## --- Model selection summary ------------------------------------------------ + + msMat <- do.call(mselect, list(object = object, fctList = fctList, sorted = "no")) + + ## --- Pre-allocate ED estimate and SE matrices ------------------------------- + + lenfl <- length(fctList) + lenrl <- length(respLev) + numRows <- lenfl + 1L + + edEst <- matrix(NA, numRows + linreg, lenrl) + edSe <- matrix(NA, numRows + linreg, lenrl) + + # Track which models failed to fit (try-error in ED computation) + fitFailed <- logical(numRows + linreg) + + # Confidence limit matrices are always initialised to avoid undefined + # variable errors in the 'kang' result-construction block. + edCll <- matrix(NA, numRows, lenrl) + edClu <- matrix(NA, numRows, lenrl) + + ## --- Set interval argument for individual ED calls -------------------------- + + # Delta-method intervals are required for the Kang approach; otherwise no + # per-model interval is needed because Buckland uses the SE directly. + interval2 <- if (identical(interval, "kang")) "delta" else "none" + + ## --- ED estimates for the original model ------------------------------------ + + edMat <- ED(object, respLev, interval2, clevel, type = type, display = FALSE) + edEst[1, ] <- edMat[, 1] + edSe[1, ] <- edMat[, 2] + + if (identical(interval2, "delta")) { + edCll[1, ] <- edMat[, 3] + edClu[1, ] <- edMat[, 4] + } + + ## --- ED estimates for each model in fctList --------------------------------- + + for (i in seq_len(lenfl)) { + edMati <- try( + ED( + update(object, fct = fctList[[i]]), + respLev, + interval2, + clevel, + type = type, + display = FALSE + ), + silent = TRUE + ) - if (identical(interval2, "delta")) - { - edCll <- matrix(NA, numRows, numCols) - edClu <- matrix(NA, numRows, numCols) - - edCll[1, ] <- as.vector((edMat)[, 3]) - edClu[1, ] <- as.vector((edMat)[, 4]) - } - for (i in 1:lenfl) - { -# edMati <- try(ED(update(object, fct = fctList[[i]]), respLev, interval2, clevel, type = type, display = FALSE, multcomp = TRUE)[["EDdisplay"]], silent = TRUE) - edMati <- try(ED(update(object, fct = fctList[[i]]), respLev, interval2, clevel, - type = type, display = FALSE), silent = TRUE) - if (inherits(edMati, "try-error")) - { - edMati <- matrix(NA, length(respLev), 4) - } - - edEst[i + 1, ] <- as.vector((edMati)[, 1]) - edSe[i + 1, ] <- as.vector((edMati)[, 2]) - if (identical(interval2, "delta")) - { - edCll[i + 1, ] <- as.vector((edMati)[, 3]) - edClu[i + 1, ] <- as.vector((edMati)[, 4]) - } + if (inherits(edMati, "try-error")) { + edMati <- matrix(NA, length(respLev), 4) + fitFailed[i + 1L] <- TRUE } -# print(edEst) - ## Adding simple linear regression fit - if (linreg) - { - linFit1 <- lm(object$"data"[, 2:1]) - edLin <- ED.lin(linFit1, respLev) - edEst[lenfl + 2, ] <- unlist((edLin)[, 1]) - edSe[lenfl + 2, ] <- unlist((edLin)[, 2]) - - ## Updating weights - expVec <- as.vector(exp(-c(msMat[, 2], AIC(linFit1)) / 2)) + edEst[i + 1L, ] <- edMati[, 1] + edSe[i + 1L, ] <- edMati[, 2] - } else { - expVec <- as.vector(exp(-msMat[, 2] / 2)) - } -# print(edEst) - wVec <- expVec / sum(expVec, na.rm = na.rm) - - edVec <- apply(edEst * wVec, 2, sum, na.rm = na.rm) - if (identical(interval, "none")) - { - retMat <- as.matrix(cbind(edVec)) - colnames(retMat) <- colnames(edMat)[1] + if (identical(interval2, "delta")) { + edCll[i + 1L, ] <- edMati[, 3] + edClu[i + 1L, ] <- edMati[, 4] } - if (identical(interval, "buckland")) - { - seVec <- apply(sqrt(edSe^2 + (t(t(edEst) - apply(edEst, 2, mean, na.rm = na.rm)))^2) * wVec, 2, - sum, na.rm = na.rm) -### Thresholding -# iVec <- wVec < 0.01 -# seVec <- apply(sqrt(edSe[iVec, ]^2 + (t(t(edEst[iVec, ]) - apply(edEst[iVec, ], 2, -# mean, na.rm = na.rm)))^2) * wVec[iVec], 2, sum, na.rm = na.rm) - quantVal <- qnorm(1 - (1 - level)/2) * seVec - retMat <- as.matrix(cbind(edVec, seVec, edVec - quantVal, edVec + quantVal)) - colnames(retMat) <- c(colnames(edMat)[c(1, 2)], "Lower", "Upper") + } + + ## --- Optional linear regression fit ---------------------------------------- + + if (linreg) { + linFit1 <- lm(object[["data"]][, 2:1]) + edLin <- ED.lin(linFit1, respLev) + edEst[lenfl + 2L, ] <- unlist(edLin[, 1]) + edSe[lenfl + 2L, ] <- unlist(edLin[, 2]) + + # Include linear model AIC in the weight calculation. + expVec <- as.vector(exp(-c(msMat[, 2], AIC(linFit1)) / 2)) + } else { + expVec <- as.vector(exp(-msMat[, 2] / 2)) + } + + ## --- Filter out models with non-finite ED estimates or fitting failures ---- + + # Save original ED estimates for display (so excluded models still show + # their Inf/NaN/NA values in the fit summary, making the reason for + # exclusion visible). + edEstDisplay <- edEst + + # Identify models where any ED estimate is non-finite (Inf or NaN). + nonFiniteMask <- apply(edEst, 1, function(x) any(is.infinite(x) | is.nan(x))) + + # Combined exclusion mask: non-finite ED values OR model fitting failures. + excludeMask <- nonFiniteMask | fitFailed + + if (any(excludeMask)) { + modelNames <- if (linreg) c(rownames(msMat), "Lin") else rownames(msMat) + for (k in which(excludeMask)) { + if (fitFailed[k]) { + warning( + "Model '", modelNames[k], "' excluded from model-averaging: ", + "model fitting or ED estimation failed", + call. = FALSE + ) + } else { + badIdx <- which(is.infinite(edEst[k, ]) | is.nan(edEst[k, ])) + warning( + "Model '", modelNames[k], "' excluded from model-averaging: ", + "non-finite ED value(s) detected (", + paste0("ED", respLev[badIdx], "=", edEst[k, badIdx], collapse = ", "), ")", + call. = FALSE + ) + } } - if (identical(interval, "kang")) - { - retMat <- as.matrix(cbind(apply(edEst * wVec, 2, sum, na.rm = na.rm), - apply(edCll * wVec, 2, sum, na.rm = na.rm), - apply(edClu * wVec, 2, sum, na.rm = na.rm))) - colnames(retMat) <- colnames(edMat)[c(1,3,4)] - } - rownames(retMat) <- rownames(edMat) - - ## Constructing matrix of fit summaries - disMat <- as.matrix(cbind(edEst, wVec)) -# colnames(disMat) <- c(paste("EC", rownames(edMat), sep = ""), "Weight") - colnames(disMat) <- c(paste("ED", respLev, sep = ""), "Weight") -# rownames(disMat) <- rownames(msMat) - if (linreg) - { - rownames(disMat) <- c(rownames(msMat), "Lin") + edEst[excludeMask, ] <- NA + edSe[excludeMask, ] <- NA + excludeCI <- excludeMask[seq_len(numRows)] + edCll[excludeCI, ] <- NA + edClu[excludeCI, ] <- NA + } + + ## --- AIC-based model weights ------------------------------------------------ + + # Excluded models (non-finite ED or fitting failures) always get zero + # weight, regardless of the na.rm parameter. + expVec[excludeMask] <- 0 + + # When models were excluded, na.rm must be TRUE in downstream sums so + # that the NA placeholders left above do not propagate. For the + # remaining (non-excluded) models, the user-supplied na.rm still governs + # how NA values from fitting failures are handled. + effectiveNaRm <- na.rm || any(excludeMask) + + totalWeight <- sum(expVec, na.rm = effectiveNaRm) + + if (totalWeight == 0) { + warning("No valid models remaining for model-averaging", call. = FALSE) + wVec <- rep(0, length(expVec)) + edVec <- rep(NA_real_, lenrl) + } else { + wVec <- expVec / totalWeight + edVec <- apply(edEst * wVec, MARGIN = 2, FUN = sum, na.rm = effectiveNaRm) + } + + ## --- Construct result matrix ------------------------------------------------ + + if (identical(interval, "none")) { + retMat <- as.matrix(cbind(edVec)) + colnames(retMat) <- colnames(edMat)[1] + + } else if (identical(interval, "buckland")) { + if (totalWeight == 0) { + seVec <- rep(NA_real_, lenrl) } else { - rownames(disMat) <- rownames(msMat) - } - -# if (lenuniCID > 1) -# { -# rownames(disMat) <- paste(rownames(msMat), uniCID, sep = "-") -# } else { -# rownames(disMat) <- rownames(msMat) -# } - if (display) - { - print(disMat) - cat("\n") + seVec <- apply( + sqrt(edSe^2 + (t(t(edEst) - apply(edEst, MARGIN = 2, FUN = mean, na.rm = effectiveNaRm)))^2) * wVec, + MARGIN = 2, + FUN = sum, + na.rm = effectiveNaRm + ) } + quantVal <- qnorm(1 - (1 - level) / 2) * seVec + retMat <- as.matrix(cbind(edVec, seVec, edVec - quantVal, edVec + quantVal)) + colnames(retMat) <- c(colnames(edMat)[c(1, 2)], "Lower", "Upper") -# resPrint(resMat, "Estimated effective doses", interval, "Model-averaging", display) - if (extended) - { - return(list(estimates = retMat, fits = disMat)) + } else { + if (totalWeight == 0) { + seVec <- rep(NA_real_, lenrl) + retMat <- matrix(NA_real_, lenrl, 4) } else { - retMat + seVec <- apply( + sqrt(edSe^2 + (t(t(edEst) - apply(edEst, MARGIN = 2, FUN = mean, na.rm = effectiveNaRm)))^2) * wVec, + MARGIN = 2, + FUN = sum, + na.rm = effectiveNaRm + ) + retMat <- as.matrix(cbind( + apply(edEst * wVec, MARGIN = 2, FUN = sum, na.rm = effectiveNaRm), + seVec, + apply(edCll * wVec, MARGIN = 2, FUN = sum, na.rm = effectiveNaRm), + apply(edClu * wVec, MARGIN = 2, FUN = sum, na.rm = effectiveNaRm) + )) } - } #May 6 2010 -} \ No newline at end of file + colnames(retMat) <- c(colnames(edMat)[c(1, 2)], "Lower", "Upper") + } + + rownames(retMat) <- rownames(edMat) + + ## --- Construct fit summary matrix ------------------------------------------- + + # Use original (unfiltered) ED estimates for display so that excluded + # models show their Inf/NaN values alongside their zero weight. + disMat <- as.matrix(cbind(edEstDisplay, wVec)) + colnames(disMat) <- c(paste0("ED", respLev), "Weight") + rownames(disMat) <- if (linreg) c(rownames(msMat), "Lin") else rownames(msMat) + + ## --- Optional display ------------------------------------------------------- + + if (display) { + print(disMat) + cat("\n") + } + + ## --- Return ----------------------------------------------------------------- + + if (extended) { + return(list(estimates = retMat, fits = disMat)) + } + + return(retMat) +} diff --git a/R/max.R b/R/max.R new file mode 100644 index 00000000..dc3882ac --- /dev/null +++ b/R/max.R @@ -0,0 +1,175 @@ +#' Maximum mean response +#' +#' Estimates the maximum mean response and the dose at which it occurs, using a +#' bisection method to locate the peak of the fitted dose-response curve. This +#' function is only implemented for the built-in model functions of class +#' \code{\link{braincousens}} and \code{\link{cedergreen}}, which are capable of +#' exhibiting hormesis (i.e., a non-monotone response with a stimulatory effect +#' at low doses). +#' +#' @param object an object of class \code{drc}, fitted using \code{\link{drm}} +#' with a hormesis model such as \code{\link{CRS.4c}} or \code{\link{BC.4}}. +#' +#' @param lower numeric. Lower bound of the interval used by the bisection +#' method to search for the dose at maximum response. Must be strictly smaller +#' than \code{upper} and should be set below the expected dose at maximum +#' response. Defaults to \code{1e-3}. +#' +#' @param upper numeric. Upper bound of the interval used by the bisection +#' method to search for the dose at maximum response. Must be strictly larger +#' than \code{lower} and should be set above the expected dose at maximum +#' response. Defaults to \code{1000}. +#' +#' @param pool logical. If \code{TRUE} (default), curves are pooled when +#' computing the variance-covariance matrix. Otherwise they are not. This +#' argument only works for models with independently fitted curves as +#' specified in \code{\link{drm}}. Note: currently the variance-covariance +#' matrix is retrieved for internal consistency but standard errors are not +#' yet reported in the output. +#' +#' @return Invisibly returns a numeric matrix with one row per curve in the +#' data set and two columns: +#' \describe{ +#' \item{Dose}{The dose at which the maximum mean response occurs, found +#' via bisection within \code{[lower, upper]}.} +#' \item{Response}{The estimated maximum mean response at that dose.} +#' } +#' Row names correspond to curve identifiers. If the computation fails for a +#' given curve, the corresponding row will contain \code{NA} values and a +#' warning is issued. The matrix is also printed to the console via +#' \code{\link{printCoefmat}}. +#' +#' @details +#' The function numerically locates the dose \eqn{d^*} that maximises the fitted +#' dose-response curve over the search interval \code{[lower, upper]}: +#' \deqn{d^* = \arg\max_{d} f(d, \hat{\theta})} +#' where \eqn{f} is the fitted dose-response function and \eqn{\hat{\theta}} is +#' the vector of estimated parameters. The search is performed using a bisection +#' approach defined internally by the model's \code{maxfct} component. +#' +#' It is the user's responsibility to ensure that the true maximum lies within +#' \code{[lower, upper]}. If the maximum falls outside this interval, the +#' function will silently return a boundary value and a warning is issued. +#' +#' @references +#' Cedergreen, N., Ritz, C., and Streibig, J. C. (2005) Improved empirical +#' models describing hormesis, \emph{Environmental Toxicology and Chemistry} +#' \bold{24}, 3166--3172. +#' +#' @author Christian Ritz. Issues fixed and documentation enhanced by Hannes Reinwald. +#' +#' @examples +#' ## Fitting a Cedergreen-Ritz-Streibig model +#' lettuce.m1 <- drm(weight ~ conc, data = lettuce, fct = CRS.4c()) +#' +#' ## Finding the maximum mean response and the corresponding dose +#' MAX(lettuce.m1) +#' +#' ## Custom search interval +#' MAX(lettuce.m1, lower = 1e-5, upper = 500) +#' +#' ## Capture the result matrix +#' result <- MAX(lettuce.m1) +#' result["Dose"] +#' +#' @keywords models nonlinear +"MAX" <- function(object, lower = 1e-3, upper = 1000, pool = TRUE) +{ + + # 1. Validate class of 'object' + if (!inherits(object, "drc")) { + stop("'object' must be of class 'drc'. Please supply a model fitted with drm().") + } + + + # 2. Check that the model supports MAX (braincousens / cedergreen) + MAXlist <- object[["fct"]][["maxfct"]] + if (is.null(MAXlist)) { + stop(paste( + "No 'maxfct' method available for this model.", + "MAX() is only supported for 'braincousens' and 'cedergreen' model classes." + )) + } + + + # 3. Validate lower / upper bounds + if (!is.numeric(lower) || length(lower) != 1 || !is.finite(lower)) { + stop("'lower' must be a single finite numeric value.") + } + if (!is.numeric(upper) || length(upper) != 1 || !is.finite(upper)) { + stop("'upper' must be a single finite numeric value.") + } + if (lower >= upper) { + stop(paste0( + "'lower' (", lower, ") must be strictly less than 'upper' (", upper, ")." + )) + } + + + # 4. Retrieve relevant model components + indexMat <- object[["indexMat"]] + parmMat <- object[["parmMat"]] + strParm <- colnames(parmMat) + + # vcov is retrieved for future SE support; pool affects its computation + varMat <- tryCatch( + vcov(object, pool = pool), + error = function(e) { + warning("Could not compute variance-covariance matrix: ", e$message) + NULL + } + ) + + + # 5. Initialise output — use NA to distinguish failure from zero + ncolIM <- ncol(indexMat) + indexVec <- seq_len(ncolIM) + dimNames <- vector("character", ncolIM) + MAXmat <- matrix(NA_real_, nrow = ncolIM, ncol = 2) + + + # 6. Loop over each curve + for (i in indexVec) + { + # Curve label — fall back gracefully if missing + curveName <- if (!is.null(strParm) && !is.na(strParm[i])) strParm[i] else paste0("Curve_", i) + dimNames[i] <- curveName + parmChosen <- parmMat[, i] + + # Attempt to compute maximum for this curve + MAXmat[i, ] <- tryCatch( + { + result <- MAXlist(parmChosen, lower, upper) + + # Warn if the optimum landed on a boundary (likely out-of-range) + # Use unname() so that named return values (e.g. from cedergreen) are + # compared correctly with the unnamed lower/upper scalars. + # A tolerance of 1e-3 is used because numerical optimisers (e.g. + # optimize()) return values near—but not exactly at—the boundary. + bnd_tol <- 1e-3 + if (isTRUE(all.equal(unname(result[1]), lower, tolerance = bnd_tol)) || + isTRUE(all.equal(unname(result[1]), upper, tolerance = bnd_tol))) { + warning( + "The estimated maximum dose for curve '", curveName, + "' is at the boundary of [lower, upper] = [", lower, ", ", upper, "]. ", + "Consider widening the search interval." + ) + } + result + }, + error = function(e) { + warning( + "MAX computation failed for curve '", curveName, "': ", e$message, + ". Returning NA for this curve." + ) + c(NA_real_, NA_real_) + } + ) + } + + + # 7. Format and return + dimnames(MAXmat) <- list(dimNames, c("Dose", "Response")) + printCoefmat(MAXmat, na.print = "NA") + invisible(MAXmat) +} diff --git a/R/max.r b/R/max.r deleted file mode 100644 index 4ff8d99b..00000000 --- a/R/max.r +++ /dev/null @@ -1,33 +0,0 @@ -"MAX" <- function( -object, lower = 1e-3, upper = 1000, pool = TRUE) -{ - ## Checking class of 'object' - MAXlist <- object[[11]]$"maxfct" - if (is.null(MAXlist)) {stop("No method available")} - - ## Retrieving relevant quantities - indexMat <- object$"indexMat" - parm <- as.vector(coef(object)) - parmMat <- object$"parmMat" - strParm <- colnames(parmMat) - varMat <- vcov(object, pool = pool) - - ## Calculating ED values - ncolIM <- ncol(indexMat) - indexVec <- 1:ncolIM - dimNames <- rep("", ncolIM) - MAXmat <- matrix(0, ncolIM, 2) - - for (i in indexVec) - { - parmInd <- indexMat[,i] - varCov <- varMat[parmInd, parmInd] - parmChosen <- parmMat[,i] - MAXmat[i, ] <- MAXlist(parmChosen, lower, upper) - dimNames[i] <- strParm[i] - } - - dimnames(MAXmat) <- list(dimNames, c("Dose", "Response")) - printCoefmat(MAXmat) - invisible(MAXmat) -} diff --git a/R/mixture.r b/R/mixture.R similarity index 78% rename from R/mixture.r rename to R/mixture.R index 19bd44ac..5e524ca6 100644 --- a/R/mixture.r +++ b/R/mixture.R @@ -1,3 +1,32 @@ +#' Fitting binary mixture models +#' +#' \code{mixture} fits a concentration addition, Hewlett or Voelund model to data from binary +#' mixture toxicity experiments. +#' +#' The function is a wrapper to \code{\link{drm}}, implementing the models described in +#' Soerensen et al. (2007). See the paper for a discussion of the merits of the different models. +#' +#' Currently only the log-logistic models are available. Application of Box-Cox transformation +#' is not yet available. +#' +#' @param object object of class 'drc' corresponding to the model with freely varying EC50 values. +#' @param model character string. It can be "CA", "Hewlett" or "Voelund". +#' @param start optional numeric vector supplying starting values for all parameters in the +#' mixture model. +#' @param startm optional numeric vector supplying the lambda parameter in the Hewlett model or +#' the eta parameters (two parameters) in the Voelund model. +#' @param control list of arguments controlling constrained optimisation (zero as boundary), +#' maximum number of iteration in the optimisation, relative tolerance in the optimisation, +#' warnings issued during the optimisation. +#' +#' @return An object of class 'drc' with a few additional components. +#' +#' @references Ritz, C. and Streibig, J. C. (2014) From additivity to synergism - A +#' modelling perspective \emph{Synergy}, \bold{1}, 22--29. +#' +#' @author Christian Ritz +#' +#' @keywords models nonlinear "mixture" <- function(object, model = c("CA", "Hewlett", "Voelund"), start, startm, control = drmc()) { model <- match.arg(model) @@ -19,11 +48,6 @@ blstr <- paste(bListEl, collapse = "") el1str <- paste(eListEl1, collapse = "") el2str <- paste(eListEl2, collapse = "") -# -# print(bListEl) -# print(eListEl1) -# print(eListEl2) - fct <- object$"fct" if (model == "CA") { @@ -125,9 +149,6 @@ if (missing(startm)) {startm <- c(3, 0.3)} } -# assign("collapseNew2", collapseNew2, envir = .GlobalEnv) - - ## Checking if levels 0 and 100 are present assayNo <- object$"dataList"$"curveid" if (all(regexpr("0", as.character(unique(assayNo))) < 0 )) @@ -144,20 +165,6 @@ parNames1 <- object$"parNames"[[1]] parNames2 <- object$"parNames"[[3]] -# eNames <- as.character(parNames2[regexpr(paste(eName, ":", sep=""), parNames1, fixed = TRUE) > 0]) -# eInd <- grep(paste(eName, ":", sep = ""), parNames1) -# eNames <- as.character(parNames2[eInd]) - -# pos0 <- match(paste("factor(", curveid, ")0", sep = ""), eNames) -# pos1 <- match(paste("factor(", curveid, ")100", sep = ""), eNames) -# if (is.na(pos0)) {pos0 <- 1} # it is the intercept -# if (is.na(pos1)) {pos1 <- 1} -# -# noED50 <- length(eNames) -# noB <- length(coef(object)) - noED50 - noLim -# sv2 <- sv[c(1:(noB + noLim), noB + noLim + pos0, noB + noLim + pos1)] -# sv2[noB+noLim+2] <- sv2[noB+noLim+1] + sv2[noB+noLim+2] - if (missing(start)) { sv2 <- c(sv[-grep(paste(eName, ":", sep = ""), parNames1)], @@ -168,12 +175,7 @@ sv3 <- start } -# print(mixtfct) -# print(collapseNew2) -# print(sv3) mModel <- update(object, fct = mixtfct, pmodels = collapseNew2, start = sv3, control = control) - -# rm(collapseNew2, envir = .GlobalEnv) mModel$deviance <- object$"fit"$"value" diff --git a/R/modelFit.R b/R/modelFit.R index e32267b3..42551278 100644 --- a/R/modelFit.R +++ b/R/modelFit.R @@ -1,3 +1,39 @@ +#' @title Assessing the model fit +#' +#' @description +#' Checking the fit of a dose-response model by means of formal significance tests. +#' +#' @param object object of class 'drc'. +#' @param test character string defining the test method to apply. +#' @param method character string specifying the method to be used for assessing the model fit. +#' +#' @details +#' Currently two methods are available. For continuous data the classical lack-of-fit test is +#' applied (Bates and Watts, 1988). The test compares the dose-response model to a more general +#' ANOVA model using an approximate F-test. For quantal data the crude goodness-of-fit test +#' based on Pearson's statistic is used. +#' +#' None of these tests are very powerful. A significant test result is more alarming than a +#' non-significant one. +#' +#' @return An object of class 'anova' which will be displayed in much the same way as an +#' ordinary ANOVA table. +#' +#' @references +#' Bates, D. M. and Watts, D. G. (1988) +#' \emph{Nonlinear Regression Analysis and Its Applications}, +#' New York: Wiley & Sons (pp. 103--104). +#' +#' @author Christian Ritz +#' +#' @examples +#' ## Comparing the four-parameter log-logistic model +#' ## to a one-way ANOVA model using an approximate F test +#' ## in other words applying a lack-of-fit test +#' ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) +#' modelFit(ryegrass.m1) +#' +#' @keywords models nonlinear "modelFit" <- function(object, test = NULL, method = c("gof", "cum")) { method <- match.arg(method) @@ -50,7 +86,16 @@ loglik <- c(anovaSS, nlsSS) testStat <- (nlsSS - anovaSS)/dfDiff[2]/(anovaSS/anovaDF) - pVal <- c(NA, pf(testStat, dfDiff[2], anovaDF, lower.tail = FALSE)) + # Handle edge cases for the F-test p-value + if (is.nan(testStat)) { + pVal <- c(NA, NA) + } else if (testStat < 0) { + pVal <- c(NA, 1) + } else if (is.infinite(testStat)) { + pVal <- c(NA, NA) + } else { + pVal <- c(NA, pf(testStat, dfDiff[2], anovaDF, lower.tail = FALSE)) + } testStat <- c(NA, testStat) headName<-"Lack-of-fit test\n" diff --git a/R/modelFunction.R b/R/modelFunction.R index f411f3c5..df4c899c 100644 --- a/R/modelFunction.R +++ b/R/modelFunction.R @@ -1,48 +1,47 @@ -modelFunction <- function(dose, parm2mat, drcFct, cm, assayNoOld, upperPos, retFct, - doseScaling, respScaling, isFinite, pshifts = NULL) -{ - if (!is.null(retFct)) - { - drcFct <- retFct(doseScaling, respScaling) - } - drcFct1 <- function(dose, parm) - { - parmVal <- parm2mat(parm) -# print(c(dim(pshifts), dim(parmVal))) - if ((!is.null(pshifts)) & all(dim(pshifts) == dim(parmVal))) - { - parmVal <- parmVal + pshifts - } -# drcFct(dose, (parm2mat(parm))[isFinite, , drop = FALSE]) - drcFct(dose, parmVal[isFinite, , drop = FALSE]) - } - - if (is.null(cm)) - { - multCurves <- function(dose, parm) - { - drcFct1(dose, parm) - } - } else { # not adapting to scaling (not using drcFct1)!!! - iv <- isFinite & (assayNoOld == cm) - niv <- !iv - fctEval <- rep(0, length(dose)) - - multCurves <- function(dose, parm) - { - parmVal <- (parm2mat(parm))[isFinite, , drop = FALSE] -# print(c(dim(pweights), dim(parmVal))) - if ((!is.null(pshifts)) & all(dim(pshifts) == dim(parmVal))) - { - parmVal <- parmVal + pshifts - } - fctEval[iv] <- parmVal[iv, upperPos, drop = FALSE] - fctEval[niv] <- drcFct(dose[niv], parmVal[niv, , drop = FALSE]) - - fctEval - } - } - - multCurves -} - +#' @title Create model evaluation function +#' @keywords internal +modelFunction <- function(dose, parm2mat, drcFct, cm, assayNoOld, upperPos, retFct, + doseScaling, respScaling, isFinite, pshifts = NULL) +{ + if (!is.null(retFct)) + { + drcFct <- retFct(doseScaling, respScaling) + } + drcFct1 <- function(dose, parm) + { + parmVal <- parm2mat(parm) + if ((!is.null(pshifts)) & all(dim(pshifts) == dim(parmVal))) + { + parmVal <- parmVal + pshifts + } + drcFct(dose, parmVal[isFinite, , drop = FALSE]) + } + + if (is.null(cm)) + { + multCurves <- function(dose, parm) + { + drcFct1(dose, parm) + } + } else { # not adapting to scaling (not using drcFct1)!!! + iv <- isFinite & (assayNoOld == cm) + niv <- !iv + fctEval <- rep(0, length(dose)) + + multCurves <- function(dose, parm) + { + parmVal <- (parm2mat(parm))[isFinite, , drop = FALSE] + if ((!is.null(pshifts)) & all(dim(pshifts) == dim(parmVal))) + { + parmVal <- parmVal + pshifts + } + fctEval[iv] <- parmVal[iv, upperPos, drop = FALSE] + fctEval[niv] <- drcFct(dose[niv], parmVal[niv, , drop = FALSE]) + + fctEval + } + } + + multCurves +} + diff --git a/R/mr.test.R b/R/mr.test.R index 7a904ada..e9270612 100644 --- a/R/mr.test.R +++ b/R/mr.test.R @@ -1,8 +1,58 @@ +#' Mizon-Richard test for dose-response models +#' +#' The function provides a lack-of-fit test for the mean structure based on the +#' Mizon-Richard test as compared to a specific alternative model. +#' +#' The function provides a p-value indicating whether or not the mean structure is appropriate. +#' +#' The test is applicable even in cases where data are non-normal or exhibit variance +#' heterogeneity. +#' +#' @param object1 object of class 'drc' (null model). +#' @param object2 object of class 'drc' (alternative model). +#' @param object object of class 'drc' (fitted model under alternative). +#' @param x numeric vector of dose values. +#' @param var.equal logical indicating whether or not equal variances can be assumed across doses. +#' @param component numeric vector specifying the component(s) in the parameter vector to use +#' in the test. +#' +#' @return A p-value for test of the null hypothesis that the chosen mean structure is +#' appropriate as compared to the alternative mean structure provided (see Ritz and +#' Martinussen (2011) for a detailed explanation). +#' +#' @note This functionality is still experimental: Currently, the null and alternative models +#' are hardcoded! In the future the function will be working for null and alternative models +#' specified by the user. +#' +#' @references Ritz, C and Martinussen, T. (2011) Lack-of-fit tests for assessing mean +#' structures for continuous dose-response data, \emph{Environmental and Ecological +#' Statistics}, \bold{18}, 349--366 +#' +#' @author Christian Ritz +#' +#' @seealso See also \code{\link{modelFit}} for details on the related lack-of-fit test +#' against an ANOVA model. +#' +#' @examples +#' ## Fitting log-logistic and Weibull models +#' ## The Weibull model is the alternative +#' etmotc.m1<-drm(rgr1~dose1, data=etmotc[1:15,], fct=LL.4()) +#' etmotc.m2 <- update(etmotc.m1, fct=W1.4()) +#' +#' ## Fitting the fitted model (using the alternative model) +#' etmotc.m3 <- drm(fitted(etmotc.m1)~dose1, data=etmotc[1:15,], fct=W1.4()) +#' +#' ## Handling missing values +#' xVec <- etmotc[1:15,]$dose1 +#' xVec[1:8] <- 1e-10 # avoiding 0's +#' +#' ## Obtaining the Mizon-Richard test +#' mr.test(etmotc.m1, etmotc.m2, etmotc.m3, xVec, var.equal = FALSE) +#' +#' @keywords models nonlinear "mr.test" <- function(object1, object2, object, x, var.equal = TRUE, component = 1) { dnFct <- deriv(~c+(d-c)/(1+(x/e)^b),c("b","c","d","e"), function(b,c,d,e,x){}, hessian = TRUE) -# dnFct <- deriv(~d*exp(-e*x),c("d","e"), function(d,e,x){}, hessian = TRUE) # exponential model -# dnFct <- deriv(~d*exp(-e/x),c("d","e"), function(d,e,x){}, hessian = TRUE) # exponential model daFct <- deriv(~c+(d-c)*exp(-exp(b*(log(x)-log(e)))),c("b","c","d","e"), function(b,c,d,e,x){}, hessian = TRUE) @@ -12,32 +62,15 @@ diffVec <- beta2 - beta lenx <- length(x) -# if (identical(var.equal, FALSE)) -# { -# res1 <- residuals(object1) -# res2 <- residuals(object2) -# } else { -# res1 <- rep(sqrt(summary(object1)$resVar), lenx) -# res2 <- res1 -# } -# res1 <- rep(1, lenx) -# res2 <- res1 - - Df1 <- attr(dnFct(beta1[1], beta1[2], beta1[3], beta1[4], x), "gradient") # * res1 -# Df1 <- attr(dnFct(beta1[1], beta1[2], x), "gradient") # exponential model + + Df1 <- attr(dnFct(beta1[1], beta1[2], beta1[3], beta1[4], x), "gradient") -# D2g1 <- attr(dnFct(theta1[1],theta1[2],theta1[3],theta1[4], x), "hessian") # not needed Df1Df1 <- matrix(apply(apply(Df1, 1, function(x){x%*%t(x)}), 1, mean), 4, 4) -# print(Df1) -# print(Df1Df1) - Df2 <- attr(daFct(beta2[1], beta2[2], beta2[3], beta2[4], x), "gradient") # * res1 + Df2 <- attr(daFct(beta2[1], beta2[2], beta2[3], beta2[4], x), "gradient") Df2Df2 <- matrix(apply(apply(Df2, 1, function(x){x%*%t(x)}), 1, mean), 4, 4) -# print(Df2) -# print(Df2Df2) ## Product of first derivatives from the two models -# lenx <- length(x) Df1Df2.0 <- matrix(0, 4 * 4, lenx) for (i in 1:lenx) { @@ -47,19 +80,12 @@ ## Second derivatives for the alternative model fitDiff <- fitted(object2) - fitted(object1) -# print(fitDiff) D2f2.0 <- attr(daFct(beta2[1], beta2[2], beta2[3], beta2[4], x), "hessian") D2f2 <- matrix(0, 4, 4) for (i in 1:4) { D2f2[i, ] <- apply(D2f2.0[, , i] * fitDiff, 2, mean) } -# print(Df2Df2) -# print(D2f2) - -# ## Using derivatives without residuals multiplied -# Df2.2 <- attr(daFct(beta2[1], beta2[2], beta2[3], beta2[4], x), "gradient") -# Df2Df2.2 <- matrix(apply(apply(Df2.2, 1, function(x){x%*%t(x)}), 1, mean), 4, 4) H <- Df2Df2 + D2f2 Hinv <- solve(H) cov12 <- Df1Df2 @@ -68,16 +94,9 @@ var2 <- Df2Df2 Wfit <- Hinv %*% cov21 %*% solve(var1) %*% cov12 %*% Hinv -# Wfit <- Hinv %*% cov21 %*% ginv(var1) %*% cov12 %*% Hinv # exponential model Wobs <- Hinv %*% var2 %*% Hinv -# varEst <- (Wobs - Wfit)/(lenx*summary(object1)$resVar) varEst <- (Wobs - Wfit) * (summary(object1)$resVar) / lenx -# varEst <- (Wobs - Wfit) / lenx - -# print(diffVec/sqrt(diag(varEst))) -# print(varEst) -# print(solve(varEst[1:4,1:4])) if (identical(var.equal, FALSE)) { Hinv <- Hinv / lenx @@ -88,18 +107,11 @@ res1 <- residuals(object1) for (i in 1:lenx) { -# veMat[i, ] <- as.vector(outer(varEst0[, i], varEst0[, i])) * summary(object1)$resVar * lenx # (res1[i]^2) veMat[i, ] <- as.vector(outer(varEst0[, i], varEst0[, i])) * (res1[i]^2) * lenx } varEst <- matrix(apply(veMat, 2, mean), p2, p2) } -# sInd <- c(1, 2, 3, 4) -# chiSq <- diffVec[sInd]%*%solve(varEst[sInd, sInd])%*%diffVec[sInd] -# chiSq <- diffVec[sInd]%*%ginv(varEst[sInd, sInd])%*%diffVec[sInd] -# pVal <- 1 - pchisq(chiSq, length(sInd)) - - stdErr <- sqrt(varEst[component, component]) diffVal <- diffVec[component] chiSq <- diffVal / stdErr diff --git a/R/mrdrm.r b/R/mrdrm.R similarity index 90% rename from R/mrdrm.r rename to R/mrdrm.R index 080e3968..146c50b8 100644 --- a/R/mrdrm.r +++ b/R/mrdrm.R @@ -1,949 +1,915 @@ -### Model-robust dose-response modelling - -## Calculating leave-one-out predictions for the parametric and non-parametric fits separately -leaveOneOut <- function(object1, object2, dose, dataSet, resp, fixedEnd) -{ - ## Leave-one-out predictions - uniDose <- sort(unique(dose)) - lenUd <- length(uniDose) - - doseDF <- dataSet[, tail(as.character(formula(object1)[[3]]), 1), drop = FALSE] # picking dose column - pred1 <- list() - pred2 <- list() - for (i in 1:lenUd) - { - reFit1 <- update(object1, data = subset(dataSet, dose != uniDose[i])) -# pred1[[i]] <- as.vector(predict(reFit1, newdata = subset(dataSet[, 1, drop = FALSE], dose == uniDose[i]), - pred1[[i]] <- as.vector(predict(reFit1, newdata = subset(doseDF, dose == uniDose[i]), - se.fit = FALSE)) -# print(pred1[[i]]) - - reFit2 <- update(object2, data = subset(dataSet, dose != uniDose[i])) -# control = loess.control(surface = "direct")) - pred2[[i]] <- predict(reFit2, newdata = subset(doseDF, dose == uniDose[i])) -# pred2[[i]] <- predict(reFit2, newdata = subset(dataSet[, 1, drop = FALSE], dose == uniDose[i])) - } - - # Avoiding overflow problems - pred2Vec <- as.vector(unlist(pred2)) - pred2Vec[pred2Vec < 0.01] <- 0.01 - pred2Vec[pred2Vec > 0.99] <- 0.99 - - ## Fixing boundary values at observed averages - if (fixedEnd) - { - pred2Vec[1] <- mean(resp[dose == uniDose[1]]) - pred2Vec[lenUd] <- mean(resp[dose == uniDose[lenUd]]) - } - - return(list(pred1 = as.vector(unlist(pred1)), pred2 = pred2Vec)) -} - - -## Calculating weights to be used in PRESS* criterion under least squares -pressWeights <- function(w, lenData, nVec, object1, resp, object2) -{ - switch(w, - "ad hoc" = # similar to what Nottingham and Birch (2000) did - { - rVec <- resp * nVec - any01 <- abs(rVec - nVec) < 1 - if (any(any01)) {rVec[any01] <- rVec[any01] - 0.5} - pVec <- rVec / nVec - nVec / (pVec * (1 - pVec)) - }, -# "inverse" = -# { -# predVec1 <- as.vector(predict(object1, se.fit = FALSE)) # se.fit = FALSE not needed -# (predVec1 * (1 - predVec1)) / nVec -# }, - "none" = rep(1, lenData), - "nonpar" = - { - predVec2 <- predict(object2) - nVec / (predVec2 * (1 - predVec2)) - }, - "par" = - { - predVec1 <- as.vector(predict(object1, se.fit = FALSE)) # se.fit = FALSE not needed - nVec / (predVec1 * (1 - predVec1)) - }, - "response" = nVec / (resp * (1 - resp))) -} - -## Function calculating degrees of freedom -dfFct <- function(object1, object2) # , trace1 = traceHat.drc, trace2 = traceHat.loess) -{ - # Trace hat for drm() model fit - lenData <- object1$"sumList"$lenData - traceHat.drc <- function(object) - { - lenData - df.residual(object) # number of parameters ... for sure an easier way? - } - - # Trace hat for loess fit - traceHat.loess <- function(object) - { - object$trace.hat - } - - function(lambda) - { -# lenUd - ( (1 - lambda) * traceHat.drc(object1) + lambda * traceHat.loess(object2)) - lenData - ( (1 - lambda) * traceHat.drc(object1) + lambda * traceHat.loess(object2)) - } -} - -## Calculating leave-one-out predictions for the semi-parametric fit -predFct <- function(looList) -{ - function(lambda) - { - (1 - lambda) * looList$"pred1" + lambda * looList$"pred2" - } -} - - -## Obtaining model-robust fit (evaluating PRESS* criterion) -"mrdrm" <- function(object1, object2, lambda = (0:10)/10, criterion = c("gcv", "lcv"), critFct = c("ls", "ll"), -ls.weights = c("nonpar", "ad hoc", "none", "par", "response"), fixedEnd = FALSE, unitScale = FALSE) -# object1 is the drm() model fit -# fixedEnd = TRUE favours the non-parametric model!!! -{ - criterion <- match.arg(criterion) - critFct <- match.arg(critFct) - ls.weights <- match.arg(ls.weights) - ## Enforcing the least squares criterion function without weighting for continuous data - if (identical(object1$"type", "continuous")) - { - critFct <- "ls" - ls.weights <- "none" - } - - ## Fitting a local linear regression with default settings in case no fit is provided - if (missing(object2)) - { - object2 <- loess(formula(object1), data = object1$"origData", degree = 1) - } - - ## Checking that a local linear regression fit is supplied - if ( (object2$"pars"$"degree" > 1) || (object2$"pars"$"degree" < 1) ) - { - stop("Local regression fit not linear!", call. = FALSE) - } - - ## Retrieving data - dataSet <- object1$"origData" - dataSet2 <- object1$"data" - dose <- dataSet2[, 1] -# uniDose <- unique(dose) -# lenUd <- length(uniDose) -# lenData <- length(dose) - resp <- dataSet2[, 2] - lenData <- object1$"sumList"$lenData - - ## Transforming doses into the unit interval - if (unitScale) - { - uniqDose <- sort(unique(dose)) - lenUD <- length(uniqDose) - doseLoess <- loess((0:(lenUD - 1))/lenUD ~ uniqDose) - dosePredict <- function(dose) {predict(doseLoess, data.frame(uniqDose = dose))} - unitDose <- dosePredict(dose) - - object2 <- loess(resp ~ unitDose, degree = 1) - } else { - dosePredict <- function(dose) {dose} # identity map - } - - -# predVec <- lambda * looList$"pred1" + (1 - lambda) * looList$"pred2" -## predVec <- lambda * as.vector(unlist(pred1)) + (1 - lambda) * as.vector(unlist(pred2)) -## print(predVec) - - ## Press value - dFct <- dfFct(object1, object2) - nVec <- object1$weights - pressFct <- switch(critFct, - "ls" = # least squares criterion function - { - ## Weights -# varVec <- weightFct(w, lenData, nVec, object1, resp) -# varVec <- switch(w, -# "ad hoc" = # similar to what Nottingham and Birch (2000) did -# { -# rVec <- resp * nVec -# any01 <- abs(rVec - nVec) < 1 -# if (any(any01)) {rVec[any01] <- rVec[any01] - 0.5} -# pVec <- rVec / nVec -# nVec / (pVec * (1 - pVec)) -# }, -# "model-based" = -# { -# predVec1 <- as.vector(predict(object1, se.fit = FALSE)) -# nVec / (predVec1 * (1 - predVec1)) -# }, -# "none" = rep(1, lenData), -# "response" = nVec / (resp * (1 - resp))) -## wVec <- object1$"weights" / (resp * (1 - resp)) -## wVec <- object1$"weights" / varVec -# print(varVec) - - ## Degrees of freedom -# dfVal <- lenUd - (lambda * traceHat.drc(object1) + (1 - lambda) * traceHat.loess(object2)) - - ## Press value -# pressFct1(resp - predVec, varVec, dfVal) - - switch(criterion, - "gcv" = { ## Using GCV - looList <- NULL - pFct <- predFct(list(pred1 = predict(object1), pred2 = predict(object2))) - pwVec <- NULL # No weights used - - function(lambda) - { - lenData * sum((resp - pFct(lambda))^2) / (dFct(lambda)^2) - } - }, - "lcv" = { # Using CV - ## Calculating leave-one-out predictions - looList <- leaveOneOut(object1, object2, dose, dataSet, resp, fixedEnd) - pFct <- predFct(looList) - pressFct1 <- function(r, w, den) {sum(w * (r^2) / den, na.rm = TRUE)} - pwVec <- pressWeights(ls.weights, lenData, nVec, object1, resp, object2) - - function(lambda) - { - pressFct1(resp - pFct(lambda), pwVec, dFct(lambda)) - } - }) - }, - "ll" = # log likelihood criterion function - { - ## Calculating leave-one-out predictions - looList <- leaveOneOut(object1, object2, dose, dataSet, resp, fixedEnd) - pFct <- predFct(looList) - pwVec <- NULL # No weights used - pressFct2 <- function(n, x, p) {-sum((n - x) * log(1 - p) + x * log(p), na.rm = TRUE)} - function(lambda) - { - pressFct2(nVec, resp * nVec, pFct(lambda)) - } - }) -# sum ( wVec * (resp - predVec)^2 / dfVal, na.rm = TRUE ) # lenUd - trace() - - vPressFct <- Vectorize(pressFct, "lambda") - - if (length(lambda) > 1) - { - pVec <- vPressFct(lambda) - optimalLambda <- lambda[which.min(pVec)] - } else { - pVec <- NA # no PRESS criterion used - optimalLambda <- lambda - } - - ## Calculating fitted values - pred1 <- as.vector(predict(object1)) - pred2 <- predict(object2) - fitVal <- (1 - optimalLambda) * pred1 + optimalLambda * pred2 - - ## Calculating goodness-of-fit values -# gofVal <- switch(object1$"type", -# "binomial" = c(sum ( nVec * ((resp - fitVal)^2) / (fitVal * (1 - fitVal))), -# sum ( nVec * ((resp - pred1)^2) / (pred1 * (1 - pred1)))), -# # adjustment for fitVal close to 0 or 1? -# "continuous" = c(sum( (resp - fitVal)^2 ), sum( (resp - pred1)^2 ))) -# -# ## Calculating AIC values -# aicVal <- switch(object1$"type", -# "binomial" = -sum((nVec - nVec * resp) * log(1 - fitVal) + (nVec * resp) * log(fitVal), na.rm = TRUE), -# "continuous" = lenData * log(2*pi) + lenData * log(gofVal/lenData) + lenData + 2 * dFct(optimalLambda)) -# -# ## Calculating residuals standard error -# seVal <- switch(object1$"type", -# "binomial" = NA, -# "continuous" = gofVal / dFct(optimalLambda)) - - dfVal <- dFct(optimalLambda) - gofVec <- switch(object1$"type", - "binomial" = { - success <- nVec * resp - - c(sum(nVec * ((resp - fitVal)^2) / (fitVal * (1 - fitVal))), - sum(nVec * ((resp - pred1)^2) / (pred1 * (1 - pred1))), - -2 * sum(log(choose(nVec, success))) - 2 * sum((nVec - success) * log(1 - fitVal) + success * log(fitVal), - na.rm = TRUE) + 2 * (lenData - dfVal), NA) - }, - "continuous" = { - gofVal <- sum( (resp - fitVal)^2 ) - - c(gofVal, sum( (resp - pred1)^2 ), - lenData * log(2*pi) + lenData * log(gofVal/lenData) + lenData + 2 * (lenData - dfVal), - gofVal / dfVal) - # Cleveland (1979) generalised - }) - names(gofVec) <- c("mr.gof", "p.gof", "aic", "rv") - - retList <- list(pressVal = pVec, lambda = optimalLambda, fitted = fitVal, gof = gofVec, - object1 = object1, object2 = object2, dose = dose, EDmethod = "inverse", ll = looList, - ls.weights = pwVec, df = dfVal) - class(retList) <- "mrdrc" - - retList -} - -## Calculating loess fit (not used, just to understand) -"loessEst" <- function(x0, x, y, span, logScale = FALSE) -{ - tricubic <- function(x, maxDist) - { - (1 - abs(x / maxDist)^3)^3 - } - - nsDistVec <- abs(x0 - x) - distVec <- sort(nsDistVec) - - x <- x[order(nsDistVec)] - y <- y[order(nsDistVec)] - - wVec <- rep(0, length(x)) - iVec <- distVec > quantile(distVec, span, type = 3) - - maxDist <- max(distVec[!iVec]) # max(distVec) - if (!logScale) - { - wVec[!iVec] <- tricubic(distVec[!iVec], maxDist) - } else { - wVec[!iVec] <- tricubic(exp(distVec[!iVec]), exp(maxDist)) - } - - list(coef(lm(y ~ I(x - x0), weights = wVec))[1], wVec) -} - -## Calculating hat matrix for loess fit -"hat.loess" <- function(x, span, x0 = x) -{ - tricubic <- function(x, maxDist) - { - (1 - abs(x / maxDist)^3)^3 - } - - X <- model.matrix( ~ x) - X0 <- as.matrix(cbind(1, x0)) - lenx0 <- length(x0) - lenx <- length(x) - H <- matrix(0, lenx0, lenx) - for (i in 1:lenx0) - { - distVec <- abs(x0[i] - x) - wVec <- rep(0, lenx) - iVec <- distVec < quantile(distVec, span) - selectDistVec <- distVec[iVec] - wVec[iVec] <- tricubic(selectDistVec, max(abs(selectDistVec))) - - Hi <- diag(wVec) - H[i, ] <- X0[i, , drop = FALSE] %*% solve(t(X) %*% Hi %*% X) %*% t(X) %*% Hi - } - H -} - -## Calculating hat matrix for drm() fit -"hat.drc" <- function(object, x, x0 = x) -{ - Dmat <- object$"deriv1" - - pMat0 <- t(object$parmMat) - pMat <- matrix(pMat0, ncol = ncol(pMat0), nrow = length(x0), byrow = TRUE) - derivMat <- object$fct$deriv1(x0, pMat) - - switch(object$"type", - "binomial" = { - pred1 <- as.vector(predict(object, se.fit = FALSE)) - - # to avoid problems in 'Wmat' below - pred1[pred1 < 0.01] <- 0.01 - pred1[pred1 > 0.99] <- 0.99 - - wMat <- diag(as.vector(object$"weights" / (pred1 * (1 - pred1)))) - derivMat %*% solve(t(Dmat) %*% wMat %*% Dmat) %*% t(Dmat) %*% wMat - }, - "continuous" = derivMat %*% solve(t(Dmat) %*% Dmat) %*% t(Dmat)) -} - -## Calculating hat matrix for model-robust fit -"hat.mr" <- function(object, x0 = x) # loess specific -{ - lambda <- object$"lambda" - x <- object$"dose" -# if (missing(x0)) {x0 <- x} - - (1 - lambda) * hat.drc(object$object1, x, x0) + lambda * hat.loess(x, object$object2$pars$span, x0) -} - - -"se.mr" <- function(object, x0) -{ - HMat <- hat.mr(object, x0) - - switch(object$object1$"type", - "binomial" = { - - pVec <- fitted(object) - pVec[pVec < 0.01] <- 0.01 - pVec[pVec > 0.99] <- 0.99 - ## Another option to use fitted values from parametric fit (for sure between 0 and 1) - - varY <- diag(as.vector((pVec * (1 - pVec)) / object$object1$"weights")) - sqrt(diag(HMat %*% varY %*% t(HMat))) - }, - "continuous" = { -# # Cleveland (1979) generalised -# dfVal <- object$object1$"sumList"$lenData - sum(diag(HMat)) -# sigma2 <- object$"gof" / dfVal - sqrt(diag(HMat %*% t(HMat)) * object$"gof"[4]) # inefficient to do complete matrix multiplication - }) -} - - -## predict method for model-robust fit -predict.mrdrc <- function(object, newdata, se.fit = FALSE, interval = c("none", "confidence", "prediction"), -level = 0.95, pava = FALSE, ...) -{ - interval <- match.arg(interval) - - if (missing(newdata)) - { - predVec <- fitted(object) - seVec <- se.mr(object, object$"dose") - } else { - pred1 <- as.vector(predict(object$"object1", newdata = newdata, se.fit = FALSE)) - pred2 <- predict(object$"object2", newdata = newdata) - lambda <- object$"lambda" - predVec <- (1 - lambda) * pred1 + lambda * pred2 - seVec <- se.mr(object, newdata[, 1]) - } - - if (se.fit) # overrules the argument "interval" - { - retMat <- as.matrix(cbind(predVec, seVec)) - colnames(retMat) <- c("Prediction", "SE") - return(retMat) - } - - if (interval == "confidence") - { - CIquan <- qnorm(1 - (1 - level)/2) - CIlower <- predVec - CIquan * seVec - CIupper <- predVec + CIquan * seVec - - retMat <- as.matrix(cbind(predVec, CIlower, CIupper)) - colnames(retMat) <- c("Prediction", "Lower CI", "Upper CI") - return(retMat) - } - if (interval == "prediction") - { - CIquan <- qnorm(1 - (1 - level)/2) - seVec <- sqrt(object$"gof"[4] + seVec^2) - CIlower <- predVec - CIquan * seVec - CIupper <- predVec + CIquan * seVec - - retMat <- as.matrix(cbind(predVec, CIlower, CIupper)) - colnames(retMat) <- c("Prediction", "Lower PI", "Upper PI") - return(retMat) - } - - if (pava) - { - if (coef(object$object1)[1] > 0) # works only for a single curve - { - -pava(-predVec) - } else { - pava(predVec) - } - } else { - predVec - } -} - - -## Calculating a single ED value with confidence interval -"inverseRegBasic" <- function(object, perc, level, interval, method, cgridsize, gridsize, -lowerRef, upperRef, intType, minmax) -{ -# method <- match.arg(method) -# intType <- "confidence" # "prediction" - predVec <- predict(object) - if (identical(minmax, "response")) - { - maxVal <- max(predVec) # more sophisticated? - minVal <- min(predVec) - } else { # dose-based (better for hormesis data) - maxVal <- predVec[which.min(object$"dose")] - minVal <- predVec[which.max(object$"dose")] - } - - ## Using specified lower and upper limits instead of the limits of the response - if (!is.null(lowerRef)) - { - minVal <- lowerRef - } - if (!is.null(upperRef)) - { - maxVal <- upperRef - } - - ## Swapping in case of a decreasing curve (only works for a single curve) - if (coef(object$"object1")[1] > 0) - { - newPerc <- 100 - perc - } else { - newPerc <- perc - } - - ## Scaling percentage up to original response scale - val <- switch(object$object1$"type", - "binomial" = newPerc/100, - "continuous" = (newPerc/100) * (maxVal - minVal) + minVal) - - ## Checking that ED level can be estimated - if ( (val < minVal) || (val > maxVal) ) - { - warning(paste("ED", perc, " cannot be estimated (not sufficient data)", sep = ""), call. = FALSE) - return(rep(NA, 3)) - } - - ## Searching an initial crude grid - x <- object$"dose" - minx <- min(x) - maxx <- max(x) - doseDF1 <- data.frame(seq(minx, maxx, length.out = cgridsize)) - colnames(doseDF1) <- as.character(formula(object$object1)[[3]]) - predVec1 <- predict(object, newdata = doseDF1, interval = intType, level = level) - min1 <- which.min(abs(predVec1[, 1] - val))[1] - if (identical(interval, "approximate")) - { - min1l <- which.min(abs(predVec1[, 2] - val))[1] - min1u <- which.min(abs(predVec1[, 3] - val))[1] - } else { - min1l <- NA - min1u <- NA - } - - ## Searching a finer grid - retVec <- switch(method, - "bisection" = - { # bisection method - bisecFct <- function(min1, column) - { - if (is.na(min1)) {return(c(NA))} - - pFct <- function(x) - { - doseDF <- data.frame(x) - colnames(doseDF) <- as.character(formula(object$object1)[[3]]) - as.vector(predict(object, newdata = doseDF, interval = intType, - level = level)[, column]) - val - } - interVal <- c(doseDF1[max(c(min1 - 1, 1)), 1], doseDF1[min(c(min1 + 1, cgridsize)), 1]) -# print(pFct(interVal[2]/2)) - rootVal <- try(uniroot(pFct, interVal)$root, silent = TRUE) - if (inherits(rootVal, "try-error")) - { - warnText <- switch(column, - "1" = "ED", - "2" = "Complete confidence interval for ED", # more informative solution? - "3" = "Complete confidence interval for ED") - warning(paste(warnText, perc, " cannot be estimated (bisection method failed)", sep = ""), - call. = FALSE) - return(NA) - } else { - return(rootVal) - } - } - limVec <- c(bisecFct(min1l, 2), bisecFct(min1u, 3)) - if (!any(is.na(limVec))) {limVec <- sort(limVec)} - c(bisecFct(min1, 1), limVec) -# c(bisecFct(min1, 1), sort(c(bisecFct(min1l, 2), bisecFct(min1u, 3)), na.last = TRUE)) - }, - "grid" = - { # grid search (slower, but more robust close to the boundaries of the dose range - gridSearch <- function(min1, column) - { - if (is.na(min1)) {return(c(NA))} - - doseDF2 <- data.frame(seq(doseDF1[max(c(min1 - 1, 1)), 1], doseDF1[min(c(min1 + 1, cgridsize)), 1], - length.out = gridsize)) - colnames(doseDF2) <- as.character(formula(object$object1)[[3]]) - doseDF2[which.min(abs(predict(object, newdata = doseDF2, interval = intType, - level = level)[, column] - val)), 1] - } - limVec <- c(gridSearch(min1u, 3), gridSearch(min1l, 2)) - if (!any(is.na(limVec))) {limVec <- sort(limVec)} - c(gridSearch(min1, 1), limVec) -# c(gridSearch(min1, 1), sort(c(gridSearch(min1u, 3), gridSearch(min1l, 2)), na.last = TRUE)) - }) - ## Adjusting confidence limits in case they are on the boundaries of the dose range used -# if (any(is.na(retVec))) {return(rep(NA, 3))} - if (is.na(retVec[1])) {return(rep(NA, 3))} # no limits returned in case no estimate is available - if ( (!is.na(retVec[2])) && (abs(retVec[2] - minx) < 0.001) ) {retVec[2] <- 0} # truncation to 0 - if ( (!is.na(retVec[3])) && (abs(retVec[3] - maxx) < 0.001) ) {retVec[3] <- Inf} # unbounded upper limit - - retVec -} -## Calculating several ED values -"inverseReg" <- Vectorize(inverseRegBasic, "perc") - -## Displaying the ED values -EDprint <- function(EDmat, ci, ciLabel, display) -{ - if (display) - { - cat("\n") - cat("Estimated effective doses\n") - if (!(ci == "none")) - { - ciText <- paste("(", ciLabel, "-based confidence interval(s))\n", sep = "") - cat(ciText) - } - cat("\n") - printCoefmat(EDmat) - } - invisible(EDmat) -} - -## Calculating ED values for model-robust fits (only works for one curve) -ED.mrdrc <- function(object, respLev, interval = c("none", "approximate", "bootstrap"), level = 0.95, -method = c("bisection", "grid"), cgridsize = 20, gridsize = 100, display = TRUE, lower = NULL, upper = NULL, -intType = c("confidence", "prediction"), minmax = c("response", "dose"), n = 1000, seedVal = 200810311, ...) -{ - interval <- match.arg(interval) - intType <- match.arg(intType) - method <- match.arg(method) - minmax <- match.arg(minmax) - - ## Calculating by means of inverse regression - if (identical(interval, "bootstrap")) - { - EDvec <- t(inverseReg(object, respLev, level, "none", method, cgridsize, gridsize, lower, upper, intType, - minmax))[, 1] - - EDci <- EDboot(n, object, respLev, seedVal, level) - EDmat <- as.matrix(cbind(EDvec, EDci)) - } else { - EDmat <- t(inverseReg(object, respLev, level, interval, method, cgridsize, gridsize, lower, upper, intType, - minmax)) - } - rownames(EDmat) <- respLev - - if (identical(interval, "none")) - { - EDmat <- EDmat[, 1, drop = FALSE] # removing NAs produced by inverseReg() - colnames(EDmat) <- c("Estimate") - } else { - colnames(EDmat) <- c("Estimate", "Lower", "Upper") - ciLabel <- ifelse(identical(interval, "approximate"), "Approximate variance formula", "Bootstrap") - } - EDprint(EDmat, interval, ciLabel, display) -} - - -plot.mrdrc <- function(x, ..., pava = FALSE) -{ - object <- x - drcObject <- x$"object1" - - plotPoints.mr <- function(doseVec) - { - doseDF <- data.frame(doseVec) - colnames(doseDF) <- as.character(formula(object$object1)[[3]]) # step needed for loess prediction - cbind(predict(object, newdata = doseDF, pava = pava)) - } - drcObject$"curve"[[1]] <- plotPoints.mr - drcObject$"curve"$"naPlot" <- TRUE # specifying that no extrapolation will go on when plotting - - plot(drcObject, ...) -} - -print.mrdrc <- function(x, ...) -{ - object <- x - gofVec <- object$"gof" - - cat(paste("\n", "A model-robust dose-response fit", "\n", sep = "")) - cat(paste("mixing a fit of class '", class(object$"object1")[1], "'", - " and a fit of class '", class(object$"object2")[1], "'\n\n", sep = "")) - - optimalLambda <- object$"lambda" - cat("Mixing coefficient:", optimalLambda, "\n") - if (optimalLambda < 1e-5) {noMixing <- TRUE} else {noMixing <- FALSE} - cat("Degrees of freedom:", object$"df", "\n") - if (!noMixing) - { - cat(paste("(for purely parametric fit: ", format(df.residual(object$"object1"), digits = 5), ")\n\n", sep = "")) - } - - if (identical(object$object1$"type", "binomial")) - { - cat("Pearson's chi-square:", format(gofVec[1], digits = 5), "\n") - if (!noMixing) - { - cat(paste("(for purely parametric fit: ", format(gofVec[2], digits = 5), " (p=", - format(1-pchisq(gofVec[2], df.residual(object$"object1")), digits = 2) , "))\n\n", sep = "")) - } - sigma2 <- 0 - } else { - cat("Residual sum of squares:", format(gofVec[1], digits = 5), "\n") - if (!noMixing) - { - cat(paste("(for purely parametric fit: ", format(gofVec[2], digits = 5), ")\n\n", sep = "")) - } - cat("Residual standard error:", format(gofVec[4], digits = 5), "\n\n") - - sigma2 <- 2 # adjustment for AIC ("removing" sigma^2 by subtracting 2) - } - - cat("AIC:", gofVec[3], "\n") - if (!noMixing) - { - cat(paste("(for purely parametric fit: ", format(AIC(object$"object1") - sigma2, digits = 5), ")\n\n", sep = "")) - } else { - cat("\n") - } - invisible(object) -} - -"EDboot" <- function(n, object, respLev, seedVal, level) -{ - set.seed(seedVal) - - doseVec <- object$"dose" - drcObj <- object$object1 - fitVal <- fitted(object) - lenData <- length(fitVal) - respType <- drcObj$"type" - weightsVec <- drcObj$"weights" - - lenED <- length(respLev) - - ## Generating datasets - dataMat <- switch(respType, - "binomial" = t(t(rbinom(n * lenData, weightsVec, fitVal)) / weightsVec), - "continuous" = rnorm(n * lenData, fitVal, sqrt(object$"gof"[4]))) - dataMat <- matrix(dataMat, nrow = n, byrow = TRUE) - - ## Defining apply() functions - rowFct1 <- function(yVec) - { - m1 <- try(drm(yVec ~ doseVec, weights = weightsVec, fct = drcObj$fct, type = respType, - start = coef(drcObj)), silent = TRUE) - - if (inherits(m1, "try-error")) - { - return(rep(NA, lenED)) - } - m2 <- loess(yVec ~ doseVec, degree = 1) - mr <- mrdrm(m1, m2) - - as.vector(ED(mr, respLev, display = FALSE)) - } - rowFct2 <- function(edVec) - { - as.vector(quantile(edVec, c((1 - level)/2, 1 - ((1 - level)/2)), na.rm = TRUE)) - } - ## Calculating ED values - if (lenED < 2) - { - EDmat <- matrix(rowFct2(apply(dataMat, 1, rowFct1)), nrow = 1) - } else { - EDmat <- t(apply(apply(dataMat, 1, rowFct1), 1, rowFct2)) - } - EDmat -} - - -#mv <- function(n, edval = 50, seedVal = 200810151) -#{ -# set.seed(seedVal) -# -# doseVec <- deguelin$dose -# nVec <- deguelin$n -# if (FALSE) -# { -## sigmaVal <- exp.x.mr$ -## lenData <- nrow() -## doseVec <- exp.x$conc -## fittedVec <- fitted(exp.x.mr) -# } -# edVec <- rep(NA, n) -# lVec <- rep(NA, n) -# for (i in 1:n) -# { -# if (TRUE) -# { -# rVec <- rbinom(length(nVec), nVec, fitted(deguelin.mr)) -# m1 <- try(drm(rVec/nVec ~ doseVec, weights = nVec, fct = LL.2(), type = "binomial", start = coef(deguelin.m1)), -# silent = TRUE) -# } -# if (FALSE) -# { -# rVec <- rnorm(lenData, fittedVec, sigmaVal) -# m1 <- try(drm(rVec ~ doseVec, fct = LL.3(), start = coef(exp.x.m1)), -# silent = TRUE) -# -# } -# if (inherits(m1, "try-error")) -# { -# edVec[i] <- NA -# } else { -# m2 <- loess(rVec/nVec ~ doseVec, degree = 1) -# mr <- mrdrm(m1, m2) -# edVec[i] <- ED(mr, edval, display = FALSE)[1] -# lVec[i] <- mr$lambda -# } -# } -# list(edVal = edVec, lambdaVal = lVec) -#} - - -## From the R-help e-mail by Ted Harding: http://tolstoy.newcastle.edu.au/R/e2/help/07/03/12853.html -## See also http://tolstoy.newcastle.edu.au/R/help/05/05/4254.html -"pava" <- function(x, wt = rep(1, length(x))) -{ - n <- length(x) - if (n <= 1) return(x) - lvlsets <- 1:n - repeat - { - viol <- (as.vector(diff(x)) < 0) - if (!(any(viol))) break - i <- min((1:(n-1))[viol]) - - lvl1 <- lvlsets[i] - lvl2 <- lvlsets[i+1] - ilvl <- ( (lvlsets == lvl1) | (lvlsets == lvl2) ) - - x[ilvl] <- sum(x[ilvl] * wt[ilvl]) / sum(wt[ilvl]) - lvlsets[ilvl] <- lvl1 - } - x -} - - -## Examples -if (FALSE) -{ - deguelin.mr <- mrdrm(deguelin.m1, deguelin.m2) - predict(deguelin.mr, interval="confidence") - plot(deguelin.m1, ylim=c(0,1)) - lines(deguelin$dose, predict(deguelin.mr), lty=2) - - ## With fixed lambda - deguelin.mr2 <- mrdrm(deguelin.m1, deguelin.m2, lambda=0.95) - lines(deguelin$dose, predict(deguelin.mr2), lty=3) - - exp.a.mr <- mrdrm(exp.a.m1, exp.a.m2) - predict(exp.a.mr, se.fit = TRUE) - ED(exp.a.mr, c(10, 50, 90)) - - ryegrass.mr <- mrdrm(ryegrass.m1, ryegrass.loess) - predict(ryegrass.mr) -} - - -#press(deguelin.m1, deguelin.m2, seq(0, 1, length.out=10), criterion="ll") - - -## trace hat component in drm() model fit? -#traceHat.drc <- function(object) -#{ -# object$"sumList"$lenData - df.residual(object) -#} -# -#traceHat.loess <- function(object) -#{ -# object$trace.hat -#} - - - - -## Example R lines -if (FALSE) -{ - -deguelin.m1<-drm(r/n~dose, weights=n, data=deguelin, fct=LL.2(), type="binomial") - -deguelin.m2<-loess(r/n~dose, data=deguelin, degree=1) -vPress(deguelin.m1, deguelin.m2, seq(0, 1, length.out=10)) - -deguelin.m3<-loess(r/n~log10(dose), data=deguelin, degree=1) -vPress(deguelin.m1, deguelin.m3, seq(0, 1, length.out=10)) - -} - -## Using lmeSplines -if (FALSE) -{ -library(lmeSplines) - -## lettuce -let2<-lettuce -let2<-cbind(let2, all=rep(1, 14)) -let2$Zt<-smspline(~conc, data=lettuce) - -let2.m1<-lme(weight~conc, data=let2, random=list(all=pdIdent(~Zt-1))) -plot(weight~conc, data=lettuce, log="x") -lines(let2$conc, fitted(let2.m1)) - - -## deguelin -deg2<-deguelin -deg2<-cbind(deg2, all=rep(1, 6)) -deg2$Zt<-smspline(~dose, data=deg2) - -deg2.m1<-lme(r/n~dose, data=deg2, random=list(all=pdIdent(~Zt-1))) -plot(r/n~dose, data=deg2) -lines(deg2$dose, fitted(deg2.m1)) - -## bin.mat -bm2<-bin.mat[c(3,6,9,12,15),] -bm2<-cbind(bm2, all=rep(1, 5)) -bm2$Zt<-smspline(~conc, data=bm2) - -bm2.m1<-lme(matured/total~conc, data=bm2, random=list(all=pdIdent(~Zt-1))) -plot(matured/total~conc, data=bm2) -lines(bm2$conc, fitted(bm2.m1)) # straight line! - - - -## exp.a -ea2<-exp.a -ea2<-cbind(ea2, all=rep(1,54)) - -ea2$Zt<-smspline(~x, data=ea2) -ea2.m1<-lme(y~x, data=ea2, random=list(all=pdIdent(~Zt-1))) -plot(y~x, ea2, log="x") -lines(ea2$x, fitted(ea2.m1)) -summary(ea2.m1) - - -ea2.m2<-drm(y~x, data=ea2, fct=LL.3()) -plot(ea2.m2, add=T, lty=2) - -cVec<-ea2$x[-c(7:12)] -Zt2<-smspline(cVec) -ea2$Zt2<-approx.Z(Zt2, cVec, ea2$x) -ea2.m3<-lme(y~x, data=ea2, random=list(all=pdIdent(~Zt2-1))) -lines(ea2$x, fitted(ea2.m3), col=2) - -cVec<-ea2$x[-c(13:18)] -Zt2<-smspline(cVec) -ea2$Zt2<-approx.Z(Zt2, cVec, ea2$x) -ea2.m3<-lme(y~x, data=ea2, random=list(all=pdIdent(~Zt2-1))) -lines(ea2$x, fitted(ea2.m3), col=5) - - - +### Model-robust dose-response modelling + +## Calculating leave-one-out predictions for the parametric and non-parametric fits separately +#' @title Model-robust dose-response modelling +#' @keywords internal +leaveOneOut <- function(object1, object2, dose, dataSet, resp, fixedEnd) +{ + ## Leave-one-out predictions + uniDose <- sort(unique(dose)) + lenUd <- length(uniDose) + + doseDF <- dataSet[, tail(as.character(formula(object1)[[3]]), 1), drop = FALSE] # picking dose column + pred1 <- list() + pred2 <- list() + for (i in 1:lenUd) + { + reFit1 <- update(object1, data = subset(dataSet, dose != uniDose[i])) + pred1[[i]] <- as.vector(predict(reFit1, newdata = subset(doseDF, dose == uniDose[i]), + se.fit = FALSE)) + + reFit2 <- update(object2, data = subset(dataSet, dose != uniDose[i])) + pred2[[i]] <- predict(reFit2, newdata = subset(doseDF, dose == uniDose[i])) + } + + # Avoiding overflow problems + pred2Vec <- as.vector(unlist(pred2)) + pred2Vec[pred2Vec < 0.01] <- 0.01 + pred2Vec[pred2Vec > 0.99] <- 0.99 + + ## Fixing boundary values at observed averages + if (fixedEnd) + { + pred2Vec[1] <- mean(resp[dose == uniDose[1]]) + pred2Vec[lenUd] <- mean(resp[dose == uniDose[lenUd]]) + } + + return(list(pred1 = as.vector(unlist(pred1)), pred2 = pred2Vec)) +} + + +## Calculating weights to be used in PRESS* criterion under least squares +pressWeights <- function(w, lenData, nVec, object1, resp, object2) +{ + switch(w, + "ad hoc" = # similar to what Nottingham and Birch (2000) did + { + rVec <- resp * nVec + any01 <- abs(rVec - nVec) < 1 + if (any(any01)) {rVec[any01] <- rVec[any01] - 0.5} + pVec <- rVec / nVec + nVec / (pVec * (1 - pVec)) + }, + "none" = rep(1, lenData), + "nonpar" = + { + predVec2 <- predict(object2) + nVec / (predVec2 * (1 - predVec2)) + }, + "par" = + { + predVec1 <- as.vector(predict(object1, se.fit = FALSE)) # se.fit = FALSE not needed + nVec / (predVec1 * (1 - predVec1)) + }, + "response" = nVec / (resp * (1 - resp))) +} + +## Function calculating degrees of freedom +dfFct <- function(object1, object2) # , trace1 = traceHat.drc, trace2 = traceHat.loess) +{ + # Trace hat for drm() model fit + lenData <- object1$"sumList"$lenData + traceHat.drc <- function(object) + { + lenData - df.residual(object) # number of parameters ... for sure an easier way? + } + + # Trace hat for loess fit + traceHat.loess <- function(object) + { + object$trace.hat + } + + function(lambda) + { + lenData - ( (1 - lambda) * traceHat.drc(object1) + lambda * traceHat.loess(object2)) + } +} + +## Calculating leave-one-out predictions for the semi-parametric fit +predFct <- function(looList) +{ + function(lambda) + { + (1 - lambda) * looList$"pred1" + lambda * looList$"pred2" + } +} + + +## Obtaining model-robust fit (evaluating PRESS* criterion) +"mrdrm" <- function(object1, object2, lambda = (0:10)/10, criterion = c("gcv", "lcv"), critFct = c("ls", "ll"), +ls.weights = c("nonpar", "ad hoc", "none", "par", "response"), fixedEnd = FALSE, unitScale = FALSE) +# object1 is the drm() model fit +# fixedEnd = TRUE favours the non-parametric model!!! +{ + criterion <- match.arg(criterion) + critFct <- match.arg(critFct) + ls.weights <- match.arg(ls.weights) + ## Enforcing the least squares criterion function without weighting for continuous data + if (identical(object1$"type", "continuous")) + { + critFct <- "ls" + ls.weights <- "none" + } + + ## Fitting a local linear regression with default settings in case no fit is provided + if (missing(object2)) + { + object2 <- loess(formula(object1), data = object1$"origData", degree = 1) + } + + ## Checking that a local linear regression fit is supplied + if ( (object2$"pars"$"degree" > 1) || (object2$"pars"$"degree" < 1) ) + { + stop("Local regression fit not linear!", call. = FALSE) + } + + ## Retrieving data + dataSet <- object1$"origData" + dataSet2 <- object1$"data" + dose <- dataSet2[, 1] + resp <- dataSet2[, 2] + lenData <- object1$"sumList"$lenData + + ## Transforming doses into the unit interval + if (unitScale) + { + uniqDose <- sort(unique(dose)) + lenUD <- length(uniqDose) + doseLoess <- loess((0:(lenUD - 1))/lenUD ~ uniqDose) + dosePredict <- function(dose) {predict(doseLoess, data.frame(uniqDose = dose))} + unitDose <- dosePredict(dose) + + object2 <- loess(resp ~ unitDose, degree = 1) + } + + +# predVec <- lambda * looList$"pred1" + (1 - lambda) * looList$"pred2" +## predVec <- lambda * as.vector(unlist(pred1)) + (1 - lambda) * as.vector(unlist(pred2)) +## print(predVec) + + ## Press value + dFct <- dfFct(object1, object2) + nVec <- object1$weights + pressFct <- switch(critFct, + "ls" = # least squares criterion function + { + switch(criterion, + "gcv" = { ## Using GCV + looList <- NULL + pFct <- predFct(list(pred1 = predict(object1), pred2 = predict(object2))) + pwVec <- NULL # No weights used + + function(lambda) + { + lenData * sum((resp - pFct(lambda))^2) / (dFct(lambda)^2) + } + }, + "lcv" = { # Using CV + ## Calculating leave-one-out predictions + looList <- leaveOneOut(object1, object2, dose, dataSet, resp, fixedEnd) + pFct <- predFct(looList) + pressFct1 <- function(r, w, den) {sum(w * (r^2) / den, na.rm = TRUE)} + pwVec <- pressWeights(ls.weights, lenData, nVec, object1, resp, object2) + + function(lambda) + { + pressFct1(resp - pFct(lambda), pwVec, dFct(lambda)) + } + }) + }, + "ll" = # log likelihood criterion function + { + ## Calculating leave-one-out predictions + looList <- leaveOneOut(object1, object2, dose, dataSet, resp, fixedEnd) + pFct <- predFct(looList) + pwVec <- NULL # No weights used + pressFct2 <- function(n, x, p) {-sum((n - x) * log(1 - p) + x * log(p), na.rm = TRUE)} + function(lambda) + { + pressFct2(nVec, resp * nVec, pFct(lambda)) + } + }) + + vPressFct <- Vectorize(pressFct, "lambda") + + if (length(lambda) > 1) + { + pVec <- vPressFct(lambda) + optimalLambda <- lambda[which.min(pVec)] + } else { + pVec <- NA # no PRESS criterion used + optimalLambda <- lambda + } + + ## Calculating fitted values + pred1 <- as.vector(predict(object1)) + pred2 <- predict(object2) + fitVal <- (1 - optimalLambda) * pred1 + optimalLambda * pred2 + + ## Calculating goodness-of-fit values +# gofVal <- switch(object1$"type", +# "binomial" = c(sum ( nVec * ((resp - fitVal)^2) / (fitVal * (1 - fitVal))), +# sum ( nVec * ((resp - pred1)^2) / (pred1 * (1 - pred1)))), +# # adjustment for fitVal close to 0 or 1? +# "continuous" = c(sum( (resp - fitVal)^2 ), sum( (resp - pred1)^2 ))) +# +# ## Calculating AIC values +# aicVal <- switch(object1$"type", +# "binomial" = -sum((nVec - nVec * resp) * log(1 - fitVal) + (nVec * resp) * log(fitVal), na.rm = TRUE), +# "continuous" = lenData * log(2*pi) + lenData * log(gofVal/lenData) + lenData + 2 * dFct(optimalLambda)) +# +# ## Calculating residuals standard error +# seVal <- switch(object1$"type", +# "binomial" = NA, +# "continuous" = gofVal / dFct(optimalLambda)) + + dfVal <- dFct(optimalLambda) + gofVec <- switch(object1$"type", + "binomial" = { + success <- nVec * resp + + c(sum(nVec * ((resp - fitVal)^2) / (fitVal * (1 - fitVal))), + sum(nVec * ((resp - pred1)^2) / (pred1 * (1 - pred1))), + -2 * sum(log(choose(nVec, success))) - 2 * sum((nVec - success) * log(1 - fitVal) + success * log(fitVal), + na.rm = TRUE) + 2 * (lenData - dfVal), NA) + }, + "continuous" = { + gofVal <- sum( (resp - fitVal)^2 ) + + c(gofVal, sum( (resp - pred1)^2 ), + lenData * log(2*pi) + lenData * log(gofVal/lenData) + lenData + 2 * (lenData - dfVal), + gofVal / dfVal) + # Cleveland (1979) generalised + }) + names(gofVec) <- c("mr.gof", "p.gof", "aic", "rv") + + retList <- list(pressVal = pVec, lambda = optimalLambda, fitted = fitVal, gof = gofVec, + object1 = object1, object2 = object2, dose = dose, EDmethod = "inverse", ll = looList, + ls.weights = pwVec, df = dfVal) + class(retList) <- "mrdrc" + + retList +} + +## Calculating loess fit (not used, just to understand) +"loessEst" <- function(x0, x, y, span, logScale = FALSE) +{ + tricubic <- function(x, maxDist) + { + (1 - abs(x / maxDist)^3)^3 + } + + nsDistVec <- abs(x0 - x) + distVec <- sort(nsDistVec) + + x <- x[order(nsDistVec)] + y <- y[order(nsDistVec)] + + wVec <- rep(0, length(x)) + iVec <- distVec > quantile(distVec, span, type = 3) + + maxDist <- max(distVec[!iVec]) # max(distVec) + if (!logScale) + { + wVec[!iVec] <- tricubic(distVec[!iVec], maxDist) + } else { + wVec[!iVec] <- tricubic(exp(distVec[!iVec]), exp(maxDist)) + } + + list(coef(lm(y ~ I(x - x0), weights = wVec))[1], wVec) +} + +## Calculating hat matrix for loess fit +"hat.loess" <- function(x, span, x0 = x) +{ + tricubic <- function(x, maxDist) + { + (1 - abs(x / maxDist)^3)^3 + } + + X <- model.matrix( ~ x) + X0 <- as.matrix(cbind(1, x0)) + lenx0 <- length(x0) + lenx <- length(x) + H <- matrix(0, lenx0, lenx) + for (i in 1:lenx0) + { + distVec <- abs(x0[i] - x) + wVec <- rep(0, lenx) + iVec <- distVec < quantile(distVec, span) + selectDistVec <- distVec[iVec] + wVec[iVec] <- tricubic(selectDistVec, max(abs(selectDistVec))) + + Hi <- diag(wVec) + H[i, ] <- X0[i, , drop = FALSE] %*% solve(t(X) %*% Hi %*% X) %*% t(X) %*% Hi + } + H +} + +## Calculating hat matrix for drm() fit +"hat.drc" <- function(object, x, x0 = x) +{ + Dmat <- object$"deriv1" + + pMat0 <- t(object$parmMat) + pMat <- matrix(pMat0, ncol = ncol(pMat0), nrow = length(x0), byrow = TRUE) + derivMat <- object$fct$deriv1(x0, pMat) + + switch(object$"type", + "binomial" = { + pred1 <- as.vector(predict(object, se.fit = FALSE)) + + # to avoid problems in 'Wmat' below + pred1[pred1 < 0.01] <- 0.01 + pred1[pred1 > 0.99] <- 0.99 + + wMat <- diag(as.vector(object$"weights" / (pred1 * (1 - pred1)))) + derivMat %*% solve(t(Dmat) %*% wMat %*% Dmat) %*% t(Dmat) %*% wMat + }, + "continuous" = derivMat %*% solve(t(Dmat) %*% Dmat) %*% t(Dmat)) +} + +## Calculating hat matrix for model-robust fit +"hat.mr" <- function(object, x0 = x) # loess specific +{ + lambda <- object$"lambda" + x <- object$"dose" +# if (missing(x0)) {x0 <- x} + + (1 - lambda) * hat.drc(object$object1, x, x0) + lambda * hat.loess(x, object$object2$pars$span, x0) +} + + +"se.mr" <- function(object, x0) +{ + HMat <- hat.mr(object, x0) + + switch(object$object1$"type", + "binomial" = { + + pVec <- fitted(object) + pVec[pVec < 0.01] <- 0.01 + pVec[pVec > 0.99] <- 0.99 + ## Another option to use fitted values from parametric fit (for sure between 0 and 1) + + varY <- diag(as.vector((pVec * (1 - pVec)) / object$object1$"weights")) + sqrt(diag(HMat %*% varY %*% t(HMat))) + }, + "continuous" = { +# # Cleveland (1979) generalised +# dfVal <- object$object1$"sumList"$lenData - sum(diag(HMat)) +# sigma2 <- object$"gof" / dfVal + sqrt(diag(HMat %*% t(HMat)) * object$"gof"[4]) # inefficient to do complete matrix multiplication + }) +} + + +## predict method for model-robust fit +#' @exportS3Method +predict.mrdrc <- function(object, newdata, se.fit = FALSE, interval = c("none", "confidence", "prediction"), +level = 0.95, pava = FALSE, ...) +{ + interval <- match.arg(interval) + + if (missing(newdata)) + { + predVec <- fitted(object) + seVec <- se.mr(object, object$"dose") + } else { + pred1 <- as.vector(predict(object$"object1", newdata = newdata, se.fit = FALSE)) + pred2 <- predict(object$"object2", newdata = newdata) + lambda <- object$"lambda" + predVec <- (1 - lambda) * pred1 + lambda * pred2 + seVec <- se.mr(object, newdata[, 1]) + } + + if (se.fit) # overrules the argument "interval" + { + retMat <- as.matrix(cbind(predVec, seVec)) + colnames(retMat) <- c("Prediction", "SE") + return(retMat) + } + + if (interval == "confidence") + { + CIquan <- qnorm(1 - (1 - level)/2) + CIlower <- predVec - CIquan * seVec + CIupper <- predVec + CIquan * seVec + + retMat <- as.matrix(cbind(predVec, CIlower, CIupper)) + colnames(retMat) <- c("Prediction", "Lower CI", "Upper CI") + return(retMat) + } + if (interval == "prediction") + { + CIquan <- qnorm(1 - (1 - level)/2) + seVec <- sqrt(object$"gof"[4] + seVec^2) + CIlower <- predVec - CIquan * seVec + CIupper <- predVec + CIquan * seVec + + retMat <- as.matrix(cbind(predVec, CIlower, CIupper)) + colnames(retMat) <- c("Prediction", "Lower PI", "Upper PI") + return(retMat) + } + + if (pava) + { + if (coef(object$object1)[1] > 0) # works only for a single curve + { + -pava(-predVec) + } else { + pava(predVec) + } + } else { + predVec + } +} + + +## Calculating a single ED value with confidence interval +"inverseRegBasic" <- function(object, perc, level, interval, method, cgridsize, gridsize, +lowerRef, upperRef, intType, minmax) +{ +# method <- match.arg(method) +# intType <- "confidence" # "prediction" + predVec <- predict(object) + if (identical(minmax, "response")) + { + maxVal <- max(predVec) # more sophisticated? + minVal <- min(predVec) + } else { # dose-based (better for hormesis data) + maxVal <- predVec[which.min(object$"dose")] + minVal <- predVec[which.max(object$"dose")] + } + + ## Using specified lower and upper limits instead of the limits of the response + if (!is.null(lowerRef)) + { + minVal <- lowerRef + } + if (!is.null(upperRef)) + { + maxVal <- upperRef + } + + ## Swapping in case of a decreasing curve (only works for a single curve) + if (coef(object$"object1")[1] > 0) + { + newPerc <- 100 - perc + } else { + newPerc <- perc + } + + ## Scaling percentage up to original response scale + val <- switch(object$object1$"type", + "binomial" = newPerc/100, + "continuous" = (newPerc/100) * (maxVal - minVal) + minVal) + + ## Checking that ED level can be estimated + if ( (val < minVal) || (val > maxVal) ) + { + warning(paste("ED", perc, " cannot be estimated (not sufficient data)", sep = ""), call. = FALSE) + return(rep(NA, 3)) + } + + ## Searching an initial crude grid + x <- object$"dose" + minx <- min(x) + maxx <- max(x) + doseDF1 <- data.frame(seq(minx, maxx, length.out = cgridsize)) + colnames(doseDF1) <- as.character(formula(object$object1)[[3]]) + predVec1 <- predict(object, newdata = doseDF1, interval = intType, level = level) + min1 <- which.min(abs(predVec1[, 1] - val))[1] + if (identical(interval, "approximate")) + { + min1l <- which.min(abs(predVec1[, 2] - val))[1] + min1u <- which.min(abs(predVec1[, 3] - val))[1] + } else { + min1l <- NA + min1u <- NA + } + + ## Searching a finer grid + retVec <- switch(method, + "bisection" = + { # bisection method + bisecFct <- function(min1, column) + { + if (is.na(min1)) {return(c(NA))} + + pFct <- function(x) + { + doseDF <- data.frame(x) + colnames(doseDF) <- as.character(formula(object$object1)[[3]]) + as.vector(predict(object, newdata = doseDF, interval = intType, + level = level)[, column]) - val + } + interVal <- c(doseDF1[max(c(min1 - 1, 1)), 1], doseDF1[min(c(min1 + 1, cgridsize)), 1]) +# print(pFct(interVal[2]/2)) + rootVal <- try(uniroot(pFct, interVal)$root, silent = TRUE) + if (inherits(rootVal, "try-error")) + { + warnText <- switch(column, + "1" = "ED", + "2" = "Complete confidence interval for ED", # more informative solution? + "3" = "Complete confidence interval for ED") + warning(paste(warnText, perc, " cannot be estimated (bisection method failed)", sep = ""), + call. = FALSE) + return(NA) + } else { + return(rootVal) + } + } + limVec <- c(bisecFct(min1l, 2), bisecFct(min1u, 3)) + if (!any(is.na(limVec))) {limVec <- sort(limVec)} + c(bisecFct(min1, 1), limVec) +# c(bisecFct(min1, 1), sort(c(bisecFct(min1l, 2), bisecFct(min1u, 3)), na.last = TRUE)) + }, + "grid" = + { # grid search (slower, but more robust close to the boundaries of the dose range + gridSearch <- function(min1, column) + { + if (is.na(min1)) {return(c(NA))} + + doseDF2 <- data.frame(seq(doseDF1[max(c(min1 - 1, 1)), 1], doseDF1[min(c(min1 + 1, cgridsize)), 1], + length.out = gridsize)) + colnames(doseDF2) <- as.character(formula(object$object1)[[3]]) + doseDF2[which.min(abs(predict(object, newdata = doseDF2, interval = intType, + level = level)[, column] - val)), 1] + } + limVec <- c(gridSearch(min1u, 3), gridSearch(min1l, 2)) + if (!any(is.na(limVec))) {limVec <- sort(limVec)} + c(gridSearch(min1, 1), limVec) +# c(gridSearch(min1, 1), sort(c(gridSearch(min1u, 3), gridSearch(min1l, 2)), na.last = TRUE)) + }) + ## Adjusting confidence limits in case they are on the boundaries of the dose range used +# if (any(is.na(retVec))) {return(rep(NA, 3))} + if (is.na(retVec[1])) {return(rep(NA, 3))} # no limits returned in case no estimate is available + if ( (!is.na(retVec[2])) && (abs(retVec[2] - minx) < 0.001) ) {retVec[2] <- 0} # truncation to 0 + if ( (!is.na(retVec[3])) && (abs(retVec[3] - maxx) < 0.001) ) {retVec[3] <- Inf} # unbounded upper limit + + retVec +} +## Calculating several ED values +"inverseReg" <- Vectorize(inverseRegBasic, "perc") + +## Displaying the ED values +EDprint <- function(EDmat, ci, ciLabel, display) +{ + if (display) + { + cat("\n") + cat("Estimated effective doses\n") + if (!(ci == "none")) + { + ciText <- paste("(", ciLabel, "-based confidence interval(s))\n", sep = "") + cat(ciText) + } + cat("\n") + printCoefmat(EDmat) + } + invisible(EDmat) +} + +## Calculating ED values for model-robust fits (only works for one curve) +#' @exportS3Method +ED.mrdrc <- function(object, respLev, interval = c("none", "approximate", "bootstrap"), level = 0.95, +method = c("bisection", "grid"), cgridsize = 20, gridsize = 100, display = TRUE, lower = NULL, upper = NULL, +intType = c("confidence", "prediction"), minmax = c("response", "dose"), n = 1000, seedVal = 200810311, ...) +{ + interval <- match.arg(interval) + intType <- match.arg(intType) + method <- match.arg(method) + minmax <- match.arg(minmax) + + ## Calculating by means of inverse regression + if (identical(interval, "bootstrap")) + { + EDvec <- t(inverseReg(object, respLev, level, "none", method, cgridsize, gridsize, lower, upper, intType, + minmax))[, 1] + + EDci <- EDboot(n, object, respLev, seedVal, level) + EDmat <- as.matrix(cbind(EDvec, EDci)) + } else { + EDmat <- t(inverseReg(object, respLev, level, interval, method, cgridsize, gridsize, lower, upper, intType, + minmax)) + } + rownames(EDmat) <- respLev + + if (identical(interval, "none")) + { + EDmat <- EDmat[, 1, drop = FALSE] # removing NAs produced by inverseReg() + colnames(EDmat) <- c("Estimate") + } else { + colnames(EDmat) <- c("Estimate", "Lower", "Upper") + ciLabel <- ifelse(identical(interval, "approximate"), "Approximate variance formula", "Bootstrap") + } + EDprint(EDmat, interval, ciLabel, display) +} + + +#' @exportS3Method +plot.mrdrc <- function(x, ..., pava = FALSE) +{ + object <- x + drcObject <- x$"object1" + + plotPoints.mr <- function(doseVec) + { + doseDF <- data.frame(doseVec) + colnames(doseDF) <- as.character(formula(object$object1)[[3]]) # step needed for loess prediction + cbind(predict(object, newdata = doseDF, pava = pava)) + } + drcObject$"curve"[[1]] <- plotPoints.mr + drcObject$"curve"$"naPlot" <- TRUE # specifying that no extrapolation will go on when plotting + + plot(drcObject, ...) +} + +#' @exportS3Method +print.mrdrc <- function(x, ...) +{ + object <- x + gofVec <- object$"gof" + + cat(paste("\n", "A model-robust dose-response fit", "\n", sep = "")) + cat(paste("mixing a fit of class '", class(object$"object1")[1], "'", + " and a fit of class '", class(object$"object2")[1], "'\n\n", sep = "")) + + optimalLambda <- object$"lambda" + cat("Mixing coefficient:", optimalLambda, "\n") + if (optimalLambda < 1e-5) {noMixing <- TRUE} else {noMixing <- FALSE} + cat("Degrees of freedom:", object$"df", "\n") + if (!noMixing) + { + cat(paste("(for purely parametric fit: ", format(df.residual(object$"object1"), digits = 5), ")\n\n", sep = "")) + } + + if (identical(object$object1$"type", "binomial")) + { + cat("Pearson's chi-square:", format(gofVec[1], digits = 5), "\n") + if (!noMixing) + { + cat(paste("(for purely parametric fit: ", format(gofVec[2], digits = 5), " (p=", + format(1-pchisq(gofVec[2], df.residual(object$"object1")), digits = 2) , "))\n\n", sep = "")) + } + sigma2 <- 0 + } else { + cat("Residual sum of squares:", format(gofVec[1], digits = 5), "\n") + if (!noMixing) + { + cat(paste("(for purely parametric fit: ", format(gofVec[2], digits = 5), ")\n\n", sep = "")) + } + cat("Residual standard error:", format(gofVec[4], digits = 5), "\n\n") + + sigma2 <- 2 # adjustment for AIC ("removing" sigma^2 by subtracting 2) + } + + cat("AIC:", gofVec[3], "\n") + if (!noMixing) + { + cat(paste("(for purely parametric fit: ", format(AIC(object$"object1") - sigma2, digits = 5), ")\n\n", sep = "")) + } else { + cat("\n") + } + invisible(object) +} + +"EDboot" <- function(n, object, respLev, seedVal, level) +{ + set.seed(seedVal) + + doseVec <- object$"dose" + drcObj <- object$object1 + fitVal <- fitted(object) + lenData <- length(fitVal) + respType <- drcObj$"type" + weightsVec <- drcObj$"weights" + + lenED <- length(respLev) + + ## Generating datasets + dataMat <- switch(respType, + "binomial" = t(t(rbinom(n * lenData, weightsVec, fitVal)) / weightsVec), + "continuous" = rnorm(n * lenData, fitVal, sqrt(object$"gof"[4]))) + dataMat <- matrix(dataMat, nrow = n, byrow = TRUE) + + ## Defining apply() functions + rowFct1 <- function(yVec) + { + result <- try({ + m1 <- drm(yVec ~ doseVec, weights = weightsVec, fct = drcObj$fct, type = respType, + start = coef(drcObj)) + + m2 <- loess(yVec ~ doseVec, degree = 1) + mr <- mrdrm(m1, m2) + + as.vector(ED(mr, respLev, display = FALSE)) + }, silent = TRUE) + + if (inherits(result, "try-error")) + { + return(rep(NA, lenED)) + } + result + } + rowFct2 <- function(edVec) + { + as.vector(quantile(edVec, c((1 - level)/2, 1 - ((1 - level)/2)), na.rm = TRUE)) + } + ## Calculating ED values + if (lenED < 2) + { + EDmat <- matrix(rowFct2(apply(dataMat, 1, rowFct1)), nrow = 1) + } else { + EDmat <- t(apply(apply(dataMat, 1, rowFct1), 1, rowFct2)) + } + EDmat +} + + +#mv <- function(n, edval = 50, seedVal = 200810151) +#{ +# set.seed(seedVal) +# +# doseVec <- deguelin$dose +# nVec <- deguelin$n +# if (FALSE) +# { +## sigmaVal <- exp.x.mr$ +## lenData <- nrow() +## doseVec <- exp.x$conc +## fittedVec <- fitted(exp.x.mr) +# } +# edVec <- rep(NA, n) +# lVec <- rep(NA, n) +# for (i in 1:n) +# { +# if (TRUE) +# { +# rVec <- rbinom(length(nVec), nVec, fitted(deguelin.mr)) +# m1 <- try(drm(rVec/nVec ~ doseVec, weights = nVec, fct = LL.2(), type = "binomial", start = coef(deguelin.m1)), +# silent = TRUE) +# } +# if (FALSE) +# { +# rVec <- rnorm(lenData, fittedVec, sigmaVal) +# m1 <- try(drm(rVec ~ doseVec, fct = LL.3(), start = coef(exp.x.m1)), +# silent = TRUE) +# +# } +# if (inherits(m1, "try-error")) +# { +# edVec[i] <- NA +# } else { +# m2 <- loess(rVec/nVec ~ doseVec, degree = 1) +# mr <- mrdrm(m1, m2) +# edVec[i] <- ED(mr, edval, display = FALSE)[1] +# lVec[i] <- mr$lambda +# } +# } +# list(edVal = edVec, lambdaVal = lVec) +#} + + +## From the R-help e-mail by Ted Harding: http://tolstoy.newcastle.edu.au/R/e2/help/07/03/12853.html +## See also http://tolstoy.newcastle.edu.au/R/help/05/05/4254.html +"pava" <- function(x, wt = rep(1, length(x))) +{ + n <- length(x) + if (n <= 1) return(x) + lvlsets <- 1:n + repeat + { + viol <- (as.vector(diff(x)) < 0) + if (!(any(viol))) break + i <- min((1:(n-1))[viol]) + + lvl1 <- lvlsets[i] + lvl2 <- lvlsets[i+1] + ilvl <- ( (lvlsets == lvl1) | (lvlsets == lvl2) ) + + x[ilvl] <- sum(x[ilvl] * wt[ilvl]) / sum(wt[ilvl]) + lvlsets[ilvl] <- lvl1 + } + x +} + + +## Examples +if (FALSE) +{ + deguelin.mr <- mrdrm(deguelin.m1, deguelin.m2) + predict(deguelin.mr, interval="confidence") + plot(deguelin.m1, ylim=c(0,1)) + lines(deguelin$dose, predict(deguelin.mr), lty=2) + + ## With fixed lambda + deguelin.mr2 <- mrdrm(deguelin.m1, deguelin.m2, lambda=0.95) + lines(deguelin$dose, predict(deguelin.mr2), lty=3) + + exp.a.mr <- mrdrm(exp.a.m1, exp.a.m2) + predict(exp.a.mr, se.fit = TRUE) + ED(exp.a.mr, c(10, 50, 90)) + + ryegrass.mr <- mrdrm(ryegrass.m1, ryegrass.loess) + predict(ryegrass.mr) +} + + +#press(deguelin.m1, deguelin.m2, seq(0, 1, length.out=10), criterion="ll") + + +## trace hat component in drm() model fit? +#traceHat.drc <- function(object) +#{ +# object$"sumList"$lenData - df.residual(object) +#} +# +#traceHat.loess <- function(object) +#{ +# object$trace.hat +#} + + + + +## Example R lines +if (FALSE) +{ + +deguelin.m1<-drm(r/n~dose, weights=n, data=deguelin, fct=LL.2(), type="binomial") + +deguelin.m2<-loess(r/n~dose, data=deguelin, degree=1) +vPress(deguelin.m1, deguelin.m2, seq(0, 1, length.out=10)) + +deguelin.m3<-loess(r/n~log10(dose), data=deguelin, degree=1) +vPress(deguelin.m1, deguelin.m3, seq(0, 1, length.out=10)) + +} + +## Using lmeSplines +if (FALSE) +{ +library(lmeSplines) + +## lettuce +let2<-lettuce +let2<-cbind(let2, all=rep(1, 14)) +let2$Zt<-smspline(~conc, data=lettuce) + +let2.m1<-lme(weight~conc, data=let2, random=list(all=pdIdent(~Zt-1))) +plot(weight~conc, data=lettuce, log="x") +lines(let2$conc, fitted(let2.m1)) + + +## deguelin +deg2<-deguelin +deg2<-cbind(deg2, all=rep(1, 6)) +deg2$Zt<-smspline(~dose, data=deg2) + +deg2.m1<-lme(r/n~dose, data=deg2, random=list(all=pdIdent(~Zt-1))) +plot(r/n~dose, data=deg2) +lines(deg2$dose, fitted(deg2.m1)) + +## bin.mat +bm2<-bin.mat[c(3,6,9,12,15),] +bm2<-cbind(bm2, all=rep(1, 5)) +bm2$Zt<-smspline(~conc, data=bm2) + +bm2.m1<-lme(matured/total~conc, data=bm2, random=list(all=pdIdent(~Zt-1))) +plot(matured/total~conc, data=bm2) +lines(bm2$conc, fitted(bm2.m1)) # straight line! + + + +## exp.a +ea2<-exp.a +ea2<-cbind(ea2, all=rep(1,54)) + +ea2$Zt<-smspline(~x, data=ea2) +ea2.m1<-lme(y~x, data=ea2, random=list(all=pdIdent(~Zt-1))) +plot(y~x, ea2, log="x") +lines(ea2$x, fitted(ea2.m1)) +summary(ea2.m1) + + +ea2.m2<-drm(y~x, data=ea2, fct=LL.3()) +plot(ea2.m2, add=T, lty=2) + +cVec<-ea2$x[-c(7:12)] +Zt2<-smspline(cVec) +ea2$Zt2<-approx.Z(Zt2, cVec, ea2$x) +ea2.m3<-lme(y~x, data=ea2, random=list(all=pdIdent(~Zt2-1))) +lines(ea2$x, fitted(ea2.m3), col=2) + +cVec<-ea2$x[-c(13:18)] +Zt2<-smspline(cVec) +ea2$Zt2<-approx.Z(Zt2, cVec, ea2$x) +ea2.m3<-lme(y~x, data=ea2, random=list(all=pdIdent(~Zt2-1))) +lines(ea2$x, fitted(ea2.m3), col=5) + + + } \ No newline at end of file diff --git a/R/mselect.r b/R/mselect.R similarity index 59% rename from R/mselect.r rename to R/mselect.R index 6f41b304..5a723cbc 100644 --- a/R/mselect.r +++ b/R/mselect.R @@ -1,3 +1,48 @@ +#' @title Dose-response model selection +#' +#' @description +#' Model selection by comparison of different models using the following criteria: the log +#' likelihood value, Akaike's information criterion (AIC), the estimated residual standard +#' error or the p-value from a lack-of-fit test. +#' +#' @param object an object of class 'drc'. +#' @param fctList a list of dose-response functions to be compared. +#' @param nested logical. TRUE results in F tests between adjacent models (in \code{fctList}). +#' Only sensible for nested models. +#' @param sorted character string determining according to which criterion the model fits +#' are ranked. +#' @param linreg logical indicating whether or not additionally polynomial regression models +#' (linear, quadratic, and cubic models) should be fitted. +#' @param icfct function for supplying the information criterion to be used. +#' \code{\link{AIC}} and \code{\link{BIC}} are two options. +#' +#' @details +#' For Akaike's information criterion and the residual standard error: the smaller the better +#' and for lack-of-fit test (against a one-way ANOVA model): the larger (the p-value) the +#' better. Note that the residual standard error is only available for continuous dose-response +#' data. +#' +#' Log likelihood values cannot be used for comparison unless the models are nested. +#' +#' @return A matrix with one row for each model and one column for each criterion. +#' +#' @author Christian Ritz +#' +#' @examples +#' ### Example with continuous/quantitative data +#' ## Fitting initial four-parameter log-logistic model +#' ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +#' +#' ## Model selection +#' mselect(ryegrass.m1, list(LL.3(), LL.5(), W1.3(), W1.4(), W2.4(), baro5())) +#' +#' ## Model selection including linear, quadratic, and cubic regression models +#' mselect(ryegrass.m1, list(LL.3(), LL.5(), W1.3(), W1.4(), W2.4(), baro5()), linreg = TRUE) +#' +#' ## Comparing nested models +#' mselect(ryegrass.m1, list(LL.5()), nested = TRUE) +#' +#' @keywords models nonlinear "mselect" <- function(object, fctList = NULL, nested = FALSE, sorted = c("IC", "Res var", "Lack of fit", "no"), linreg = FALSE, icfct = AIC) { @@ -8,10 +53,6 @@ function(object, fctList = NULL, nested = FALSE, sorted = c("IC", "Res var", "La contData <- identical(object$"type", "continuous") nestedInd <- 3 + contData + nested -# if (missing(fctList)) -# { -# return(object) -# } else { mc <- match.call() lenFL <- length(fctList) @@ -19,28 +60,20 @@ function(object, fctList = NULL, nested = FALSE, sorted = c("IC", "Res var", "La retMat[1 ,1] <- logLik(object) retMat[1, 2] <- icfct(object) # AIC(object) - if (nested) {retMat[1, 3] <- modelFit(object)[2, 5]} + retMat[1, 3] <- modelFit(object)[2, 5] if (contData) { tryRV <- try(summary(object)$"resVar", silent = TRUE) - if (!inherits("tryRV", "try-error")) + if (!inherits(tryRV, "try-error")) { retMat[1, 4] <- tryRV } else { retMat[1, 4] <- NA } -# retMat[1, 4] <- summary(object)$"resVar" } if (nested) {retMat[1, nestedInd] <- NA} -# fctList2 <- list() -# fctList2[[1]] <- deparse((object$"call"$"fct")) - -# retList <- list() -# retList[[1]] <- object - fctList2 <- rep("", lenFL + 1) -# fctList2[1] <- deparse((object$"call"$"fct")) fctList2[1] <- object$"fct"$"name" if (!is.null(fctList)) @@ -48,41 +81,25 @@ function(object, fctList = NULL, nested = FALSE, sorted = c("IC", "Res var", "La prevObj <- object for (i in 1:lenFL) { -# tempObj <- update(object, fct = fctList[[i]]) # try(update(object, fct = fctList[[i]]), silent = TRUE) tempObj <- try(update(object, fct = fctList[[i]], data = object[["origData"]]), silent = TRUE) fctList2[i+1] <- fctList[[i]]$"name" if (!inherits(tempObj, "try-error")) { -# if (is.null(names(fctList))) -# { - -# tempChar <- deparse(mc[[3]][i+1]) -# fctList2[i+1] <- substr(tempChar, start = 1, stop = nchar(tempChar) - 2) - -# fctList2[i+1] <- fctList[[i]]$"name" - -# } else { -# tempChar <- names(fctList)[i] -# fctList2[i+1] <- as.character(tempChar) -# } - - retMat[i+1, 1] <- logLik(tempObj) retMat[i+1, 2] <- icfct(tempObj) # AIC(tempObj) - if (nested) {retMat[i+1, 3] <- modelFit(tempObj)[2, 5]} + retMat[i+1, 3] <- modelFit(tempObj)[2, 5] if (contData) { tryRV2 <- try(summary(tempObj)$"resVar", silent = TRUE) - if (!inherits("tryRV2", "try-error")) + if (!inherits(tryRV2, "try-error")) { retMat[i + 1, 4] <- tryRV2 } else { retMat[i + 1, 4] <- NA - } -# retMat[i+1, 4] <- summary(tempObj)$"resVar" - } + } + } if (nested) { @@ -94,7 +111,6 @@ function(object, fctList = NULL, nested = FALSE, sorted = c("IC", "Res var", "La prevObj <- tempObj } } -# } rownames(retMat) <- as.vector(unlist(fctList2)) @@ -114,28 +130,23 @@ function(object, fctList = NULL, nested = FALSE, sorted = c("IC", "Res var", "La lm(yVec ~ xVec + I(xVec * xVec) + I(xVec * xVec * xVec), data = drcData)) -# linModMat <- matrix(unlist(lapply(linFitList, function(listObj) {c(logLik(listObj), AIC(listObj), NA, (summary(listObj)$"sigma")^2)})), linModMat <- matrix(unlist(lapply(linFitList, function(listObj) {c(logLik(listObj), icfct(listObj), NA, (summary(listObj)$"sigma")^2)})), 3, 4, byrow = TRUE) rownames(linModMat) <- c("Lin", "Quad", "Cubic") colnames(linModMat) <- cnames[1:4] -# print(linModMat) if (nested) # switching off nested in case linear fits are requested { retMat <- retMat[, 1:4] } -# print(retMat) retMat <- rbind(retMat, linModMat) } -# print(retMat) if (sorted != "no") { return(retMat[order(retMat[, sorted]), ]) } else { return(retMat) } -# return(list(fctList2, retList)) } diff --git a/R/multi2.r b/R/multi2.R similarity index 75% rename from R/multi2.r rename to R/multi2.R index 8909374b..4452f916 100644 --- a/R/multi2.r +++ b/R/multi2.R @@ -1,3 +1,32 @@ +#' Multistage Dose-Response Model with Quadratic Terms +#' +#' A five-parameter multistage dose-response model useful for describing more complex +#' dose-response patterns. +#' +#' The multistage model function with quadratic terms is: +#' +#' \deqn{f(x) = c + (d-c)\exp(-b1 - b2 x - b3 x^2)} +#' +#' where x denotes the dose or the logarithm-transformed dose. +#' +#' @param fixed numeric vector specifying which parameters are fixed and at what value +#' they are fixed. NAs are used for parameters that are not fixed. +#' @param names a vector of character strings giving the names of the parameters +#' (should not contain ":"). The default is reasonable. +#' @param ssfct a self starter function to be used. +#' @param fctName optional character string used internally by convenience functions. +#' @param fctText optional character string used internally by convenience functions. +#' +#' @return A list containing the nonlinear function, the self starter function, +#' and the parameter names. +#' +#' @references Wheeler, M. W., Bailer, A. J. (2009) +#' Comparing model averaging with other model selection strategies for benchmark +#' dose estimation, \emph{Environmental and Ecological Statistics}, \bold{16}, 37--51. +#' +#' @author Christian Ritz +#' +#' @keywords models nonlinear "multi2" <- function( fixed = c(NA, NA, NA, NA, NA), names = c("b1", "b2", "b3", "c", "d"), ssfct = NULL, fctName, fctText) @@ -62,8 +91,7 @@ ssfct = NULL, fctName, fctText) ssfct <- function(dframe) { first4 <- llogistic.ssf(fixed = c(NA, NA, NA, NA, 1))(dframe) -# c(0, -first4[1], 0, first4[2:3])[is.na(fixed)] - c(0, -first4[1] / (mean(dframe[, 1]) * 0.7), 0, first4[2:3])[notFixed] + c(0, -first4[1] / (mean(dframe[, 1]) * 0.7), 0, first4[2:3])[notFixed] } } @@ -88,7 +116,9 @@ ssfct = NULL, fctName, fctText) edfct <- function(parm, respl, reference, type, ...) { parmVec[notFixed] <- parm - p <- absToRel(parmVec, respl, type) + ## Reorder parmVec so that c (lower asymptote) is at index 2 and d (upper asymptote) + ## is at index 3, as expected by absToRel() + p <- absToRel(parmVec[c(1, 4, 5, 2, 3)], respl, type) ## Reversing p if (identical(type, "absolute")) @@ -99,7 +129,6 @@ ssfct = NULL, fctName, fctText) { p <- 100 - p } -# pProp <- log(1 - (100 - p) / 100) pProp <- log((100 - p) / 100) ## deriv(~ (-b2+sqrt(b2*b2-4*b3*(b1+22)))/(2*b3), c("b1", "b2", "b3", "c", "d"), function(b1, b2, b3, c, d){}) diff --git a/R/nec.R b/R/nec.R new file mode 100644 index 00000000..b3cb7986 --- /dev/null +++ b/R/nec.R @@ -0,0 +1,177 @@ +#' @title No Effect Concentration (NEC) dose-response model +#' +#' @description +#' The NEC model is a dose-response model with a threshold below which the response is assumed +#' constant and equal to the control response. It has been proposed as an alternative to both the +#' classical NOEC and the regression-based EC/ED approach. +#' +#' @param fixed numeric vector specifying which parameters are fixed and at what value they are fixed. +#' NAs are used for parameters that are not fixed. +#' @param names a vector of character strings giving the names of the parameters (should not contain ":"). +#' The default is reasonable (see under 'Usage'). +#' @param fctName optional character string used internally by convenience functions. +#' @param fctText optional character string used internally by convenience functions. +#' +#' @details +#' The NEC model function proposed by Pires et al (2002) is: +#' \deqn{f(x) = c + (d-c)\exp(-b(x-e)I(x-e))} +#' where \eqn{I(x-e)} is the indicator function equal to 0 for \eqn{x<=e} and 1 for \eqn{x>e}. +#' +#' @return A list containing the nonlinear function, the self starter function +#' and the parameter names. +#' +#' @references +#' Pires, A. M., Branco, J. A., Picado, A., Mendonca, E. (2002) +#' Models for the estimation of a 'no effect concentration', +#' \emph{Environmetrics}, \bold{13}, 15--27. +#' +#' @author Christian Ritz +#' +#' @seealso \code{\link{NEC.2}}, \code{\link{NEC.3}}, \code{\link{NEC.4}}, \code{\link{drm}} +#' +#' @examples +#' nec.m1 <- drm(rootl ~ conc, data = ryegrass, fct = NEC.4()) +#' summary(nec.m1) +#' plot(nec.m1) +#' +#' @keywords models nonlinear +"NEC" <- function( +fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), +fctName, fctText) +{ + ## Checking arguments + numParm <- 4 + if (!is.character(names) | !(length(names) == numParm)) {stop("Not correct 'names' argument")} + if ( !(length(fixed) == numParm) ) {stop("Not correct 'fixed' argument")} + + ## Handling 'fixed' argument + notFixed <- is.na(fixed) + parmVec <- rep(0, numParm) + parmVec[!notFixed] <- fixed[!notFixed] + + ## Defining the non-linear function + fct <- function(dose, parm) + { + parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE) + parmMat[, notFixed] <- parm + + cParm <- parmMat[, 2] + doseDiff <- dose - parmMat[, 4] + cParm + (parmMat[, 3] - cParm) * exp(-parmMat[, 1] * doseDiff * (doseDiff > 0) ) + } + + ## Defining self starter function + ssfct <- function(dframe) + { + LLinit <- llogistic.ssf(fixed = c(NA, NA, NA, NA, 1))(dframe) # drc::: not needed + c(LLinit[1:3], LLinit[3]/3)[is.na(fixed)] + } + + ##Defining the first and second derivative (in the parameters) + deriv1 <- NULL + deriv2 <- NULL + + ##Defining the first derivative (in the dose) + derivx <- NULL + + ## Defining the ED function + edfct <- NULL + + ## Returning the function with self starter and names + returnList <- + list(fct = fct, ssfct = ssfct, names = names[notFixed], + deriv1 = deriv1, deriv2 = deriv2, derivx = derivx, edfct = edfct, + name = ifelse(missing(fctName), as.character(match.call()[[1]]), fctName), + text = ifelse(missing(fctText), "NEC", fctText), + noParm = sum(is.na(fixed)) + ) + + class(returnList) <- "NEC" + invisible(returnList) +} + + +#' @title Two-parameter NEC model +#' +#' @description +#' Convenience function for the NEC model with lower limit fixed at 0 and upper limit fixed. +#' +#' @param upper numeric value. The fixed upper limit in the model. Default is 1. +#' @param fixed numeric vector of length 2 specifying fixed parameters (NAs for free parameters). +#' @param names character vector of parameter names. +#' @param ... additional arguments passed to \code{\link{NEC}}. +#' +#' @return A list (see \code{\link{NEC}}). +#' +#' @seealso \code{\link{NEC}}, \code{\link{NEC.3}}, \code{\link{NEC.4}} +#' +#' @keywords models nonlinear +"NEC.2" <- +function(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) +{ + ## Checking arguments + numParm <- 2 + if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct 'names' argument")} + if (!(length(fixed)==numParm)) {stop("Not correct length of 'fixed' argument")} + + return( NEC(fixed = c(fixed[1], 0, upper, fixed[2]), + names = c(names[1], "c", "d", names[2]), + fctName = as.character(match.call()[[1]]), + fctText = lowupFixed("NEC", upper), + ...) ) +} + +#' @title Three-parameter NEC model +#' +#' @description +#' Convenience function for the NEC model with the lower limit fixed at 0. +#' +#' @param fixed numeric vector of length 3 specifying fixed parameters (NAs for free parameters). +#' @param names character vector of parameter names. +#' @param ... additional arguments passed to \code{\link{NEC}}. +#' +#' @return A list (see \code{\link{NEC}}). +#' +#' @seealso \code{\link{NEC}}, \code{\link{NEC.2}}, \code{\link{NEC.4}} +#' +#' @keywords models nonlinear +"NEC.3" <- +function(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) +{ + ## Checking arguments + numParm <- 3 + if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct 'names' argument")} + if (!(length(fixed)==numParm)) {stop("Not correct length of 'fixed' argument")} + + return( NEC(fixed = c(fixed[1], 0, fixed[2:3]), + names = c(names[1], "c", names[2:3]), + fctName = as.character(match.call()[[1]]), + fctText = lowFixed("NEC"), + ...) ) +} + +#' @title Four-parameter NEC model +#' +#' @description +#' Convenience function for the full four-parameter NEC model. +#' +#' @param fixed numeric vector of length 4 specifying fixed parameters (NAs for free parameters). +#' @param names character vector of parameter names. +#' @param ... additional arguments passed to \code{\link{NEC}}. +#' +#' @return A list (see \code{\link{NEC}}). +#' +#' @seealso \code{\link{NEC}}, \code{\link{NEC.2}}, \code{\link{NEC.3}} +#' +#' @keywords models nonlinear +"NEC.4" <- +function(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) +{ + ## Checking arguments + numParm <- 4 + if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct 'names' argument")} + if (!(length(fixed)==numParm)) {stop("Not correct length of 'fixed' argument")} + + return( NEC(fixed = fixed, names = names, + fctName = as.character(match.call()[[1]]), ...) ) +} diff --git a/R/nec.r b/R/nec.r deleted file mode 100644 index 410f4b6b..00000000 --- a/R/nec.r +++ /dev/null @@ -1,97 +0,0 @@ -"NEC" <- function( -fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), -fctName, fctText) -{ - ## Checking arguments - numParm <- 4 - if (!is.character(names) | !(length(names) == numParm)) {stop("Not correct 'names' argument")} - if ( !(length(fixed) == numParm) ) {stop("Not correct 'fixed' argument")} - - ## Handling 'fixed' argument - notFixed <- is.na(fixed) - parmVec <- rep(0, numParm) - parmVec[!notFixed] <- fixed[!notFixed] - - ## Defining the non-linear function - fct <- function(dose, parm) - { - parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE) - parmMat[, notFixed] <- parm - - cParm <- parmMat[, 2] - doseDiff <- dose - parmMat[, 4] - cParm + (parmMat[, 3] - cParm) * exp(-parmMat[, 1] * doseDiff * (doseDiff > 0) ) - } - - ## Defining self starter function - ssfct <- function(dframe) - { - LLinit <- llogistic.ssf(fixed = c(NA, NA, NA, NA, 1))(dframe) # drc::: not needed - c(LLinit[1:3], LLinit[3]/3)[is.na(fixed)] - } - - ##Defining the first and second derivative (in the parameters) - deriv1 <- NULL - deriv2 <- NULL - - ##Defining the first derivative (in the dose) - derivx <- NULL - - ## Defining the ED function - edfct <- NULL - - ## Returning the function with self starter and names - returnList <- - list(fct = fct, ssfct = ssfct, names = names[notFixed], - deriv1 = deriv1, deriv2 = deriv2, derivx = derivx, edfct = edfct, - name = ifelse(missing(fctName), as.character(match.call()[[1]]), fctName), - text = ifelse(missing(fctText), "NEC", fctText), - noParm = sum(is.na(fixed)) - ) - - class(returnList) <- "NEC" - invisible(returnList) -} - - -"NEC.2" <- -function(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) -{ - ## Checking arguments - numParm <- 2 - if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct 'names' argument")} - if (!(length(fixed)==numParm)) {stop("Not correct length of 'fixed' argument")} - - return( NEC(fixed = c(fixed[1], 0, upper, fixed[2]), - names = c(names[1], "c", "d", names[2]), - fctName = as.character(match.call()[[1]]), - fctText = lowupFixed("NEC", upper), - ...) ) -} - -"NEC.3" <- -function(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) -{ - ## Checking arguments - numParm <- 3 - if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct 'names' argument")} - if (!(length(fixed)==numParm)) {stop("Not correct length of 'fixed' argument")} - - return( NEC(fixed = c(fixed[1], 0, fixed[2:3]), - names = c(names[1], "c", names[2:3]), - fctName = as.character(match.call()[[1]]), - fctText = lowFixed("NEC"), - ...) ) -} - -"NEC.4" <- -function(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) -{ - ## Checking arguments - numParm <- 4 - if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct names argument")} - if (!(length(fixed)==numParm)) {stop("Not correct length of 'fixed' argument")} - - return( NEC(fixed = fixed, names = names, - fctName = as.character(match.call()[[1]]), ...) ) -} diff --git a/R/neill.test.R b/R/neill.test.R index 10978853..3e3d2ad7 100644 --- a/R/neill.test.R +++ b/R/neill.test.R @@ -1,3 +1,52 @@ +#' Neill's lack-of-fit test for dose-response models +#' +#' \code{neill.test} provides a lack-of-fit test for non-linear regression models. It is +#' applicable both in cases where there are replicates (in which case it reduces to the +#' standard lack-of-fit test against an ANOVA model) and in cases where there are no +#' replicates, though then a grouping has to be provided. +#' +#' The functions use the methods \code{\link{df.residual}} and \code{\link{residuals}} and +#' the \code{data} component of \code{object} (only for determining the number of observations). +#' +#' @param object object of class 'drc' or 'nls'. +#' @param grouping character or numeric vector that provides the grouping of the dose values. +#' @param method character string specifying the method to be used to generate a grouping +#' of the dose values. +#' @param breakp numeric vector of break points for generating dose intervals that form a grouping. +#' @param display logical. If TRUE results are displayed. Otherwise they are not (useful in simulations). +#' +#' @return The function returns an object of class anova which is displayed using +#' \code{print.anova}. +#' +#' @note A clustering technique could be employed to determine the grouping to be used in cases +#' where there are no replicates. There should at most be ceiling(n/2) clusters as otherwise +#' some observations will not be used in the test. At the other end there need to be more +#' clusters than parameters in the model. +#' +#' @references Neill, J. W. (1988) Testing for lack of fit in nonlinear regression, +#' \emph{Ann. Statist.}, \bold{16}, 733--740 +#' +#' @author Christian Ritz +#' +#' @seealso See also \code{\link{modelFit}} for details on the lack-of-fit test against an +#' ANOVA model. +#' +#' @examples +#' ### Example with 'drc' object +#' +#' ## Lack-of-fit test against ANOVA +#' ryegrass.m1 <-drm(rootl~conc, data = ryegrass, fct = LL.4()) +#' modelFit(ryegrass.m1) +#' +#' ## The same test using 'neill.test' +#' neill.test(ryegrass.m1, ryegrass$conc) +#' +#' ## Generating a grouping +#' neill.test(ryegrass.m1, method="c-finest") +#' neill.test(ryegrass.m1, method="finest") +#' neill.test(ryegrass.m1, method="perc") +#' +#' @keywords models nonlinear "neill.test" <- function( object, grouping, method = c("c-finest", "finest", "percentiles"), breakp = NULL, display = TRUE) { @@ -42,6 +91,7 @@ object, grouping, method = c("c-finest", "finest", "percentiles"), breakp = NULL } } +#' @keywords internal "neill.default" <- function(object, grouping, anovaDisplay) { M <- length(unique(grouping)) @@ -64,8 +114,6 @@ object, grouping, method = c("c-finest", "finest", "percentiles"), breakp = NULL if (anovaDisplay) { ## Print information on grouping: -# tapply(polcurve$dist, grouping, function(x){paste(as.character(range(x)), collapse = "-")}) -# The above line should in the clustering function cat("Grouping used\n\n") grTable <- table(grouping) dimnames(grTable) <- list(dimnames(grTable)$grouping) diff --git a/R/noEffect.R b/R/noEffect.R index 2305cf98..f6bf7dfb 100644 --- a/R/noEffect.R +++ b/R/noEffect.R @@ -1,3 +1,26 @@ +#' @title Testing if there is a dose effect at all +#' +#' @description +#' A significance test is provided for the comparison of the dose-response model considered +#' and the simple linear regression model with slope 0 (a horizontal regression line +#' corresponding to no dose effect). +#' +#' @param object an object of class 'drc'. +#' +#' @details Perhaps useful for screening purposes. +#' +#' @return The likelihood ratio test statistic and the corresponding degrees of freedom +#' and p-value are reported. +#' +#' @author Christian Ritz +#' +#' @examples +#' ryegrass.LL.4 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +#' +#' noEffect(ryegrass.LL.4) +#' # p-value < 0.0001: there is a highly significant dose effect! +#' +#' @keywords models nonlinear noEffect <- function(object) { if (identical(object$"type", "binomial")) @@ -6,10 +29,11 @@ noEffect <- function(object) weiVec <- object$"dataList"$weights llNull <- logLik(glm(cbind(respVec*weiVec, (1-respVec)*weiVec) ~ 1, family = binomial)) } - + if (identical(object$"type", "Poisson")) { - llNull <- logLik(glm(resp ~ 1, family = poisson)) + respVec <- object$"dataList"$resp + llNull <- logLik(glm(respVec ~ 1, family = poisson)) } if (identical(object$"type", "continuous")) @@ -20,6 +44,14 @@ noEffect <- function(object) lrt <- -2*(llNull - lldrc) dfDiff <- attr(lldrc, "df") - attr(llNull, "df") + # Check if degrees of freedom difference is valid + if (dfDiff <= 0) { + warning("Degrees of freedom difference is ", dfDiff, + ". This may indicate that the dose-response model has no additional ", + "parameters compared to the null model (e.g., when parameters are fixed). ", + "The likelihood ratio test may not be meaningful in this case.") + } + retVec <- c(lrt, dfDiff, 1 - pchisq(lrt, dfDiff)) names(retVec) <- c("Chi-square test", "Df", "p-value") retVec diff --git a/R/onAttach.R b/R/onAttach.R index 9189ad4e..2c614192 100644 --- a/R/onAttach.R +++ b/R/onAttach.R @@ -1,10 +1,29 @@ -.onAttach <- function(libname, pkgname) -{ - packageStartupMessage("\n'drc' has been loaded.\n") - packageStartupMessage("Please cite R and 'drc' if used for a publication,") - packageStartupMessage("for references type 'citation()' and 'citation('drc')'.\n") - -# cat("\n") -# cat("'drc' has been loaded.\n\n") -# cat("for references type 'citation()' and 'citation('drc')'.\n\n") -} +#' @title Package attach hook +#' @keywords internal +.onAttach <- function(libname, pkgname) +{ + packageStartupMessage(paste0( + "\n===============================================\n", + " 'drc' has been loaded\n", + " Analysis of Dose-Response Data\n", + " Version 3.3.2\n", + "===============================================\n\n", + "Developers:\n", + " - Christian Ritz (ritz@bioassay.dk)\n", + " - Jens C. Streibig (streibig@bioassay.dk)\n", + " - Hannes Reinwald (hannes.reinwald@bayer.com)\n\n", + "Please cite 'drc' if used for a publication:\n\n", + " Ritz, C., Jensen, S. M., Gerhard, D., Streibig, J. C. (2019)\n", + " Dose-Response Analysis Using R. CRC Press\n\n", + "Additional references:\n", + " - Ritz, C., et al. (2015). Dose-Response Analysis Using R.\n", + " PLOS ONE, 10(12), e0146021.\n", + " - Ritz, C. and Streibig, J. C. (2005). Bioassay Analysis using R.\n", + " Journal of Statistical Software, 12(5), 1-22.\n\n", + "For citation formats, type: citation('drc')\n", + "For R citation, type: citation()\n\n", + "Bug reports and issues:\n", + " https://github.com/hreinwald/drc/issues/\n", + "===============================================\n" + )) +} \ No newline at end of file diff --git a/R/pickParm.R b/R/pickParm.R index 9937098c..0895588b 100644 --- a/R/pickParm.R +++ b/R/pickParm.R @@ -1,18 +1,20 @@ -## Helper functions for mean functions -"pickParm" <- function(parmVec, indexVec, parmNo) -{ - function(parm) - { - parmVec[indexVec] <- parm - parmVec[parmNo] - } -} - -"monoParm" <- function(parmVec, indexVec, parmNo, signVal) -{ - function(parm) - { - parmVec[indexVec] <- parm - signVal * parmVec[parmNo] - } -} +## Helper functions for mean functions +#' @title Pick parameters from model +#' @keywords internal +"pickParm" <- function(parmVec, indexVec, parmNo) +{ + function(parm) + { + parmVec[indexVec] <- parm + parmVec[parmNo] + } +} + +"monoParm" <- function(parmVec, indexVec, parmNo, signVal) +{ + function(parm) + { + parmVec[indexVec] <- parm + signVal * parmVec[parmNo] + } +} diff --git a/R/plot.drc.R b/R/plot.drc.R index 31695b77..2783ba6c 100644 --- a/R/plot.drc.R +++ b/R/plot.drc.R @@ -1,788 +1,735 @@ -"plot.drc" <- -function(x, ..., add = FALSE, level = NULL, type = c("average", "all", "bars", "none", "obs", "confidence"), -broken = FALSE, bp, bcontrol = NULL, conName = NULL, axes = TRUE, gridsize = 100, -log = "x", xtsty, xttrim = TRUE, xt = NULL, xtlab = NULL, xlab, xlim, -yt = NULL, ytlab = NULL, ylab, ylim, -cex, cex.axis = 1, col = FALSE, lty, pch, -legend, legendText, legendPos, cex.legend = 1, -normal = FALSE, normRef = 1, confidence.level = 0.95) -{ - object <- x - type <- match.arg(type) - - ## Determining logarithmic scales - if ((log == "") || (log == "y")) - { - logX <- FALSE - } else { - logX <- TRUE - } - - ## Determining the tick mark style for the dose axis - if (missing(xtsty)) - { - if (logX) - { - xtsty <- "base10" - } else { - xtsty <- "standard" - } - } - - ## Constructing the plot data -# origData<-object$"data" -# doseDim <- ncol(origData) - 4 # subtracting 4 because the data frame also contains columns with response, - # curve no. (in new and old enumeration) and weights -# if (doseDim > 1) {stop("No plot features for plots in more than two dimensions")} -# dose1 <- origData[, 1:doseDim] -# resp1 <- origData[, doseDim+1] - - dataList <- object[["dataList"]] - dose <- dataList[["dose"]] - resp <- dataList[["origResp"]] - curveid <- dataList[["curveid"]] - plotid <- dataList[["plotid"]] -# levels(curveid) <- unique(dataList[["curveid"]]) # commented out 12/2-2014 - - ## Modifying "response" in case of SSD - if (identical(object[["type"]], "ssd")) - { - dose <- unlist(with(dataList, tapply(dose, curveid, function(x){sort(x)}))[unique(dataList[["curveid"]])]) - resp <- unlist(with(dataList, tapply(dose, curveid, function(x){ppoints(x, 0.5)}))[unique(dataList[["curveid"]])]) -# print(resp) - } - - ## Normalizing the response values - if (normal) - { - names(resp) <- seq(length(resp)) - respList <- split(resp, curveid) - - respNorm <- mapply(normalizeLU, respList, - as.list(as.data.frame(getLU(object)))[names(respList)], - normRef = normRef, SIMPLIFY = F) - - resp <- do.call(c, unname(respNorm))[as.character(seq(length(resp)))] -# respNew <- unlist(mapply(normalizeLU, respList, as.list(as.data.frame(getLU(object))))) -# print(respNew) -# print(resp) - } - -# assayNo <- origData[, 3] -# assayNoOld <- as.vector(origData[, 4]) # as.vector() to remove factor structure - -# if (!is.null(dataList[["plotid"]])) -# { -# assayNoOld <- dataList[["plotid"]] -# uniAss <- unique(assayNoOld) -# } else { -# assayNoOld <- as.vector(curveid) # as.vector() to remove factor structure -# uniAss <- unique(curveid) -# } -# commented out 3/3-'14 - - if (!is.null(plotid)) - { # used for event-time data - -# piVec <- dataList[["plotid"]] -# levels(piVec) <- as.vector(unique(curveid)) -# assayNoOld <- as.vector(piVec) # used for event-time data - assayNoOld <- as.vector(plotid) - } else { - assayNoOld <- as.vector(curveid) - } - uniAss <- unique(assayNoOld) - numAss <- length(uniAss) - -# print(uniAss) - -# numAss <- length(unique(assayNoOld)) -# doPlot <- is.null(level) || any(unique(assayNoOld) %in% level) - - doPlot <- is.null(level) || any(uniAss %in% level) - if (!doPlot) {stop("Nothing to plot")} - - plotFct <- (object$"curve")[[1]] - logDose <- (object$"curve")[[2]] - naPlot <- ifelse(is.null(object$"curve"$"naPlot"), FALSE, TRUE) - -# if (missing(conName)) -# { -# if (is.null(logDose)) {conName <- expression(0)} else {conName <- expression(-infinity)} -# } - - ## Assigning axis names -# varNames <- colnames(origData)[1:(doseDim+1)] - - dlNames <- dataList[["names"]] - doseName <- dlNames[["dName"]] - respName <- dlNames[["orName"]] - # axis names are the names of the dose variable and response variable in the original data set -# if (missing(xlab)) {if (varNames[1] == "") {xlab <- "Dose"} else {xlab <- varNames[1]}} -# if (missing(ylab)) {if (varNames[2] == "") {ylab <- "Response"} else {ylab <- varNames[2]}} - if (missing(xlab)) {if (doseName == "") {xlab <- "Dose"} else {xlab <- doseName}} - if (missing(ylab)) {if (respName == "") {ylab <- "Response"} else {ylab <- respName}} - - ## Determining range of dose values - if (missing(xlim)) - { - xLimits <- c(min(dose), max(dose)) - } else { - xLimits <- xlim # if (abs(xLimits[1]) 0]))) - 1 - conLevel <- 10^(log10cl) - } - } else { - conLevel <- bp - } - if ((xLimits[1] < conLevel) && (logX || (!is.null(logDose)))) - { - xLimits[1] <- conLevel - smallDoses <- (dose < conLevel) - dose[smallDoses] <- conLevel - if (is.null(conName)) - { - if (is.null(logDose)) {conName <- expression(0)} else {conName <- expression(-infinity)} - } -# conNameYes <- TRUE - } else { -# conNameYes <- FALSE - conName <- NULL - } - if (xLimits[1] >= xLimits[2]) {stop("Argument 'conLevel' is set too high")} - - ## Constructing dose values for plotting -# if (doseDim == 1) -# { - if ((is.null(logDose)) && (logX)) - { - dosePts <- exp(seq(log(xLimits[1]), log(xLimits[2]), length = gridsize)) - ## Avoiding that slight imprecision produces dose values outside the dose range - ## (the model-robust predict method is sensitive to such deviations!) - dosePts[1] <- xLimits[1] - dosePts[gridsize] <- xLimits[2] - } else { - dosePts <- seq(xLimits[1], xLimits[2], length = gridsize) - } -# } else {} # No handling of multi-dimensional dose values - - - ## Finding minimum and maximum on response scale - if (is.null(logDose)) - { - plotMat <- plotFct(dosePts) - } else { - plotMat <- plotFct(logDose^(dosePts)) - } - ## Normalizing the fitted values - if (normal) - { - respList <- split(resp, curveid) - plotMat <- mapply(normalizeLU, as.list(as.data.frame(plotMat)), - as.list(as.data.frame(getLU(object))), - normRef = normRef) -# pmNew <- mapply(normalizeLU, as.list(as.data.frame(plotMat)), as.list(as.data.frame(getLU(object)))) -# print(pmNew) -# print(plotMat) - } -# numCol <- ncol(plotMat) - - maxR <- max(resp) - options(warn = -1) # suppressing warning in case maximum of NULL is taken - maxPM <- apply(plotMat, 2, max, na.rm = TRUE) - if (max(maxPM) > maxR) {maxPM <- maxPM[which.max(maxPM)]} else {maxPM <- maxR} - options(warn=0) - - if (missing(ylim)) - { - if (missing(xlim)) - { - yLimits <- c(min(resp), maxPM) - } else { - yLimits <- getRange(dose, resp, xLimits) - } - } else { - yLimits <- ylim - } - - - ## Cutting away y values (determined by the fitted model) outside the limits -### naPlot <- FALSE # remove naPlot further down -# for (i in 1:numCol) -# { -# logVec <- !(plotMat[, i] >= yLimits[1] & plotMat[, i] <= yLimits[2]) -# if ( any(!is.na(logVec)) && any(logVec) ) -# { -# plotMat[logVec, i] <- NA -# naPlot <- TRUE -# } -# } - - ## Setting a few graphical parameters - par(las = 1) - if (!is.null(logDose)) - { - if (log == "x") {log <- ""} - if ( (log == "xy") || (log == "yx") ) {log <- "y"} - } - - ## Cutting away original x values outside the limits - eps1 <- 1e-8 - logVec <- !( (dose < xLimits[1] - eps1) | (dose > xLimits[2] + eps1) ) - dose <- dose[logVec] - resp <- resp[logVec] -# assayNo <- assayNo[logVec] - assayNoOld <- assayNoOld[logVec] - - ## Calculating predicted values for error bars - if (identical(type, "bars")) - { -# predictMat <- predict(object, interval = "confidence")[, 3:4] -# predictMat <- predict(object, interval = "confidence")[, c("Lower", "Upper")] - predictMat <- predict(object, interval = "confidence", - level = confidence.level)[, c("Lower", "Upper")] - - if(normal) { - names(predictMat) <- seq(length(predictMat)) - predictList <- split(predictMat, curveid) - predictMatListNorm <- mapply(normalizeLU, predictList, - as.list(as.data.frame(getLU(object))), - normRef = normRef, - SIMPLIFY = F) - predictMatNorm <- do.call(c, unname(predictMatListNorm))[as.character(seq(length(predictMat)))] - predictMat<- matrix(predictMatNorm, ncol = 2) - } -# print(predictMat) - - barFct <- function(plotPoints) - { - pp3 <- plotPoints[, 3] - pp4 <- plotPoints[, 4] - plotCI(plotPoints[, 1], pp3 + 0.5 * (pp4 - pp3), - li = pp3, ui = pp4, add = TRUE, pch = NA) - } - - ciFct <- function(level, ...){invisible(NULL)} - - pointFct <- function(plotPoints, cexVal, colVal, pchVal, ...){invisible(NULL)} - - } else if (identical(type, "confidence")) - { - - barFct <- function(plotPoints){invisible(NULL)} - - ciFct <- function(level, ...) - { - newdata <- data.frame(DOSE=dosePts, CURVE=rep(level, length(dosePts))) - predictMat <- predict(object, - newdata=newdata, - interval = "confidence", - level=confidence.level) - - x <- c(dosePts, rev(dosePts)) - y <- c(predictMat[,"Lower"], rev(predictMat[,"Upper"])) - polygon(x,y, border=NA, ...) - } - - pointFct <- function(plotPoints, cexVal, colVal, pchVal, ...){invisible(NULL)} - - } else { - - barFct <- function(plotPoints){invisible(NULL)} - - ciFct <- function(level, ...){invisible(NULL)} - - pointFct <- function(plotPoints, cexVal, colVal, pchVal, ...) - { - points(plotPoints, cex = cexVal, col = colVal, pch = pchVal, ...) - } - } - - - ## Setting the plot type - if ( (identical(type, "none")) || (identical(type, "bars")) ) - { - plotType <- "n" - } else { - plotType <- "p" - } - - ## Determining levels to be plotted -# uniAss <- unique(assayNoOld) - if (is.null(level)) - { - level <- uniAss - } else { - level <- intersect(level, uniAss) - } - lenlev <- length(level) - - ## Determining presence of legend - if (missing(legend)) - { - if (lenlev == 1) {legend <- FALSE} else {legend <- TRUE} - } - - ## Setting graphical parameters - colourVec <- rep(1, lenlev) - if (is.logical(col) && col) - { - colourVec <- 1:lenlev - } - if (!is.logical(col) && (length(col) == lenlev) ) - { - colourVec <- col - } - if (!is.logical(col) && (!(length(col) == lenlev)) ) - { - colourVec <- rep(col, lenlev) - } - cexVec <- parFct(cex, lenlev, 1) - ltyVec <- parFct(lty, lenlev) - pchVec <- parFct(pch, lenlev) - - ## Plotting data - levelInd <- 1:lenlev - for (i in levelInd) - { - indVec <- level[i] == assayNoOld -# print(indVec) -# print(level[i]) -# print(assayNoOld) - plotPoints <- - switch( - type, - - "average" = cbind(as.numeric(names(tapVec <- tapply(resp[indVec], - dose[indVec], mean))), tapVec), - - "bars" = cbind( - as.numeric(names(tapVec <- tapply(resp[indVec], dose[indVec], mean))), - tapVec, - tapply(predictMat[indVec, 1], dose[indVec], head, 1), - tapply(predictMat[indVec, 2], dose[indVec], head, 1)), - - "none" = cbind(dose[indVec], resp[indVec]), - "all" = cbind(dose[indVec], resp[indVec]), - "obs" = cbind(dose[indVec], resp[indVec]) - ) -# print(plotPoints) - ## New approach -# plotPointsRaw <- ppList[uniAss2[i]] -# plotPoints <- with(plotPointsRaw, -# switch( -# type, -# "average" = cbind(as.numeric(names(tapVec <- tapply(resp, -# dose, mean))), tapVec), -# "bars" = cbind(as.numeric(names(tapVec <- tapply(resp, -# dose, mean))), tapVec, tapply(predictMat[indVec, 1], dose[indVec], head, 1), -# tapply(predictMat[indVec, 2], dose[indVec], head, 1)), -# "none" = cbind(dose[indVec], resp[indVec]), -# "all" = cbind(dose[indVec], resp[indVec]), -# "obs" = cbind(dose[indVec], resp[indVec]) -# )) - - if ( (!add) && (i == 1) ) - { - ## Plotting data for the first curve id - plot(plotPoints, type = plotType, xlab = xlab, ylab = ylab, log = log, xlim = xLimits, ylim = yLimits, - axes = FALSE, frame.plot = TRUE, col = colourVec[i], pch = pchVec[i], cex = cexVec[i], ...) - - ## Adding error bars - barFct(plotPoints) - - ## Add confidence regions - ciFct(level=i, col=alpha(colourVec[i],0.25)) - - ## Adding axes - addAxes(axes, cex.axis, conName, xt, xtlab, xtsty, xttrim, logX, yt, ytlab, conLevel, logDose) - - ## Adding axis break - ivMid <- brokenAxis(bcontrol, broken, conLevel, dosePts, gridsize, log, logX, logDose) - - ## Plotting in the case "add = TRUE" and for all remaining curve ids - } else { - ## Adding axis break (in fact only restricting the dose range to be plotted) - ivMid <- brokenAxis(bcontrol, broken, conLevel, dosePts, gridsize, log, logX, logDose, plotit = FALSE) - - if (!identical(type, "none")) # equivalent of type = "n" in the above "plot" - { - pointFct(plotPoints, cexVec[i], colourVec[i], pchVec[i], ...) - - ## Adding error bars - barFct(plotPoints) - - ## Add confidence regions - ciFct(level=i, col=alpha(colourVec[i],0.25)) - } - } - } - - ## Plotting fitted curves - noPlot <- rep(FALSE, lenlev) - if (!identical(type, "obs")) - { - for (i in levelInd) - { - indVal <- uniAss %in% level[i] - if ( (!naPlot) && (any(is.na(plotMat[, indVal]))) ) - { - noPlot[i] <- TRUE - next - } - lines(dosePts[ivMid], plotMat[ivMid, indVal], lty = ltyVec[i], col = colourVec[i], ...) - } - } - - -# ## Plotting pointwise prediction intervals -# if (identical(type, "predict")) -# { -# for (i in levelInd) -# { -# indVal <- uniAss %in% level[i] -# if ( (!naPlot) && (any(is.na(plotMat[, indVal]))) ) -# { -# noPlot[i] <- TRUE -# next -# } -# lines(dosePts[ivMid], plotMat[ivMid, indVal], lty = ltyVec[i], col = colourVec[i], ...) -# } -# } - - - ## Adding legend - makeLegend(colourVec, legend, cex.legend, legendPos, legendText, lenlev, level, ltyVec, - noPlot, pchVec, type, xLimits, yLimits) - - ## Resetting graphical parameter - par(las = 0) - - retData <- data.frame(dosePts, as.data.frame(plotMat)) -# colnames(retData) <- c(colnames(origData)[1:doseDim], as.character(unique(assayNoOld))) - colnames(retData) <- c(doseName, dlNames[["cNames"]]) - - invisible(retData) -} - - -"getRange" <- function(x, y, xlim) -{ - logVec <- ((x >= xlim[1]) & (x <= xlim[2])) - return(range(y[logVec])) -} - -# if (FALSE) -# { -# "addAxes" <- function(axes, cex.axis, conLevel, conName, conNameYes, xt, xtlab, xsty, yt, ytlab) -# { -# if (!axes) {return(invisible(NULL))} # doing nothing -# -# ## Concerning the y axis -# yaxisTicks <- axTicks(2) -# yLabels <- TRUE -# if (!is.null(yt)) {yaxisTicks <- yt; yLabels <- yt} -# if (!is.null(ytlab)) {yLabels <- ytlab} -# -# ## Concerning the x axis -# xaxisTicks <- axTicks(1) -# -# -# -# -# if (conNameYes) -# { -# xaxisTicks[1] <- conName -# } -# xaxisTicksOrig <- xaxisTicks -# xLabels <- xaxisTicks -# -# if ((conNameYes) && (min(xt) < conLevel)) -# { -# xLimits[1] <- conLevel -# smallDoses <- dose 6) -# # { -# # halfLXT <- floor(lenXT/2) - 1 -# # chosenInd <- 1 + 2*(0:halfLXT) # ensuring that control always is present -# # xaxisTicks <- xaxisTicks[chosenInd] -# # xLabels <- xLabels[chosenInd] -# # } -# # -# if (identical(xsty, "base10")) -# { -# ceilingxTicks <- ceiling(log10(xaxisTicks[-1])) -# xaxisTicks <- c(xaxisTicks[1], 10^(unique(ceilingxTicks))) -# xLabels <- c(xLabels[1], unlist(tapply(xLabels[-1], ceilingxTicks, head, 1))) -# -# ## Reverting to original tick marks in case too few were created -# if (length(xaxisTicks) < 3) -# { -# xaxisTicks <- xaxisTicksOrig -# } -# } -# -# if (!is.null(xt)) -# { -# if (as.character(xt[1]) == as.character(eval(conName))) -# { -# xaxisTicks <- c(xaxisTicks[1], xt[-1]) -# xLabels <- c(conName, xt[-1]) -# } else { -# xaxisTicks <- xt -# xLabels <- xt -# conNameYes <- FALSE -# } -# } -# if (!is.null(xtlab)) {xLabels <- xtlab} -# # print(xaxisTicks) -# -# ## Updating x axis labels -# xLabels <- as.expression(xaxisTicks) -# if (conNameYes) {xLabels[1] <- conName} -# -# axis(1, at = xaxisTicks, labels = xLabels, cex.axis = cex.axis) -# axis(2, at = yaxisTicks, labels = yLabels, cex.axis = cex.axis) -# } -# } - - -"addAxes" <- function(axes, cex.axis, conName, xt, xtlab, xtsty, xttrim, logX, yt, ytlab, conLevel, logDose) -{ - if (!axes) {return(invisible(NULL))} # doing nothing - - ## Setting up the y axis tick mark locations and labels - yaxisTicks <- axTicks(2) - yLabels <- TRUE - if (!is.null(yt)) {yaxisTicks <- yt; yLabels <- yt} - if (!is.null(ytlab)) {yLabels <- ytlab} - - ## Setting up the x axis tick mark locations and labels - if (!is.null(xt)) - { - xaxisTicks <- xt - if (identical(as.numeric(xaxisTicks)[1], 0)) - { - xaxisTicks[1] <- conLevel - } - } else { - xaxisTicks <- axTicks(1) - - ## Styling the x axis tick marks - if (identical(xtsty, "base10")) - { - if (!is.null(logDose)) - { - ceilingxTicks <- ceiling(xaxisTicks[-1]) - xaxisTicksOrig <- xaxisTicks - xaxisTicks <- c(xaxisTicks[1], unique(ceilingxTicks)) - } else { - ceilingxTicks <- ceiling(log10(xaxisTicks[-1])) - xaxisTicksOrig <- xaxisTicks - xaxisTicks <- c(xaxisTicks[1], 10^(unique(ceilingxTicks))) -# xLabels <- c(xLabels[1], unlist(tapply(xLabels[-1], ceilingxTicks, head, 1))) - } - - ## Reverting to original tick marks in case too few were created - if (length(xaxisTicks) < 3) - { - xaxisTicks <- xaxisTicksOrig -# xLabels <- as.character(xaxisTicks) - } - } - } - - ## Assigning labels to the tick marks - if (!is.null(xtlab)) - { - xLabels <- xtlab - } else { - xLabels <- as.character(xaxisTicks) - } - - ## Avoiding too many tick marks - if (xttrim) - { - lenXT <- length(xaxisTicks) - if (lenXT > 6) - { - thinFactor <- max(c(2, floor(lenXT/6))) - halfLXT <- floor(lenXT / thinFactor) - 1 - chosenInd <- 1 + thinFactor*(0:halfLXT) - # "1" is ensuring that control always is present - xaxisTicks <- xaxisTicks[chosenInd] - xLabels <- xLabels[chosenInd] - } - } - - ## Assigning special name to first tick mark - if (logX && (is.null(xtlab)) && (!is.null(conName))) - { - xLabels[1] <- conName - } - - ## Updating labels - xLabels <- as.expression(xLabels) - - ## Updating x axis labels -# xLabels <- as.expression(xaxisTicks) -# if (conNameYes) {xLabels[1] <- conName} - - axis(1, at = xaxisTicks, labels = xLabels, cex.axis = cex.axis) - axis(2, at = yaxisTicks, labels = yLabels, cex.axis = cex.axis) -} - - - -## Creating a broken axis -"brokenAxis" <- function(bcontrol, broken, bp, dosePts, gridsize, log, logX, logDose, plotit = TRUE) -{ - notNullLD <- !is.null(logDose) - if ((broken) && (logX || (notNullLD))) - { - bList <- list(factor = 2, style = "slash", width = 0.02) - - if (!is.null(bcontrol)) - { - namesBC <- names(bcontrol) - for (j in 1:length(bcontrol)) - { - bList[[namesBC[j]]] <- bcontrol[[j]] - } - } - breakStyle <- bList$"style" # "slash" - breakWidth <- bList$"width" # 0.02 # default in axis.break - clFactor <- bList$"factor" # 2 - - if (notNullLD) - { - brokenx <- log(clFactor * (logDose^bp), logDose) - } else { - brokenx <- clFactor * bp - } -# brokenx <- clFactor * bp - if ( (log == "x") || (log == "xy") || (log == "yx") ) - { - ivMid <- dosePts > brokenx - } else { - ivMid <- rep(TRUE, gridsize) - } - if (plotit) - { -# require(plotrix, quietly = TRUE) - axis.break(1, brokenx, style = breakStyle, brw = breakWidth) - } - - } else { - ivMid <- rep(TRUE, gridsize) - } - return(ivMid) -} - - -## Adding legend and legend text -"makeLegend" <- function(colourVec, legend, legendCex, legendPos, legendText, lenlev, level, ltyVec, noPlot, pchVec, type, -xLimits, yLimits) -{ - if (!legend) {return(invisible(NULL))} - - legendLevels <- as.character(level) - if (!missing(legendText)) - { - lenLT <- length(legendText) - - if (lenLT == lenlev) {legendLevels <- legendText} - - if (lenLT == 1) {legendLevels <- rep(legendText, lenlev)} - } - levInd <- 1:lenlev - - ## Removing line types when lines are not drawn - ltyVec[noPlot] <- 0 - if (identical(type, "obs")) - { - ltyVec[levInd] <- 0 - } - - ## Removing plot symbol when no points are drawn - if ( (identical(type, "none")) || (identical(type, "bars")) ) - { - pchVec[levInd] <- NA - } - - ## Defining position of legend - if (!missing(legendPos)) - { - if ( (is.numeric(legendPos)) && (length(legendPos) == 2) ) - xlPos <- legendPos[1] - ylPos <- legendPos[2] - } else { - xlPos <- xLimits[2] - ylPos <- yLimits[2] - } - - ## Adding legend - legend(xlPos, ylPos, legendLevels, lty = ltyVec[levInd], pch = pchVec[levInd], - col = colourVec[levInd], bty = "n", xjust = 1, yjust = 1, cex = legendCex) -} - -"parFct" <- function(gpar, lenlev, defVal = NULL) -{ - if (!missing(gpar)) - { - if (length(gpar) == 1) - { - return(rep(gpar, lenlev)) - } else { - return(gpar) - } - } else { - if (is.null(defVal)) {return(1:lenlev)} else {rep(defVal, lenlev)} - } -} - - -getLU <- function(object) -{ - parmMat <- object$"parmMat" -# rownames(parmMat) <- object$"parNames"[[2]] - fixedVal <- object$fct$fixed - lenFV <- length(fixedVal) -# parmMatExt <- matrix(NA, length(fixedVal), ncol(parmMat)) - parmMatExt <- matrix(fixedVal, length(fixedVal), ncol(parmMat)) - parmMatExt[is.na(fixedVal), ] <- parmMat - - colnames(parmMatExt) <- colnames(parmMat) - parmMatExt -} - - -normalizeLU <- function(x, y, normRef = 1) -{ - cVal <- y[2] - dVal <- y[3] - normRef * ((x - cVal) / (dVal - cVal)) -} - -#mapply(normalizeLU, as.list(as.data.frame(matrix(1:20, 10, 2))), as.list(as.data.frame(getLU(S.alba.m1)))) - +#' @title Plotting fitted dose-response curves +#' +#' @description +#' \code{plot} displays fitted curves and observations in the same plot window, +#' distinguishing between curves by different plot symbols and line types. +#' +#' @param x an object of class 'drc'. +#' @param ... additional graphical arguments. For instance, use \code{lwd=2} or +#' \code{lwd=3} to increase the width of plot symbols. +#' @param add logical. If TRUE then add to already existing plot. +#' @param level vector of character strings. To plot only the curves specified +#' by their names. +#' @param type a character string specifying how to plot the data. Options are: +#' \code{"average"} (averages and fitted curve(s); default), \code{"none"} +#' (only the fitted curve(s)), \code{"obs"} (only the data points), +#' \code{"all"} (all data points and fitted curve(s)), \code{"bars"} +#' (averages and fitted curve(s) with model-based standard errors), and +#' \code{"confidence"} (confidence bands for fitted curve(s)). +#' @param broken logical. If TRUE the x axis is broken provided this axis is +#' logarithmic (using functionality in the CRAN package 'plotrix'). +#' @param bp numeric value specifying the break point below which the dose is +#' zero. The default is the base-10 value corresponding to the rounded value +#' of the minimum of the log10 values of all positive dose values. Only works +#' for logarithmic dose axes. +#' @param bcontrol a list with components \code{factor}, \code{style} and +#' \code{width} controlling the appearance of the break (when \code{broken} +#' is \code{TRUE}). +#' @param conName character string. Name on x axis for dose zero. Default is +#' \code{"0"}. +#' @param axes logical indicating whether both axes should be drawn on the plot. +#' @param gridsize numeric. Number of points in the grid used for plotting the +#' fitted curves. +#' @param log a character string which contains \code{"x"} if the x axis is to +#' be logarithmic, \code{"y"} if the y axis is to be logarithmic and +#' \code{"xy"} or \code{"yx"} if both axes are to be logarithmic. The default +#' is \code{"x"}. The empty string \code{""} yields the original axes. +#' @param xtsty a character string specifying the dose axis style for +#' arrangement of tick marks. By default for a logarithmic axis only base 10 +#' tick marks are shown (\code{"base10"}). Otherwise sensible equidistantly +#' located tick marks are shown (\code{"standard"}). +#' @param xttrim logical specifying if the number of tick marks should be +#' trimmed in case too many tick marks are initially determined. +#' @param xt a numeric vector containing the positions of the tick marks on the +#' x axis. +#' @param xtlab a vector containing the tick marks on the x axis. +#' @param xlab an optional label for the x axis. +#' @param xlim a numeric vector of length two, containing the lower and upper +#' limit for the x axis. +#' @param yt a numeric vector containing the positions of the tick marks on the +#' y axis. +#' @param ytlab a vector containing the tick marks on the y axis. +#' @param ylab an optional label for the y axis. +#' @param ylim a numeric vector of length two, containing the lower and upper +#' limit for the y axis. +#' @param cex numeric or numeric vector specifying the size of plotting symbols +#' and text (see \code{\link{par}} for details). +#' @param cex.axis numeric value specifying the magnification to be used for +#' axis annotation relative to the current setting of cex. +#' @param col either logical or a vector of colours. If TRUE default colours are +#' used. If FALSE (default) no colours are used. +#' @param errbar.col colour(s) for error bars when using \code{type = "bars"}. +#' If \code{NULL} (default), error bars will match the curve colours specified +#' by \code{col}. Use \code{errbar.col = "black"} to restore the previous +#' behaviour of black error bars. +#' @param errbar.lwd line width(s) for error bars when using \code{type = "bars"}. +#' If \code{NULL} (default), error bars will inherit the line width specified +#' by \code{lwd} (via \code{...}). If \code{lwd} is also not specified, the +#' default graphical parameter \code{par("lwd")} is used. +#' @param lty a numeric vector specifying the line types. +#' @param pch a vector of plotting characters or symbols (see +#' \code{\link{points}}). +#' @param legend logical. If TRUE a legend is displayed. +#' @param legendText a character string or vector of character strings +#' specifying the legend text. +#' @param legendPos numeric vector of length 2 giving the position of the +#' legend. +#' @param cex.legend numeric specifying the legend text size. +#' @param normal logical. If TRUE the plot of the normalized data and fitted +#' curves are shown (see Weimer et al. (2012) for details). +#' @param normRef numeric specifying the reference for the normalization +#' (default is 1). +#' @param confidence.level confidence level for error bars. Defaults to 0.95. +#' +#' @return An invisible data frame with the values used for plotting the fitted +#' curves. The first column contains the dose values, and the following +#' columns (one for each curve) contain the fitted response values. +#' +#' @details +#' The use of \code{xlim} allows changing the range of the x axis, +#' extrapolating the fitted dose-response curves. Note that changing the range +#' on the x axis may also entail a change of the range on the y axis. Sometimes +#' it may be useful to extend the upper limit on the y axis (using \code{ylim}) +#' in order to fit a legend into the plot. +#' +#' See \code{\link{colors}} for the available colours. Suitable labels are +#' automatically provided. +#' +#' The arguments \code{broken} and \code{bcontrol} rely on the function +#' \code{axis.break} with arguments \code{style} and \code{brw} in the package +#' \pkg{plotrix}. +#' +#' The model-based standard errors used for the error bars are calculated as the +#' fitted value plus/minus the estimated error times the 1-(alpha/2) quantile in +#' the t distribution with degrees of freedom equal to the residual degrees of +#' freedom for the model (or using a standard normal distribution in case of +#' binomial and Poisson data), where alpha = 1 - confidence.level. The standard +#' errors are obtained using the predict method with the arguments +#' \code{interval = "confidence"} and \code{level = confidence.level}. +#' +#' @seealso \code{\link{colors}} +#' +#' @examples +#' ## Fitting models to be plotted below +#' ryegrass.m1 <- drm(rootl~conc, data = ryegrass, fct = LL.4()) +#' ryegrass.m2 <- drm(rootl~conc, data = ryegrass, fct = LL.3()) +#' +#' ## Plotting observations and fitted curve for the first model +#' plot(ryegrass.m1, broken = TRUE) +#' +#' ## Adding fitted curve for the second model +#' plot(ryegrass.m2, broken = TRUE, add = TRUE, type = "none", col = 2, lty = 2) +#' +#' ## Add confidence region for the first model +#' plot(ryegrass.m1, broken = TRUE, type="confidence", add=TRUE) +#' +#' ## Fitting model with multiple curves +#' spinach.m1 <- drm(SLOPE~DOSE, CURVE, data = spinach, fct = LL.4()) +#' +#' ## Plot with default colours +#' plot(spinach.m1, col = TRUE, main = "Default colours") +#' +#' @author Christian Ritz and Jens C. Streibig. Contributions from Xiaoyan Wang +#' and Greg Warnes. +#' +#' @keywords aplot +"plot.drc" <- +function(x, ..., add = FALSE, level = NULL, type = c("average", "all", "bars", "none", "obs", "confidence"), +broken = FALSE, bp, bcontrol = NULL, conName = NULL, axes = TRUE, gridsize = 100, +log = "x", xtsty, xttrim = TRUE, xt = NULL, xtlab = NULL, xlab, xlim, +yt = NULL, ytlab = NULL, ylab, ylim, +cex, cex.axis = 1, col = FALSE, errbar.col = NULL, errbar.lwd = NULL, lty, pch, +legend, legendText, legendPos, cex.legend = 1, +normal = FALSE, normRef = 1, confidence.level = 0.95) +{ + object <- x + type <- match.arg(type) + + ## Determining logarithmic scales + if ((log == "") || (log == "y")) + { + logX <- FALSE + } else { + logX <- TRUE + } + + ## Determining the tick mark style for the dose axis + if (missing(xtsty)) + { + if (logX) + { + xtsty <- "base10" + } else { + xtsty <- "standard" + } + } + + ## Constructing the plot data + dataList <- object[["dataList"]] + dose <- dataList[["dose"]] + resp <- dataList[["origResp"]] + curveid <- dataList[["curveid"]] + plotid <- dataList[["plotid"]] + + ## Modifying "response" in case of SSD + if (identical(object[["type"]], "ssd")) + { + dose <- unlist(with(dataList, tapply(dose, curveid, function(x){sort(x)}))[unique(dataList[["curveid"]])]) + resp <- unlist(with(dataList, tapply(dose, curveid, function(x){ppoints(x, 0.5)}))[unique(dataList[["curveid"]])]) + } + + ## Normalizing the response values + if (normal) + { + names(resp) <- seq(length(resp)) + respList <- split(resp, curveid) + + respNorm <- mapply(normalizeLU, respList, + as.list(as.data.frame(getLU(object)))[names(respList)], + normRef = normRef, SIMPLIFY = F) + + resp <- do.call(c, unname(respNorm))[as.character(seq(length(resp)))] + } + + if (!is.null(plotid)) + { # used for event-time data + + assayNoOld <- as.vector(plotid) + } else { + assayNoOld <- as.vector(curveid) + } + uniAss <- unique(assayNoOld) + numAss <- length(uniAss) + + doPlot <- is.null(level) || any(uniAss %in% level) + if (!doPlot) {stop("Nothing to plot")} + + plotFct <- (object$"curve")[[1]] + logDose <- (object$"curve")[[2]] + naPlot <- ifelse(is.null(object$"curve"$"naPlot"), FALSE, TRUE) + + ## Assigning axis names + dlNames <- dataList[["names"]] + doseName <- dlNames[["dName"]] + respName <- dlNames[["orName"]] + # axis names are the names of the dose variable and response variable in the original data set + if (missing(xlab)) {if (doseName == "") {xlab <- "Dose"} else {xlab <- doseName}} + if (missing(ylab)) {if (respName == "") {ylab <- "Response"} else {ylab <- respName}} + + ## Determining range of dose values + if (missing(xlim)) + { + xLimits <- c(min(dose), max(dose)) + } else { + xLimits <- xlim # if (abs(xLimits[1]) 0]))) - 1 + conLevel <- 10^(log10cl) + } + } else { + conLevel <- bp + } + if ((xLimits[1] < conLevel) && (logX || (!is.null(logDose)))) + { + xLimits[1] <- conLevel + smallDoses <- (dose < conLevel) + dose[smallDoses] <- conLevel + if (is.null(conName)) + { + if (is.null(logDose)) {conName <- expression(0)} else {conName <- expression(-infinity)} + } + } else { + conName <- NULL + } + if (xLimits[1] >= xLimits[2]) {stop("Argument 'conLevel' is set too high")} + + ## Constructing dose values for plotting + if ((is.null(logDose)) && (logX)) + { + dosePts <- exp(seq(log(xLimits[1]), log(xLimits[2]), length = gridsize)) + ## Avoiding that slight imprecision produces dose values outside the dose range + ## (the model-robust predict method is sensitive to such deviations!) + dosePts[1] <- xLimits[1] + dosePts[gridsize] <- xLimits[2] + } else { + dosePts <- seq(xLimits[1], xLimits[2], length = gridsize) + } + + ## Finding minimum and maximum on response scale + if (is.null(logDose)) + { + plotMat <- plotFct(dosePts) + } else { + plotMat <- plotFct(logDose^(dosePts)) + } + ## Normalizing the fitted values + if (normal) + { + respList <- split(resp, curveid) + plotMat <- mapply(normalizeLU, as.list(as.data.frame(plotMat)), + as.list(as.data.frame(getLU(object))), + normRef = normRef) + } + + maxR <- max(resp) + maxPM <- suppressWarnings(apply(plotMat, 2, max, na.rm = TRUE)) + if (max(maxPM) > maxR) {maxPM <- maxPM[which.max(maxPM)]} else {maxPM <- maxR} + + if (missing(ylim)) + { + if (missing(xlim)) + { + yLimits <- c(min(resp), maxPM) + } else { + yLimits <- getRange(dose, resp, xLimits) + } + } else { + yLimits <- ylim + } + + ## Cutting away y values (determined by the fitted model) outside the limits + + ## Setting a few graphical parameters + par(las = 1) + if (!is.null(logDose)) + { + if (log == "x") {log <- ""} + if ( (log == "xy") || (log == "yx") ) {log <- "y"} + } + + ## Cutting away original x values outside the limits + eps1 <- 1e-8 + logVec <- !( (dose < xLimits[1] - eps1) | (dose > xLimits[2] + eps1) ) + dose <- dose[logVec] + resp <- resp[logVec] + assayNoOld <- assayNoOld[logVec] + + ## Calculating predicted values for error bars + if (identical(type, "bars")) + { + predictMat <- predict(object, interval = "confidence", + level = confidence.level)[, c("Lower", "Upper")] + + if(normal) { + names(predictMat) <- seq(length(predictMat)) + predictList <- split(predictMat, curveid) + predictMatListNorm <- mapply(normalizeLU, predictList, + as.list(as.data.frame(getLU(object))), + normRef = normRef, + SIMPLIFY = F) + predictMatNorm <- do.call(c, unname(predictMatListNorm))[as.character(seq(length(predictMat)))] + predictMat<- matrix(predictMatNorm, ncol = 2) + } + + barFct <- function(plotPoints, col = "black", lwd = 1) + { + pp3 <- plotPoints[, 3] + pp4 <- plotPoints[, 4] + plotCI(plotPoints[, 1], pp3 + 0.5 * (pp4 - pp3), + li = pp3, ui = pp4, add = TRUE, pch = NA, col = col, lwd = lwd) + } + + ciFct <- function(level, ...){invisible(NULL)} + + pointFct <- function(plotPoints, cexVal, colVal, pchVal, ...){invisible(NULL)} + + } else if (identical(type, "confidence")) + { + + barFct <- function(plotPoints, col = "black", lwd = 1){invisible(NULL)} + + ciFct <- function(level, ...) + { + newdata <- data.frame(DOSE=dosePts, CURVE=rep(level, length(dosePts))) + predictMat <- predict(object, + newdata=newdata, + interval = "confidence", + level=confidence.level) + + x <- c(dosePts, rev(dosePts)) + y <- c(predictMat[,"Lower"], rev(predictMat[,"Upper"])) + polygon(x,y, border=NA, ...) + } + + pointFct <- function(plotPoints, cexVal, colVal, pchVal, ...){invisible(NULL)} + + } else { + + barFct <- function(plotPoints, col = "black", lwd = 1){invisible(NULL)} + + ciFct <- function(level, ...){invisible(NULL)} + + pointFct <- function(plotPoints, cexVal, colVal, pchVal, ...) + { + points(plotPoints, cex = cexVal, col = colVal, pch = pchVal, ...) + } + } + + ## Setting the plot type + if ( (identical(type, "none")) || (identical(type, "bars")) ) + { + plotType <- "n" + } else { + plotType <- "p" + } + + ## Determining levels to be plotted + if (is.null(level)) + { + level <- uniAss + } else { + level <- intersect(level, uniAss) + } + lenlev <- length(level) + + ## Determining presence of legend + if (missing(legend)) + { + if (lenlev == 1) {legend <- FALSE} else {legend <- TRUE} + } + + ## Setting graphical parameters + colourVec <- rep(1, lenlev) + if (is.logical(col) && col) + { + colourVec <- 1:lenlev + } + if (!is.logical(col) && (length(col) == lenlev) ) + { + colourVec <- col + } + if (!is.logical(col) && (!(length(col) == lenlev)) ) + { + colourVec <- rep(col, lenlev) + } + if (is.null(errbar.col)) { + errbarColVec <- colourVec + } else { + errbarColVec <- rep(errbar.col, length.out = lenlev) + } + ## Resolve error bar line width + dots <- list(...) + resolved_errbar_lwd <- if (!is.null(errbar.lwd)) { + errbar.lwd + } else if (!is.null(dots$lwd)) { + dots$lwd + } else { + par("lwd") + } + + cexVec <- parFct(cex, lenlev, 1) + ltyVec <- parFct(lty, lenlev) + pchVec <- parFct(pch, lenlev) + + ## Plotting data + levelInd <- 1:lenlev + for (i in levelInd) + { + indVec <- level[i] == assayNoOld + plotPoints <- + switch( + type, + + "average" = cbind(as.numeric(names(tapVec <- tapply(resp[indVec], + dose[indVec], mean))), tapVec), + + "bars" = cbind( + as.numeric(names(tapVec <- tapply(resp[indVec], dose[indVec], mean))), + tapVec, + tapply(predictMat[indVec, 1], dose[indVec], head, 1), + tapply(predictMat[indVec, 2], dose[indVec], head, 1)), + + "none" = cbind(dose[indVec], resp[indVec]), + "all" = cbind(dose[indVec], resp[indVec]), + "obs" = cbind(dose[indVec], resp[indVec]) + ) + + if ( (!add) && (i == 1) ) + { + ## Plotting data for the first curve id + plot(plotPoints, type = plotType, xlab = xlab, ylab = ylab, log = log, xlim = xLimits, ylim = yLimits, + axes = FALSE, frame.plot = TRUE, col = colourVec[i], pch = pchVec[i], cex = cexVec[i], ...) + + ## Adding error bars + barFct(plotPoints, col = errbarColVec[i], lwd = resolved_errbar_lwd) + + ## Add confidence regions + ciFct(level=i, col=alpha(colourVec[i],0.25)) + + ## Adding axes + addAxes(axes, cex.axis, conName, xt, xtlab, xtsty, xttrim, logX, yt, ytlab, conLevel, logDose) + + ## Adding axis break + ivMid <- brokenAxis(bcontrol, broken, conLevel, dosePts, gridsize, log, logX, logDose) + + ## Plotting in the case "add = TRUE" and for all remaining curve ids + } else { + ## Adding axis break (in fact only restricting the dose range to be plotted) + ivMid <- brokenAxis(bcontrol, broken, conLevel, dosePts, gridsize, log, logX, logDose, plotit = FALSE) + + if (!identical(type, "none")) # equivalent of type = "n" in the above "plot" + { + pointFct(plotPoints, cexVec[i], colourVec[i], pchVec[i], ...) + + ## Adding error bars + barFct(plotPoints, col = errbarColVec[i], lwd = resolved_errbar_lwd) + + ## Add confidence regions + ciFct(level=i, col=alpha(colourVec[i],0.25)) + } + } + } + + ## Plotting fitted curves + noPlot <- rep(FALSE, lenlev) + if (!identical(type, "obs")) + { + for (i in levelInd) + { + indVal <- uniAss %in% level[i] + if ( (!naPlot) && (any(is.na(plotMat[, indVal]))) ) + { + noPlot[i] <- TRUE + next + } + lines(dosePts[ivMid], plotMat[ivMid, indVal], lty = ltyVec[i], col = colourVec[i], ...) + } + } + + ## Adding legend + makeLegend(colourVec, legend, cex.legend, legendPos, legendText, lenlev, level, ltyVec, + noPlot, pchVec, type, xLimits, yLimits) + + ## Resetting graphical parameter + par(las = 0) + + retData <- data.frame(dosePts, as.data.frame(plotMat)) + colnames(retData) <- c(doseName, dlNames[["cNames"]]) + + invisible(retData) +} + +"getRange" <- function(x, y, xlim) +{ + logVec <- ((x >= xlim[1]) & (x <= xlim[2])) + return(range(y[logVec])) +} + +"addAxes" <- function(axes, cex.axis, conName, xt, xtlab, xtsty, xttrim, logX, yt, ytlab, conLevel, logDose) +{ + if (!axes) {return(invisible(NULL))} # doing nothing + + ## Setting up the y axis tick mark locations and labels + yaxisTicks <- axTicks(2) + yLabels <- TRUE + if (!is.null(yt)) {yaxisTicks <- yt; yLabels <- yt} + if (!is.null(ytlab)) {yLabels <- ytlab} + + ## Setting up the x axis tick mark locations and labels + if (!is.null(xt)) + { + xaxisTicks <- xt + if (identical(as.numeric(xaxisTicks)[1], 0)) + { + xaxisTicks[1] <- conLevel + } + } else { + xaxisTicks <- axTicks(1) + + ## Styling the x axis tick marks + if (identical(xtsty, "base10")) + { + if (!is.null(logDose)) + { + ceilingxTicks <- ceiling(xaxisTicks[-1]) + xaxisTicksOrig <- xaxisTicks + xaxisTicks <- c(xaxisTicks[1], unique(ceilingxTicks)) + } else { + ceilingxTicks <- ceiling(log10(xaxisTicks[-1])) + xaxisTicksOrig <- xaxisTicks + xaxisTicks <- c(xaxisTicks[1], 10^(unique(ceilingxTicks))) + } + + ## Reverting to original tick marks in case too few were created + if (length(xaxisTicks) < 3) + { + xaxisTicks <- xaxisTicksOrig + } + } + } + + ## Assigning labels to the tick marks + if (!is.null(xtlab)) + { + xLabels <- xtlab + } else { + xLabels <- as.character(xaxisTicks) + } + + ## Avoiding too many tick marks + if (xttrim) + { + lenXT <- length(xaxisTicks) + if (lenXT > 6) + { + thinFactor <- max(c(2, floor(lenXT/6))) + halfLXT <- floor(lenXT / thinFactor) - 1 + chosenInd <- 1 + thinFactor*(0:halfLXT) + # "1" is ensuring that control always is present + xaxisTicks <- xaxisTicks[chosenInd] + xLabels <- xLabels[chosenInd] + } + } + + ## Assigning special name to first tick mark + if (logX && (is.null(xtlab)) && (!is.null(conName))) + { + xLabels[1] <- conName + } + + ## Updating labels + xLabels <- as.expression(xLabels) + + ## Updating x axis labels + + axis(1, at = xaxisTicks, labels = xLabels, cex.axis = cex.axis) + axis(2, at = yaxisTicks, labels = yLabels, cex.axis = cex.axis) +} + +## Creating a broken axis +"brokenAxis" <- function(bcontrol, broken, bp, dosePts, gridsize, log, logX, logDose, plotit = TRUE) +{ + notNullLD <- !is.null(logDose) + if ((broken) && (logX || (notNullLD))) + { + bList <- list(factor = 2, style = "slash", width = 0.02) + + if (!is.null(bcontrol)) + { + namesBC <- names(bcontrol) + for (j in 1:length(bcontrol)) + { + bList[[namesBC[j]]] <- bcontrol[[j]] + } + } + breakStyle <- bList$"style" # "slash" + breakWidth <- bList$"width" # 0.02 # default in axis.break + clFactor <- bList$"factor" # 2 + + if (notNullLD) + { + brokenx <- log(clFactor * (logDose^bp), logDose) + } else { + brokenx <- clFactor * bp + } + if ( (log == "x") || (log == "xy") || (log == "yx") ) + { + ivMid <- dosePts > brokenx + } else { + ivMid <- rep(TRUE, gridsize) + } + if (plotit) + { + axis.break(1, brokenx, style = breakStyle, brw = breakWidth) + } + + } else { + ivMid <- rep(TRUE, gridsize) + } + return(ivMid) +} + +## Adding legend and legend text +"makeLegend" <- function(colourVec, legend, legendCex, legendPos, legendText, lenlev, level, ltyVec, noPlot, pchVec, type, +xLimits, yLimits) +{ + if (!legend) {return(invisible(NULL))} + + legendLevels <- as.character(level) + if (!missing(legendText)) + { + lenLT <- length(legendText) + + if (lenLT == lenlev) {legendLevels <- legendText} + + if (lenLT == 1) {legendLevels <- rep(legendText, lenlev)} + } + levInd <- 1:lenlev + + ## Removing line types when lines are not drawn + ltyVec[noPlot] <- 0 + if (identical(type, "obs")) + { + ltyVec[levInd] <- 0 + } + + ## Removing plot symbol when no points are drawn + if ( (identical(type, "none")) || (identical(type, "bars")) ) + { + pchVec[levInd] <- NA + } + + ## Defining position of legend + if (!missing(legendPos)) + { + if ( (is.numeric(legendPos)) && (length(legendPos) == 2) ) + xlPos <- legendPos[1] + ylPos <- legendPos[2] + } else { + xlPos <- xLimits[2] + ylPos <- yLimits[2] + } + + ## Adding legend + legend(xlPos, ylPos, legendLevels, lty = ltyVec[levInd], pch = pchVec[levInd], + col = colourVec[levInd], bty = "n", xjust = 1, yjust = 1, cex = legendCex) +} + +"parFct" <- function(gpar, lenlev, defVal = NULL) +{ + if (!missing(gpar)) + { + if (length(gpar) == 1) + { + return(rep(gpar, lenlev)) + } else { + return(gpar) + } + } else { + if (is.null(defVal)) {return(1:lenlev)} else {rep(defVal, lenlev)} + } +} + +getLU <- function(object) +{ + parmMat <- object$"parmMat" +# rownames(parmMat) <- object$"parNames"[[2]] + fixedVal <- object$fct$fixed + lenFV <- length(fixedVal) +# parmMatExt <- matrix(NA, length(fixedVal), ncol(parmMat)) + parmMatExt <- matrix(fixedVal, length(fixedVal), ncol(parmMat)) + parmMatExt[is.na(fixedVal), ] <- parmMat + + colnames(parmMatExt) <- colnames(parmMat) + parmMatExt +} + +normalizeLU <- function(x, y, normRef = 1) +{ + cVal <- y[2] + dVal <- y[3] + normRef * ((x - cVal) / (dVal - cVal)) +} + +#mapply(normalizeLU, as.list(as.data.frame(matrix(1:20, 10, 2))), as.list(as.data.frame(getLU(S.alba.m1)))) + diff --git a/R/pr.R b/R/pr.R new file mode 100644 index 00000000..7e246f1f --- /dev/null +++ b/R/pr.R @@ -0,0 +1,44 @@ +#' Expected or predicted response +#' +#' Returns the expected or predicted response for specified dose values. This is a +#' convenience function for easy access to predicted values. +#' +#' @param object object of class \code{drc} obtained from fitting a dose-response model. +#' @param xVec numeric vector of dose values. +#' @param ... additional arguments passed to \code{\link[drc]{predict.drc}}. +#' +#' @return A numeric vector of predicted values or possibly a matrix of predicted values +#' and corresponding standard errors. +#' +#' @author Christian Ritz after a suggestion from Andrew Kniss. +#' +#' @seealso \code{\link[drc]{predict.drc}} +#' +#' @examples +#' ryegrass.m1 <- drm(ryegrass, fct = LL.4()) +#' PR(ryegrass.m1, c(5, 10)) +#' +#' @keywords models nonlinear +"PR" <- function(object, xVec, ...) +{ + lenXV <- length(xVec) + + curveId <- as.character(unique(object$data[, 3])) + lenCI <- length(curveId) + + if (lenCI > 1) + { + retMat <- predict(object, data.frame(xVec, rep(curveId, rep(lenXV, lenCI))), se.fit = TRUE, ...) + rownames(retMat) <- paste(rep(curveId, rep(lenXV, lenCI)), rep(as.character(xVec), lenCI), sep = ":") + } else { + retMat <- predict(object, data.frame(xVec), ...) + if (is.matrix(retMat)) + { + rownames(retMat) <- rep(as.character(xVec), lenCI) + } else { + names(retMat) <- rep(as.character(xVec), lenCI) + } + } + + return(retMat) +} diff --git a/R/pr.r b/R/pr.r deleted file mode 100644 index b5e32d3a..00000000 --- a/R/pr.r +++ /dev/null @@ -1,23 +0,0 @@ -"PR" <- function(object, xVec, ...) -{ - lenXV <- length(xVec) - - curveId <- as.character(unique(object$data[, 3])) - lenCI <- length(curveId) - - if (lenCI > 1) - { - retMat <- predict(object, data.frame(xVec, rep(curveId, rep(lenXV, lenCI))), se.fit = TRUE, ...) - rownames(retMat) <- paste(rep(curveId, rep(lenXV, lenCI)), rep(as.character(xVec), lenCI), sep = ":") - } else { - retMat <- predict(object, data.frame(xVec)) - if (is.matrix(retMat)) - { - rownames(retMat) <- rep(as.character(xVec), lenCI) - } else { - names(retMat) <- rep(as.character(xVec), lenCI) - } - } - - return(retMat) -} diff --git a/R/predict.drc.R b/R/predict.drc.R index d9de7778..31e00382 100644 --- a/R/predict.drc.R +++ b/R/predict.drc.R @@ -1,3 +1,56 @@ +#' @title Prediction +#' +#' @description +#' Predicted values for models of class 'drc'. +#' +#' @param object an object of class 'drc'. +#' @param newdata an optional data frame in which to look for variables with +#' which to predict. If omitted, the fitted values are used. +#' @param se.fit logical. If TRUE standard errors are required. +#' @param interval character string. Type of interval calculation: +#' \code{"none"}, \code{"confidence"}, \code{"prediction"}, or \code{"ssd"}. +#' @param level tolerance/confidence level. +#' @param na.action function determining what should be done with missing values +#' in \code{newdata}. The default is to predict \code{NA}. +#' @param od logical. If TRUE adjustment for over-dispersion is used. +#' @param vcov. function providing the variance-covariance matrix. +#' \code{\link{vcov}} is the default, but \code{sandwich} is also an option +#' (for obtaining robust standard errors). +#' @param ssdSEfct specifies the function for interpolating standard errors +#' between observed standard errors. The default is linear interpolation on +#' log-log scale (back-transformed). +#' @param constrain logical. If TRUE (default) predicted values are truncated +#' within meaningful limits, i.e., 0 and, possibly, 1. +#' @param checkND logical indicating whether or not names in \code{newdata} +#' data frame match the names in the original data frame used for fitting +#' the model. Default is TRUE. +#' @param ... further arguments passed to or from other methods. +#' +#' @return A matrix with as many rows as there are dose values provided in +#' \code{newdata} or in the original dataset (in case \code{newdata} is not +#' specified) and, at most, 4 columns containing fitted values, standard +#' errors, lower and upper limits of confidence/prediction intervals. +#' +#' @seealso For details see the help page for \code{\link{predict.lm}}. +#' +#' @examples +#' ## Fitting a model +#' spinach.model1 <- drm(SLOPE~DOSE, CURVE, data = spinach, fct = LL.4()) +#' +#' ## Predicting values at dose=2 (with standard errors) +#' predict(spinach.model1, data.frame(dose=2, CURVE=c("1", "2", "3")), se.fit = TRUE) +#' +#' ## Getting confidence intervals +#' predict(spinach.model1, data.frame(dose=2, CURVE=c("1", "2", "3")), +#' interval = "confidence") +#' +#' ## Getting prediction intervals +#' predict(spinach.model1, data.frame(dose=2, CURVE=c("1", "2", "3")), +#' interval = "prediction") +#' +#' @author Christian Ritz +#' +#' @keywords models nonlinear "predict.drc" <- function(object, newdata, se.fit = FALSE, interval = c("none", "confidence", "prediction", "ssd"), level = 0.95, na.action = na.pass, od = FALSE, vcov. = vcov, @@ -14,10 +67,6 @@ ## Assigning dataset from object if no data frame is provided if (missing(newdata)) { -# predValues <- fitted(object) # not used -# newdata <- data.frame(object$data[, 1], object$data[, 3]) -# dataList <- object[["dataList"]] - ## New part (25/6-2014) doseVec <- dataList[["dose"]] if (identical(respType, "event")) @@ -26,13 +75,6 @@ } else { groupLevels <- as.character(dataList[["curveid"]]) } -# -# if (identical(respType, "event")) -# { -# newdata <- data.frame(dataList[["dose"]], dataList[["plotid"]]) -# } else { -# newdata <- data.frame(dataList[["dose"]], dataList[["curveid"]]) -# } } else { if (checkND) @@ -43,7 +85,6 @@ doseVec <- newdata[, dName] } else { doseVec <- newdata[, 1] -# warning("Dose variable not in 'newdata'") } } else { doseVec <- newdata @@ -56,28 +97,12 @@ # as.character() removes factor encoding } else { - groupLevels <- rep(1, nrow(newdata)) + nRows <- if (is.data.frame(newdata) || is.matrix(newdata)) nrow(newdata) else length(newdata) + groupLevels <- rep(1, nRows) } -# -# -# if (ncol(newdata) < (doseDim + 1)) {newdata <- data.frame(newdata, rep(1, nrow(newdata)))} -# # ndncol <- ncol(newdata) -# # doseVec <- newdata[, 1:(ndncol-1)] -# doseVec <- newdata[, 1:doseDim] -# # groupLevels <- as.character(newdata[, ndncol]) # 'as.character()' used to suppress factor levels -# groupLevels <- as.character(newdata[, doseDim + 1]) # 'as.character()' used to suppress factor levels } noNewData <- length(groupLevels) -# if (ncol(newdata) < 2) {newdata <- data.frame(newdata, rep(1, nrow(newdata)))} -# if (ncol(newdata) > 2) {stop("More than 2 variables in 'newdata' argument")} - - ## Defining dose values -- dose in the first column! -# doseVec <- newdata[, 1] -# groupLevels <- as.character(newdata[, 2]) # 'as.character()' used to suppress factor levels -# noNewData <- length(doseVec) - - ## Transforming to dose scale if necessary powerExp <- (object$"curve")[[2]] if (!is.null(powerExp)) @@ -88,62 +113,27 @@ ## Retrieving matrix of parameter estimates parmMat <- object[["parmMat"]] pm <- t(parmMat[, groupLevels, drop = FALSE]) - -# parmNames <- colnames(parmMat) -# lenCN <- length(parmNames) -# indVec <- 1:lenCN -# names(indVec) <- parmNames -# if (lenCN > 1) -# { -# indVec <- indVec[as.character(newdata[, 2])] -# -## groupLevels <- newdata[, 2] -# if (!all(is.numeric(groupLevels))) -# { -## pm <- parmMat[, as.character(groupLevels)] # 'as.character()' used to suppress factor levels -# pm <- parmMat[, groupLevels] -# } else { -# pm <- parmMat[, groupLevels] -# } -# pm <- parmMat[, groupLevels] -# -# } else { -# lenDV <- length(doseVec) -## indVec <- rep(1, lenDV) -# pm <- matrix(parmMat[, 1], length(parmMat[, 1]), lenDV) -# } - -# ## Checking for NAs in matrix of parameter estimates -# naVec <- rep(FALSE, lenCN) -# for (i in 1:lenCN) -# { -# naVec[i] <- any(is.na(parmMat[, i])) -# } -# parmMat <- parmMat[, !naVec, drop = FALSE] - ## Retrieving variance-covariance matrix sumObj <- summary(object, od = od) -# varMat <- sumObj[["varMat"]] vcovMat <- vcov.(object) ## Defining index matrix for parameter estimates indexMat <- object[["indexMat"]] - ## Calculating predicted values -# indexVec <- as.vector(indVec) -# print(indexVec) -# lenIV <- length(indexVec) - + ## Ensure indexMat is always a matrix, even with many fixed parameters + if (!is.matrix(indexMat)) { + indexMat <- as.matrix(indexMat) + if (!is.null(colnames(parmMat))) { + colnames(indexMat) <- colnames(parmMat) + } + } -# retMat <- matrix(0, lenIV, 4) + ## Calculating predicted values retMat <- matrix(0, noNewData, 4) colnames(retMat) <- c("Prediction", "SE", "Lower", "Upper") objFct <- object[["fct"]] -# print(pm) -# print(doseVec) retMat[, 1] <- objFct$"fct"(doseVec, pm) -# print(pm) ## Checking if derivatives are available deriv1 <- objFct$"deriv1" @@ -174,16 +164,12 @@ if (is.null(ssdSEfct)) { -# lmObj <- lm(seVec ~ estVec) # linear, not great lmObj <- lm(log(seVec) ~ log(estVec)) sePred <- exp(predict(lmObj, data.frame(estVec = doseVec))) } else { sePred <- ssdSEfct(estVec, seVec, doseVec) } -# print(sePred) -# print(object[["fct"]][["derivx"]](doseVec, pm)) derivxRes <- object[["fct"]][["derivx"]](doseVec, pm) -# print(derivxRes) # if (is.finite(derivxRes)) # { # sumObjRV <- (derivxRes * sePred)^2 @@ -193,48 +179,20 @@ sumObjRV <- rep(0, length(derivxRes)) isFinDR <- is.finite(derivxRes) sumObjRV[isFinDR] <- ((derivxRes * sePred)^2)[isFinDR] - -# print(sumObjRV) } if (identical(interval, "prediction")) { sumObjRV <- rep(sumObj$"resVar", noNewData) } - #else { - # sumObjRV <- 0 - # } -# rowIndex <- 1 -# for (i in indexVec) -# for (i in 1:ncol(indexMat)) - -# groupLevels <- newdata[, 2] piMat <- indexMat[, groupLevels, drop = FALSE] -# print(piMat) -# print(groupLevels) for (rowIndex in 1:noNewData) { -# parmInd <- indexMat[, i] -# print(indexVec) -# print(varMat) -# print(parmInd) - -# varCov <- varMat[parmInd, parmInd] -# print(varCov) -# groupLevels <- newdata[, 2] -# parmInd <- indexMat[, groupLevels[rowIndex]] -# varCov <- varMat[parmInd, parmInd] - parmInd <- piMat[, rowIndex] varCov <- vcovMat[parmInd, parmInd] -# parmChosen <- t(parmMat[, i, drop = FALSE]) -# parmChosen <- t(pm[, rowIndex, drop = FALSE]) -# dfEval <- deriv1(doseVec[rowIndex], parmChosen) - dfEval <- deriv1(doseVec[rowIndex], pm[rowIndex, , drop = FALSE]) varVal <- dfEval %*% varCov %*% dfEval retMat[rowIndex, 2] <- sqrt(varVal) -# retMat[rowIndex, 2] <- sqrt(dfEval %*% varCov %*% dfEval) if (!se.fit) { @@ -243,18 +201,6 @@ retMat[rowIndex, 3] <- retMat[rowIndex, 1] - tquan * sqrt(varVal + sumObjRV[rowIndex]) retMat[rowIndex, 4] <- retMat[rowIndex, 1] + tquan * sqrt(varVal + sumObjRV[rowIndex]) } -# if (identical(interval, "confidence")) -# { -# retMat[rowIndex, 3] <- retMat[rowIndex, 1] - tquan * sqrt(varVal) -# retMat[rowIndex, 4] <- retMat[rowIndex, 1] + tquan * sqrt(varVal) -# } -# if (identical(interval, "prediction")) -# { -# sumObjRV <- sumObj$"resVar" -# retMat[rowIndex, 3] <- retMat[rowIndex, 1] - tquan * sqrt(varVal + sumObjRV) -# retMat[rowIndex, 4] <- retMat[rowIndex, 1] + tquan * sqrt(varVal + sumObjRV) -# } -# rowIndex <- rowIndex + 1 } } ## Imposing constraints on predicted values @@ -276,7 +222,11 @@ if (se.fit) {keepInd <- c(keepInd, 2)} if (!identical(interval, "none")) {keepInd <- c(keepInd, 3, 4)} - return(retMat[, keepInd]) # , drop = FALSE]) + if (length(keepInd) > 1) { + return(retMat[, keepInd, drop = FALSE]) + } else { + return(retMat[, keepInd]) + } } diff --git a/R/print.drc.R b/R/print.drc.R index 74f3e6fb..dd18ac89 100644 --- a/R/print.drc.R +++ b/R/print.drc.R @@ -1,3 +1,25 @@ +#' @title Printing key features +#' +#' @description +#' \code{print} displays brief information on an object of class 'drc'. +#' +#' @param x an object of class 'drc'. +#' @param ... additional arguments. +#' @param digits an integer giving the number of digits of the parameter coefficients. Default is 3. +#' +#' @return The object is returned invisibly. +#' +#' @author Christian Ritz +#' +#' @examples +#' ## Fitting a four-parameter log-logistic model +#' ryegrass.m1 <- drm(rootl ~conc, data = ryegrass, fct = LL.4()) +#' +#' ## Displaying the model fit +#' print(ryegrass.m1) +#' ryegrass.m1 # gives the same output as the previous line +#' +#' @keywords models nonlinear "print.drc" <- function(x, ..., digits = max(3, getOption("digits") - 3)) { object <- x diff --git a/R/print.summary.drc.R b/R/print.summary.drc.R index ac1b09c0..833641e1 100644 --- a/R/print.summary.drc.R +++ b/R/print.summary.drc.R @@ -1,10 +1,28 @@ +#' @title Printing summary of non-linear model fits +#' +#' @description +#' This method produces formatted output of the summary statistics: parameter estimates, +#' estimated standard errors, z-test statistics and corresponding p-values. +#' +#' @param x an object of class 'drc'. +#' @param ... additional arguments. +#' +#' @return The object (argument \code{x}) is returned invisibly. +#' +#' @author Christian Ritz +#' +#' @examples +#' ryegrass.m1 <- drm(rootl~conc, data=ryegrass, fct= LL.4()) +#' +#' summary(ryegrass.m1) +#' +#' @keywords models nonlinear "print.summary.drc" <- function(x, ...) { object <- x cat("\n") -# cat(paste("Model fitted: ", object$"fctName", "\n", sep = "")) if (!is.null(object$"noParm")) { @@ -25,7 +43,6 @@ function(x, ...) printCoefmat(object$"coefficients") if (!is.na(object$"resVar")) -# if ((!is.null(object$"resVar")) && (!identical(object$"type", "binomial"))) { cat("\nResidual standard error") @@ -86,9 +103,6 @@ function(x, ...) { # empty } else { -# pVal <- format(object$"boxcox"[2], digits=3) -# boxcoxci <- c(format(ci[1], digits = 3), format(ci[2], digits = 3)) - cat("\n") cat("Non-normality/heterogeneity adjustment through Box-Cox transformation\n\n") @@ -96,7 +110,6 @@ function(x, ...) if (!is.na(ci[1])) { cat("Estimated lambda:", format(lambda, digits = 3), "\n") -# cat("P-value for test of null hypothesis that lambda=1:", pVal, "\n") ci <- format(ci, digits = 3) ciStr <- paste("[", ci[1], ",", ci[2], "]", sep="") cat("Confidence interval for lambda:", ciStr, "\n\n") diff --git a/R/rdrm.R b/R/rdrm.R new file mode 100644 index 00000000..244cc963 --- /dev/null +++ b/R/rdrm.R @@ -0,0 +1,106 @@ +#' Simulating a dose-response curve +#' +#' Simulation of a dose-response curve with user-specified dose values and error distribution. +#' +#' The distribution for the dose values can either be a fixed set of dose values (a numeric +#' vector) used repeatedly for creating all curves or be a distribution specified as a +#' character string resulting in varying dose values from curve to curve. +#' +#' The error distribution for the response values can be any continuous distribution +#' like \code{\link{rnorm}} or \code{\link{rgamma}}. Alternatively it can be the binomial +#' distribution \code{\link{rbinom}}. +#' +#' @param nosim numeric. The number of simulated curves to be returned. +#' @param fct list. Any built-in function in the package \emph{drc} or a list with similar +#' components. +#' @param mpar numeric. The model parameters to be supplied to \code{fct}. +#' @param xerror numeric or character. The distribution for the dose values. +#' @param xpar numeric vector supplying the parameter values defining the distribution for the +#' dose values. If \code{xerror} is a distribution then remember that the number of dose +#' values also is part of this argument (the first argument). +#' @param yerror numeric or character. The error distribution for the response values. +#' @param ypar numeric vector supplying the parameter values defining the error distribution +#' for the response values. +#' @param onlyY logical. If TRUE then only the response values are returned (useful in +#' simulations). Otherwise both dose values and response values (and for binomial data also +#' the weights) are returned. +#' +#' @return A list with up to 3 components (depending on the value of the \code{onlyY} argument). +#' +#' @author Christian Ritz +#' +#' @examples +#' ## Simulating normally distributed dose-response data +#' +#' ## Model fit to simulate from +#' ryegrass.m1 <- drm(rootl~conc, data = ryegrass, fct = LL.4()) +#' +#' ## 10 random dose-response curves based on the model fit +#' sim10a <- rdrm(10, LL.4(), coef(ryegrass.m1), xerror = ryegrass$conc) +#' sim10a +#' +#' ## Simulating binomial dose-response data +#' +#' ## Model fit to simulate from +#' deguelin.m1 <- drm(r/n~dose, weights=n, data=deguelin, fct=LL.2(), type="binomial") +#' +#' ## 10 random dose-response curves +#' sim10b <- rdrm(10, LL.2(), coef(deguelin.m1), deguelin$dose, yerror="rbinom", ypar=deguelin$n) +#' sim10b +#' +#' @keywords models nonlinear +"rdrm" <- function(nosim, fct, mpar, xerror, xpar = 1, yerror = "rnorm", ypar = c(0, 1), +onlyY = FALSE) +{ + ## Constructing the predictor values + if (is.numeric(xerror)) + { + x <- xerror + } else { + xFun <- match.fun(xerror) + x <- do.call(xFun, as.list(xpar)) + } + lenx <- length(x) + x <- sort(x) + x <- rep(x, nosim) + xMat <- matrix(x, nosim, lenx, byrow = TRUE) + + ## Constructing the mean dose-response + meanVec <- fct$fct(x, matrix(mpar, lenx*nosim, length(mpar), byrow = TRUE)) + + ## Constructing the simulated response values + yFun <- match.fun(yerror) + if (yerror == "rbinom") + { + if (length(ypar) == 1) + { + ypar <- rep(ypar, lenx*nosim) + wMat <- matrix(ypar, nosim, lenx, byrow = TRUE) + } else { + wMat <- matrix(ypar, nosim, lenx, byrow = TRUE) + } + errorVec <- yFun(lenx*nosim, ypar, meanVec) + + yMat <- matrix(errorVec, nosim, lenx, byrow = TRUE) + + ## Returning the simulated curves + if (onlyY) + { + return(list(y = yMat)) + } else { + return(list(x = xMat, w = wMat, y = yMat)) + } + } else { + errorVec <- do.call(yFun, c(list(lenx*nosim), as.list(ypar))) + + yMat <- matrix(meanVec, nosim, lenx, byrow = TRUE) + errorVec + + ## Returning the simulated curves + if (onlyY) + { + return(list(y = yMat)) + } else { + return(list(x = xMat, y = yMat)) + } + } +} diff --git a/R/rdrm.r b/R/rdrm.r deleted file mode 100644 index 1b5f1869..00000000 --- a/R/rdrm.r +++ /dev/null @@ -1,57 +0,0 @@ -"rdrm" <- function(nosim, fct, mpar, xerror, xpar = 1, yerror = "rnorm", ypar = c(0, 1), -onlyY = FALSE) -{ - ## Constructing the predictor values - if (is.numeric(xerror)) - { - x <- xerror - } else { - evalStr1 <- paste(xerror, "(", paste(xpar, sep = ",", collapse = ","), ")") - x <- eval(parse(text = evalStr1)) - } - lenx <- length(x) - x <- sort(x) - x <- rep(x, nosim) - xMat <- matrix(x, nosim, lenx, byrow = TRUE) - - ## Constructing the mean dose-response - meanVec <- fct$fct(x, matrix(mpar, lenx*nosim, length(mpar), byrow = TRUE)) - - ## Constructing the simulated response values - if (yerror == "rbinom") - { - if (length(ypar) == 1) - { - ypar <- rep(ypar, lenx*nosim) - wMat <- matrix(ypar, nosim, lenx, byrow = TRUE) - } else { - wMat <- matrix(ypar, nosim, lenx, byrow = TRUE) - } - evalStr2 <- paste(deparse(substitute(yerror)), "(", lenx*nosim, ", ypar, meanVec)") - errorVec <- eval(parse(text = evalStr2)) - - yMat <- matrix(errorVec, nosim, lenx, byrow = TRUE) - - ## Returning the simulated curves - if (onlyY) - { - return(list(y = yMat)) - } else { - return(list(x = xMat, w = wMat, y = yMat)) - } - } else { - evalStr2 <- paste(yerror, "(", lenx*nosim, ",", - paste(ypar, sep = ",", collapse = ","), ")") - errorVec <- eval(parse(text = evalStr2)) - - yMat <- matrix(meanVec, nosim, lenx, byrow = TRUE) + errorVec - - ## Returning the simulated curves - if (onlyY) - { - return(list(y = yMat)) - } else { - return(list(x = xMat, y = yMat)) - } - } -} diff --git a/R/relpot.r b/R/relpot.R similarity index 59% rename from R/relpot.r rename to R/relpot.R index 1581508e..64c56f6f 100644 --- a/R/relpot.r +++ b/R/relpot.R @@ -1,15 +1,30 @@ +#' Relative potency function +#' +#' Calculates and optionally plots relative potency as a function of the response level +#' for two curves in a dose-response model, using \code{\link{EDcomp}} for the underlying comparisons. +#' +#' @param object an object of class 'drc'. +#' @param plotit logical. If TRUE (default), a plot of relative potency against response level is produced. +#' @param compMatch a numeric vector of length 2 specifying which two curves to compare. +#' @param percVec numeric vector of response levels at which to evaluate relative potency. +#' If NULL, a suitable range is determined automatically. +#' @param interval character string specifying confidence interval type. Default is "none". +#' @param type character string. Either "relative" (default) or "absolute" response levels. +#' @param scale character string. One of "original" (default), "percent", or "unconstrained". +#' @param ... additional graphical arguments passed to \code{plot}. +#' +#' @return An invisible list with components \code{x}, \code{y} (relative potency values), +#' and \code{percVec}. +#' +#' @author Christian Ritz +#' +#' @keywords models nonlinear "relpot" <- function(object, plotit = TRUE, compMatch = NULL, percVec = NULL, interval = "none", type = c("relative", "absolute"), scale = c("original", "percent", "unconstrained"), ...) { scale <- match.arg(scale) type <- match.arg(type) -# ## Checking arguments -# if (length(compMatch) != 2) -# { -# stop("Argument 'compMatch' should have length 2") -# } - ## Defining range for 'percVec' parmMat <- commatFct(object, compMatch) lowerVec <- apply(parmMat, 2, object$"fct"$"lowerAs") @@ -62,24 +77,25 @@ type = c("relative", "absolute"), scale = c("original", "percent", "unconstraine } } + ## Compute xVec (always needed for the return value) + if ( (type == "relative") && ((scale == "percent") || (scale == "unconstrained")) ) + { + xlabStr <- "Relative response level (%)" + xVec <- percVec + } + if ( (type == "relative") && (scale == "original") ) + { + xlabStr <- "Response level" + xVec <- seq(maxLow, minUp, length.out = lenpv) + } + if (type == "absolute") + { + xlabStr <- "Response level" + xVec <- percVec + } + if (plotit) { - if ( (type == "relative") && ((scale == "percent") || (scale == "unconstrained")) ) - { - xlabStr <- "Relative response level (%)" - xVec <- percVec - } - if ( (type == "relative") && (scale == "original") ) - { - xlabStr <- "Response level" - xVec <- seq(maxLow, minUp, length.out = 99) - } - if (type == "absolute") - { - xlabStr <- "Response level" - xVec <- percVec - } - if (!identical(interval, "none")) { plot(xVec, rpVec, type = "l", xlab = xlabStr, ylab = "Relative potency", diff --git a/R/repChar.R b/R/repChar.R index fa2ba065..03435580 100644 --- a/R/repChar.R +++ b/R/repChar.R @@ -1,61 +1,60 @@ -"repChar" <- function(str, names, fixed, keep) # used in 'mixdrc' -{ - if (is.null(fixed)) {fixed <- rep(NA, length(names))} - - "replaceChar" <- function(str, names, fixed, keep, sep=c(",", ";")) - { - lenK <- length(keep) - lenN <- length(names) - strVal <- str - - cutFrom <- rep(0, lenK) - cutTo <- rep(0, lenK) - keep2 <- rep("", lenK) - for (i in 1:lenK) - { - - cutFrom[i] <- regexpr(keep[i], strVal) # matchVec[i] - cutTo[i] <- cutFrom[i] + attr(regexpr(keep[i], strVal), "match.length") - 1 - - keep2[i] <- paste(rep(sep[i], nchar(keep[i])), collapse="") - substr(strVal, cutFrom[i], cutTo[i]) <- keep2[i] - } - #print(strVal) - - for (i in 1:lenN) - { - if (!is.na(fixed[i])) - { - strVal <- gsub(names[i], as.character(fixed[i]), strVal) - } - } - - for (i in 1:lenK) - { - cutFrom[i] <- regexpr(keep2[i], strVal) # matchVec[i] - cutTo[i] <- cutFrom[i] + attr(regexpr(keep2[i], strVal), "match.length") - 1 - substr(strVal, cutFrom[i], cutTo[i]) <- keep[i] - } - return(strVal) - } - - - - "buildFct" <- function(bodyStr, names, fixed) - { - argNames <- paste(names[is.na(fixed)], collapse=",") - headerStr <- paste("function(DOSE," , argNames, "){(") - - fctStr <- paste(headerStr, bodyStr, "^lambda - 1)/lambda}") - - - formStr <- paste("formula(respVar ~ opfct(doseVar,", argNames, "))") - -# print(fctStr) - return(list(fctStr, formStr)) -# return(eval(parse(text=fctStr))) - } - - bodyS <- replaceChar(str, names, fixed, keep) - return(buildFct(bodyS, names, fixed)) -} +#' @title Replace characters in strings +#' @keywords internal +"repChar" <- function(str, names, fixed, keep) # used in 'mixdrc' +{ + if (is.null(fixed)) {fixed <- rep(NA, length(names))} + + "replaceChar" <- function(str, names, fixed, keep, sep=c(",", ";")) + { + lenK <- length(keep) + lenN <- length(names) + strVal <- str + + cutFrom <- rep(0, lenK) + cutTo <- rep(0, lenK) + keep2 <- rep("", lenK) + for (i in 1:lenK) + { + + cutFrom[i] <- regexpr(keep[i], strVal) # matchVec[i] + cutTo[i] <- cutFrom[i] + attr(regexpr(keep[i], strVal), "match.length") - 1 + + keep2[i] <- paste(rep(sep[i], nchar(keep[i])), collapse="") + substr(strVal, cutFrom[i], cutTo[i]) <- keep2[i] + } + + for (i in 1:lenN) + { + if (!is.na(fixed[i])) + { + strVal <- gsub(names[i], as.character(fixed[i]), strVal) + } + } + + for (i in 1:lenK) + { + cutFrom[i] <- regexpr(keep2[i], strVal) # matchVec[i] + cutTo[i] <- cutFrom[i] + attr(regexpr(keep2[i], strVal), "match.length") - 1 + substr(strVal, cutFrom[i], cutTo[i]) <- keep[i] + } + return(strVal) + } + + + + "buildFct" <- function(bodyStr, names, fixed) + { + argNames <- paste(names[is.na(fixed)], collapse=",") + headerStr <- paste("function(DOSE,", argNames, "){(") + + fctStr <- paste(headerStr, bodyStr, "^lambda - 1)/lambda}") + + + formStr <- paste("formula(respVar ~ opfct(doseVar,", argNames, "))") + + return(list(fctStr, formStr)) + } + + bodyS <- replaceChar(str, names, fixed, keep) + return(buildFct(bodyS, names, fixed)) +} diff --git a/R/resPrint.R b/R/resPrint.R index 3c7f53eb..66da0002 100644 --- a/R/resPrint.R +++ b/R/resPrint.R @@ -1,17 +1,13 @@ -"resPrint" <- function(resMat, headerText, interval, intervalLabel, display) -{ -# Note: arguments "interval", "intervalLabel" no longer used - if (display) - { - cat("\n") - cat(paste(headerText, "\n", sep = "")) - # if (!identical(interval, "none")) - # { - # intervalText <- paste("(", intervalLabel, "-based confidence interval(s))\n", sep = "") - # cat(intervalText) - # } - cat("\n") - printCoefmat(resMat, cs.ind = 1:ncol(resMat), tst.ind = NULL, has.Pvalue = FALSE) - } -# invisible(resMat) +#' @title Print residual information +#' @keywords internal +"resPrint" <- function(resMat, headerText, interval, intervalLabel, display) +{ +# Note: arguments "interval", "intervalLabel" no longer used + if (display) + { + cat("\n") + cat(paste(headerText, "\n", sep = "")) + cat("\n") + printCoefmat(resMat, cs.ind = 1:ncol(resMat), tst.ind = NULL, has.Pvalue = FALSE) + } } \ No newline at end of file diff --git a/R/residuals.drc.R b/R/residuals.drc.R index a794e21a..b8479d18 100644 --- a/R/residuals.drc.R +++ b/R/residuals.drc.R @@ -1,10 +1,39 @@ +#' @title Extracting residuals from the fitted dose-response model +#' +#' @description +#' \code{residuals} extracts different types of residuals from an object of +#' class 'drc'. +#' +#' @param object an object of class 'drc'. +#' @param typeRes character string specifying the type of residual to be +#' returned: raw/working residuals, residuals standardised using the +#' estimated residual standard error, or studentised residuals based on the +#' H matrix of partial derivatives of the model function. +#' @param trScale logical value indicating whether or not to return residuals +#' on the transformed scale (in case a Box-Cox transformation was applied). +#' @param ... additional arguments. +#' +#' @return The raw (also called working) residuals or some kind of scaled +#' residuals extracted from \code{object}. +#' +#' @examples +#' ## Fitting a four-parameter log-logistic model +#' ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +#' +#' ## Displaying the residual plot (raw residuals) +#' plot(fitted(ryegrass.m1), residuals(ryegrass.m1)) +#' +#' ## Using the standardised residuals +#' plot(fitted(ryegrass.m1), residuals(ryegrass.m1, typeRes = "standard")) +#' +#' @author Christian Ritz +#' +#' @keywords models nonlinear "residuals.drc" <- function(object, typeRes = c("working", "standardised", "studentised"), trScale = TRUE, ...) { typeRes <- match.arg(typeRes) -# rawResiduals <- object$"dataList"$"resp" - fitted(object) # changed 29/12 2012 - if (trScale && (!is.null(object$"boxcox"))) { ## Defining Box-Cox transformation function @@ -30,15 +59,9 @@ function(object, typeRes = c("working", "standardised", "studentised"), trScale if (is.null(rstan)) { cat("Scale parameter fixed at 1. So working residuals are returned\n\n") -# return(object$"predres"[, 2]) return(rawResiduals) - -# stop("No standardisation available") } else { -# return(object$"predres"[, 2] / rstan(object)) return(rawResiduals / rstan(object)) - -# return( object$"predres"[, 2] / sqrt(summary(object)$"resVar") ) } } @@ -54,26 +77,17 @@ function(object, typeRes = c("working", "standardised", "studentised"), trScale { Hdiag[i] <- Xmat[i, ] %*% Xprod %*% t(Xmat[i, , drop = FALSE]) } -# print(length(Hdiag)) -# print(dim(object$"predres")) scaleEst0 <- summary(object)$"resVar" scaleEst <- ifelse(is.na(scaleEst0), 1, scaleEst0) # to handle response types that are not continuous/quantitative -# return(object$"predres"[, 2] / sqrt(scaleEst * (1 - Hdiag))) - return(rawResiduals / sqrt(scaleEst * (1 - Hdiag))) + denom <- scaleEst * (1 - Hdiag) + denom[denom <= 0] <- NA # avoid division by zero for high-leverage points + return(rawResiduals / sqrt(denom)) } if (identical(typeRes, "working")) { -# return(object$"predres"[, 2]) return(rawResiduals) } } - -"scaleEst" <- function(object) -{ - - - -} diff --git a/R/rse.R b/R/rse.R index 034723ef..d9a01eaf 100644 --- a/R/rse.R +++ b/R/rse.R @@ -1,3 +1,5 @@ +#' @title Residual standard error +#' @keywords internal "rse" <- function(object, resvar = FALSE) { if (!is.null(object$"objList")) diff --git a/R/rss.R b/R/rss.R new file mode 100644 index 00000000..71ce5c47 --- /dev/null +++ b/R/rss.R @@ -0,0 +1,45 @@ +#' Residual sum of squares for dose-response models +#' +#' Calculates and displays the residual sum of squares (RSS) for a fitted dose-response model. +#' For models with multiple curves, per-curve and total RSS values are returned. +#' +#' @param object an object of class 'drc'. +#' @param print logical. If `TRUE` (the default), the RSS values are printed. +#' +#' @return Invisibly returns a matrix of RSS values. For single-curve models, a 1x1 matrix. +#' For multi-curve models, includes per-curve values and a total RSS. +#' +#' @seealso [Rsq()] which uses this function to compute R-squared. +#' +#' @author Christian Ritz +#' +#' @keywords models nonlinear +#' @export +"rss" <- function(object, print = TRUE) +{ + curve <- object$data[,4] + uniCurve <- unique(curve) + lenUC <- length(uniCurve) + + rssVals <- tapply(residuals(object)^2, curve, sum) + totRSS <- sum(residuals(object)^2) + + if (lenUC == 1) + { + hText <- "\nResidual sum of squares\n" + rssMat <- matrix(rssVals, 1, 1) + rownames(rssMat) <- "" + } else { + hText <- "\nResidual sums of squares\n" + rssMat <- matrix(c(rssVals, totRSS), lenUC + 1, 1) + rownames(rssMat) <- c(as.character(uniCurve), "Total") + } + colnames(rssMat) <- "" + + if (print) + { + cat(hText) + printCoefmat(rssMat) + } + invisible(rssMat) +} diff --git a/R/sandwich.r b/R/sandwich.R similarity index 58% rename from R/sandwich.r rename to R/sandwich.R index b77ff2b1..1f3b5860 100644 --- a/R/sandwich.r +++ b/R/sandwich.R @@ -1,5 +1,40 @@ +#' @title Estimating function for the sandwich estimator +#' +#' @description +#' Evaluates the estimating function (the "meat") for the sandwich estimator of the +#' variance-covariance matrix for objects of class 'drc'. +#' +#' @param x object of class \code{drc}. +#' @param ... additional arguments. At the moment none are supported. +#' +#' @details The details are provided by Zeileis (2006). +#' +#' @return The estimating function evaluated at the data and the parameter estimates. +#' By default no clustering is assumed, corresponding to robust standard errors +#' under independence. +#' +#' @references +#' Zeileis, A. (2006) Object-oriented Computation of Sandwich Estimators, +#' \emph{J. Statist. Software}, \bold{16}, Issue 9. +#' +#' @author Christian Ritz +#' +#' @examples +#' ## The lines below requires that the packages +#' ## 'lmtest' and 'sandwich' are installed +#' # library(lmtest) +#' # library(sandwich) +#' +#' # ryegrass.m1<-drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +#' +#' # Standard summary output +#' # coeftest(ryegrass.m1) +#' +#' # Output with robust standard errors +#' # coeftest(ryegrass.m1, vcov = sandwich) +#' +#' @keywords models nonlinear "estfun.drc" <- function (x, ...) -#"estfun.drc" <- function (x, cvar = NULL, ...) { ## Extending the matrix of derivatives to have one column per parameter (not only per model parameter) ## only relevant in case several curves (with different parameters) were fitted @@ -11,25 +46,13 @@ } else { indMat <- t(matrix(indexMat0, nrow = 1)) } -# print(indMat) colnames(indMat) <- colnames(x$indexMat) curveID <- x$dataList[["curveid"]] -# xderiv2 <- xderiv1[, rep(1:ncol(xderiv1), apply(indMat, 1, length))] - -# xderiv2 <- xderiv1[, rep(1:ncol(xderiv1), apply(indMat, 1, function(x){length(unique(x))}))] -# cnInd <- colnames(indMat) -# for (i in 1:ncol(indMat)) -# { -# xderiv2[curveID != cnInd[i], indMat[, i]] <- 0 -# } -## xderiv2[curveID != colnames(indMat)[2], indMat[, 2]] <- 0 -## print(xderiv2) ## Defining a helper function for making a wide version of the mattrix of parameter estimates xderiv2Fct <- function(xderiv1, indMat, curveID) { xderiv2 <- xderiv1[, rep(1:ncol(xderiv1), apply(indMat, 1, function(x){length(unique(x))}))] -# print(xderiv2) cnInd <- colnames(indMat) for (i in 1:ncol(indMat)) @@ -42,7 +65,6 @@ if (identical(x$type, "continuous")) { xderiv2 <- xderiv2Fct(xderiv1, indMat, curveID) -# rval <- (weights(x) * residuals(x)) * x$deriv1 rval <- (weights(x) * residuals(x)) * xderiv2 } @@ -53,7 +75,6 @@ fittedVal <- fitted(x) rval0 <- nObs/fittedVal + (nObs - nTotal)/(1 - fittedVal) rval0[!is.finite(rval0)] <- 0 # handling fitted values equal to 0 or 1 -# rval <- x$deriv1 * rval0 xderiv2 <- xderiv2Fct(xderiv1, indMat, curveID) rval <- xderiv2 * rval0 rval @@ -63,8 +84,7 @@ resp <- x[["dataList"]][["resp"]] fittedVal <- fitted(x) rval0 <- resp / fittedVal - 1 -# rval <- x$deriv1 * rval0 - xderiv2 <- xderiv2Fct(xderiv1, indMat, curveID) + xderiv2 <- xderiv2Fct(xderiv1, indMat, curveID) rval <- xderiv2 * rval0 rval } @@ -83,51 +103,36 @@ diffDF <- xderiv2Fct(diffDF.0, indMat, x$data[, 5]) rval <- (x$data[, 3] / diffF) * diffDF - - if (FALSE) - { - dataList <- x[["data"]] - xderiv1 <- x[["fct"]]$"deriv1"(dataList[, 1], t(x[["parmMat"]][, as.character(dataList[, 4])])) - print(xderiv1) - xderiv2 <- xderiv2Fct(xderiv1, indMat, data[, 4]) -# print(xderiv2) - resp <- c(0, dataList[, 3]) - fittedVal <- c(0, predict(dataList[, 2])) -# print(resp) -# print(fittedVal) -# fittedVal[length(fittedVal)] <- 1 -# fittedVal2 <- c(fittedVal[-1], 1) # assuming data ordered according to time -# rval0 <- diff(resp) / diff(fittedVal) -# print(rval0) -## lagDeriv1 <- apply(x$deriv1, 2, function(x){diff(x)}) -# lagDeriv1 <- apply(xderiv2, 2, function(x){diff(x)}) -# rval <- lagDeriv1 * rval0 -# rval <- xderiv2 * rval0 -# rval - rval <- xderiv2 * (diff(resp) / diff(fittedVal)) - } } -# ## Summing up according to specified clusters (the variable "cvar") -# if (!is.null(cvar)) -# { -# rval <- rowsum(rval, cvar) -# } -# print(rval) colnames(rval) <- names(coef(x)) -# colnames(rval) <- x$fct$names rval } +#' @title Bread for the sandwich estimator +#' +#' @description +#' Computes the "bread" (unscaled hessian) for the sandwich estimator of the +#' variance-covariance matrix for objects of class 'drc'. +#' +#' @param x object of class \code{drc}. +#' @param ... additional arguments. At the moment none are supported. +#' +#' @details The details are provided by Zeileis (2006). +#' +#' @return The unscaled hessian matrix. +#' +#' @references +#' Zeileis, A. (2006) Object-oriented Computation of Sandwich Estimators, +#' \emph{J. Statist. Software}, \bold{16}, Issue 9. +#' +#' @author Christian Ritz +#' +#' @keywords models nonlinear "bread.drc" <- function (x, ...) { -# if (identical(x$type, "binomial")) -# { -# breadMat <- vcov(x) * unlist(x$sumList[1]) -# } if (identical(x$type, "continuous")) { -# breadMat <- summary(x)$cov.unscaled * unlist(x$sumList[1]) breadMat <- vcov(x) / (summary(x)$rse[1]^2) * unlist(x$sumList[1]) } else { ## Note: not checked for event time data! breadMat <- vcov(x) * unlist(x$sumList[1]) diff --git a/R/searchdrc.R b/R/searchdrc.R index e2e90a97..b0a2ffdd 100644 --- a/R/searchdrc.R +++ b/R/searchdrc.R @@ -1,28 +1,161 @@ -"searchdrc" <- function(object, which, range, len = 50) +#' Search through a range of initial parameter values to obtain convergence +#' +#' \code{searchdrc} provides a facility for searching through a range of initial +#' values for a single parameter in order to obtain convergence of the non-linear +#' estimation procedure used in dose-response curve fitting. +#' +#' The function iterates through at most \code{len} evenly spaced values within +#' the specified \code{range}, using each as a starting value for the chosen +#' parameter. The search stops as soon as the first successful model fit is +#' found. You would need to identify the parameter which is most likely to cause +#' problems for the estimation procedure. +#' +#' Parameter names should be provided \strong{without} the curve suffix. For +#' example, use \code{"b"} rather than \code{"b:1"}. The function internally +#' matches the parameter using the pattern \code{"^:"} against the full +#' parameter names stored in the model object. +#' +#' @param object an object of class \code{'drc'}, which must have valid +#' \code{$start} and \code{$parNames} fields populated. This is typically +#' an object from a model that failed to converge but was still constructed +#' with initial parameter values. +#' @param which a character string containing the parameter name +#' \strong{without} the curve suffix (e.g., \code{"b"} not \code{"b:1"}). +#' Must exactly match one of the parameter names in the model object. +#' @param range a numeric vector of exactly length 2 specifying the interval +#' endpoints \code{c(lower, upper)} for the search range. The two endpoints +#' must be different. +#' @param len a positive integer (minimum 2). The maximum number of evenly +#' spaced starting values to try within \code{range}. The search stops early +#' as soon as convergence is achieved, so the actual number of attempts may +#' be less than \code{len}. Defaults to \code{50}. +#' @param verbose logical. If \code{TRUE}, prints progress messages indicating +#' which starting value is currently being tried. Defaults to \code{FALSE}. +#' +#' @return If convergence is achieved, returns the fitted model object of class +#' \code{'drc'}, corresponding to the \strong{first} starting value in the +#' search grid that led to a successful fit. If no starting value leads to +#' convergence, the function throws an error. +#' +#' @author Christian Ritz, Hannes Reinwald. +#' +#' @seealso +#' \code{\link[drc]{drm}} for the main model fitting function, +#' \code{\link[drc]{drmc}} for control arguments, +#' \code{\link[stats]{update}} for the update method used internally. +#' +#' @examples +#' \dontrun{ +#' library(drc) +#' +#' # Fit an initial model (which may fail to converge) +#' myModel <- drm(response ~ dose, data = myData, fct = LL.4()) +#' +#' # Search over a range of starting values for the slope parameter "b" +#' myModelFixed <- searchdrc(myModel, which = "b", range = c(-5, 5), len = 100) +#' +#' # With progress messages enabled +#' myModelFixed <- searchdrc(myModel, which = "b", range = c(-5, 5), +#' len = 100, verbose = TRUE) +#' } +#' +#' @keywords models nonlinear +searchdrc <- function(object, which, range, len = 50, verbose = FALSE) { - sv <- object$start - - parNames <- object$parNames[[2]] - whichInd <- regexpr(paste("^", which, ":", sep = ""), parNames) - whichInd <- ((1:length(parNames))[whichInd>0])[1] - - if (length(whichInd)<1) {stop(paste("No such parameter ", which, sep = ""))} - - found <- FALSE - for (i in seq(range[1], range[2], length.out = len)) - { - sv[whichInd] <- i - - options(warn = -1) - modelFit <- try(update(object, start = sv, control = drmc(noMessage = TRUE)), silent=TRUE) - if (!inherits(modelFit, "try-error")) {found <- TRUE; break} - options(warn = 0) - } - - if (found) - { - return(modelFit) - } else { - warning("Convergence failed.", call. = FALSE) - } -} + # 1. Input validation + if (!inherits(object, "drc")) { + stop("'object' must be of class 'drc'.", call. = FALSE) + } + if (is.null(object$start) || is.null(object$parNames)) { + stop(paste0( + "'object' must have valid '$start' and '$parNames' fields. ", + "Ensure the model object was constructed with initial parameter values." + ), call. = FALSE) + } + if (!is.character(which) || length(which) != 1 || nchar(trimws(which)) == 0) { + stop("'which' must be a single non-empty character string.", call. = FALSE) + } + if (!is.numeric(range) || length(range) != 2) { + stop("'range' must be a numeric vector of exactly length 2.", call. = FALSE) + } + if (range[1] == range[2]) { + stop("The two endpoints of 'range' must be different.", call. = FALSE) + } + if (!is.numeric(len) || length(len) != 1 || len < 2) { + stop("'len' must be a single numeric value of at least 2.", call. = FALSE) + } + if (!is.logical(verbose) || length(verbose) != 1) { + stop("'verbose' must be a single logical value (TRUE or FALSE).", call. = FALSE) + } + + len <- as.integer(len) + + # 2. Identify the target parameter index + sv <- object$start + parNames <- object$parNames[[2]] + + escapedWhich <- gsub("([.\\^$*+?\\[\\]{}()|])", "\\\\\\1", which, perl = TRUE) + matchPattern <- paste0("^", escapedWhich, "(:|$)") + matchIndices <- seq_along(parNames)[regexpr(matchPattern, parNames, perl = TRUE) > 0] + + if (length(matchIndices) == 0) { + stop(paste0( + "No such parameter '", which, "' was found. ", + "Available parameter names (without curve suffix) are: ", + paste(unique(sub(":.*$", "", parNames)), collapse = ", "), "." + ), call. = FALSE) + } + if (length(matchIndices) > 1) { + warning(paste0( + "Multiple parameters matched '", which, "': ", + paste(parNames[matchIndices], collapse = ", "), ". ", + "Using the first match: '", parNames[matchIndices[1]], "'." + ), call. = FALSE) + } + + # 3. Search loop + on.exit(options(warn = getOption("warn")), add = TRUE) + searchGrid <- seq(range[1], range[2], length.out = len) + modelFit <- NULL + + for (i in seq_along(searchGrid)) + { + sv[matchIndices[1]] <- searchGrid[i] + + if (verbose) { + message(sprintf("[searchdrc] Attempt %d / %d : %s = %.6g", + i, len, which, searchGrid[i])) + } + + modelFit <- tryCatch( + withCallingHandlers( + update(object, start = sv, control = drmc(noMessage = TRUE)), + warning = function(w) invokeRestart("muffleWarning") + ), + error = function(e) NULL + ) + + if (!is.null(modelFit)) { + if (verbose) { + message(sprintf( + "[searchdrc] Convergence achieved at %s = %.6g (attempt %d / %d).", + which, searchGrid[i], i, len + )) + } + break + } + } + + # 4. Return result or stop with informative error + if (!is.null(modelFit)) { + return(modelFit) + } + + warning(paste0( + "Convergence failed. No starting value for parameter '", which, + "' in the range [", range[1], ", ", range[2], "] across ", + len, " attempt(s) led to a successful fit. ", + "Consider expanding the range or increasing 'len'." + ), call. = FALSE) + return(invisible(NULL)) +} \ No newline at end of file diff --git a/R/showNews.R b/R/showNews.R deleted file mode 100644 index f5e3fc6e..00000000 --- a/R/showNews.R +++ /dev/null @@ -1,8 +0,0 @@ -"showNews" <- function(pkgname, filename = c("NEWS", "CHANGES")) -{ - filename <- match.arg(filename) - - file.show(paste(.libPaths(), pkgname, filename, sep = "/"), - title = paste("Package information for", pkgname)) -} -## drc:::showNews("drc") \ No newline at end of file diff --git a/R/siInner.R b/R/siInner.R index 9e779530..c3795851 100644 --- a/R/siInner.R +++ b/R/siInner.R @@ -1,88 +1,82 @@ -siInner <- function(indPair, pVec, compMatch, object, indexMat, parmMat, varMat, level, reference, type, sifct, interval, degfree, logBase) -{ - jInd <- indPair[1] - kInd <- indPair[2] - -# indexMat <- object$"indexMat" - parmInd1 <- indexMat[, jInd] - parmInd2 <- indexMat[, kInd] -# parmMat <- matrix(coef(object)[indexMat], ncol = ncol(indexMat)) - - parmChosen1 <- parmMat[, jInd] - parmChosen2 <- parmMat[, kInd] - -# SIeval <- sifct(parmChosen1, parmChosen2, pVec, 1,2,1,2, reference, type, jInd, kInd) - SIeval <- sifct(parmChosen1, parmChosen2, pVec, jInd, kInd, reference, type) - - SIval <- SIeval$"val" # SIeval[[1]] - dSIval <- SIeval$"der" # SIeval[[2]] -# print(dSIval) - -# print(varMat) - oriMatRow <- c(SIval, sqrt(t(dSIval) %*% varMat %*% dSIval)) - siMatRow <- matrix(NA, 1, 4) # four is the maximum number of columns - siMatRow[1, 1] <- SIval - - ## Using t-distribution for continuous data - ## only under the normality assumption - if (identical(object$"type", "continuous")) - { - qFct <- function(x) {qt(x, degfree)} - pFct <- function(x) {pt(x, degfree)} - } else { - qFct <- qnorm - pFct <- pnorm - } - - if (identical(interval, "none")) - { - siMatRow[2] <- oriMatRow[2] # sqrt(dSIval%*%varCov%*%dSIval) - - ## Testing SI equal to 1 - tempStat <- (siMatRow[1] - 1)/siMatRow[2] - siMatRow[3] <- tempStat - siMatRow[4] <- pFct(-abs(tempStat)) + (1 - pFct(abs(tempStat))) - } - if ( (identical(interval, "delta")) || (identical(interval, "fls")) ) - { - stErr <- oriMatRow[2] # sqrt(derEval%*%varCov%*%derEval) - tquan <- qFct(1 - (1 - level)/2) - - siMatRow[2] <- siMatRow[1] - tquan * stErr - siMatRow[3] <- siMatRow[1] + tquan * stErr - ciLabel <- "Delta method" - } - if (identical(interval, "tfls")) - { - lsVal <- log(oriMatRow[1]) - lsdVal <- oriMatRow[2] / oriMatRow[1] - tquan <- qFct(1 - (1 - level)/2) - - siMatRow[2] <- exp(lsVal - tquan * lsdVal) - siMatRow[3] <- exp(lsVal + tquan * lsdVal) - ciLabel <- "To and from log scale" - } - if ((!is.null(logBase)) && (identical(interval, "fls"))) - { - siMatRow[1] <- logBase^(siMatRow[1]) - siMatRow[2] <- logBase^(siMatRow[2]) - siMatRow[3] <- logBase^(siMatRow[3]) - ciLabel <- "From log scale" - } - if (identical(interval, "fieller")) # using t-distribution - { - vcMat <- matrix(NA, 2, 2) -# vcMat[1, 1] <- SIeval$"der1" %*% varMat[parmInd1, parmInd1] %*% SIeval$"der1" -# vcMat[2, 2] <- SIeval$"der2" %*% varMat[parmInd2, parmInd2] %*% SIeval$"der2" -# vcMat[1, 2] <- SIeval$"der1" %*% varMat[parmInd1, parmInd2] %*% SIeval$"der2" - vcMat[1, 1] <- SIeval$"der1" %*% varMat %*% SIeval$"der1" - vcMat[2, 2] <- SIeval$"der2" %*% varMat %*% SIeval$"der2" - vcMat[1, 2] <- SIeval$"der1" %*% varMat %*% SIeval$"der2" - vcMat[2, 1] <- vcMat[1, 2] - muVec <- c(SIeval$"valnum", SIeval$"valden") - - siMatRow[2:3] <- fieller(muVec, degfree, vcMat, level = level) - ciLabel <- "Fieller" - } - c(siMatRow, dSIval) +#' @title Inner function for selectivity index +#' @keywords internal +siInner <- function(indPair, pVec, compMatch, object, indexMat, parmMat, varMat, level, reference, type, sifct, interval, degfree, logBase) +{ + jInd <- indPair[1] + kInd <- indPair[2] + + parmInd1 <- indexMat[, jInd] + parmInd2 <- indexMat[, kInd] + + parmChosen1 <- parmMat[, jInd] + parmChosen2 <- parmMat[, kInd] + + SIeval <- sifct(parmChosen1, parmChosen2, pVec, jInd, kInd, reference, type) + + SIval <- SIeval$"val" # SIeval[[1]] + dSIval <- SIeval$"der" # SIeval[[2]] + + oriMatRow <- c(SIval, sqrt(t(dSIval) %*% varMat %*% dSIval)) + siMatRow <- matrix(NA, 1, 4) # four is the maximum number of columns + siMatRow[1, 1] <- SIval + + ## Using t-distribution for continuous data + ## only under the normality assumption + if (identical(object$"type", "continuous")) + { + qFct <- function(x) {qt(x, degfree)} + pFct <- function(x) {pt(x, degfree)} + } else { + qFct <- qnorm + pFct <- pnorm + } + + if (identical(interval, "none")) + { + siMatRow[2] <- oriMatRow[2] # sqrt(dSIval%*%varCov%*%dSIval) + + ## Testing SI equal to 1 + tempStat <- (siMatRow[1] - 1)/siMatRow[2] + siMatRow[3] <- tempStat + siMatRow[4] <- pFct(-abs(tempStat)) + (1 - pFct(abs(tempStat))) + } + if ( (identical(interval, "delta")) || (identical(interval, "fls")) ) + { + stErr <- oriMatRow[2] # sqrt(derEval%*%varCov%*%derEval) + tquan <- qFct(1 - (1 - level)/2) + + siMatRow[2] <- siMatRow[1] - tquan * stErr + siMatRow[3] <- siMatRow[1] + tquan * stErr + ciLabel <- "Delta method" + } + if (identical(interval, "tfls")) + { + lsVal <- log(oriMatRow[1]) + lsdVal <- oriMatRow[2] / oriMatRow[1] + tquan <- qFct(1 - (1 - level)/2) + + siMatRow[2] <- exp(lsVal - tquan * lsdVal) + siMatRow[3] <- exp(lsVal + tquan * lsdVal) + ciLabel <- "To and from log scale" + } + if ((!is.null(logBase)) && (identical(interval, "fls"))) + { + siMatRow[1] <- logBase^(siMatRow[1]) + siMatRow[2] <- logBase^(siMatRow[2]) + siMatRow[3] <- logBase^(siMatRow[3]) + ciLabel <- "From log scale" + } + if (identical(interval, "fieller")) # using t-distribution + { + vcMat <- matrix(NA, 2, 2) + vcMat[1, 1] <- SIeval$"der1" %*% varMat %*% SIeval$"der1" + vcMat[2, 2] <- SIeval$"der2" %*% varMat %*% SIeval$"der2" + vcMat[1, 2] <- SIeval$"der1" %*% varMat %*% SIeval$"der2" + vcMat[2, 1] <- vcMat[1, 2] + muVec <- c(SIeval$"valnum", SIeval$"valden") + + siMatRow[2:3] <- fieller(muVec, degfree, vcMat, level = level) + ciLabel <- "Fieller" + } + c(siMatRow, dSIval) } \ No newline at end of file diff --git a/R/simDR.R b/R/simDR.R index 8c7fec12..5c337ddd 100644 --- a/R/simDR.R +++ b/R/simDR.R @@ -1,58 +1,97 @@ - -## One curve only -"simDR" <- function(mpar, sigma, fct, noSim = 1000, conc, edVec = c(10, 50), seedVal = 20070723) +#' Simulating ED values under various scenarios +#' +#' Simulating ED values for a given model and given dose values. +#' +#' The arguments \code{mpar} and \code{sigma} are typically obtained from a +#' previous model fit. Only dose-response models assuming normally distributed +#' errors can be used. +#' +#' @param mpar numeric vector of model parameters. +#' @param sigma numeric specifying the residual standard deviation. +#' @param fct list supplying the chosen dose-response mean function (e.g., \code{LL.4()}). +#' @param noSim numeric giving the number of simulations. Defaults to \code{1000}. +#' @param conc numeric vector of concentration/dose values. Must contain at least 5 values. +#' @param edVec numeric vector of ED levels to estimate in each simulation. Defaults to +#' \code{c(10, 50)}. +#' @param seedVal numeric giving the seed used to initialise the random number generator. +#' Defaults to \code{20070723}. +#' +#' @return Invisibly returns a list with one element: +#' \describe{ +#' \item{\code{se}}{A 3D array of dimensions +#' \code{(length(conc) - 4) x 6 x length(edVec)} containing empirical +#' standard deviations of the estimated ED values. Rows correspond to the +#' number of concentration levels used (starting from 5). Columns correspond +#' to the number of replicates per concentration (1 to 6). The third dimension +#' corresponds to each ED level in \code{edVec}.} +#' } +#' The array values are also printed to the console during execution. +#' +#' @author Christian Ritz, Hannes Reinwald +#' +#' @examples +#' ryegrass.m1 <- drm(ryegrass, fct = LL.4()) +#' +#' simDR( +#' mpar = coef(ryegrass.m1), +#' sigma = sqrt(summary(ryegrass.m1)$resVar), +#' fct = LL.4(), +#' noSim = 2, +#' conc = c(1.88, 3.75, 7.50, 0.94, 15, 0.47, 30, 0.23, 60), +#' seedVal = 20070723 +#' ) +#' +#' @keywords models nonlinear +simDR <- function(mpar, sigma, fct, noSim = 1000, conc, edVec = c(10, 50), seedVal = 20070723) { - set.seed(seedVal) - - ## Calculating the true ED values - lened <- length(edVec) - edTRUE <- rep(0, lened) - for (i in 1:lened) + set.seed(seedVal) + + ## Calculating the true ED values + n_ed <- length(edVec) + ed_true <- rep(0, n_ed) + for (i in 1:n_ed) + { + ed_true[i] <- fct$edfct(mpar, edVec[i], type = "relative")[[1]] + } + + ## Run simulations + ed_array <- array(NA, c(length(conc) - 4, 6, n_ed)) + sim_biases <- matrix(NA, noSim, n_ed) + + for (i in 5:length(conc)) + { + conc_sorted <- sort(conc[1:i]) + for (j in 1:6) { - edTRUE[i] <- fct$edfct(mpar, edVec[i], type="relative")[[1]] - } - - ## Run simulations - edMat1 <- array(NA, c(length(conc)-4, 6, lened)) -# edMat2 <- array(NA, c(length(conc)-4, 6, 3)) -# edMat3 <- array(NA, c(length(conc)-4, 6, 3)) - tempMat <- matrix(NA, noSim, lened) - for (i in 5:length(conc)) - { - cVec1 <- sort(conc[1:i]) - for (j in 1:6) + conc_rep <- rep(conc_sorted, rep(j, i)) + sim_data <- rdrm(noSim, fct, mpar, conc_rep, ypar = sigma) + + for (k in 1:noSim) + { + fit <- try(drm(sim_data$y[k, ] ~ sim_data$x[k, ], fct = fct), silent = TRUE) + if (!inherits(fit, "try-error")) { - cVec2 <- rep(cVec1, rep(j, i)) - sim1 <- rdrm(noSim, LL.4(), mpar, cVec2, ypar = sigma) - - for (k in 1:noSim) - { - tempFit <- try(drm(sim1$y[k, ]~sim1$x[k, ], fct = fct), silent = TRUE) - if (!inherits(tempFit, "try-error")) - { - edVal <- ED(tempFit, edVec, display = FALSE) - tempMat[k, ] <- edVal[, 1] - edTRUE - } - } - edMat1[i - 4, j, ] <- apply(tempMat, 2, sd, na.rm = TRUE) -# edMat2[i - 4, j, ] <- apply(tempMat, 2, mean, na.rm = TRUE) -# edMat3[i - 4, j, ] <- apply(tempMat, 2, function(x) {mean(x^2, na.rm = TRUE)}) + ed_estimates <- ED(fit, edVec, display = FALSE) + sim_biases[k, ] <- ed_estimates[, 1] - ed_true } - } - -#print(edMat1) - cat("Concentrations used:", conc, "\n\n") - for (i in 1:lened) - { - tempMat <- edMat1[, , i] - colnames(tempMat) <- 1:6 - rownames(tempMat) <- 5:9 - - cat("ED value considered:", edVec[i], "\n") - cat("Conc. no.\\Replicates:", "\n") - print(tempMat) - cat("\n\n") - } + } + ed_array[i - 4, j, ] <- apply(sim_biases, 2, sd, na.rm = TRUE) + } + } + + ## Display results + cat("Concentrations used:", conc, "\n\n") + for (i in 1:n_ed) + { + result_matrix <- ed_array[, , i] + colnames(result_matrix) <- 1:6 + rownames(result_matrix) <- 5:length(conc) - invisible(list(se=edMat1)) # , bias=edMat2, mse=edMat3)) -} + cat("ED value considered:", edVec[i], "\n") + cat("Conc. no.\\Replicates:", "\n") + print(result_matrix) + cat("\n\n") + } + + invisible(list(se = ed_array)) +} \ No newline at end of file diff --git a/R/simFct.R b/R/simFct.R index cac6e4ca..612c6417 100644 --- a/R/simFct.R +++ b/R/simFct.R @@ -1,4 +1,36 @@ -## Simulating ED values +#' Simulation of dose-response data and ED estimation +#' +#' Simulates dose-response datasets using parametric or non-parametric methods and estimates +#' effective doses (ED values) from each simulated dataset. Useful for assessing the +#' performance of ED estimation methods via Monte Carlo simulation. +#' +#' @param noSim integer. Number of simulations to run. +#' @param edVal numeric vector of ED levels to estimate (default is \code{c(10, 20, 50)}). +#' @param type character string. Either "non-parametric" or "parametric" simulation. +#' @param response character string. Either "bin" (binomial) or "con" (continuous) response. +#' @param fct dose-response function used for simulation (default is \code{LL.2()}). +#' @param coefVec numeric vector of model coefficients for parametric simulation. +#' @param method character string. Estimation method: "sp" (semi-parametric), "p" (parametric), +#' or "np" (non-parametric). +#' @param doseVec numeric vector of dose values. +#' @param nVec numeric vector of sample sizes per dose (for binomial response). +#' @param pVec numeric vector of expected response probabilities (for non-parametric simulation). +#' @param rVec numeric vector of responses. +#' @param resVar numeric. Residual variance (for continuous response). +#' @param pfct dose-response function used for fitting (defaults to \code{fct}). +#' @param reference character string specifying the reference for ED estimation. +#' @param span numeric. Smoothing parameter for local regression. NA uses default. +#' @param minmax character string. Type of min/max calculation. Default is "response". +#' @param lower numeric. Lower bounds for optimization. +#' @param upper numeric. Upper bounds for optimization. +#' @param seedVal integer. Random seed for reproducibility (default is 200810201). +#' +#' @return A list with components \code{edArray} (array of ED estimates), \code{mixVec}, +#' \code{edVal}, \code{aicVec}, and \code{spanVec}. +#' +#' @author Christian Ritz +#' +#' @keywords models nonlinear "simFct" <- function(noSim, edVal = c(10, 20, 50), type = c("non-parametric", "parametric"), response = c("bin", "con"), fct = LL.2(), coefVec, method = c("sp", "p", "np"), doseVec, nVec, pVec, rVec, resVar, pfct = fct, reference = NULL, span = NA, @@ -92,8 +124,7 @@ minmax = "response", lower = NULL, upper = NULL, seedVal = 200810201) { spanVec[i] <- gcvFct(doseVec, y) } -# print(spanVec[i]) - loessModel <- loess(y ~ doseVec, degree = 1, span = spanVec[i]) # span = span + loessModel <- loess(y ~ doseVec, degree = 1, span = spanVec[i]) tempModel <- mrdrm(parModel, loessModel) if (inherits(tempModel, "try-error")) @@ -120,8 +151,8 @@ minmax = "response", lower = NULL, upper = NULL, seedVal = 200810201) edMat[, , i] <- NA mixVec[i] <- NA } else { - tempED <- ED(tempModel, edVal, display = FALSE, ci = "delta")[, c(1, 3, 4)] - if (inherits(tempModel, "try-error")) + tempED <- try(ED(tempModel, edVal, display = FALSE, interval = "delta")[, c(1, 3, 4)], silent = TRUE) + if (inherits(tempED, "try-error")) { edMat[, , i] <- NA mixVec[i] <- NA @@ -145,7 +176,6 @@ coverFct <- function(mfit, simres, edVec = NULL) edVec <- ED(mfit, edVal, display = FALSE)[, 1] } -# notNA <- sum(!is.na(simres$edArray[1, 2,])) lenem <- length(edVal) cpVec <- rep(NA, lenem) cplVec <- rep(NA, lenem) @@ -166,865 +196,3 @@ coverFct <- function(mfit, simres, edVec = NULL) list(coverage = cpVec, covLow = cplVec, covUp = cpuVec, true = edVec, mean = mvVec, width = mwVec, notNAs = notNA, NAs = length(simres$edArray[1, 2,]) - notNA, mixingAverage = mean(simres$mixVec, na.rm = TRUE)) } - - -#misspec <- function(lambda, delta = 0.5) -#{ -# function(x) -# { -# Lfct <- function(x, mu, tau) {1/(1+exp(-((x-mu)/tau)))} -# (1-lambda)*Lfct(x, 0.5, 0.1) + lambda*(delta*Lfct(x, 0.25, 0.05) + (1-delta)*Lfct(x, 0.75, 0.05)) -# } -#} -# -#msFct <- misspec(0.5) - -if (FALSE) -{ - -## Simulations based on the design and probabilities in the dataset 'deguelin' - -deguelin.m1 <- drm(r/n~dose, weights=n, data=deguelin, fct=LL.2(), type="binomial") - -## Semi-parametric -simres<-simFct2(1000, edVal = c(50), type = c("parametric"), -response = c("bin"), fct = LL.2(), coefVec = coef(deguelin.m1), method = c("sp"), -doseVec = deguelin$dose, nVec = deguelin$n) # , rVec = deguelin$r) -coverFct(deguelin.m1, simres) - -true.sr.sp1b<-simFct2(100, edVal = c(50), type = c("parametric"), -response = c("bin"), fct = LL.2(), coefVec = coef(deguelin.m1), method = c("sp"), -doseVec = deguelin$dose, nVec = deguelin$n) # , rVec = deguelin$r) -coverFct(deguelin.m1, true.sr.sp1) - -simres4<-simFct2(1000, edVal = c(10,20,50), type = c("parametric"), -response = c("bin"), fct = LL.2(), coefVec = coef(deguelin.m1), method = c("sp"), -doseVec = c(1, deguelin$dose), nVec = c(49, deguelin$n)) # , rVec = c(1, deguelin$r)) -coverFct(deguelin.m1, simres4) - -simres7<-simFct2(1000, edVal = c(10,20,50), type = c("parametric"), -response = c("bin"), fct = LL.2(), coefVec = coef(deguelin.m1), method = c("sp"), -doseVec = c(1, deguelin$dose), nVec = rep(10, 7)) -coverFct(deguelin.m1, simres7) - -simres7b<-simFct2(1000, edVal = c(10,20,50), type = c("parametric"), -response = c("bin"), fct = LL.2(), coefVec = coef(deguelin.m1), method = c("sp"), -doseVec = c(1, deguelin$dose), nVec = rep(20, 7), seedVal=200802211) -coverFct(deguelin.m1, simres7b) - -simres7c<-simFct2(1000, edVal = c(10,20,50), type = c("parametric"), -response = c("bin"), fct = LL.2(), coefVec = coef(deguelin.m1), method = c("sp"), -doseVec = c(1, deguelin$dose), nVec = rep(20, 7), seedVal=200804011) -coverFct(deguelin.m1, simres7c) - -simres7d<-simFct2(10, edVal = c(10,20,50), type = c("parametric"), -response = c("bin"), fct = LL.2(), coefVec = coef(deguelin.m1), method = c("sp"), -doseVec = c(2.5, deguelin$dose), nVec = rep(20, 7), seedVal=200804012) -coverFct(deguelin.m1, simres7d) - - -## Parametric -simres2<-simFct2(1000, edVal = c(50), type = c("parametric"), -response = c("bin"), fct = LL.2(), coefVec = coef(deguelin.m1), method = c("p"), -doseVec = deguelin$dose, nVec = deguelin$n) # , rVec = deguelin$r) - -simres3<-simFct2(1000, edVal = c(10,20,50), type = c("parametric"), -response = c("bin"), fct = LL.2(), coefVec = coef(deguelin.m1), method = c("p"), -doseVec = c(1, deguelin$dose), nVec = c(49, deguelin$n)) # , rVec = c(1, deguelin$r)) -coverFct(deguelin.m1, simres3) - -simres5<-simFct2(1000, edVal = c(10,20,50), type = c("parametric"), -response = c("bin"), fct = LL.2(), coefVec = coef(deguelin.m1), method = c("p"), -doseVec = c(1, deguelin$dose), nVec = rep(20, 7)) -coverFct(deguelin.m1, simres5) - -simres6<-simFct2(1000, edVal = c(10,20,50), type = c("parametric"), -response = c("bin"), fct = LL.2(), coefVec = coef(deguelin.m1), method = c("p"), -doseVec = c(1, deguelin$dose), nVec = rep(10, 7)) -coverFct(deguelin.m1, simres6) - -## Non-parametric -np.simres1 <- simFct2(1000, edVal = c(10,20,50), type = c("parametric"), -response = c("bin"), fct = LL.2(), coefVec = coef(deguelin.m1), method = c("np"), -doseVec = c(1, deguelin$dose), nVec = rep(10, 7), seedVal = 200802191) -coverFct(deguelin.m1, np.simres1) - -np.simres2 <- simFct2(1000, edVal = c(10,20,50), type = c("parametric"), -response = c("bin"), fct = LL.2(), coefVec = coef(deguelin.m1), method = c("np"), -doseVec = c(1, deguelin$dose), nVec = rep(20, 7), seedVal = 200802192) -coverFct(deguelin.m1, np.simres2) - -np.simres3 <- simFct2(1000, edVal = c(10,20,50), type = c("parametric"), -response = c("bin"), fct = LL.2(), coefVec = coef(deguelin.m1), method = c("np"), -doseVec = c(1, deguelin$dose), nVec = rep(50, 7), seedVal = 200802193) -coverFct(deguelin.m1, np.simres3) - - - -## Under misspecification - -msFct <- misspec(0.5) - -evFct <- function(edVal, maxx = 1) -{ - lenev <- length(edVal) - edVec <- rep(NA, lenev) - for (i in 1:lenev) - { - edVec[i] <- uniroot(function(x){msFct(x/maxx)-edVal[i]/100}, c(1, 99))$root - } - edVec -} -edVec <- evFct(c(10,20,50), maxx = 52) - - -## Parametric -mis.sr.p1 <- simFct2(1000, edVal = c(10,20,50), type = c("non-parametric"), -response = c("bin"), method = c("p"), -doseVec = c(1, deguelin$dose), nVec = rep(10, 7), pVec = msFct(c(1, deguelin$dose)/52), seedVal = 200802194) -coverFct(deguelin.m1, mis.sr.p1, edVec) - -mis.sr.p2 <- simFct2(1000, edVal = c(10,20,50), type = c("non-parametric"), -response = c("bin"), method = c("p"), -doseVec = c(1, deguelin$dose), nVec = rep(20, 7), pVec = msFct(c(1, deguelin$dose)/52), seedVal = 200802195) -coverFct(deguelin.m1, mis.sr.p2, edVec) - -mis.sr.p3 <- simFct2(1000, edVal = c(10,20,50), type = c("non-parametric"), -response = c("bin"), method = c("p"), -doseVec = c(1, deguelin$dose), nVec = rep(50, 7), pVec = msFct(c(1, deguelin$dose)/52), seedVal = 200802196) -coverFct(deguelin.m1, mis.sr.p3, edVec) - - -## Semi-parametric -mis.sr.sp1 <- simFct2(1000, edVal = c(10,20,50), type = c("non-parametric"), -response = c("bin"), method = c("sp"), -doseVec = c(1, deguelin$dose), nVec = rep(10, 7), pVec = msFct(c(1, deguelin$dose)/52), seedVal = 200802197) -coverFct(deguelin.m1, mis.sr.sp1, edVec) - -mis.sr.sp1b <- simFct2(100, edVal = c(10,20,50), type = c("non-parametric"), -response = c("bin"), method = c("sp"), -doseVec = c(1, deguelin$dose), nVec = rep(10, 7), pVec = msFct(c(1, deguelin$dose)/52), seedVal = 200802197) -coverFct(deguelin.m1, mis.sr.sp1b, edVec) - -mis.sr.sp2 <- simFct2(1000, edVal = c(10,20,50), type = c("non-parametric"), -response = c("bin"), method = c("sp"), -doseVec = c(1, deguelin$dose), nVec = rep(20, 7), pVec = msFct(c(1, deguelin$dose)/52), seedVal = 200802198) -coverFct(deguelin.m1, mis.sr.sp2, edVec) - -mis.sr.sp3 <- simFct2(1000, edVal = c(10,20,50), type = c("non-parametric"), -response = c("bin"), method = c("sp"), -doseVec = c(1, deguelin$dose), nVec = rep(50, 7), pVec = msFct(c(1, deguelin$dose)/52), seedVal = 200802199) -coverFct(deguelin.m1, mis.sr.sp3, edVec) - -mis.sr.sp3b <- simFct2(100, edVal = c(10,20,50), type = c("non-parametric"), -response = c("bin"), method = c("sp"), -doseVec = c(1, deguelin$dose), nVec = rep(50, 7), pVec = msFct(c(1, deguelin$dose)/52), seedVal = 200802199) -coverFct(deguelin.m1, mis.sr.sp3b, edVec) - - -## Non-parametric -mis.sr.np1 <- simFct2(1000, edVal = c(10,20,50), type = c("non-parametric"), -response = c("bin"), method = c("np"), -doseVec = c(1, deguelin$dose), nVec = rep(10, 7), pVec = msFct(c(1, deguelin$dose)/52), seedVal = 200802201) -coverFct(deguelin.m1, mis.sr.np1, edVec) - -mis.sr.np2 <- simFct2(1000, edVal = c(10,20,50), type = c("non-parametric"), -response = c("bin"), method = c("np"), -doseVec = c(1, deguelin$dose), nVec = rep(20, 7), pVec = msFct(c(1, deguelin$dose)/52), seedVal = 200802202) -coverFct(deguelin.m1, mis.sr.np2, edVec) - -mis.sr.np3 <- simFct2(1000, edVal = c(10,20,50), type = c("non-parametric"), -response = c("bin"), method = c("np"), -doseVec = c(1, deguelin$dose), nVec = rep(50, 7), pVec = msFct(c(1, deguelin$dose)/52), seedVal = 200802203) -coverFct(deguelin.m1, mis.sr.np3, edVec) - - - -## Using 14 dose levels - -dose14 <- seq(1, 50, length.out = 14) - -## Semi-parametric -mis.14.sp1 <- simFct2(1000, edVal = c(10,20,50), type = c("non-parametric"), -response = c("bin"), method = c("sp"), -doseVec = dose14, nVec = rep(10, 14), pVec = msFct(dose14/52), seedVal = 200802212) -coverFct(deguelin.m1, mis.14.sp1, edVec) - -mis.14.sp2 <- simFct2(1000, edVal = c(10,20,50), type = c("non-parametric"), -response = c("bin"), method = c("sp"), -doseVec = dose14, nVec = rep(20, 14), pVec = msFct(dose14/52), seedVal = 200802213) -coverFct(deguelin.m1, mis.14.sp2, edVec) - -mis.14.sp3 <- simFct2(1000, edVal = c(10,20,50), type = c("non-parametric"), -response = c("bin"), method = c("sp"), -doseVec = dose14, nVec = rep(50, 14), pVec = msFct(dose14/52), seedVal = 200802214) -coverFct(deguelin.m1, mis.14.sp3, edVec) - -## Using 56 dose levels - -dose56 <- seq(1, 50, length.out = 56) - -## Semi-parametric -mis.56.sp1 <- simFct2(1000, edVal = c(10,20,50), type = c("non-parametric"), -response = c("bin"), method = c("sp"), -doseVec = dose56, nVec = rep(10, 56), pVec = msFct(dose56/52), seedVal = 200802281) -coverFct(deguelin.m1, mis.56.sp1, evFct(c(10,20,50), maxx = 52)) - -mis.56.sp2 <- simFct2(100, edVal = c(10,20,50), type = c("non-parametric"), -response = c("bin"), method = c("sp"), -doseVec = dose56, nVec = rep(20, 56), pVec = msFct(dose56/52), seedVal = 200802281) -coverFct(deguelin.m1, mis.56.sp2, evFct(c(10,20,50), maxx = 52)) - - - - -## bin.mat -bin.mat.m1 <- drm(matured/total~conc, weights=total, data = bin.mat[c(1,4,7,10,13),], fct=LL.2()) - -## Parametric -bin.mat.true.p1<-simFct2(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("bin"), fct = LL.2(), coefVec = coef(bin.mat.m1), method = c("p"), -doseVec = bin.mat[c(1,4,7,10,13),]$conc, nVec = bin.mat[c(1,4,7,10,13),]$total, seedVal=200802271) -coverFct(bin.mat.m1, bin.mat.true.p1) - -bin.mat.true.p2<-simFct2(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("bin"), fct = LL.2(), coefVec = coef(bin.mat.m1), method = c("p"), -doseVec = bin.mat[c(1,4,7,10,13),]$conc, nVec = rep(20, 5), seedVal=200802272) -coverFct(bin.mat.m1, bin.mat.true.p2) - -bin.mat.true.p3<-simFct2(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("bin"), fct = LL.2(), coefVec = coef(bin.mat.m1), method = c("p"), -doseVec = bin.mat[c(1,4,7,10,13),]$conc, nVec = rep(50, 5), seedVal=200802273) -coverFct(bin.mat.m1, bin.mat.true.p3) - - -## Semi-parametric -true.sp1<-simFct2(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("bin"), fct = LL.2(), coefVec = coef(bin.mat.m1), method = c("sp"), -doseVec = bin.mat[c(1,4,7,10,13),]$conc, nVec = bin.mat[c(1,4,7,10,13),]$total, seedVal=200802221) -coverFct(bin.mat.m1, true.sp1) - -#true.aic.sp1<-true.sp1<-simFct2(10, edVal = c(10, 20, 50), type = c("parametric"), -#response = c("bin"), fct = LL.2(), coefVec = coef(bin.mat.m1), method = c("sp"), -#doseVec = bin.mat[c(1,4,7,10,13),]$conc, nVec = bin.mat[c(1,4,7,10,13),]$total, seedVal=200802221,aic=TRUE) -#true.aic.sp1$aic -# -#true.aic.p1<-true.sp1<-simFct2(10, edVal = c(10, 20, 50), type = c("parametric"), -#response = c("bin"), fct = LL.2(), coefVec = coef(bin.mat.m1), method = c("p"), -#doseVec = bin.mat[c(1,4,7,10,13),]$conc, nVec = bin.mat[c(1,4,7,10,13),]$total, seedVal=200802221,aic=TRUE) -#true.aic.p1$aic -## the AIC values are not compatible between the parametric and the semi-parametric models for binomial data! - - -true.sp2<-simFct2(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("bin"), fct = LL.2(), coefVec = coef(bin.mat.m1), method = c("sp"), -doseVec = bin.mat[c(1,4,7,10,13),]$conc, nVec = rep(20, 5), seedVal=200802222) -coverFct(bin.mat.m1, true.sp2) - -true.sp3<-simFct2(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("bin"), fct = LL.2(), coefVec = coef(bin.mat.m1), method = c("sp"), -doseVec = bin.mat[c(1,4,7,10,13),]$conc, nVec = rep(50, 5), seedVal=200802223) -coverFct(bin.mat.m1, true.sp3) - -## Non-parametric -bin.mat.true.np1<-simFct2(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("bin"), method = c("np"), doseVec = bin.mat[c(1,4,7,10,13),]$conc, nVec = bin.mat[c(1,4,7,10,13),]$total, -fct = LL.2(), coefVec = coef(bin.mat.m1), -seedVal=200802261) -coverFct(bin.mat.m1, bin.mat.true.np1) - -bin.mat.true.np2<-simFct2(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("bin"), method = c("np"), -doseVec = bin.mat[c(1,4,7,10,13),]$conc, nVec = rep(20, 5), -fct = LL.2(), coefVec = coef(bin.mat.m1), -seedVal=200802262) -coverFct(bin.mat.m1, bin.mat.true.np2) - -bin.mat.true.np3<-simFct2(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("bin"), method = c("np"), -doseVec = bin.mat[c(1,4,7,10,13),]$conc, nVec = rep(50, 5), -fct = LL.2(), coefVec = coef(bin.mat.m1), -seedVal=200802263) -coverFct(bin.mat.m1, bin.mat.true.np3) - - -## Under misspecification - -evFct <- function(edVal, maxx = 1) -{ - lenev <- length(edVal) - edVec <- rep(NA, lenev) - for (i in 1:lenev) - { - edVec[i] <- uniroot(function(x){msFct(x/maxx)-edVal[i]/100}, c(1e-6, maxx - 1e-6))$root - } - edVec -} -edVec <- evFct(c(10,20,50)) - - -## Parametric -bin.mat.mis.p1<-simFct2(1000, edVal = c(10, 20, 50), type = c("non-parametric"), -response = c("bin"), method = c("p"), doseVec = bin.mat[c(1,4,7,10,13),]$conc, nVec = bin.mat[c(1,4,7,10,13),]$total, -pVec = 1 - msFct(bin.mat[c(1,4,7,10,13),]$conc), -seedVal=200802251) -coverFct(bin.mat.m1, bin.mat.mis.p1, edVec) - -bin.mat.mis.p2<-simFct2(1000, edVal = c(10, 20, 50), type = c("non-parametric"), -response = c("bin"), method = c("p"), -doseVec = bin.mat[c(1,4,7,10,13),]$conc, nVec = rep(20, 5), pVec = 1 - msFct(bin.mat[c(1,4,7,10,13),]$conc), -seedVal=200802252) -coverFct(bin.mat.m1, bin.mat.mis.p2, edVec) - -bin.mat.mis.p3<-simFct2(1000, edVal = c(10, 20, 50), type = c("non-parametric"), -response = c("bin"), method = c("p"), -doseVec = bin.mat[c(1,4,7,10,13),]$conc, nVec = rep(50, 5), pVec = 1 - msFct(bin.mat[c(1,4,7,10,13),]$conc), -seedVal=200802253) -coverFct(bin.mat.m1, bin.mat.mis.p3, edVec) - -## Semi-parametric -bin.mat.mis.sp1<-simFct2(1000, edVal = c(10, 20, 50), type = c("non-parametric"), -response = c("bin"), method = c("sp"), doseVec = bin.mat[c(1,4,7,10,13),]$conc, nVec = bin.mat[c(1,4,7,10,13),]$total, -pVec = 1 - msFct(bin.mat[c(1,4,7,10,13),]$conc), -seedVal=200802254) -coverFct(bin.mat.m1, bin.mat.mis.sp1, edVec) - -bin.mat.mis.sp2<-simFct2(1000, edVal = c(10, 20, 50), type = c("non-parametric"), -response = c("bin"), method = c("sp"), -doseVec = bin.mat[c(1,4,7,10,13),]$conc, nVec = rep(20, 5), pVec = 1 - msFct(bin.mat[c(1,4,7,10,13),]$conc), -seedVal=200802255) -coverFct(bin.mat.m1, bin.mat.mis.sp2, edVec) - -bin.mat.mis.sp3<-simFct2(1000, edVal = c(10, 20, 50), type = c("non-parametric"), -response = c("bin"), method = c("sp"), -doseVec = bin.mat[c(1,4,7,10,13),]$conc, nVec = rep(50, 5), pVec = 1 - msFct(bin.mat[c(1,4,7,10,13),]$conc), -seedVal=200802256) -coverFct(bin.mat.m1, bin.mat.mis.sp3, edVec) - -## Non-parametric -bin.mat.mis.np1<-simFct2(1000, edVal = c(10, 20, 50), type = c("non-parametric"), -response = c("bin"), method = c("np"), doseVec = bin.mat[c(1,4,7,10,13),]$conc, nVec = bin.mat[c(1,4,7,10,13),]$total, -pVec = 1 - msFct(bin.mat[c(1,4,7,10,13),]$conc), -seedVal=200802257) -coverFct(bin.mat.m1, bin.mat.mis.np1, edVec) - -bin.mat.mis.np2<-simFct2(1000, edVal = c(10, 20, 50), type = c("non-parametric"), -response = c("bin"), method = c("np"), -doseVec = bin.mat[c(1,4,7,10,13),]$conc, nVec = rep(20, 5), pVec = 1 - msFct(bin.mat[c(1,4,7,10,13),]$conc), -seedVal=200802258) -coverFct(bin.mat.m1, bin.mat.mis.np2, edVec) - -bin.mat.mis.np3<-simFct2(1000, edVal = c(10, 20, 50), type = c("non-parametric"), -response = c("bin"), method = c("np"), -doseVec = bin.mat[c(1,4,7,10,13),]$conc, nVec = rep(50, 5), pVec = 1 - msFct(bin.mat[c(1,4,7,10,13),]$conc), -seedVal=200802259) -coverFct(bin.mat.m1, bin.mat.mis.np3, edVec) - - - - -## ryegrass -ryegrass.m1 <- drm(rootl~conc, data = ryegrass, fct=LL.4()) - -## Parametric -ryegrass.true.p1<-simFct2(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = LL.4(), coefVec = coef(ryegrass.m1), method = c("p"), -doseVec = unique(ryegrass$conc), resVar = summary(ryegrass.m1)$resVar, seedVal=200803031) -coverFct(ryegrass.m1, ryegrass.true.p1) - -ryegrass.true.p2<-simFct2(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = LL.4(), coefVec = coef(ryegrass.m1), method = c("p"), -doseVec = rep(unique(ryegrass$conc), rep(2, 7)), resVar = summary(ryegrass.m1)$resVar, seedVal=200803032) -coverFct(ryegrass.m1, ryegrass.true.p2) - -ryegrass.true.p3<-simFct2(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = LL.4(), coefVec = coef(ryegrass.m1), method = c("p"), -doseVec = rep(unique(ryegrass$conc), rep(3, 7)), resVar = summary(ryegrass.m1)$resVar, seedVal=200803033) -coverFct(ryegrass.m1, ryegrass.true.p3) - -## Semi-parametric - -## Tester -ryegrass.tester <- simFct(50, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = LL.4(), coefVec = coef(ryegrass.m1), method = c("sp"), -doseVec = unique(ryegrass$conc), resVar = summary(ryegrass.m1)$resVar, seedVal=200810202) - -ryegrass.true.sp1<-simFct(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = LL.4(), coefVec = coef(ryegrass.m1), method = c("sp"), -doseVec = unique(ryegrass$conc), resVar = summary(ryegrass.m1)$resVar, seedVal = 200810211) -coverFct(ryegrass.m1, ryegrass.true.sp1) - - - -dVec <- c(0, 0.12, 0.235, 0.47, unique(ryegrass$conc)[-1], 60, 120, 240, 480) -## No. replicates: 1 -ryegrass.true.sp1new<-simFct(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = LL.4(), coefVec = c(3, 0.5, 8, 60), method = c("sp"), -doseVec = dVec, resVar = 0.25, seedVal = 200810213) -coverFct(ryegrass.m1, ryegrass.true.sp1new, c(60*(10/90)^(1/3), 60*(20/80)^(1/3), 60)) - -true.sp.1<-simFct(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = LL.4(), coefVec = c(3, 0.5, 8, 60), method = c("sp"), -doseVec = dVec, resVar = 0.25, seedVal = 200810213, span = 0.75) -coverFct(NULL, true.sp.1, c(60*(10/90)^(1/3), 60*(20/80)^(1/3), 60)) - -true.sp.1a<-simFct(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = LL.4(), coefVec = c(3, 0.05, 0.8, 60), method = c("sp"), -doseVec = dVec, resVar = 0.0025, seedVal = 200810213, span = 0.75) -coverFct(NULL, true.sp.1a, c(60*(10/90)^(1/3), 60*(20/80)^(1/3), 60)) - - -## More help by fixing lower and upper limits -true.sp.1b <- simFct(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = LL.4(), coefVec = c(3, 0.5, 8, 60), method = c("sp"), -doseVec = dVec, resVar = 0.0025, seedVal = 200810213, lower = 0.5, upper = 8, span = 0.75) -coverFct(NULL, true.sp.1ab, c(60*(10/90)^(1/3), 60*(20/80)^(1/3), 60)) - -true.sp.1ab <- simFct(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = LL.4(), coefVec = c(3, 0.05, 0.8, 60), method = c("sp"), -doseVec = dVec, resVar = 0.0025, seedVal = 200810213, lower = 0.05, upper = 0.8, span = 0.75) -coverFct(NULL, true.sp.1ab, c(60*(10/90)^(1/3), 60*(20/80)^(1/3), 60)) - -true.p.1<-simFct(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = LL.4(), coefVec = c(3, 0.05, 0.8, 60), method = c("p"), -doseVec = dVec, resVar = 0.0025, seedVal = 200810191) -coverFct(NULL, true.p.1, c(60*(10/90)^(1/3), 60*(20/80)^(1/3), 60)) - -## No. replicates: 3 -ryegrass.true.sp2new<-simFct(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = LL.4(), coefVec = c(3, 0.5, 8, 60), method = c("sp"), -doseVec = rep(dVec, rep(3, 14)), resVar = 0.25, seedVal = 200810213) -coverFct(ryegrass.m1, ryegrass.true.sp2new, c(60*(10/90)^(1/3), 60*(20/80)^(1/3), 60)) - -true.sp.3<-simFct(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = LL.4(), coefVec = c(3, 0.5, 8, 60), method = c("sp"), -doseVec = rep(dVec, rep(3, 14)), resVar = 0.25, seedVal = 200811081, span = 0.75) -coverFct(NULL, true.sp.3, c(60*(10/90)^(1/3), 60*(20/80)^(1/3), 60)) - -## More help by fixing lower and upper limits -true.sp.3b <- simFct(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = LL.4(), coefVec = c(3, 0.5, 8, 60), method = c("sp"), -doseVec = rep(dVec, rep(3, 14)), resVar = 0.25, seedVal = 200811081, lower = 0.5, upper = 8, span = 0.75) -coverFct(NULL, true.sp.3b, c(60*(10/90)^(1/3), 60*(20/80)^(1/3), 60)) - -## Response between 0 and 1 -true.sp.3a<-simFct(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = LL.4(), coefVec = c(3, 0.05, 0.8, 60), method = c("sp"), -doseVec = rep(dVec, rep(3, 14)), resVar = 0.0025, seedVal = 200811081, span = 0.75) -coverFct(NULL, true.sp.3a, c(60*(10/90)^(1/3), 60*(20/80)^(1/3), 60)) - -true.sp.3ab <- simFct(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = LL.4(), coefVec = c(3, 0.05, 0.8, 60), method = c("sp"), -doseVec = rep(dVec, rep(3, 14)), resVar = 0.0025, seedVal = 200811081, lower = 0.05, upper = 0.8, span = 0.75) -coverFct(NULL, true.sp.3ab, c(60*(10/90)^(1/3), 60*(20/80)^(1/3), 60)) - -true.p.3<-simFct(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = LL.4(), coefVec = c(3, 0.05, 0.8, 60), method = c("p"), -doseVec = rep(dVec, rep(3, 14)), resVar = 0.0025, seedVal = 200810192) -coverFct(ryegrass.m1, true.p.3, c(60*(10/90)^(1/3), 60*(20/80)^(1/3), 60)) - -## No. replicates: 5 -ryegrass.true.sp3new<-simFct(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = LL.4(), coefVec = c(3, 0.5, 8, 60), method = c("sp"), -doseVec = rep(dVec, rep(5, 14)), resVar = 0.25, seedVal = 200810214) -coverFct(ryegrass.m1, ryegrass.true.sp3new, c(60*(10/90)^(1/3), 60*(20/80)^(1/3), 60)) - -true.sp5<-simFct(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = LL.4(), coefVec = c(3, 0.5, 8, 60), method = c("sp"), -doseVec = rep(dVec, rep(5, 14)), resVar = 0.25, seedVal = 200811081, span = 0.75) -coverFct(NULL, true.sp5, c(60*(10/90)^(1/3), 60*(20/80)^(1/3), 60)) - -## More help by fixing lower and upper limits -true.sp5b<-simFct(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = LL.4(), coefVec = c(3, 0.5, 8, 60), method = c("sp"), -doseVec = rep(dVec, rep(5, 14)), resVar = 0.25, seedVal = 200811081, lower = 0.5, upper = 8, span = 0.75) -coverFct(NULL, true.sp5b, c(60*(10/90)^(1/3), 60*(20/80)^(1/3), 60)) - -## Response between 0 and 1 -true.sp5a<-simFct(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = LL.4(), coefVec = c(3, 0.05, 0.8, 60), method = c("sp"), -doseVec = rep(dVec, rep(5, 14)), resVar = 0.0025, seedVal = 200811081, span = 0.75) -coverFct(NULL, true.sp5a, c(60*(10/90)^(1/3), 60*(20/80)^(1/3), 60)) - -true.sp5ab<-simFct(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = LL.4(), coefVec = c(3, 0.05, 0.8, 60), method = c("sp"), -doseVec = rep(dVec, rep(5, 14)), resVar = 0.0025, seedVal = 200811081, lower = 0.05, upper = 0.8, span = 0.75) -coverFct(NULL, true.sp5ab, c(60*(10/90)^(1/3), 60*(20/80)^(1/3), 60)) - -true.p.5<-simFct(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = LL.4(), coefVec = c(3, 0.05, 0.8, 60), method = c("p"), -doseVec = rep(dVec, rep(5, 14)), resVar = 0.0025, seedVal = 200810193) -coverFct(ryegrass.m1, true.p.5, c(60*(10/90)^(1/3), 60*(20/80)^(1/3), 60)) - - - -#misFct <- function(a, b, c, d, x0, x) -#{ -# indX <- (x < x0) -# x1 <- x[indX] -# x2 <- x[!indX] -# -# c(a + b * x1, c + d * x2) -#} -# misFct(8, -0.02, 4, -0.025, 30, c(0:13)*10) - -#misFct2 <- function(a, b, c, d, e, x0, x) -#{ -# indX1 <- (x < x0) -# indX2 <- (x >= x0) & (x < x0 + 0.025) -# indX3 <- (x >= x0 + 0.025) -# x1 <- x[indX1] -# x2 <- x[indX2] -# x3 <- x[indX3] -# -# c(a + 0 * x1, b + c * x2, d + e * x3) -#} - -## Misspecified model -#dVec2 <- c(0.06, 0.12, 0.235, 0.47, unique(ryegrass$conc)[-1], 60, 120, 240, 480) -#fVec <- misFct2(8, 4.5+3.5/0.025*0.1, -3.5/0.025, 1+3.5/499.9*500, -3.5/499.9, 0.075, dVec2) -##coverFct(NULL, mis.sp.1, c(0.080715, 0.0864285, 71.5)) -#fVec <- misFct2(8, 5+3/0.025*0.1, -3/0.025, 1+4/499.9*500, -4/499.9, 0.075, dVec2) -# -### No. replicates:1 -#mis.sp.1 <- simFct(1000, edVal = c(10, 20, 50), type = c("non-parametric"), -#response = c("con"), method = c("sp"), doseVec = rep(dVec2, rep(1, 14)), -#pVec = rep(fVec, rep(1, 14)), seedVal = 200810222, pfct = LL.4(), resVar = 0.5) -# -#coverFct(NULL, mis.sp.1, c(0.0816666, 0.0883333, 125)) -# -# -#mis.p.1 <- simFct(1000, edVal = c(10, 20, 50), type = c("non-parametric"), -#response = c("con"), method = c("p"), doseVec = rep(dVec2, rep(1, 14)), -#pVec = rep(fVec, rep(1, 14)), seedVal = 200810222, pfct = LL.4(), resVar = 0.5) -# -#coverFct(NULL, mis.p.1, c(0.0816666, 0.0883333, 125)) - - -dVec3<-seq(0, 500, length = 14) -horFct<-function(x){(8+0.1*x)/(1+(x/125)^3.5)} -fVec <- horFct(dVec3) -dVec4<-seq(0, 500, length = 50) -fVec2 <- horFct(dVec4) -dVec5<-seq(0, 500, length = 100) -fVec3 <- horFct(dVec5) - - -## No. replicates:1 -mis.sp.1ab <- simFct(1000, edVal = c(10, 20, 50), type = c("non-parametric"), -response = c("con"), method = c("sp"), doseVec = rep(dVec3, rep(1, 14)), -pVec = rep(fVec/10, rep(1, 14)), seedVal = 200710221, pfct = LL.4(), resVar = 0.01, span = 0.35, minmax = "dose") -coverFct(NULL, mis.sp.1ab, c(158.96, 169.39, 211.35)) - -## More help by fixing lower and upper limits -mis.sp.1aab <- simFct(1000, edVal = c(10, 20, 50), type = c("non-parametric"), -response = c("con"), method = c("sp"), doseVec = rep(dVec3, rep(1, 14)), -pVec = rep(fVec/10, rep(1, 14)), seedVal = 200710221, pfct = LL.4(), resVar = 0.01, span = 0.35, minmax = "dose", -lower = 0, upper = 0.8) -coverFct(NULL, mis.sp.1aab, c(158.96, 169.39, 211.35)) - -mis.p.1 <- simFct(1000, edVal = c(10, 20, 50), type = c("non-parametric"), -response = c("con"), method = c("p"), doseVec = rep(dVec3, rep(1, 14)), -pVec = rep(fVec, rep(1, 14)), seedVal = 200710222, pfct = LL.4(), resVar = 1) -coverFct(NULL, mis.p.1, c(158.96, 169.39, 211.35)) - -## No. replicates:1 - 100 doses -mis.sp.1.100a <- simFct(1000, edVal = c(10, 20, 50), type = c("non-parametric"), -response = c("con"), method = c("sp"), doseVec = rep(dVec5, rep(1, 100)), -pVec = rep(fVec3/10, rep(1, 100)), seedVal = 200811032, pfct = LL.4(), resVar = 0.01, span = 0.2, minmax = "dose", -lower = 0, upper = 0.8) -coverFct(NULL, mis.sp.1.100a, c(158.96, 169.39, 211.35)) - -mis.p.1 <- simFct(1000, edVal = c(10, 20, 50), type = c("non-parametric"), -response = c("con"), method = c("p"), doseVec = rep(dVec3, rep(1, 14)), -pVec = rep(fVec, rep(1, 14)), seedVal = 200710222, pfct = LL.4(), resVar = 1) -coverFct(NULL, mis.p.1, c(158.96, 169.39, 211.35)) - - -## No. replicates:3 -mis.sp.3a <- simFct(1000, edVal = c(10, 20, 50), type = c("non-parametric"), -response = c("con"), method = c("sp"), doseVec = rep(dVec3, rep(3, 14)), -pVec = rep(fVec/10, rep(3, 14)), seedVal = 200810216, pfct = LL.4(), resVar = 0.01, span = 0.35, minmax = "dose") -coverFct(NULL, mis.sp.3a, c(158.96, 169.39, 211.35)) - -## More help by fixing lower and upper limits -mis.sp.3ab <- simFct(1000, edVal = c(10, 20, 50), type = c("non-parametric"), -response = c("con"), method = c("sp"), doseVec = rep(dVec3, rep(3, 14)), -pVec = rep(fVec/10, rep(3, 14)), seedVal = 200810216, pfct = LL.4(), resVar = 0.01, span = 0.35, minmax = "dose", -lower = 0, upper = 0.8) -coverFct(NULL, mis.sp.3ab, c(158.96, 169.39, 211.35)) - -mis.p.3 <- simFct(1000, edVal = c(10, 20, 50), type = c("non-parametric"), -response = c("con"), method = c("p"), doseVec = rep(dVec3, rep(3, 14)), -pVec = rep(fVec/10, rep(3, 14)), seedVal = 200810227, pfct = LL.4(), resVar = 0.01) -coverFct(NULL, mis.p.3, c(158.96, 169.39, 211.35)) - -mis.sp.3.100 <- simFct(1000, edVal = c(10, 20, 50), type = c("non-parametric"), -response = c("con"), method = c("sp"), doseVec = rep(dVec5, rep(3, 100)), -pVec = rep(fVec3, rep(3, 100)), seedVal = 200811053, pfct = LL.4(), resVar = 1, span = 0.2, minmax = "dose", -lower = 0, upper = 8) -coverFct(NULL, mis.sp.3.100, c(158.96, 169.39, 211.35)) - - - -## No. replicates:5 -mis.sp.5a <- simFct(1000, edVal = c(10, 20, 50), type = c("non-parametric"), -response = c("con"), method = c("sp"), doseVec = rep(dVec3, rep(5, 14)), -pVec = rep(fVec/10, rep(5, 14)), seedVal = 200810228, pfct = LL.4(), resVar = 0.01, span = 0.35, minmax = "dose") -coverFct(NULL, mis.sp.5, c(158.96, 169.39, 211.35)) - -## More help by fixing lower and upper limits -mis.sp.5ab <- simFct(1000, edVal = c(10, 20, 50), type = c("non-parametric"), -response = c("con"), method = c("sp"), doseVec = rep(dVec3, rep(5, 14)), -pVec = rep(fVec/10, rep(5, 14)), seedVal = 200810228, pfct = LL.4(), resVar = 0.01, span = 0.35, minmax = "dose", -lower = 0, upper = 0.8) -coverFct(NULL, mis.sp.5b, c(158.96, 169.39, 211.35)) - -mis.p.5 <- simFct(1000, edVal = c(10, 20, 50), type = c("non-parametric"), -response = c("con"), method = c("p"), doseVec = rep(dVec3, rep(5, 14)), -pVec = rep(fVec/10, rep(5, 14)), seedVal = 200810229, pfct = LL.4(), resVar = 0.01) -coverFct(NULL, mis.p.5, c(158.96, 169.39, 211.35)) - - -## Figure 2 -horFct2<-function(x){horFct(x)/10} -ll4Fct<-function(x){(0.5+(8-0.5)/(1+(x/60)^3))/10} -curve(ll4Fct, xlim=c(0, 500), ylim=c(0, 1.4), xlab="Dose", ylab="Response", lwd=2) -curve(horFct2, xlim=c(0, 500), add=TRUE, lty=2, lwd=2) - - - - - - -ryegrass.true.sp2<-simFct(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = LL.4(), coefVec = coef(ryegrass.m1), method = c("sp"), -doseVec = rep(unique(ryegrass$conc), rep(2, 7)), resVar = summary(ryegrass.m1)$resVar, seedVal = 200810212) -coverFct(ryegrass.m1, ryegrass.true.sp2) - -ryegrass.true.sp3<-simFct(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = LL.4(), coefVec = coef(ryegrass.m1), method = c("sp"), -doseVec = rep(unique(ryegrass$conc), rep(3, 7)), resVar = summary(ryegrass.m1)$resVar, seedVal = 200810206) -coverFct(ryegrass.m1, ryegrass.true.sp3) - -ryegrass.true.sp5<-simFct(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = LL.4(), coefVec = coef(ryegrass.m1), method = c("sp"), -doseVec = rep(unique(ryegrass$conc), rep(5, 7)), resVar = summary(ryegrass.m1)$resVar, seedVal = 200810207) -coverFct(ryegrass.m1, ryegrass.true.sp5) - - -## Non-parametric -ryegrass.true.np1<-simFct2(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = LL.4(), coefVec = coef(ryegrass.m1), method = c("np"), -doseVec = unique(ryegrass$conc), resVar = summary(ryegrass.m1)$resVar, seedVal=200803037) -coverFct(ryegrass.m1, ryegrass.true.np1) - -ryegrass.true.np2<-simFct2(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = LL.4(), coefVec = coef(ryegrass.m1), method = c("np"), -doseVec = rep(unique(ryegrass$conc), rep(2, 7)), resVar = summary(ryegrass.m1)$resVar, seedVal=200803038) -coverFct(ryegrass.m1, ryegrass.true.np2) - -ryegrass.true.np3<-simFct2(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = LL.4(), coefVec = coef(ryegrass.m1), method = c("np"), -doseVec = rep(unique(ryegrass$conc), rep(3, 7)), resVar = summary(ryegrass.m1)$resVar, seedVal=200803039) -coverFct(ryegrass.m1, ryegrass.true.np3) - -## Under misspecification -lettuce.m1 <- drm(weight ~ conc, data = lettuce, fct = LL.3()) -lettuce.m2 <- drm(weight ~ conc, data = lettuce, fct = BC.4()) - -## Parametric -lettuce.mis.p1<-simFct2(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = BC.4(), coefVec = coef(lettuce.m2), method = c("p"), -doseVec = unique(lettuce$conc), resVar = summary(lettuce.m2)$resVar, pfct = LL.3(), seedVal=200803041) -coverFct(lettuce.m2, lettuce.mis.p1) - -lettuce.mis.p2<-simFct2(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = BC.4(), coefVec = coef(lettuce.m2), method = c("p"), -doseVec = rep(unique(lettuce$conc), rep(2, 7)), resVar = summary(lettuce.m2)$resVar, pfct = LL.3(), seedVal=200803042) -coverFct(lettuce.m2, lettuce.mis.p2) - -lettuce.mis.p3<-simFct2(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = BC.4(), coefVec = coef(lettuce.m2), method = c("p"), -doseVec = rep(unique(lettuce$conc), rep(3, 7)), resVar = summary(lettuce.m2)$resVar, pfct = LL.3(), seedVal=200803043) -coverFct(lettuce.m2, lettuce.mis.p3) - -## Semi-parametric -lettuce.mis.sp1<-simFct2(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = BC.4(), coefVec = coef(lettuce.m2), method = c("sp"), -doseVec = unique(lettuce$conc), resVar = summary(lettuce.m2)$resVar, pfct = LL.3(), reference = 0, seedVal=200803044) -coverFct(lettuce.m2, lettuce.mis.sp1) - -lettuce.mis.sp2<-simFct2(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = BC.4(), coefVec = coef(lettuce.m2), method = c("sp"), -doseVec = rep(unique(lettuce$conc), rep(2, 7)), resVar = summary(lettuce.m2)$resVar, pfct = LL.3(), -reference = 0, seedVal=200803045) -coverFct(lettuce.m2, lettuce.mis.sp2) - -lettuce.mis.sp3<-simFct2(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = BC.4(), coefVec = coef(lettuce.m2), method = c("sp"), -doseVec = rep(unique(lettuce$conc), rep(3, 7)), resVar = summary(lettuce.m2)$resVar, pfct = LL.3(), -reference = 0, seedVal=200803046) -coverFct(lettuce.m2, lettuce.mis.sp3) - -## Non-parametric -lettuce.mis.np1<-simFct2(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = BC.4(), coefVec = coef(lettuce.m2), method = c("np"), -doseVec = unique(lettuce$conc), resVar = summary(lettuce.m2)$resVar, pfct = LL.3(), seedVal=200803047) -coverFct(lettuce.m2, lettuce.mis.np1) - -lettuce.mis.np2<-simFct2(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = BC.4(), coefVec = coef(lettuce.m2), method = c("np"), -doseVec = rep(unique(lettuce$conc), rep(2, 7)), resVar = summary(lettuce.m2)$resVar, pfct = LL.3(), seedVal=200803048) -coverFct(lettuce.m2, lettuce.mis.np2) - -lettuce.mis.np3<-simFct2(1000, edVal = c(10, 20, 50), type = c("parametric"), -response = c("con"), fct = BC.4(), coefVec = coef(lettuce.m2), method = c("np"), -doseVec = rep(unique(lettuce$conc), rep(3, 7)), resVar = summary(lettuce.m2)$resVar, pfct = LL.3(), seedVal=200803049) -coverFct(lettuce.m2, lettuce.mis.np3) - -## Comparison of parametric and semi-parametric models - -## Under the true model -exp.a.m1<-drm(y~x, data=exp.a, fct=LL.4()) - -true.aic.sp1<-true.sp1<-simFct2(1000, edVal = c(50), type = c("parametric"), -response = c("con"), fct = LL.4(), coefVec = coef(exp.a.m1), method = c("sp"), -doseVec = unique(exp.a$x), seedVal=200805052, resVar = summary(exp.a.m1)$resVar, aic = TRUE) -true.aic.sp1$aic - -true.aic.p1<-true.p1<-simFct2(1000, edVal = c(50), type = c("parametric"), -response = c("con"), fct = LL.4(), coefVec = coef(exp.a.m1), method = c("p"), -doseVec = unique(exp.a$x), seedVal=200805052, resVar = summary(exp.a.m1)$resVar, aic = TRUE) -true.aic.p1$aic - -## Under misspecification -mis.aic.sp1<-simFct2(1000, edVal = c(50), type = c("parametric"), -response = c("con"), fct = BC.4(), coefVec = coef(lettuce.m2), method = c("sp"), -doseVec = seq(min(uniVec<-unique(lettuce$conc)), max(uniVec), length.out=14), resVar = summary(lettuce.m2)$resVar, pfct = LL.3(), reference = 0, -seedVal=200805053, aic = TRUE) -mis.aic.sp1$aic - -mis.aic.p1<-simFct2(1000, edVal = c(50), type = c("parametric"), -response = c("con"), fct = BC.4(), coefVec = coef(lettuce.m2), method = c("p"), -doseVec = seq(min(uniVec<-unique(lettuce$conc)), max(uniVec), length.out=14), resVar = summary(lettuce.m2)$resVar, pfct = LL.3(), reference = 0, -seedVal=200805053, aic = TRUE) -mis.aic.p1$aic -plot(mis.aic.p1$aic-(mis.aic.sp1$aic+2)) - - -## Testing area -mr.test <- mrdrm(bin.mat[c(1,4,7,10,13),]$conc, c(12, 5, 4, 2, 0)/bin.mat[c(1,4,7,10,13),]$total, -bin.mat[c(1,4,7,10,13),]$total, -type = "bin", fct = LL.2(), respLev = c(10, 20, 50), reference = NULL, level = 0.95, robust = FALSE, -mixVec = seq(0, 1, by = 0.05), logex = TRUE, bwLower = 0) - -mr.test1 <- mrdrm(lettuce$conc, lettuce$weight, -type = "con", fct = LL.3(), respLev = c(10, 20, 50), reference = 0, level = 0.95, robust = FALSE, -mixVec = seq(0, 1, by = 0.05), bwLower = 0, logex = TRUE) -mr.test1$edMat -mr.test1$mixing -plotmr(mr.test1) - - -mr.test2 <- mrdrm(lettuce$conc, lettuce$weight, -type = "con", fct = LL.3(), respLev = c(10, 20, 50), reference = 0, level = 0.95, robust = TRUE, -mixVec = seq(0, 1, by = 0.05), bwLower = 0, logex = TRUE) -mr.test2$edMat -mr.test2$mixing -plotmr(mr.test2) - -mr.test3 <- mrdrm(lettuce$conc, lettuce$weight, -type = "con", fct = BC.4(), respLev = c(10, 20, 50), reference = 0, level = 0.95, robust = FALSE, -mixVec = seq(0, 1, by = 0.05), bwLower = 0, logex = TRUE) -mr.test3$edMat -mr.test3$mixing -plotmr(mr.test3) - - - -simres<-simFct1(1000, 50) -edMat <- ED(deguelin.m1, c(10, 20, 50), reference="control")[, 1] - -## Cannot be estimated -#sum(simres$edArray[2,,1] > edMat[1]) -#sum(simres$edArray[3,,1] < edMat[1]) -#sum(simres$edArray[2,,2] > edMat[2]) -#sum(simres$edArray[3,,2] < edMat[2]) - -sum(simres$edArray[2,,1] > edMat[3]) -sum(simres$edArray[3,,1] < edMat[3]) - -mean(simres$edArray[1,,1]) -mean(apply(simres$edArray[2:3,,1], 2, diff)) - -## Simulations based on the design and probabilities modified from the dataset 'deguelin' -simres2<-simFct1(1000, design="moddeguelin", type="parametric", seedVal=20080103) - -sum(simres2$edArray[2,,3] > 9.8228) -sum(simres2$edArray[3,,3] < 9.8228) - -sum(simres2$edArray[2,,2] > 4.7186) -sum(simres2$edArray[3,,2] < 4.7186) - -sum(simres2$edArray[2,,1] > 3.0729) -sum(simres2$edArray[3,,1] < 3.0729) - -mean(simres2$edArray[1,,1]) -mean(simres2$edArray[1,,2]) -mean(simres2$edArray[1,,3]) - -mean(apply(simres2$edArray[2:3,,3], 2, diff)) -mean(apply(simres2$edArray[2:3,,2], 2, diff)) -mean(apply(simres2$edArray[2:3,,1], 2, diff)) - - - tempModel1 <- SP.mrr( - formula = deguelin$r/deguelin$n ~ log(deguelin$dose), - cases=deguelin$n, - NP.control=NP.control.lr.wls( - response.type="bin", - optim="bandwidth.grid", - weight.function="gaus", - bandwidth.type="fixed.width", - bandwidth=seq(0.3,1.0,by=0.05) - ), - P.control=P.control.glm.binomial.ml( - link="logit" - ), - SP.control=SP.control.mrr( - response.type="bin", - optim="mixing.grid", - mixing=seq(0,1,by=0.05) - )) - - tempModel2 <- SP.mrr( - formula = c(1, deguelin$r)/c(49, deguelin$n) ~ log(c(1, deguelin$dose)), - cases=c(49, deguelin$n), - NP.control=NP.control.lr.wls( - response.type="bin", - optim="bandwidth.grid", - weight.function="gaus", - bandwidth.type="fixed.width", - bandwidth=seq(0.3,1.0,by=0.05) - ), - P.control=P.control.glm.binomial.ml( - link="logit" - ), - SP.control=SP.control.mrr( - response.type="bin", - optim="mixing.grid", - mixing=seq(0,1,by=0.05) - )) - - m1<-drm(c(1, deguelin$r)/c(49, deguelin$n) ~ c(1, deguelin$dose), - weights = c(49, deguelin$n), fct=LL.2(), type="binomial") - - plot(c(1,deguelin$dose), predict(m1)[,1], type="l") - lines(c(1,deguelin$dose), predict(m1)[,1]+predict(m1)[,2]*1.96, lty=2) - lines(c(1,deguelin$dose), predict(m1)[,1]-predict(m1)[,2]*1.96, lty=2) - abline(h=0.5, lty=3) - - m2<-glm(c(1, deguelin$r)/c(48, deguelin$n) ~ log(c(1, deguelin$dose)), - weights = c(48, deguelin$n), family=binomial) -} diff --git a/R/summary.drc.R b/R/summary.drc.R index 43c5fb58..5c14844f 100644 --- a/R/summary.drc.R +++ b/R/summary.drc.R @@ -1,202 +1,108 @@ -"summary.drc" <- -function(object, od = FALSE, pool = TRUE, ...) -{ - ## Producing a summary of a model fit -# sumVec1 <- object$fit # object[[2]] -# sumVec2 <- object$summary # object[[4]] -# parNames <- object$"parNames"[[1]] # object[[6]] - - ## Calculating variance-covariance matrix from Hessian -# em <- object$"estMethod" -# parVec <- (em$parmfct)(object$fit, fixed = FALSE) - parVec <- as.vector(coef(object)) -# notNA <- !is.na(parVec) -# varMat <- (object$"scaleFct")( (em$vcovfct)(object) ) - varMat <- vcov(object, od = od, pool = pool) - - ## Calculating estimated residual variance - ## and unscaled variance-covariance matrix -# if (!is.null(em$rvfct)) -# { -# resVar <- (em$rvfct)(object) -# } else { -# resVar <- NULL -# } - resVar <- rse(object, TRUE) - if (!is.null(resVar)) - { - varMat.us <- varMat / (2*resVar) - } else { - varMat.us <- NULL - } - - ## Calculating the residual standard error(s) - if ((!is.null(object$"objList")) && (!pool)) - { - objList <- object$"objList" - lenol <- length(objList) - - rseMat <- matrix(NA, lenol, 2) - rownames(rseMat) <- names(objList) - resVar <- as.vector(unlist(lapply(objList, rse, resvar = TRUE))) - rseMat[, 1] <- sqrt(resVar) # only to keep resVar - rseMat[, 2] <- as.vector(unlist(lapply(objList, df.residual))) - } else { - resVar <- rse(object, TRUE) - - rseMat <- matrix(NA, 1, 2) - rownames(rseMat) <- "" - rseMat[1, 1] <- sqrt(resVar) - rseMat[1, 2] <- df.residual(object) - } - colnames(rseMat) <- c("rse", "df") - -# ## Adjusting for over-dispersion using the Pearson statistic -# if (od && (!is.null(object$"gofTest"))) -# { -# varMat <- varMat*(object$"gofTest"[1]/object$"gofTest"[2]) -# } - estSE <- sqrt(diag(varMat)) - - ## Calculating estimated standard errors for robust methods - - ## M-estimators - if (!is.null(object$robust) && object$robust%in%c("metric trimming", "metric Winsorizing", "Tukey's biweight")) - { - psi.trimmed <- function(u, deriv = 0) - { - if (deriv == 0) - { - retVec <- u - retVec[ abs(u) > 1.345 ] <- 0 - } - if (deriv == 1) - { - retVec <- rep(1, length(u)) - retVec[ abs(u) > 1.345 ] <- 0 - } - return(retVec) - } - - if (object$robust=="Tukey's biweight") - { - psifct <- psi.bisquare # in MASS - } - if (object$robust=="metric Winsorizing") - { - psifct <- psi.huber # in MASS - } - if (object$robust=="metric trimming") - { - psifct <- psi.trimmed - } - - if (FALSE) - { -# resVec <- residuals(object) - resVec <- (object)[["predres"]][, "Residuals"] - psiprime <- psifct(resVec/sqrt(resVar), deriv = 1) - meanpp <- mean(psiprime) - - notNA <- !is.na(parVec) - sumVec1 <- object$fit - -# K <- 1 + length(parVec[notNA])*var(psiprime)/(object$summary[7]*meanpp^2) - - nVal <- object[["sumList"]][["lenData"]] - dfVal <- object[["sumList"]][["df.residual"]] - - pVal <- nVal - dfVal - K <- 1 + pVal * var(psiprime) / (nVal * meanpp^2) - w <- psifct(resVec/sqrt(resVar)) -# s <- sum((resVec*w)^2)/object$summary[6] - s <- sum((resVec*w)^2) / dfVal - print(c(K, resVar, s, mean(psiprime)^2, mean(w^2))) - -# print(parVec[notNA]) -# print(var(psiprime)) -# print(c(K,w,s)) - stddev <- sqrt(s) * (K / meanpp) -# invXXt <- solve(sumVec1$hessian[notNA, notNA] / mean(psiprime) * resVar) - invXXt <- solve(sumVec1$hessian[notNA, notNA]) * (mean(psiprime) / resVar) - estSE <- sqrt(diag(invXXt)) * stddev - # formulas (6.5) (6.14) in Huber: Robust Statistics? - } # end of FALSE - -# objDer <- object[["deriv"]] -# if ( (!is.null(objDer)) && (!observed) ) -# { -# estSE <- sqrt(resVar * (sum(w^2)/(nVal - dfVal) / mean(psiprime)^2) * diag(solve(t(objDer) %*% objDer)) ) -# # formula (6.5) in Huber: Robust Statistics -# } else { - # Observed information-type of variance-covariance matrix -# estSE <- sqrt(resVar * diag(solve(object[["fit"]][["hessian"]]))) -# } - # Observed "information"-type of variance-covariance matrix - estSE <- sqrt(resVar * diag(solve(object[["fit"]][["hessian"]]))) - -# resVec <- (object)[["predres"]][, "Residuals"] -# psiprime <- psifct(resVec/sqrt(resVar), deriv = 1) -# w <- psifct(resVec/sqrt(resVar)) -# K <- mean(w^2) / (mean(psiprime)^2) -# estSE <- sqrt(resVar * K * diag(solve(object[["fit"]][["hessian"]]))) -# - } - - - ## Forming a matrix of results -# resultMat <- matrix(0, sum(notNA), 4, dimnames = list(parNames, c("Estimate", "Std. Error", "t-value", "p-value"))) -# resultMat[, 1] <- parVec[notNA] - - parNames <- object$"parNames"[[1]] - resultMat <- matrix(NA, length(parVec), 4, - dimnames = list(parNames, c("Estimate", "Std. Error", "t-value", "p-value"))) - - resultMat[, 1] <- parVec - resultMat[, 2] <- estSE - tempStat <- resultMat[, 1] / resultMat[, 2] - resultMat[, 3] <- tempStat - - ## Using t-distribution for continuous data - ## only under the normality assumption - if (object$"type" == "continuous") - { - pFct <- function(x) {pt(x, df.residual(object))} - } else { - pFct <- pnorm - } - resultMat[, 4] <- pFct(-abs(tempStat)) + (1 - pFct(abs(tempStat))) - - ## Separating out variance parameters -if (FALSE) -{ - if (!is.null(object$"varParm")) - { - indexVec <- object$"varParm"$"index" - varParm <- object$"varParm" - - estVec <- resultMat[-indexVec, , drop = FALSE] - if (object$"varParm"$"type" == "varPower") - { - estVec[2, 3] <- (estVec[2, 1] - 0)/estVec[2, 2] # testing the hypothesis theta=0 - estVec[2, 4] <- 2*pt(-abs(estVec[2, 3]), df.residual(object)) - } - varParm$"estimates" <- estVec - - resultMat <- resultMat[indexVec,] - varMat <- varMat[indexVec, indexVec] # for use in ED/MAX/SI - } else { - varParm <- NULL - } -} - - fctName <- deparse(object$call$fct) - - sumObj <- list(resVar, varMat, resultMat, object$"boxcox", fctName, object$"robust", NULL, object$"type", - df.residual(object), varMat.us, object$"fct"$"text", object$"fct"$"noParm", rseMat) - names(sumObj) <- c("resVar", "varMat", "coefficients", "boxcox", "fctName", "robust", "varParm", "type", - "df.residual", "cov.unscaled", "text", "noParm", "rseMat") - - class(sumObj) <- c("summary.drc") - return(sumObj) -} +#' @title Summarising non-linear model fits +#' +#' @description +#' \code{summary} compiles a comprehensive summary for objects of class 'drc'. +#' +#' @param object an object of class 'drc'. +#' @param od logical. If TRUE adjustment for over-dispersion is used. +#' @param pool logical. If TRUE curves are pooled. Otherwise they are not. This +#' argument only works for models with independently fitted curves as +#' specified in \code{\link{drm}}. +#' @param ... additional arguments. +#' +#' @return A list of summary statistics that includes parameter estimates and +#' estimated standard errors. +#' +#' @seealso \code{\link{drm}}, \code{\link{coef.drc}}, \code{\link{confint.drc}} +#' +#' @examples +#' ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +#' summary(ryegrass.m1) +#' +#' @author Christian Ritz +#' +#' @keywords models nonlinear +"summary.drc" <- +function(object, od = FALSE, pool = TRUE, ...) +{ + ## Calculating variance-covariance matrix from Hessian + parVec <- as.vector(coef(object)) + varMat <- vcov(object, od = od, pool = pool) + + ## Calculating estimated residual variance + ## and unscaled variance-covariance matrix + resVar <- rse(object, TRUE) + if (!is.na(resVar)) + { + varMat.us <- varMat / (2*resVar) + } else { + varMat.us <- NULL + } + + ## Calculating the residual standard error(s) + if ((!is.null(object$"objList")) && (!pool)) + { + objList <- object$"objList" + lenol <- length(objList) + + rseMat <- matrix(NA, lenol, 2) + rownames(rseMat) <- names(objList) + resVarVec <- as.vector(unlist(lapply(objList, rse, resvar = TRUE))) + rseMat[, 1] <- sqrt(resVarVec) + rseMat[, 2] <- as.vector(unlist(lapply(objList, df.residual))) + } else { + resVar <- rse(object, TRUE) + + rseMat <- matrix(NA, 1, 2) + rownames(rseMat) <- "" + rseMat[1, 1] <- sqrt(resVar) + rseMat[1, 2] <- df.residual(object) + } + colnames(rseMat) <- c("rse", "df") + + diagVar <- diag(varMat) + estSE <- numeric(length(diagVar)) + validVar <- diagVar >= 0 + estSE[validVar] <- sqrt(diagVar[validVar]) + estSE[!validVar] <- NaN + + ## Calculating estimated standard errors for robust methods + + ## M-estimators + if (!is.null(object$robust) && object$robust%in%c("metric trimming", "metric Winsorizing", "Tukey's biweight")) + { + # Observed "information"-type of variance-covariance matrix + estSE <- sqrt(resVar * diag(solve(object[["fit"]][["hessian"]]))) + } + + + ## Forming a matrix of results + parNames <- object$"parNames"[[1]] + resultMat <- matrix(NA, length(parVec), 4, + dimnames = list(parNames, c("Estimate", "Std. Error", "t-value", "p-value"))) + + resultMat[, 1] <- parVec + resultMat[, 2] <- estSE + tempStat <- resultMat[, 1] / resultMat[, 2] + resultMat[, 3] <- tempStat + + ## Using t-distribution for continuous data + ## only under the normality assumption + if (object$"type" == "continuous") + { + pFct <- function(x) {pt(x, df.residual(object))} + } else { + pFct <- pnorm + } + resultMat[, 4] <- pFct(-abs(tempStat)) + (1 - pFct(abs(tempStat))) + + fctName <- deparse(object$call$fct) + + sumObj <- list(resVar, varMat, resultMat, object$"boxcox", fctName, object$"robust", NULL, object$"type", + df.residual(object), varMat.us, object$"fct"$"text", object$"fct"$"noParm", rseMat) + names(sumObj) <- c("resVar", "varMat", "coefficients", "boxcox", "fctName", "robust", "varParm", "type", + "df.residual", "cov.unscaled", "text", "noParm", "rseMat") + + class(sumObj) <- c("summary.drc") + return(sumObj) +} diff --git a/R/threephase.R b/R/threephase.R index 43fce15e..3c6cfcf2 100644 --- a/R/threephase.R +++ b/R/threephase.R @@ -1,3 +1,29 @@ +#' Three-Phase Dose-Response Model +#' +#' A ten-parameter dose-response model combining three log-logistic components, +#' extending the two-phase model (\code{\link{twophase}}) for describing even more +#' complex dose-response patterns. +#' +#' The model function is the sum of a four-parameter log-logistic model and two +#' three-parameter log-logistic models: +#' +#' \deqn{f(x) = \mathrm{LL.4}(x; b1, c1, d1, e1) + \mathrm{LL.3}(x; b2, d2, e2) + \mathrm{LL.3}(x; b3, d3, e3)} +#' +#' @param fixed numeric vector specifying which parameters are fixed and at what value +#' they are fixed. NAs are used for parameters that are not fixed. +#' @param names a vector of character strings giving the names of the parameters +#' (should not contain ":"). The default is reasonable. +#' @param fctName optional character string used internally by convenience functions. +#' @param fctText optional character string used internally by convenience functions. +#' +#' @return A list containing the nonlinear function, the self starter function, +#' and the parameter names. +#' +#' @author Christian Ritz +#' +#' @seealso \code{\link{twophase}}, \code{\link{llogistic}} +#' +#' @keywords models nonlinear "threephase" <- function( fixed = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), names = c("b1", "c1", "d1", "e1", "b2", "d2", "e2", "b3", "d3", "e3"), @@ -16,30 +42,17 @@ fctName, fctText) ## Defining the non-linear function fct <- function(dose, parm) { -# print("A") parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE) -# print(notFixed) -# print(parm) -# print(parmMat[, notFixed]) parmMat[, notFixed] <- parm -# print("B") -# LL.4(fixed[1:4])$fct(dose, parmMat[, 1:4]) + LL.3(fixed[5:7])$fct(dose, parmMat[, 5:7]) -# fixed1.4 <- fixed[1:4] -# fixed5.7 <- fixed[5:7] {LL.4()$fct(dose, parmMat[, 1:4, drop = FALSE]) + LL.3()$fct(dose, parmMat[, 5:7, drop = FALSE]) + LL.3()$fct(dose, parmMat[, 8:10, drop = FALSE])} } ## Defining self starter function ssfct <- function(dframe) { -# first4 <- drc:::llogistic.ssf(fixed = fixed[1:4])(dframe) # drc::: not need -# first4 <- drc:::llogistic.ssf(fixed = c(NA, NA, NA, NA, 1))(dframe) first4 <- llogistic.ssf(fixed = c(NA, NA, NA, NA, 1))(dframe) -# print(c(first4[1:2], first4[3]/2, first4[4]/3, first4[1], first4[3]/2, first4[4])[is.na(fixed)]) - -# c(first4[1:2], first4[3]/2, first4[4]/3, first4[1], first4[3]/2, first4[4])[is.na(fixed)] c(first4[1:2], first4[3]/3, first4[4]/3, first4[1], first4[3]*(2/3), first4[4]*(2/3), first4[1], first4[3], first4[4])[is.na(fixed)] } diff --git a/R/twophase.r b/R/twophase.R similarity index 52% rename from R/twophase.r rename to R/twophase.R index f0eb73b1..ad284ffb 100644 --- a/R/twophase.r +++ b/R/twophase.R @@ -1,3 +1,36 @@ +#' Two-Phase Dose-Response Model +#' +#' A seven-parameter dose-response model combining two log-logistic components, +#' useful for describing more complex dose-response patterns. +#' +#' Following Groot \emph{et al} (1996) the two-phase model function is: +#' +#' \deqn{f(x) = c + \frac{d1-c}{1+\exp(b1(\log(x)-\log(e1)))} + \frac{d2}{1+\exp(b2(\log(x)-\log(e2)))}} +#' +#' For each of the two phases, the parameters have the same interpretation as in +#' the ordinary log-logistic model. +#' +#' @param fixed numeric vector specifying which parameters are fixed and at what value +#' they are fixed. NAs are used for parameters that are not fixed. +#' @param names a vector of character strings giving the names of the parameters +#' (should not contain ":"). The default is reasonable. +#' @param fctName optional character string used internally by convenience functions. +#' @param fctText optional character string used internally by convenience functions. +#' +#' @return A list containing the nonlinear function, the self starter function, +#' and the parameter names. +#' +#' @references Groot, J. C. J., Cone, J. W., Williams, B. A., Debersaques, F. M. A., +#' Lantinga, E. A. (1996) Multiphasic analysis of gas production kinetics for +#' in vitro fermentation of ruminant feeds, +#' \emph{Animal Feed Science Technology}, \bold{64}, 77--89. +#' +#' @author Christian Ritz +#' +#' @seealso The basic component in the two-phase model is the log-logistic model +#' \code{\link{llogistic}}. +#' +#' @keywords models nonlinear "twophase" <- function( fixed = c(NA, NA, NA, NA, NA, NA, NA), names = c("b1", "c1", "d1", "e1", "b2", "d2", "e2"), fctName, fctText) @@ -15,30 +48,19 @@ fctName, fctText) ## Defining the non-linear function fct <- function(dose, parm) { -# print("A") parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE) -# print(notFixed) -# print(parm) -# print(parmMat[, notFixed]) parmMat[, notFixed] <- parm -# print("B") -# LL.4(fixed[1:4])$fct(dose, parmMat[, 1:4]) + LL.3(fixed[5:7])$fct(dose, parmMat[, 5:7]) fixed1.4 <- fixed[1:4] - fixed5.7 <- fixed[5:7] + fixed5.7 <- fixed[5:7] LL.4()$fct(dose, parmMat[, 1:4, drop = FALSE]) + LL.3()$fct(dose, parmMat[, 5:7, drop = FALSE]) } ## Defining self starter function ssfct <- function(dframe) { -# first4 <- drc:::llogistic.ssf(fixed = fixed[1:4])(dframe) # drc::: not need -# first4 <- drc:::llogistic.ssf(fixed = c(NA, NA, NA, NA, 1))(dframe) first4 <- llogistic.ssf(fixed = c(NA, NA, NA, NA, 1))(dframe) -# print(c(first4[1:2], first4[3]/2, first4[4]/3, first4[1], first4[3]/2, first4[4])[is.na(fixed)]) - -# c(first4[1:2], first4[3]/2, first4[4]/3, first4[1], first4[3]/2, first4[4])[is.na(fixed)] c(first4[1:2], first4[3]/2, first4[4]/3, first4[1], first4[3], first4[4])[is.na(fixed)] } diff --git a/R/ucedergreen.R b/R/ucedergreen.R index 63a13fc4..2051dfb6 100644 --- a/R/ucedergreen.R +++ b/R/ucedergreen.R @@ -1,24 +1,68 @@ +#' @title U-shaped Cedergreen-Ritz-Streibig model +#' +#' @description +#' \code{ucedergreen} provides a very general way of specifying the Cedergreen-Ritz-Streibig +#' modified log-logistic model for describing u-shaped hormesis, under various constraints on the parameters. +#' +#' @param fixed A numeric vector of length 5 specifying any parameters to be held fixed +#' during the estimation. The order is \code{c(b, c, d, e, f)}. Use \code{NA} for +#' parameters that should be estimated. The default is to estimate all parameters. +#' @param names A character vector of length 5 providing names for the parameters. +#' The default is \code{c("b", "c", "d", "e", "f")}. +#' @param method A character string specifying the method for the self-starter function +#' to use for finding initial parameter values. Options are \code{"loglinear"}, +#' \code{"anke"}, \code{"method3"}, and \code{"normolle"}. This is only used if \code{ssfct} is \code{NULL}. +#' @param ssfct A custom self-starter function. If \code{NULL} (the default), a +#' self-starter is automatically generated by calling \code{\link{cedergreen.ssf}} +#' with the specified \code{method}, \code{fixed}, and \code{alpha} arguments. +#' @param alpha A mandatory numeric value specifying the fixed shape parameter \eqn{\alpha}. +#' The function will stop if this is not provided. +#' @param fctName An optional character string to name the function object. +#' @param fctText An optional character string providing a descriptive text for the model. +#' +#' @details +#' The u-shaped model is given by the expression +#' \deqn{f(x) = c + d - \frac{d-c+f \exp(-1/x^{\alpha})}{1+\exp(b(\log(x)-\log(e)))}} +#' +#' @return A list of class \code{"UCRS"}, containing the model function (\code{fct}), +#' the self-starter function (\code{ssfct}), parameter names (\code{names}), and other +#' components required for use with modeling functions like \code{\link[drc]{drm}}. +#' +#' @references +#' Cedergreen, N. and Ritz, C. and Streibig, J. C. (2005) +#' Improved empirical models describing hormesis, +#' \emph{Environmental Toxicology and Chemistry} \bold{24}, 3166--3172. +#' +#' @author Christian Ritz, Hannes Reinwald +#' +#' @seealso \code{\link{cedergreen}}, \code{\link{UCRS.4a}}, \code{\link{UCRS.5a}}, \code{\link{drm}} +#' +#' @keywords models nonlinear "ucedergreen" <- function( -fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), -method = c("1", "2", "3", "4"), ssfct = NULL, -alpha) -{ + fixed = c(NA, NA, NA, NA, NA), + names = c("b", "c", "d", "e", "f"), + method = c("loglinear", "anke", "method3", "normolle"), + ssfct = NULL, + alpha, + fctName, + fctText +){ + ## Checking arguments and setting up fixed parameter logic numParm <- 5 - if (!is.character(names) | !(length(names) == numParm)) {stop("Not correct 'names' argument")} - if (!(length(fixed) == numParm)) {stop("Not correct 'fixed' argument")} - -# if (!is.logical(useD)) {stop("Not logical useD argument")} -# if (useD) {stop("Derivatives not available")} - + if (!is.character(names) || !(length(names) == numParm)) {stop("Not correct 'names' argument")} + if (!(length(fixed) == numParm)) {stop("Not correct 'fixed' argument")} if (missing(alpha)) {stop("'alpha' argument must be specified")} + # Determine if fixed parameters are being used. This will be passed to ssfct. + useFixed <- !all(is.na(fixed)) + + # Match the method argument + method <- match.arg(method) notFixed <- is.na(fixed) - parmVec <- rep(0, numParm) + parmVec <- rep(0, numParm) parmVec[!notFixed] <- fixed[!notFixed] - parmVec1 <- parmVec - parmVec2 <- parmVec - ## Defining the function + ## Defining the non-linear function fct <- function(dose, parm) { parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE) @@ -26,57 +70,29 @@ alpha) numTerm <- parmMat[, 3] - parmMat[, 2] + parmMat[, 5]*exp(-1/dose^alpha) denTerm <- 1 + exp(parmMat[, 1]*(log(dose) - log(parmMat[, 4]))) - parmMat[, 3] - numTerm/denTerm + # U-shaped model: f(x) = c + d - numTerm/denTerm + parmMat[, 2] + parmMat[, 3] - numTerm/denTerm } - ## Defining self starter function - if (!is.null(ssfct)) - { - ssfct <- ssfct - } else { - ssfct <- function(dframe) - { - initval <- llogistic()$ssfct(dframe) - initval[1] <- -initval[1] - initval[5] <- 0 # better solution? - - return(initval[notFixed]) + ## --- Correctly defining the self-starter --- + # If a custom self-starter is not provided, use our robust cedergreen.ssf + if (is.null(ssfct)) { + # Delegate to the external self-starter, passing method, fixed, alpha, and useFixed. + ssfct_inner <- cedergreen.ssf(method = method, fixed = fixed, alpha = alpha, useFixed = useFixed) + ssfct <- function(dframe) { + initval <- ssfct_inner(dframe) + # For U-shaped model, negate the b parameter if it's not fixed + if (is.na(fixed[1])) { + initval[1] <- -initval[1] + } + return(initval) } - } - -# ## Setting the names of the parameters -# names <- names[notFixed] - - -# ## Defining parameter to be scaled -# if ( (scaleDose) && (is.na(fixed[4])) ) -# { -# scaleInd <- sum(is.na(fixed[1:4])) -# } else { -# scaleInd <- NULL -# } - - - ## Defining derivatives - -# ## Constructing a helper function -# xlogx <- function(x, p) -# { -# lv <- (x < 1e-12) -# nlv <- !lv -# -# rv <- rep(0, length(x)) -# -# xlv <- x[lv] -# rv[lv] <- log(xlv^(xlv^p[lv])) -# -# xnlv <- x[nlv] -# rv[nlv] <- (xnlv^p[nlv])*log(xnlv) -# -# rv -# } - - ## Specifying the derivatives + } + + ## Defining names for the parameters to be estimated + names <- names[notFixed] + + ## Specifying the derivatives deriv1 <- function(dose, parm) { parmMat <- matrix(parmVec, nrow(parm), numParm, byrow=TRUE) @@ -85,117 +101,235 @@ alpha) t0 <- exp(-1/(dose^alpha)) t1 <- parmMat[, 3] - parmMat[, 2] + parmMat[, 5]*t0 t2 <- exp(parmMat[, 1]*(log(dose) - log(parmMat[, 4]))) - t3 <- 1 + t2 + t3 <- 1 + t2 t4 <- (1 + t2)^(-2) - cbind( t1*xlogx(dose/parmMat[, 4], parmMat[, 1])*t4, - 1/t3, - 1 - 1/t3, - -t1*t2*(parmMat[, 1]/parmMat[, 4])*t4, + cbind( t1*xlogx(dose/parmMat[, 4], parmMat[, 1])*t4, + 1 + 1/t3, + 1 - 1/t3, + -t1*t2*(parmMat[, 1]/parmMat[, 4])*t4, -t0/t3 )[, notFixed] } - - deriv2 <- NULL - ## Setting limits -# if (length(lowerc) == numParm) {lowerLimits <- lowerc[notFixed]} else {lowerLimits <- lowerc} -# if (length(upperc) == numParm) {upperLimits <- upperc[notFixed]} else {upperLimits <- upperc} + deriv2 <- NULL - ## Defining the ED function - edfct <- function(parm, p, lower = 1e-4, upper = 10000, ...) - { - cedergreen(fixed = fixed, names = names, alpha = alpha)$edfct(parm, 100 - p, lower, upper, ...) + ## Defining the ED function: wrapper closure that delegates to cedergreen_edfct + ## The framework calls edfct(parm, respl, reference, type, ...) so we bind + ## parmVec, notFixed, and alpha from the enclosing scope. + edfct <- function(parm, respl, reference, type, lower = 1e-4, upper = 10000, ...) + { + cedergreen_edfct(parm, parmVec, notFixed, alpha, 100 - respl, reference, type, lower, upper) } -# ## Defining the SI function -# sifct <- function(parm1, parm2, pair, upper = 10000, interval = c(1e-4, 10000)) -# { -# cedergreen(alpha = alpha)$sifct(parm1, parm2, 100-pair, upper, interval) -# } - - ## Finding the maximal hormesis - maxfct <- function(parm, upper, interval) + ## Finding the maximal hormesis: wrapper closure that delegates to cedergreen_maxfct + ## The framework calls maxfct(parm, lower, upper) where parm is the non-fixed + ## parameter vector. We reconstruct the full named-list and bind alpha. + maxfct <- function(parm, lower = 1e-3, upper = 1000, .optimize_fn = stats::optimize) { - retVal <- cedergreen(fixed = fixed, names = names, alpha = alpha)$maxfct(parm, upper, interval) -# retVal[2] <- (parm[2] + parm[3]) - (retVal[2] - parm[2]) - retVal[2] <- (parm[2] + parm[3]) - retVal[2] - - return(retVal) + parmVec[notFixed] <- parm + all_params <- list(b = parmVec[1], c = parmVec[2], d = parmVec[3], + e = parmVec[4], f = parmVec[5]) + retVal <- cedergreen_maxfct(all_params, alpha, lower, upper, .optimize_fn) + # For U-shaped: invert the response + retVal[2] <- (parmVec[2] + parmVec[3]) - retVal[2] + return(retVal) } - returnList <- - list(fct = fct, ssfct = ssfct, names = names[notFixed], edfct = edfct, maxfct = maxfct, - name = "ucedergreen", - text = "U-shaped Cedergreen-Ritz-Streibig", - noParm = sum(is.na(fixed))) - + # Return results + returnList <- list( + fct = fct, + ssfct = ssfct, + names = names, + deriv1 = deriv1, + deriv2 = NULL, + edfct = edfct, + maxfct = maxfct, + name = ifelse(missing(fctName), as.character(match.call()[[1]]), fctName), + text = ifelse(missing(fctText), "U-shaped Cedergreen-Ritz-Streibig", fctText), + noParm = sum(is.na(fixed)) + ) + class(returnList) <- "UCRS" invisible(returnList) } +#' @title U-shaped CRS model with lower limit 0 (alpha=1) +#' +#' @description +#' Four-parameter u-shaped CRS hormesis model with lower limit fixed at 0 and alpha=1. +#' +#' @param names a vector of character strings giving the names of the parameters. +#' @param ... additional arguments passed to \code{\link{ucedergreen}}. +#' +#' @return A list (see \code{\link{ucedergreen}}). +#' +#' @seealso \code{\link{ucedergreen}}, \code{\link{UCRS.5a}}, \code{\link{CRS.4a}} +#' +#' @keywords models nonlinear "UCRS.4a" <- function(names = c("b", "d", "e", "f"), ...) { ## Checking arguments - if (!is.character(names) | !(length(names) == 4)) {stop("Not correct 'names' argument")} + if (!is.character(names) || !(length(names) == 4)) {stop("Not correct 'names' argument")} return(ucedergreen(names = c(names[1], "c", names[2:4]), fixed = c(NA, 0, NA, NA, NA), alpha = 1, ...)) } +#' @title Alias for UCRS.4a +#' @description \code{uml3a} is an alias for \code{\link{UCRS.4a}}. +#' @param names a vector of character strings giving the names of the parameters. +#' @param ... additional arguments passed to \code{\link{ucedergreen}}. +#' @seealso \code{\link{UCRS.4a}} +#' @keywords models nonlinear uml3a <- UCRS.4a +#' @title U-shaped CRS model with lower limit 0 (alpha=0.5) +#' +#' @description +#' Four-parameter u-shaped CRS hormesis model with lower limit fixed at 0 and alpha=0.5. +#' +#' @param names a vector of character strings giving the names of the parameters. +#' @param ... additional arguments passed to \code{\link{ucedergreen}}. +#' +#' @return A list (see \code{\link{ucedergreen}}). +#' +#' @seealso \code{\link{ucedergreen}}, \code{\link{UCRS.4a}}, \code{\link{CRS.4b}} +#' +#' @keywords models nonlinear "UCRS.4b" <- function(names = c("b", "d", "e", "f"), ...) { ## Checking arguments - if (!is.character(names) | !(length(names) == 4)) {stop("Not correct 'names' argument")} + if (!is.character(names) || !(length(names) == 4)) {stop("Not correct 'names' argument")} return(ucedergreen(names = c(names[1], "c", names[2:4]), fixed = c(NA, 0, NA, NA, NA), alpha = 0.5, ...)) } +#' @title Alias for UCRS.4b +#' @description \code{uml3b} is an alias for \code{\link{UCRS.4b}}. +#' @param names a vector of character strings giving the names of the parameters. +#' @param ... additional arguments passed to \code{\link{ucedergreen}}. +#' @seealso \code{\link{UCRS.4b}} +#' @keywords models nonlinear uml3b <- UCRS.4b +#' @title U-shaped CRS model with lower limit 0 (alpha=0.25) +#' +#' @description +#' Four-parameter u-shaped CRS hormesis model with lower limit fixed at 0 and alpha=0.25. +#' +#' @param names a vector of character strings giving the names of the parameters. +#' @param ... additional arguments passed to \code{\link{ucedergreen}}. +#' +#' @return A list (see \code{\link{ucedergreen}}). +#' +#' @seealso \code{\link{ucedergreen}}, \code{\link{UCRS.4a}}, \code{\link{CRS.4c}} +#' +#' @keywords models nonlinear "UCRS.4c" <- function(names = c("b", "d", "e", "f"), ...) { ## Checking arguments - if (!is.character(names) | !(length(names) == 4)) {stop("Not correct 'names' argument")} + if (!is.character(names) || !(length(names) == 4)) {stop("Not correct 'names' argument")} return(ucedergreen(names = c(names[1], "c", names[2:4]), fixed = c(NA, 0, NA, NA, NA), alpha = 0.25, ...)) } +#' @title Alias for UCRS.4c +#' @description \code{uml3c} is an alias for \code{\link{UCRS.4c}}. +#' @param names a vector of character strings giving the names of the parameters. +#' @param ... additional arguments passed to \code{\link{ucedergreen}}. +#' @seealso \code{\link{UCRS.4c}} +#' @keywords models nonlinear uml3c <- UCRS.4c +#' @title U-shaped CRS five-parameter model (alpha=1) +#' +#' @description +#' Five-parameter u-shaped CRS hormesis model with alpha=1. +#' +#' @param names a vector of character strings giving the names of the parameters. +#' @param ... additional arguments passed to \code{\link{ucedergreen}}. +#' +#' @return A list (see \code{\link{ucedergreen}}). +#' +#' @seealso \code{\link{ucedergreen}}, \code{\link{UCRS.4a}}, \code{\link{CRS.5a}} +#' +#' @keywords models nonlinear "UCRS.5a" <- function(names = c("b", "c", "d", "e", "f"), ...) { ## Checking arguments - if (!is.character(names) | !(length(names) == 5)) {stop("Not correct 'names' argument")} + if (!is.character(names) || !(length(names) == 5)) {stop("Not correct 'names' argument")} return(ucedergreen(names = names, fixed = c(NA, NA, NA, NA, NA), alpha = 1, ...)) } +#' @title Alias for UCRS.5a +#' @description \code{uml4a} is an alias for \code{\link{UCRS.5a}}. +#' @param names a vector of character strings giving the names of the parameters. +#' @param ... additional arguments passed to \code{\link{ucedergreen}}. +#' @seealso \code{\link{UCRS.5a}} +#' @keywords models nonlinear uml4a <- UCRS.5a +#' @title U-shaped CRS five-parameter model (alpha=0.5) +#' +#' @description +#' Five-parameter u-shaped CRS hormesis model with alpha=0.5. +#' +#' @param names a vector of character strings giving the names of the parameters. +#' @param ... additional arguments passed to \code{\link{ucedergreen}}. +#' +#' @return A list (see \code{\link{ucedergreen}}). +#' +#' @seealso \code{\link{ucedergreen}}, \code{\link{UCRS.5a}}, \code{\link{CRS.5b}} +#' +#' @keywords models nonlinear "UCRS.5b" <- function(names = c("b", "c", "d", "e", "f"), ...) { ## Checking arguments - if (!is.character(names) | !(length(names) == 5)) {stop("Not correct 'names' argument")} + if (!is.character(names) || !(length(names) == 5)) {stop("Not correct 'names' argument")} return(ucedergreen(names = names, fixed = c(NA, NA, NA, NA, NA), alpha = 0.5, ...)) } +#' @title Alias for UCRS.5b +#' @description \code{uml4b} is an alias for \code{\link{UCRS.5b}}. +#' @param names a vector of character strings giving the names of the parameters. +#' @param ... additional arguments passed to \code{\link{ucedergreen}}. +#' @seealso \code{\link{UCRS.5b}} +#' @keywords models nonlinear uml4b <- UCRS.5b +#' @title U-shaped CRS five-parameter model (alpha=0.25) +#' +#' @description +#' Five-parameter u-shaped CRS hormesis model with alpha=0.25. +#' +#' @param names a vector of character strings giving the names of the parameters. +#' @param ... additional arguments passed to \code{\link{ucedergreen}}. +#' +#' @return A list (see \code{\link{ucedergreen}}). +#' +#' @seealso \code{\link{ucedergreen}}, \code{\link{UCRS.5a}}, \code{\link{CRS.5c}} +#' +#' @keywords models nonlinear "UCRS.5c" <- function(names = c("b", "c", "d", "e", "f"), ...) { ## Checking arguments - if (!is.character(names) | !(length(names) == 5)) {stop("Not correct 'names' argument")} + if (!is.character(names) || !(length(names) == 5)) {stop("Not correct 'names' argument")} return(ucedergreen(names = names, fixed = c(NA, NA, NA, NA, NA), alpha = 0.25, ...)) } +#' @title Alias for UCRS.5c +#' @description \code{uml4c} is an alias for \code{\link{UCRS.5c}}. +#' @param names a vector of character strings giving the names of the parameters. +#' @param ... additional arguments passed to \code{\link{ucedergreen}}. +#' @seealso \code{\link{UCRS.5c}} +#' @keywords models nonlinear uml4c <- UCRS.5c diff --git a/R/update.drc.R b/R/update.drc.R index daf9e2d2..c7884e93 100644 --- a/R/update.drc.R +++ b/R/update.drc.R @@ -1,3 +1,25 @@ +#' @title Updating and re-fitting a model +#' +#' @description +#' \code{update} updates and re-fits a model on the basis of an object of class 'drc'. +#' +#' @param object an object of class 'drc'. +#' @param ... arguments to alter in object. +#' @param evaluate logical. If TRUE model is re-fit; otherwise an unevaluated call is returned. +#' +#' @return An object of class 'drc'. +#' +#' @author Christian Ritz +#' +#' @examples +#' ## Fitting a four-parameter Weibull model +#' model1 <- drm(ryegrass, fct = W1.4()) +#' +#' ## Updating 'model1' by fitting a three-parameter Weibull model instead +#' model2 <- update(model1, fct = W1.3()) +#' anova(model2, model1) +#' +#' @keywords models nonlinear "update.drc" <- function (object, ..., evaluate = TRUE) { call <- object$call @@ -7,7 +29,6 @@ extras <- match.call(expand.dots = FALSE)$... if (length(extras) > 0) { -# glsa <- names(as.list(args(multdrc))) glsa <- names(as.list(args(drm))) names(extras) <- glsa[pmatch(names(extras), glsa[-length(glsa)])] existing <- !is.na(match(names(extras), names(call))) @@ -19,14 +40,26 @@ } } if (evaluate) - { -# print(parent.frame(n=2)) -# print(ls(envir=parent.frame(n=2))) -# env2 <- parent.frame(n=2) -# print(ls(envir=env2)) -# eval(call, envir = env2) - -# eval(call, envir = parent.frame(), enclos = .GlobalEnv) - eval(call, parent.frame()) + { + ## If call$data refers to a symbol that cannot be resolved in the + ## calling frame (e.g. .x inside purrr::map()), fall back to the + ## data stored in the fitted object. + eval_env <- parent.frame() + if (!is.null(call$data) && !is.null(object$origData)) + { + data_resolvable <- tryCatch( + { + is.data.frame(eval(call$data, eval_env)) + }, + error = function(e) FALSE) + if (!data_resolvable) + { + eval_env <- list2env( + list(.drc_stored_data__ = object$origData), + parent = eval_env) + call$data <- quote(.drc_stored_data__) + } + } + eval(call, eval_env) } else call } diff --git a/R/ursa.r b/R/ursa.R similarity index 57% rename from R/ursa.r rename to R/ursa.R index f347b928..fc2baded 100644 --- a/R/ursa.r +++ b/R/ursa.R @@ -1,5 +1,52 @@ +#' Universal Response Surface Approach (URSA) for Drug Interaction +#' +#' URSA provides a parametric approach for modelling the joint action of several +#' agents. The model allows quantification of synergistic effects through a single +#' parameter. The model function is defined implicitly through an appropriate equation. +#' +#' @param fixed numeric vector. Specifies which parameters are fixed and at what value +#' they are fixed. NAs for parameters that are not fixed. +#' @param names a vector of character strings giving the names of the parameters. +#' The default is reasonable. +#' @param ssfct a self starter function to be used (optional). +#' +#' @return A list containing the nonlinear function, the self starter function, +#' and the parameter names. +#' +#' @references +#' Greco, W. R. and Park H. S. and Rustum, Y. M. (1990) Application of a New +#' Approach for the Quantitation of Drug Synergism to the Combination of +#' cis-Diamminedichloroplatinum and 1-beta-D-Arabinofuranosylcytosine, +#' \emph{Cancer Research}, \bold{50}, 5318--5327. +#' +#' Greco, W. R. Bravo, G. and Parsons, J. C. (1995) The Search for Synergy: +#' A Critical Review from a Response Surface Perspective, +#' \emph{Pharmacological Reviews}, \bold{47}, Issue 2, 331--385. +#' +#' @author Christian Ritz after an idea by Hugo Ceulemans. +#' +#' @seealso Other models for fitting mixture data: \code{\link{mixture}}. +#' +#' @examples +#' d1 <- c(0, 0, 0, 0, 0, 0, 0, 0, 2, 5, 10, 20, 50, 2, 2, 2, +#' 2, 2, 5, 5, 5, 5, 5, 10, 10, 10, 10, 10, 20, 20, 20, 20, +#' 20, 50, 50, 50, 50, 50) +#' d2 <- c(0, 0, 0, 0.2, 0.5, 1, 2, 5, 0, 0, 0, 0, 0, 0.2, +#' 0.5, 1, 2, 5, 0.2, 0.5, 1, 2, 5, 0.2, 0.5, 1, 2, 5, 0.2, +#' 0.5, 1, 2, 5, 0.2, 0.5, 1, 2, 5) +#' effect <- c(106, 99.2, 115, 79.2, 70.1, 49, 21, 3.83, 74.2, +#' 71.5, 48.1, 30.9, 16.3, 76.3, 48.8, 44.5, 15.5, 3.21, +#' 56.7, 47.5, 26.8, 16.9, 3.25, 46.7, 35.6, 21.5, 11.1, +#' 2.94, 24.8, 21.6, 17.3, 7.78, 1.84, 13.6, 11.1, 6.43, +#' 3.34, 0.89) +#' greco <- data.frame(d1, d2, effect) +#' greco.m1 <- drm(effect ~ d1 + d2, data = greco, +#' fct = ursa(fixed = c(NA, NA, 0, NA, NA, NA, NA))) +#' summary(greco.m1) +#' +#' @keywords models nonlinear "ursa" <- function( -fixed = rep(NA, 7), names = c("b1", "b2", "c", "d", "e1", "e1", "f"), ssfct = NULL) +fixed = rep(NA, 7), names = c("b1", "b2", "c", "d", "e1", "e2", "f"), ssfct = NULL) { ## Checking arguments numParm <- 7 @@ -39,8 +86,6 @@ fixed = rep(NA, 7), names = c("b1", "b2", "c", "d", "e1", "e1", "f"), ssfct = NU applyImplicitFct <- function(parmVec) { -# print(parmVec) - if ((!is.finite(parmVec[5])) && (!is.finite(parmVec[6]))) { return(parmVec[4]) @@ -56,13 +101,6 @@ fixed = rep(NA, 7), names = c("b1", "b2", "c", "d", "e1", "e1", "f"), ssfct = NU parmVec[7]/(parmVec[5] * parmVec[6] * (scaledEffect^(recSlope1/2 + recSlope2/2))) - 1 } -# print(c(implicitFct(parmVec[3]*1.01), implicitFct(parmVec[4]*0.99), parmVec[4]*0.99)) - -# reducFactor0 <- max(c((1/parmVec[5])^parmVec[1] + 1, (1/parmVec[6])^parmVec[2] + 1)) -# reducFactor <- max(c(0.99, reducFactor0 / (1 + reducFactor0))) -# print(c((1/parmVec[5])^parmVec[1], (1/parmVec[6])^parmVec[2], reducFactor0, reducFactor)) -# bisection <- try(uniroot(implicitFct, c(parmVec[3] * (2 - reducFactor), parmVec[4] * reducFactor)), silent = FALSE) -# bisection <- try(uniroot(implicitFct, c(parmVec[3]*1.01, parmVec[4]*0.99)), silent = FALSE) bisection <- try(bisec(implicitFct, parmVec[3], parmVec[4]), silent = TRUE) if (inherits(bisection, "try-error")) { @@ -73,7 +111,6 @@ fixed = rep(NA, 7), names = c("b1", "b2", "c", "d", "e1", "e1", "f"), ssfct = NU } } -# print(apply(parmMat, 1, applyImplicitFct)) apply(parmMat, 1, applyImplicitFct) } @@ -83,8 +120,6 @@ fixed = rep(NA, 7), names = c("b1", "b2", "c", "d", "e1", "e1", "f"), ssfct = NU } else { ssfct <- function(dframe) { -# initval <- c((llogistic()$ssfct(dframe))[c(1, 1:4, 4)], 0.5) * c(-1, -1, rep(1, 5)) - startLL.d1 <- as.vector(coef(drm(dframe[, c(3,1)], fct = LL.4()))) startLL.d2 <- as.vector(coef(drm(dframe[, c(3,2)], fct = LL.4()))) @@ -112,15 +147,9 @@ fixed = rep(NA, 7), names = c("b1", "b2", "c", "d", "e1", "e1", "f"), ssfct = NU ## Defining the SI function sifct <- NULL - ## Scale function -# scaleFct <- function(doseScaling, respScaling) -# { -# c(1, 1, respScaling, respScaling, doseScaling, doseScaling, 1)[notFixed] -# } - returnList <- list(fct = fct, ssfct = ssfct, names = names, deriv1 = deriv1, deriv2 = deriv2, - edfct = edfct, sifct = sifct, # scaleFct = scaleFct, + edfct = edfct, sifct = sifct, name = "ursa", text = "URSA", noParm = sum(is.na(fixed))) diff --git a/R/vcov.drc.R b/R/vcov.drc.R index 8e573f44..5644539c 100644 --- a/R/vcov.drc.R +++ b/R/vcov.drc.R @@ -1,3 +1,31 @@ +#' @title Calculating variance-covariance matrix for objects of class 'drc' +#' +#' @description +#' \code{vcov} returns the estimated variance-covariance matrix for the +#' parameters in the non-linear function. +#' +#' @param object an object of class 'drc'. +#' @param ... additional arguments. +#' @param corr logical. If TRUE a correlation matrix is returned. +#' @param od logical. If TRUE adjustment for over-dispersion is used. This +#' argument only makes a difference for binomial data. +#' @param pool logical. If TRUE curves are pooled. Otherwise they are not. This +#' argument only works for models with independently fitted curves as +#' specified in \code{\link{drm}}. +#' @param unscaled logical. If TRUE the unscaled variance-covariance is +#' returned. This argument only makes a difference for continuous data. +#' +#' @return A matrix of estimated variances and covariances. +#' +#' @examples +#' ## Fitting a four-parameter log-logistic model +#' ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +#' vcov(ryegrass.m1) +#' vcov(ryegrass.m1, corr = TRUE) +#' +#' @author Christian Ritz +#' +#' @keywords models nonlinear "vcov.drc" <- function(object, ..., corr = FALSE, od = FALSE, pool = TRUE, unscaled = FALSE) { @@ -13,10 +41,8 @@ function(object, ..., corr = FALSE, od = FALSE, pool = TRUE, unscaled = FALSE) ## Retrieving the estimated variance-covariance matrix for the parameter estimates if (!corr) { -# summary(object)$"varMat" if (!is.null(object$"objList")) { -# require(magic, quietly = TRUE) if ((contData) && (pool)) { @@ -32,14 +58,7 @@ function(object, ..., corr = FALSE, od = FALSE, pool = TRUE, unscaled = FALSE) } else { vcMat <- do.call("adiag", lapply(object$"objList", vcovfct)) } -# do.call("adiag", lapply(object$"objList", object$"estMethod"$"vcovfct")) -# vcMat <- do.call("adiag", lapply(object$"objList", vcovfct)) -# if (contPool) -# { -# vcMat <- vcMat * (2 * (object$"minval" / df.residual(object))) -# # scaling based on all fits -# } - return(vcMat) + return(vcMat) } else { if ((contData) && (unscaled)) { @@ -62,33 +81,32 @@ function(object, ..., corr = FALSE, od = FALSE, pool = TRUE, unscaled = FALSE) { vcMat <- (object$"estMethod")$"vcovfct"(object) diage <- sqrt(diag(vcMat)) - vcMat / (outer(diage, diage)) + corrMat <- vcMat / (outer(diage, diage)) + ## Clamp to [-1, 1] to handle floating-point precision issues + corrMat[] <- pmin(pmax(corrMat, -1), 1) + corrMat } if (!is.null(object$"objList")) { -# require(magic, quietly = TRUE) - do.call("adiag", lapply(object$"objList", corrFct)) + do.call("adiag", lapply(object$"objList", corrFct)) } else { corrFct(object) } - } + } } "vcCont" <- function(object) { -# scaledH <- (object$"fit"$"hessian") / (2 * rvfct(object)) scaledH <- (object$"fit"$"hessian") / (2 * rse(object, TRUE)) invMat <- try(solve(scaledH), silent = TRUE) if (inherits(invMat, "try-error")) { -# cat("Note: Variance-covariance matrix regularized\n") ## More stable than 'solve' (suggested by Nicholas Lewin-Koh - 2007-02-12) ch <- try(chol(scaledH), silent = TRUE) ## "silent" argument added after report by Xuesong Yu - 2010-03-09 if (inherits(ch, "try-error")) { -# ch <- try(chol(0.99 * object$fit$hessian + 0.01 * diag(dim(object$fit$hessian)[1])), silent = TRUE) ch <- try(chol(0.99 * scaledH + 0.01 * diag(dim(scaledH)[1])), silent = TRUE) # 2012-06-22 } ## Try regularizing if the varcov is unstable @@ -106,5 +124,44 @@ function(object, ..., corr = FALSE, od = FALSE, pool = TRUE, unscaled = FALSE) "vcDisc" <- function(object) { - solve(object$fit$hessian) + H <- object$fit$hessian + numRows <- nrow(H) + + ## Helper: check that the inverse is a valid variance-covariance matrix + ## (all diagonal elements must be non-negative) + isValidVcov <- function(mat) { + !inherits(mat, "try-error") && all(diag(mat) >= 0) + } + + warnAndReturnNA <- function() { + warning( + "Variance-covariance matrix could not be computed: ", + "the Hessian is singular. Standard errors will be NA. ", + "Consider re-parameterising the model or using a different ", + "starting value or optimisation method.", + call. = FALSE + ) + matrix(NA_real_, numRows, numRows) + } + + invMat <- try(solve(H), silent = TRUE) + if (isValidVcov(invMat)) return(invMat) + + ## More stable than 'solve' (suggested by Nicholas Lewin-Koh - 2007-02-12) + ch <- try(chol(H), silent = TRUE) + if (!inherits(ch, "try-error")) + { + invMat <- chol2inv(ch) + if (isValidVcov(invMat)) return(invMat) + } + + ## Try regularizing if the varcov is unstable + ch <- try(chol(0.99 * H + 0.01 * diag(numRows)), silent = TRUE) + if (!inherits(ch, "try-error")) + { + invMat <- chol2inv(ch) + if (isValidVcov(invMat)) return(invMat) + } + + warnAndReturnNA() } \ No newline at end of file diff --git a/R/voelund.r b/R/voelund.R similarity index 57% rename from R/voelund.r rename to R/voelund.R index c40a4101..a3917653 100644 --- a/R/voelund.r +++ b/R/voelund.R @@ -1,3 +1,24 @@ +#' Voelund Mixture Model +#' +#' Provides the Voelund model for describing the joint action of two compounds +#' in binary mixture experiments. Used internally by \code{\link{mixture}}. +#' +#' @param fixed numeric vector. Specifies which parameters are fixed and at what value +#' they are fixed. NAs for parameters that are not fixed. +#' @param names a vector of character strings giving the names of the parameters +#' (should not contain ":"). +#' @param method character string indicating the self starter function to use. +#' @param ssfct a self starter function to be used (optional). +#' @param eps numeric tolerance for handling zero dose values. +#' +#' @return A list containing the nonlinear model function, the self starter function, +#' and the parameter names. +#' +#' @author Christian Ritz +#' +#' @seealso \code{\link{mixture}}, \code{\link{hewlett}} +#' +#' @keywords internal "voelund" <- function( fixed = c(NA, NA, NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f", "g", "h"), @@ -18,22 +39,16 @@ eps = 1e-10) ## Defining the non-linear function fct <- function(dose, parm) { -# print(parm) - parmMat <- matrix(parmVec, nrow(parm), numParm, byrow=TRUE) parmMat[, notFixed] <- parm -# loge <- -parmMat[, 6]*log((1/parmMat[, 4])^(1/parmMat[, 6]) + (1/parmMat[, 5])^(1/parmMat[, 6])) -# parmMat[, 2]+(parmMat[, 3]-parmMat[, 2])/(1+exp(parmMat[, 1]*(log(dose)-loge))) - - ratio <- parmMat[, 4]/parmMat[, 5] + ratio<- parmMat[, 4]/parmMat[, 5] tmp <- (1+ratio)^(1-parmMat[, 6])+((ratio)^parmMat[, 7])*((1+ratio)^(1-parmMat[, 7])) loge <- log(parmMat[, 4]/tmp) loge[!is.finite(parmMat[, 4])] <- log(parmMat[!is.finite(parmMat[, 4]), 5]) loge[!is.finite(parmMat[, 5])] <- log(parmMat[!is.finite(parmMat[, 5]), 4]) -# parmMat[, 2]+(parmMat[, 3]-parmMat[, 2])/(1+exp(parmMat[, 1]*(log(dose)-loge))) retVec <- parmMat[, 2]+(parmMat[, 3]-parmMat[, 2])/(1+exp(parmMat[, 1]*(log(dose)-loge))) ## Handling the case dose=0 where "loge" may become NaN due to the mixture encoding (pct in glymet) retVec[dose < eps] <- parmMat[dose < eps, 3] @@ -41,39 +56,6 @@ eps = 1e-10) } ## Defining self starter function -if (FALSE) -{ - ssfct <- function(dataFra) - { - dose2 <- dataFra[,1] - resp3 <- dataFra[,2] - - startVal <- rep(0, numParm) - - startVal[3] <- max(resp3)+0.001 # the d parameter - startVal[2] <- min(resp3)-0.001 # the c parameter - startVal[5] <- 1 # better choice may be possible! -# startVal[!notFixed] <- fixed[!notFixed] - - if (length(unique(dose2))==1) {return((c(NA, NA, startVal[3], NA, NA))[notFixed])} # only estimate of upper limit if a single unique dose value - - indexT2 <- (dose2>0) - if (!any(indexT2)) {return((rep(NA, numParm))[notFixed])} # for negative dose value - dose3 <- dose2[indexT2] - resp3 <- resp3[indexT2] - - logitTrans <- log((startVal[3]-resp3)/(resp3-startVal[2]+0.001)) # 0.001 to avoid 0 in the denominator - logitFit <- lm(logitTrans~log(dose3)) - startVal[4] <- exp((-coef(logitFit)[1]/coef(logitFit)[2])) # the e parameter - startVal[1] <- coef(logitFit)[2] # the b parameter - - startVal[5] <- startVal[4] - startVal[6] <- 1 - startVal[7] <- 1 - - return(startVal[notFixed]) - } -} if (!is.null(ssfct)) { ssfct <- ssfct @@ -108,7 +90,7 @@ if (FALSE) returnList <- list(fct=fct, ssfct=ssfct, names=names, deriv1=deriv1, deriv2=deriv2, - edfct=edfct, sifct=sifct, + edfct=edfct, sifct=sifct, scaleFct=scaleFct, name = "voelund", text = "Voelund mixture", noParm = sum(is.na(fixed))) diff --git a/R/weibull1.R b/R/weibull1.R new file mode 100644 index 00000000..dbd203af --- /dev/null +++ b/R/weibull1.R @@ -0,0 +1,474 @@ +#' @title The four-parameter Weibull type 1 model +#' +#' @description +#' The general Weibull type 1 model for fitting dose-response data. +#' +#' @details +#' The four-parameter Weibull type 1 model is given by the expression +#' \deqn{f(x) = c + (d - c) \exp(-\exp(b(\log(x) - \log(e))))} +#' +#' The model is sometimes also called the Gompertz model. +#' +#' The \code{method} argument determines how starting values for the parameters +#' \code{b} and \code{e} are estimated (the starting values for \code{c} and +#' \code{d} are always based on the range of the response values). Four methods +#' are available: +#' \describe{ +#' \item{\code{"1"} (default)}{Linear regression on transformed data. Applies a +#' log-log transformation to the response and a log transformation to the +#' dose, then fits a linear regression to estimate starting values for +#' \code{b} and \code{e}.} +#' \item{\code{"2"}}{Anke's procedure. Estimates \code{e} by finding the dose +#' at which the response crosses the midpoint between \code{c} and \code{d}, +#' then estimates \code{b} as the median of back-calculated values.} +#' \item{\code{"3"}}{Stepwise approach. Identifies where the mean response +#' crosses the midpoint between \code{c} and \code{d} and uses the +#' corresponding dose as the starting value for \code{e}. The starting value +#' for \code{b} is based on the sign of the slope at that point.} +#' \item{\code{"4"}}{Normolle's procedure. Uses the mean of the dose range as +#' an initial estimate for \code{e}, then estimates \code{b} and \code{e} +#' using median-based back-calculations.} +#' } +#' +#' @param fixed numeric vector of length 4. Specifies which parameters are +#' fixed and at what value. Use \code{NA} for parameters that are not fixed. +#' @param names character vector of length 4 giving the names of the +#' parameters \code{b}, \code{c}, \code{d}, and \code{e}. +#' @param method character string indicating the self starter function to use +#' for obtaining starting values (\code{"1"} (default), \code{"2"}, +#' \code{"3"}, or \code{"4"}). See Details. +#' @param ssfct a self starter function to be used. If \code{NULL} (default), +#' the built-in self starter is used. +#' @param fctName optional character string used internally for the function +#' name. +#' @param fctText optional character string used internally for the function +#' text description. +#' +#' @return A list of class \code{Weibull-1} containing the nonlinear function, +#' self starter function, and parameter names. +#' +#' @author Christian Ritz +#' +#' @references +#' Seber, G. A. F. and Wild, C. J. (1989) +#' \emph{Nonlinear Regression}, New York: Wiley & Sons (pp. 338--339). +#' +#' @seealso \code{\link{W1.2}}, \code{\link{W1.3}}, \code{\link{W1.4}}, +#' \code{\link{weibull2}} +#' +#' @keywords models nonlinear +"weibull1" <- function( +fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), +method = c("1", "2", "3", "4"), ssfct = NULL, +fctName, fctText) +{ + ## Checking arguments + numParm <- 4 + if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct 'names' argument")} + if (!(length(fixed)==numParm)) {stop("Not correct 'fixed' argument")} + + notFixed <- is.na(fixed) + parmVec <- rep(0, numParm) + parmVec[!notFixed] <- fixed[!notFixed] + parmVec1 <- parmVec + parmVec2 <- parmVec + + + ## Defining the non-linear function + fct <- function(dose, parm) + { + parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE) + parmMat[, notFixed] <- parm + + parmMat[, 2] + (parmMat[, 3] - parmMat[, 2]) * exp( -exp(parmMat[, 1] *(log(dose) - log(parmMat[, 4])))) + } + + + ## Defining the self starter function + if (!is.null(ssfct)) + { + ssfct <- ssfct # in case it is explicitly provided + } else { + ssfct <- weibull1.ssf(method, fixed) + } + + + ## Defining names + names <- names[notFixed] + + + ## Defining derivatives + ## Defining derivatives + deriv1 <- function(dose, parm) + { + parmMat <- matrix(parmVec, nrow(parm), numParm, byrow=TRUE) + parmMat[, notFixed] <- parm + + t1 <- parmMat[, 3] - parmMat[, 2] + t2 <- exp(parmMat[, 1]*(log(dose) - log(parmMat[, 4]))) + t3 <- exp(-t2) + + derMat <- as.matrix(cbind( -t1 * divAtInf(xlogx(dose/parmMat[, 4], parmMat[, 1]), exp(t2)), + 1 - t3, + t3, + t1 * divAtInf(t2, exp(t2)) * parmMat[, 1]/parmMat[, 4] )) + return(derMat[, notFixed]) + } + deriv2 <- NULL + + + ## Defining the first derivative (in x=dose) + ## based on deriv(~c+(d-c)*(exp(-exp(b*(log(x)-log(e))))), "x", function(x, b,c,d,e){}) + derivx <- function(x, parm) + { + parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE) + parmMat[, notFixed] <- parm + + .expr1 <- parmMat[, 3] - parmMat[, 2] # d - c + .expr6 <- exp(parmMat[, 1] * (log(x) - log(parmMat[, 4]))) + .expr8 <- exp(-.expr6) + .value <- parmMat[, 2] + .expr1 * .expr8 + .grad <- array(0, c(length(.value), 1L), list(NULL, c("x"))) + .grad[, "x"] <- -(.expr1 * (.expr8 * (.expr6 * (parmMat[, 1] * (1/x))))) + .grad + } + + ## Defining the ED function + edfct <- function(parm, respl, reference, type, ...) # function(parm, p, reference, type, ...) + { + parmVec[notFixed] <- parm + p <- EDhelper(parmVec, respl, reference, type) + + tempVal <- log(-log((100-p)/100)) + EDp <- exp(tempVal/parmVec[1] + log(parmVec[4])) + + EDder <- EDp*c(-tempVal/(parmVec[1]^2), 0, 0, 1/parmVec[4]) + + ## Fix: correct c and d derivatives for absolute type using central differences. + ## The analytical derivatives above miss the chain-rule contribution from + ## the absolute-to-relative conversion (EDhelper), where p depends on c and d. + if (identical(type, "absolute")) { + .edval <- function(pv) { + p0 <- EDhelper(pv, respl, reference, type) + tv0 <- log(-log((100 - p0) / 100)) + exp(tv0 / pv[1] + log(pv[4])) + } + .eps <- .Machine$double.eps + for (.i in c(2, 3)) { + .h <- if (abs(parmVec[.i]) > sqrt(.eps)) abs(parmVec[.i]) * .eps^(1/3) else .eps^(1/3) + .pvUp <- replace(parmVec, .i, parmVec[.i] + .h) + .pvDn <- replace(parmVec, .i, parmVec[.i] - .h) + EDder[.i] <- (.edval(.pvUp) - .edval(.pvDn)) / (2 * .h) + } + } + + return(list(EDp, EDder[notFixed])) + } + + returnList <- + list(fct = fct, ssfct = ssfct, names = names, deriv1 = deriv1, deriv2 = deriv2, derivx = derivx, edfct = edfct, + name = ifelse(missing(fctName), as.character(match.call()[[1]]), fctName), + text = ifelse(missing(fctText), "Weibull (type 1)", fctText), + noParm = sum(is.na(fixed)), + fixed = fixed) + + class(returnList) <- "Weibull-1" + invisible(returnList) +} + + +#' @title Two-parameter Weibull type 1 model +#' +#' @description +#' A two-parameter Weibull type 1 model with the lower limit fixed at 0 +#' and the upper limit fixed at a specified value (default 1). +#' +#' @details +#' The model is given by the expression +#' \deqn{f(x) = upper \exp(-\exp(b(\log(x) - \log(e))))} +#' +#' This is mostly used for binomial/quantal responses. +#' +#' @param upper numeric value giving the fixed upper limit. The default is 1. +#' @param fixed numeric vector of length 2. Specifies which parameters are +#' fixed and at what value. Use \code{NA} for parameters that are not fixed. +#' @param names character vector of length 2 giving the names of the +#' parameters. The default is \code{c("b", "e")}. +#' @param \dots additional arguments passed to \code{\link{weibull1}}, most +#' notably \code{method} (a character string: \code{"1"} (default), +#' \code{"2"}, \code{"3"}, or \code{"4"}) which selects the self-starter +#' method for obtaining starting values. See \code{\link{weibull1}} for +#' details. +#' +#' @return A list of class \code{Weibull-1} containing the nonlinear function, +#' self starter function, and parameter names. +#' +#' @seealso \code{\link{weibull1}}, \code{\link{W1.3}}, \code{\link{W1.4}} +#' +#' @examples +#' earthworms.m1 <- drm(number/total ~ dose, weights = total, +#' data = earthworms, fct = W1.2(), type = "binomial") +#' +#' @keywords models nonlinear +"W1.2" <- +function(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) +{ + ## Checking arguments + numParm <- 2 + if (!is.character(names) | !(length(names) == numParm)) {stop("Not correct 'names' argument")} + if (!(length(fixed) == numParm)) {stop("Not correct length of 'fixed' argument")} + + return(weibull1(fixed = c(fixed[1], 0, upper, fixed[2]), names = c(names[1], "c", "d", names[2]), + fctName = as.character(match.call()[[1]]), + fctText = lowupFixed("Weibull (type 1)", upper), ...)) +} + +#' @rdname W1.2 +w2 <- W1.2 + +#' @title Three-parameter Weibull type 1 model +#' +#' @description +#' A three-parameter Weibull type 1 model with the lower limit fixed at 0. +#' +#' @details +#' The model is given by the expression +#' \deqn{f(x) = d \exp(-\exp(b(\log(x) - \log(e))))} +#' +#' This is a special case of the four-parameter Weibull type 1 model +#' where the lower limit is fixed at 0. +#' +#' @param fixed numeric vector of length 3. Specifies which parameters are +#' fixed and at what value. Use \code{NA} for parameters that are not fixed. +#' @param names character vector of length 3 giving the names of the +#' parameters. The default is \code{c("b", "d", "e")}. +#' @param \dots additional arguments passed to \code{\link{weibull1}}, most +#' notably \code{method} (a character string: \code{"1"} (default), +#' \code{"2"}, \code{"3"}, or \code{"4"}) which selects the self-starter +#' method for obtaining starting values. See \code{\link{weibull1}} for +#' details. +#' +#' @return A list of class \code{Weibull-1} containing the nonlinear function, +#' self starter function, and parameter names. +#' +#' @seealso \code{\link{weibull1}}, \code{\link{W1.2}}, \code{\link{W1.4}} +#' +#' @examples +#' ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.3()) +#' +#' @keywords models nonlinear +"W1.3" <- +function(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) +{ + ## Checking arguments + numParm <- 3 + if (!is.character(names) | !(length(names) == numParm)) {stop("Not correct 'names' argument")} + if (!(length(fixed) == numParm)) {stop("Not correct length of 'fixed' argument")} + + return(weibull1(fixed = c(fixed[1], 0, fixed[2:3]), names = c(names[1], "c", names[2:3]), + fctName = as.character(match.call()[[1]]), + fctText = lowFixed("Weibull (type 1)"), ...)) +} + +#' @rdname W1.3 +w3 <- W1.3 + +#' @title Three-parameter Weibull type 1 model with upper limit fixed +#' +#' @description +#' A three-parameter Weibull type 1 model with the upper limit fixed +#' (default 1). +#' +#' @details +#' The model is given by the expression +#' \deqn{f(x) = c + (upper - c) \exp(-\exp(b(\log(x) - \log(e))))} +#' +#' This is a special case of the four-parameter Weibull type 1 model +#' where the upper limit is fixed at a specified value. +#' +#' @param upper numeric value giving the fixed upper limit. The default is 1. +#' @param fixed numeric vector of length 3. Specifies which parameters are +#' fixed and at what value. Use \code{NA} for parameters that are not fixed. +#' @param names character vector of length 3 giving the names of the +#' parameters. The default is \code{c("b", "c", "e")}. +#' @param \dots additional arguments passed to \code{\link{weibull1}}, most +#' notably \code{method} (a character string: \code{"1"} (default), +#' \code{"2"}, \code{"3"}, or \code{"4"}) which selects the self-starter +#' method for obtaining starting values. See \code{\link{weibull1}} for +#' details. +#' +#' @return A list of class \code{Weibull-1} containing the nonlinear function, +#' self starter function, and parameter names. +#' +#' @seealso \code{\link{weibull1}}, \code{\link{W1.3}}, \code{\link{W1.4}} +#' +#' @keywords models nonlinear +"W1.3u" <- +function(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...) +{ + ## Checking arguments + numParm <- 3 + if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct 'names' argument")} + if (!(length(fixed)==numParm)) {stop("Not correct length of 'fixed' argument")} + + return(weibull1(fixed = c(fixed[1:2], upper, fixed[3]), + names = c(names[1:2], "d", names[3]), + fctName = as.character(match.call()[[1]]), + fctText = upFixed("Weibull (type 1)", upper), ...)) +} + +#' @title Four-parameter Weibull type 1 model +#' +#' @description +#' A four-parameter Weibull type 1 model. +#' +#' @details +#' The model is given by the expression +#' \deqn{f(x) = c + (d - c) \exp(-\exp(b(\log(x) - \log(e))))} +#' +#' @param fixed numeric vector of length 4. Specifies which parameters are +#' fixed and at what value. Use \code{NA} for parameters that are not fixed. +#' @param names character vector of length 4 giving the names of the +#' parameters. The default is \code{c("b", "c", "d", "e")}. +#' @param \dots additional arguments passed to \code{\link{weibull1}}, most +#' notably \code{method} (a character string: \code{"1"} (default), +#' \code{"2"}, \code{"3"}, or \code{"4"}) which selects the self-starter +#' method for obtaining starting values. See \code{\link{weibull1}} for +#' details. +#' +#' @return A list of class \code{Weibull-1} containing the nonlinear function, +#' self starter function, and parameter names. +#' +#' @references +#' Seber, G. A. F. and Wild, C. J. (1989) +#' \emph{Nonlinear Regression}, New York: Wiley & Sons (pp. 338--339). +#' +#' Ritz, C. (2009) +#' Towards a unified approach to dose-response modeling in ecotoxicology. +#' \emph{Environ Toxicol Chem}, \bold{29}, 220--229. +#' +#' @seealso \code{\link{weibull1}}, \code{\link{W1.2}}, \code{\link{W1.3}} +#' +#' @examples +#' terbuthylazin.m1 <- drm(rgr ~ dose, data = terbuthylazin, fct = W1.4()) +#' +#' @keywords models nonlinear +"W1.4" <- +function(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) +{ + ## Checking arguments + numParm <- 4 + if (!(length(fixed) == numParm)) {stop("Not correct length of 'fixed' argument")} + if (!is.character(names) | !(length(names) == numParm)) {stop("Not correct 'names' argument")} + + return(weibull1(fixed = fixed, names = names, + fctName = as.character(match.call()[[1]]), + fctText = "Weibull (type 1)", ...)) +} + +#' @rdname W1.4 +w4 <- W1.4 + + +#' @title Two-parameter exponential decay model +#' +#' @description +#' A two-parameter exponential decay model with the slope parameter \code{b} +#' fixed at 1 and the lower limit fixed at 0. +#' +#' @details +#' The model is given by the expression +#' \deqn{f(x) = d \exp(-x/e)} +#' +#' This is a special case of the Weibull type 1 model +#' (\code{\link{weibull1}}) with the slope fixed at 1 and the lower limit +#' fixed at 0. +#' +#' @param fixed numeric vector of length 2. Specifies which parameters are +#' fixed and at what value. Use \code{NA} for parameters that are not fixed. +#' @param names character vector of length 2 giving the names of the +#' parameters. The default is \code{c("d", "e")}. +#' @param \dots additional arguments passed to \code{\link{weibull1}}, most +#' notably \code{method} (a character string: \code{"1"} (default), +#' \code{"2"}, \code{"3"}, or \code{"4"}) which selects the self-starter +#' method for obtaining starting values. See \code{\link{weibull1}} for +#' details. +#' +#' @return A list of class \code{Weibull-1} containing the nonlinear function, +#' self starter function, and parameter names. +#' +#' @references +#' Seber, G. A. F. and Wild, C. J. (1989) +#' \emph{Nonlinear Regression}, New York: Wiley & Sons (pp. 338--339). +#' +#' @seealso \code{\link{EXD.3}}, \code{\link{AR.2}}, \code{\link{AR.3}}, +#' \code{\link{weibull1}} +#' +#' @examples +#' ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = EXD.2()) +#' +#' @keywords models nonlinear +"EXD.2" <- +function(fixed = c(NA, NA), names = c("d", "e"), ...) +{ + ## Checking arguments + numParm <- 2 + if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct 'names' argument")} + if (!(length(fixed)==numParm)) {stop("Not correct length of 'fixed' argument")} + + return(weibull1(fixed = c(1, 0, fixed[1:2]), + names = c("b", "c", names[1:2]), + fctName = as.character(match.call()[[1]]), + fctText = lowFixed("Exponential decay"), ...)) +} + +#' @title Three-parameter exponential decay model +#' +#' @description +#' A three-parameter exponential decay model with the slope parameter \code{b} +#' fixed at 1. +#' +#' @details +#' The model is given by the expression +#' \deqn{f(x) = c + (d - c) \exp(-x/e)} +#' +#' This is a special case of the Weibull type 1 model +#' (\code{\link{weibull1}}) with the slope fixed at 1. +#' +#' @param fixed numeric vector of length 3. Specifies which parameters are +#' fixed and at what value. Use \code{NA} for parameters that are not fixed. +#' @param names character vector of length 3 giving the names of the +#' parameters. The default is \code{c("c", "d", "e")}. +#' @param \dots additional arguments passed to \code{\link{weibull1}}, most +#' notably \code{method} (a character string: \code{"1"} (default), +#' \code{"2"}, \code{"3"}, or \code{"4"}) which selects the self-starter +#' method for obtaining starting values. See \code{\link{weibull1}} for +#' details. +#' +#' @return A list of class \code{Weibull-1} containing the nonlinear function, +#' self starter function, and parameter names. +#' +#' @references +#' Seber, G. A. F. and Wild, C. J. (1989) +#' \emph{Nonlinear Regression}, New York: Wiley & Sons (pp. 338--339). +#' +#' @seealso \code{\link{EXD.2}}, \code{\link{AR.2}}, \code{\link{AR.3}}, +#' \code{\link{weibull1}} +#' +#' @examples +#' ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = EXD.3()) +#' +#' @keywords models nonlinear +"EXD.3" <- +function(fixed = c(NA, NA, NA), names = c("c", "d", "e"), ...) +{ + ## Checking arguments + numParm <- 3 + if (!(length(fixed) == numParm)) {stop("Not correct length of 'fixed' argument")} + if (!is.character(names) | !(length(names) == numParm)) {stop("Not correct 'names' argument")} + + return(weibull1(fixed = c(1, fixed[1:3]), + names = c("b", names[1:3]), + fctName = as.character(match.call()[[1]]), + fctText = "Shifted exponential decay", ...)) +} diff --git a/R/weibull1.r b/R/weibull1.r deleted file mode 100644 index d6353bda..00000000 --- a/R/weibull1.r +++ /dev/null @@ -1,323 +0,0 @@ -"weibull1" <- function( -fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), -method = c("1", "2", "3", "4"), ssfct = NULL, -fctName, fctText) -{ - ## Checking arguments - numParm <- 4 - if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct 'names' argument")} - if (!(length(fixed)==numParm)) {stop("Not correct 'fixed' argument")} - -# if (!is.logical(useD)) {stop("Not logical useD argument")} -# if (useD) {stop("Derivatives not available")} - - notFixed <- is.na(fixed) - parmVec <- rep(0, numParm) - parmVec[!notFixed] <- fixed[!notFixed] - parmVec1 <- parmVec - parmVec2 <- parmVec - - - ## Defining the non-linear function - fct <- function(dose, parm) - { - parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE) - parmMat[, notFixed] <- parm - - parmMat[, 2] + (parmMat[, 3] - parmMat[, 2]) * exp( -exp(parmMat[, 1] *(log(dose) - log(parmMat[, 4])))) - } - - -# ## Defining value for control measurements (dose=0) -# confct <- function(drcSign) -# { -# if (drcSign>0) {conPos <- 2} else {conPos <- 3} -# confct2 <- function(parm) -# { -# parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE) -# parmMat[, notFixed] <- parm -# parmMat[, conPos] -# } -# return(list(pos = conPos, fct = confct2)) -# } - - -# ## Defining flag to indicate if more general ANOVA model -## anovaYes <- list(bin = !any(is.na(fixed[c(2,3)])) , cont = TRUE) -# binVar <- all(fixed[c(2, 3)]==c(0, 1)) -# if (is.na(binVar)) {binVar <- FALSE} -# if (!binVar) {binVar <- NULL} -# anovaYes <- list(bin = binVar, cont = TRUE) - - - ## Defining the self starter function -if (FALSE) -{ - ssfct <- function(dataFra) - { - dose2 <- dataFra[, 1] - resp3 <- dataFra[, 2] - - startVal <- rep(0, numParm) - - if (is.na(fixed[2])) - { - startVal[2] <- min(resp3) # the lower bound - } else { - startVal[2] <- fixed[2] - } - - if (is.na(fixed[3])) - { - startVal[3] <- max(resp3) # the upper bound - } else { - startVal[3] <- fixed[3] - } - - - if (length(unique(dose2))==1) {return((c(NA, NA, startVal[3], NA))[notFixed])} - # only estimate of upper limit if a single unique dose value - - indexT2 <- (dose2>0) - if (!any(indexT2)) {return((rep(NA, numParm))[notFixed])} # for negative dose value - dose3 <- dose2[indexT2] - resp3 <- resp3[indexT2] - -# loglogTrans <- log(-log((resp3-startVal[2] + 0.001)/(startVal[3]-startVal[2]))) # 0.001 to avoid 0 as argument to log - -# loglogTrans <- log(-log(abs(resp3 - startVal[2] - startVal[3]/((pi*pi)^2))/(startVal[3] - startVal[2]))) - loglogTrans <- log(-log((resp3 - startVal[2])/(startVal[3] - startVal[2]))) - - isFin <- is.finite(loglogTrans) - loglogTrans <- loglogTrans[isFin] - dose3 <- dose3[isFin] - -# print(resp3) -# print(loglogTrans) -# print(log(dose3)) - loglogFit <- lm(loglogTrans ~ log(dose3)) - - if (is.na(fixed[4])) - { - startVal[4] <- exp(-coef(loglogFit)[1]/coef(loglogFit)[2]) # the e parameter - } else { - startVal[4] <- fixed[4] - } -# startVal[4] <- exp(-coef(loglogFit)[1]/coef(loglogFit)[2]) # the e parameter - - if (is.na(fixed[1])) - { - startVal[1] <- coef(loglogFit)[2] # the b parameter - } else { - startVal[1] <- fixed[1] - } -# startVal[1] <- coef(loglogFit)[2] # the b parameter - - - ## Avoiding 0 as start value for lower limit (convergence will fail) - if ( startVal[2] < 1e-12 ) {startVal[2] <- startVal[3]/10} - -# print(startVal) - return(startVal[notFixed]) - } -} - if (!is.null(ssfct)) - { - ssfct <- ssfct # in case it is explicitly provided - } else { - ssfct <- weibull1.ssf(method, fixed) - } - - - - ## Defining names - names <- names[notFixed] - - -# ## Defining parameter to be scaled -# if ( (scaleDose) && (is.na(fixed[4])) ) -# { -# scaleInd <- sum(is.na(fixed[1:4])) -# } else { -# scaleInd <- NULL -# } - - - ## Defining derivatives - ## Defining derivatives - deriv1 <- function(dose, parm) - { - parmMat <- matrix(parmVec, nrow(parm), numParm, byrow=TRUE) - parmMat[, notFixed] <- parm - - t1 <- parmMat[, 3] - parmMat[, 2] - t2 <- exp(parmMat[, 1]*(log(dose) - log(parmMat[, 4]))) - t3 <- exp(-t2) - - derMat <- as.matrix(cbind( -t1 * divAtInf(xlogx(dose/parmMat[, 4], parmMat[, 1]), exp(t2)), - 1 - t3, - t3, - t1 * divAtInf(t2, exp(t2)) * parmMat[, 1]/parmMat[, 4] )) - return(derMat[, notFixed]) - } - deriv2 <- NULL - - - ## Defining the first derivative (in x=dose) - ## based on deriv(~c+(d-c)*(exp(-exp(b*(log(x)-log(e))))), "x", function(x, b,c,d,e){}) - derivx <- function(x, parm) - { - parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE) - parmMat[, notFixed] <- parm - - .expr1 <- parmMat[, 3] - parmMat[, 2] # d - c - .expr6 <- exp(parmMat[, 1] * (log(x) - log(parmMat[, 4]))) - .expr8 <- exp(-.expr6) - .value <- parmMat[, 2] + .expr1 * .expr8 - .grad <- array(0, c(length(.value), 1L), list(NULL, c("x"))) - .grad[, "x"] <- -(.expr1 * (.expr8 * (.expr6 * (parmMat[, 1] * (1/x))))) - .grad - } - -# ## Limits -# if (length(lowerc)==numParm) {lowerLimits <- lowerc[notFixed]} else {lowerLimits <- lowerc} -# if (length(upperc)==numParm) {upperLimits <- upperc[notFixed]} else {upperLimits <- upperc} - - - ## Defining the ED function - edfct <- function(parm, respl, reference, type, ...) # function(parm, p, reference, type, ...) - { - parmVec[notFixed] <- parm - p <- EDhelper(parmVec, respl, reference, type) - -# if (type == "absolute") {p <- 100*((parmVec[3] - p)/(parmVec[3] - parmVec[2]))} -# if ( (parmVec[1] < 0) && (reference == "control") ) {p <- 100 - p} - - tempVal <- log(-log((100-p)/100)) - EDp <- exp(tempVal/parmVec[1] + log(parmVec[4])) - - EDder <- EDp*c(-tempVal/(parmVec[1]^2), 0, 0, 1/parmVec[4]) - - return(list(EDp, EDder[notFixed])) - } - -# -# ## Defining the SI function -# sifct <- function(parm1, parm2, pair) -# { -# parmVec1[notFixed] <- parm1 -# parmVec2[notFixed] <- parm2 -# -# tempVal1 <- log(-log((100-pair[1])/100)) -# tempVal2 <- log(-log((100-pair[2])/100)) -# -# SIpair <- exp(tempVal1/parmVec1[1] + log(parmVec1[4]))/exp(tempVal2/parmVec2[1] + log(parmVec2[4])) -# -# SIder1 <- SIpair*c(-tempVal1/(parmVec1[1]*parmVec1[1]), 0, 0, 1/parmVec1[4]) -# SIder2 <- SIpair*c(tempVal2/(parmVec2[1]*parmVec2[1]), 0, 0, -1/parmVec2[4]) -# -# return(list(SIpair, SIder1[notFixed], SIder2[notFixed])) -# } - - - returnList <- - list(fct = fct, ssfct = ssfct, names = names, deriv1 = deriv1, deriv2 = deriv2, derivx = derivx, edfct = edfct, -# lowerc=lowerLimits, upperc=upperLimits, confct=confct, anovaYes=anovaYes, -# scaleInd = scaleInd, - name = ifelse(missing(fctName), as.character(match.call()[[1]]), fctName), - text = ifelse(missing(fctText), "Weibull (type 1)", fctText), - noParm = sum(is.na(fixed)), - fixed = fixed) - - class(returnList) <- "Weibull-1" - invisible(returnList) -} - - -"W1.2" <- -function(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) -{ - ## Checking arguments - numParm <- 2 - if (!is.character(names) | !(length(names) == numParm)) {stop("Not correct 'names' argument")} - if (!(length(fixed) == numParm)) {stop("Not correct length of 'fixed' argument")} - - return(weibull1(fixed = c(fixed[1], 0, upper, fixed[2]), names = c(names[1], "c", "d", names[2]), - fctName = as.character(match.call()[[1]]), - fctText = lowupFixed("Weibull (type 1)", upper), ...)) -} - -w2 <- W1.2 - -"W1.3" <- -function(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) -{ - ## Checking arguments - numParm <- 3 - if (!is.character(names) | !(length(names) == numParm)) {stop("Not correct 'names' argument")} - if (!(length(fixed) == numParm)) {stop("Not correct length of 'fixed' argument")} - - return(weibull1(fixed = c(fixed[1], 0, fixed[2:3]), names = c(names[1], "c", names[2:3]), - fctName = as.character(match.call()[[1]]), - fctText = lowFixed("Weibull (type 1)"), ...)) -} - -w3 <- W1.3 - -"W1.3u" <- -function(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...) -{ - ## Checking arguments - numParm <- 3 - if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct 'names' argument")} - if (!(length(fixed)==numParm)) {stop("Not correct length of 'fixed' argument")} - - return(weibull1(fixed = c(fixed[1:2], upper, fixed[3]), - names = c(names[1:2], "d", names[3]), - fctName = as.character(match.call()[[1]]), - fctText = upFixed("Weibull (type 1)", upper), ...)) -} - -"W1.4" <- -function(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) -{ - ## Checking arguments - numParm <- 4 - if (!(length(fixed) == numParm)) {stop("Not correct length of 'fixed' argument")} - if (!is.character(names) | !(length(names) == numParm)) {stop("Not correct 'names' argument")} - - return(weibull1(fixed = fixed, names = names, - fctName = as.character(match.call()[[1]]), - fctText = "Weibull (type 1)", ...)) -} - -w4 <- W1.4 - - -"EXD.2" <- -function(fixed = c(NA, NA), names = c("d", "e"), ...) -{ - ## Checking arguments - numParm <- 2 - if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct 'names' argument")} - if (!(length(fixed)==numParm)) {stop("Not correct length of 'fixed' argument")} - - return(weibull1(fixed = c(1, 0, fixed[1:2]), - names = c("b", "c", names[1:2]), - fctName = as.character(match.call()[[1]]), - fctText = lowFixed("Exponential decay"), ...)) -} - -"EXD.3" <- -function(fixed = c(NA, NA, NA), names = c("c", "d", "e"), ...) -{ - ## Checking arguments - numParm <- 3 - if (!(length(fixed) == numParm)) {stop("Not correct length of 'fixed' argument")} - if (!is.character(names) | !(length(names) == numParm)) {stop("Not correct 'names' argument")} - - return(weibull1(fixed = c(1, fixed[1:3]), - names = c("b", names[1:3]), - fctName = as.character(match.call()[[1]]), - fctText = "Shifted exponential decay", ...)) -} diff --git a/R/weibull1.ssf.R b/R/weibull1.ssf.R index bda5da98..ce013431 100644 --- a/R/weibull1.ssf.R +++ b/R/weibull1.ssf.R @@ -1,31 +1,33 @@ -"weibull1.ssf" <- function(method = c("1", "2", "3", "4"), fixed, useFixed = FALSE) -{ - method <- match.arg(method) - - ## Defining helper functions (used below) - ytrans <- function(y, cVal, dVal) {log(-log((y - cVal)/(dVal - cVal)))} - bfct <- function(x, y, cVal, dVal, eVal) {ytrans(y, cVal, dVal)/log(x/eVal)} - efct <- function(x, y, bVal, cVal, dVal) {x * exp(-ytrans(y, cVal, dVal)/bVal)} - - ## Assigning function for finding initial b and e parameter values - findbe <- switch(method, - "1" = findbe1(function(x) {rVec <- log(x); rVec[!x>0] <- NA; rVec}, ytrans), - "2" = findbe2(bfct, efct, "Anke"), - "3" = findbe3(), - "4" = findbe2(bfct, efct, "Normolle")) - - function(dframe) - { - x <- dframe[, 1] - y <- dframe[, 2] - - ## Finding initial values for the c and d parameters - cdVal <- findcd(x, y) - if (useFixed) {} # not implemented at the moment - - ## Finding initial values for the b and e parameters - beVal <- findbe(x, y, cdVal[1], cdVal[2]) - - return(c(beVal[1], cdVal, beVal[2])[is.na(fixed)]) - } +#' @title Self-starter for Weibull type 1 model +#' @keywords internal +"weibull1.ssf" <- function(method = c("1", "2", "3", "4"), fixed, useFixed = FALSE) +{ + method <- match.arg(method) + + ## Defining helper functions (used below) + ytrans <- function(y, cVal, dVal) {log(-log((y - cVal)/(dVal - cVal)))} + bfct <- function(x, y, cVal, dVal, eVal) {ytrans(y, cVal, dVal)/log(x/eVal)} + efct <- function(x, y, bVal, cVal, dVal) {x * exp(-ytrans(y, cVal, dVal)/bVal)} + + ## Assigning function for finding initial b and e parameter values + findbe <- switch(method, + "1" = findbe1(function(x) {rVec <- log(x); rVec[!x>0] <- NA; rVec}, ytrans), + "2" = findbe2(bfct, efct, "Anke"), + "3" = findbe3(), + "4" = findbe2(bfct, efct, "Normolle")) + + function(dframe) + { + x <- dframe[, 1] + y <- dframe[, 2] + + ## Finding initial values for the c and d parameters + cdVal <- findcd(x, y) + if (useFixed) {} # not implemented at the moment + + ## Finding initial values for the b and e parameters + beVal <- findbe(x, y, cdVal[1], cdVal[2]) + + return(c(beVal[1], cdVal, beVal[2])[is.na(fixed)]) + } } \ No newline at end of file diff --git a/R/weibull2.R b/R/weibull2.R new file mode 100644 index 00000000..2c49e32b --- /dev/null +++ b/R/weibull2.R @@ -0,0 +1,413 @@ +#' The four-parameter Weibull (type 2) model +#' +#' Provides a general framework for the four-parameter Weibull type 2 model +#' given by the equation +#' \deqn{f(x) = c + (d - c)(1 - \exp(-\exp(b(\log(x) - \log(e)))))} +#' +#' @details +#' The \code{method} argument determines how starting values for the parameters +#' \code{b} and \code{e} are estimated (the starting values for \code{c} and +#' \code{d} are always based on the range of the response values). Four methods +#' are available: +#' \describe{ +#' \item{\code{"1"} (default)}{Linear regression on transformed data. Applies a +#' complementary log-log transformation to the response and a log +#' transformation to the dose, then fits a linear regression to estimate +#' starting values for \code{b} and \code{e}.} +#' \item{\code{"2"}}{Anke's procedure. Estimates \code{e} by finding the dose +#' at which the response crosses the midpoint between \code{c} and \code{d}, +#' then estimates \code{b} as the median of back-calculated values.} +#' \item{\code{"3"}}{Stepwise approach. Identifies where the mean response +#' crosses the midpoint between \code{c} and \code{d} and uses the +#' corresponding dose as the starting value for \code{e}. The starting value +#' for \code{b} is based on the sign of the slope at that point.} +#' \item{\code{"4"}}{Normolle's procedure. Uses the mean of the dose range as +#' an initial estimate for \code{e}, then estimates \code{b} and \code{e} +#' using median-based back-calculations.} +#' } +#' +#' @param fixed numeric vector of length 4, specifying fixed parameters (use \code{NA} for +#' parameters that should be estimated). +#' @param names character vector of length 4 giving the names of the parameters +#' (default \code{c("b", "c", "d", "e")}). +#' @param method character string indicating the self starter method to use for +#' obtaining starting values. One of \code{"1"} (default), \code{"2"}, +#' \code{"3"}, or \code{"4"}. See Details. +#' @param ssfct a self starter function. If \code{NULL} (default), a built-in +#' self starter is used based on \code{method}. +#' @param fctName optional character string used internally for the function name. +#' @param fctText optional character string used internally for the function description. +#' +#' @return A list containing the nonlinear function, self starter function, +#' and parameter names. The list has class \code{"Weibull-2"}. +#' +#' @author Christian Ritz +#' +#' @references Seber, G. A. F. and Wild, C. J. (1989) +#' \emph{Nonlinear Regression}, New York: Wiley & Sons (pp. 338--339). +#' +#' @seealso \code{\link{weibull1}}, \code{\link{W2.2}}, \code{\link{W2.3}}, +#' \code{\link{W2.4}} +#' +#' @keywords models nonlinear +"weibull2" <- function( +fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), +method = c("1", "2", "3", "4"), ssfct = NULL, +fctName, fctText) +{ + ## Checking arguments + numParm <- 4 + if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct 'names' argument")} + if (!(length(fixed)==numParm)) {stop("Not correct 'fixed' argument")} + + notFixed <- is.na(fixed) + parmVec <- rep(0, numParm) + parmVec[!notFixed] <- fixed[!notFixed] + parmVec1 <- parmVec + parmVec2 <- parmVec + + + ## Defining the non-linear function + fct <- function(dose, parm) + { + parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE) + parmMat[, notFixed] <- parm + + parmMat[,2] + (parmMat[,3] - parmMat[,2]) * (1 - exp(-exp(parmMat[,1] *(log(dose) - log(parmMat[,4]))))) + } + + + ## Defining the self starter function + if (!is.null(ssfct)) + { + ssfct <- ssfct # in case it is explicitly provided + } else { + ssfct <- weibull2.ssf(method, fixed) + } + + + ## Defining names + w2.names <- names[notFixed] + + + ## Defining derivatives + deriv1 <- function(dose, parm) + { + parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE) + parmMat[, notFixed] <- parm + + t1 <- parmMat[, 3] - parmMat[, 2] + t2 <- exp(parmMat[, 1]*(log(dose) - log(parmMat[, 4]))) + t3 <- exp(-t2) + + derMat <- as.matrix(cbind( t1*xexplogx(dose/parmMat[, 4], parmMat[, 1]), + 1 - (1 - t3), + 1 - t3, + -t1*xexpx(dose/parmMat[, 4], parmMat[, 1])*parmMat[, 1]/parmMat[, 4] )) + return(derMat[, notFixed]) + } + deriv2 <- NULL + + + ## Defining the first derivative (in x=dose) + ## based on deriv(~c+(d-c)*(1 - exp(-exp(b*(log(x)-log(e))))), "x", function(x, b,c,d,e){}) + derivx <- function(x, parm) + { + parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE) + parmMat[, notFixed] <- parm + + .expr1 <- parmMat[, 3] - parmMat[, 2] + .expr6 <- exp(parmMat[, 1] * (log(x) - log(parmMat[, 4]))) + .expr8 <- exp(-.expr6) + .value <- parmMat[, 2] + .expr1 * (1 - .expr8) + .grad <- array(0, c(length(.value), 1L), list(NULL, c("x"))) + .grad[, "x"] <- .expr1 * (.expr8 * (.expr6 * (parmMat[, 1] * (1/x)))) + .grad + } + + + ## Defining the ED function + edfct <- function(parm, p, reference, type, ...) + { + parmVec[notFixed] <- parm + respl <- p # save original response level + + p <- absToRel(parmVec, p, type) + + ## Reversing p + if (identical(type, "absolute") && (parmVec[1] > 0) && (reference == "control")) + { + p <- 100 - p + } + + result <- weibull1(fixed, names)$edfct(parm, p, reference, "relative", ...) + + ## Fix: correct c and d derivatives for absolute type using central differences. + ## The delegation to weibull1 with type="relative" produces zero derivatives + ## for c and d, missing the chain-rule contribution from the + ## absolute-to-relative conversion (absToRel) where p depends on c and d. + if (identical(type, "absolute")) { + .edval <- function(pv) { + p0 <- absToRel(pv, respl, type) + # Replicate weibull2's reversal (for b > 0 and absolute type) + if (pv[1] > 0 && identical(reference, "control")) p0 <- 100 - p0 + # Replicate weibull1's EDhelper swap (for b < 0 and relative type) + if (pv[1] < 0 && identical(reference, "control")) p0 <- 100 - p0 + tv0 <- log(-log((100 - p0) / 100)) + exp(tv0 / pv[1] + log(pv[4])) + } + .eps <- .Machine$double.eps + .nfIdx <- which(notFixed) + for (.i in c(2, 3)) { + if (!notFixed[.i]) next + .h <- if (abs(parmVec[.i]) > sqrt(.eps)) abs(parmVec[.i]) * .eps^(1/3) else .eps^(1/3) + .pvUp <- replace(parmVec, .i, parmVec[.i] + .h) + .pvDn <- replace(parmVec, .i, parmVec[.i] - .h) + .pos <- which(.nfIdx == .i) + if (length(.pos) == 1L) { + result[[2]][.pos] <- (.edval(.pvUp) - .edval(.pvDn)) / (2 * .h) + } + } + } + + result + } + + + returnList <- + list(fct = fct, ssfct = ssfct, names = w2.names, deriv1 = deriv1, deriv2 = deriv2, derivx = derivx, edfct = edfct, + name = ifelse(missing(fctName),as.character(match.call()[[1]]), fctName), + text = ifelse(missing(fctText), "Weibull (type 2)", fctText), + noParm = sum(is.na(fixed)), + fixed = fixed) + + class(returnList) <- "Weibull-2" + invisible(returnList) +} + + +#' Two-parameter Weibull (type 2) model +#' +#' A two-parameter Weibull type 2 model with the lower limit fixed at 0 and the +#' upper limit fixed at a specified value. The model is given by the equation +#' \deqn{f(x) = \mathrm{upper} \cdot (1 - \exp(-\exp(b(\log(x) - \log(e)))))} +#' This model is primarily intended for binomial/quantal responses. +#' +#' @param upper numeric value giving the fixed upper limit (default 1). +#' @param fixed numeric vector of length 2, specifying fixed parameters (use \code{NA} for +#' parameters that should be estimated). +#' @param names character vector of length 2 giving the names of the parameters +#' (default \code{c("b", "e")}). +#' @param ... additional arguments passed to \code{\link{weibull2}}, most +#' notably \code{method} (a character string: \code{"1"} (default), +#' \code{"2"}, \code{"3"}, or \code{"4"}) which selects the self-starter +#' method for obtaining starting values. See \code{\link{weibull2}} for +#' details. +#' +#' @return A list of class \code{"Weibull-2"} as returned by \code{\link{weibull2}}. +#' +#' @seealso \code{\link{weibull2}}, \code{\link{W2.3}}, \code{\link{W2.4}}, +#' \code{\link{W1.2}} +#' +#' @examples +#' earthworms.m1 <- drm(number/total ~ dose, weights = total, +#' data = earthworms, fct = W2.2(), type = "binomial") +#' +#' @keywords models nonlinear +"W2.2" <- function( +upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) +{ + ## Checking arguments + numParm <- 2 + if (!is.character(names) | !(length(names) == numParm)) {stop("Not correct 'names' argument")} + if (!(length(fixed) == numParm)) {stop("Not correct length of 'fixed' argument")} + + return(weibull2(fixed = c(fixed[1], 0, upper, fixed[2]), names = c(names[1], "c", "d", names[2]), + fctName = as.character(match.call()[[1]]), + fctText = lowupFixed("Weibull (type 2)", upper), ...)) +} + +#' Three-parameter Weibull (type 2) model +#' +#' A three-parameter Weibull type 2 model with the lower limit fixed at 0. +#' The model is given by the equation +#' \deqn{f(x) = d \cdot (1 - \exp(-\exp(b(\log(x) - \log(e)))))} +#' +#' @param fixed numeric vector of length 3, specifying fixed parameters (use \code{NA} for +#' parameters that should be estimated). +#' @param names character vector of length 3 giving the names of the parameters +#' (default \code{c("b", "d", "e")}). +#' @param ... additional arguments passed to \code{\link{weibull2}}, most +#' notably \code{method} (a character string: \code{"1"} (default), +#' \code{"2"}, \code{"3"}, or \code{"4"}) which selects the self-starter +#' method for obtaining starting values. See \code{\link{weibull2}} for +#' details. +#' +#' @return A list of class \code{"Weibull-2"} as returned by \code{\link{weibull2}}. +#' +#' @seealso \code{\link{weibull2}}, \code{\link{W2.2}}, \code{\link{W2.4}} +#' +#' @examples +#' ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W2.3()) +#' +#' @keywords models nonlinear +"W2.3" <- +function(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) +{ + ## Checking arguments + numParm <- 3 + if (!is.character(names) | !(length(names) == numParm)) {stop("Not correct 'names' argument")} + if (!(length(fixed) == numParm)) {stop("Not correct length of 'fixed' argument")} + + return(weibull2(fixed = c(fixed[1], 0, fixed[2:3]), names = c(names[1], "c", names[2:3]), + fctName = as.character(match.call()[[1]]), + fctText = lowFixed("Weibull (type 2)"), ...)) +} + +#' Three-parameter Weibull (type 2) model with upper limit fixed +#' +#' A three-parameter Weibull type 2 model with the upper limit fixed at a +#' specified value. The model is given by the equation +#' \deqn{f(x) = c + (\mathrm{upper} - c)(1 - \exp(-\exp(b(\log(x) - \log(e)))))} +#' +#' @param upper numeric value giving the fixed upper limit (default 1). +#' @param fixed numeric vector of length 3, specifying fixed parameters (use \code{NA} for +#' parameters that should be estimated). +#' @param names character vector of length 3 giving the names of the parameters +#' (default \code{c("b", "c", "e")}). +#' @param ... additional arguments passed to \code{\link{weibull2}}, most +#' notably \code{method} (a character string: \code{"1"} (default), +#' \code{"2"}, \code{"3"}, or \code{"4"}) which selects the self-starter +#' method for obtaining starting values. See \code{\link{weibull2}} for +#' details. +#' +#' @return A list of class \code{"Weibull-2"} as returned by \code{\link{weibull2}}. +#' +#' @seealso \code{\link{weibull2}}, \code{\link{W2.3}}, \code{\link{W2.4}} +#' +#' @keywords models nonlinear +"W2.3u" <- +function(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...) +{ + ## Checking arguments + numParm <- 3 + if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct 'names' argument")} + if (!(length(fixed)==numParm)) {stop("Not correct length of 'fixed' argument")} + + return(weibull2(fixed = c(fixed[1:2], upper, fixed[3]), + names = c(names[1:2], "d", names[3]), + fctName = as.character(match.call()[[1]]), + fctText = upFixed("Weibull (type 2)", upper), ...)) +} + +#' Four-parameter Weibull (type 2) model +#' +#' A four-parameter Weibull type 2 model. The model is given by the equation +#' \deqn{f(x) = c + (d - c)(1 - \exp(-\exp(b(\log(x) - \log(e)))))} +#' +#' @param fixed numeric vector of length 4, specifying fixed parameters (use \code{NA} for +#' parameters that should be estimated). +#' @param names character vector of length 4 giving the names of the parameters +#' (default \code{c("b", "c", "d", "e")}). +#' @param ... additional arguments passed to \code{\link{weibull2}}, most +#' notably \code{method} (a character string: \code{"1"} (default), +#' \code{"2"}, \code{"3"}, or \code{"4"}) which selects the self-starter +#' method for obtaining starting values. See \code{\link{weibull2}} for +#' details. +#' +#' @return A list of class \code{"Weibull-2"} as returned by \code{\link{weibull2}}. +#' +#' @seealso \code{\link{weibull2}}, \code{\link{W2.2}}, \code{\link{W2.3}} +#' +#' @examples +#' terbuthylazin.m1 <- drm(rgr ~ dose, data = terbuthylazin, fct = W2.4()) +#' +#' @keywords models nonlinear +"W2.4" <- +function(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) +{ + ## Checking arguments + numParm <- 4 + if (!(length(fixed) == numParm)) {stop("Not correct length of 'fixed' argument")} + if (!is.character(names) | !(length(names) == numParm)) {stop("Not correct 'names' argument")} + + return(weibull2(fixed = fixed, names = names, + fctName = as.character(match.call()[[1]]), + fctText = "Weibull (type 2)", ...)) +} + +#' Two-parameter asymptotic regression model +#' +#' A two-parameter asymptotic regression model where \code{b} is fixed at 1 and +#' the lower limit is fixed at 0. The model is given by the equation +#' \deqn{f(x) = d \cdot (1 - \exp(-x / e))} +#' +#' @param fixed numeric vector of length 2, specifying fixed parameters (use \code{NA} for +#' parameters that should be estimated). +#' @param names character vector of length 2 giving the names of the parameters +#' (default \code{c("d", "e")}). +#' @param ... additional arguments passed to \code{\link{weibull2}}, most +#' notably \code{method} (a character string: \code{"1"} (default), +#' \code{"2"}, \code{"3"}, or \code{"4"}) which selects the self-starter +#' method for obtaining starting values. See \code{\link{weibull2}} for +#' details. +#' +#' @return A list of class \code{"Weibull-2"} as returned by \code{\link{weibull2}}. +#' +#' @seealso \code{\link{AR.3}}, \code{\link{weibull2}}, \code{\link{EXD.2}} +#' +#' @examples +#' ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = AR.2()) +#' +#' @keywords models nonlinear +"AR.2" <- +function(fixed = c(NA, NA), names = c("d", "e"), ...) +{ + ## Checking arguments + numParm <- 2 + if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct 'names' argument")} + if (!(length(fixed)==numParm)) {stop("Not correct length of 'fixed' argument")} + + return(weibull2(fixed = c(1, 0, fixed[1:2]), + names = c("b", "c", names[1:2]), + fctName = as.character(match.call()[[1]]), + fctText = lowFixed("Asymptotic regression"), ...)) +} + +#' Three-parameter shifted asymptotic regression model +#' +#' A three-parameter asymptotic regression model where \code{b} is fixed at 1. +#' The model is given by the equation +#' \deqn{f(x) = c + (d - c)(1 - \exp(-x / e))} +#' +#' @param fixed numeric vector of length 3, specifying fixed parameters (use \code{NA} for +#' parameters that should be estimated). +#' @param names character vector of length 3 giving the names of the parameters +#' (default \code{c("c", "d", "e")}). +#' @param ... additional arguments passed to \code{\link{weibull2}}, most +#' notably \code{method} (a character string: \code{"1"} (default), +#' \code{"2"}, \code{"3"}, or \code{"4"}) which selects the self-starter +#' method for obtaining starting values. See \code{\link{weibull2}} for +#' details. +#' +#' @return A list of class \code{"Weibull-2"} as returned by \code{\link{weibull2}}. +#' +#' @seealso \code{\link{AR.2}}, \code{\link{weibull2}}, \code{\link{EXD.3}} +#' +#' @examples +#' ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = AR.3()) +#' +#' @keywords models nonlinear +"AR.3" <- +function(fixed = c(NA, NA, NA), names = c("c", "d", "e"), ...) +{ + ## Checking arguments + numParm <- 3 + if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct 'names' argument")} + if (!(length(fixed)==numParm)) {stop("Not correct length of 'fixed' argument")} + + return(weibull2(fixed = c(1, fixed[1:3]), + names = c("b", names[1:3]), + fctName = as.character(match.call()[[1]]), + fctText = "Shifted asymptotic regression", ...)) +} diff --git a/R/weibull2.r b/R/weibull2.r deleted file mode 100644 index 41d03584..00000000 --- a/R/weibull2.r +++ /dev/null @@ -1,308 +0,0 @@ -"weibull2" <- function( -fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), -method = c("1", "2", "3", "4"), ssfct = NULL, -fctName, fctText) -{ - ## Checking arguments - numParm <- 4 - if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct 'names' argument")} - if (!(length(fixed)==numParm)) {stop("Not correct 'fixed' argument")} - -# if (!is.logical(useD)) {stop("Not logical useD argument")} -# if (useD) {stop("Derivatives not available")} - - notFixed <- is.na(fixed) - parmVec <- rep(0, numParm) - parmVec[!notFixed] <- fixed[!notFixed] - parmVec1 <- parmVec - parmVec2 <- parmVec - - - ## Defining the non-linear function - fct <- function(dose, parm) - { - parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE) - parmMat[, notFixed] <- parm - - parmMat[,2] + (parmMat[,3] - parmMat[,2]) * (1 - exp(-exp(parmMat[,1] *(log(dose) - log(parmMat[,4]))))) - } - - -# ## Defining value for control measurements (dose=0) -# confct <- function(drcSign) -# { -# if (drcSign>0) {conPos <- 2} else {conPos <- 3} -# confct2 <- function(parm) -# { -# parmMat <- matrix(parmVec, nrow(parm), numParm, byrow=TRUE) -# parmMat[, notFixed] <- parm -# parmMat[, conPos] -# } -# return(list(pos=conPos, fct=confct2)) -# } -# -# -# ## Defining flag to indicate if more general ANOVA model -# anovaYes <- TRUE - - - ## Defining the self starter function -if (FALSE) -{ - ssfct <- function(dataFra) - { - dose2 <- dataFra[,1] - resp3 <- dataFra[,2] - - startVal <- rep(0, numParm) - startVal[3] <- max(resp3) # +0.001 # the upper bound - startVal[2] <- min(resp3) # -0.001 # the lower bound -# startVal[!notFixed] <- fixed[!notFixed] - - if (length(unique(dose2))==1) {return((c(NA, NA, startVal[3], NA))[notFixed])} - # only estimate of upper limit if a single unique dose value - - indexT2 <- (dose2>0) - if (!any(indexT2)) {return((rep(NA, numParm))[notFixed])} # for negative dose value - dose3 <- dose2[indexT2] - resp3 <- resp3[indexT2] - - loglogTrans <- log(-log((startVal[3] - resp3 + 0.001)/(startVal[3]-startVal[2]))) # 0.001 to avoid 0 as argument to log - - loglogFit <- lm(loglogTrans~log(dose3)) - startVal[4] <- exp(-coef(loglogFit)[1]/coef(loglogFit)[2]) # the e parameter - startVal[1] <- coef(loglogFit)[2] # the b parameter - - ## Avoiding 0 as start value for lower limit (convergence will fail) - if ( startVal[2] < 1e-12 ) {startVal[2] <- startVal[3]/10} - - return(startVal[notFixed]) - } -} - if (!is.null(ssfct)) - { - ssfct <- ssfct # in case it is explicitly provided - } else { - ssfct <- weibull2.ssf(method, fixed) - } - - - ## Defining names - w2.names <- names[notFixed] - - -# ## Defining parameter to be scaled -# if ( (scaleDose) && (is.na(fixed[4])) ) -# { -# scaleInd <- sum(is.na(fixed[1:4])) -# } else { -# scaleInd <- NULL -# } - - - ## Defining derivatives - deriv1 <- function(dose, parm) - { - parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE) - parmMat[, notFixed] <- parm - - t1 <- parmMat[, 3] - parmMat[, 2] - t2 <- exp(parmMat[, 1]*(log(dose) - log(parmMat[, 4]))) - t3 <- exp(-t2) - -# derMat <- as.matrix(cbind( t1*t3*t2*(log(dose) - log(parmMat[, 4])), - derMat <- as.matrix(cbind( t1*xexplogx(dose/parmMat[, 4], parmMat[, 1]), - 1 - (1 - t3), - 1 - t3, - -t1*xexpx(dose/parmMat[, 4], parmMat[, 1])*parmMat[, 1]/parmMat[, 4] )) -# -t1*t3*t2*parmMat[, 1]/parmMat[, 4] )) - return(derMat[, notFixed]) - } - deriv2 <- NULL - - - ## Defining the first derivative (in x=dose) - ## based on deriv(~c+(d-c)*(1 - exp(-exp(b*(log(x)-log(e))))), "x", function(x, b,c,d,e){}) - derivx <- function(x, parm) - { - parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE) - parmMat[, notFixed] <- parm - - .expr1 <- parmMat[, 3] - parmMat[, 2] - .expr6 <- exp(parmMat[, 1] * (log(x) - log(parmMat[, 4]))) - .expr8 <- exp(-.expr6) - .value <- parmMat[, 2] + .expr1 * (1 - .expr8) - .grad <- array(0, c(length(.value), 1L), list(NULL, c("x"))) - .grad[, "x"] <- .expr1 * (.expr8 * (.expr6 * (parmMat[, 1] * (1/x)))) - .grad - } - - - ## Limits -# if (length(lowerc)==numParm) {lowerLimits <- lowerc[notFixed]} else {lowerLimits <- lowerc} -# if (length(upperc)==numParm) {upperLimits <- upperc[notFixed]} else {upperLimits <- upperc} - - - ## Defining the ED function -# edfct <- function(parm, p, upper=NULL) # upper argument not used in 'gompertz' -# { -# parmVec[notFixed] <- parm -# -# tempVal <- log(-log(p/100)) -# EDp <- exp(tempVal/parmVec[1] + log(parmVec[4])) -# -# EDder <- EDp*c( -tempVal/(parmVec[1]*parmVec[1]), 0, 0, 1/parmVec[4]) -# -# return(list(EDp, EDder[notFixed])) -# } - edfct <- function(parm, p, reference, type, ...) - { - parmVec[notFixed] <- parm - - p <- absToRel(parmVec, p, type) - - ## Reversing p -# if (identical(type, "absolute")) -# { -# p <- 100 - p -# type <- "relative" -# } - - if (identical(type, "absolute") && (parmVec[1] > 0) && (reference == "control")) - { - p <- 100 - p - } - -# if ( (parmVec[1] > 0) && (reference == "control") ) -# { -# p <- 100 - p -# reference <- "upper" # to avoid resetting of p in weibull1() called below -# } -# if ( (parmVec[1] < 0) && (reference == "control") ) -# { -# p <- 100 - p -# } - - -# weibull1(fixed, names)$edfct(parm, 100 - p, reference, type, ...) - weibull1(fixed, names)$edfct(parm, p, reference, "relative", ...) - } - - - ## Defining the SI function -# sifct <- function(parm1, parm2, pair) -# { -# parmVec1[notFixed] <- parm1 -# parmVec2[notFixed] <- parm2 -# -# tempVal1 <- log(-log(pair[1]/100)) -# tempVal2 <- log(-log(pair[2]/100)) -# -# SIpair <- exp(tempVal1/parmVec1[1] + log(parmVec1[4]))/exp(tempVal2/parmVec2[1] + log(parmVec2[4])) -# -# SIder1 <- SIpair*c(-tempVal1/(parmVec1[1]*parmVec1[1]), 0, 0, 1/parmVec1[4]) -# SIder2 <- SIpair*c(tempVal2/(parmVec2[1]*parmVec2[1]), 0, 0, -1/parmVec2[4]) -# -# return(list(SIpair, SIder1[notFixed], SIder2[notFixed])) -# } - -## sifct <- function(parm1, parm2, pair) -## { -## weibull(lowerc, upperc, fixed, names, scaleDose, useDer)$sifct(parm1, parm2, 100-pair) -## } - - - returnList <- - list(fct = fct, ssfct = ssfct, names = w2.names, deriv1 = deriv1, deriv2 = deriv2, derivx = derivx, edfct = edfct, -# list(fct=fct, confct=confct, ssfct=ssfct, names=w2.names, deriv1=deriv1, deriv2=deriv2, -# lowerc=lowerLimits, upperc=upperLimits, edfct=edfct, anovaYes=anovaYes, - name = ifelse(missing(fctName), as.character(match.call()[[1]]), fctName), - text = ifelse(missing(fctText), "Weibull (type 2)", fctText), - noParm = sum(is.na(fixed)), - fixed = fixed) - - class(returnList) <- "Weibull-2" - invisible(returnList) -} - - -"W2.2" <- function( -upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) -{ - ## Checking arguments - numParm <- 2 - if (!is.character(names) | !(length(names) == numParm)) {stop("Not correct 'names' argument")} - if (!(length(fixed) == numParm)) {stop("Not correct length of 'fixed' argument")} - - return(weibull2(fixed = c(fixed[1], 0, upper, fixed[2]), names = c(names[1], "c", "d", names[2]), - fctName = as.character(match.call()[[1]]), - fctText = lowupFixed("Weibull (type 2)", upper), ...)) -} - -"W2.3" <- -function(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) -{ - ## Checking arguments - numParm <- 3 - if (!is.character(names) | !(length(names) == numParm)) {stop("Not correct 'names' argument")} - if (!(length(fixed) == numParm)) {stop("Not correct length of 'fixed' argument")} - - return(weibull2(fixed = c(fixed[1], 0, fixed[2:3]), names = c(names[1], "c", names[2:3]), - fctName = as.character(match.call()[[1]]), - fctText = lowFixed("Weibull (type 2)"), ...)) -} - -"W2.3u" <- -function(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...) -{ - ## Checking arguments - numParm <- 3 - if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct 'names' argument")} - if (!(length(fixed)==numParm)) {stop("Not correct length of 'fixed' argument")} - - return(weibull2(fixed = c(fixed[1:2], upper, fixed[3]), - names = c(names[1:2], "d", names[3]), - fctName = as.character(match.call()[[1]]), - fctText = upFixed("Weibull (type 2)", upper), ...)) -} - -"W2.4" <- -function(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) -{ - ## Checking arguments - numParm <- 4 - if (!(length(fixed) == numParm)) {stop("Not correct length of 'fixed' argument")} - if (!is.character(names) | !(length(names) == numParm)) {stop("Not correct 'names' argument")} - - return(weibull2(fixed = fixed, names = names, - fctName = as.character(match.call()[[1]]), - fctText = "Weibull (type 2)", ...)) -} - -"AR.2" <- -function(fixed = c(NA, NA), names = c("d", "e"), ...) -{ - ## Checking arguments - numParm <- 2 - if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct 'names' argument")} - if (!(length(fixed)==numParm)) {stop("Not correct length of 'fixed' argument")} - - return(weibull2(fixed = c(1, 0, fixed[1:2]), - names = c("b", "c", names[1:2]), - fctName = as.character(match.call()[[1]]), - fctText = lowFixed("Asymptotic regression"), ...)) -} - -"AR.3" <- -function(fixed = c(NA, NA, NA), names = c("c", "d", "e"), ...) -{ - ## Checking arguments - numParm <- 3 - if (!is.character(names) | !(length(names)==numParm)) {stop("Not correct 'names' argument")} - if (!(length(fixed)==numParm)) {stop("Not correct length of 'fixed' argument")} - - return(weibull2(fixed = c(1, fixed[1:3]), - names = c("b", names[1:3]), - fctName = as.character(match.call()[[1]]), - fctText = "Shifted asymptotic regression", ...)) -} diff --git a/R/weibull2.ssf.R b/R/weibull2.ssf.R index 9aba8a7d..a7b97b1f 100644 --- a/R/weibull2.ssf.R +++ b/R/weibull2.ssf.R @@ -1,31 +1,33 @@ -"weibull2.ssf" <- function(method = c("1", "2", "3", "4"), fixed, useFixed = FALSE) -{ - method <- match.arg(method) - - ## Defining helper functions (used below) - ytrans <- function(y, cVal, dVal) {log(-log((dVal - y)/(dVal - cVal)))} - bfct <- function(x, y, cVal, dVal, eVal) {ytrans(y, cVal, dVal)/log(x/eVal)} - efct <- function(x, y, bVal, cVal, dVal) {x * exp(-ytrans(y, cVal, dVal)/bVal)} - - ## Assigning function for finding initial b and e parameter values - findbe <- switch(method, - "1" = findbe1(function(x) {rVec <- log(x); rVec[!x>0] <- NA; rVec}, ytrans), - "2" = findbe2(bfct, efct, "Anke"), - "3" = findbe3(-1), - "4" = findbe2(bfct, efct, "Normolle")) - - function(dframe) - { - x <- dframe[, 1] - y <- dframe[, 2] - - ## Finding initial values for the c and d parameters - cdVal <- findcd(x, y) - if (useFixed) {} # not implemented at the moment - - ## Finding initial values for the b and e parameters - beVal <- findbe(x, y, cdVal[1], cdVal[2]) - - return(c(beVal[1], cdVal, beVal[2])[is.na(fixed)]) - } +#' @title Self-starter for Weibull type 2 model +#' @keywords internal +"weibull2.ssf" <- function(method = c("1", "2", "3", "4"), fixed, useFixed = FALSE) +{ + method <- match.arg(method) + + ## Defining helper functions (used below) + ytrans <- function(y, cVal, dVal) {log(-log((dVal - y)/(dVal - cVal)))} + bfct <- function(x, y, cVal, dVal, eVal) {ytrans(y, cVal, dVal)/log(x/eVal)} + efct <- function(x, y, bVal, cVal, dVal) {x * exp(-ytrans(y, cVal, dVal)/bVal)} + + ## Assigning function for finding initial b and e parameter values + findbe <- switch(method, + "1" = findbe1(function(x) {rVec <- log(x); rVec[!x>0] <- NA; rVec}, ytrans), + "2" = findbe2(bfct, efct, "Anke"), + "3" = findbe3(-1), + "4" = findbe2(bfct, efct, "Normolle")) + + function(dframe) + { + x <- dframe[, 1] + y <- dframe[, 2] + + ## Finding initial values for the c and d parameters + cdVal <- findcd(x, y) + if (useFixed) {} # not implemented at the moment + + ## Finding initial values for the b and e parameters + beVal <- findbe(x, y, cdVal[1], cdVal[2]) + + return(c(beVal[1], cdVal, beVal[2])[is.na(fixed)]) + } } \ No newline at end of file diff --git a/R/weibull2x.R b/R/weibull2x.R index e703e285..7f1d470b 100644 --- a/R/weibull2x.R +++ b/R/weibull2x.R @@ -1,3 +1,34 @@ +#' Five-parameter Weibull type 2 model with lag time +#' +#' A five-parameter Weibull type 2 model extended with a lag time parameter +#' \code{t0}. The model is given by the expression +#' \deqn{f(x) = c + (d - c)(1 - \exp(-\exp(b(\log(x - t0) - \log(e)))))} +#' for \eqn{x > t0} and \eqn{f(x) = c} otherwise. +#' +#' The lag time parameter \code{t0} cannot be fixed. +#' +#' @param fixed numeric vector of length 5. Specifies which parameters are +#' fixed and at what value. Use \code{NA} for parameters that should be +#' estimated (default is \code{rep(NA, 5)}). +#' @param names character vector of length 5 giving the names of the +#' parameters (default is \code{c("b", "c", "d", "e", "t0")}). +#' @param method character string indicating the self starter method to use. +#' One of \code{"1"}, \code{"2"}, \code{"3"}, or \code{"4"}. +#' @param ssfct a self starter function. If \code{NULL} (default), a built-in +#' self starter is used. +#' @param fctName optional character string specifying the function name +#' (used internally). +#' @param fctText optional character string specifying the function description +#' (used internally). +#' +#' @return A list of class \code{"Weibull-2"} containing the nonlinear +#' function, self starter function, and parameter names. +#' +#' @author Christian Ritz +#' +#' @seealso \code{\link{weibull2}}, \code{\link{W2x.3}}, \code{\link{W2x.4}} +#' +#' @keywords models nonlinear "weibull2x" <- function( fixed = rep(NA, 5), names = c("b", "c", "d", "e", "t0"), method = c("1", "2", "3", "4"), ssfct = NULL, @@ -23,8 +54,7 @@ fctName, fctText) parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE) parmMat[, notFixed] <- parm -# parmMat[,2] + (parmMat[,3] - parmMat[,2]) * (1 - exp(-exp(parmMat[,1] *(log(dose - t0) - log(parmMat[,4]))))) - ifelse(dose > parmMat[,5], parmMat[,2] + (parmMat[,3] - parmMat[,2]) * (1 - exp(-exp(parmMat[,1] *(log(dose - parmMat[,5]) - log(parmMat[,4]))))), parmMat[,2]) + ifelse(dose > parmMat[,5],parmMat[,2] + (parmMat[,3] - parmMat[,2]) * (1 - exp(-exp(parmMat[,1] *(log(dose - parmMat[,5]) - log(parmMat[,4]))))), parmMat[,2]) } @@ -65,18 +95,18 @@ fctName, fctText) p <- 100 - p } - weibull1(fixed, names)$edfct(head(parm, -1), 100 - p, reference, type, ...) + parmVec[5] + edResult <- weibull1(head(fixed, -1), head(names, -1))$edfct(head(parm, -1), 100 - p, reference, type, ...) # not accounting completely for the uncertainty due to estimation of the lag time + edResult[[1]] <- edResult[[1]] + parmVec[5] + edResult } ## using head( , -1) to remove the lag-time parameter ## Returning list of functions and values returnList <- - list(fct = fct, ssfct = ssfct, names = w2.names, deriv1 = deriv1, deriv2 = deriv2, derivx = derivx, edfct = edfct, -# list(fct=fct, confct=confct, ssfct=ssfct, names=w2.names, deriv1=deriv1, deriv2=deriv2, -# lowerc=lowerLimits, upperc=upperLimits, edfct=edfct, anovaYes=anovaYes, - name = ifelse(missing(fctName), as.character(match.call()[[1]]), fctName), + list(fct = fct, ssfct = ssfct, names = w2.names, deriv1 = deriv1, deriv2 = deriv2, derivx = derivx, edfct = edfct, + name = ifelse(missing(fctName),as.character(match.call()[[1]]), fctName), text = ifelse(missing(fctText), "Weibull (type 2)", fctText), noParm = sum(is.na(fixed)), fixed = fixed) @@ -86,6 +116,29 @@ fctName, fctText) } +#' Three-parameter Weibull type 2 model with lag time +#' +#' A three-parameter Weibull type 2 model with lag time, where \code{b} is +#' fixed at 1 and \code{c} is fixed at 0. This is a convenience wrapper +#' around \code{\link{weibull2x}}. +#' +#' @param fixed numeric vector of length 3. Specifies which parameters are +#' fixed and at what value. Use \code{NA} for parameters that should be +#' estimated (default is \code{c(NA, NA, NA)}). +#' @param names character vector of length 3 giving the names of the +#' parameters (default is \code{c("d", "e", "t0")}). +#' @param \dots additional arguments passed to \code{\link{weibull2x}}. +#' +#' @return A list of class \code{"Weibull-2"} containing the nonlinear +#' function, self starter function, and parameter names. +#' +#' @seealso \code{\link{weibull2x}}, \code{\link{W2x.4}}, \code{\link{W2.3}} +#' +#' @examples +#' spinach.m1 <- drm(SLOPE ~ DOSE, data = spinach, fct = W2x.3()) +#' summary(spinach.m1) +#' +#' @keywords models nonlinear "W2x.3" <- function(fixed = c(NA, NA, NA), names = c("d", "e", "t0"), ...) { @@ -99,6 +152,27 @@ function(fixed = c(NA, NA, NA), names = c("d", "e", "t0"), ...) fctText = lowFixed("Weibull (type 2)"), ...)) } +#' Four-parameter Weibull type 2 model with lag time +#' +#' A four-parameter Weibull type 2 model with lag time, where \code{b} is +#' fixed at 1. This is a convenience wrapper around \code{\link{weibull2x}}. +#' +#' @param fixed numeric vector of length 4. Specifies which parameters are +#' fixed and at what value. Use \code{NA} for parameters that should be +#' estimated (default is \code{c(NA, NA, NA, NA)}). +#' @param names character vector of length 4 giving the names of the +#' parameters (default is \code{c("c", "d", "e", "t0")}). +#' @param \dots additional arguments passed to \code{\link{weibull2x}}. +#' +#' @return A list of class \code{"Weibull-2"} containing the nonlinear +#' function, self starter function, and parameter names. +#' +#' @seealso \code{\link{weibull2x}}, \code{\link{W2x.3}}, \code{\link{W2.4}} +#' +#' @examples +#' ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W2x.4()) +#' +#' @keywords models nonlinear "W2x.4" <- function(fixed = c(NA, NA, NA, NA), names = c("c", "d", "e", "t0"), ...) { @@ -109,5 +183,5 @@ function(fixed = c(NA, NA, NA, NA), names = c("c", "d", "e", "t0"), ...) return(weibull2x(fixed = c(1, fixed[1:4]), names = c("b", names[1:4]), fctName = as.character(match.call()[[1]]), - fctText = lowFixed("Weibull (type 2)"), ...)) + fctText = "Weibull (type 2)", ...)) } diff --git a/R/xlogx.r b/R/xlogx.R similarity index 64% rename from R/xlogx.r rename to R/xlogx.R index 9b43f26b..03c150cd 100644 --- a/R/xlogx.r +++ b/R/xlogx.R @@ -1,86 +1,69 @@ -## Helper functions -## used in llogistic, weibull1, weibull2 - -#"xlogx" <- function(x, p) -#{ -# lv <- (x < 1e-12) -# nlv <- !lv -# -# rv <- rep(0, length(x)) -# -# xlv <- x[lv] -# rv[lv] <- log(xlv^(xlv^p[lv])) -# -# xnlv <- x[nlv] -# rv[nlv] <- (xnlv^p[nlv])*log(xnlv) -# -# rv -#} - -divAtInf <- function(x, y) -{ - retVec <- x / y - retVec[(!is.finite(y))] <- 0 - # Assuming the y tends to infinity faster than x - - retVec -} - - -"xlogx" <- function(x, p, f = 0) -{ - lv <- (x < 1e-12) - nlv <- !lv - - rv <- rep(0, length(x)) - - xPowerp <- x^p - - # Handling Inf/Inf -# ratioVec <- xPowerp / (1 + xPowerp)^f -# ratioVec[!is.finite(xPowerp)] <- 0 - ratioVec <- divAtInf(xPowerp, (1 + xPowerp)^f) - - xlv <- x[lv] - rv[lv] <- log( xlv^ratioVec[lv] ) -# rv[lv] <- log( xlv^(xlv^p[lv] / (1 + xlv^p[lv])^f[lv]) ) - - xnlv <- x[nlv] - rv[nlv] <- ratioVec[nlv] * log(xnlv) -# rv[nlv] <- ( xnlv^p[nlv] / (1 + xnlv^p[nlv])^f[nlv] ) * log(xnlv) - - rv -} - - -"xexpx" <- function(x, p) -{ - lv <- (x < 1e-12) - nlv <- !lv - - rv <- rep(0, length(x)) - - xlv <- x[lv] - rv[lv] <- 0 # must be a better approach - - xnlv <- x[nlv] - rv[nlv] <- (xnlv^p[nlv])*exp(-(xnlv^p[nlv])) - - rv -} - -"xexplogx" <- function(x, p) -{ - lv <- (x < 1e-12) - nlv <- !lv - - rv <- rep(0, length(x)) - - xlv <- x[lv] - rv[lv] <- 0 # must be a better approach - - xnlv <- x[nlv] - rv[nlv] <- log(xnlv)*(xnlv^p[nlv])*exp(-(xnlv^p[nlv])) - - rv -} +## Helper functions +## used in llogistic, weibull1, weibull2 + +#' @title Helper functions for x*log(x) calculations +#' @keywords internal + +divAtInf <- function(x, y) +{ + retVec <- x / y + retVec[(!is.finite(y))] <- 0 + # Assuming the y tends to infinity faster than x + + retVec +} + + +"xlogx" <- function(x, p, f = 0) +{ + lv <- (x < 1e-12) + nlv <- !lv + + rv <- rep(0, length(x)) + + xPowerp <- x^p + + # Handling Inf/Inf + ratioVec <- divAtInf(xPowerp, (1 + xPowerp)^f) + + xlv <- x[lv] + rv[lv] <- log( xlv^ratioVec[lv] ) + + xnlv <- x[nlv] + rv[nlv] <- ratioVec[nlv] * log(xnlv) + + rv +} + + +"xexpx" <- function(x, p) +{ + lv <- (x < 1e-12) + nlv <- !lv + + rv <- rep(0, length(x)) + + xlv <- x[lv] + rv[lv] <- 0 # must be a better approach + + xnlv <- x[nlv] + rv[nlv] <- (xnlv^p[nlv])*exp(-(xnlv^p[nlv])) + + rv +} + +"xexplogx" <- function(x, p) +{ + lv <- (x < 1e-12) + nlv <- !lv + + rv <- rep(0, length(x)) + + xlv <- x[lv] + rv[lv] <- 0 # must be a better approach + + xnlv <- x[nlv] + rv[nlv] <- log(xnlv)*(xnlv^p[nlv])*exp(-(xnlv^p[nlv])) + + rv +} diff --git a/R/yieldLoss.R b/R/yieldLoss.R index e9df1a57..9809b83d 100644 --- a/R/yieldLoss.R +++ b/R/yieldLoss.R @@ -1,3 +1,42 @@ +#' Calculating yield loss parameters +#' +#' Calculation of parameters in the re-parameterization of the Michaelis-Menten model that is commonly +#' used to assess yield loss (the rectangular hyperbola model). +#' +#' The rectangular hyperbola model is a reparameterization of the Michaelis-Menten in terms of parameters +#' \eqn{A} and \eqn{I}: +#' \deqn{Y_L = \frac{Id}{1+Id/A}}{Y_L = Id / (1 + Id/A)} +#' where \eqn{d} denotes the weed density and \eqn{Y_L} the resulting yield loss. +#' +#' @param object object of class 'drc'. +#' @param interval character string specifying the type of confidence intervals. The default is "none". +#' Use "as" for asymptotically-based confidence intervals. +#' @param level numeric. The level for the confidence intervals. The default is 0.95. +#' @param display logical. If TRUE results are displayed. Otherwise they are not (useful in simulations). +#' +#' @return For each of the two parameters, a matrix with two or more columns, containing the estimates +#' and the corresponding estimated standard errors and possibly lower and upper confidence limits. +#' +#' @references Cousens, R. (1985). A simple model relating yield loss to weed density, +#' \emph{Ann. Appl. Biol.}, \bold{107}, 239--252. +#' +#' @author Christian Ritz +#' +#' @note This function is only for use with model fits based on Michaelis-Menten models. +#' +#' @examples +#' ## Fitting Michaelis-Menten model +#' met.mm.m1 <- drm(gain~dose, product, data = methionine, fct = MM.3(), +#' pmodels = list(~1, ~factor(product), ~factor(product))) +#' +#' ## Yield loss parameters with standard errors +#' yieldLoss(met.mm.m1) +#' +#' ## Also showing confidence intervals +#' yieldLoss(met.mm.m1, "as") +#' +#' @keywords models nonlinear +#' @concept rectangular hyperbola model "yieldLoss" <- function(object, interval = c("none", "as"), level = 0.95, display = TRUE) { diff --git a/README.Rmd b/README.Rmd deleted file mode 100644 index a051d23b..00000000 --- a/README.Rmd +++ /dev/null @@ -1,35 +0,0 @@ ---- -output: - github_document: - html_preview: false ---- - -[![CRAN_Status_Badge](http://www.r-pkg.org/badges/version/drc)](https://cran.r-project.org/package=drc) -[![Build Status](https://travis-ci.org/DoseResponse/drc.svg?branch=master)](https://travis-ci.org/DoseResponse/drc) -[![Downloads](https://cranlogs.r-pkg.org/badges/drc)](https://cranlogs.r-pkg.org/) - - -```{r, echo = FALSE} -knitr::opts_chunk$set( - collapse = TRUE, - comment = "#>", - fig.path = "README-" -) -``` - -# drc - -## Overview - -Analysis of dose-response data is made available through a suite of flexible and versatile model fitting and after-fitting functions. - -## Installation - -```{r, eval = FALSE} -## You can install drc from GitHub -# install.packages("devtools") -## first installing drcData -devtools::install_github("DoseResponse/drcData") -## then installing the development version of drc -devtools::install_github("DoseResponse/drc") -``` diff --git a/README.md b/README.md index ebea6e56..2ba1c7cb 100644 --- a/README.md +++ b/README.md @@ -1,22 +1,214 @@ +[![GitHub dev version](https://img.shields.io/github/r-package/v/hreinwald/drc)](https://github.com/hreinwald/drc) +[![Documentation](https://img.shields.io/static/v1?style=flat-square&message=ReadTheDocs&color=2C4AA8&logo=ReadTheDocs&logoColor=FFFFFF&label=Documentation)](https://hreinwald.github.io/drc/) +R-CMD-check status +Code coverage status +Lifecycle: stable -[![CRAN\_Status\_Badge](http://www.r-pkg.org/badges/version/drc)](https://cran.r-project.org/package=drc) [![Build Status](https://travis-ci.org/DoseResponse/drc.svg?branch=master)](https://travis-ci.org/DoseResponse/drc) [![Downloads](https://cranlogs.r-pkg.org/badges/drc)](https://cranlogs.r-pkg.org/) +CRAN version +[![Downloads](https://cranlogs.r-pkg.org/badges/drc)](https://cranlogs.r-pkg.org/) +License: GPL-2.0 +Last commit date +Contributions welcome -drc -=== +

+ drc Logo +

-Overview --------- -Analysis of dose-response data is made available through a suite of flexible and versatile model fitting and after-fitting functions. +# drc — Dose-Response Curve Analysis in R -Installation ------------- +## Note + +This repository contains a refactored development version of the [*drc*](https://github.com/DoseResponse/drc) R package first published by **Christian Ritz, Florent Baty, Jens C. Streibig und Daniel Gerhard** [(2015)](https://doi.org/10.1371/journal.pone.0146021). Their foundational work on dose–response modeling in R is gratefully acknowledged and inspired the present refactoring. + +The goal of this project is to modernize the codebase, improve maintainability, and provide a clearer development structure while preserving the core functionality of the original package. + +This repository focuses on structural refactoring and development improvements. Behavior and interfaces may change as the codebase is modernized. + +## Overview + +The **drc** package provides a comprehensive framework for fitting, analyzing, and visualizing dose-response curves in R. It is widely used in bioassay, toxicology, pharmacology, and agricultural research to model the relationship between an exposure (e.g., concentration of a substance) or dose and a biological response. + +The package offers: + +- **Flexible model fitting** via the central `drm()` function, supporting multiple data types (continuous, binomial, Poisson, negative binomial, event-time, and species sensitivity distributions). +- **40+ built-in parametric models** including log-logistic, Weibull, Gompertz, Brain-Cousens, Cedergreen, and many more, each with self-starting parameter initialization. +- **Effective dose (ED) estimation** with confidence intervals (delta method, Fieller, inverse regression) through `ED()`. +- **Model comparison and diagnostics**: ANOVA, lack-of-fit tests, Neill's test, Box-Cox transformations, R-squared, Cook's distance, and hat values. +- **Multi-curve analysis**: fit and compare dose-response curves across groups, compute relative potency and selectivity indices via `EDcomp()`. +- **Robust inference**: sandwich variance estimators for heteroscedasticity-consistent standard errors. +- **Simulation tools**: generate random dose-response data for power analysis and method comparison. + +For more details visit: + +:book: **[drc github documentation](https://hreinwald.github.io/drc/)** +:zap: **[drc example workflow](https://hreinwald.github.io/drc/articles/dose-response-workflow.html)** + +Feature requests or ideas? + +:bulb: **[Post them here](https://github.com/hreinwald/drc/discussions)** + +## Installation + +**⚠️ Important:** We **do not recommend** installing the currently heavily outdated CRAN version of this package. Instead, we recommend installing the development (`dev`) or stable beta (`main_beta`) version from GitHub. + +For details on why the CRAN and upstream fork version is heavily outdated see the [drc package comparative analysis](https://hreinwald.github.io/drc/articles/package-version-comparative-analysis.html). It also show cases the most critical bugs that were fixed in this re-factored version. + +### Install from GitHub (Recommended) ``` r -## You can install drc from GitHub # install.packages("devtools") -## first installing drcData -devtools::install_github("DoseResponse/drcData") -## then installing the development version of drc -devtools::install_github("DoseResponse/drc") + +# Install the re-factored development version +devtools::install_github("hreinwald/drc") + +# Install the re-factored stable version +devtools::install_github("hreinwald/drc@main") +``` + +### Local Installation from tar.gz + +If GitHub installation is failing, you can run the installation from the local tar.gz file. +[Download the latest release](https://github.com/hreinwald/drc/archive/refs/tags/3.3.2.tar.gz). + +After downloading the file, run the following: + +``` r +# Specify the path to the directory where you saved the downloaded tar.gz file. +targz <- file.path("~/Downloads/drc-3.3.2.tar.gz") + +# Local installation with base R +install.packages(targz, repos = NULL, type = "source") +``` + +### Outdated CRAN Version (Not Recommended) + +To install the outdated version from CRAN: + +``` r +install.packages("drc") +``` + +## Quick Start + +### Fitting a basic dose-response model + +``` r +library(drc) + +# Fit a four-parameter log-logistic model to the built-in 'ryegrass' dataset +model <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + +# View model summary with parameter estimates and standard errors +summary(model) + +# Plot the fitted dose-response curve +plot(model, xlab = "Concentration", ylab = "Root length") +``` + +### Estimating effective doses (ED values) + +``` r +# Estimate the ED50 (dose producing 50% effect) with confidence intervals +ED(model, respLev = c(10, 50, 90), interval = "delta") +``` + +### Comparing curves across groups + +``` r +# Fit separate curves for multiple groups +model_multi <- drm(rootl ~ conc, curveid = herbicide, + data = ryegrass, fct = LL.4()) + +# Compare ED50 values between groups +EDcomp(model_multi, percVec = c(50), interval = "delta") +``` + +### Model selection + +``` r +# Compare different dose-response model families +mselect(model, fctList = list(W1.4(), W2.4(), LL.3())) +``` + +## Vignettes + +The package includes detailed vignettes to help you understand specific topics: + +``` r +# View available vignettes +vignette(package = "drc") + +# Access the NEC models vignette +vignette("nec-models", package = "drc") ``` + +## Available Models + +| Function | Description | +|-----------|-------------------------------------------------| +| `LL.2()` – `LL.5()` | Log-logistic models (2 to 5 parameters) | +| `W1.2()` – `W1.4()` | Weibull type 1 models | +| `W2.2()` – `W2.4()` | Weibull type 2 models | +| `G.3()`, `G.4()` | Gompertz models | +| `LN.2()` – `LN.4()` | Log-normal models | +| `BC.4()`, `BC.5()` | Brain-Cousens models (hormesis) | +| `CRS.4a()` – `CRS.4c()` | Cedergreen-Ritz-Streibig 4-parameter models (hormesis) | +| `CRS.5()`, `CRS.5a()` – `CRS.5c()` | Cedergreen-Ritz-Streibig 5-parameter models (hormesis) | +| `CRS.6()` | Generalised Cedergreen-Ritz-Streibig model (hormesis) | +| `UCRS.4a()` – `UCRS.4c()` | U-shaped Cedergreen-Ritz-Streibig 4-parameter models (hormesis) | +| `UCRS.5a()` – `UCRS.5c()` | U-shaped Cedergreen-Ritz-Streibig 5-parameter models (hormesis) | +| `NEC.2()` – `NEC.4()` | No-effect-concentration models | +| `L.3()` – `L.5()` | Logistic models | +| `baro5()` | Baro five-parameter model | +| `gammadr()` | Gamma dose-response model | + +## Key Functions + +| Function | Purpose | +|---------------|----------------------------------------------------| +| `drm()` | Fit dose-response models | +| `ED()` | Estimate effective doses (ED10, ED50, ...) | +| `maED()` | Model averaged estimate effective doses (ED10, ED50, ...) | +| `EDcomp()` | Compare ED values between curves | +| `compParm()` | Compare model parameters between curves | +| `noEffect()` | Testing if there is a dose effect at all | +| `plot()` | Plot fitted dose-response curves | +| `summary()` | Model summary with parameter estimates | +| `anova()` | ANOVA and lack-of-fit tests | +| `mselect()` | Model selection among candidate models | +| `predict()` | Predictions with confidence/prediction intervals | +| `modelFit()` | Goodness-of-fit test | +| `Rsq()` | R-squared calculation | +| `rdrm()` | Simulate dose-response data | + +## Data Types Supported + +The `drm()` function supports multiple response types via the `type` argument: + +- **`"continuous"`** (default): Standard continuous dose-response data. +- **`"binomial"`**: Quantal/binary response data (e.g., proportion of individuals affected). +- **`"Poisson"`**: Count data following a Poisson distribution. +- **`"negbin1"`, `"negbin2"`**: Negative binomial count data. +- **`"event"`**: Event-time / time-to-event data (e.g., germination time). +- **`"ssd"`**: Species sensitivity distributions for ecotoxicology. + +## Dependencies + +**drc** depends on: +- R (≥ 4.0.0), MASS, stats + +and imports from: car, graphics, gtools, lifecycle, multcomp, plotrix, sandwich, scales, utils. + +## References + +- Ritz, C., Baty, F., Streibig, J. C., and Gerhard, D. (2015). Dose-Response Analysis Using R. *PLOS ONE*, 10(12), e0146021. +- Ritz, C. and Streibig, J. C. (2005). Bioassay Analysis using R. *Journal of Statistical Software*, 12(5), 1–22. + +## Bug Reports + +Please report issues with this re-factory version [here](https://github.com/hreinwald/drc/issues/). + +## License + +GPL-2.0 diff --git a/_Rbuildignore b/_Rbuildignore deleted file mode 100644 index 91114bf2..00000000 --- a/_Rbuildignore +++ /dev/null @@ -1,2 +0,0 @@ -^.*\.Rproj$ -^\.Rproj\.user$ diff --git a/_gitignore b/_gitignore deleted file mode 100644 index 6adc580b..00000000 --- a/_gitignore +++ /dev/null @@ -1,5 +0,0 @@ -.Rproj.user -.Rhistory -.RData -.Ruserdata -drc.Rproj diff --git a/_pkgdown.yml b/_pkgdown.yml index a7ed27c2..a62965f9 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -1,161 +1,207 @@ -reference: -- title: Fitting dose resonse models - contents: - - drm -- title: Methods - contents: - - anova.drc - - boxcox.drc - - bread.drc - - coef.drc - - confint.drc - - cooks.distance.drc - - ED.drc - - estfun.drc - - fitted.drc - - hatvalues.drc - - loglik.drc - - plot.drc - - predict.drc - - print.drc - - print.summary.drc - - residuals.drc - - summary.drc - - vcov.drc -- title: Misc - contents: - - backfit - - CIcomp - - CIcompX - - comped - - compParm - - drmc - - ED - - EDcomp - - getInitial - - getMeanFunctions - - isobole - - lin.test - - maED - - MAX - - mixture - - modelFit - - mr.test - - mselect - - neill.test - - noEffect - - plotFACI - - PR - - rdrm - - relpot - - searchdrc - - simDR - - yieldloss -- title: Dose-response functions - contents: - - AR.2 - - AR.3 - - baro5 - - BC.4 - - BC.5 - - bcl3 - - bcl4 - - braincousens - - cedergreen - - CRS.4a - - CRS.4b - - CRS.4c - - CRS.5a - - CRS.5b - - CRS.5c - - CRS.6 - - EXD.2 - - EXD.3 - - FPL.4 - - fplogistic - - G.2 - - G.3 - - G.3u - - G.4 - - gammadr - - gaussian - - genBliss - - genBliss2 - - genLoewe - - genLoewe2 - - genursa - - gompertz - - gompertzd - - iceLoewe.1 - - iceLoewe2.1 - - L.3 - - L.4 - - L.5 - - l2 - - l3 - - l3u - - l4 - - l5 - - lgaussian - - LL.2 - - LL.3 - - LL.3u - - LL.4 - - LL.5 - - LL2.2 - - LL2.3 - - LL2.3u - - LL2.4 - - LL2.5 - - llogistic - - llogistic2 - - LN.2 - - LN.3 - - LN.3u - - LN.4 - - lnormal - - logistic - - ml3a - - ml3b - - ml3c - - ml4a - - ml4b - - ml4c - - MM.2 - - MM.3 - - multi2 - - NEC - - NEC.2 - - NEC.3 - - NEC.4 - - twophase - - ucedergreen - - UCRS.4a - - UCRS.4b - - UCRS.4c - - UCRS.5a - - UCRS.5b - - UCRS.5c - - uml3a - - uml3b - - uml3c - - uml4a - - uml4b - - uml4c - - ursa - - W1.2 - - W1.3 - - W1.3u - - W1.4 - - w2 - - W2.2 - - W2.3 - - W2.3u - - W2.4 - - W2x.3 - - W2x.4 - - w3 - - w4 - - weibull1 - - weibull2 - \ No newline at end of file +url: https://hreinwald.github.io/drc +destination: docs + +logo: docs/logo.png +favicon: docs/logo.png + +template: + bootstrap: 5 + +home: + links: + - text: Report an issue + href: https://github.com/hreinwald/drc/issues + +articles: +- title: Guides + navbar: ~ + contents: + - dose-response-workflow + - nec-models +- title: Technical Reports + contents: + - package-version-comparative-analysis + +reference: +- title: Core Functions + desc: Main functions for dose-response analysis + contents: + - drm + - ED + - EDcomp + - compParm + - mselect + - drmc + +- title: Model Functions + desc: Available dose-response model families + contents: + - starts_with("LL.") + - starts_with("LL2.") + - starts_with("W1.") + - starts_with("W2.") + - starts_with("W2x.") + - starts_with("G.") + - starts_with("LN.") + - starts_with("BC.") + - starts_with("CRS.") + - starts_with("UCRS.") + - starts_with("NEC.") + - starts_with("L.") + - starts_with("AR.") + - starts_with("EXD.") + - starts_with("MM.") + - FPL.4 + - starts_with("ml3") + - starts_with("ml4") + - starts_with("uml3") + - starts_with("uml4") + - bcl3 + - bcl4 + - baro5 + - braincousens + - cedergreen + - ucedergreen + - fplogistic + - gammadr + - gaussian + - gompertz + - gompertzd + - lgaussian + - llogistic + - llogistic2 + - lnormal + - logistic + - threephase + - twophase + - weibull1 + - weibull2 + - weibull2x + - yieldLoss + - arandaordaz + +- title: Effective Dose Estimation + desc: Functions for estimating effective doses and comparisons + contents: + - ED.drc + - ED_robust + - CIcomp + - CIcompX + - comped + - maED + - maED_robust + - isobole + - NEC + - MAX + - PR + - relpot + +- title: Diagnostics and Model Selection + desc: Model diagnostics and helper functions + contents: + - modelFit + - Rsq + - rss + - rdrm + - anova.drc + - lin.test + - mr.test + - neill.test + - noEffect + - backfit + - boxcox.drc + - searchdrc + - simDR + - simFct + - plotFACI + - getInitial + - getMeanFunctions + +- title: S3 Methods + desc: Methods for drc model objects + contents: + - coef.drc + - confint.drc + - cooks.distance.drc + - estfun.drc + - fitted.drc + - hatvalues.drc + - logLik.drc + - plot.drc + - predict.drc + - print.drc + - print.summary.drc + - residuals.drc + - summary.drc + - update.drc + - vcov.drc + - bread.drc + +- title: Datasets + desc: Example datasets for dose-response analysis + contents: + - acidiq + - aconiazide + - acute.inh + - algae + - arbovirus + - auxins + - barley + - bees + - blackgrass + - broccoli + - C.dubia + - CadmiumDaphnia + - carbendazim + - chickweed + - chlorac + - chlordan + - ctb + - Cyp17 + - Daphnia + - daphnids + - decontaminants + - deguelin + - earthworms + - echovirus + - Eryngium.sparganophyllum + - etmotc + - finney71 + - fluoranthene + - germination + - GiantKelp + - glymet + - guthion + - H.virescens + - heartrate + - leaflength + - lemna + - lepidium + - lettuce + - liver.tumor + - M.bahia + - mdra + - mecter + - metals + - methionine + - mixture + - multi2 + - nasturtium + - nfa + - nicotine + - O.mykiss + - P.promelas + - RScompetition + - red.fescue + - ryegrass + - ryegrass2 + - S.alba + - S.alba.comp + - S.capricornutum + - secalonic + - selenium + - spinach + - TCDD + - terbuthylazin + - ursa + - vinclozolin diff --git a/data/C.dubia.rda b/data/C.dubia.rda new file mode 100644 index 00000000..71fdd385 Binary files /dev/null and b/data/C.dubia.rda differ diff --git a/data/CadmiumDaphnia.rda b/data/CadmiumDaphnia.rda new file mode 100644 index 00000000..7b36771a Binary files /dev/null and b/data/CadmiumDaphnia.rda differ diff --git a/data/Cyp17.rda b/data/Cyp17.rda new file mode 100644 index 00000000..13c6d934 Binary files /dev/null and b/data/Cyp17.rda differ diff --git a/data/Daphnia.rda b/data/Daphnia.rda new file mode 100644 index 00000000..6038966c Binary files /dev/null and b/data/Daphnia.rda differ diff --git a/data/Eryngium.sparganophyllum.rda b/data/Eryngium.sparganophyllum.rda new file mode 100644 index 00000000..a3094c06 Binary files /dev/null and b/data/Eryngium.sparganophyllum.rda differ diff --git a/data/Eryngium.sparganophyllum0.rda b/data/Eryngium.sparganophyllum0.rda new file mode 100644 index 00000000..73e63973 Binary files /dev/null and b/data/Eryngium.sparganophyllum0.rda differ diff --git a/data/G.aparine.rda b/data/G.aparine.rda new file mode 100644 index 00000000..0676fc0e Binary files /dev/null and b/data/G.aparine.rda differ diff --git a/data/GiantKelp.rda b/data/GiantKelp.rda new file mode 100644 index 00000000..ab59b593 Binary files /dev/null and b/data/GiantKelp.rda differ diff --git a/data/H.virescens.rda b/data/H.virescens.rda new file mode 100644 index 00000000..9700eb21 Binary files /dev/null and b/data/H.virescens.rda differ diff --git a/data/M.bahia.rda b/data/M.bahia.rda new file mode 100644 index 00000000..59cebf70 Binary files /dev/null and b/data/M.bahia.rda differ diff --git a/data/O.mykiss.rda b/data/O.mykiss.rda new file mode 100644 index 00000000..be3ae428 Binary files /dev/null and b/data/O.mykiss.rda differ diff --git a/data/P.promelas.rda b/data/P.promelas.rda new file mode 100644 index 00000000..ec950d02 Binary files /dev/null and b/data/P.promelas.rda differ diff --git a/data/RScompetition.rda b/data/RScompetition.rda new file mode 100644 index 00000000..e6b8cd39 Binary files /dev/null and b/data/RScompetition.rda differ diff --git a/data/S.alba.comp.rda b/data/S.alba.comp.rda new file mode 100644 index 00000000..4bbea714 Binary files /dev/null and b/data/S.alba.comp.rda differ diff --git a/data/S.alba.rda b/data/S.alba.rda new file mode 100644 index 00000000..6314b2d7 Binary files /dev/null and b/data/S.alba.rda differ diff --git a/data/S.capricornutum.rda b/data/S.capricornutum.rda new file mode 100644 index 00000000..7cac4bbe Binary files /dev/null and b/data/S.capricornutum.rda differ diff --git a/data/TCDD.rda b/data/TCDD.rda new file mode 100644 index 00000000..59e09afc Binary files /dev/null and b/data/TCDD.rda differ diff --git a/data/acidiq.rda b/data/acidiq.rda new file mode 100644 index 00000000..b1910ead Binary files /dev/null and b/data/acidiq.rda differ diff --git a/data/aconiazide.rda b/data/aconiazide.rda new file mode 100644 index 00000000..cccd9767 Binary files /dev/null and b/data/aconiazide.rda differ diff --git a/data/acute.inh.rda b/data/acute.inh.rda new file mode 100644 index 00000000..9ca85981 Binary files /dev/null and b/data/acute.inh.rda differ diff --git a/data/algae.rda b/data/algae.rda new file mode 100644 index 00000000..52fe0779 Binary files /dev/null and b/data/algae.rda differ diff --git a/data/arbovirus.rda b/data/arbovirus.rda new file mode 100644 index 00000000..29134fa5 Binary files /dev/null and b/data/arbovirus.rda differ diff --git a/data/auxins.rda b/data/auxins.rda new file mode 100644 index 00000000..cebdbe47 Binary files /dev/null and b/data/auxins.rda differ diff --git a/data/barley.rda b/data/barley.rda new file mode 100644 index 00000000..560a8e1c Binary files /dev/null and b/data/barley.rda differ diff --git a/data/bees.rda b/data/bees.rda new file mode 100644 index 00000000..f5a8593d Binary files /dev/null and b/data/bees.rda differ diff --git a/data/blackgrass.rda b/data/blackgrass.rda new file mode 100644 index 00000000..11933a68 Binary files /dev/null and b/data/blackgrass.rda differ diff --git a/data/broccoli.rda b/data/broccoli.rda new file mode 100644 index 00000000..daf06749 Binary files /dev/null and b/data/broccoli.rda differ diff --git a/data/carbendazim.rda b/data/carbendazim.rda new file mode 100644 index 00000000..ff35b6b9 Binary files /dev/null and b/data/carbendazim.rda differ diff --git a/data/chickweed.rda b/data/chickweed.rda new file mode 100644 index 00000000..b3d2cf66 Binary files /dev/null and b/data/chickweed.rda differ diff --git a/data/chickweed0.rda b/data/chickweed0.rda new file mode 100644 index 00000000..5b31d7f5 Binary files /dev/null and b/data/chickweed0.rda differ diff --git a/data/chlorac.rda b/data/chlorac.rda new file mode 100644 index 00000000..87c6d393 Binary files /dev/null and b/data/chlorac.rda differ diff --git a/data/chlordan.rda b/data/chlordan.rda new file mode 100644 index 00000000..dfc019d7 Binary files /dev/null and b/data/chlordan.rda differ diff --git a/data/ctb.rda b/data/ctb.rda new file mode 100644 index 00000000..0e3f6ffb Binary files /dev/null and b/data/ctb.rda differ diff --git a/data/daphnids.rda b/data/daphnids.rda new file mode 100644 index 00000000..e143d761 Binary files /dev/null and b/data/daphnids.rda differ diff --git a/data/decontaminants.rda b/data/decontaminants.rda new file mode 100644 index 00000000..ccf199b9 Binary files /dev/null and b/data/decontaminants.rda differ diff --git a/data/deguelin.rda b/data/deguelin.rda new file mode 100644 index 00000000..e74b940f Binary files /dev/null and b/data/deguelin.rda differ diff --git a/data/earthworms.rda b/data/earthworms.rda new file mode 100644 index 00000000..416e9eee Binary files /dev/null and b/data/earthworms.rda differ diff --git a/data/echovirus.rda b/data/echovirus.rda new file mode 100644 index 00000000..187cd589 Binary files /dev/null and b/data/echovirus.rda differ diff --git a/data/etmotc.rda b/data/etmotc.rda new file mode 100644 index 00000000..cc67c1b3 Binary files /dev/null and b/data/etmotc.rda differ diff --git a/data/finney71.rda b/data/finney71.rda new file mode 100644 index 00000000..a6ba357f Binary files /dev/null and b/data/finney71.rda differ diff --git a/data/fluoranthene.rda b/data/fluoranthene.rda new file mode 100644 index 00000000..f8ff1e69 Binary files /dev/null and b/data/fluoranthene.rda differ diff --git a/data/germination.rda b/data/germination.rda new file mode 100644 index 00000000..da108ada Binary files /dev/null and b/data/germination.rda differ diff --git a/data/glymet.rda b/data/glymet.rda new file mode 100644 index 00000000..c70597fe Binary files /dev/null and b/data/glymet.rda differ diff --git a/data/guthion.rda b/data/guthion.rda new file mode 100644 index 00000000..b185d9bd Binary files /dev/null and b/data/guthion.rda differ diff --git a/data/heartrate.rda b/data/heartrate.rda new file mode 100644 index 00000000..e0a7e0bc Binary files /dev/null and b/data/heartrate.rda differ diff --git a/data/leaflength.rda b/data/leaflength.rda new file mode 100644 index 00000000..385b34c4 Binary files /dev/null and b/data/leaflength.rda differ diff --git a/data/lemna.rda b/data/lemna.rda new file mode 100644 index 00000000..45752fbc Binary files /dev/null and b/data/lemna.rda differ diff --git a/data/lepidium.rda b/data/lepidium.rda new file mode 100644 index 00000000..6b0b451d Binary files /dev/null and b/data/lepidium.rda differ diff --git a/data/lettuce.rda b/data/lettuce.rda new file mode 100644 index 00000000..ad2b3fac Binary files /dev/null and b/data/lettuce.rda differ diff --git a/data/liver.tumor.rda b/data/liver.tumor.rda new file mode 100644 index 00000000..b6bec395 Binary files /dev/null and b/data/liver.tumor.rda differ diff --git a/data/mdra.rda b/data/mdra.rda new file mode 100644 index 00000000..3a6f0f4a Binary files /dev/null and b/data/mdra.rda differ diff --git a/data/mecter.rda b/data/mecter.rda new file mode 100644 index 00000000..64ff4fac Binary files /dev/null and b/data/mecter.rda differ diff --git a/data/metals.rda b/data/metals.rda new file mode 100644 index 00000000..127ef7b8 Binary files /dev/null and b/data/metals.rda differ diff --git a/data/methionine.rda b/data/methionine.rda new file mode 100644 index 00000000..28817520 Binary files /dev/null and b/data/methionine.rda differ diff --git a/data/nasturtium.rda b/data/nasturtium.rda new file mode 100644 index 00000000..a49ed1f6 Binary files /dev/null and b/data/nasturtium.rda differ diff --git a/data/nfa.rda b/data/nfa.rda new file mode 100644 index 00000000..38c675f9 Binary files /dev/null and b/data/nfa.rda differ diff --git a/data/nicotine.rda b/data/nicotine.rda new file mode 100644 index 00000000..b399d26c Binary files /dev/null and b/data/nicotine.rda differ diff --git a/data/red.fescue.rda b/data/red.fescue.rda new file mode 100644 index 00000000..ba4c2e07 Binary files /dev/null and b/data/red.fescue.rda differ diff --git a/data/ryegrass.rda b/data/ryegrass.rda new file mode 100644 index 00000000..d2e869c9 Binary files /dev/null and b/data/ryegrass.rda differ diff --git a/data/ryegrass2.rda b/data/ryegrass2.rda new file mode 100644 index 00000000..15f49b65 Binary files /dev/null and b/data/ryegrass2.rda differ diff --git a/data/secalonic.rda b/data/secalonic.rda new file mode 100644 index 00000000..b6825145 Binary files /dev/null and b/data/secalonic.rda differ diff --git a/data/selenium.rda b/data/selenium.rda new file mode 100644 index 00000000..14f372a6 Binary files /dev/null and b/data/selenium.rda differ diff --git a/data/spinach.rda b/data/spinach.rda new file mode 100644 index 00000000..b396b5c9 Binary files /dev/null and b/data/spinach.rda differ diff --git a/data/terbuthylazin.rda b/data/terbuthylazin.rda new file mode 100644 index 00000000..736ee578 Binary files /dev/null and b/data/terbuthylazin.rda differ diff --git a/data/vinclozolin.rda b/data/vinclozolin.rda new file mode 100644 index 00000000..c1149830 Binary files /dev/null and b/data/vinclozolin.rda differ diff --git a/docs/.nojekyll b/docs/.nojekyll new file mode 100644 index 00000000..8b137891 --- /dev/null +++ b/docs/.nojekyll @@ -0,0 +1 @@ + diff --git a/docs/404.html b/docs/404.html new file mode 100644 index 00000000..ea977beb --- /dev/null +++ b/docs/404.html @@ -0,0 +1,89 @@ + + + + + + + +Page not found (404) • drc + + + + + + + + + + + + + + Skip to contents + + +
+
+
+

Page not found (404)

+ +
+ +Content not found. Please use links in the navbar. + +
+
+ + +
+

Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

+
+ +
+

Site built with pkgdown 2.2.0.

+
+ +
+
+ + + + + + + diff --git a/docs/404.md b/docs/404.md new file mode 100644 index 00000000..5107f896 --- /dev/null +++ b/docs/404.md @@ -0,0 +1,3 @@ +Content not found. Please use links in the navbar. + +# Page not found (404) diff --git a/docs/LICENSE-text.html b/docs/LICENSE-text.html new file mode 100644 index 00000000..a3947977 --- /dev/null +++ b/docs/LICENSE-text.html @@ -0,0 +1,400 @@ + +License • drc + Skip to contents + + +
+
+
+

License

+ +
+ +
                    GNU GENERAL PUBLIC LICENSE
+                       Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.,
+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+                            Preamble
+
+  The licenses for most software are designed to take away your
+freedom to share and change it.  By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users.  This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it.  (Some other Free Software Foundation software is covered by
+the GNU Lesser General Public License instead.)  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
+this service 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 make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+  For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have.  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.
+
+  We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+  Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software.  If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+  Finally, any free program is threatened constantly by software
+patents.  We wish to avoid the danger that redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary.  To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.
+
+                    GNU GENERAL PUBLIC LICENSE
+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+  0. This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License.  The "Program", below,
+refers to any such program or work, and a "work based on the Program"
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language.  (Hereinafter, translation is included without limitation in
+the term "modification".)  Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope.  The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+  1. You may copy and distribute 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 and disclaimer of warranty; keep intact all the
+notices that refer to this License and to the absence of any warranty;
+and give any other recipients of the Program a copy of this License
+along with the Program.
+
+You may charge a fee for the physical act of transferring a copy, and
+you may at your option offer warranty protection in exchange for a fee.
+
+  2. You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+    a) You must cause the modified files to carry prominent notices
+    stating that you changed the files and the date of any change.
+
+    b) You must cause any work that you distribute or publish, that in
+    whole or in part contains or is derived from the Program or any
+    part thereof, to be licensed as a whole at no charge to all third
+    parties under the terms of this License.
+
+    c) If the modified program normally reads commands interactively
+    when run, you must cause it, when started running for such
+    interactive use in the most ordinary way, to print or display an
+    announcement including an appropriate copyright notice and a
+    notice that there is no warranty (or else, saying that you provide
+    a warranty) and that users may redistribute the program under
+    these conditions, and telling the user how to view a copy of this
+    License.  (Exception: if the Program itself is interactive but
+    does not normally print such an announcement, your work based on
+    the Program is not required to print an announcement.)
+
+These requirements apply to the modified work as a whole.  If
+identifiable sections of that work are not derived from the Program,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works.  But when you
+distribute the same sections as part of a whole which is a work based
+on the Program, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+  3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+    a) Accompany it with the complete corresponding machine-readable
+    source code, which must be distributed under the terms of Sections
+    1 and 2 above on a medium customarily used for software interchange; or,
+
+    b) Accompany it with a written offer, valid for at least three
+    years, to give any third party, for a charge no more than your
+    cost of physically performing source distribution, a complete
+    machine-readable copy of the corresponding source code, to be
+    distributed under the terms of Sections 1 and 2 above on a medium
+    customarily used for software interchange; or,
+
+    c) Accompany it with the information you received as to the offer
+    to distribute corresponding source code.  (This alternative is
+    allowed only for noncommercial distribution and only if you
+    received the program in object code or executable form with such
+    an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for
+making modifications to it.  For an executable work, complete source
+code means all the source code for all modules it contains, plus any
+associated interface definition files, plus the scripts used to
+control compilation and installation of the executable.  However, as a
+special exception, the source code distributed need not include
+anything that is normally distributed (in either source or binary
+form) with the major components (compiler, kernel, and so on) of the
+operating system on which the executable runs, unless that component
+itself accompanies the executable.
+
+If distribution of executable or object code is made by offering
+access to copy from a designated place, then offering equivalent
+access to copy the source code from the same place counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+  4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License.  Any attempt
+otherwise to copy, modify, sublicense or distribute the Program is
+void, and will automatically terminate your rights under this License.
+However, parties who have received copies, or rights, from you under
+this License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+  5. You are not required to accept this License, since you have not
+signed it.  However, nothing else grants you permission to modify or
+distribute the Program or its derivative works.  These actions are
+prohibited by law if you do not accept this License.  Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+  6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program subject to
+these terms and conditions.  You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+  7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+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
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Program at all.  For example, if a patent
+license would not permit royalty-free redistribution of the Program by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system, which is
+implemented by public license practices.  Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+  8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program under this License
+may add an explicit geographical distribution limitation excluding
+those countries, so that distribution is permitted only in or among
+countries not thus excluded.  In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+  9. The Free Software Foundation may publish revised and/or new versions
+of the 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 a version number of this License which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation.  If the Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+  10. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission.  For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this.  Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+                            NO WARRANTY
+
+  11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, 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.
+
+  12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE 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.
+
+                     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
+convey the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+    <one line to give the program's name and a brief idea of what it does.>
+    Copyright (C) <year>  <name of author>
+
+    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.
+
+    You should have received a copy of the GNU General Public License along
+    with this program; if not, write to the Free Software Foundation, Inc.,
+    51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+    Gnomovision version 69, Copyright (C) year name of author
+    Gnomovision 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, the commands you use may
+be called something other than `show w' and `show c'; they could even be
+mouse-clicks or menu items--whatever suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary.  Here is a sample; alter the names:
+
+  Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+  `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+  <signature of Ty Coon>, 1 April 1989
+  Ty Coon, President of Vice
+
+This 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.
+
+ +
+ + +
+

Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

+
+ +
+

Site built with pkgdown 2.2.0.

+
+ +
+ + + + + + + diff --git a/docs/LICENSE-text.md b/docs/LICENSE-text.md new file mode 100644 index 00000000..4e3fa4c5 --- /dev/null +++ b/docs/LICENSE-text.md @@ -0,0 +1,341 @@ +# License + + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your + freedom to share and change it. By contrast, the GNU General Public + License is intended to guarantee your freedom to share and change free + software--to make sure the software is free for all its users. This + General Public License applies to most of the Free Software + Foundation's software and to any other program whose authors commit to + using it. (Some other Free Software Foundation software is covered by + the GNU Lesser General Public License instead.) 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 + this service 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 make restrictions that forbid + anyone to deny you these rights or to ask you to surrender the rights. + These restrictions translate to certain responsibilities for you if you + distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether + gratis or for a fee, you must give the recipients all the rights that + you have. 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. + + We protect your rights with two steps: (1) copyright the software, and + (2) offer you this license which gives you legal permission to copy, + distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain + that everyone understands that there is no warranty for this free + software. If the software is modified by someone else and passed on, we + want its recipients to know that what they have is not the original, so + that any problems introduced by others will not reflect on the original + authors' reputations. + + Finally, any free program is threatened constantly by software + patents. We wish to avoid the danger that redistributors of a free + program will individually obtain patent licenses, in effect making the + program proprietary. To prevent this, we have made it clear that any + patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and + modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains + a notice placed by the copyright holder saying it may be distributed + under the terms of this General Public License. The "Program", below, + refers to any such program or work, and a "work based on the Program" + means either the Program or any derivative work under copyright law: + that is to say, a work containing the Program or a portion of it, + either verbatim or with modifications and/or translated into another + language. (Hereinafter, translation is included without limitation in + the term "modification".) Each licensee is addressed as "you". + + Activities other than copying, distribution and modification are not + covered by this License; they are outside its scope. The act of + running the Program is not restricted, and the output from the Program + is covered only if its contents constitute a work based on the + Program (independent of having been made by running the Program). + Whether that is true depends on what the Program does. + + 1. You may copy and distribute 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 and disclaimer of warranty; keep intact all the + notices that refer to this License and to the absence of any warranty; + and give any other recipients of the Program a copy of this License + along with the Program. + + You may charge a fee for the physical act of transferring a copy, and + you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion + of it, thus forming a work based on the Program, and copy and + distribute such modifications or work under the terms of Section 1 + above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + + These requirements apply to the modified work as a whole. If + identifiable sections of that work are not derived from the Program, + and can be reasonably considered independent and separate works in + themselves, then this License, and its terms, do not apply to those + sections when you distribute them as separate works. But when you + distribute the same sections as part of a whole which is a work based + on the Program, the distribution of the whole must be on the terms of + this License, whose permissions for other licensees extend to the + entire whole, and thus to each and every part regardless of who wrote it. + + Thus, it is not the intent of this section to claim rights or contest + your rights to work written entirely by you; rather, the intent is to + exercise the right to control the distribution of derivative or + collective works based on the Program. + + In addition, mere aggregation of another work not based on the Program + with the Program (or with a work based on the Program) on a volume of + a storage or distribution medium does not bring the other work under + the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, + under Section 2) in object code or executable form under the terms of + Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + + The source code for a work means the preferred form of the work for + making modifications to it. For an executable work, complete source + code means all the source code for all modules it contains, plus any + associated interface definition files, plus the scripts used to + control compilation and installation of the executable. However, as a + special exception, the source code distributed need not include + anything that is normally distributed (in either source or binary + form) with the major components (compiler, kernel, and so on) of the + operating system on which the executable runs, unless that component + itself accompanies the executable. + + If distribution of executable or object code is made by offering + access to copy from a designated place, then offering equivalent + access to copy the source code from the same place counts as + distribution of the source code, even though third parties are not + compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program + except as expressly provided under this License. Any attempt + otherwise to copy, modify, sublicense or distribute the Program is + void, and will automatically terminate your rights under this License. + However, parties who have received copies, or rights, from you under + this License will not have their licenses terminated so long as such + parties remain in full compliance. + + 5. You are not required to accept this License, since you have not + signed it. However, nothing else grants you permission to modify or + distribute the Program or its derivative works. These actions are + prohibited by law if you do not accept this License. Therefore, by + modifying or distributing the Program (or any work based on the + Program), you indicate your acceptance of this License to do so, and + all its terms and conditions for copying, distributing or modifying + the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the + Program), the recipient automatically receives a license from the + original licensor to copy, distribute or modify the Program subject to + these terms and conditions. You may not impose any further + restrictions on the recipients' exercise of the rights granted herein. + You are not responsible for enforcing compliance by third parties to + this License. + + 7. If, as a consequence of a court judgment or allegation of patent + infringement or for any other reason (not limited to patent issues), + 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 + distribute so as to satisfy simultaneously your obligations under this + License and any other pertinent obligations, then as a consequence you + may not distribute the Program at all. For example, if a patent + license would not permit royalty-free redistribution of the Program by + all those who receive copies directly or indirectly through you, then + the only way you could satisfy both it and this License would be to + refrain entirely from distribution of the Program. + + If any portion of this section is held invalid or unenforceable under + any particular circumstance, the balance of the section is intended to + apply and the section as a whole is intended to apply in other + circumstances. + + It is not the purpose of this section to induce you to infringe any + patents or other property right claims or to contest validity of any + such claims; this section has the sole purpose of protecting the + integrity of the free software distribution system, which is + implemented by public license practices. Many people have made + generous contributions to the wide range of software distributed + through that system in reliance on consistent application of that + system; it is up to the author/donor to decide if he or she is willing + to distribute software through any other system and a licensee cannot + impose that choice. + + This section is intended to make thoroughly clear what is believed to + be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in + certain countries either by patents or by copyrighted interfaces, the + original copyright holder who places the Program under this License + may add an explicit geographical distribution limitation excluding + those countries, so that distribution is permitted only in or among + countries not thus excluded. In such case, this License incorporates + the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions + of the 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 a version number of this License which applies to it and "any + later version", you have the option of following the terms and conditions + either of that version or of any later version published by the Free + Software Foundation. If the Program does not specify a version number of + this License, you may choose any version ever published by the Free Software + Foundation. + + 10. If you wish to incorporate parts of the Program into other free + programs whose distribution conditions are different, write to the author + to ask for permission. For software which is copyrighted by the Free + Software Foundation, write to the Free Software Foundation; we sometimes + make exceptions for this. Our decision will be guided by the two goals + of preserving the free status of all derivatives of our free software and + of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, 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. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING + WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR + REDISTRIBUTE 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. + + 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 + convey 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 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. + + You should have received a copy of the GNU General Public License along + with this program; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + + Also add information on how to contact you by electronic and paper mail. + + If the program is interactive, make it output a short notice like this + when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) year name of author + Gnomovision 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, the commands you use may + be called something other than `show w' and `show c'; they could even be + mouse-clicks or menu items--whatever suits your program. + + You should also get your employer (if you work as a programmer) or your + school, if any, to sign a "copyright disclaimer" for the program, if + necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + + This 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. diff --git a/docs/apple-touch-icon.png b/docs/apple-touch-icon.png new file mode 100644 index 00000000..8380533b Binary files /dev/null and b/docs/apple-touch-icon.png differ diff --git a/docs/articles/dose-response-workflow.html b/docs/articles/dose-response-workflow.html new file mode 100644 index 00000000..ba64e457 --- /dev/null +++ b/docs/articles/dose-response-workflow.html @@ -0,0 +1,1134 @@ + + + + + + + +A Practical Workflow for Dose-Response Analysis • drc + + + + + + + + + + + + + Skip to contents + + +
+ + + + +
+
+

A Practical Workflow for Dose-Response Analysis

+

Hannes +Reinwald

+ +

2026-05-26

+ + Source: vignettes/dose-response-workflow.Rmd +
dose-response-workflow.Rmd
+
+ + + +
+

Executive Summary +

+

This vignette provides a comprehensive, step-by-step workflow for +conducting proper dose-response analysis using the drc +package. We demonstrate the complete analysis process from initial model +fitting through model selection, validation, and interpretation. By +following this workflow, even inexperienced users can perform rigorous +dose-response modeling while avoiding common pitfalls.

+
+
+

Introduction +

+

Dose-response analysis is fundamental in toxicology, ecotoxicology, +pharmacology, and related fields. The relationship between dose (or +concentration) and biological response often follows non-linear patterns +that require specialized statistical models. The drc +package provides a comprehensive framework for fitting, comparing, and +interpreting dose-response models.

+
+

What You Will Learn +

+

This vignette demonstrates a complete workflow including:

+
    +
  1. Initial exploratory model fitting
    2. +
  2. Visual assessment of model adequacy
    3. +
  3. Statistical evaluation of model fit
    4. +
  4. Systematic model comparison and selection
    5. +
  5. Model-averaged estimation for robust inference
    6. +
  6. Understanding the impact of parameter constraints
    7. +
  7. Choosing appropriate models for different data types
    8. +
+
+
+

The Example Dataset +

+

We will use the ryegrass dataset, which contains +measurements of root length in perennial ryegrass (Lolium perenne +L.) exposed to different concentrations of ferulic acid, a phenolic +compound that inhibits plant growth.

+
+# Load the ryegrass dataset
+data(ryegrass)
+
+# Examine the data structure
+head(ryegrass, 10)
+#>       rootl conc
+#> 1  7.580000 0.00
+#> 2  8.000000 0.00
+#> 3  8.328571 0.00
+#> 4  7.250000 0.00
+#> 5  7.375000 0.00
+#> 6  7.962500 0.00
+#> 7  8.355556 0.94
+#> 8  6.914286 0.94
+#> 9  7.750000 0.94
+#> 10 6.871429 1.88
+
+# Summary statistics
+summary(ryegrass)
+#>      rootl             conc       
+#>  Min.   :0.2200   Min.   : 0.000  
+#>  1st Qu.:0.8491   1st Qu.: 0.705  
+#>  Median :5.0778   Median : 2.815  
+#>  Mean   :4.3272   Mean   : 7.384  
+#>  3rd Qu.:7.4262   3rd Qu.: 9.375  
+#>  Max.   :8.3556   Max.   :30.000
+
+# Simple exploratory plot
+plot(rootl ~ conc, data = ryegrass,
+     xlab = "Ferulic acid concentration (mM)",
+     ylab = "Root length (cm)",
+     main = "Ryegrass Root Growth vs. Ferulic Acid Concentration",
+     pch = 16, cex = 1.2)
+

Scatter plot showing ryegrass root length (cm) versus ferulic acid concentration (mM), displaying a decreasing dose-response relationship

+

The dataset contains 24 observations with: - conc: +Ferulic acid concentration in millimolar (mM) - rootl: Root +length in centimeters (cm)

+

We observe a clear dose-response relationship: as the concentration +increases, root length decreases, indicating an inhibitory effect of +ferulic acid on ryegrass root growth.

+
+
+
+

Step 1: Initial Model Fitting +

+
+

Choosing a Starting Model +

+

For a typical monotonic dose-response curve, the four-parameter +log-logistic model (LL.4) is an excellent starting point. +It is flexible, well-characterized, and commonly used in toxicology.

+

The LL.4 model has the form:

+

f(x)=c+d−c1+exp(b(log(x)−log(e)))f(x) = c + \frac{d-c}{1 + \exp(b(\log(x) - \log(e)))}

+

where: - b: Slope parameter (steepness of the curve) +- c: Lower asymptote (response at infinite dose) - +d: Upper asymptote (response at zero dose, control +response) - e: ED50 or EC50 (dose producing 50% of the +maximal effect)

+
+
+

Fitting the Initial Model +

+
+# Fit a four-parameter log-logistic model
+ryegrass.LL4 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4())
+
+# Display model summary
+summary(ryegrass.LL4)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept)  2.98222    0.46506  6.4125 2.960e-06 ***
+#> c:(Intercept)  0.48141    0.21219  2.2688   0.03451 *  
+#> d:(Intercept)  7.79296    0.18857 41.3272 < 2.2e-16 ***
+#> e:(Intercept)  3.05795    0.18573 16.4644 4.268e-13 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.5196256 (20 degrees of freedom)
+

The summary provides: - Parameter estimates and their standard errors +- Residual standard error - Model convergence information

+

Interpretation of Parameters: - The d +parameter (upper limit) represents the control root length (at zero +concentration) - The c parameter (lower limit) represents +the minimum root length at high concentrations - The e +parameter (ED50) is the concentration causing 50% reduction from control +- The b parameter controls the steepness of the +dose-response curve

+
+
+
+

Step 2: Visual Assessment of Model Fit +

+

Visual diagnostics are crucial for assessing whether the fitted model +adequately describes the data. We use two primary tools: the standard +dose-response plot and quantile-quantile (Q-Q) plots.

+
+

Standard Dose-Response Plot +

+
+# Plot the fitted model with data points
+plot(ryegrass.LL4, type = "all",
+     main = "LL.4 Model Fit to Ryegrass Data",
+     xlab = "Ferulic acid concentration (mM)",
+     ylab = "Root length (cm)",
+     lwd = 2, cex = 1.2)
+

Dose-response curve showing LL.4 model fit to ryegrass data with observed data points and fitted sigmoid curve

+

The plot shows: - Observed data points - Fitted dose-response curve - +Overall pattern of fit

+

What to Look For: - Do the fitted values follow the +general trend of the data? - Are there systematic deviations (e.g., all +points above or below the curve in certain regions)? - Are there +outliers that might influence the fit?

+
+
+

Quantile-Quantile (Q-Q) Plot +

+

Q-Q plots assess whether the model residuals follow a normal +distribution, which is an assumption of the fitting procedure.

+
+# Create Q-Q plot for residual diagnostics
+qqnorm(residuals(ryegrass.LL4),
+       main = "Normal Q-Q Plot of Residuals (LL.4)",
+       pch = 16, cex = 1.2)
+qqline(residuals(ryegrass.LL4), col = "red", lwd = 2)
+

Normal Q-Q plot of residuals from LL.4 model showing points approximately along the diagonal reference line

+

Interpretation: - Points should fall approximately +along the diagonal line - Systematic deviations suggest non-normality of +residuals - Deviations at the extremes are common and often acceptable - +Severe deviations may indicate model inadequacy or outliers

+
+
+

Residual Plot +

+

An additional useful diagnostic is plotting residuals against fitted +values:

+
+# Residuals vs. Fitted values
+plot(fitted(ryegrass.LL4), residuals(ryegrass.LL4),
+     xlab = "Fitted values",
+     ylab = "Residuals",
+     main = "Residual Plot (LL.4)",
+     pch = 16, cex = 1.2)
+abline(h = 0, col = "red", lwd = 2, lty = 2)
+

Residual plot showing residuals versus fitted values with random scatter around zero horizontal line

+

What to Look For: - Random scatter around zero (no +systematic pattern) - Constant variance across fitted values +(homoscedasticity) - No obvious outliers or influential points

+
+
+
+

Step 3: Statistical Evaluation of Model Fit +

+

Beyond visual assessment, we use formal statistical tests to evaluate +model adequacy and significance.

+
+

Test for Dose Effect: noEffect() +

+

The noEffect() function performs a likelihood ratio test +comparing the dose-response model to a null model (no dose effect).

+
+# Test whether there is a significant dose effect
+noEffect(ryegrass.LL4)
+#> Chi-square test              Df         p-value 
+#>        91.87776         3.00000         0.00000
+

Interpretation: - The null hypothesis is “no dose +effect” (all responses are equal) - A significant p-value (< 0.05) +indicates that the dose-response model fits significantly better than +the null model - This confirms that ferulic acid concentration has a +significant effect on root length

+
+
+

Goodness-of-Fit Test: modelFit() +

+

The modelFit() function assesses whether the model +adequately describes the data using a lack-of-fit test.

+
+# Perform goodness-of-fit test
+modelFit(ryegrass.LL4)
+#> Lack-of-fit test
+#> 
+#>           ModelDf    RSS Df F value p value
+#> ANOVA          17 5.1799                   
+#> DRC model      20 5.4002  3  0.2411  0.8665
+

Interpretation: - This test compares the fitted +model to a saturated model (perfect fit) - A +non-significant p-value suggests adequate fit (model is +not significantly worse than perfect fit) - A significant p-value +indicates lack of fit (model may be inadequate) - Note: +This test requires replication at dose levels

+
+
+

Estimating Effective Doses: ED() +

+

Effective dose (ED) or effective concentration (EC) values are key +outputs in dose-response analysis. They represent the dose required to +produce a specified level of effect.

+
+# Estimate EC10, EC20, and EC50 with 95% confidence intervals
+# Using delta method for confidence intervals
+ed_values <- ED(ryegrass.LL4, respLev = c(10, 20, 50), interval = "delta")
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error   Lower   Upper
+#> e:10  1.46371    0.18677 1.07411 1.85330
+#> e:20  1.92109    0.17774 1.55032 2.29186
+#> e:50  3.05795    0.18573 2.67053 3.44538
+ed_values
+#>      Estimate Std. Error    Lower    Upper
+#> e:10 1.463706  0.1867704 1.074109 1.853302
+#> e:20 1.921091  0.1777432 1.550325 2.291857
+#> e:50 3.057955  0.1857313 2.670526 3.445384
+

Understanding ED Values: - EC10: +Concentration causing 10% effect (reduction in root length) - +EC20: Concentration causing 20% effect - +EC50: Concentration causing 50% effect (often used as a +summary measure of potency)

+

Confidence Intervals: - The +interval = "delta" argument uses the delta method for CI +estimation - Alternative methods include "fls" (fieller), +"tfls" (transformed fieller) - Narrower CIs indicate more +precise estimates

+
+
+

Alternative Confidence Interval Methods +

+
+# Compare different confidence interval methods
+cat("Delta method:\n")
+#> Delta method:
+ED(ryegrass.LL4, respLev = 50, interval = "delta")
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error   Lower   Upper
+#> e:50  3.05795    0.18573 2.67053 3.44538
+
+cat("\nFieller method:\n")
+#> 
+#> Fieller method:
+ED(ryegrass.LL4, respLev = 50, interval = "fls")
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error    Lower    Upper
+#> e:50 21.28399    0.18573 14.44757 31.35531
+

The Fieller method is often preferred for ED50 estimation as it +accounts for the ratio nature of the parameter.

+
+
+
+

Step 4: Model Comparison and Selection +

+

A critical step in dose-response analysis is comparing alternative +models to select the most appropriate one. Different model families may +fit the data better depending on the underlying biological +mechanism.

+
+

Comparing Multiple Models +

+

We’ll compare the initial LL.4 model with several alternatives:

+
    +
  • +LN.4: Four-parameter log-normal model
    • +
  • +W1.4: Four-parameter Weibull type 1 model
    • +
  • +W2.4: Four-parameter Weibull type 2 model
    • +
  • +BC.4: Four-parameter Brain-Cousens hormesis +model
    • +
  • +LL.5: Five-parameter log-logistic model +(asymmetric)
    • +
  • +EXD.3: Three-parameter exponential decay model
    • +
+
+# Use mselect() to compare multiple models
+# This fits each model and compares using AIC
+model_comparison <- suppressWarnings(
+ mselect(
+   ryegrass.LL4,
+   fctList = list(LN.4(), W1.4(), W2.4(), BC.4(), LL.5(), EXD.3())
+   )
+ )
+model_comparison
+#>          logLik       IC Lack of fit   Res var
+#> W2.4  -15.91352 41.82703 0.945071314 0.2646283
+#> LL.4  -16.15514 42.31029 0.866483043 0.2700107
+#> LN.4  -16.29214 42.58429 0.818641010 0.2731110
+#> LL.5  -15.87828 43.75656 0.853847582 0.2777393
+#> BC.4  -17.05120 44.10241 0.565407254 0.2909448
+#> W1.4  -17.46720 44.93439 0.450567622 0.3012075
+#> EXD.3 -28.22358 64.44717 0.000886637 0.7030127
+

Understanding the Output:

+

The table shows: - logLik: Log-likelihood (higher is +better, but penalized for parameters) - IC: Information +criterion (AIC by default; lower is better) - +Res var: Residual variance (lower is better) - +Lack of fit: P-value for lack-of-fit test +(non-significant is better)

+

Models are sorted by IC (AIC), with the best-fitting model at the +top.

+
+
+

Selecting the Best Model +

+
+# Based on mselect results, fit the best model
+# (In this example, we'll use the model with lowest AIC from the comparison)
+# For ryegrass data, typically W1.4 or LL.4 performs well
+
+ryegrass.best <- drm(rootl ~ conc, data = ryegrass, fct = W1.4())
+
+# Summary of best model
+summary(ryegrass.best)
+#> 
+#> Model fitted: Weibull (type 1) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept)  2.39341    0.47832  5.0038 6.813e-05 ***
+#> c:(Intercept)  0.66045    0.18857  3.5023  0.002243 ** 
+#> d:(Intercept)  7.80586    0.20852 37.4348 < 2.2e-16 ***
+#> e:(Intercept)  3.60013    0.20311 17.7250 1.068e-13 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.5488238 (20 degrees of freedom)
+
+# ED estimates for best model
+ed_best <- ED(ryegrass.best, respLev = c(10, 20, 50), interval = "delta")
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error   Lower   Upper
+#> e:10  1.40598    0.25357 0.87705 1.93491
+#> e:20  1.92374    0.23477 1.43403 2.41346
+#> e:50  3.08896    0.17331 2.72744 3.45048
+ed_best
+#>      Estimate Std. Error     Lower    Upper
+#> e:10 1.405979  0.2535663 0.8770491 1.934909
+#> e:20 1.923744  0.2347672 1.4340283 2.413460
+#> e:50 3.088964  0.1733114 2.7274422 3.450485
+
+
+

Visual Comparison of Models +

+

Plotting multiple models together helps visualize differences in +fit:

+
+# Plot initial LL.4 model
+plot(ryegrass.LL4, type = "all",
+     main = "Comparison: LL.4 vs W1.4 Models",
+     xlab = "Ferulic acid concentration (mM)",
+     ylab = "Root length (cm)",
+     lwd = 2, cex = 1.2, col = "blue",
+     legend = FALSE)
+
+# Overlay the best model (W1.4)
+plot(ryegrass.best, add = TRUE, type = "none", lwd = 2, col = "red", lty = 2)
+
+# Add legend
+legend("topright", legend = c("LL.4 (initial)", "W1.4 (best)"),
+       col = c("blue", "red"), lwd = 2, lty = c(1, 2), cex = 1.1)
+

Comparison of LL.4 and W1.4 model fits showing two overlapping dose-response curves in blue (LL.4) and red dashed line (W1.4)

+
+
+

Comparing ED Estimates Between Models +

+
+# Compare EC50 estimates between models
+cat("EC50 from LL.4 model:\n")
+#> EC50 from LL.4 model:
+ED(ryegrass.LL4, respLev = 50, interval = "delta")
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error   Lower   Upper
+#> e:50  3.05795    0.18573 2.67053 3.44538
+
+cat("\nEC50 from W1.4 model:\n")
+#> 
+#> EC50 from W1.4 model:
+ED(ryegrass.best, respLev = 50, interval = "delta")
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error   Lower   Upper
+#> e:50  3.08896    0.17331 2.72744 3.45048
+

Important Notes: - Different models may yield +different ED estimates - Model selection should be based on both +statistical criteria (AIC) and biological plausibility - Small +differences in AIC (< 2) suggest models are essentially +equivalent

+
+
+
+

Step 5: Model-Averaged ED Estimation +

+

When multiple models fit similarly well, model averaging provides a +robust approach that accounts for model uncertainty. The +maED() function computes model-averaged ED estimates using +AIC-based weights.

+
+

Computing Model-Averaged EDs +

+
+# Model-averaged EC50 estimation using top 3 models
+# Based on our mselect results, we'll average over several competitive models
+ma_results <- maED(ryegrass.LL4,
+                   fctList = list(W1.4(), W2.4(), LL.5()),
+                   respLev = 50,
+                   interval = "buckland")
+#>          ED50     Weight
+#> LL.4 3.057955 0.33027128
+#> W1.4 3.088964 0.08893096
+#> W2.4 2.996913 0.42054089
+#> LL.5 3.023549 0.16025686
+
+ma_results
+#>      Estimate Std. Error    Lower    Upper
+#> e:50 3.029528  0.1969989 2.643417 3.415639
+

Understanding Model Averaging:

+
    +
  • Each model receives a weight based on its AIC value
    • +
  • Better-fitting models (lower AIC) receive higher weights
    • +
  • The final estimate is a weighted average across models
    • +
  • Confidence intervals account for both parameter uncertainty and +model uncertainty
    • +
+
+
+

Comparing Single-Model vs Model-Averaged Estimates +

+
+# Compare model-averaged EC50 with single-model estimates
+cat("Single model (W1.4) EC50:\n")
+#> Single model (W1.4) EC50:
+ED(ryegrass.best, respLev = 50, interval = "delta")
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error   Lower   Upper
+#> e:50  3.08896    0.17331 2.72744 3.45048
+
+cat("\nModel-averaged EC50 (top 3 models):\n")
+#> 
+#> Model-averaged EC50 (top 3 models):
+print(ma_results)
+#>      Estimate Std. Error    Lower    Upper
+#> e:50 3.029528  0.1969989 2.643417 3.415639
+

When to Use Model Averaging: - Multiple models have +similar AIC values (ΔAIC < 2-4) - You want robust estimates that +don’t depend on selecting a single model - Regulatory or risk assessment +contexts requiring conservative estimates

+

When to Use Single Model: - One model is clearly +superior (ΔAIC > 10) - Strong biological rationale for a specific +model form - Simpler interpretation needed

+
+
+
+

Step 6: Impact of Fixing Asymptotes +

+

The upper and lower asymptotes (parameters d and +c) can be estimated from the data or fixed based on prior +knowledge. Understanding when and how to fix these parameters is crucial +for proper model fitting.

+
+

Understanding Asymptote Parameters +

+
    +
  • +d (upper limit): Response at zero dose (control +response)
    • +
  • +c (lower limit): Response at infinite dose (maximal +effect)
    • +
+
+
+

Models with Different Asymptote Constraints +

+
+# LL.4: Both asymptotes free (4 parameters)
+ryegrass.LL4 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4())
+
+# LL.3: Lower asymptote fixed at 0 (3 parameters)
+ryegrass.LL3 <- drm(rootl ~ conc, data = ryegrass, fct = LL.3())
+
+# LL.3u: Upper asymptote fixed at 1 (3 parameters)
+# Note: Requires normalized data for this to be meaningful
+ryegrass_norm <- ryegrass
+ryegrass_norm$rootl_norm <- ryegrass$rootl / max(ryegrass$rootl)
+ryegrass.LL3u <- drm(rootl_norm ~ conc, data = ryegrass_norm, fct = LL.3u())
+
+# LL.2: Both asymptotes fixed (2 parameters)
+ryegrass.LL2 <- drm(rootl_norm ~ conc, data = ryegrass_norm, fct = LL.2())
+
+# Compare models
+cat("LL.4 (both free):\n")
+#> LL.4 (both free):
+summary(ryegrass.LL4)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept)  2.98222    0.46506  6.4125 2.960e-06 ***
+#> c:(Intercept)  0.48141    0.21219  2.2688   0.03451 *  
+#> d:(Intercept)  7.79296    0.18857 41.3272 < 2.2e-16 ***
+#> e:(Intercept)  3.05795    0.18573 16.4644 4.268e-13 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.5196256 (20 degrees of freedom)
+
+cat("\nLL.3 (lower = 0):\n")
+#> 
+#> LL.3 (lower = 0):
+summary(ryegrass.LL3)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept)  2.47033    0.34168  7.2299 4.011e-07 ***
+#> d:(Intercept)  7.85543    0.20438 38.4352 < 2.2e-16 ***
+#> e:(Intercept)  3.26336    0.19641 16.6154 1.474e-13 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.5615802 (21 degrees of freedom)
+
+cat("\nAIC Comparison:\n")
+#> 
+#> AIC Comparison:
+cat("LL.4 (4 params):", AIC(ryegrass.LL4), "\n")
+#> LL.4 (4 params): 42.31029
+cat("LL.3 (3 params):", AIC(ryegrass.LL3), "\n")
+#> LL.3 (3 params): 45.20827
+
+
+

Visual Comparison of Constrained Models +

+
+# Plot models with different constraints
+plot(ryegrass.LL4, type = "all",
+     main = "Effect of Asymptote Constraints",
+     xlab = "Ferulic acid concentration (mM)",
+     ylab = "Root length (cm)",
+     lwd = 2, col = "black", legend = FALSE, cex = 1.2)
+
+plot(ryegrass.LL3, add = TRUE, type = "none", lwd = 2, col = "blue", lty = 2)
+
+legend("topright",
+       legend = c("LL.4 (both free)", "LL.3 (c = 0)"),
+       col = c("black", "blue"),
+       lwd = 2, lty = c(1, 2),
+       cex = 1.1)
+

Comparison of LL.4 and LL.3 models showing effect of asymptote constraints with black solid line (LL.4) and blue dashed line (LL.3)

+
+
+

Implications of Fixing Asymptotes +

+

Benefits of Fixing Asymptotes: 1. Reduced +parameter count: Simpler model, fewer parameters to estimate 2. +Improved stability: Fewer parameters can mean more +stable fits 3. Biological relevance: Incorporating +prior knowledge (e.g., c = 0 when complete inhibition is impossible) 4. +Identifiability: Some datasets may not contain enough +information to estimate all parameters

+

When to Fix Asymptotes: - Fix c = 0 +when: - Response cannot go below zero (e.g., growth, survival) - +Biological knowledge indicates complete inhibition doesn’t occur - Data +doesn’t extend to high enough doses to estimate c

+
    +
  • +Fix d when: +
      +
    • Control response is known from independent measurements
      • +
    • Data is normalized to a known maximum (e.g., 100%)
      • +
    • You want to focus on relative potency comparisons
      • +
    +
    • +
+

When to Keep Asymptotes Free: - Data extends over a +wide dose range - Both asymptotes are clearly identifiable in the data - +No strong prior knowledge about asymptote values - Model +comparison/selection workflow

+
+
+

Effect on ED Estimates +

+
+# Compare ED estimates with different constraints
+cat("EC50 with LL.4 (both asymptotes free):\n")
+#> EC50 with LL.4 (both asymptotes free):
+ED(ryegrass.LL4, respLev = 50, interval = "delta")
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error   Lower   Upper
+#> e:50  3.05795    0.18573 2.67053 3.44538
+
+cat("\nEC50 with LL.3 (lower asymptote = 0):\n")
+#> 
+#> EC50 with LL.3 (lower asymptote = 0):
+ED(ryegrass.LL3, respLev = 50, interval = "delta")
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error   Lower   Upper
+#> e:50  3.26336    0.19641 2.85491 3.67181
+

Important Note: The choice of asymptote constraints +can substantially affect ED estimates, especially for EC10 and EC20 +values which depend more heavily on the asymptote values than EC50.

+
+
+
+

Step 7: Overview of Available Models +

+

The drc package provides numerous dose-response models +suitable for different types of data and biological mechanisms. +Understanding which model to use is crucial for proper analysis.

+
+

Monotonic (Non-Hormesis) Models +

+

Monotonic models describe dose-response relationships that are either +strictly increasing or strictly decreasing. These are appropriate when +the response changes consistently in one direction as dose +increases.

+
+

Log-Logistic Models (LL family) +

+

Characteristics: - Symmetric on log-dose scale - +Most commonly used in toxicology - S-shaped curve - Parameters: b +(slope), c (lower), d (upper), e (ED50)

+

Variants: - LL.2(): 2 parameters (c=0, +d=1 fixed) - LL.3(): 3 parameters (c=0) - +LL.3u(): 3 parameters (d=1) - LL.4(): 4 +parameters (most flexible) - LL.5(): 5 parameters +(asymmetric, f parameter)

+

Best for: - General dose-response data - Toxicity +studies - EC50/ED50 estimation

+

Example:

+
+# Standard application of log-logistic model
+example.LL <- drm(rootl ~ conc, data = ryegrass, fct = LL.4())
+plot(example.LL, main = "Log-Logistic Model (LL.4)")
+

Log-logistic model (LL.4) fitted to ryegrass data showing typical S-shaped dose-response curve

+
+
+

Weibull Models (W1 and W2 families) +

+

Characteristics: - Asymmetric on log-dose scale - +Two types: W1 (increasing asymmetry) and W2 (decreasing asymmetry) - +Flexible shape - Same parameter structure as log-logistic

+

Variants: - W1.2(), +W1.3(), W1.4(): Weibull type 1 - +W2.2(), W2.3(), W2.4(): Weibull +type 2

+

Best for: - Data with asymmetric dose-response +curves - Time-to-event data - Germination/mortality studies

+

Example:

+
+# Weibull models often fit plant growth data well
+example.W1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4())
+example.W2 <- drm(rootl ~ conc, data = ryegrass, fct = W2.4())
+
+# Compare
+plot(example.W1, type = "all", main = "Weibull Type 1 vs Type 2",
+     lwd = 2, col = "blue", legend = FALSE)
+plot(example.W2, add = TRUE, type = "none", lwd = 2, col = "red", lty = 2)
+legend("topright", legend = c("W1.4", "W2.4"),
+       col = c("blue", "red"), lwd = 2, lty = c(1, 2))
+

Comparison of Weibull Type 1 (blue) and Type 2 (red dashed) models showing asymmetric dose-response curves

+
+
+

Log-Normal Models (LN family) +

+

Characteristics: - Based on log-normal distribution +- Symmetric on log-dose scale - Similar to log-logistic but different +tail behavior

+

Variants: - LN.2(), +LN.3(), LN.3u(), LN.4()

+

Best for: - Data with normal distribution on log +scale - Particle size distributions - Alternative to log-logistic when +AIC suggests

+

Example:

+
+example.LN <- drm(rootl ~ conc, data = ryegrass, fct = LN.4())
+
+
+

Exponential Decay Models (EXD family) +

+

Characteristics: - Exponential decrease - No lower +asymptote (unless constrained) - Simpler than sigmoidal models

+

Variants: - EXD.2(): 2 parameters - +EXD.3(): 3 parameters

+

Best for: - Exponential decay processes - +Radioactive decay - Simple inhibition without clear asymptote

+

Example:

+
+example.EXD <- drm(rootl ~ conc, data = ryegrass, fct = EXD.3())
+
+
+
+

Hormesis (Non-Monotonic) Models +

+

Hormesis describes a biphasic dose-response relationship where low +doses stimulate a response (increase) while high doses inhibit +(decrease). This creates a characteristic inverted U-shape or J-shape +curve.

+
+

Brain-Cousens Models (BC family) +

+

Characteristics: - Adds hormesis parameter to +log-logistic model - Peak response at intermediate dose - Widely used +for hormetic data

+

Variants: - BC.4(): 4 parameters (c=0 +fixed) - BC.5(): 5 parameters (all free)

+

Parameters: - Standard LL parameters plus +f: hormesis parameter (controls magnitude of +stimulation)

+

Best for: - Plant growth stimulation at low +herbicide doses - Pharmaceutical hormesis - Toxicological hormesis

+

Example (conceptual):

+
+# Example with hormetic data (not ryegrass which is monotonic)
+# hormetic.model <- drm(response ~ dose, data = hormetic_data, fct = BC.5())
+# plot(hormetic.model)
+
+
+

Cedergreen-Ritz-Streibig Models (CRS family) +

+

Characteristics: - More flexible hormesis models - +Multiple parameterizations (a, b, c variants) - Better for pronounced +hormesis

+

Variants: - CRS.4a(), +CRS.4b(), CRS.4c(): 4-parameter variants - +CRS.5a(), CRS.5b(), CRS.5c(): +5-parameter variants - CRS.6(): 6 parameters (most +flexible)

+

Best for: - Strong hormesis effects - When BC models +don’t fit well - Detailed hormesis characterization

+
+
+

U-Shaped Cedergreen Models (UCRS family) +

+

Characteristics: - U-shaped response (opposite of +hormesis) - Low and high doses harmful, intermediate doses beneficial - +Less common than hormesis

+

Variants: - UCRS.4a(), +UCRS.4b(), UCRS.4c() - UCRS.5a(), +UCRS.5b(), UCRS.5c()

+

Best for: - Essential nutrients (deficiency and +toxicity) - Biphasic therapeutic responses

+
+
+
+

Model Selection Decision Tree +

+
Is your dose-response curve monotonic?
+│
+├─ YES (Monotonic/No Hormesis)
+│  │
+│  ├─ Standard S-shaped curve? → Start with LL.4
+│  ├─ Asymmetric curve? → Try W1.4 or W2.4
+│  ├─ Simple decay? → Try EXD.3
+│  └─ Unknown? → Compare LL.4, W1.4, W2.4, LN.4 using mselect()
+│
+└─ NO (Non-Monotonic/Hormesis)
+   │
+   ├─ Inverted U-shape (stimulation then inhibition)? → Try BC.5
+   ├─ Strong hormesis? → Try CRS.5a
+   ├─ U-shaped (harm-benefit-harm)? → Try UCRS.5a
+   └─ Unknown? → Compare BC.5, CRS.5a with mselect()
+
+
+

Practical Recommendations +

+
    +
  1. +Start Simple: Begin with LL.4 or W1.4 for monotonic +data
    2. +
  2. +Use Model Selection: Always compare multiple models +with mselect() +
    3. +
  3. +Check Residuals: Visual diagnostics are +essential
    4. +
  4. +Consider Biology: Model choice should make +biological sense
    5. +
  5. +Parameter Constraints: Use simpler models (LL.3, +LL.2) when appropriate
    6. +
  6. +Hormesis Testing: If you suspect hormesis, +explicitly test with BC or CRS models
    7. +
+
+
+

Comprehensive Model Comparison Example +

+
+# Compare a wide range of monotonic models for ryegrass data
+comprehensive <- suppressWarnings(
+   mselect(ryegrass.LL4, nested = TRUE,
+                        fctList = list(LL.3(), LL.5(),
+                                      W1.3(), W1.4(),
+                                      W2.3(), W2.4(),
+                                      LN.3(), LN.4(),
+                                      EXD.3())) 
+)
+comprehensive
+#>          logLik       IC Lack of fit   Res var Nested F test
+#> W2.3  -16.77862 41.55725 0.794024850 0.2708671  1.000000e+00
+#> W2.4  -15.91352 41.82703 0.945071314 0.2646283  2.356418e-01
+#> LL.4  -16.15514 42.31029 0.866483043 0.2700107            NA
+#> LN.4  -16.29214 42.58429 0.818641010 0.2731110  2.899907e-02
+#> LL.5  -15.87828 43.75656 0.853847582 0.2777393  1.155597e-01
+#> W1.4  -17.46720 44.93439 0.450567622 0.3012075  5.421708e-03
+#> LL.3  -18.60413 45.20827 0.353167872 0.3153724  4.597125e-02
+#> LN.3  -19.22361 46.44721 0.254436052 0.3320803  2.032428e-02
+#> W1.3  -22.22047 52.44094 0.043791495 0.4262881  6.598584e-03
+#> EXD.3 -28.22358 64.44717 0.000886637 0.7030127  1.040468e-05
+
+
+
+

Conclusion +

+

This vignette has demonstrated a comprehensive workflow for +dose-response analysis using the drc package. By following +these steps, you can:

+
+

Key Takeaways +

+
    +
  1. +Always Start with Exploration: Visualize your data +before fitting models
    2. +
  2. +Fit Multiple Models: Don’t rely on a single model +without comparison
    3. +
  3. +Use Visual Diagnostics: Q-Q plots and residual +plots are essential
    4. +
  4. +Perform Statistical Tests: Use +noEffect() and modelFit() to validate your +model
    5. +
  5. +Compare Systematically: Use mselect() +with AIC for objective model selection
    6. +
  6. +Consider Model Averaging: Use maED() +when multiple models fit similarly
    7. +
  7. +Understand Parameter Constraints: Know when to fix +or free asymptotes (c, d parameters)
    8. +
  8. +Choose Models Based on Data Type: Distinguish +between monotonic and hormetic responses
    9. +
+
+
+

Common Pitfalls to Avoid +

+
    +
  1. +Fitting only one model: Always compare +alternatives
    2. +
  2. +Ignoring diagnostics: Visual and statistical checks +are crucial
    3. +
  3. +Over-parameterization: More parameters isn’t always +better
    4. +
  4. +Inappropriate constraints: Don’t fix parameters +without justification
    5. +
  5. +Ignoring biology: Statistical fit should align with +biological plausibility
    6. +
  6. +Using hormesis models for monotonic data: This can +lead to spurious hormesis
    7. +
  7. +Not reporting confidence intervals: Point estimates +without uncertainty are incomplete
    8. +
+
+
+ +
    +
  1. +Explore your data with plots
    2. +
  2. +Fit an initial general model (e.g., LL.4)
    3. +
  3. +Assess fit visually (Q-Q plots, residual +plots)
    4. +
  4. +Test statistically (noEffect, modelFit)
    5. +
  5. +Compare multiple models (mselect)
    6. +
  6. +Select the best model or use model averaging
    7. +
  7. +Estimate EDs/ECs with appropriate confidence +intervals
    8. +
  8. +Evaluate parameter constraints if needed
    9. +
  9. +Interpret results in biological context
    10. +
  10. +Report model choice, fit statistics, and ED +estimates with CIs
    11. +
+
+
+

Further Resources +

+
    +
  • See ?drm for detailed function documentation
    • +
  • See ?LL.4, ?W1.4, etc. for specific model +documentation
    • +
  • See ?mselect for model selection details
    • +
  • See ?ED for effective dose estimation options
    • +
  • See the “Understanding NEC Models” vignette for threshold +models
    • +
+
+
+
+

References +

+

Ritz, C., Baty, F., Streibig, J. C., Gerhard, D. (2015). +Dose-Response Analysis Using R. PLOS ONE, +10(12), e0146021.

+

Ritz, C., Streibig, J. C. (2005). Bioassay analysis using R. +Journal of Statistical Software, 12(5), +1-22.

+

Brain, P., Cousens, R. (1989). An equation to describe dose-responses +where there is stimulation of growth at low doses. Weed +Research, 29, 93-96.

+

Cedergreen, N., Ritz, C., Streibig, J. C. (2005). Improved empirical +models describing hormesis. Environmental Toxicology and +Chemistry, 24, 3166-3172.

+

Inderjit, Streibig, J. C., Olofsdotter, M. (2002). Joint action of +phenolic acid mixtures and its significance in allelopathy research. +Physiologia Plantarum, 114, 422-428.

+
+
+

See Also +

+
    +
  • +vignette("nec-models") - Understanding NEC Models in +the drc Package
    • +
  • +?drm - Main function for fitting dose-response +models
    • +
  • +?ED - Estimating effective doses
    • +
  • +?mselect - Model selection
    • +
  • +?modelFit - Goodness-of-fit testing
    • +
  • +?plot.drc - Plotting dose-response curves
    • +
+
+
+
+ + + +
+

Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

+
+ +
+

Site built with pkgdown 2.2.0.

+
+ +
+
+ + + + + + + diff --git a/docs/articles/dose-response-workflow.md b/docs/articles/dose-response-workflow.md new file mode 100644 index 00000000..847ba94c --- /dev/null +++ b/docs/articles/dose-response-workflow.md @@ -0,0 +1,1039 @@ +# A Practical Workflow for Dose-Response Analysis + +## Executive Summary + +This vignette provides a comprehensive, step-by-step workflow for +conducting proper dose-response analysis using the `drc` package. We +demonstrate the complete analysis process from initial model fitting +through model selection, validation, and interpretation. By following +this workflow, even inexperienced users can perform rigorous +dose-response modeling while avoiding common pitfalls. + +## Introduction + +Dose-response analysis is fundamental in toxicology, ecotoxicology, +pharmacology, and related fields. The relationship between dose (or +concentration) and biological response often follows non-linear patterns +that require specialized statistical models. The `drc` package provides +a comprehensive framework for fitting, comparing, and interpreting +dose-response models. + +### What You Will Learn + +This vignette demonstrates a complete workflow including: + +1. Initial exploratory model fitting +2. Visual assessment of model adequacy +3. Statistical evaluation of model fit +4. Systematic model comparison and selection +5. Model-averaged estimation for robust inference +6. Understanding the impact of parameter constraints +7. Choosing appropriate models for different data types + +### The Example Dataset + +We will use the `ryegrass` dataset, which contains measurements of root +length in perennial ryegrass (*Lolium perenne L.*) exposed to different +concentrations of ferulic acid, a phenolic compound that inhibits plant +growth. + +``` r +# Load the ryegrass dataset +data(ryegrass) + +# Examine the data structure +head(ryegrass, 10) +#> rootl conc +#> 1 7.580000 0.00 +#> 2 8.000000 0.00 +#> 3 8.328571 0.00 +#> 4 7.250000 0.00 +#> 5 7.375000 0.00 +#> 6 7.962500 0.00 +#> 7 8.355556 0.94 +#> 8 6.914286 0.94 +#> 9 7.750000 0.94 +#> 10 6.871429 1.88 + +# Summary statistics +summary(ryegrass) +#> rootl conc +#> Min. :0.2200 Min. : 0.000 +#> 1st Qu.:0.8491 1st Qu.: 0.705 +#> Median :5.0778 Median : 2.815 +#> Mean :4.3272 Mean : 7.384 +#> 3rd Qu.:7.4262 3rd Qu.: 9.375 +#> Max. :8.3556 Max. :30.000 + +# Simple exploratory plot +plot(rootl ~ conc, data = ryegrass, + xlab = "Ferulic acid concentration (mM)", + ylab = "Root length (cm)", + main = "Ryegrass Root Growth vs. Ferulic Acid Concentration", + pch = 16, cex = 1.2) +``` + +![Scatter plot showing ryegrass root length (cm) versus ferulic acid +concentration (mM), displaying a decreasing dose-response +relationship](dose-response-workflow_files/figure-html/load-data-1.png) + +The dataset contains 24 observations with: - `conc`: Ferulic acid +concentration in millimolar (mM) - `rootl`: Root length in centimeters +(cm) + +We observe a clear dose-response relationship: as the concentration +increases, root length decreases, indicating an inhibitory effect of +ferulic acid on ryegrass root growth. + +## Step 1: Initial Model Fitting + +### Choosing a Starting Model + +For a typical monotonic dose-response curve, the four-parameter +log-logistic model (`LL.4`) is an excellent starting point. It is +flexible, well-characterized, and commonly used in toxicology. + +The `LL.4` model has the form: + +``` math +f(x) = c + \frac{d-c}{1 + \exp(b(\log(x) - \log(e)))} +``` + +where: - **b**: Slope parameter (steepness of the curve) - **c**: Lower +asymptote (response at infinite dose) - **d**: Upper asymptote (response +at zero dose, control response) - **e**: ED50 or EC50 (dose producing +50% of the maximal effect) + +### Fitting the Initial Model + +``` r +# Fit a four-parameter log-logistic model +ryegrass.LL4 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + +# Display model summary +summary(ryegrass.LL4) +#> +#> Model fitted: Log-logistic (ED50 as parameter) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 2.98222 0.46506 6.4125 2.960e-06 *** +#> c:(Intercept) 0.48141 0.21219 2.2688 0.03451 * +#> d:(Intercept) 7.79296 0.18857 41.3272 < 2.2e-16 *** +#> e:(Intercept) 3.05795 0.18573 16.4644 4.268e-13 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.5196256 (20 degrees of freedom) +``` + +The summary provides: - Parameter estimates and their standard errors - +Residual standard error - Model convergence information + +**Interpretation of Parameters:** - The `d` parameter (upper limit) +represents the control root length (at zero concentration) - The `c` +parameter (lower limit) represents the minimum root length at high +concentrations - The `e` parameter (ED50) is the concentration causing +50% reduction from control - The `b` parameter controls the steepness of +the dose-response curve + +## Step 2: Visual Assessment of Model Fit + +Visual diagnostics are crucial for assessing whether the fitted model +adequately describes the data. We use two primary tools: the standard +dose-response plot and quantile-quantile (Q-Q) plots. + +### Standard Dose-Response Plot + +``` r +# Plot the fitted model with data points +plot(ryegrass.LL4, type = "all", + main = "LL.4 Model Fit to Ryegrass Data", + xlab = "Ferulic acid concentration (mM)", + ylab = "Root length (cm)", + lwd = 2, cex = 1.2) +``` + +![Dose-response curve showing LL.4 model fit to ryegrass data with +observed data points and fitted sigmoid +curve](dose-response-workflow_files/figure-html/basic-plot-1.png) + +The plot shows: - Observed data points - Fitted dose-response curve - +Overall pattern of fit + +**What to Look For:** - Do the fitted values follow the general trend of +the data? - Are there systematic deviations (e.g., all points above or +below the curve in certain regions)? - Are there outliers that might +influence the fit? + +### Quantile-Quantile (Q-Q) Plot + +Q-Q plots assess whether the model residuals follow a normal +distribution, which is an assumption of the fitting procedure. + +``` r +# Create Q-Q plot for residual diagnostics +qqnorm(residuals(ryegrass.LL4), + main = "Normal Q-Q Plot of Residuals (LL.4)", + pch = 16, cex = 1.2) +qqline(residuals(ryegrass.LL4), col = "red", lwd = 2) +``` + +![Normal Q-Q plot of residuals from LL.4 model showing points +approximately along the diagonal reference +line](dose-response-workflow_files/figure-html/qq-plot-1.png) + +**Interpretation:** - Points should fall approximately along the +diagonal line - Systematic deviations suggest non-normality of +residuals - Deviations at the extremes are common and often acceptable - +Severe deviations may indicate model inadequacy or outliers + +### Residual Plot + +An additional useful diagnostic is plotting residuals against fitted +values: + +``` r +# Residuals vs. Fitted values +plot(fitted(ryegrass.LL4), residuals(ryegrass.LL4), + xlab = "Fitted values", + ylab = "Residuals", + main = "Residual Plot (LL.4)", + pch = 16, cex = 1.2) +abline(h = 0, col = "red", lwd = 2, lty = 2) +``` + +![Residual plot showing residuals versus fitted values with random +scatter around zero horizontal +line](dose-response-workflow_files/figure-html/residual-plot-1.png) + +**What to Look For:** - Random scatter around zero (no systematic +pattern) - Constant variance across fitted values (homoscedasticity) - +No obvious outliers or influential points + +## Step 3: Statistical Evaluation of Model Fit + +Beyond visual assessment, we use formal statistical tests to evaluate +model adequacy and significance. + +### Test for Dose Effect: noEffect() + +The +[`noEffect()`](https://hreinwald.github.io/drc/reference/noEffect.md) +function performs a likelihood ratio test comparing the dose-response +model to a null model (no dose effect). + +``` r +# Test whether there is a significant dose effect +noEffect(ryegrass.LL4) +#> Chi-square test Df p-value +#> 91.87776 3.00000 0.00000 +``` + +**Interpretation:** - The null hypothesis is “no dose effect” (all +responses are equal) - A significant p-value (\< 0.05) indicates that +the dose-response model fits significantly better than the null model - +This confirms that ferulic acid concentration has a significant effect +on root length + +### Goodness-of-Fit Test: modelFit() + +The +[`modelFit()`](https://hreinwald.github.io/drc/reference/modelFit.md) +function assesses whether the model adequately describes the data using +a lack-of-fit test. + +``` r +# Perform goodness-of-fit test +modelFit(ryegrass.LL4) +#> Lack-of-fit test +#> +#> ModelDf RSS Df F value p value +#> ANOVA 17 5.1799 +#> DRC model 20 5.4002 3 0.2411 0.8665 +``` + +**Interpretation:** - This test compares the fitted model to a saturated +model (perfect fit) - A **non-significant** p-value suggests adequate +fit (model is not significantly worse than perfect fit) - A significant +p-value indicates lack of fit (model may be inadequate) - **Note:** This +test requires replication at dose levels + +### Estimating Effective Doses: ED() + +Effective dose (ED) or effective concentration (EC) values are key +outputs in dose-response analysis. They represent the dose required to +produce a specified level of effect. + +``` r +# Estimate EC10, EC20, and EC50 with 95% confidence intervals +# Using delta method for confidence intervals +ed_values <- ED(ryegrass.LL4, respLev = c(10, 20, 50), interval = "delta") +#> +#> Estimated effective doses +#> +#> Estimate Std. Error Lower Upper +#> e:10 1.46371 0.18677 1.07411 1.85330 +#> e:20 1.92109 0.17774 1.55032 2.29186 +#> e:50 3.05795 0.18573 2.67053 3.44538 +ed_values +#> Estimate Std. Error Lower Upper +#> e:10 1.463706 0.1867704 1.074109 1.853302 +#> e:20 1.921091 0.1777432 1.550325 2.291857 +#> e:50 3.057955 0.1857313 2.670526 3.445384 +``` + +**Understanding ED Values:** - **EC10**: Concentration causing 10% +effect (reduction in root length) - **EC20**: Concentration causing 20% +effect - **EC50**: Concentration causing 50% effect (often used as a +summary measure of potency) + +**Confidence Intervals:** - The `interval = "delta"` argument uses the +delta method for CI estimation - Alternative methods include `"fls"` +(fieller), `"tfls"` (transformed fieller) - Narrower CIs indicate more +precise estimates + +### Alternative Confidence Interval Methods + +``` r +# Compare different confidence interval methods +cat("Delta method:\n") +#> Delta method: +ED(ryegrass.LL4, respLev = 50, interval = "delta") +#> +#> Estimated effective doses +#> +#> Estimate Std. Error Lower Upper +#> e:50 3.05795 0.18573 2.67053 3.44538 + +cat("\nFieller method:\n") +#> +#> Fieller method: +ED(ryegrass.LL4, respLev = 50, interval = "fls") +#> +#> Estimated effective doses +#> +#> Estimate Std. Error Lower Upper +#> e:50 21.28399 0.18573 14.44757 31.35531 +``` + +The Fieller method is often preferred for ED50 estimation as it accounts +for the ratio nature of the parameter. + +## Step 4: Model Comparison and Selection + +A critical step in dose-response analysis is comparing alternative +models to select the most appropriate one. Different model families may +fit the data better depending on the underlying biological mechanism. + +### Comparing Multiple Models + +We’ll compare the initial LL.4 model with several alternatives: + +- **LN.4**: Four-parameter log-normal model +- **W1.4**: Four-parameter Weibull type 1 model +- **W2.4**: Four-parameter Weibull type 2 model +- **BC.4**: Four-parameter Brain-Cousens hormesis model +- **LL.5**: Five-parameter log-logistic model (asymmetric) +- **EXD.3**: Three-parameter exponential decay model + +``` r +# Use mselect() to compare multiple models +# This fits each model and compares using AIC +model_comparison <- suppressWarnings( + mselect( + ryegrass.LL4, + fctList = list(LN.4(), W1.4(), W2.4(), BC.4(), LL.5(), EXD.3()) + ) + ) +model_comparison +#> logLik IC Lack of fit Res var +#> W2.4 -15.91352 41.82703 0.945071314 0.2646283 +#> LL.4 -16.15514 42.31029 0.866483043 0.2700107 +#> LN.4 -16.29214 42.58429 0.818641010 0.2731110 +#> LL.5 -15.87828 43.75656 0.853847582 0.2777393 +#> BC.4 -17.05120 44.10241 0.565407254 0.2909448 +#> W1.4 -17.46720 44.93439 0.450567622 0.3012075 +#> EXD.3 -28.22358 64.44717 0.000886637 0.7030127 +``` + +**Understanding the Output:** + +The table shows: - **logLik**: Log-likelihood (higher is better, but +penalized for parameters) - **IC**: Information criterion (AIC by +default; **lower is better**) - **Res var**: Residual variance (lower is +better) - **Lack of fit**: P-value for lack-of-fit test (non-significant +is better) + +Models are sorted by IC (AIC), with the best-fitting model at the top. + +### Selecting the Best Model + +``` r +# Based on mselect results, fit the best model +# (In this example, we'll use the model with lowest AIC from the comparison) +# For ryegrass data, typically W1.4 or LL.4 performs well + +ryegrass.best <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) + +# Summary of best model +summary(ryegrass.best) +#> +#> Model fitted: Weibull (type 1) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 2.39341 0.47832 5.0038 6.813e-05 *** +#> c:(Intercept) 0.66045 0.18857 3.5023 0.002243 ** +#> d:(Intercept) 7.80586 0.20852 37.4348 < 2.2e-16 *** +#> e:(Intercept) 3.60013 0.20311 17.7250 1.068e-13 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.5488238 (20 degrees of freedom) + +# ED estimates for best model +ed_best <- ED(ryegrass.best, respLev = c(10, 20, 50), interval = "delta") +#> +#> Estimated effective doses +#> +#> Estimate Std. Error Lower Upper +#> e:10 1.40598 0.25357 0.87705 1.93491 +#> e:20 1.92374 0.23477 1.43403 2.41346 +#> e:50 3.08896 0.17331 2.72744 3.45048 +ed_best +#> Estimate Std. Error Lower Upper +#> e:10 1.405979 0.2535663 0.8770491 1.934909 +#> e:20 1.923744 0.2347672 1.4340283 2.413460 +#> e:50 3.088964 0.1733114 2.7274422 3.450485 +``` + +### Visual Comparison of Models + +Plotting multiple models together helps visualize differences in fit: + +``` r +# Plot initial LL.4 model +plot(ryegrass.LL4, type = "all", + main = "Comparison: LL.4 vs W1.4 Models", + xlab = "Ferulic acid concentration (mM)", + ylab = "Root length (cm)", + lwd = 2, cex = 1.2, col = "blue", + legend = FALSE) + +# Overlay the best model (W1.4) +plot(ryegrass.best, add = TRUE, type = "none", lwd = 2, col = "red", lty = 2) + +# Add legend +legend("topright", legend = c("LL.4 (initial)", "W1.4 (best)"), + col = c("blue", "red"), lwd = 2, lty = c(1, 2), cex = 1.1) +``` + +![Comparison of LL.4 and W1.4 model fits showing two overlapping +dose-response curves in blue (LL.4) and red dashed line +(W1.4)](dose-response-workflow_files/figure-html/model-comparison-plot-1.png) + +### Comparing ED Estimates Between Models + +``` r +# Compare EC50 estimates between models +cat("EC50 from LL.4 model:\n") +#> EC50 from LL.4 model: +ED(ryegrass.LL4, respLev = 50, interval = "delta") +#> +#> Estimated effective doses +#> +#> Estimate Std. Error Lower Upper +#> e:50 3.05795 0.18573 2.67053 3.44538 + +cat("\nEC50 from W1.4 model:\n") +#> +#> EC50 from W1.4 model: +ED(ryegrass.best, respLev = 50, interval = "delta") +#> +#> Estimated effective doses +#> +#> Estimate Std. Error Lower Upper +#> e:50 3.08896 0.17331 2.72744 3.45048 +``` + +**Important Notes:** - Different models may yield different ED +estimates - Model selection should be based on both statistical criteria +(AIC) and biological plausibility - Small differences in AIC (\< 2) +suggest models are essentially equivalent + +## Step 5: Model-Averaged ED Estimation + +When multiple models fit similarly well, model averaging provides a +robust approach that accounts for model uncertainty. The +[`maED()`](https://hreinwald.github.io/drc/reference/maED.md) function +computes model-averaged ED estimates using AIC-based weights. + +### Computing Model-Averaged EDs + +``` r +# Model-averaged EC50 estimation using top 3 models +# Based on our mselect results, we'll average over several competitive models +ma_results <- maED(ryegrass.LL4, + fctList = list(W1.4(), W2.4(), LL.5()), + respLev = 50, + interval = "buckland") +#> ED50 Weight +#> LL.4 3.057955 0.33027128 +#> W1.4 3.088964 0.08893096 +#> W2.4 2.996913 0.42054089 +#> LL.5 3.023549 0.16025686 + +ma_results +#> Estimate Std. Error Lower Upper +#> e:50 3.029528 0.1969989 2.643417 3.415639 +``` + +**Understanding Model Averaging:** + +- Each model receives a weight based on its AIC value +- Better-fitting models (lower AIC) receive higher weights +- The final estimate is a weighted average across models +- Confidence intervals account for both parameter uncertainty and model + uncertainty + +### Comparing Single-Model vs Model-Averaged Estimates + +``` r +# Compare model-averaged EC50 with single-model estimates +cat("Single model (W1.4) EC50:\n") +#> Single model (W1.4) EC50: +ED(ryegrass.best, respLev = 50, interval = "delta") +#> +#> Estimated effective doses +#> +#> Estimate Std. Error Lower Upper +#> e:50 3.08896 0.17331 2.72744 3.45048 + +cat("\nModel-averaged EC50 (top 3 models):\n") +#> +#> Model-averaged EC50 (top 3 models): +print(ma_results) +#> Estimate Std. Error Lower Upper +#> e:50 3.029528 0.1969989 2.643417 3.415639 +``` + +**When to Use Model Averaging:** - Multiple models have similar AIC +values (ΔAIC \< 2-4) - You want robust estimates that don’t depend on +selecting a single model - Regulatory or risk assessment contexts +requiring conservative estimates + +**When to Use Single Model:** - One model is clearly superior (ΔAIC \> +10) - Strong biological rationale for a specific model form - Simpler +interpretation needed + +## Step 6: Impact of Fixing Asymptotes + +The upper and lower asymptotes (parameters `d` and `c`) can be estimated +from the data or fixed based on prior knowledge. Understanding when and +how to fix these parameters is crucial for proper model fitting. + +### Understanding Asymptote Parameters + +- **d (upper limit)**: Response at zero dose (control response) +- **c (lower limit)**: Response at infinite dose (maximal effect) + +### Models with Different Asymptote Constraints + +``` r +# LL.4: Both asymptotes free (4 parameters) +ryegrass.LL4 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + +# LL.3: Lower asymptote fixed at 0 (3 parameters) +ryegrass.LL3 <- drm(rootl ~ conc, data = ryegrass, fct = LL.3()) + +# LL.3u: Upper asymptote fixed at 1 (3 parameters) +# Note: Requires normalized data for this to be meaningful +ryegrass_norm <- ryegrass +ryegrass_norm$rootl_norm <- ryegrass$rootl / max(ryegrass$rootl) +ryegrass.LL3u <- drm(rootl_norm ~ conc, data = ryegrass_norm, fct = LL.3u()) + +# LL.2: Both asymptotes fixed (2 parameters) +ryegrass.LL2 <- drm(rootl_norm ~ conc, data = ryegrass_norm, fct = LL.2()) + +# Compare models +cat("LL.4 (both free):\n") +#> LL.4 (both free): +summary(ryegrass.LL4) +#> +#> Model fitted: Log-logistic (ED50 as parameter) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 2.98222 0.46506 6.4125 2.960e-06 *** +#> c:(Intercept) 0.48141 0.21219 2.2688 0.03451 * +#> d:(Intercept) 7.79296 0.18857 41.3272 < 2.2e-16 *** +#> e:(Intercept) 3.05795 0.18573 16.4644 4.268e-13 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.5196256 (20 degrees of freedom) + +cat("\nLL.3 (lower = 0):\n") +#> +#> LL.3 (lower = 0): +summary(ryegrass.LL3) +#> +#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 2.47033 0.34168 7.2299 4.011e-07 *** +#> d:(Intercept) 7.85543 0.20438 38.4352 < 2.2e-16 *** +#> e:(Intercept) 3.26336 0.19641 16.6154 1.474e-13 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.5615802 (21 degrees of freedom) + +cat("\nAIC Comparison:\n") +#> +#> AIC Comparison: +cat("LL.4 (4 params):", AIC(ryegrass.LL4), "\n") +#> LL.4 (4 params): 42.31029 +cat("LL.3 (3 params):", AIC(ryegrass.LL3), "\n") +#> LL.3 (3 params): 45.20827 +``` + +### Visual Comparison of Constrained Models + +``` r +# Plot models with different constraints +plot(ryegrass.LL4, type = "all", + main = "Effect of Asymptote Constraints", + xlab = "Ferulic acid concentration (mM)", + ylab = "Root length (cm)", + lwd = 2, col = "black", legend = FALSE, cex = 1.2) + +plot(ryegrass.LL3, add = TRUE, type = "none", lwd = 2, col = "blue", lty = 2) + +legend("topright", + legend = c("LL.4 (both free)", "LL.3 (c = 0)"), + col = c("black", "blue"), + lwd = 2, lty = c(1, 2), + cex = 1.1) +``` + +![Comparison of LL.4 and LL.3 models showing effect of asymptote +constraints with black solid line (LL.4) and blue dashed line +(LL.3)](dose-response-workflow_files/figure-html/asymptote-plot-1.png) + +### Implications of Fixing Asymptotes + +**Benefits of Fixing Asymptotes:** 1. **Reduced parameter count**: +Simpler model, fewer parameters to estimate 2. **Improved stability**: +Fewer parameters can mean more stable fits 3. **Biological relevance**: +Incorporating prior knowledge (e.g., c = 0 when complete inhibition is +impossible) 4. **Identifiability**: Some datasets may not contain enough +information to estimate all parameters + +**When to Fix Asymptotes:** - **Fix c = 0** when: - Response cannot go +below zero (e.g., growth, survival) - Biological knowledge indicates +complete inhibition doesn’t occur - Data doesn’t extend to high enough +doses to estimate c + +- **Fix d** when: + - Control response is known from independent measurements + - Data is normalized to a known maximum (e.g., 100%) + - You want to focus on relative potency comparisons + +**When to Keep Asymptotes Free:** - Data extends over a wide dose +range - Both asymptotes are clearly identifiable in the data - No strong +prior knowledge about asymptote values - Model comparison/selection +workflow + +### Effect on ED Estimates + +``` r +# Compare ED estimates with different constraints +cat("EC50 with LL.4 (both asymptotes free):\n") +#> EC50 with LL.4 (both asymptotes free): +ED(ryegrass.LL4, respLev = 50, interval = "delta") +#> +#> Estimated effective doses +#> +#> Estimate Std. Error Lower Upper +#> e:50 3.05795 0.18573 2.67053 3.44538 + +cat("\nEC50 with LL.3 (lower asymptote = 0):\n") +#> +#> EC50 with LL.3 (lower asymptote = 0): +ED(ryegrass.LL3, respLev = 50, interval = "delta") +#> +#> Estimated effective doses +#> +#> Estimate Std. Error Lower Upper +#> e:50 3.26336 0.19641 2.85491 3.67181 +``` + +**Important Note:** The choice of asymptote constraints can +substantially affect ED estimates, especially for EC10 and EC20 values +which depend more heavily on the asymptote values than EC50. + +## Step 7: Overview of Available Models + +The `drc` package provides numerous dose-response models suitable for +different types of data and biological mechanisms. Understanding which +model to use is crucial for proper analysis. + +### Monotonic (Non-Hormesis) Models + +Monotonic models describe dose-response relationships that are either +strictly increasing or strictly decreasing. These are appropriate when +the response changes consistently in one direction as dose increases. + +#### Log-Logistic Models (LL family) + +**Characteristics:** - Symmetric on log-dose scale - Most commonly used +in toxicology - S-shaped curve - Parameters: b (slope), c (lower), d +(upper), e (ED50) + +**Variants:** - +[`LL.2()`](https://hreinwald.github.io/drc/reference/LL.2.md): 2 +parameters (c=0, d=1 fixed) - +[`LL.3()`](https://hreinwald.github.io/drc/reference/LL.3.md): 3 +parameters (c=0) - +[`LL.3u()`](https://hreinwald.github.io/drc/reference/LL.3u.md): 3 +parameters (d=1) - +[`LL.4()`](https://hreinwald.github.io/drc/reference/LL.4.md): 4 +parameters (most flexible) - +[`LL.5()`](https://hreinwald.github.io/drc/reference/LL.5.md): 5 +parameters (asymmetric, f parameter) + +**Best for:** - General dose-response data - Toxicity studies - +EC50/ED50 estimation + +**Example:** + +``` r +# Standard application of log-logistic model +example.LL <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +plot(example.LL, main = "Log-Logistic Model (LL.4)") +``` + +![Log-logistic model (LL.4) fitted to ryegrass data showing typical +S-shaped dose-response +curve](dose-response-workflow_files/figure-html/ll-example-1.png) + +#### Weibull Models (W1 and W2 families) + +**Characteristics:** - Asymmetric on log-dose scale - Two types: W1 +(increasing asymmetry) and W2 (decreasing asymmetry) - Flexible shape - +Same parameter structure as log-logistic + +**Variants:** - +[`W1.2()`](https://hreinwald.github.io/drc/reference/W1.2.md), +[`W1.3()`](https://hreinwald.github.io/drc/reference/W1.3.md), +[`W1.4()`](https://hreinwald.github.io/drc/reference/W1.4.md): Weibull +type 1 - [`W2.2()`](https://hreinwald.github.io/drc/reference/W2.2.md), +[`W2.3()`](https://hreinwald.github.io/drc/reference/W2.3.md), +[`W2.4()`](https://hreinwald.github.io/drc/reference/W2.4.md): Weibull +type 2 + +**Best for:** - Data with asymmetric dose-response curves - +Time-to-event data - Germination/mortality studies + +**Example:** + +``` r +# Weibull models often fit plant growth data well +example.W1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) +example.W2 <- drm(rootl ~ conc, data = ryegrass, fct = W2.4()) + +# Compare +plot(example.W1, type = "all", main = "Weibull Type 1 vs Type 2", + lwd = 2, col = "blue", legend = FALSE) +plot(example.W2, add = TRUE, type = "none", lwd = 2, col = "red", lty = 2) +legend("topright", legend = c("W1.4", "W2.4"), + col = c("blue", "red"), lwd = 2, lty = c(1, 2)) +``` + +![Comparison of Weibull Type 1 (blue) and Type 2 (red dashed) models +showing asymmetric dose-response +curves](dose-response-workflow_files/figure-html/weibull-example-1.png) + +#### Log-Normal Models (LN family) + +**Characteristics:** - Based on log-normal distribution - Symmetric on +log-dose scale - Similar to log-logistic but different tail behavior + +**Variants:** - +[`LN.2()`](https://hreinwald.github.io/drc/reference/LN.2.md), +[`LN.3()`](https://hreinwald.github.io/drc/reference/LN.3.md), +[`LN.3u()`](https://hreinwald.github.io/drc/reference/LN.3u.md), +[`LN.4()`](https://hreinwald.github.io/drc/reference/LN.4.md) + +**Best for:** - Data with normal distribution on log scale - Particle +size distributions - Alternative to log-logistic when AIC suggests + +**Example:** + +``` r +example.LN <- drm(rootl ~ conc, data = ryegrass, fct = LN.4()) +``` + +#### Exponential Decay Models (EXD family) + +**Characteristics:** - Exponential decrease - No lower asymptote (unless +constrained) - Simpler than sigmoidal models + +**Variants:** - +[`EXD.2()`](https://hreinwald.github.io/drc/reference/EXD.2.md): 2 +parameters - +[`EXD.3()`](https://hreinwald.github.io/drc/reference/EXD.3.md): 3 +parameters + +**Best for:** - Exponential decay processes - Radioactive decay - Simple +inhibition without clear asymptote + +**Example:** + +``` r +example.EXD <- drm(rootl ~ conc, data = ryegrass, fct = EXD.3()) +``` + +### Hormesis (Non-Monotonic) Models + +Hormesis describes a biphasic dose-response relationship where low doses +stimulate a response (increase) while high doses inhibit (decrease). +This creates a characteristic inverted U-shape or J-shape curve. + +#### Brain-Cousens Models (BC family) + +**Characteristics:** - Adds hormesis parameter to log-logistic model - +Peak response at intermediate dose - Widely used for hormetic data + +**Variants:** - +[`BC.4()`](https://hreinwald.github.io/drc/reference/BC.4.md): 4 +parameters (c=0 fixed) - +[`BC.5()`](https://hreinwald.github.io/drc/reference/BC.5.md): 5 +parameters (all free) + +**Parameters:** - Standard LL parameters plus `f`: hormesis parameter +(controls magnitude of stimulation) + +**Best for:** - Plant growth stimulation at low herbicide doses - +Pharmaceutical hormesis - Toxicological hormesis + +**Example (conceptual):** + +``` r +# Example with hormetic data (not ryegrass which is monotonic) +# hormetic.model <- drm(response ~ dose, data = hormetic_data, fct = BC.5()) +# plot(hormetic.model) +``` + +#### Cedergreen-Ritz-Streibig Models (CRS family) + +**Characteristics:** - More flexible hormesis models - Multiple +parameterizations (a, b, c variants) - Better for pronounced hormesis + +**Variants:** - +[`CRS.4a()`](https://hreinwald.github.io/drc/reference/CRS.4a.md), +[`CRS.4b()`](https://hreinwald.github.io/drc/reference/CRS.4b.md), +[`CRS.4c()`](https://hreinwald.github.io/drc/reference/CRS.4c.md): +4-parameter variants - +[`CRS.5a()`](https://hreinwald.github.io/drc/reference/CRS.5a.md), +[`CRS.5b()`](https://hreinwald.github.io/drc/reference/CRS.5b.md), +[`CRS.5c()`](https://hreinwald.github.io/drc/reference/CRS.5c.md): +5-parameter variants - +[`CRS.6()`](https://hreinwald.github.io/drc/reference/CRS.6.md): 6 +parameters (most flexible) + +**Best for:** - Strong hormesis effects - When BC models don’t fit +well - Detailed hormesis characterization + +#### U-Shaped Cedergreen Models (UCRS family) + +**Characteristics:** - U-shaped response (opposite of hormesis) - Low +and high doses harmful, intermediate doses beneficial - Less common than +hormesis + +**Variants:** - +[`UCRS.4a()`](https://hreinwald.github.io/drc/reference/UCRS.4a.md), +[`UCRS.4b()`](https://hreinwald.github.io/drc/reference/UCRS.4b.md), +[`UCRS.4c()`](https://hreinwald.github.io/drc/reference/UCRS.4c.md) - +[`UCRS.5a()`](https://hreinwald.github.io/drc/reference/UCRS.5a.md), +[`UCRS.5b()`](https://hreinwald.github.io/drc/reference/UCRS.5b.md), +[`UCRS.5c()`](https://hreinwald.github.io/drc/reference/UCRS.5c.md) + +**Best for:** - Essential nutrients (deficiency and toxicity) - Biphasic +therapeutic responses + +### Model Selection Decision Tree + + Is your dose-response curve monotonic? + │ + ├─ YES (Monotonic/No Hormesis) + │ │ + │ ├─ Standard S-shaped curve? → Start with LL.4 + │ ├─ Asymmetric curve? → Try W1.4 or W2.4 + │ ├─ Simple decay? → Try EXD.3 + │ └─ Unknown? → Compare LL.4, W1.4, W2.4, LN.4 using mselect() + │ + └─ NO (Non-Monotonic/Hormesis) + │ + ├─ Inverted U-shape (stimulation then inhibition)? → Try BC.5 + ├─ Strong hormesis? → Try CRS.5a + ├─ U-shaped (harm-benefit-harm)? → Try UCRS.5a + └─ Unknown? → Compare BC.5, CRS.5a with mselect() + +### Practical Recommendations + +1. **Start Simple**: Begin with LL.4 or W1.4 for monotonic data +2. **Use Model Selection**: Always compare multiple models with + [`mselect()`](https://hreinwald.github.io/drc/reference/mselect.md) +3. **Check Residuals**: Visual diagnostics are essential +4. **Consider Biology**: Model choice should make biological sense +5. **Parameter Constraints**: Use simpler models (LL.3, LL.2) when + appropriate +6. **Hormesis Testing**: If you suspect hormesis, explicitly test with + BC or CRS models + +### Comprehensive Model Comparison Example + +``` r +# Compare a wide range of monotonic models for ryegrass data +comprehensive <- suppressWarnings( + mselect(ryegrass.LL4, nested = TRUE, + fctList = list(LL.3(), LL.5(), + W1.3(), W1.4(), + W2.3(), W2.4(), + LN.3(), LN.4(), + EXD.3())) +) +comprehensive +#> logLik IC Lack of fit Res var Nested F test +#> W2.3 -16.77862 41.55725 0.794024850 0.2708671 1.000000e+00 +#> W2.4 -15.91352 41.82703 0.945071314 0.2646283 2.356418e-01 +#> LL.4 -16.15514 42.31029 0.866483043 0.2700107 NA +#> LN.4 -16.29214 42.58429 0.818641010 0.2731110 2.899907e-02 +#> LL.5 -15.87828 43.75656 0.853847582 0.2777393 1.155597e-01 +#> W1.4 -17.46720 44.93439 0.450567622 0.3012075 5.421708e-03 +#> LL.3 -18.60413 45.20827 0.353167872 0.3153724 4.597125e-02 +#> LN.3 -19.22361 46.44721 0.254436052 0.3320803 2.032428e-02 +#> W1.3 -22.22047 52.44094 0.043791495 0.4262881 6.598584e-03 +#> EXD.3 -28.22358 64.44717 0.000886637 0.7030127 1.040468e-05 +``` + +## Conclusion + +This vignette has demonstrated a comprehensive workflow for +dose-response analysis using the `drc` package. By following these +steps, you can: + +### Key Takeaways + +1. **Always Start with Exploration**: Visualize your data before + fitting models +2. **Fit Multiple Models**: Don’t rely on a single model without + comparison +3. **Use Visual Diagnostics**: Q-Q plots and residual plots are + essential +4. **Perform Statistical Tests**: Use + [`noEffect()`](https://hreinwald.github.io/drc/reference/noEffect.md) + and + [`modelFit()`](https://hreinwald.github.io/drc/reference/modelFit.md) + to validate your model +5. **Compare Systematically**: Use + [`mselect()`](https://hreinwald.github.io/drc/reference/mselect.md) + with AIC for objective model selection +6. **Consider Model Averaging**: Use + [`maED()`](https://hreinwald.github.io/drc/reference/maED.md) when + multiple models fit similarly +7. **Understand Parameter Constraints**: Know when to fix or free + asymptotes (c, d parameters) +8. **Choose Models Based on Data Type**: Distinguish between monotonic + and hormetic responses + +### Common Pitfalls to Avoid + +1. **Fitting only one model**: Always compare alternatives +2. **Ignoring diagnostics**: Visual and statistical checks are crucial +3. **Over-parameterization**: More parameters isn’t always better +4. **Inappropriate constraints**: Don’t fix parameters without + justification +5. **Ignoring biology**: Statistical fit should align with biological + plausibility +6. **Using hormesis models for monotonic data**: This can lead to + spurious hormesis +7. **Not reporting confidence intervals**: Point estimates without + uncertainty are incomplete + +### Recommended Workflow Summary + +1. **Explore** your data with plots +2. **Fit** an initial general model (e.g., LL.4) +3. **Assess** fit visually (Q-Q plots, residual plots) +4. **Test** statistically (noEffect, modelFit) +5. **Compare** multiple models (mselect) +6. **Select** the best model or use model averaging +7. **Estimate** EDs/ECs with appropriate confidence intervals +8. **Evaluate** parameter constraints if needed +9. **Interpret** results in biological context +10. **Report** model choice, fit statistics, and ED estimates with CIs + +### Further Resources + +- See [`?drm`](https://hreinwald.github.io/drc/reference/drm.md) for + detailed function documentation +- See [`?LL.4`](https://hreinwald.github.io/drc/reference/LL.4.md), + [`?W1.4`](https://hreinwald.github.io/drc/reference/W1.4.md), etc. for + specific model documentation +- See [`?mselect`](https://hreinwald.github.io/drc/reference/mselect.md) + for model selection details +- See [`?ED`](https://hreinwald.github.io/drc/reference/ED.md) for + effective dose estimation options +- See the “Understanding NEC Models” vignette for threshold models + +## References + +Ritz, C., Baty, F., Streibig, J. C., Gerhard, D. (2015). Dose-Response +Analysis Using R. *PLOS ONE*, **10**(12), e0146021. + +Ritz, C., Streibig, J. C. (2005). Bioassay analysis using R. *Journal of +Statistical Software*, **12**(5), 1-22. + +Brain, P., Cousens, R. (1989). An equation to describe dose-responses +where there is stimulation of growth at low doses. *Weed Research*, +**29**, 93-96. + +Cedergreen, N., Ritz, C., Streibig, J. C. (2005). Improved empirical +models describing hormesis. *Environmental Toxicology and Chemistry*, +**24**, 3166-3172. + +Inderjit, Streibig, J. C., Olofsdotter, M. (2002). Joint action of +phenolic acid mixtures and its significance in allelopathy research. +*Physiologia Plantarum*, **114**, 422-428. + +## See Also + +- [`vignette("nec-models")`](https://hreinwald.github.io/drc/articles/nec-models.md) - + Understanding NEC Models in the drc Package +- [`?drm`](https://hreinwald.github.io/drc/reference/drm.md) - Main + function for fitting dose-response models +- [`?ED`](https://hreinwald.github.io/drc/reference/ED.md) - Estimating + effective doses +- [`?mselect`](https://hreinwald.github.io/drc/reference/mselect.md) - + Model selection +- [`?modelFit`](https://hreinwald.github.io/drc/reference/modelFit.md) - + Goodness-of-fit testing +- [`?plot.drc`](https://hreinwald.github.io/drc/reference/plot.drc.md) - + Plotting dose-response curves diff --git a/docs/articles/dose-response-workflow_files/figure-html/asymptote-plot-1.png b/docs/articles/dose-response-workflow_files/figure-html/asymptote-plot-1.png new file mode 100644 index 00000000..1112b558 Binary files /dev/null and b/docs/articles/dose-response-workflow_files/figure-html/asymptote-plot-1.png differ diff --git a/docs/articles/dose-response-workflow_files/figure-html/basic-plot-1.png b/docs/articles/dose-response-workflow_files/figure-html/basic-plot-1.png new file mode 100644 index 00000000..9102a124 Binary files /dev/null and b/docs/articles/dose-response-workflow_files/figure-html/basic-plot-1.png differ diff --git a/docs/articles/dose-response-workflow_files/figure-html/ll-example-1.png b/docs/articles/dose-response-workflow_files/figure-html/ll-example-1.png new file mode 100644 index 00000000..4f226341 Binary files /dev/null and b/docs/articles/dose-response-workflow_files/figure-html/ll-example-1.png differ diff --git a/docs/articles/dose-response-workflow_files/figure-html/load-data-1.png b/docs/articles/dose-response-workflow_files/figure-html/load-data-1.png new file mode 100644 index 00000000..197c5b24 Binary files /dev/null and b/docs/articles/dose-response-workflow_files/figure-html/load-data-1.png differ diff --git a/docs/articles/dose-response-workflow_files/figure-html/model-comparison-plot-1.png b/docs/articles/dose-response-workflow_files/figure-html/model-comparison-plot-1.png new file mode 100644 index 00000000..91e20501 Binary files /dev/null and b/docs/articles/dose-response-workflow_files/figure-html/model-comparison-plot-1.png differ diff --git a/docs/articles/dose-response-workflow_files/figure-html/qq-plot-1.png b/docs/articles/dose-response-workflow_files/figure-html/qq-plot-1.png new file mode 100644 index 00000000..6d88475b Binary files /dev/null and b/docs/articles/dose-response-workflow_files/figure-html/qq-plot-1.png differ diff --git a/docs/articles/dose-response-workflow_files/figure-html/residual-plot-1.png b/docs/articles/dose-response-workflow_files/figure-html/residual-plot-1.png new file mode 100644 index 00000000..8706bc83 Binary files /dev/null and b/docs/articles/dose-response-workflow_files/figure-html/residual-plot-1.png differ diff --git a/docs/articles/dose-response-workflow_files/figure-html/weibull-example-1.png b/docs/articles/dose-response-workflow_files/figure-html/weibull-example-1.png new file mode 100644 index 00000000..fb901661 Binary files /dev/null and b/docs/articles/dose-response-workflow_files/figure-html/weibull-example-1.png differ diff --git a/docs/articles/index.html b/docs/articles/index.html new file mode 100644 index 00000000..56527eee --- /dev/null +++ b/docs/articles/index.html @@ -0,0 +1,75 @@ + +Articles • drc + Skip to contents + + +
+
+
+

Articles

+
+ +
+

Guides

+
+ +
A Practical Workflow for Dose-Response Analysis
+
+
Understanding NEC Models in the drc Package
+
+
+
+

Technical Reports

+
+ +
Comparative Analysis: hreinwald/drc vs DoseResponse/drc
+
+
+
+ + +
+

Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

+
+ +
+

Site built with pkgdown 2.2.0.

+
+ +
+ + + + + + + diff --git a/docs/articles/index.md b/docs/articles/index.md new file mode 100644 index 00000000..50347d1a --- /dev/null +++ b/docs/articles/index.md @@ -0,0 +1,13 @@ +# Articles + +### Guides + +- [A Practical Workflow for Dose-Response + Analysis](https://hreinwald.github.io/drc/articles/dose-response-workflow.md): +- [Understanding NEC Models in the drc + Package](https://hreinwald.github.io/drc/articles/nec-models.md): + +### Technical Reports + +- [Comparative Analysis: hreinwald/drc vs + DoseResponse/drc](https://hreinwald.github.io/drc/articles/package-version-comparative-analysis.md): diff --git a/docs/articles/nec-models.html b/docs/articles/nec-models.html new file mode 100644 index 00000000..d9afded1 --- /dev/null +++ b/docs/articles/nec-models.html @@ -0,0 +1,762 @@ + + + + + + + +Understanding NEC Models in the drc Package • drc + + + + + + + + + + + + + Skip to contents + + +
+ + + + +
+
+

Understanding NEC Models in the drc Package

+

Hannes +Reinwald

+ +

2026-05-26

+ + Source: vignettes/nec-models.Rmd +
nec-models.Rmd
+
+ + + +
+

Executive Summary +

+

The drc R package contains 4 NEC (No Effect +Concentration) functions: NEC, NEC.2, +NEC.3, and NEC.4. After thorough analysis, +all functions are necessary and serve distinct +purposes. There is no redundancy.

+
+
+

Introduction +

+

The No Effect Concentration (NEC) model is a dose-response model with +a threshold below which the response is assumed constant and equal to +the control response. It has been proposed as an alternative to both the +classical NOEC (No Observed Effect Concentration) and the +regression-based EC/ED approach (Pires et al., 2002).

+

This vignette explains the differences between the four NEC functions +available in the drc package and provides guidance on when to use each +variant.

+
+
+

The NEC Model Equation +

+

The NEC model function proposed by Pires et al. (2002) is:

+

f(x)=c+(d−c)exp(−b(x−e)I(x−e))f(x) = c + (d-c) \exp(-b(x-e)I(x-e))

+

where +I(x−e)I(x-e) +is an indicator function equal to 0 for +x≤ex \leq e +and 1 for +x>ex > e.

+
+

Model Parameters +

+
    +
  • +b: Slope/rate parameter controlling the steepness +of the dose-response curve above the threshold
    • +
  • +c: Lower limit (control response) - the response +level below the threshold
    • +
  • +d: Upper limit (maximum response) - the asymptotic +response at high doses
    • +
  • +e: NEC threshold (no effect concentration) - the +dose below which there is no effect
    • +
+
+
+
+

Function Overview +

+
+

Base Implementation: NEC (Not Exported) +

+

The NEC function is the core implementation that +provides the flexible NEC dose-response model. It is not +exported in the package NAMESPACE and serves as an internal +implementation engine.

+

Key Features:

+
    +
  • Accepts a fixed argument to specify which parameters +should be fixed
    • +
  • Uses log-logistic self-starter function for initialization
    • +
  • Returns a model list with nonlinear function, self starter, and +parameter names
    • +
+

This function is called internally by all the numbered variants +(NEC.2, NEC.3, NEC.4) with specific parameter constraints.

+
+
+

NEC.2: Two-Parameter NEC Model +

+

Purpose: Convenience wrapper for highly constrained +scenarios where both lower and upper limits are known.

+

Free Parameters: 2

+
    +
  • +b: Slope parameter
    • +
  • +e: NEC threshold
    • +
+

Fixed Parameters:

+
    +
  • +c: Fixed at 0
    • +
  • +d: Fixed at user-specified value (default 1)
    • +
+

Use Cases:

+
    +
  • Response bounded on a known scale (e.g., 0-1 for proportions, 0-100 +for percentages)
    • +
  • Both bounds are well-defined from experimental design
    • +
  • Focus estimation on slope and threshold only
    • +
  • Reduces model complexity and improves parameter identifiability
    • +
+

Example:

+
+# Example with proportion data (bounded 0-1)
+# Using ryegrass data, normalizing to 0-1 scale
+data(ryegrass)
+ryegrass$prop_rootl <- ryegrass$rootl / max(ryegrass$rootl)
+
+# Fit NEC.2 model with upper limit fixed at 1
+nec2.model <- drm(prop_rootl ~ conc, data = ryegrass, fct = NEC.2())
+summary(nec2.model)
+#> 
+#> Model fitted: NEC with lower limit at 0 and upper limit at 1 (2 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept) 0.303610   0.035141  8.6397 1.609e-08 ***
+#> e:(Intercept) 0.751527   0.156092  4.8146 8.261e-05 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.08003264 (22 degrees of freedom)
+
+
+

NEC.3: Three-Parameter NEC Model +

+

Purpose: Most common variant - assumes zero baseline +response with variable maximum.

+

Free Parameters: 3

+
    +
  • +b: Slope parameter
    • +
  • +d: Upper limit
    • +
  • +e: NEC threshold
    • +
+

Fixed Parameters:

+
    +
  • +c: Fixed at 0
    • +
+

Use Cases:

+
    +
  • Standard toxicological/biological scenarios
    • +
  • Baseline response is zero (no treatment/exposure)
    • +
  • Maximum response varies by treatment
    • +
  • Balances flexibility with model stability
    • +
  • Reduces overfitting compared to NEC.4
    • +
+

Example:

+
+# Fit NEC.3 model - most common case
+# Assumes zero baseline response
+nec3.model <- drm(rootl ~ conc, data = ryegrass, fct = NEC.3())
+summary(nec3.model)
+#> 
+#> Model fitted: NEC with lower limit at 0 (3 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept)  2.54094        NaN     NaN       NaN    
+#> d:(Intercept)  7.39655    0.23498  31.477 < 2.2e-16 ***
+#> e:(Intercept)  3.39679        NaN     NaN       NaN    
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.81401 (21 degrees of freedom)
+
+# Plot the fitted model
+plot(nec3.model, type = "all", log = "",
+     main = "NEC.3 Model for Ryegrass Root Length",
+     xlab = "Ferulic acid concentration (mM)",
+     ylab = "Root length (cm)")
+

NEC.3 model for ryegrass root length showing threshold effect at low concentrations followed by exponential decline

+
+
+

NEC.4: Four-Parameter NEC Model +

+

Purpose: Full flexibility - all parameters estimated +from data.

+

Free Parameters: 4

+
    +
  • +b: Slope parameter
    • +
  • +c: Lower limit
    • +
  • +d: Upper limit
    • +
  • +e: NEC threshold
    • +
+

Use Cases:

+
    +
  • No biological constraints on parameters
    • +
  • Both baseline and maximum responses vary
    • +
  • Model selection and comparison workflows
    • +
  • Maximum flexibility when data supports it
    • +
  • Cases where control/baseline response is non-zero and unknown
    • +
+

Example:

+
+# Fit NEC.4 model - full flexibility
+nec4.model <- drm(rootl ~ conc, data = ryegrass, fct = NEC.4())
+summary(nec4.model)
+#> 
+#> Model fitted: NEC (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                Estimate Std. Error t-value   p-value    
+#> b:(Intercept)   3.16938  393.27265  0.0081  0.993650    
+#> c:(Intercept)   0.67201    0.23463  2.8641  0.009592 ** 
+#> d:(Intercept)   7.39666    0.20260 36.5091 < 2.2e-16 ***
+#> e:(Intercept)   3.41729   41.27705  0.0828  0.934842    
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.7017905 (20 degrees of freedom)
+
+# Compare parameter estimates
+coef(nec4.model)
+#> b:(Intercept) c:(Intercept) d:(Intercept) e:(Intercept) 
+#>     3.1693834     0.6720099     7.3966630     3.4172914
+
+
+
+

Comparison of NEC Variants +

+

The following table summarizes the key differences between the NEC +functions:

+ +++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
AspectNEC (base)NEC.2NEC.3NEC.4
ExportedNoYesYesYes
Free ParametersConfigurable2 (b, e)3 (b, d, e)4 (b, c, d, e)
Fixed c (lower)Configurable00Free
Fixed d (upper)ConfigurableUser-definedFreeFree
Model ComplexityDependsLowestMediumHighest
When to UseInternal onlyKnown boundsZero baselineFull flexibility
IdentifiabilityDependsExcellentGoodMay be challenging
+
+
+

Model Comparison Example +

+

Let’s compare the three exported NEC variants on the ryegrass +dataset:

+
+# Fit all three models
+nec2.fit <- drm(rootl ~ conc, data = ryegrass, fct = NEC.2(upper = max(ryegrass$rootl)))
+nec3.fit <- drm(rootl ~ conc, data = ryegrass, fct = NEC.3())
+nec4.fit <- drm(rootl ~ conc, data = ryegrass, fct = NEC.4())
+
+# Compare models using AIC
+cat("Model Comparison (AIC values):\n")
+#> Model Comparison (AIC values):
+cat("NEC.2:", AIC(nec2.fit), "\n")
+#> NEC.2: 52.70586
+cat("NEC.3:", AIC(nec3.fit), "\n")
+#> NEC.3: 63.02673
+cat("NEC.4:", AIC(nec4.fit), "\n")
+#> NEC.4: 56.73556
+
+# Plot all three models together
+my_plot = function(mod, col = "black", lwd = 2, pch = 16) {
+  plot(mod, type = "all", 
+     main = mod$fct$name,
+     col = col, lwd = lwd, pch = pch,
+     xlab = "Ferulic acid concentration (mM)",
+     ylab = "Root length (cm)")
+}
+my_plot(nec2.fit)
+

NEC.2 model fitted to ryegrass data with both asymptotes constrained

+
+my_plot(nec3.fit, col = "darkblue", lwd = 2)
+

NEC.3 model fitted to ryegrass data with lower asymptote fixed at zero

+
+my_plot(nec4.fit, col = "darkred", lwd = 2)
+

NEC.4 model fitted to ryegrass data with all parameters estimated

+
+
+

Design Pattern in the drc Package +

+

The NEC functions follow the standard drc package design +pattern used consistently across all model families:

+
+

Examples of Similar Patterns: +

+
    +
  1. +Log-logistic models: llogistic, +LL.2, LL.3, LL.3u, +LL.4, LL.5 +
    2. +
  2. +Weibull type 1: weibull1, +W1.2, W1.3, W1.3u, +W1.4 +
    3. +
  3. +Weibull type 2: weibull2, +W2.2, W2.3, W2.3u, +W2.4 +
    4. +
  4. +Gompertz: gompertz, G.2, +G.3, G.3u, G.4 +
    5. +
  5. +Log-normal: lnormal, +LN.2, LN.3, LN.3u, +LN.4 +
    6. +
+
+
+

Pattern Structure: +

+
    +
  1. +Base function (e.g., llogistic, +NEC) +
      +
    • Provides core implementation with full parameter flexibility
      • +
    • Often not exported (used internally)
      • +
    • Accepts fixed argument for parameter constraints
      • +
    +
    2. +
  2. +Numbered variants (e.g., LL.2, +LL.3, LL.4, LL.5) +
      +
    • Convenience wrappers with common parameter combinations
      • +
    • Exported for user convenience
      • +
    • Number indicates count of free parameters
      • +
    • Each serves specific biological/experimental scenarios
      • +
    +
    3. +
+
+
+

Benefits of This Design: +

+
    +
  • +User convenience: Common cases are easy to +specify
    • +
  • +Parameter identifiability: Constraining parameters +when appropriate improves estimation
    • +
  • +Model selection: Easy to compare nested models
    • +
  • +Biological meaning: Parameter constraints reflect +experimental knowledge
    • +
  • +Backwards compatibility: Adding variants doesn’t +break existing code
    • +
  • +Documentation clarity: Each variant can have +specific use-case documentation
    • +
+
+
+
+

Choosing the Right NEC Variant +

+

Here’s a decision guide to help you choose the appropriate NEC +function:

+
    +
  1. +Do you know both the lower and upper response +limits? +
      +
    • Yes → Use NEC.2 +
      • +
    • No → Go to step 2
      • +
    +
    2. +
  2. +Is your baseline (control) response zero or can it be +assumed to be zero? +
      +
    • Yes → Use NEC.3 (most common case)
      • +
    • No → Go to step 3
      • +
    +
    3. +
  3. +Do you need to estimate all parameters from the +data? +
      +
    • Yes → Use NEC.4 +
      • +
    • Unsure → Start with NEC.3 and compare with +NEC.4 using model selection criteria (AIC, BIC)
      • +
    +
    4. +
+
+

Example Decision Process: +

+
+# Toxicology study with percentage mortality (0-100%)
+# Known bounds: lower = 0%, upper = 100%
+# → Use NEC.2
+mortality.model <- drm(mortality ~ dose, data = mydata, fct = NEC.2(upper = 100))
+
+# Plant growth study measuring root length
+# Control (no treatment) shows some growth (not zero)
+# → Try both NEC.3 and NEC.4, compare with AIC
+model3 <- drm(rootlength ~ concentration, data = mydata, fct = NEC.3())
+model4 <- drm(rootlength ~ concentration, data = mydata, fct = NEC.4())
+mselect(model3, model4)
+
+# Standard dose-response with zero baseline
+# Maximum response unknown
+# → Use NEC.3
+response.model <- drm(response ~ dose, data = mydata, fct = NEC.3())
+
+
+
+

Redundancy Assessment +

+
+

Are any NEC functions redundant? +

+

Answer: NO - All functions are necessary.

+
+
+

Reasoning: +

+
    +
  1. +NEC (base function) +
      +
    • Cannot be removed: Contains the actual mathematical +implementation
      • +
    • All other functions are wrappers that call NEC with +specific constraints
      • +
    • Removing it would break NEC.2, NEC.3, and NEC.4
      • +
    +
    2. +
  2. +NEC.2 +
      +
    • Unique purpose: Only variant with both upper and lower limits +fixed
      • +
    • Distinct use case: Bounded response scales (proportions, +percentages)
      • +
    • Cannot be replicated: NEC.3 fixes only lower limit, NEC.4 fixes +nothing
      • +
    • Statistical benefit: Reduces parameters from 4 to 2, greatly +improving identifiability
      • +
    +
    3. +
  3. +NEC.3 +
      +
    • Most common scenario: Standard toxicology with zero baseline
      • +
    • Optimal balance: More flexible than NEC.2, more stable than +NEC.4
      • +
    • Common convention: Matches typical experimental designs where +control = 0
      • +
    • Unique constraint: Only variant fixing lower limit while freeing +upper limit
      • +
    +
    4. +
  4. +NEC.4 +
      +
    • Essential for flexibility: Only way to estimate all 4 +parameters
      • +
    • Model selection: Needed for comparing against constrained +models
      • +
    • Non-zero baselines: Only option when control response is unknown and +non-zero
      • +
    • Diagnostic tool: Helps determine if constraints are appropriate
      • +
    +
    5. +
+
+
+

User Experience Comparison: +

+

If functions were combined, users would need to manually specify +constraints:

+
+# Current approach (user-friendly):
+drm(y ~ x, data = mydata, fct = NEC.3())
+
+# If combined (cumbersome and error-prone):
+drm(y ~ x, data = mydata, fct = NEC(fixed = c(NA, 0, NA, NA)))
+

The current design: - Reduces usability barriers - Prevents errors +from wrong constraint specifications - Provides helpful documentation +for common cases - Maintains backwards compatibility - Follows +established drc package conventions

+
+
+
+

Practical Tips +

+
+

1. Starting with Model Selection +

+

When unsure which variant to use, start with NEC.3 (most common) and +compare with other variants:

+
+# Fit an initial model, then compare with alternative NEC variants
+m3 <- drm(response ~ dose, data = mydata, fct = NEC.3())
+
+# Compare using model selection (mselect takes one fitted model + a list of alternatives)
+mselect(m3, fctList = list(NEC.2(), NEC.4()))
+
+
+

2. Checking Parameter Identifiability +

+

If your NEC.4 model shows very large standard errors or fails to +converge, consider constraining parameters:

+
+# If NEC.4 has convergence issues, try NEC.3
+summary(nec4.model)  # Check standard errors
+# If c is close to 0 with large SE, use NEC.3
+nec3.model <- drm(response ~ dose, data = mydata, fct = NEC.3())
+
+
+

3. Interpreting the Threshold Parameter +

+

The e parameter represents the NEC threshold - the +concentration below which there is no effect:

+
+# Extract the threshold estimate
+threshold <- coef(nec3.model)["e:(Intercept)"]
+cat("Estimated NEC threshold:", threshold, "\n")
+
+# Get confidence interval for the threshold
+confint(nec3.model)
+
+
+
+

Conclusion +

+

All 4 NEC functions serve distinct and necessary purposes in the drc +package:

+
    +
  • +NEC: Internal implementation engine
    • +
  • +NEC.2: Highly constrained models with known bounds +(2 parameters)
    • +
  • +NEC.3: Standard case with zero baseline (3 +parameters) - most commonly used +
    • +
  • +NEC.4: Full flexibility for complex scenarios (4 +parameters)
    • +
+

The design represents:

+
    +
  1. +Sound software architecture: Internal +implementation separated from user interface
    2. +
  2. +Statistical best practice: Providing appropriate +model complexity for different scenarios
    3. +
  3. +User experience optimization: Common cases are +simple, complex cases are possible
    4. +
  4. +Package consistency: Matches the established +pattern used for all other model families
    5. +
+
+
+

References +

+

Pires, A. M., Branco, J. A., Picado, A., Mendonca, E. (2002) Models +for the estimation of a ‘no effect concentration’, +Environmetrics, 13, 15-27.

+
+
+

See Also +

+
    +
  • +?NEC - Base NEC function documentation
    • +
  • +?NEC.2 - Two-parameter NEC model
    • +
  • +?NEC.3 - Three-parameter NEC model
    • +
  • +?NEC.4 - Four-parameter NEC model
    • +
  • +?drm - Main function for fitting dose-response +models
    • +
  • +?mselect - Model selection function
    • +
+
+
+
+ + + +
+

Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

+
+ +
+

Site built with pkgdown 2.2.0.

+
+ +
+
+ + + + + + + diff --git a/docs/articles/nec-models.md b/docs/articles/nec-models.md new file mode 100644 index 00000000..3420f0ef --- /dev/null +++ b/docs/articles/nec-models.md @@ -0,0 +1,492 @@ +# Understanding NEC Models in the drc Package + +## Executive Summary + +The `drc` R package contains 4 NEC (No Effect Concentration) functions: +`NEC`, `NEC.2`, `NEC.3`, and `NEC.4`. After thorough analysis, **all +functions are necessary and serve distinct purposes**. There is no +redundancy. + +## Introduction + +The No Effect Concentration (NEC) model is a dose-response model with a +threshold below which the response is assumed constant and equal to the +control response. It has been proposed as an alternative to both the +classical NOEC (No Observed Effect Concentration) and the +regression-based EC/ED approach (Pires et al., 2002). + +This vignette explains the differences between the four NEC functions +available in the drc package and provides guidance on when to use each +variant. + +## The NEC Model Equation + +The NEC model function proposed by Pires et al. (2002) is: + +``` math +f(x) = c + (d-c) \exp(-b(x-e)I(x-e)) +``` + +where $`I(x-e)`$ is an indicator function equal to 0 for $`x \leq e`$ +and 1 for $`x > e`$. + +### Model Parameters + +- **b**: Slope/rate parameter controlling the steepness of the + dose-response curve above the threshold +- **c**: Lower limit (control response) - the response level below the + threshold +- **d**: Upper limit (maximum response) - the asymptotic response at + high doses +- **e**: NEC threshold (no effect concentration) - the dose below which + there is no effect + +## Function Overview + +### Base Implementation: NEC (Not Exported) + +The `NEC` function is the core implementation that provides the flexible +NEC dose-response model. It is **not exported** in the package NAMESPACE +and serves as an internal implementation engine. + +**Key Features:** + +- Accepts a `fixed` argument to specify which parameters should be fixed +- Uses log-logistic self-starter function for initialization +- Returns a model list with nonlinear function, self starter, and + parameter names + +This function is called internally by all the numbered variants (NEC.2, +NEC.3, NEC.4) with specific parameter constraints. + +### NEC.2: Two-Parameter NEC Model + +**Purpose:** Convenience wrapper for highly constrained scenarios where +both lower and upper limits are known. + +**Free Parameters:** 2 + +- `b`: Slope parameter +- `e`: NEC threshold + +**Fixed Parameters:** + +- `c`: Fixed at 0 +- `d`: Fixed at user-specified value (default 1) + +**Use Cases:** + +- Response bounded on a known scale (e.g., 0-1 for proportions, 0-100 + for percentages) +- Both bounds are well-defined from experimental design +- Focus estimation on slope and threshold only +- Reduces model complexity and improves parameter identifiability + +**Example:** + +``` r +# Example with proportion data (bounded 0-1) +# Using ryegrass data, normalizing to 0-1 scale +data(ryegrass) +ryegrass$prop_rootl <- ryegrass$rootl / max(ryegrass$rootl) + +# Fit NEC.2 model with upper limit fixed at 1 +nec2.model <- drm(prop_rootl ~ conc, data = ryegrass, fct = NEC.2()) +summary(nec2.model) +#> +#> Model fitted: NEC with lower limit at 0 and upper limit at 1 (2 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 0.303610 0.035141 8.6397 1.609e-08 *** +#> e:(Intercept) 0.751527 0.156092 4.8146 8.261e-05 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.08003264 (22 degrees of freedom) +``` + +### NEC.3: Three-Parameter NEC Model + +**Purpose:** Most common variant - assumes zero baseline response with +variable maximum. + +**Free Parameters:** 3 + +- `b`: Slope parameter +- `d`: Upper limit +- `e`: NEC threshold + +**Fixed Parameters:** + +- `c`: Fixed at 0 + +**Use Cases:** + +- Standard toxicological/biological scenarios +- Baseline response is zero (no treatment/exposure) +- Maximum response varies by treatment +- Balances flexibility with model stability +- Reduces overfitting compared to NEC.4 + +**Example:** + +``` r +# Fit NEC.3 model - most common case +# Assumes zero baseline response +nec3.model <- drm(rootl ~ conc, data = ryegrass, fct = NEC.3()) +summary(nec3.model) +#> +#> Model fitted: NEC with lower limit at 0 (3 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 2.54094 NaN NaN NaN +#> d:(Intercept) 7.39655 0.23498 31.477 < 2.2e-16 *** +#> e:(Intercept) 3.39679 NaN NaN NaN +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.81401 (21 degrees of freedom) + +# Plot the fitted model +plot(nec3.model, type = "all", log = "", + main = "NEC.3 Model for Ryegrass Root Length", + xlab = "Ferulic acid concentration (mM)", + ylab = "Root length (cm)") +``` + +![NEC.3 model for ryegrass root length showing threshold effect at low +concentrations followed by exponential +decline](nec-models_files/figure-html/nec3-example-1.png) + +### NEC.4: Four-Parameter NEC Model + +**Purpose:** Full flexibility - all parameters estimated from data. + +**Free Parameters:** 4 + +- `b`: Slope parameter +- `c`: Lower limit +- `d`: Upper limit +- `e`: NEC threshold + +**Use Cases:** + +- No biological constraints on parameters +- Both baseline and maximum responses vary +- Model selection and comparison workflows +- Maximum flexibility when data supports it +- Cases where control/baseline response is non-zero and unknown + +**Example:** + +``` r +# Fit NEC.4 model - full flexibility +nec4.model <- drm(rootl ~ conc, data = ryegrass, fct = NEC.4()) +summary(nec4.model) +#> +#> Model fitted: NEC (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 3.16938 393.27265 0.0081 0.993650 +#> c:(Intercept) 0.67201 0.23463 2.8641 0.009592 ** +#> d:(Intercept) 7.39666 0.20260 36.5091 < 2.2e-16 *** +#> e:(Intercept) 3.41729 41.27705 0.0828 0.934842 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.7017905 (20 degrees of freedom) + +# Compare parameter estimates +coef(nec4.model) +#> b:(Intercept) c:(Intercept) d:(Intercept) e:(Intercept) +#> 3.1693834 0.6720099 7.3966630 3.4172914 +``` + +## Comparison of NEC Variants + +The following table summarizes the key differences between the NEC +functions: + +| Aspect | NEC (base) | NEC.2 | NEC.3 | NEC.4 | +|----|----|----|----|----| +| **Exported** | No | Yes | Yes | Yes | +| **Free Parameters** | Configurable | 2 (b, e) | 3 (b, d, e) | 4 (b, c, d, e) | +| **Fixed c (lower)** | Configurable | 0 | 0 | Free | +| **Fixed d (upper)** | Configurable | User-defined | Free | Free | +| **Model Complexity** | Depends | Lowest | Medium | Highest | +| **When to Use** | Internal only | Known bounds | Zero baseline | Full flexibility | +| **Identifiability** | Depends | Excellent | Good | May be challenging | + +## Model Comparison Example + +Let’s compare the three exported NEC variants on the ryegrass dataset: + +``` r +# Fit all three models +nec2.fit <- drm(rootl ~ conc, data = ryegrass, fct = NEC.2(upper = max(ryegrass$rootl))) +nec3.fit <- drm(rootl ~ conc, data = ryegrass, fct = NEC.3()) +nec4.fit <- drm(rootl ~ conc, data = ryegrass, fct = NEC.4()) + +# Compare models using AIC +cat("Model Comparison (AIC values):\n") +#> Model Comparison (AIC values): +cat("NEC.2:", AIC(nec2.fit), "\n") +#> NEC.2: 52.70586 +cat("NEC.3:", AIC(nec3.fit), "\n") +#> NEC.3: 63.02673 +cat("NEC.4:", AIC(nec4.fit), "\n") +#> NEC.4: 56.73556 + +# Plot all three models together +my_plot = function(mod, col = "black", lwd = 2, pch = 16) { + plot(mod, type = "all", + main = mod$fct$name, + col = col, lwd = lwd, pch = pch, + xlab = "Ferulic acid concentration (mM)", + ylab = "Root length (cm)") +} +my_plot(nec2.fit) +``` + +![NEC.2 model fitted to ryegrass data with both asymptotes +constrained](nec-models_files/figure-html/model-comparison-1.png) + +``` r +my_plot(nec3.fit, col = "darkblue", lwd = 2) +``` + +![NEC.3 model fitted to ryegrass data with lower asymptote fixed at +zero](nec-models_files/figure-html/model-comparison-2.png) + +``` r +my_plot(nec4.fit, col = "darkred", lwd = 2) +``` + +![NEC.4 model fitted to ryegrass data with all parameters +estimated](nec-models_files/figure-html/model-comparison-3.png) + +## Design Pattern in the drc Package + +The NEC functions follow the **standard drc package design pattern** +used consistently across all model families: + +### Examples of Similar Patterns: + +1. **Log-logistic models:** `llogistic`, `LL.2`, `LL.3`, `LL.3u`, + `LL.4`, `LL.5` +2. **Weibull type 1:** `weibull1`, `W1.2`, `W1.3`, `W1.3u`, `W1.4` +3. **Weibull type 2:** `weibull2`, `W2.2`, `W2.3`, `W2.3u`, `W2.4` +4. **Gompertz:** `gompertz`, `G.2`, `G.3`, `G.3u`, `G.4` +5. **Log-normal:** `lnormal`, `LN.2`, `LN.3`, `LN.3u`, `LN.4` + +### Pattern Structure: + +1. **Base function** (e.g., `llogistic`, `NEC`) + - Provides core implementation with full parameter flexibility + - Often not exported (used internally) + - Accepts `fixed` argument for parameter constraints +2. **Numbered variants** (e.g., `LL.2`, `LL.3`, `LL.4`, `LL.5`) + - Convenience wrappers with common parameter combinations + - Exported for user convenience + - Number indicates count of free parameters + - Each serves specific biological/experimental scenarios + +### Benefits of This Design: + +- **User convenience**: Common cases are easy to specify +- **Parameter identifiability**: Constraining parameters when + appropriate improves estimation +- **Model selection**: Easy to compare nested models +- **Biological meaning**: Parameter constraints reflect experimental + knowledge +- **Backwards compatibility**: Adding variants doesn’t break existing + code +- **Documentation clarity**: Each variant can have specific use-case + documentation + +## Choosing the Right NEC Variant + +Here’s a decision guide to help you choose the appropriate NEC function: + +1. **Do you know both the lower and upper response limits?** + - Yes → Use **NEC.2** + - No → Go to step 2 +2. **Is your baseline (control) response zero or can it be assumed to + be zero?** + - Yes → Use **NEC.3** (most common case) + - No → Go to step 3 +3. **Do you need to estimate all parameters from the data?** + - Yes → Use **NEC.4** + - Unsure → Start with **NEC.3** and compare with **NEC.4** using + model selection criteria (AIC, BIC) + +### Example Decision Process: + +``` r +# Toxicology study with percentage mortality (0-100%) +# Known bounds: lower = 0%, upper = 100% +# → Use NEC.2 +mortality.model <- drm(mortality ~ dose, data = mydata, fct = NEC.2(upper = 100)) + +# Plant growth study measuring root length +# Control (no treatment) shows some growth (not zero) +# → Try both NEC.3 and NEC.4, compare with AIC +model3 <- drm(rootlength ~ concentration, data = mydata, fct = NEC.3()) +model4 <- drm(rootlength ~ concentration, data = mydata, fct = NEC.4()) +mselect(model3, model4) + +# Standard dose-response with zero baseline +# Maximum response unknown +# → Use NEC.3 +response.model <- drm(response ~ dose, data = mydata, fct = NEC.3()) +``` + +## Redundancy Assessment + +### Are any NEC functions redundant? + +**Answer: NO - All functions are necessary.** + +### Reasoning: + +1. **NEC (base function)** + - Cannot be removed: Contains the actual mathematical implementation + - All other functions are wrappers that call `NEC` with specific + constraints + - Removing it would break NEC.2, NEC.3, and NEC.4 +2. **NEC.2** + - Unique purpose: Only variant with both upper and lower limits + fixed + - Distinct use case: Bounded response scales (proportions, + percentages) + - Cannot be replicated: NEC.3 fixes only lower limit, NEC.4 fixes + nothing + - Statistical benefit: Reduces parameters from 4 to 2, greatly + improving identifiability +3. **NEC.3** + - Most common scenario: Standard toxicology with zero baseline + - Optimal balance: More flexible than NEC.2, more stable than NEC.4 + - Common convention: Matches typical experimental designs where + control = 0 + - Unique constraint: Only variant fixing lower limit while freeing + upper limit +4. **NEC.4** + - Essential for flexibility: Only way to estimate all 4 parameters + - Model selection: Needed for comparing against constrained models + - Non-zero baselines: Only option when control response is unknown + and non-zero + - Diagnostic tool: Helps determine if constraints are appropriate + +### User Experience Comparison: + +If functions were combined, users would need to manually specify +constraints: + +``` r +# Current approach (user-friendly): +drm(y ~ x, data = mydata, fct = NEC.3()) + +# If combined (cumbersome and error-prone): +drm(y ~ x, data = mydata, fct = NEC(fixed = c(NA, 0, NA, NA))) +``` + +The current design: - Reduces usability barriers - Prevents errors from +wrong constraint specifications - Provides helpful documentation for +common cases - Maintains backwards compatibility - Follows established +drc package conventions + +## Practical Tips + +### 1. Starting with Model Selection + +When unsure which variant to use, start with NEC.3 (most common) and +compare with other variants: + +``` r +# Fit an initial model, then compare with alternative NEC variants +m3 <- drm(response ~ dose, data = mydata, fct = NEC.3()) + +# Compare using model selection (mselect takes one fitted model + a list of alternatives) +mselect(m3, fctList = list(NEC.2(), NEC.4())) +``` + +### 2. Checking Parameter Identifiability + +If your NEC.4 model shows very large standard errors or fails to +converge, consider constraining parameters: + +``` r +# If NEC.4 has convergence issues, try NEC.3 +summary(nec4.model) # Check standard errors +# If c is close to 0 with large SE, use NEC.3 +nec3.model <- drm(response ~ dose, data = mydata, fct = NEC.3()) +``` + +### 3. Interpreting the Threshold Parameter + +The `e` parameter represents the NEC threshold - the concentration below +which there is no effect: + +``` r +# Extract the threshold estimate +threshold <- coef(nec3.model)["e:(Intercept)"] +cat("Estimated NEC threshold:", threshold, "\n") + +# Get confidence interval for the threshold +confint(nec3.model) +``` + +## Conclusion + +All 4 NEC functions serve distinct and necessary purposes in the drc +package: + +- **NEC**: Internal implementation engine +- **NEC.2**: Highly constrained models with known bounds (2 parameters) +- **NEC.3**: Standard case with zero baseline (3 parameters) - **most + commonly used** +- **NEC.4**: Full flexibility for complex scenarios (4 parameters) + +The design represents: + +1. **Sound software architecture**: Internal implementation separated + from user interface +2. **Statistical best practice**: Providing appropriate model + complexity for different scenarios +3. **User experience optimization**: Common cases are simple, complex + cases are possible +4. **Package consistency**: Matches the established pattern used for + all other model families + +## References + +Pires, A. M., Branco, J. A., Picado, A., Mendonca, E. (2002) Models for +the estimation of a ‘no effect concentration’, *Environmetrics*, **13**, +15-27. + +## See Also + +- [`?NEC`](https://hreinwald.github.io/drc/reference/NEC.md) - Base NEC + function documentation +- [`?NEC.2`](https://hreinwald.github.io/drc/reference/NEC.2.md) - + Two-parameter NEC model +- [`?NEC.3`](https://hreinwald.github.io/drc/reference/NEC.3.md) - + Three-parameter NEC model +- [`?NEC.4`](https://hreinwald.github.io/drc/reference/NEC.4.md) - + Four-parameter NEC model +- [`?drm`](https://hreinwald.github.io/drc/reference/drm.md) - Main + function for fitting dose-response models +- [`?mselect`](https://hreinwald.github.io/drc/reference/mselect.md) - + Model selection function diff --git a/docs/articles/nec-models_files/figure-html/model-comparison-1.png b/docs/articles/nec-models_files/figure-html/model-comparison-1.png new file mode 100644 index 00000000..2cba3149 Binary files /dev/null and b/docs/articles/nec-models_files/figure-html/model-comparison-1.png differ diff --git a/docs/articles/nec-models_files/figure-html/model-comparison-2.png b/docs/articles/nec-models_files/figure-html/model-comparison-2.png new file mode 100644 index 00000000..358b42f9 Binary files /dev/null and b/docs/articles/nec-models_files/figure-html/model-comparison-2.png differ diff --git a/docs/articles/nec-models_files/figure-html/model-comparison-3.png b/docs/articles/nec-models_files/figure-html/model-comparison-3.png new file mode 100644 index 00000000..98fc8444 Binary files /dev/null and b/docs/articles/nec-models_files/figure-html/model-comparison-3.png differ diff --git a/docs/articles/nec-models_files/figure-html/nec3-example-1.png b/docs/articles/nec-models_files/figure-html/nec3-example-1.png new file mode 100644 index 00000000..b7855ca3 Binary files /dev/null and b/docs/articles/nec-models_files/figure-html/nec3-example-1.png differ diff --git a/docs/articles/package-version-comparative-analysis.html b/docs/articles/package-version-comparative-analysis.html new file mode 100644 index 00000000..ebe5adda --- /dev/null +++ b/docs/articles/package-version-comparative-analysis.html @@ -0,0 +1,1170 @@ + + + + + + + +Comparative Analysis: hreinwald/drc vs DoseResponse/drc • drc + + + + + + + + + + + + + Skip to contents + + +
+ + + + +
+
+

Comparative Analysis: hreinwald/drc vs DoseResponse/drc

+

Hannes +Reinwald

+ +

2026-04-24

+ + Source: vignettes/package-version-comparative-analysis.Rmd +
package-version-comparative-analysis.Rmd
+
+ + + +
+

For: “Reviving drc: A corrected and modernized R package for +dose-response analysis” +

+
+
+
+

Executive Summary +

+

The drc R package (Ritz et al., 2015, PLOS ONE) +is among the most widely deployed tools for dose-response analysis in +bioassay, toxicology, pharmacology, and ecotoxicology. The version +maintained at DoseResponse/drc (v3.2-0, last updated +January 2021) harbors multiple correctness bugs of varying severity that +silently corrupt downstream results. The fork at +hreinwald/drc (dev branch, v3.3.2) addresses +these systematically. The most critical bug discovered is a missing +lower-asymptote term (c parameter) in the U-shaped +Cedergreen-Ritz-Streibig hormesis models (UCRS.*), +rendering every result computed with those functions incorrect. +Secondary bugs include incorrect gradient vectors for absolute-type +effective dose (ED) standard errors across at least seven model +families, a wrong derivative in gammadr(), and a +function-level edfct signature mismatch in the logistic model +family.

+

Beyond bug correction, hreinwald/drc delivers a +substantially refactored codebase: dead code removed from 70+ source +files, file naming standardized, a comprehensive test suite of 79 +testthat files added (versus 3 ad-hoc test scripts in the +original), and full pkgdown documentation deployed at https://hreinwald.github.io/drc/. CI/CD is integrated +through three GitHub Actions workflows (R-CMD-check, code coverage, +pkgdown deployment). The fork source lacks equivalent infrastructure: it +has only a deprecated Travis CI configuration, no +CITATION.cff, and a seven-line README.

+

Taken together, the evidence supports the framing of this as not a +mere maintenance release but a substantive correction to the scientific +record. Users who computed ED confidence intervals using +type="absolute" with Weibull, log-logistic, log-normal, +logistic, Brain-Cousens, or fplogistic models—or who fitted any UCRS +hormesis model—may have published incorrect standard errors or incorrect +fitted values.

+
+
+
+

1. Critical Bugs Identified +

+
+

1.1 Missing Lower Asymptote (c) in U-shaped CRS Model — +SEVERITY: CRITICAL +

+

Affected model/function: ucedergreen() +and all convenience wrappers UCRS.4a, UCRS.4b, +UCRS.4c, UCRS.5a, UCRS.5b, +UCRS.5c

+

File: R/ucedergreen.R

+

Original (incorrect) code +(DoseResponse/drc, R/ucedergreen.R, line +~32):

+
+fct <- function(dose, parm)
+{
+    parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE)
+    parmMat[, notFixed] <- parm
+
+    numTerm <- parmMat[, 3] - parmMat[, 2] + parmMat[, 5]*exp(-1/dose^alpha)
+    denTerm <- 1 + exp(parmMat[, 1]*(log(dose) - log(parmMat[, 4])))
+    parmMat[, 3] - numTerm/denTerm   # WRONG: missing parmMat[, 2] (c parameter)
+}
+

Fixed code (hreinwald/drc, +R/ucedergreen.R, line ~56):

+
+fct <- function(dose, parm)
+{
+    parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE)
+    parmMat[, notFixed] <- parm
+
+    numTerm <- parmMat[, 3] - parmMat[, 2] + parmMat[, 5]*exp(-1/dose^alpha)
+    denTerm <- 1 + exp(parmMat[, 1]*(log(dose) - log(parmMat[, 4])))
+    parmMat[, 2] + parmMat[, 3] - numTerm/denTerm   # CORRECT: c + d - numTerm/denTerm
+}
+

Scientific impact: The published model formula +(Cedergreen, Ritz & Streibig, 2005, Environ. Toxicol. Chem. +24:3166) is:

+

f(x)=c+d−d−c+fe−1/xα1+exp(b(logx−loge))f(x) = c + d - \frac{d - c + f\,e^{-1/x^\alpha}}{1 + \exp(b(\log x - \log e))}

+

The original implementation returns d - numTerm/denTerm, +i.e., the fitted response is shifted upward by c (the lower +horizontal asymptote) for all dose values. When c = 0 (the +most common case for UCRS.4x models), the result is numerically +coincidentally correct; however, when c is estimated +(UCRS.5x) or is supplied as a non-zero fixed value, every fitted value +is wrong by exactly c. Any paper that used +UCRS.5a, UCRS.5b, or UCRS.5c with +estimated c ≠ 0 and reported dose-response parameters, EC +values, or hormesis estimates has incorrect results that propagate to +all downstream comparisons.

+

Additionally, the deriv1 (gradient with respect to the +c parameter) in the original code is 1/t3 +(positive), whereas the corrected formula’s partial derivative is +1 + 1/t3. This means even if fitted values were not +perceptibly shifted (because c ≈ 0), standard errors for +the c-parameter estimate were systematically wrong.

+
+
+
+

1.2 Wrong Multiplier in gammadr() Gradient — SEVERITY: +HIGH +

+

Affected model/function: gammadr() — +Gamma dose-response model

+

File: R/gammadr.r (DoseResponse) vs +R/gammadr.R (hreinwald)

+

Original (incorrect) code +(DoseResponse/drc, R/gammadr.r, inside +deriv1):

+
+cbind(
+    t1 * dgamma(parmMat[, 1] * dose, parmMat[, 4], 1) * parmMat[, 1],  # WRONG: uses b not dose
+    1 - t2,
+    t2,
+    t1 * logGamma(parmMat[, 1] * dose, parmMat[, 4])
+)[, notFixed]
+

Fixed code (hreinwald/drc, +R/gammadr.R, inside deriv1):

+
+cbind(
+    t1 * dgamma(parmMat[, 1] * dose, parmMat[, 4], 1) * dose,  # CORRECT: uses dose
+    1 - t2,
+    t2,
+    t1 * logGamma(parmMat[, 1] * dose, parmMat[, 4])
+)[, notFixed]
+

Scientific impact: The derivative of +f(x) = c + (d-c) · pgamma(b·x, e, 1) with respect to +b is (d-c) · dgamma(b·x, e, 1) · x. The +original uses b instead of x in this product, +yielding a gradient vector that scales incorrectly with the dose. This +corrupts the delta-method standard errors for the b +parameter and propagates to standard errors for any derived quantities +(ED values, predicted values with CIs) computed from models fit with +gammadr().

+
+
+
+

1.3 Zero Gradients for Absolute-Type ED Standard Errors (7 Model +Families) — SEVERITY: HIGH +

+

Affected models/functions: +braincousens(), fplogistic(), +llogistic(), llogistic2(), +lnormal(), weibull1(), +weibull2()

+

Files: Respective R/*.R files in both +repositories

+

Root cause (shared pattern, shown for +weibull1()):

+

Original code (DoseResponse/drc, +R/weibull1.r, edfct):

+
+edfct <- function(parm, respl, reference, type, ...)
+{
+    parmVec[notFixed] <- parm
+    p <- EDhelper(parmVec, respl, reference, type)
+
+    tempVal <- log(-log((100-p)/100))
+    EDp <- exp(tempVal/parmVec[1] + log(parmVec[4]))
+
+    EDder <- EDp*c(-tempVal/(parmVec[1]^2), 0, 0, 1/parmVec[4])
+    # ^^^ derivatives for c and d are always 0 — correct only for relative type
+    return(list(EDp, EDder[notFixed]))
+}
+

Fixed code (hreinwald/drc, R/weibull1.R, +edfct):

+
+edfct <- function(parm, respl, reference, type, ...)
+{
+    parmVec[notFixed] <- parm
+    p <- EDhelper(parmVec, respl, reference, type)
+
+    tempVal <- log(-log((100-p)/100))
+    EDp <- exp(tempVal/parmVec[1] + log(parmVec[4]))
+    EDder <- EDp*c(-tempVal/(parmVec[1]^2), 0, 0, 1/parmVec[4])
+
+    ## Fix: correct c and d derivatives for absolute type using central differences.
+    if (identical(type, "absolute")) {
+        .edval <- function(pv) { ... }  # full chain-rule evaluation
+        for (.i in c(2, 3)) {
+            .h <- ...
+            EDder[.i] <- (.edval(.pvUp) - .edval(.pvDn)) / (2 * .h)
+        }
+    }
+    return(list(EDp, EDder[notFixed]))
+}
+

Scientific impact: When users call +ED(model, respLev, type="absolute", interval="delta"), the +delta-method standard errors reported for the ED values are incorrect +because ∂ED/∂c and ∂ED/∂d are set to zero. The absolute-to-relative +conversion (absToRel/EDhelper) makes +p a function of both c and d; the +chain rule therefore requires non-zero partial derivatives. The +magnitude of the error depends on the spread of the response: for data +with large ranges between c and d, the +absolute type conversion creates large sensitivity to asymptote +estimates, and zeroing those terms can substantially underestimate the +true confidence interval width. Any published confidence intervals for +absolute ED values from the original package are potentially too +narrow.

+
+
+
+

1.4 logistic() edfct Signature Mismatch +and Wrong p-swap — SEVERITY: HIGH +

+

Affected model/function: logistic() and +all convenience wrappers L.3, L.4, +L.5

+

File: R/logistic.r (DoseResponse) vs +R/logistic.R (hreinwald)

+

Original (incorrect) code +(DoseResponse/drc, R/logistic.r, +edfct):

+
+edfct <- function(parm, p, ...)
+{
+    parmVec[notFixed] <- parm
+    # ... (no reference or type handling)
+    # ... always uses p directly, no type="absolute" support
+    return(list(EDp, EDder[notFixed]))
+}
+

Fixed code (hreinwald/drc, +R/logistic.R, edfct):

+
+edfct <- function(parm, respl, reference = "control", type = "relative", ...)
+{
+    parmVec[notFixed] <- parm
+    if (identical(type, "absolute")) {
+        p <- 100 * ((parmVec[3] - respl) / (parmVec[3] - parmVec[2]))
+    } else {
+        p <- respl
+    }
+    ## NOTE: unlike log-logistic models, logistic model has b < 0 = increasing,
+    ## so EDhelper's p-swap for b < 0 would be incorrect here.
+    ...
+}
+

Scientific impact: The logistic model +(L.3, L.4, L.5) uses raw dose +values (not log(dose)), so the sign convention of +b is reversed compared to log-logistic models. The original +code ignores type and reference arguments, +meaning ED(model, type="absolute") would silently return +wrong values (no error is thrown; the wrong formula runs). Furthermore, +the original code would delegate to EDhelper which applies +an incorrect p-swap for this model family, yielding ED values computed +at the complementary percentile (e.g., computing ED10 instead of +ED90).

+
+
+
+

1.5 ucedergreen() — Additional Bugs (17 Total) — +SEVERITY: CRITICAL/HIGH/MEDIUM +

+

The ucedergreen() function in DoseResponse/drc contained +17 separate bugs documented in the hreinwald NEWS.md for v3.3.0.02. A +summary of the most impactful:

+ +++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Sub-BugLocationSeverity
Missing +c in fct (see §1.1)fct()CRITICAL
+edfct signature mismatch (p vs +respl, missing +reference/type)edfct()HIGH
+deriv1: wrong sign/formula for c-column +(1/t3 vs 1 + 1/t3)deriv1()HIGH
Undefined xlogx call in deriv1 (uses unset +closure)deriv1()HIGH
Missing match.arg() for method +top-levelMEDIUM
Vectorized \| in scalar if() guardstop-levelMEDIUM
Missing useFixed flag computationself-starterMEDIUM
+maxfct signature mismatchmaxfct()MEDIUM
Broken self-starter ignoring +alpha/method/useFixed +ssfct()MEDIUM
Missing fctName/fctText parametersreturn listLOW
+deriv1 excluded from return listreturn listHIGH
+

The absence of deriv1 in the return list means that all +Newton-type optimizers relying on gradient information would fail +silently or fall back to finite differences, producing degraded +convergence.

+
+
+
+

1.6 mselect() Parse Error — SEVERITY: +MEDIUM +

+

File: R/mselect.r / +R/mselect.R

+

Bug: Two missing closing braces in +mselect(). This caused a parse error when the function was +sourced directly from the file (though it would load correctly via the +compiled package). Any user attempting to modify or source-load the +function would encounter a confusing parse failure.

+
+
+
+

1.7 ED.lin.R Incorrect Delta Method for Quadratic +Models — SEVERITY: MEDIUM +

+

File: R/ED.lin.R

+

Bugs fixed in hreinwald: - Duplicate +if-block (dead code evaluating the same condition twice) - +Stray debug print() statement (emits output during +analysis) - Missing parameterNames = c("b0", "b1", "b2") +argument in deltaMethod() call for quadratic models — +causing incorrect parameter mapping and therefore wrong confidence +intervals for ED values from quadratic linear models.

+
+
+
+

1.8 drmOpt() Inverted Trace/Silent Logic — SEVERITY: +MEDIUM +

+

File: R/drmOpt.R

+

Bug: The otrace/silentVal +logic was inverted: otrace=TRUE (intending verbose output) +incorrectly caused silent=TRUE in +try(optim()), suppressing error messages rather than +displaying them. This would cause optimization failures to be silently +ignored during debugging sessions.

+
+
+
+
+

2. Justification for Refactoring +

+

The codebase at DoseResponse/drc has been effectively +unmaintained since January 2021 (version 3.2-0). During this time, +multiple bugs have accumulated that undermine the scientific validity of +results produced by the package. The justification for refactoring rests +on five concrete lines of evidence:

+

1. Mathematical incorrectness in production models. +The missing c parameter in ucedergreen() +(§1.1), the wrong multiplier in gammadr() (§1.2), and the +zero-gradient errors in seven model families (§1.3) constitute +mathematical errors that silently corrupt numerical results. These are +not software bugs in the traditional sense (crashes, type errors) — they +pass silently and deliver plausible-looking but wrong numbers.

+

2. API mismatch with the framework’s own calling +conventions. The edfct function is called by +ED.drc with the signature +(parm, respl, reference, type, ...). The logistic model’s +edfct only accepted (parm, p, ...), silently +dropping reference and type. Similarly, +ucedergreen()’s edfct dropped +reference and type. This is not a +documentation problem; it is an undetected interface violation that +causes incorrect behavior whenever users deviate from default +parameters.

+

3. Dead code and commented-out experiments in production +files. Across 70+ source files, if(FALSE){...} +blocks (sometimes hundreds of lines), stray print() debug +statements, and large sections of commented-out alternative +implementations existed in the production codebase. This constitutes +significant technical debt that impedes maintenance, review, and the +ability to reason about what code paths are active.

+

4. Non-standard file naming. Many R source files +used lowercase extensions (.r instead of .R): +backfit.r, baro5.r, comped.r, +drmc.r, fct2list.r, gammadr.r, +gompertz.r, hewlett.r, iband.r, +idrm.r, isobole.r, lnormal.r, +logistic.r, max.r, mixture.r, +mrdrm.r, mselect.r, multi2.r, +nec.r, pr.r, rdrm.r, +relpot.r, sandwich.r, twophase.r, +ursa.r, voelund.r, weibull1.r, +weibull2.r, xlogx.r. On case-sensitive file +systems (Linux, most CI environments), this can cause load failures.

+

5. Complete absence of automated testing. +DoseResponse/drc contains 3 ad-hoc test scripts +(test1.r, test2.r, test3.r) plus +one seed-germination script — no testthat framework, no +assertions, no coverage tracking. hreinwald/drc introduces +79 testthat test files covering all major model families, +utility functions, and edge cases.

+
+
+
+

3. Documentation Improvements +

+
+

3.1 README +

+ +++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
AspectDoseResponse/drchreinwald/drc
File +README.md (7 lines) +README.md (~250 lines)
Status badgesCRAN, Travis CI (deprecated), DownloadsGitHub version, R-CMD-check, Codecov, lifecycle, CRAN, Downloads, +License, Last-commit, Contributions
Package description1 sentenceFull description with 7-item feature list
Installation instructions3 lines (devtools only)Multi-section: recommended GitHub install, tar.gz local install, +CRAN (explicitly discouraged)
Quick StartNone3 worked examples with drm(), ED(), +EDcomp(), mselect() +
Model tableNoneComplete table of all model families with descriptions
Key functions tableNoneComplete table of core functions with descriptions
Data typesNoneComplete table of type= options
DependenciesNoneFull list
LogoNoneCustom logo in man/figures/logo.png +
+
+
+

3.2 Roxygen2 Documentation Quality +

+

DoseResponse/drc uses Roxygen2 version 6.1.1 (declared +in DESCRIPTION). Most model files have minimal or no +@param, @return, @examples, or +@details tags — functions are defined with no Roxygen +headers at all.

+

hreinwald/drc uses Roxygen2 7.3.3 with markdown support +(Roxygen: list(markdown = TRUE)). Every exported function +has:

+
    +
  • +@title and @description +
    • +
  • +@param for each argument with type and purpose
    • +
  • +@return describing the return structure
    • +
  • +@details with the mathematical formula in LaTeX
    • +
  • +@examples with working, runnable code
    • +
  • +@seealso cross-references
    • +
  • +@references with full bibliographic citations
    • +
  • +@author attributions
    • +
  • @keywords
    • +
+

Example of improvement — weibull1() documentation +added:

+
    +
  • 4-item describe block explaining each of the 4 self-starter +methods
    • +
  • LaTeX formula for the Weibull type 1 model
    • +
  • Complete @param for each of 7 arguments
    • +
  • 3 working examples across W1.2, W1.3, +W1.4, EXD.2, EXD.3 +
    • +
+
+
+

3.3 GitHub Pages Documentation +

+ +++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
AspectDoseResponse/drchreinwald/drc
pkgdown sitePresent (minimal, no GitHub Pages deployment)Full site deployed at https://hreinwald.github.io/drc/ +
Reference indexBasic auto-generatedOrganized by category in _pkgdown.yml (3,265 bytes vs +1,863 bytes)
VignettesNone2 vignettes: dose-response-workflow.Rmd (28KB), +nec-models.Rmd (14KB)
Favicon/brandingNoneCustom favicon and logo
AccessibilityNoneAlt-text on all images
+
+
+

3.4 Vignettes +

+

hreinwald/drc introduces two new vignettes absent from +DoseResponse/drc:

+
    +

  1. dose-response-workflow.Rmd (28,149 +bytes): A complete end-to-end workflow demonstrating data loading, model +fitting, ED estimation, multi-curve comparison, model selection with +mselect(), and result visualization. References the +corrected ED output format.

    2. +

  2. nec-models.Rmd (14,499 bytes): +Dedicated documentation of No-Effect Concentration (NEC) models with +scientific context, fitting examples, and interpretation +guidance.

    3. +
+
+
+

3.5 CITATION.cff +

+

DoseResponse/drc has a plain-text +inst/citation file (517 bytes) with no structured +metadata.

+

hreinwald/drc has a proper CITATION.cff +(1,523 bytes) with CFF version 1.2.0, author ORCID identifiers for all +four original authors, version, DOI, release date, and two structured +references entries (PLoS ONE 2015 article and CRC Press +2019 book).

+
+
+
+
+

4. New Features & Improvements +

+
+

4.1 New Functions +

+ +++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
FunctionFileDescription
rss()R/rss.RResidual sum of squares for fitted drc objects; +Rsq() now reuses rss() internally
+ED_robust() (internal)R/ED_robust.RRobust ED estimation using rlang (replaces deprecated +lazyeval)
absToRel()R/absToRel.RExported utility: absolute-to-relative response level +conversion
commatFct()R/commatFct.RInternal helper for formatting comma-separated parameter texts
drm_legacy()R/drm_legacy.RLegacy-compatible drm() interface for backward +compatibility
+simFct() / simDR() + +R/simFct.R / R/simDR.R +Simulation functions for dose-response data generation
onAttach()R/onAttach.RPackage attachment message with version info and repository URL
+
+
+

4.2 New Model Variants +

+
    +
  • All UCRS models (UCRS.4a/4b/4c, +UCRS.5a/5b/5c) were completely rewritten — while they +existed in DoseResponse/drc, they were functionally broken (see §1.1, +§1.5) and are effectively new working implementations.
    • +
  • +CRS.4a, CRS.4b, CRS.4c +display text fixes (e.g., CRS.4b now correctly shows +“alpha=0.5” instead of “alpha=”).
    • +
+
+
+

4.3 Enhancements to Existing Functions +

+
    +
  • +ED() / ED.drc(): Multiple +robustness improvements — correct matrix handling when +indexMat is a vector (single-parameter models), NaN/Inf +handling in LL.5, dynamic curve loop with post-hoc clevel +filtering, drop=FALSE for covariance matrix slices, unnamed +gradient vectors.
    • +
  • +maED(): Excludes models with +non-finite ED estimates or fitting errors from model-averaged estimate; +returns NA instead of NaN when all candidates +fail.
    • +
  • +predict.drc(): Fixed “incorrect number +of dimensions” for models with many fixed parameters.
    • +
  • +plot.drc(): New +errbar.col parameter to control error bar colors; default +now matches curve colors.
    • +
  • +anova.drc(): Corrected documentation +to accurately reflect actual behavior; improved error handling.
    • +
  • +mselect(): Fixed parse error from +missing closing braces.
    • +
  • +noEffect(): Added warning when degrees +of freedom difference ≤ 0.
    • +
  • +searchdrc(): Fixed regex error and +convergence failure behavior.
    • +
  • +drmOpt(): Fixed inverted +otrace/silentVal logic.
    • +
+
+
+

4.4 Dependency Updates +

+ +++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
AspectDoseResponse/drchreinwald/drc
R minimum version≥ 2.0.0≥ 4.0.0
lazyevalUsedReplaced with rlang +
+drcData (separate package)RequiredRemoved (data bundled or sourced differently)
+data.table, dplyr +Not presentAdded to Imports
lifecycleNot presentAdded to Imports (for deprecation warnings)
testthatNot present in SuggestsAdded (≥ 3.0.0)
+knitr, rmarkdown +Not presentAdded for vignettes
+
+
+

4.5 Test Coverage +

+ +++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
AspectDoseResponse/drchreinwald/drc
Test frameworkAd-hoc R scripts +testthat v3
Number of test files3 scripts + 1 data file79 test files
Models with dedicated tests0All major model families (llogistic, weibull1/2, logistic, gompertz, +lnormal, braincousens, cedergreen, ucedergreen, NEC, gammadr, baro5, +etc.)
Utility function tests0ED, ED.lin, EDcomp, maED, mselect, anova, modelFit, predict, +CIcompX, rss, and many more
Code coverage trackingNoneCodecov integration via GitHub Actions
+
+
+
+
+

5. Version Control & Project Hygiene +

+ +++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
AspectDoseResponse/drchreinwald/drc
Current version3.2-03.3.2
Last substantive updateJanuary 2021May 2026
Commit qualitySparse, terse messagesStructured commits with clear descriptions referencing issues
Active branchesOnly master + +dev (primary), main_beta (stable beta), +multiple feature branches
CI/CD +.travis.yml (Travis CI — deprecated/inactive)3 GitHub Actions workflows: R-CMD-check.yaml, +test-coverage.yaml, static.yml (pkgdown)
CITATION.cffAbsentPresent (CFF 1.2.0, ORCIDs, DOI, two references)
NEWS.md +news (plain text, no markdown) +NEWS.md (properly formatted, categorized, 36KB)
Issue trackerNot actively usedUsed with references in commit messages
pkgdown deploymentNot deployedAuto-deployed via static.yml to GitHub Pages
LicenseGPL-2GPL-2 (correctly inherited)
MaintainerChristian Ritz (inactive)Hannes Reinwald (cre role)
Authors in DESCRIPTIONRitz + StreibigRitz + Streibig + Reinwald (as aut, +cre)
Roxygen version6.1.17.3.3
File naming conventionMixed .r/.R +Standardized .R throughout
+
+
+
+

6. Publication Readiness Summary +

+
+

Items That Strengthen the Submission Now: +

+
    +
  • +Bug evidence is documented and reproducible. The +NEWS.md provides a detailed bug report for each fix. The 79 +testthat tests provide regression guards.
    • +
  • +The ucedergreen() bug is a compelling +primary justification: it is unambiguous, affects a named published +model family, and affects all previous users.
    • +
  • +Breadth of fixes across 7 model families for the +absolute-type ED gradient bug provides evidence of systematic, not +incidental, review.
    • +
+
+
+ +
    +

  1. Benchmark study: Quantify the numerical +difference between old and new results on synthetic or real datasets +(e.g., table showing correct vs. incorrect ED confidence intervals under +type="absolute" for W1.4, LN.4, LL.4 — critical for +reviewers to assess impact magnitude).

    2. +

  2. Version stability: The dev branch +is still the primary development branch. A stable tagged release on +main (or main_beta promoted) would be expected +by most journal submission processes.

    3. +

  3. CRAN submission: The README explicitly +discourages the CRAN version. A corrected CRAN submission would +maximally reach the user community and is required for R Journal papers +referencing a package.

    4. +

  4. Vignette for the corrected bugs: A dedicated +vignette showing before/after comparisons (old vs. new results) for the +most critical bugs would directly serve the paper’s narrative.

    5. +

  5. Acknowledgment of original authors: The paper +should prominently acknowledge Ritz, Baty, Streibig & Gerhard as +originators. The framing as “corrected and modernized” is already +appropriately respectful.

    6. +

  6. Test coverage metric: The README references a +Codecov badge. A coverage percentage of ≥ 70% on key model functions +would be a strong claim for a methods paper.

    7. +
+
+
+
+
+

7. Suggested Abstract Draft +

+
+

The drc R package (Ritz et al., 2015) provides +a widely-used framework for parametric dose-response modeling in +bioassay, toxicology, and ecotoxicology. Since its last CRAN release +(v3.2-0, January 2021), the package has received no substantive +maintenance despite continued use in the scientific literature. We +present drc v3.3.2, a corrected and modernized version of +the package, addressing a series of bugs ranging in severity from +silently incorrect fitted values to systematically underestimated +confidence intervals. The most critical error, discovered in the +U-shaped Cedergreen-Ritz-Streibig hormesis model family +(UCRS.*), omits the lower horizontal asymptote parameter +from the model function, rendering every fitted value incorrect whenever +the lower asymptote differs from zero. Additionally, the gradient +functions used in delta-method standard error calculations for +absolute-type effective dose (ED) estimates were incorrect in seven +model families (Weibull type 1 and 2, log-logistic, log-normal, +logistic, Brain-Cousens, and fractional polynomial logistic), +consistently setting chain-rule contributions to zero and producing +confidence intervals that are potentially too narrow. A further gradient +error in the Gamma model inverted the rate-parameter derivative. These +bugs affect published results obtained using the original package. +Beyond correctness, the refactored package introduces 79 +testthat unit tests (versus zero in the original), +comprehensive Roxygen2 documentation with mathematical formulae and +worked examples, a pkgdown documentation website, three GitHub Actions +CI/CD workflows, and a CITATION.cff metadata file. The +package is available from https://github.com/hreinwald/drc and is fully backward +compatible with the existing drm() interface.

+
+
+
+
+

Source Repositories +

+ +
+
+
+ + + +
+

Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

+
+ +
+

Site built with pkgdown 2.2.0.

+
+ +
+
+ + + + + + + diff --git a/docs/articles/package-version-comparative-analysis.md b/docs/articles/package-version-comparative-analysis.md new file mode 100644 index 00000000..d510deac --- /dev/null +++ b/docs/articles/package-version-comparative-analysis.md @@ -0,0 +1,662 @@ +# Comparative Analysis: hreinwald/drc vs DoseResponse/drc + +## For: *“Reviving drc: A corrected and modernized R package for dose-response analysis”* + +------------------------------------------------------------------------ + +## Executive Summary + +The `drc` R package (Ritz et al., 2015, *PLOS ONE*) is among the most +widely deployed tools for dose-response analysis in bioassay, +toxicology, pharmacology, and ecotoxicology. The version maintained at +`DoseResponse/drc` (v3.2-0, last updated January 2021) harbors multiple +correctness bugs of varying severity that silently corrupt downstream +results. The fork at `hreinwald/drc` (`dev` branch, v3.3.2) addresses +these systematically. The most critical bug discovered is a missing +lower-asymptote term (`c` parameter) in the U-shaped +Cedergreen-Ritz-Streibig hormesis models (`UCRS.*`), rendering every +result computed with those functions incorrect. Secondary bugs include +incorrect gradient vectors for absolute-type effective dose (ED) +standard errors across at least seven model families, a wrong derivative +in [`gammadr()`](https://hreinwald.github.io/drc/reference/gammadr.md), +and a function-level edfct signature mismatch in the logistic model +family. + +Beyond bug correction, `hreinwald/drc` delivers a substantially +refactored codebase: dead code removed from 70+ source files, file +naming standardized, a comprehensive test suite of 79 `testthat` files +added (versus 3 ad-hoc test scripts in the original), and full `pkgdown` +documentation deployed at . CI/CD is +integrated through three GitHub Actions workflows (R-CMD-check, code +coverage, pkgdown deployment). The fork source lacks equivalent +infrastructure: it has only a deprecated Travis CI configuration, no +`CITATION.cff`, and a seven-line README. + +Taken together, the evidence supports the framing of this as not a mere +maintenance release but a substantive correction to the scientific +record. Users who computed ED confidence intervals using +`type="absolute"` with Weibull, log-logistic, log-normal, logistic, +Brain-Cousens, or fplogistic models—or who fitted any UCRS hormesis +model—may have published incorrect standard errors or incorrect fitted +values. + +------------------------------------------------------------------------ + +## 1. Critical Bugs Identified + +### 1.1 Missing Lower Asymptote (`c`) in U-shaped CRS Model — SEVERITY: **CRITICAL** + +**Affected model/function:** +[`ucedergreen()`](https://hreinwald.github.io/drc/reference/ucedergreen.md) +and all convenience wrappers `UCRS.4a`, `UCRS.4b`, `UCRS.4c`, `UCRS.5a`, +`UCRS.5b`, `UCRS.5c` + +**File:** `R/ucedergreen.R` + +**Original (incorrect) code** (`DoseResponse/drc`, `R/ucedergreen.R`, +line ~32): + +``` r +fct <- function(dose, parm) +{ + parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE) + parmMat[, notFixed] <- parm + + numTerm <- parmMat[, 3] - parmMat[, 2] + parmMat[, 5]*exp(-1/dose^alpha) + denTerm <- 1 + exp(parmMat[, 1]*(log(dose) - log(parmMat[, 4]))) + parmMat[, 3] - numTerm/denTerm # WRONG: missing parmMat[, 2] (c parameter) +} +``` + +**Fixed code** (`hreinwald/drc`, `R/ucedergreen.R`, line ~56): + +``` r +fct <- function(dose, parm) +{ + parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE) + parmMat[, notFixed] <- parm + + numTerm <- parmMat[, 3] - parmMat[, 2] + parmMat[, 5]*exp(-1/dose^alpha) + denTerm <- 1 + exp(parmMat[, 1]*(log(dose) - log(parmMat[, 4]))) + parmMat[, 2] + parmMat[, 3] - numTerm/denTerm # CORRECT: c + d - numTerm/denTerm +} +``` + +**Scientific impact:** The published model formula (Cedergreen, Ritz & +Streibig, 2005, *Environ. Toxicol. Chem.* 24:3166) is: + +``` math +f(x) = c + d - \frac{d - c + f\,e^{-1/x^\alpha}}{1 + \exp(b(\log x - \log e))} +``` + +The original implementation returns `d - numTerm/denTerm`, i.e., the +fitted response is shifted upward by `c` (the lower horizontal +asymptote) for all dose values. When `c = 0` (the most common case for +UCRS.4x models), the result is numerically coincidentally correct; +however, when `c` is estimated (UCRS.5x) or is supplied as a non-zero +fixed value, every fitted value is wrong by exactly `c`. Any paper that +used `UCRS.5a`, `UCRS.5b`, or `UCRS.5c` with estimated `c ≠ 0` and +reported dose-response parameters, EC values, or hormesis estimates has +incorrect results that propagate to all downstream comparisons. + +Additionally, the `deriv1` (gradient with respect to the `c` parameter) +in the original code is `1/t3` (positive), whereas the corrected +formula’s partial derivative is `1 + 1/t3`. This means even if fitted +values were not perceptibly shifted (because `c ≈ 0`), standard errors +for the c-parameter estimate were systematically wrong. + +------------------------------------------------------------------------ + +### 1.2 Wrong Multiplier in `gammadr()` Gradient — SEVERITY: **HIGH** + +**Affected model/function:** +[`gammadr()`](https://hreinwald.github.io/drc/reference/gammadr.md) — +Gamma dose-response model + +**File:** `R/gammadr.r` (DoseResponse) vs `R/gammadr.R` (hreinwald) + +**Original (incorrect) code** (`DoseResponse/drc`, `R/gammadr.r`, inside +`deriv1`): + +``` r +cbind( + t1 * dgamma(parmMat[, 1] * dose, parmMat[, 4], 1) * parmMat[, 1], # WRONG: uses b not dose + 1 - t2, + t2, + t1 * logGamma(parmMat[, 1] * dose, parmMat[, 4]) +)[, notFixed] +``` + +**Fixed code** (`hreinwald/drc`, `R/gammadr.R`, inside `deriv1`): + +``` r +cbind( + t1 * dgamma(parmMat[, 1] * dose, parmMat[, 4], 1) * dose, # CORRECT: uses dose + 1 - t2, + t2, + t1 * logGamma(parmMat[, 1] * dose, parmMat[, 4]) +)[, notFixed] +``` + +**Scientific impact:** The derivative of +`f(x) = c + (d-c) · pgamma(b·x, e, 1)` with respect to `b` is +`(d-c) · dgamma(b·x, e, 1) · x`. The original uses `b` instead of `x` in +this product, yielding a gradient vector that scales incorrectly with +the dose. This corrupts the delta-method standard errors for the `b` +parameter and propagates to standard errors for any derived quantities +(ED values, predicted values with CIs) computed from models fit with +[`gammadr()`](https://hreinwald.github.io/drc/reference/gammadr.md). + +------------------------------------------------------------------------ + +### 1.3 Zero Gradients for Absolute-Type ED Standard Errors (7 Model Families) — SEVERITY: **HIGH** + +**Affected models/functions:** +[`braincousens()`](https://hreinwald.github.io/drc/reference/braincousens.md), +[`fplogistic()`](https://hreinwald.github.io/drc/reference/fplogistic.md), +[`llogistic()`](https://hreinwald.github.io/drc/reference/llogistic.md), +[`llogistic2()`](https://hreinwald.github.io/drc/reference/llogistic2.md), +[`lnormal()`](https://hreinwald.github.io/drc/reference/lnormal.md), +[`weibull1()`](https://hreinwald.github.io/drc/reference/weibull1.md), +[`weibull2()`](https://hreinwald.github.io/drc/reference/weibull2.md) + +**Files:** Respective `R/*.R` files in both repositories + +**Root cause (shared pattern, shown for +[`weibull1()`](https://hreinwald.github.io/drc/reference/weibull1.md))**: + +Original code (`DoseResponse/drc`, `R/weibull1.r`, `edfct`): + +``` r +edfct <- function(parm, respl, reference, type, ...) +{ + parmVec[notFixed] <- parm + p <- EDhelper(parmVec, respl, reference, type) + + tempVal <- log(-log((100-p)/100)) + EDp <- exp(tempVal/parmVec[1] + log(parmVec[4])) + + EDder <- EDp*c(-tempVal/(parmVec[1]^2), 0, 0, 1/parmVec[4]) + # ^^^ derivatives for c and d are always 0 — correct only for relative type + return(list(EDp, EDder[notFixed])) +} +``` + +Fixed code (`hreinwald/drc`, `R/weibull1.R`, `edfct`): + +``` r +edfct <- function(parm, respl, reference, type, ...) +{ + parmVec[notFixed] <- parm + p <- EDhelper(parmVec, respl, reference, type) + + tempVal <- log(-log((100-p)/100)) + EDp <- exp(tempVal/parmVec[1] + log(parmVec[4])) + EDder <- EDp*c(-tempVal/(parmVec[1]^2), 0, 0, 1/parmVec[4]) + + ## Fix: correct c and d derivatives for absolute type using central differences. + if (identical(type, "absolute")) { + .edval <- function(pv) { ... } # full chain-rule evaluation + for (.i in c(2, 3)) { + .h <- ... + EDder[.i] <- (.edval(.pvUp) - .edval(.pvDn)) / (2 * .h) + } + } + return(list(EDp, EDder[notFixed])) +} +``` + +**Scientific impact:** When users call +`ED(model, respLev, type="absolute", interval="delta")`, the +delta-method standard errors reported for the ED values are incorrect +because ∂ED/∂c and ∂ED/∂d are set to zero. The absolute-to-relative +conversion (`absToRel`/`EDhelper`) makes `p` a function of both `c` and +`d`; the chain rule therefore requires non-zero partial derivatives. The +magnitude of the error depends on the spread of the response: for data +with large ranges between `c` and `d`, the absolute type conversion +creates large sensitivity to asymptote estimates, and zeroing those +terms can substantially underestimate the true confidence interval +width. Any published confidence intervals for absolute ED values from +the original package are potentially too narrow. + +------------------------------------------------------------------------ + +### 1.4 `logistic()` `edfct` Signature Mismatch and Wrong p-swap — SEVERITY: **HIGH** + +**Affected model/function:** +[`logistic()`](https://hreinwald.github.io/drc/reference/logistic.md) +and all convenience wrappers `L.3`, `L.4`, `L.5` + +**File:** `R/logistic.r` (DoseResponse) vs `R/logistic.R` (hreinwald) + +**Original (incorrect) code** (`DoseResponse/drc`, `R/logistic.r`, +`edfct`): + +``` r +edfct <- function(parm, p, ...) +{ + parmVec[notFixed] <- parm + # ... (no reference or type handling) + # ... always uses p directly, no type="absolute" support + return(list(EDp, EDder[notFixed])) +} +``` + +**Fixed code** (`hreinwald/drc`, `R/logistic.R`, `edfct`): + +``` r +edfct <- function(parm, respl, reference = "control", type = "relative", ...) +{ + parmVec[notFixed] <- parm + if (identical(type, "absolute")) { + p <- 100 * ((parmVec[3] - respl) / (parmVec[3] - parmVec[2])) + } else { + p <- respl + } + ## NOTE: unlike log-logistic models, logistic model has b < 0 = increasing, + ## so EDhelper's p-swap for b < 0 would be incorrect here. + ... +} +``` + +**Scientific impact:** The logistic model (`L.3`, `L.4`, `L.5`) uses raw +dose values (not `log(dose)`), so the sign convention of `b` is reversed +compared to log-logistic models. The original code ignores `type` and +`reference` arguments, meaning `ED(model, type="absolute")` would +silently return wrong values (no error is thrown; the wrong formula +runs). Furthermore, the original code would delegate to `EDhelper` which +applies an incorrect p-swap for this model family, yielding ED values +computed at the complementary percentile (e.g., computing ED10 instead +of ED90). + +------------------------------------------------------------------------ + +### 1.5 `ucedergreen()` — Additional Bugs (17 Total) — SEVERITY: **CRITICAL/HIGH/MEDIUM** + +The +[`ucedergreen()`](https://hreinwald.github.io/drc/reference/ucedergreen.md) +function in DoseResponse/drc contained 17 separate bugs documented in +the hreinwald NEWS.md for v3.3.0.02. A summary of the most impactful: + +| Sub-Bug | Location | Severity | +|----|----|----| +| Missing `+c` in fct (see §1.1) | `fct()` | CRITICAL | +| `edfct` signature mismatch (`p` vs `respl`, missing `reference`/`type`) | `edfct()` | HIGH | +| `deriv1`: wrong sign/formula for c-column (`1/t3` vs `1 + 1/t3`) | `deriv1()` | HIGH | +| Undefined `xlogx` call in `deriv1` (uses unset closure) | `deriv1()` | HIGH | +| Missing [`match.arg()`](https://rdrr.io/r/base/match.arg.html) for `method` | top-level | MEDIUM | +| Vectorized `\|` in scalar `if()` guards | top-level | MEDIUM | +| Missing `useFixed` flag computation | self-starter | MEDIUM | +| `maxfct` signature mismatch | `maxfct()` | MEDIUM | +| Broken self-starter ignoring `alpha`/`method`/`useFixed` | `ssfct()` | MEDIUM | +| Missing `fctName`/`fctText` parameters | return list | LOW | +| `deriv1` excluded from return list | return list | HIGH | + +The absence of `deriv1` in the return list means that all Newton-type +optimizers relying on gradient information would fail silently or fall +back to finite differences, producing degraded convergence. + +------------------------------------------------------------------------ + +### 1.6 `mselect()` Parse Error — SEVERITY: **MEDIUM** + +**File:** `R/mselect.r` / `R/mselect.R` + +**Bug:** Two missing closing braces in +[`mselect()`](https://hreinwald.github.io/drc/reference/mselect.md). +This caused a parse error when the function was sourced directly from +the file (though it would load correctly via the compiled package). Any +user attempting to modify or source-load the function would encounter a +confusing parse failure. + +------------------------------------------------------------------------ + +### 1.7 `ED.lin.R` Incorrect Delta Method for Quadratic Models — SEVERITY: **MEDIUM** + +**File:** `R/ED.lin.R` + +**Bugs fixed in hreinwald:** - Duplicate `if`-block (dead code +evaluating the same condition twice) - Stray debug +[`print()`](https://rdrr.io/r/base/print.html) statement (emits output +during analysis) - Missing `parameterNames = c("b0", "b1", "b2")` +argument in `deltaMethod()` call for quadratic models — causing +incorrect parameter mapping and therefore wrong confidence intervals for +ED values from quadratic linear models. + +------------------------------------------------------------------------ + +### 1.8 `drmOpt()` Inverted Trace/Silent Logic — SEVERITY: **MEDIUM** + +**File:** `R/drmOpt.R` + +**Bug:** The `otrace`/`silentVal` logic was inverted: `otrace=TRUE` +(intending verbose output) incorrectly caused `silent=TRUE` in +`try(optim())`, suppressing error messages rather than displaying them. +This would cause optimization failures to be silently ignored during +debugging sessions. + +------------------------------------------------------------------------ + +## 2. Justification for Refactoring + +The codebase at `DoseResponse/drc` has been effectively unmaintained +since January 2021 (version 3.2-0). During this time, multiple bugs have +accumulated that undermine the scientific validity of results produced +by the package. The justification for refactoring rests on five concrete +lines of evidence: + +**1. Mathematical incorrectness in production models.** The missing `c` +parameter in +[`ucedergreen()`](https://hreinwald.github.io/drc/reference/ucedergreen.md) +(§1.1), the wrong multiplier in +[`gammadr()`](https://hreinwald.github.io/drc/reference/gammadr.md) +(§1.2), and the zero-gradient errors in seven model families (§1.3) +constitute mathematical errors that silently corrupt numerical results. +These are not software bugs in the traditional sense (crashes, type +errors) — they pass silently and deliver plausible-looking but wrong +numbers. + +**2. API mismatch with the framework’s own calling conventions.** The +`edfct` function is called by `ED.drc` with the signature +`(parm, respl, reference, type, ...)`. The logistic model’s `edfct` only +accepted `(parm, p, ...)`, silently dropping `reference` and `type`. +Similarly, +[`ucedergreen()`](https://hreinwald.github.io/drc/reference/ucedergreen.md)’s +`edfct` dropped `reference` and `type`. This is not a documentation +problem; it is an undetected interface violation that causes incorrect +behavior whenever users deviate from default parameters. + +**3. Dead code and commented-out experiments in production files.** +Across 70+ source files, `if(FALSE){...}` blocks (sometimes hundreds of +lines), stray [`print()`](https://rdrr.io/r/base/print.html) debug +statements, and large sections of commented-out alternative +implementations existed in the production codebase. This constitutes +significant technical debt that impedes maintenance, review, and the +ability to reason about what code paths are active. + +**4. Non-standard file naming.** Many R source files used lowercase +extensions (`.r` instead of `.R`): `backfit.r`, `baro5.r`, `comped.r`, +`drmc.r`, `fct2list.r`, `gammadr.r`, `gompertz.r`, `hewlett.r`, +`iband.r`, `idrm.r`, `isobole.r`, `lnormal.r`, `logistic.r`, `max.r`, +`mixture.r`, `mrdrm.r`, `mselect.r`, `multi2.r`, `nec.r`, `pr.r`, +`rdrm.r`, `relpot.r`, `sandwich.r`, `twophase.r`, `ursa.r`, `voelund.r`, +`weibull1.r`, `weibull2.r`, `xlogx.r`. On case-sensitive file systems +(Linux, most CI environments), this can cause load failures. + +**5. Complete absence of automated testing.** `DoseResponse/drc` +contains 3 ad-hoc test scripts (`test1.r`, `test2.r`, `test3.r`) plus +one seed-germination script — no `testthat` framework, no assertions, no +coverage tracking. `hreinwald/drc` introduces 79 `testthat` test files +covering all major model families, utility functions, and edge cases. + +------------------------------------------------------------------------ + +## 3. Documentation Improvements + +### 3.1 README + +| Aspect | DoseResponse/drc | hreinwald/drc | +|----|----|----| +| File | `README.md` (7 lines) | `README.md` (~250 lines) | +| Status badges | CRAN, Travis CI (deprecated), Downloads | GitHub version, R-CMD-check, Codecov, lifecycle, CRAN, Downloads, License, Last-commit, Contributions | +| Package description | 1 sentence | Full description with 7-item feature list | +| Installation instructions | 3 lines (devtools only) | Multi-section: recommended GitHub install, tar.gz local install, CRAN (explicitly discouraged) | +| Quick Start | None | 3 worked examples with [`drm()`](https://hreinwald.github.io/drc/reference/drm.md), [`ED()`](https://hreinwald.github.io/drc/reference/ED.md), [`EDcomp()`](https://hreinwald.github.io/drc/reference/EDcomp.md), [`mselect()`](https://hreinwald.github.io/drc/reference/mselect.md) | +| Model table | None | Complete table of all model families with descriptions | +| Key functions table | None | Complete table of core functions with descriptions | +| Data types | None | Complete table of `type=` options | +| Dependencies | None | Full list | +| Logo | None | Custom logo in `man/figures/logo.png` | + +### 3.2 Roxygen2 Documentation Quality + +`DoseResponse/drc` uses Roxygen2 version 6.1.1 (declared in +DESCRIPTION). Most model files have minimal or no `@param`, `@return`, +`@examples`, or `@details` tags — functions are defined with no Roxygen +headers at all. + +`hreinwald/drc` uses Roxygen2 7.3.3 with markdown support +(`Roxygen: list(markdown = TRUE)`). Every exported function has: + +- `@title` and `@description` +- `@param` for each argument with type and purpose +- `@return` describing the return structure +- `@details` with the mathematical formula in LaTeX +- `@examples` with working, runnable code +- `@seealso` cross-references +- `@references` with full bibliographic citations +- `@author` attributions +- `@keywords` + +Example of improvement — +[`weibull1()`](https://hreinwald.github.io/drc/reference/weibull1.md) +documentation added: + +- 4-item describe block explaining each of the 4 self-starter methods +- LaTeX formula for the Weibull type 1 model +- Complete `@param` for each of 7 arguments +- 3 working examples across `W1.2`, `W1.3`, `W1.4`, `EXD.2`, `EXD.3` + +### 3.3 GitHub Pages Documentation + +| Aspect | DoseResponse/drc | hreinwald/drc | +|----|----|----| +| pkgdown site | Present (minimal, no GitHub Pages deployment) | Full site deployed at | +| Reference index | Basic auto-generated | Organized by category in `_pkgdown.yml` (3,265 bytes vs 1,863 bytes) | +| Vignettes | None | 2 vignettes: `dose-response-workflow.Rmd` (28KB), `nec-models.Rmd` (14KB) | +| Favicon/branding | None | Custom favicon and logo | +| Accessibility | None | Alt-text on all images | + +### 3.4 Vignettes + +`hreinwald/drc` introduces two new vignettes absent from +`DoseResponse/drc`: + +1. **`dose-response-workflow.Rmd`** (28,149 bytes): A complete + end-to-end workflow demonstrating data loading, model fitting, ED + estimation, multi-curve comparison, model selection with + [`mselect()`](https://hreinwald.github.io/drc/reference/mselect.md), + and result visualization. References the corrected ED output format. + +2. **`nec-models.Rmd`** (14,499 bytes): Dedicated documentation of + No-Effect Concentration (NEC) models with scientific context, + fitting examples, and interpretation guidance. + +### 3.5 CITATION.cff + +`DoseResponse/drc` has a plain-text `inst/citation` file (517 bytes) +with no structured metadata. + +`hreinwald/drc` has a proper `CITATION.cff` (1,523 bytes) with CFF +version 1.2.0, author ORCID identifiers for all four original authors, +version, DOI, release date, and two structured `references` entries +(PLoS ONE 2015 article and CRC Press 2019 book). + +------------------------------------------------------------------------ + +## 4. New Features & Improvements + +### 4.1 New Functions + +| Function | File | Description | +|----|----|----| +| [`rss()`](https://hreinwald.github.io/drc/reference/rss.md) | `R/rss.R` | Residual sum of squares for fitted `drc` objects; [`Rsq()`](https://hreinwald.github.io/drc/reference/Rsq.md) now reuses [`rss()`](https://hreinwald.github.io/drc/reference/rss.md) internally | +| [`ED_robust()`](https://hreinwald.github.io/drc/reference/ED_robust.md) (internal) | `R/ED_robust.R` | Robust ED estimation using `rlang` (replaces deprecated `lazyeval`) | +| [`absToRel()`](https://hreinwald.github.io/drc/reference/absToRel.md) | `R/absToRel.R` | Exported utility: absolute-to-relative response level conversion | +| [`commatFct()`](https://hreinwald.github.io/drc/reference/commatFct.md) | `R/commatFct.R` | Internal helper for formatting comma-separated parameter texts | +| [`drm_legacy()`](https://hreinwald.github.io/drc/reference/drm_legacy.md) | `R/drm_legacy.R` | Legacy-compatible [`drm()`](https://hreinwald.github.io/drc/reference/drm.md) interface for backward compatibility | +| [`simFct()`](https://hreinwald.github.io/drc/reference/simFct.md) / [`simDR()`](https://hreinwald.github.io/drc/reference/simDR.md) | `R/simFct.R` / `R/simDR.R` | Simulation functions for dose-response data generation | +| `onAttach()` | `R/onAttach.R` | Package attachment message with version info and repository URL | + +### 4.2 New Model Variants + +- All `UCRS` models (`UCRS.4a/4b/4c`, `UCRS.5a/5b/5c`) were completely + rewritten — while they existed in DoseResponse/drc, they were + functionally broken (see §1.1, §1.5) and are effectively new working + implementations. +- `CRS.4a`, `CRS.4b`, `CRS.4c` display text fixes (e.g., `CRS.4b` now + correctly shows “alpha=0.5” instead of “alpha=”). + +### 4.3 Enhancements to Existing Functions + +- **[`ED()`](https://hreinwald.github.io/drc/reference/ED.md) / + [`ED.drc()`](https://hreinwald.github.io/drc/reference/ED.drc.md)**: + Multiple robustness improvements — correct matrix handling when + `indexMat` is a vector (single-parameter models), NaN/Inf handling in + LL.5, dynamic curve loop with post-hoc `clevel` filtering, + `drop=FALSE` for covariance matrix slices, unnamed gradient vectors. +- **[`maED()`](https://hreinwald.github.io/drc/reference/maED.md)**: + Excludes models with non-finite ED estimates or fitting errors from + model-averaged estimate; returns `NA` instead of `NaN` when all + candidates fail. +- **[`predict.drc()`](https://hreinwald.github.io/drc/reference/predict.drc.md)**: + Fixed “incorrect number of dimensions” for models with many fixed + parameters. +- **[`plot.drc()`](https://hreinwald.github.io/drc/reference/plot.drc.md)**: + New `errbar.col` parameter to control error bar colors; default now + matches curve colors. +- **[`anova.drc()`](https://hreinwald.github.io/drc/reference/anova.drc.md)**: + Corrected documentation to accurately reflect actual behavior; + improved error handling. +- **[`mselect()`](https://hreinwald.github.io/drc/reference/mselect.md)**: + Fixed parse error from missing closing braces. +- **[`noEffect()`](https://hreinwald.github.io/drc/reference/noEffect.md)**: + Added warning when degrees of freedom difference ≤ 0. +- **[`searchdrc()`](https://hreinwald.github.io/drc/reference/searchdrc.md)**: + Fixed regex error and convergence failure behavior. +- **[`drmOpt()`](https://hreinwald.github.io/drc/reference/drmOpt.md)**: + Fixed inverted `otrace`/`silentVal` logic. + +### 4.4 Dependency Updates + +| Aspect | DoseResponse/drc | hreinwald/drc | +|----|----|----| +| R minimum version | ≥ 2.0.0 | ≥ 4.0.0 | +| `lazyeval` | Used | Replaced with `rlang` | +| `drcData` (separate package) | Required | Removed (data bundled or sourced differently) | +| `data.table`, `dplyr` | Not present | Added to Imports | +| `lifecycle` | Not present | Added to Imports (for deprecation warnings) | +| `testthat` | Not present in Suggests | Added (≥ 3.0.0) | +| `knitr`, `rmarkdown` | Not present | Added for vignettes | + +### 4.5 Test Coverage + +| Aspect | DoseResponse/drc | hreinwald/drc | +|----|----|----| +| Test framework | Ad-hoc R scripts | `testthat` v3 | +| Number of test files | 3 scripts + 1 data file | 79 test files | +| Models with dedicated tests | 0 | All major model families (llogistic, weibull1/2, logistic, gompertz, lnormal, braincousens, cedergreen, ucedergreen, NEC, gammadr, baro5, etc.) | +| Utility function tests | 0 | ED, ED.lin, EDcomp, maED, mselect, anova, modelFit, predict, CIcompX, rss, and many more | +| Code coverage tracking | None | Codecov integration via GitHub Actions | + +------------------------------------------------------------------------ + +## 5. Version Control & Project Hygiene + +| Aspect | DoseResponse/drc | hreinwald/drc | +|----|----|----| +| Current version | 3.2-0 | 3.3.2 | +| Last substantive update | January 2021 | May 2026 | +| Commit quality | Sparse, terse messages | Structured commits with clear descriptions referencing issues | +| Active branches | Only `master` | `dev` (primary), `main_beta` (stable beta), multiple feature branches | +| CI/CD | `.travis.yml` (Travis CI — deprecated/inactive) | 3 GitHub Actions workflows: `R-CMD-check.yaml`, `test-coverage.yaml`, `static.yml` (pkgdown) | +| `CITATION.cff` | Absent | Present (CFF 1.2.0, ORCIDs, DOI, two references) | +| `NEWS.md` | `news` (plain text, no markdown) | `NEWS.md` (properly formatted, categorized, 36KB) | +| Issue tracker | Not actively used | Used with references in commit messages | +| pkgdown deployment | Not deployed | Auto-deployed via `static.yml` to GitHub Pages | +| License | GPL-2 | GPL-2 (correctly inherited) | +| Maintainer | Christian Ritz (inactive) | Hannes Reinwald (`cre` role) | +| Authors in DESCRIPTION | Ritz + Streibig | Ritz + Streibig + Reinwald (as `aut`, `cre`) | +| Roxygen version | 6.1.1 | 7.3.3 | +| File naming convention | Mixed `.r`/`.R` | Standardized `.R` throughout | + +------------------------------------------------------------------------ + +## 6. Publication Readiness Summary + +### Items That Strengthen the Submission Now: + +- **Bug evidence is documented and reproducible.** The `NEWS.md` + provides a detailed bug report for each fix. The 79 `testthat` tests + provide regression guards. +- **The + [`ucedergreen()`](https://hreinwald.github.io/drc/reference/ucedergreen.md) + bug** is a compelling primary justification: it is unambiguous, + affects a named published model family, and affects all previous + users. +- **Breadth of fixes** across 7 model families for the absolute-type ED + gradient bug provides evidence of systematic, not incidental, review. + +### Items Recommended Before Submission (JSS / JOSS / The R Journal): + +1. **Benchmark study**: Quantify the numerical difference between old + and new results on synthetic or real datasets (e.g., table showing + correct vs. incorrect ED confidence intervals under + `type="absolute"` for W1.4, LN.4, LL.4 — critical for reviewers to + assess impact magnitude). + +2. **Version stability**: The `dev` branch is still the primary + development branch. A stable tagged release on `main` (or + `main_beta` promoted) would be expected by most journal submission + processes. + +3. **CRAN submission**: The README explicitly discourages the CRAN + version. A corrected CRAN submission would maximally reach the user + community and is required for R Journal papers referencing a + package. + +4. **Vignette for the corrected bugs**: A dedicated vignette showing + before/after comparisons (old vs. new results) for the most critical + bugs would directly serve the paper’s narrative. + +5. **Acknowledgment of original authors**: The paper should prominently + acknowledge Ritz, Baty, Streibig & Gerhard as originators. The + framing as “corrected and modernized” is already appropriately + respectful. + +6. **Test coverage metric**: The README references a Codecov badge. A + coverage percentage of ≥ 70% on key model functions would be a + strong claim for a methods paper. + +------------------------------------------------------------------------ + +## 7. Suggested Abstract Draft + +> The `drc` R package (Ritz *et al.*, 2015) provides a widely-used +> framework for parametric dose-response modeling in bioassay, +> toxicology, and ecotoxicology. Since its last CRAN release (v3.2-0, +> January 2021), the package has received no substantive maintenance +> despite continued use in the scientific literature. We present `drc` +> v3.3.2, a corrected and modernized version of the package, addressing +> a series of bugs ranging in severity from silently incorrect fitted +> values to systematically underestimated confidence intervals. The most +> critical error, discovered in the U-shaped Cedergreen-Ritz-Streibig +> hormesis model family (`UCRS.*`), omits the lower horizontal asymptote +> parameter from the model function, rendering every fitted value +> incorrect whenever the lower asymptote differs from zero. +> Additionally, the gradient functions used in delta-method standard +> error calculations for absolute-type effective dose (ED) estimates +> were incorrect in seven model families (Weibull type 1 and 2, +> log-logistic, log-normal, logistic, Brain-Cousens, and fractional +> polynomial logistic), consistently setting chain-rule contributions to +> zero and producing confidence intervals that are potentially too +> narrow. A further gradient error in the Gamma model inverted the +> rate-parameter derivative. These bugs affect published results +> obtained using the original package. Beyond correctness, the +> refactored package introduces 79 `testthat` unit tests (versus zero in +> the original), comprehensive Roxygen2 documentation with mathematical +> formulae and worked examples, a pkgdown documentation website, three +> GitHub Actions CI/CD workflows, and a `CITATION.cff` metadata file. +> The package is available from and +> is fully backward compatible with the existing +> [`drm()`](https://hreinwald.github.io/drc/reference/drm.md) interface. + +------------------------------------------------------------------------ + +## Source Repositories + +- **Refactored package (subject):** + (branch: `dev`, commit `508f602`) +- **Fork source (baseline):** + (default branch `master`, commit `8719d43`) +- **GitHub Pages:** diff --git a/docs/authors.html b/docs/authors.html index 41846bf8..5c47f4a0 100644 --- a/docs/authors.html +++ b/docs/authors.html @@ -1,127 +1,93 @@ - - - - - - +Authors and Citation • drc + Skip to contents -Authors • drc - - - +
+
+
+

Authors and Citation

- -
-
- - - +
+

Authors

-
-
-
-

Authors

+
  • +

    Christian Ritz. Author. +

    +
    • +
  • +

    Jens C. Streibig. Author. +

    +
    • +
  • +

    Hannes Reinwald. Author, maintainer. +

    +
    • +
+ +
+

Citation

+

Source: DESCRIPTION

+ +

Ritz C, Streibig JC, Reinwald H (2026). +drc: Analysis of Dose-Response Data. +R package version 3.3.2, https://hreinwald.github.io/drc. +

+ 
@Manual{,
+  title = {drc: Analysis of Dose-Response Data},
+  author = {Christian Ritz and Jens C. Streibig and Hannes Reinwald},
+  year = {2026},
+  note = {R package version 3.3.2},
+  url = {https://hreinwald.github.io/drc},
+}
-
    -
  • -

    Christian Ritz. Author, maintainer. -

    -
    • -
  • -

    Jens C. Streibig. Author. -

    -
    • -
+
-
+
+

Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

- -
-
-

Developed by Christian Ritz, Jens C. Streibig.

+
+

Site built with pkgdown 2.2.0.

-
-

Site built with pkgdown.

-
+
+ + - - - - - + diff --git a/docs/authors.md b/docs/authors.md new file mode 100644 index 00000000..6582fd84 --- /dev/null +++ b/docs/authors.md @@ -0,0 +1,25 @@ +# Authors and Citation + +## Authors + +- **Christian Ritz**. Author. + +- **Jens C. Streibig**. Author. + +- **Hannes Reinwald**. Author, maintainer. + +## Citation + +Source: +[`DESCRIPTION`](https://github.com/hreinwald/drc/blob/HEAD/DESCRIPTION) + +Ritz C, Streibig JC, Reinwald H (2026). *drc: Analysis of Dose-Response +Data*. R package version 3.3.2, . + + @Manual{, + title = {drc: Analysis of Dose-Response Data}, + author = {Christian Ritz and Jens C. Streibig and Hannes Reinwald}, + year = {2026}, + note = {R package version 3.3.2}, + url = {https://hreinwald.github.io/drc}, + } diff --git a/docs/deps/bootstrap-5.3.1/bootstrap.bundle.min.js b/docs/deps/bootstrap-5.3.1/bootstrap.bundle.min.js new file mode 100644 index 00000000..e8f21f70 --- /dev/null +++ b/docs/deps/bootstrap-5.3.1/bootstrap.bundle.min.js @@ -0,0 +1,7 @@ +/*! + * Bootstrap v5.3.1 (https://getbootstrap.com/) + * Copyright 2011-2023 The Bootstrap Authors (https://github.com/twbs/bootstrap/graphs/contributors) + * Licensed under MIT (https://github.com/twbs/bootstrap/blob/main/LICENSE) + */ +!function(t,e){"object"==typeof exports&&"undefined"!=typeof module?module.exports=e():"function"==typeof define&&define.amd?define(e):(t="undefined"!=typeof globalThis?globalThis:t||self).bootstrap=e()}(this,(function(){"use strict";const t=new Map,e={set(e,i,n){t.has(e)||t.set(e,new Map);const s=t.get(e);s.has(i)||0===s.size?s.set(i,n):console.error(`Bootstrap doesn't allow more than one instance per element. Bound instance: ${Array.from(s.keys())[0]}.`)},get:(e,i)=>t.has(e)&&t.get(e).get(i)||null,remove(e,i){if(!t.has(e))return;const n=t.get(e);n.delete(i),0===n.size&&t.delete(e)}},i="transitionend",n=t=>(t&&window.CSS&&window.CSS.escape&&(t=t.replace(/#([^\s"#']+)/g,((t,e)=>`#${CSS.escape(e)}`))),t),s=t=>{t.dispatchEvent(new Event(i))},o=t=>!(!t||"object"!=typeof t)&&(void 0!==t.jquery&&(t=t[0]),void 0!==t.nodeType),r=t=>o(t)?t.jquery?t[0]:t:"string"==typeof t&&t.length>0?document.querySelector(n(t)):null,a=t=>{if(!o(t)||0===t.getClientRects().length)return!1;const e="visible"===getComputedStyle(t).getPropertyValue("visibility"),i=t.closest("details:not([open])");if(!i)return e;if(i!==t){const e=t.closest("summary");if(e&&e.parentNode!==i)return!1;if(null===e)return!1}return e},l=t=>!t||t.nodeType!==Node.ELEMENT_NODE||!!t.classList.contains("disabled")||(void 0!==t.disabled?t.disabled:t.hasAttribute("disabled")&&"false"!==t.getAttribute("disabled")),c=t=>{if(!document.documentElement.attachShadow)return null;if("function"==typeof t.getRootNode){const e=t.getRootNode();return e instanceof ShadowRoot?e:null}return t instanceof ShadowRoot?t:t.parentNode?c(t.parentNode):null},h=()=>{},d=t=>{t.offsetHeight},u=()=>window.jQuery&&!document.body.hasAttribute("data-bs-no-jquery")?window.jQuery:null,f=[],p=()=>"rtl"===document.documentElement.dir,m=t=>{var e;e=()=>{const e=u();if(e){const i=t.NAME,n=e.fn[i];e.fn[i]=t.jQueryInterface,e.fn[i].Constructor=t,e.fn[i].noConflict=()=>(e.fn[i]=n,t.jQueryInterface)}},"loading"===document.readyState?(f.length||document.addEventListener("DOMContentLoaded",(()=>{for(const t of f)t()})),f.push(e)):e()},g=(t,e=[],i=t)=>"function"==typeof t?t(...e):i,_=(t,e,n=!0)=>{if(!n)return void g(t);const o=(t=>{if(!t)return 0;let{transitionDuration:e,transitionDelay:i}=window.getComputedStyle(t);const n=Number.parseFloat(e),s=Number.parseFloat(i);return n||s?(e=e.split(",")[0],i=i.split(",")[0],1e3*(Number.parseFloat(e)+Number.parseFloat(i))):0})(e)+5;let r=!1;const a=({target:n})=>{n===e&&(r=!0,e.removeEventListener(i,a),g(t))};e.addEventListener(i,a),setTimeout((()=>{r||s(e)}),o)},b=(t,e,i,n)=>{const s=t.length;let o=t.indexOf(e);return-1===o?!i&&n?t[s-1]:t[0]:(o+=i?1:-1,n&&(o=(o+s)%s),t[Math.max(0,Math.min(o,s-1))])},v=/[^.]*(?=\..*)\.|.*/,y=/\..*/,w=/::\d+$/,A={};let E=1;const T={mouseenter:"mouseover",mouseleave:"mouseout"},C=new Set(["click","dblclick","mouseup","mousedown","contextmenu","mousewheel","DOMMouseScroll","mouseover","mouseout","mousemove","selectstart","selectend","keydown","keypress","keyup","orientationchange","touchstart","touchmove","touchend","touchcancel","pointerdown","pointermove","pointerup","pointerleave","pointercancel","gesturestart","gesturechange","gestureend","focus","blur","change","reset","select","submit","focusin","focusout","load","unload","beforeunload","resize","move","DOMContentLoaded","readystatechange","error","abort","scroll"]);function O(t,e){return e&&`${e}::${E++}`||t.uidEvent||E++}function x(t){const e=O(t);return t.uidEvent=e,A[e]=A[e]||{},A[e]}function k(t,e,i=null){return Object.values(t).find((t=>t.callable===e&&t.delegationSelector===i))}function L(t,e,i){const n="string"==typeof e,s=n?i:e||i;let o=I(t);return C.has(o)||(o=t),[n,s,o]}function S(t,e,i,n,s){if("string"!=typeof e||!t)return;let[o,r,a]=L(e,i,n);if(e in T){const t=t=>function(e){if(!e.relatedTarget||e.relatedTarget!==e.delegateTarget&&!e.delegateTarget.contains(e.relatedTarget))return t.call(this,e)};r=t(r)}const l=x(t),c=l[a]||(l[a]={}),h=k(c,r,o?i:null);if(h)return void(h.oneOff=h.oneOff&&s);const d=O(r,e.replace(v,"")),u=o?function(t,e,i){return function n(s){const o=t.querySelectorAll(e);for(let{target:r}=s;r&&r!==this;r=r.parentNode)for(const a of o)if(a===r)return P(s,{delegateTarget:r}),n.oneOff&&N.off(t,s.type,e,i),i.apply(r,[s])}}(t,i,r):function(t,e){return function i(n){return P(n,{delegateTarget:t}),i.oneOff&&N.off(t,n.type,e),e.apply(t,[n])}}(t,r);u.delegationSelector=o?i:null,u.callable=r,u.oneOff=s,u.uidEvent=d,c[d]=u,t.addEventListener(a,u,o)}function D(t,e,i,n,s){const o=k(e[i],n,s);o&&(t.removeEventListener(i,o,Boolean(s)),delete e[i][o.uidEvent])}function $(t,e,i,n){const s=e[i]||{};for(const[o,r]of Object.entries(s))o.includes(n)&&D(t,e,i,r.callable,r.delegationSelector)}function I(t){return t=t.replace(y,""),T[t]||t}const N={on(t,e,i,n){S(t,e,i,n,!1)},one(t,e,i,n){S(t,e,i,n,!0)},off(t,e,i,n){if("string"!=typeof e||!t)return;const[s,o,r]=L(e,i,n),a=r!==e,l=x(t),c=l[r]||{},h=e.startsWith(".");if(void 0===o){if(h)for(const i of Object.keys(l))$(t,l,i,e.slice(1));for(const[i,n]of Object.entries(c)){const s=i.replace(w,"");a&&!e.includes(s)||D(t,l,r,n.callable,n.delegationSelector)}}else{if(!Object.keys(c).length)return;D(t,l,r,o,s?i:null)}},trigger(t,e,i){if("string"!=typeof e||!t)return null;const n=u();let s=null,o=!0,r=!0,a=!1;e!==I(e)&&n&&(s=n.Event(e,i),n(t).trigger(s),o=!s.isPropagationStopped(),r=!s.isImmediatePropagationStopped(),a=s.isDefaultPrevented());const l=P(new Event(e,{bubbles:o,cancelable:!0}),i);return a&&l.preventDefault(),r&&t.dispatchEvent(l),l.defaultPrevented&&s&&s.preventDefault(),l}};function P(t,e={}){for(const[i,n]of Object.entries(e))try{t[i]=n}catch(e){Object.defineProperty(t,i,{configurable:!0,get:()=>n})}return t}function M(t){if("true"===t)return!0;if("false"===t)return!1;if(t===Number(t).toString())return Number(t);if(""===t||"null"===t)return null;if("string"!=typeof t)return t;try{return JSON.parse(decodeURIComponent(t))}catch(e){return t}}function j(t){return t.replace(/[A-Z]/g,(t=>`-${t.toLowerCase()}`))}const F={setDataAttribute(t,e,i){t.setAttribute(`data-bs-${j(e)}`,i)},removeDataAttribute(t,e){t.removeAttribute(`data-bs-${j(e)}`)},getDataAttributes(t){if(!t)return{};const e={},i=Object.keys(t.dataset).filter((t=>t.startsWith("bs")&&!t.startsWith("bsConfig")));for(const n of i){let i=n.replace(/^bs/,"");i=i.charAt(0).toLowerCase()+i.slice(1,i.length),e[i]=M(t.dataset[n])}return e},getDataAttribute:(t,e)=>M(t.getAttribute(`data-bs-${j(e)}`))};class H{static get Default(){return{}}static get DefaultType(){return{}}static get NAME(){throw new Error('You have to implement the static method "NAME", for each component!')}_getConfig(t){return t=this._mergeConfigObj(t),t=this._configAfterMerge(t),this._typeCheckConfig(t),t}_configAfterMerge(t){return t}_mergeConfigObj(t,e){const i=o(e)?F.getDataAttribute(e,"config"):{};return{...this.constructor.Default,..."object"==typeof i?i:{},...o(e)?F.getDataAttributes(e):{},..."object"==typeof t?t:{}}}_typeCheckConfig(t,e=this.constructor.DefaultType){for(const[n,s]of Object.entries(e)){const e=t[n],r=o(e)?"element":null==(i=e)?`${i}`:Object.prototype.toString.call(i).match(/\s([a-z]+)/i)[1].toLowerCase();if(!new RegExp(s).test(r))throw new TypeError(`${this.constructor.NAME.toUpperCase()}: Option "${n}" provided type "${r}" but expected type "${s}".`)}var i}}class W extends H{constructor(t,i){super(),(t=r(t))&&(this._element=t,this._config=this._getConfig(i),e.set(this._element,this.constructor.DATA_KEY,this))}dispose(){e.remove(this._element,this.constructor.DATA_KEY),N.off(this._element,this.constructor.EVENT_KEY);for(const t of Object.getOwnPropertyNames(this))this[t]=null}_queueCallback(t,e,i=!0){_(t,e,i)}_getConfig(t){return t=this._mergeConfigObj(t,this._element),t=this._configAfterMerge(t),this._typeCheckConfig(t),t}static getInstance(t){return e.get(r(t),this.DATA_KEY)}static getOrCreateInstance(t,e={}){return this.getInstance(t)||new this(t,"object"==typeof e?e:null)}static get VERSION(){return"5.3.1"}static get DATA_KEY(){return`bs.${this.NAME}`}static get EVENT_KEY(){return`.${this.DATA_KEY}`}static eventName(t){return`${t}${this.EVENT_KEY}`}}const B=t=>{let e=t.getAttribute("data-bs-target");if(!e||"#"===e){let i=t.getAttribute("href");if(!i||!i.includes("#")&&!i.startsWith("."))return null;i.includes("#")&&!i.startsWith("#")&&(i=`#${i.split("#")[1]}`),e=i&&"#"!==i?i.trim():null}return n(e)},z={find:(t,e=document.documentElement)=>[].concat(...Element.prototype.querySelectorAll.call(e,t)),findOne:(t,e=document.documentElement)=>Element.prototype.querySelector.call(e,t),children:(t,e)=>[].concat(...t.children).filter((t=>t.matches(e))),parents(t,e){const i=[];let n=t.parentNode.closest(e);for(;n;)i.push(n),n=n.parentNode.closest(e);return i},prev(t,e){let i=t.previousElementSibling;for(;i;){if(i.matches(e))return[i];i=i.previousElementSibling}return[]},next(t,e){let i=t.nextElementSibling;for(;i;){if(i.matches(e))return[i];i=i.nextElementSibling}return[]},focusableChildren(t){const e=["a","button","input","textarea","select","details","[tabindex]",'[contenteditable="true"]'].map((t=>`${t}:not([tabindex^="-"])`)).join(",");return this.find(e,t).filter((t=>!l(t)&&a(t)))},getSelectorFromElement(t){const e=B(t);return e&&z.findOne(e)?e:null},getElementFromSelector(t){const e=B(t);return e?z.findOne(e):null},getMultipleElementsFromSelector(t){const e=B(t);return e?z.find(e):[]}},R=(t,e="hide")=>{const i=`click.dismiss${t.EVENT_KEY}`,n=t.NAME;N.on(document,i,`[data-bs-dismiss="${n}"]`,(function(i){if(["A","AREA"].includes(this.tagName)&&i.preventDefault(),l(this))return;const s=z.getElementFromSelector(this)||this.closest(`.${n}`);t.getOrCreateInstance(s)[e]()}))},q=".bs.alert",V=`close${q}`,K=`closed${q}`;class Q extends W{static get NAME(){return"alert"}close(){if(N.trigger(this._element,V).defaultPrevented)return;this._element.classList.remove("show");const t=this._element.classList.contains("fade");this._queueCallback((()=>this._destroyElement()),this._element,t)}_destroyElement(){this._element.remove(),N.trigger(this._element,K),this.dispose()}static jQueryInterface(t){return this.each((function(){const e=Q.getOrCreateInstance(this);if("string"==typeof t){if(void 0===e[t]||t.startsWith("_")||"constructor"===t)throw new TypeError(`No method named "${t}"`);e[t](this)}}))}}R(Q,"close"),m(Q);const X='[data-bs-toggle="button"]';class Y extends W{static get NAME(){return"button"}toggle(){this._element.setAttribute("aria-pressed",this._element.classList.toggle("active"))}static jQueryInterface(t){return this.each((function(){const e=Y.getOrCreateInstance(this);"toggle"===t&&e[t]()}))}}N.on(document,"click.bs.button.data-api",X,(t=>{t.preventDefault();const e=t.target.closest(X);Y.getOrCreateInstance(e).toggle()})),m(Y);const U=".bs.swipe",G=`touchstart${U}`,J=`touchmove${U}`,Z=`touchend${U}`,tt=`pointerdown${U}`,et=`pointerup${U}`,it={endCallback:null,leftCallback:null,rightCallback:null},nt={endCallback:"(function|null)",leftCallback:"(function|null)",rightCallback:"(function|null)"};class st extends H{constructor(t,e){super(),this._element=t,t&&st.isSupported()&&(this._config=this._getConfig(e),this._deltaX=0,this._supportPointerEvents=Boolean(window.PointerEvent),this._initEvents())}static get Default(){return it}static get DefaultType(){return nt}static get NAME(){return"swipe"}dispose(){N.off(this._element,U)}_start(t){this._supportPointerEvents?this._eventIsPointerPenTouch(t)&&(this._deltaX=t.clientX):this._deltaX=t.touches[0].clientX}_end(t){this._eventIsPointerPenTouch(t)&&(this._deltaX=t.clientX-this._deltaX),this._handleSwipe(),g(this._config.endCallback)}_move(t){this._deltaX=t.touches&&t.touches.length>1?0:t.touches[0].clientX-this._deltaX}_handleSwipe(){const t=Math.abs(this._deltaX);if(t<=40)return;const e=t/this._deltaX;this._deltaX=0,e&&g(e>0?this._config.rightCallback:this._config.leftCallback)}_initEvents(){this._supportPointerEvents?(N.on(this._element,tt,(t=>this._start(t))),N.on(this._element,et,(t=>this._end(t))),this._element.classList.add("pointer-event")):(N.on(this._element,G,(t=>this._start(t))),N.on(this._element,J,(t=>this._move(t))),N.on(this._element,Z,(t=>this._end(t))))}_eventIsPointerPenTouch(t){return this._supportPointerEvents&&("pen"===t.pointerType||"touch"===t.pointerType)}static isSupported(){return"ontouchstart"in document.documentElement||navigator.maxTouchPoints>0}}const ot=".bs.carousel",rt=".data-api",at="next",lt="prev",ct="left",ht="right",dt=`slide${ot}`,ut=`slid${ot}`,ft=`keydown${ot}`,pt=`mouseenter${ot}`,mt=`mouseleave${ot}`,gt=`dragstart${ot}`,_t=`load${ot}${rt}`,bt=`click${ot}${rt}`,vt="carousel",yt="active",wt=".active",At=".carousel-item",Et=wt+At,Tt={ArrowLeft:ht,ArrowRight:ct},Ct={interval:5e3,keyboard:!0,pause:"hover",ride:!1,touch:!0,wrap:!0},Ot={interval:"(number|boolean)",keyboard:"boolean",pause:"(string|boolean)",ride:"(boolean|string)",touch:"boolean",wrap:"boolean"};class xt extends W{constructor(t,e){super(t,e),this._interval=null,this._activeElement=null,this._isSliding=!1,this.touchTimeout=null,this._swipeHelper=null,this._indicatorsElement=z.findOne(".carousel-indicators",this._element),this._addEventListeners(),this._config.ride===vt&&this.cycle()}static get Default(){return Ct}static get DefaultType(){return Ot}static get NAME(){return"carousel"}next(){this._slide(at)}nextWhenVisible(){!document.hidden&&a(this._element)&&this.next()}prev(){this._slide(lt)}pause(){this._isSliding&&s(this._element),this._clearInterval()}cycle(){this._clearInterval(),this._updateInterval(),this._interval=setInterval((()=>this.nextWhenVisible()),this._config.interval)}_maybeEnableCycle(){this._config.ride&&(this._isSliding?N.one(this._element,ut,(()=>this.cycle())):this.cycle())}to(t){const e=this._getItems();if(t>e.length-1||t<0)return;if(this._isSliding)return void N.one(this._element,ut,(()=>this.to(t)));const i=this._getItemIndex(this._getActive());if(i===t)return;const n=t>i?at:lt;this._slide(n,e[t])}dispose(){this._swipeHelper&&this._swipeHelper.dispose(),super.dispose()}_configAfterMerge(t){return t.defaultInterval=t.interval,t}_addEventListeners(){this._config.keyboard&&N.on(this._element,ft,(t=>this._keydown(t))),"hover"===this._config.pause&&(N.on(this._element,pt,(()=>this.pause())),N.on(this._element,mt,(()=>this._maybeEnableCycle()))),this._config.touch&&st.isSupported()&&this._addTouchEventListeners()}_addTouchEventListeners(){for(const t of z.find(".carousel-item img",this._element))N.on(t,gt,(t=>t.preventDefault()));const t={leftCallback:()=>this._slide(this._directionToOrder(ct)),rightCallback:()=>this._slide(this._directionToOrder(ht)),endCallback:()=>{"hover"===this._config.pause&&(this.pause(),this.touchTimeout&&clearTimeout(this.touchTimeout),this.touchTimeout=setTimeout((()=>this._maybeEnableCycle()),500+this._config.interval))}};this._swipeHelper=new st(this._element,t)}_keydown(t){if(/input|textarea/i.test(t.target.tagName))return;const e=Tt[t.key];e&&(t.preventDefault(),this._slide(this._directionToOrder(e)))}_getItemIndex(t){return this._getItems().indexOf(t)}_setActiveIndicatorElement(t){if(!this._indicatorsElement)return;const e=z.findOne(wt,this._indicatorsElement);e.classList.remove(yt),e.removeAttribute("aria-current");const i=z.findOne(`[data-bs-slide-to="${t}"]`,this._indicatorsElement);i&&(i.classList.add(yt),i.setAttribute("aria-current","true"))}_updateInterval(){const t=this._activeElement||this._getActive();if(!t)return;const e=Number.parseInt(t.getAttribute("data-bs-interval"),10);this._config.interval=e||this._config.defaultInterval}_slide(t,e=null){if(this._isSliding)return;const i=this._getActive(),n=t===at,s=e||b(this._getItems(),i,n,this._config.wrap);if(s===i)return;const o=this._getItemIndex(s),r=e=>N.trigger(this._element,e,{relatedTarget:s,direction:this._orderToDirection(t),from:this._getItemIndex(i),to:o});if(r(dt).defaultPrevented)return;if(!i||!s)return;const a=Boolean(this._interval);this.pause(),this._isSliding=!0,this._setActiveIndicatorElement(o),this._activeElement=s;const l=n?"carousel-item-start":"carousel-item-end",c=n?"carousel-item-next":"carousel-item-prev";s.classList.add(c),d(s),i.classList.add(l),s.classList.add(l),this._queueCallback((()=>{s.classList.remove(l,c),s.classList.add(yt),i.classList.remove(yt,c,l),this._isSliding=!1,r(ut)}),i,this._isAnimated()),a&&this.cycle()}_isAnimated(){return this._element.classList.contains("slide")}_getActive(){return z.findOne(Et,this._element)}_getItems(){return z.find(At,this._element)}_clearInterval(){this._interval&&(clearInterval(this._interval),this._interval=null)}_directionToOrder(t){return p()?t===ct?lt:at:t===ct?at:lt}_orderToDirection(t){return p()?t===lt?ct:ht:t===lt?ht:ct}static jQueryInterface(t){return this.each((function(){const e=xt.getOrCreateInstance(this,t);if("number"!=typeof t){if("string"==typeof t){if(void 0===e[t]||t.startsWith("_")||"constructor"===t)throw new TypeError(`No method named "${t}"`);e[t]()}}else e.to(t)}))}}N.on(document,bt,"[data-bs-slide], [data-bs-slide-to]",(function(t){const e=z.getElementFromSelector(this);if(!e||!e.classList.contains(vt))return;t.preventDefault();const i=xt.getOrCreateInstance(e),n=this.getAttribute("data-bs-slide-to");return n?(i.to(n),void i._maybeEnableCycle()):"next"===F.getDataAttribute(this,"slide")?(i.next(),void i._maybeEnableCycle()):(i.prev(),void i._maybeEnableCycle())})),N.on(window,_t,(()=>{const t=z.find('[data-bs-ride="carousel"]');for(const e of t)xt.getOrCreateInstance(e)})),m(xt);const kt=".bs.collapse",Lt=`show${kt}`,St=`shown${kt}`,Dt=`hide${kt}`,$t=`hidden${kt}`,It=`click${kt}.data-api`,Nt="show",Pt="collapse",Mt="collapsing",jt=`:scope .${Pt} .${Pt}`,Ft='[data-bs-toggle="collapse"]',Ht={parent:null,toggle:!0},Wt={parent:"(null|element)",toggle:"boolean"};class Bt extends W{constructor(t,e){super(t,e),this._isTransitioning=!1,this._triggerArray=[];const i=z.find(Ft);for(const t of i){const e=z.getSelectorFromElement(t),i=z.find(e).filter((t=>t===this._element));null!==e&&i.length&&this._triggerArray.push(t)}this._initializeChildren(),this._config.parent||this._addAriaAndCollapsedClass(this._triggerArray,this._isShown()),this._config.toggle&&this.toggle()}static get Default(){return Ht}static get DefaultType(){return Wt}static get NAME(){return"collapse"}toggle(){this._isShown()?this.hide():this.show()}show(){if(this._isTransitioning||this._isShown())return;let t=[];if(this._config.parent&&(t=this._getFirstLevelChildren(".collapse.show, .collapse.collapsing").filter((t=>t!==this._element)).map((t=>Bt.getOrCreateInstance(t,{toggle:!1})))),t.length&&t[0]._isTransitioning)return;if(N.trigger(this._element,Lt).defaultPrevented)return;for(const e of t)e.hide();const e=this._getDimension();this._element.classList.remove(Pt),this._element.classList.add(Mt),this._element.style[e]=0,this._addAriaAndCollapsedClass(this._triggerArray,!0),this._isTransitioning=!0;const i=`scroll${e[0].toUpperCase()+e.slice(1)}`;this._queueCallback((()=>{this._isTransitioning=!1,this._element.classList.remove(Mt),this._element.classList.add(Pt,Nt),this._element.style[e]="",N.trigger(this._element,St)}),this._element,!0),this._element.style[e]=`${this._element[i]}px`}hide(){if(this._isTransitioning||!this._isShown())return;if(N.trigger(this._element,Dt).defaultPrevented)return;const t=this._getDimension();this._element.style[t]=`${this._element.getBoundingClientRect()[t]}px`,d(this._element),this._element.classList.add(Mt),this._element.classList.remove(Pt,Nt);for(const t of this._triggerArray){const e=z.getElementFromSelector(t);e&&!this._isShown(e)&&this._addAriaAndCollapsedClass([t],!1)}this._isTransitioning=!0,this._element.style[t]="",this._queueCallback((()=>{this._isTransitioning=!1,this._element.classList.remove(Mt),this._element.classList.add(Pt),N.trigger(this._element,$t)}),this._element,!0)}_isShown(t=this._element){return t.classList.contains(Nt)}_configAfterMerge(t){return t.toggle=Boolean(t.toggle),t.parent=r(t.parent),t}_getDimension(){return this._element.classList.contains("collapse-horizontal")?"width":"height"}_initializeChildren(){if(!this._config.parent)return;const t=this._getFirstLevelChildren(Ft);for(const e of t){const t=z.getElementFromSelector(e);t&&this._addAriaAndCollapsedClass([e],this._isShown(t))}}_getFirstLevelChildren(t){const e=z.find(jt,this._config.parent);return z.find(t,this._config.parent).filter((t=>!e.includes(t)))}_addAriaAndCollapsedClass(t,e){if(t.length)for(const i of t)i.classList.toggle("collapsed",!e),i.setAttribute("aria-expanded",e)}static jQueryInterface(t){const e={};return"string"==typeof t&&/show|hide/.test(t)&&(e.toggle=!1),this.each((function(){const i=Bt.getOrCreateInstance(this,e);if("string"==typeof t){if(void 0===i[t])throw new TypeError(`No method named "${t}"`);i[t]()}}))}}N.on(document,It,Ft,(function(t){("A"===t.target.tagName||t.delegateTarget&&"A"===t.delegateTarget.tagName)&&t.preventDefault();for(const t of z.getMultipleElementsFromSelector(this))Bt.getOrCreateInstance(t,{toggle:!1}).toggle()})),m(Bt);var zt="top",Rt="bottom",qt="right",Vt="left",Kt="auto",Qt=[zt,Rt,qt,Vt],Xt="start",Yt="end",Ut="clippingParents",Gt="viewport",Jt="popper",Zt="reference",te=Qt.reduce((function(t,e){return t.concat([e+"-"+Xt,e+"-"+Yt])}),[]),ee=[].concat(Qt,[Kt]).reduce((function(t,e){return t.concat([e,e+"-"+Xt,e+"-"+Yt])}),[]),ie="beforeRead",ne="read",se="afterRead",oe="beforeMain",re="main",ae="afterMain",le="beforeWrite",ce="write",he="afterWrite",de=[ie,ne,se,oe,re,ae,le,ce,he];function ue(t){return t?(t.nodeName||"").toLowerCase():null}function fe(t){if(null==t)return window;if("[object Window]"!==t.toString()){var e=t.ownerDocument;return e&&e.defaultView||window}return t}function pe(t){return t instanceof fe(t).Element||t instanceof Element}function me(t){return t instanceof fe(t).HTMLElement||t instanceof HTMLElement}function ge(t){return"undefined"!=typeof ShadowRoot&&(t instanceof fe(t).ShadowRoot||t instanceof ShadowRoot)}const _e={name:"applyStyles",enabled:!0,phase:"write",fn:function(t){var e=t.state;Object.keys(e.elements).forEach((function(t){var i=e.styles[t]||{},n=e.attributes[t]||{},s=e.elements[t];me(s)&&ue(s)&&(Object.assign(s.style,i),Object.keys(n).forEach((function(t){var e=n[t];!1===e?s.removeAttribute(t):s.setAttribute(t,!0===e?"":e)})))}))},effect:function(t){var e=t.state,i={popper:{position:e.options.strategy,left:"0",top:"0",margin:"0"},arrow:{position:"absolute"},reference:{}};return Object.assign(e.elements.popper.style,i.popper),e.styles=i,e.elements.arrow&&Object.assign(e.elements.arrow.style,i.arrow),function(){Object.keys(e.elements).forEach((function(t){var n=e.elements[t],s=e.attributes[t]||{},o=Object.keys(e.styles.hasOwnProperty(t)?e.styles[t]:i[t]).reduce((function(t,e){return t[e]="",t}),{});me(n)&&ue(n)&&(Object.assign(n.style,o),Object.keys(s).forEach((function(t){n.removeAttribute(t)})))}))}},requires:["computeStyles"]};function be(t){return t.split("-")[0]}var ve=Math.max,ye=Math.min,we=Math.round;function Ae(){var t=navigator.userAgentData;return null!=t&&t.brands&&Array.isArray(t.brands)?t.brands.map((function(t){return t.brand+"/"+t.version})).join(" "):navigator.userAgent}function Ee(){return!/^((?!chrome|android).)*safari/i.test(Ae())}function Te(t,e,i){void 0===e&&(e=!1),void 0===i&&(i=!1);var n=t.getBoundingClientRect(),s=1,o=1;e&&me(t)&&(s=t.offsetWidth>0&&we(n.width)/t.offsetWidth||1,o=t.offsetHeight>0&&we(n.height)/t.offsetHeight||1);var r=(pe(t)?fe(t):window).visualViewport,a=!Ee()&&i,l=(n.left+(a&&r?r.offsetLeft:0))/s,c=(n.top+(a&&r?r.offsetTop:0))/o,h=n.width/s,d=n.height/o;return{width:h,height:d,top:c,right:l+h,bottom:c+d,left:l,x:l,y:c}}function Ce(t){var e=Te(t),i=t.offsetWidth,n=t.offsetHeight;return Math.abs(e.width-i)<=1&&(i=e.width),Math.abs(e.height-n)<=1&&(n=e.height),{x:t.offsetLeft,y:t.offsetTop,width:i,height:n}}function Oe(t,e){var i=e.getRootNode&&e.getRootNode();if(t.contains(e))return!0;if(i&&ge(i)){var n=e;do{if(n&&t.isSameNode(n))return!0;n=n.parentNode||n.host}while(n)}return!1}function xe(t){return fe(t).getComputedStyle(t)}function ke(t){return["table","td","th"].indexOf(ue(t))>=0}function Le(t){return((pe(t)?t.ownerDocument:t.document)||window.document).documentElement}function Se(t){return"html"===ue(t)?t:t.assignedSlot||t.parentNode||(ge(t)?t.host:null)||Le(t)}function De(t){return me(t)&&"fixed"!==xe(t).position?t.offsetParent:null}function $e(t){for(var e=fe(t),i=De(t);i&&ke(i)&&"static"===xe(i).position;)i=De(i);return i&&("html"===ue(i)||"body"===ue(i)&&"static"===xe(i).position)?e:i||function(t){var e=/firefox/i.test(Ae());if(/Trident/i.test(Ae())&&me(t)&&"fixed"===xe(t).position)return null;var i=Se(t);for(ge(i)&&(i=i.host);me(i)&&["html","body"].indexOf(ue(i))<0;){var n=xe(i);if("none"!==n.transform||"none"!==n.perspective||"paint"===n.contain||-1!==["transform","perspective"].indexOf(n.willChange)||e&&"filter"===n.willChange||e&&n.filter&&"none"!==n.filter)return i;i=i.parentNode}return null}(t)||e}function Ie(t){return["top","bottom"].indexOf(t)>=0?"x":"y"}function Ne(t,e,i){return ve(t,ye(e,i))}function Pe(t){return Object.assign({},{top:0,right:0,bottom:0,left:0},t)}function Me(t,e){return e.reduce((function(e,i){return e[i]=t,e}),{})}const je={name:"arrow",enabled:!0,phase:"main",fn:function(t){var e,i=t.state,n=t.name,s=t.options,o=i.elements.arrow,r=i.modifiersData.popperOffsets,a=be(i.placement),l=Ie(a),c=[Vt,qt].indexOf(a)>=0?"height":"width";if(o&&r){var h=function(t,e){return Pe("number"!=typeof(t="function"==typeof t?t(Object.assign({},e.rects,{placement:e.placement})):t)?t:Me(t,Qt))}(s.padding,i),d=Ce(o),u="y"===l?zt:Vt,f="y"===l?Rt:qt,p=i.rects.reference[c]+i.rects.reference[l]-r[l]-i.rects.popper[c],m=r[l]-i.rects.reference[l],g=$e(o),_=g?"y"===l?g.clientHeight||0:g.clientWidth||0:0,b=p/2-m/2,v=h[u],y=_-d[c]-h[f],w=_/2-d[c]/2+b,A=Ne(v,w,y),E=l;i.modifiersData[n]=((e={})[E]=A,e.centerOffset=A-w,e)}},effect:function(t){var e=t.state,i=t.options.element,n=void 0===i?"[data-popper-arrow]":i;null!=n&&("string"!=typeof n||(n=e.elements.popper.querySelector(n)))&&Oe(e.elements.popper,n)&&(e.elements.arrow=n)},requires:["popperOffsets"],requiresIfExists:["preventOverflow"]};function Fe(t){return t.split("-")[1]}var He={top:"auto",right:"auto",bottom:"auto",left:"auto"};function We(t){var e,i=t.popper,n=t.popperRect,s=t.placement,o=t.variation,r=t.offsets,a=t.position,l=t.gpuAcceleration,c=t.adaptive,h=t.roundOffsets,d=t.isFixed,u=r.x,f=void 0===u?0:u,p=r.y,m=void 0===p?0:p,g="function"==typeof h?h({x:f,y:m}):{x:f,y:m};f=g.x,m=g.y;var _=r.hasOwnProperty("x"),b=r.hasOwnProperty("y"),v=Vt,y=zt,w=window;if(c){var A=$e(i),E="clientHeight",T="clientWidth";A===fe(i)&&"static"!==xe(A=Le(i)).position&&"absolute"===a&&(E="scrollHeight",T="scrollWidth"),(s===zt||(s===Vt||s===qt)&&o===Yt)&&(y=Rt,m-=(d&&A===w&&w.visualViewport?w.visualViewport.height:A[E])-n.height,m*=l?1:-1),s!==Vt&&(s!==zt&&s!==Rt||o!==Yt)||(v=qt,f-=(d&&A===w&&w.visualViewport?w.visualViewport.width:A[T])-n.width,f*=l?1:-1)}var C,O=Object.assign({position:a},c&&He),x=!0===h?function(t,e){var i=t.x,n=t.y,s=e.devicePixelRatio||1;return{x:we(i*s)/s||0,y:we(n*s)/s||0}}({x:f,y:m},fe(i)):{x:f,y:m};return f=x.x,m=x.y,l?Object.assign({},O,((C={})[y]=b?"0":"",C[v]=_?"0":"",C.transform=(w.devicePixelRatio||1)<=1?"translate("+f+"px, "+m+"px)":"translate3d("+f+"px, "+m+"px, 0)",C)):Object.assign({},O,((e={})[y]=b?m+"px":"",e[v]=_?f+"px":"",e.transform="",e))}const Be={name:"computeStyles",enabled:!0,phase:"beforeWrite",fn:function(t){var e=t.state,i=t.options,n=i.gpuAcceleration,s=void 0===n||n,o=i.adaptive,r=void 0===o||o,a=i.roundOffsets,l=void 0===a||a,c={placement:be(e.placement),variation:Fe(e.placement),popper:e.elements.popper,popperRect:e.rects.popper,gpuAcceleration:s,isFixed:"fixed"===e.options.strategy};null!=e.modifiersData.popperOffsets&&(e.styles.popper=Object.assign({},e.styles.popper,We(Object.assign({},c,{offsets:e.modifiersData.popperOffsets,position:e.options.strategy,adaptive:r,roundOffsets:l})))),null!=e.modifiersData.arrow&&(e.styles.arrow=Object.assign({},e.styles.arrow,We(Object.assign({},c,{offsets:e.modifiersData.arrow,position:"absolute",adaptive:!1,roundOffsets:l})))),e.attributes.popper=Object.assign({},e.attributes.popper,{"data-popper-placement":e.placement})},data:{}};var ze={passive:!0};const Re={name:"eventListeners",enabled:!0,phase:"write",fn:function(){},effect:function(t){var e=t.state,i=t.instance,n=t.options,s=n.scroll,o=void 0===s||s,r=n.resize,a=void 0===r||r,l=fe(e.elements.popper),c=[].concat(e.scrollParents.reference,e.scrollParents.popper);return o&&c.forEach((function(t){t.addEventListener("scroll",i.update,ze)})),a&&l.addEventListener("resize",i.update,ze),function(){o&&c.forEach((function(t){t.removeEventListener("scroll",i.update,ze)})),a&&l.removeEventListener("resize",i.update,ze)}},data:{}};var qe={left:"right",right:"left",bottom:"top",top:"bottom"};function Ve(t){return t.replace(/left|right|bottom|top/g,(function(t){return qe[t]}))}var Ke={start:"end",end:"start"};function Qe(t){return t.replace(/start|end/g,(function(t){return Ke[t]}))}function Xe(t){var e=fe(t);return{scrollLeft:e.pageXOffset,scrollTop:e.pageYOffset}}function Ye(t){return Te(Le(t)).left+Xe(t).scrollLeft}function Ue(t){var e=xe(t),i=e.overflow,n=e.overflowX,s=e.overflowY;return/auto|scroll|overlay|hidden/.test(i+s+n)}function Ge(t){return["html","body","#document"].indexOf(ue(t))>=0?t.ownerDocument.body:me(t)&&Ue(t)?t:Ge(Se(t))}function Je(t,e){var i;void 0===e&&(e=[]);var n=Ge(t),s=n===(null==(i=t.ownerDocument)?void 0:i.body),o=fe(n),r=s?[o].concat(o.visualViewport||[],Ue(n)?n:[]):n,a=e.concat(r);return s?a:a.concat(Je(Se(r)))}function Ze(t){return Object.assign({},t,{left:t.x,top:t.y,right:t.x+t.width,bottom:t.y+t.height})}function ti(t,e,i){return e===Gt?Ze(function(t,e){var i=fe(t),n=Le(t),s=i.visualViewport,o=n.clientWidth,r=n.clientHeight,a=0,l=0;if(s){o=s.width,r=s.height;var c=Ee();(c||!c&&"fixed"===e)&&(a=s.offsetLeft,l=s.offsetTop)}return{width:o,height:r,x:a+Ye(t),y:l}}(t,i)):pe(e)?function(t,e){var i=Te(t,!1,"fixed"===e);return i.top=i.top+t.clientTop,i.left=i.left+t.clientLeft,i.bottom=i.top+t.clientHeight,i.right=i.left+t.clientWidth,i.width=t.clientWidth,i.height=t.clientHeight,i.x=i.left,i.y=i.top,i}(e,i):Ze(function(t){var e,i=Le(t),n=Xe(t),s=null==(e=t.ownerDocument)?void 0:e.body,o=ve(i.scrollWidth,i.clientWidth,s?s.scrollWidth:0,s?s.clientWidth:0),r=ve(i.scrollHeight,i.clientHeight,s?s.scrollHeight:0,s?s.clientHeight:0),a=-n.scrollLeft+Ye(t),l=-n.scrollTop;return"rtl"===xe(s||i).direction&&(a+=ve(i.clientWidth,s?s.clientWidth:0)-o),{width:o,height:r,x:a,y:l}}(Le(t)))}function ei(t){var e,i=t.reference,n=t.element,s=t.placement,o=s?be(s):null,r=s?Fe(s):null,a=i.x+i.width/2-n.width/2,l=i.y+i.height/2-n.height/2;switch(o){case zt:e={x:a,y:i.y-n.height};break;case Rt:e={x:a,y:i.y+i.height};break;case qt:e={x:i.x+i.width,y:l};break;case Vt:e={x:i.x-n.width,y:l};break;default:e={x:i.x,y:i.y}}var c=o?Ie(o):null;if(null!=c){var h="y"===c?"height":"width";switch(r){case Xt:e[c]=e[c]-(i[h]/2-n[h]/2);break;case Yt:e[c]=e[c]+(i[h]/2-n[h]/2)}}return e}function ii(t,e){void 0===e&&(e={});var i=e,n=i.placement,s=void 0===n?t.placement:n,o=i.strategy,r=void 0===o?t.strategy:o,a=i.boundary,l=void 0===a?Ut:a,c=i.rootBoundary,h=void 0===c?Gt:c,d=i.elementContext,u=void 0===d?Jt:d,f=i.altBoundary,p=void 0!==f&&f,m=i.padding,g=void 0===m?0:m,_=Pe("number"!=typeof g?g:Me(g,Qt)),b=u===Jt?Zt:Jt,v=t.rects.popper,y=t.elements[p?b:u],w=function(t,e,i,n){var s="clippingParents"===e?function(t){var e=Je(Se(t)),i=["absolute","fixed"].indexOf(xe(t).position)>=0&&me(t)?$e(t):t;return pe(i)?e.filter((function(t){return pe(t)&&Oe(t,i)&&"body"!==ue(t)})):[]}(t):[].concat(e),o=[].concat(s,[i]),r=o[0],a=o.reduce((function(e,i){var s=ti(t,i,n);return e.top=ve(s.top,e.top),e.right=ye(s.right,e.right),e.bottom=ye(s.bottom,e.bottom),e.left=ve(s.left,e.left),e}),ti(t,r,n));return a.width=a.right-a.left,a.height=a.bottom-a.top,a.x=a.left,a.y=a.top,a}(pe(y)?y:y.contextElement||Le(t.elements.popper),l,h,r),A=Te(t.elements.reference),E=ei({reference:A,element:v,strategy:"absolute",placement:s}),T=Ze(Object.assign({},v,E)),C=u===Jt?T:A,O={top:w.top-C.top+_.top,bottom:C.bottom-w.bottom+_.bottom,left:w.left-C.left+_.left,right:C.right-w.right+_.right},x=t.modifiersData.offset;if(u===Jt&&x){var k=x[s];Object.keys(O).forEach((function(t){var e=[qt,Rt].indexOf(t)>=0?1:-1,i=[zt,Rt].indexOf(t)>=0?"y":"x";O[t]+=k[i]*e}))}return O}function ni(t,e){void 0===e&&(e={});var i=e,n=i.placement,s=i.boundary,o=i.rootBoundary,r=i.padding,a=i.flipVariations,l=i.allowedAutoPlacements,c=void 0===l?ee:l,h=Fe(n),d=h?a?te:te.filter((function(t){return Fe(t)===h})):Qt,u=d.filter((function(t){return c.indexOf(t)>=0}));0===u.length&&(u=d);var f=u.reduce((function(e,i){return e[i]=ii(t,{placement:i,boundary:s,rootBoundary:o,padding:r})[be(i)],e}),{});return Object.keys(f).sort((function(t,e){return f[t]-f[e]}))}const si={name:"flip",enabled:!0,phase:"main",fn:function(t){var e=t.state,i=t.options,n=t.name;if(!e.modifiersData[n]._skip){for(var s=i.mainAxis,o=void 0===s||s,r=i.altAxis,a=void 0===r||r,l=i.fallbackPlacements,c=i.padding,h=i.boundary,d=i.rootBoundary,u=i.altBoundary,f=i.flipVariations,p=void 0===f||f,m=i.allowedAutoPlacements,g=e.options.placement,_=be(g),b=l||(_!==g&&p?function(t){if(be(t)===Kt)return[];var e=Ve(t);return[Qe(t),e,Qe(e)]}(g):[Ve(g)]),v=[g].concat(b).reduce((function(t,i){return t.concat(be(i)===Kt?ni(e,{placement:i,boundary:h,rootBoundary:d,padding:c,flipVariations:p,allowedAutoPlacements:m}):i)}),[]),y=e.rects.reference,w=e.rects.popper,A=new Map,E=!0,T=v[0],C=0;C=0,S=L?"width":"height",D=ii(e,{placement:O,boundary:h,rootBoundary:d,altBoundary:u,padding:c}),$=L?k?qt:Vt:k?Rt:zt;y[S]>w[S]&&($=Ve($));var I=Ve($),N=[];if(o&&N.push(D[x]<=0),a&&N.push(D[$]<=0,D[I]<=0),N.every((function(t){return t}))){T=O,E=!1;break}A.set(O,N)}if(E)for(var P=function(t){var e=v.find((function(e){var i=A.get(e);if(i)return i.slice(0,t).every((function(t){return t}))}));if(e)return T=e,"break"},M=p?3:1;M>0&&"break"!==P(M);M--);e.placement!==T&&(e.modifiersData[n]._skip=!0,e.placement=T,e.reset=!0)}},requiresIfExists:["offset"],data:{_skip:!1}};function oi(t,e,i){return void 0===i&&(i={x:0,y:0}),{top:t.top-e.height-i.y,right:t.right-e.width+i.x,bottom:t.bottom-e.height+i.y,left:t.left-e.width-i.x}}function ri(t){return[zt,qt,Rt,Vt].some((function(e){return t[e]>=0}))}const ai={name:"hide",enabled:!0,phase:"main",requiresIfExists:["preventOverflow"],fn:function(t){var e=t.state,i=t.name,n=e.rects.reference,s=e.rects.popper,o=e.modifiersData.preventOverflow,r=ii(e,{elementContext:"reference"}),a=ii(e,{altBoundary:!0}),l=oi(r,n),c=oi(a,s,o),h=ri(l),d=ri(c);e.modifiersData[i]={referenceClippingOffsets:l,popperEscapeOffsets:c,isReferenceHidden:h,hasPopperEscaped:d},e.attributes.popper=Object.assign({},e.attributes.popper,{"data-popper-reference-hidden":h,"data-popper-escaped":d})}},li={name:"offset",enabled:!0,phase:"main",requires:["popperOffsets"],fn:function(t){var e=t.state,i=t.options,n=t.name,s=i.offset,o=void 0===s?[0,0]:s,r=ee.reduce((function(t,i){return t[i]=function(t,e,i){var n=be(t),s=[Vt,zt].indexOf(n)>=0?-1:1,o="function"==typeof i?i(Object.assign({},e,{placement:t})):i,r=o[0],a=o[1];return r=r||0,a=(a||0)*s,[Vt,qt].indexOf(n)>=0?{x:a,y:r}:{x:r,y:a}}(i,e.rects,o),t}),{}),a=r[e.placement],l=a.x,c=a.y;null!=e.modifiersData.popperOffsets&&(e.modifiersData.popperOffsets.x+=l,e.modifiersData.popperOffsets.y+=c),e.modifiersData[n]=r}},ci={name:"popperOffsets",enabled:!0,phase:"read",fn:function(t){var e=t.state,i=t.name;e.modifiersData[i]=ei({reference:e.rects.reference,element:e.rects.popper,strategy:"absolute",placement:e.placement})},data:{}},hi={name:"preventOverflow",enabled:!0,phase:"main",fn:function(t){var e=t.state,i=t.options,n=t.name,s=i.mainAxis,o=void 0===s||s,r=i.altAxis,a=void 0!==r&&r,l=i.boundary,c=i.rootBoundary,h=i.altBoundary,d=i.padding,u=i.tether,f=void 0===u||u,p=i.tetherOffset,m=void 0===p?0:p,g=ii(e,{boundary:l,rootBoundary:c,padding:d,altBoundary:h}),_=be(e.placement),b=Fe(e.placement),v=!b,y=Ie(_),w="x"===y?"y":"x",A=e.modifiersData.popperOffsets,E=e.rects.reference,T=e.rects.popper,C="function"==typeof m?m(Object.assign({},e.rects,{placement:e.placement})):m,O="number"==typeof C?{mainAxis:C,altAxis:C}:Object.assign({mainAxis:0,altAxis:0},C),x=e.modifiersData.offset?e.modifiersData.offset[e.placement]:null,k={x:0,y:0};if(A){if(o){var L,S="y"===y?zt:Vt,D="y"===y?Rt:qt,$="y"===y?"height":"width",I=A[y],N=I+g[S],P=I-g[D],M=f?-T[$]/2:0,j=b===Xt?E[$]:T[$],F=b===Xt?-T[$]:-E[$],H=e.elements.arrow,W=f&&H?Ce(H):{width:0,height:0},B=e.modifiersData["arrow#persistent"]?e.modifiersData["arrow#persistent"].padding:{top:0,right:0,bottom:0,left:0},z=B[S],R=B[D],q=Ne(0,E[$],W[$]),V=v?E[$]/2-M-q-z-O.mainAxis:j-q-z-O.mainAxis,K=v?-E[$]/2+M+q+R+O.mainAxis:F+q+R+O.mainAxis,Q=e.elements.arrow&&$e(e.elements.arrow),X=Q?"y"===y?Q.clientTop||0:Q.clientLeft||0:0,Y=null!=(L=null==x?void 0:x[y])?L:0,U=I+K-Y,G=Ne(f?ye(N,I+V-Y-X):N,I,f?ve(P,U):P);A[y]=G,k[y]=G-I}if(a){var J,Z="x"===y?zt:Vt,tt="x"===y?Rt:qt,et=A[w],it="y"===w?"height":"width",nt=et+g[Z],st=et-g[tt],ot=-1!==[zt,Vt].indexOf(_),rt=null!=(J=null==x?void 0:x[w])?J:0,at=ot?nt:et-E[it]-T[it]-rt+O.altAxis,lt=ot?et+E[it]+T[it]-rt-O.altAxis:st,ct=f&&ot?function(t,e,i){var n=Ne(t,e,i);return n>i?i:n}(at,et,lt):Ne(f?at:nt,et,f?lt:st);A[w]=ct,k[w]=ct-et}e.modifiersData[n]=k}},requiresIfExists:["offset"]};function di(t,e,i){void 0===i&&(i=!1);var n,s,o=me(e),r=me(e)&&function(t){var e=t.getBoundingClientRect(),i=we(e.width)/t.offsetWidth||1,n=we(e.height)/t.offsetHeight||1;return 1!==i||1!==n}(e),a=Le(e),l=Te(t,r,i),c={scrollLeft:0,scrollTop:0},h={x:0,y:0};return(o||!o&&!i)&&(("body"!==ue(e)||Ue(a))&&(c=(n=e)!==fe(n)&&me(n)?{scrollLeft:(s=n).scrollLeft,scrollTop:s.scrollTop}:Xe(n)),me(e)?((h=Te(e,!0)).x+=e.clientLeft,h.y+=e.clientTop):a&&(h.x=Ye(a))),{x:l.left+c.scrollLeft-h.x,y:l.top+c.scrollTop-h.y,width:l.width,height:l.height}}function ui(t){var e=new Map,i=new Set,n=[];function s(t){i.add(t.name),[].concat(t.requires||[],t.requiresIfExists||[]).forEach((function(t){if(!i.has(t)){var n=e.get(t);n&&s(n)}})),n.push(t)}return t.forEach((function(t){e.set(t.name,t)})),t.forEach((function(t){i.has(t.name)||s(t)})),n}var fi={placement:"bottom",modifiers:[],strategy:"absolute"};function pi(){for(var t=arguments.length,e=new Array(t),i=0;iNumber.parseInt(t,10))):"function"==typeof t?e=>t(e,this._element):t}_getPopperConfig(){const t={placement:this._getPlacement(),modifiers:[{name:"preventOverflow",options:{boundary:this._config.boundary}},{name:"offset",options:{offset:this._getOffset()}}]};return(this._inNavbar||"static"===this._config.display)&&(F.setDataAttribute(this._menu,"popper","static"),t.modifiers=[{name:"applyStyles",enabled:!1}]),{...t,...g(this._config.popperConfig,[t])}}_selectMenuItem({key:t,target:e}){const i=z.find(".dropdown-menu .dropdown-item:not(.disabled):not(:disabled)",this._menu).filter((t=>a(t)));i.length&&b(i,e,t===Ti,!i.includes(e)).focus()}static jQueryInterface(t){return this.each((function(){const e=qi.getOrCreateInstance(this,t);if("string"==typeof t){if(void 0===e[t])throw new TypeError(`No method named "${t}"`);e[t]()}}))}static clearMenus(t){if(2===t.button||"keyup"===t.type&&"Tab"!==t.key)return;const e=z.find(Ni);for(const i of e){const e=qi.getInstance(i);if(!e||!1===e._config.autoClose)continue;const n=t.composedPath(),s=n.includes(e._menu);if(n.includes(e._element)||"inside"===e._config.autoClose&&!s||"outside"===e._config.autoClose&&s)continue;if(e._menu.contains(t.target)&&("keyup"===t.type&&"Tab"===t.key||/input|select|option|textarea|form/i.test(t.target.tagName)))continue;const o={relatedTarget:e._element};"click"===t.type&&(o.clickEvent=t),e._completeHide(o)}}static dataApiKeydownHandler(t){const e=/input|textarea/i.test(t.target.tagName),i="Escape"===t.key,n=[Ei,Ti].includes(t.key);if(!n&&!i)return;if(e&&!i)return;t.preventDefault();const s=this.matches(Ii)?this:z.prev(this,Ii)[0]||z.next(this,Ii)[0]||z.findOne(Ii,t.delegateTarget.parentNode),o=qi.getOrCreateInstance(s);if(n)return t.stopPropagation(),o.show(),void o._selectMenuItem(t);o._isShown()&&(t.stopPropagation(),o.hide(),s.focus())}}N.on(document,Si,Ii,qi.dataApiKeydownHandler),N.on(document,Si,Pi,qi.dataApiKeydownHandler),N.on(document,Li,qi.clearMenus),N.on(document,Di,qi.clearMenus),N.on(document,Li,Ii,(function(t){t.preventDefault(),qi.getOrCreateInstance(this).toggle()})),m(qi);const Vi="backdrop",Ki="show",Qi=`mousedown.bs.${Vi}`,Xi={className:"modal-backdrop",clickCallback:null,isAnimated:!1,isVisible:!0,rootElement:"body"},Yi={className:"string",clickCallback:"(function|null)",isAnimated:"boolean",isVisible:"boolean",rootElement:"(element|string)"};class Ui extends H{constructor(t){super(),this._config=this._getConfig(t),this._isAppended=!1,this._element=null}static get Default(){return Xi}static get DefaultType(){return Yi}static get NAME(){return Vi}show(t){if(!this._config.isVisible)return void g(t);this._append();const e=this._getElement();this._config.isAnimated&&d(e),e.classList.add(Ki),this._emulateAnimation((()=>{g(t)}))}hide(t){this._config.isVisible?(this._getElement().classList.remove(Ki),this._emulateAnimation((()=>{this.dispose(),g(t)}))):g(t)}dispose(){this._isAppended&&(N.off(this._element,Qi),this._element.remove(),this._isAppended=!1)}_getElement(){if(!this._element){const t=document.createElement("div");t.className=this._config.className,this._config.isAnimated&&t.classList.add("fade"),this._element=t}return this._element}_configAfterMerge(t){return t.rootElement=r(t.rootElement),t}_append(){if(this._isAppended)return;const t=this._getElement();this._config.rootElement.append(t),N.on(t,Qi,(()=>{g(this._config.clickCallback)})),this._isAppended=!0}_emulateAnimation(t){_(t,this._getElement(),this._config.isAnimated)}}const Gi=".bs.focustrap",Ji=`focusin${Gi}`,Zi=`keydown.tab${Gi}`,tn="backward",en={autofocus:!0,trapElement:null},nn={autofocus:"boolean",trapElement:"element"};class sn extends H{constructor(t){super(),this._config=this._getConfig(t),this._isActive=!1,this._lastTabNavDirection=null}static get Default(){return en}static get DefaultType(){return nn}static get NAME(){return"focustrap"}activate(){this._isActive||(this._config.autofocus&&this._config.trapElement.focus(),N.off(document,Gi),N.on(document,Ji,(t=>this._handleFocusin(t))),N.on(document,Zi,(t=>this._handleKeydown(t))),this._isActive=!0)}deactivate(){this._isActive&&(this._isActive=!1,N.off(document,Gi))}_handleFocusin(t){const{trapElement:e}=this._config;if(t.target===document||t.target===e||e.contains(t.target))return;const i=z.focusableChildren(e);0===i.length?e.focus():this._lastTabNavDirection===tn?i[i.length-1].focus():i[0].focus()}_handleKeydown(t){"Tab"===t.key&&(this._lastTabNavDirection=t.shiftKey?tn:"forward")}}const on=".fixed-top, .fixed-bottom, .is-fixed, .sticky-top",rn=".sticky-top",an="padding-right",ln="margin-right";class cn{constructor(){this._element=document.body}getWidth(){const t=document.documentElement.clientWidth;return Math.abs(window.innerWidth-t)}hide(){const t=this.getWidth();this._disableOverFlow(),this._setElementAttributes(this._element,an,(e=>e+t)),this._setElementAttributes(on,an,(e=>e+t)),this._setElementAttributes(rn,ln,(e=>e-t))}reset(){this._resetElementAttributes(this._element,"overflow"),this._resetElementAttributes(this._element,an),this._resetElementAttributes(on,an),this._resetElementAttributes(rn,ln)}isOverflowing(){return this.getWidth()>0}_disableOverFlow(){this._saveInitialAttribute(this._element,"overflow"),this._element.style.overflow="hidden"}_setElementAttributes(t,e,i){const n=this.getWidth();this._applyManipulationCallback(t,(t=>{if(t!==this._element&&window.innerWidth>t.clientWidth+n)return;this._saveInitialAttribute(t,e);const s=window.getComputedStyle(t).getPropertyValue(e);t.style.setProperty(e,`${i(Number.parseFloat(s))}px`)}))}_saveInitialAttribute(t,e){const i=t.style.getPropertyValue(e);i&&F.setDataAttribute(t,e,i)}_resetElementAttributes(t,e){this._applyManipulationCallback(t,(t=>{const i=F.getDataAttribute(t,e);null!==i?(F.removeDataAttribute(t,e),t.style.setProperty(e,i)):t.style.removeProperty(e)}))}_applyManipulationCallback(t,e){if(o(t))e(t);else for(const i of z.find(t,this._element))e(i)}}const hn=".bs.modal",dn=`hide${hn}`,un=`hidePrevented${hn}`,fn=`hidden${hn}`,pn=`show${hn}`,mn=`shown${hn}`,gn=`resize${hn}`,_n=`click.dismiss${hn}`,bn=`mousedown.dismiss${hn}`,vn=`keydown.dismiss${hn}`,yn=`click${hn}.data-api`,wn="modal-open",An="show",En="modal-static",Tn={backdrop:!0,focus:!0,keyboard:!0},Cn={backdrop:"(boolean|string)",focus:"boolean",keyboard:"boolean"};class On extends W{constructor(t,e){super(t,e),this._dialog=z.findOne(".modal-dialog",this._element),this._backdrop=this._initializeBackDrop(),this._focustrap=this._initializeFocusTrap(),this._isShown=!1,this._isTransitioning=!1,this._scrollBar=new cn,this._addEventListeners()}static get Default(){return Tn}static get DefaultType(){return Cn}static get NAME(){return"modal"}toggle(t){return this._isShown?this.hide():this.show(t)}show(t){this._isShown||this._isTransitioning||N.trigger(this._element,pn,{relatedTarget:t}).defaultPrevented||(this._isShown=!0,this._isTransitioning=!0,this._scrollBar.hide(),document.body.classList.add(wn),this._adjustDialog(),this._backdrop.show((()=>this._showElement(t))))}hide(){this._isShown&&!this._isTransitioning&&(N.trigger(this._element,dn).defaultPrevented||(this._isShown=!1,this._isTransitioning=!0,this._focustrap.deactivate(),this._element.classList.remove(An),this._queueCallback((()=>this._hideModal()),this._element,this._isAnimated())))}dispose(){N.off(window,hn),N.off(this._dialog,hn),this._backdrop.dispose(),this._focustrap.deactivate(),super.dispose()}handleUpdate(){this._adjustDialog()}_initializeBackDrop(){return new Ui({isVisible:Boolean(this._config.backdrop),isAnimated:this._isAnimated()})}_initializeFocusTrap(){return new sn({trapElement:this._element})}_showElement(t){document.body.contains(this._element)||document.body.append(this._element),this._element.style.display="block",this._element.removeAttribute("aria-hidden"),this._element.setAttribute("aria-modal",!0),this._element.setAttribute("role","dialog"),this._element.scrollTop=0;const e=z.findOne(".modal-body",this._dialog);e&&(e.scrollTop=0),d(this._element),this._element.classList.add(An),this._queueCallback((()=>{this._config.focus&&this._focustrap.activate(),this._isTransitioning=!1,N.trigger(this._element,mn,{relatedTarget:t})}),this._dialog,this._isAnimated())}_addEventListeners(){N.on(this._element,vn,(t=>{"Escape"===t.key&&(this._config.keyboard?this.hide():this._triggerBackdropTransition())})),N.on(window,gn,(()=>{this._isShown&&!this._isTransitioning&&this._adjustDialog()})),N.on(this._element,bn,(t=>{N.one(this._element,_n,(e=>{this._element===t.target&&this._element===e.target&&("static"!==this._config.backdrop?this._config.backdrop&&this.hide():this._triggerBackdropTransition())}))}))}_hideModal(){this._element.style.display="none",this._element.setAttribute("aria-hidden",!0),this._element.removeAttribute("aria-modal"),this._element.removeAttribute("role"),this._isTransitioning=!1,this._backdrop.hide((()=>{document.body.classList.remove(wn),this._resetAdjustments(),this._scrollBar.reset(),N.trigger(this._element,fn)}))}_isAnimated(){return this._element.classList.contains("fade")}_triggerBackdropTransition(){if(N.trigger(this._element,un).defaultPrevented)return;const t=this._element.scrollHeight>document.documentElement.clientHeight,e=this._element.style.overflowY;"hidden"===e||this._element.classList.contains(En)||(t||(this._element.style.overflowY="hidden"),this._element.classList.add(En),this._queueCallback((()=>{this._element.classList.remove(En),this._queueCallback((()=>{this._element.style.overflowY=e}),this._dialog)}),this._dialog),this._element.focus())}_adjustDialog(){const t=this._element.scrollHeight>document.documentElement.clientHeight,e=this._scrollBar.getWidth(),i=e>0;if(i&&!t){const t=p()?"paddingLeft":"paddingRight";this._element.style[t]=`${e}px`}if(!i&&t){const t=p()?"paddingRight":"paddingLeft";this._element.style[t]=`${e}px`}}_resetAdjustments(){this._element.style.paddingLeft="",this._element.style.paddingRight=""}static jQueryInterface(t,e){return this.each((function(){const i=On.getOrCreateInstance(this,t);if("string"==typeof t){if(void 0===i[t])throw new TypeError(`No method named "${t}"`);i[t](e)}}))}}N.on(document,yn,'[data-bs-toggle="modal"]',(function(t){const e=z.getElementFromSelector(this);["A","AREA"].includes(this.tagName)&&t.preventDefault(),N.one(e,pn,(t=>{t.defaultPrevented||N.one(e,fn,(()=>{a(this)&&this.focus()}))}));const i=z.findOne(".modal.show");i&&On.getInstance(i).hide(),On.getOrCreateInstance(e).toggle(this)})),R(On),m(On);const xn=".bs.offcanvas",kn=".data-api",Ln=`load${xn}${kn}`,Sn="show",Dn="showing",$n="hiding",In=".offcanvas.show",Nn=`show${xn}`,Pn=`shown${xn}`,Mn=`hide${xn}`,jn=`hidePrevented${xn}`,Fn=`hidden${xn}`,Hn=`resize${xn}`,Wn=`click${xn}${kn}`,Bn=`keydown.dismiss${xn}`,zn={backdrop:!0,keyboard:!0,scroll:!1},Rn={backdrop:"(boolean|string)",keyboard:"boolean",scroll:"boolean"};class qn extends W{constructor(t,e){super(t,e),this._isShown=!1,this._backdrop=this._initializeBackDrop(),this._focustrap=this._initializeFocusTrap(),this._addEventListeners()}static get Default(){return zn}static get DefaultType(){return Rn}static get NAME(){return"offcanvas"}toggle(t){return this._isShown?this.hide():this.show(t)}show(t){this._isShown||N.trigger(this._element,Nn,{relatedTarget:t}).defaultPrevented||(this._isShown=!0,this._backdrop.show(),this._config.scroll||(new cn).hide(),this._element.setAttribute("aria-modal",!0),this._element.setAttribute("role","dialog"),this._element.classList.add(Dn),this._queueCallback((()=>{this._config.scroll&&!this._config.backdrop||this._focustrap.activate(),this._element.classList.add(Sn),this._element.classList.remove(Dn),N.trigger(this._element,Pn,{relatedTarget:t})}),this._element,!0))}hide(){this._isShown&&(N.trigger(this._element,Mn).defaultPrevented||(this._focustrap.deactivate(),this._element.blur(),this._isShown=!1,this._element.classList.add($n),this._backdrop.hide(),this._queueCallback((()=>{this._element.classList.remove(Sn,$n),this._element.removeAttribute("aria-modal"),this._element.removeAttribute("role"),this._config.scroll||(new cn).reset(),N.trigger(this._element,Fn)}),this._element,!0)))}dispose(){this._backdrop.dispose(),this._focustrap.deactivate(),super.dispose()}_initializeBackDrop(){const t=Boolean(this._config.backdrop);return new Ui({className:"offcanvas-backdrop",isVisible:t,isAnimated:!0,rootElement:this._element.parentNode,clickCallback:t?()=>{"static"!==this._config.backdrop?this.hide():N.trigger(this._element,jn)}:null})}_initializeFocusTrap(){return new sn({trapElement:this._element})}_addEventListeners(){N.on(this._element,Bn,(t=>{"Escape"===t.key&&(this._config.keyboard?this.hide():N.trigger(this._element,jn))}))}static jQueryInterface(t){return this.each((function(){const e=qn.getOrCreateInstance(this,t);if("string"==typeof t){if(void 0===e[t]||t.startsWith("_")||"constructor"===t)throw new TypeError(`No method named "${t}"`);e[t](this)}}))}}N.on(document,Wn,'[data-bs-toggle="offcanvas"]',(function(t){const e=z.getElementFromSelector(this);if(["A","AREA"].includes(this.tagName)&&t.preventDefault(),l(this))return;N.one(e,Fn,(()=>{a(this)&&this.focus()}));const i=z.findOne(In);i&&i!==e&&qn.getInstance(i).hide(),qn.getOrCreateInstance(e).toggle(this)})),N.on(window,Ln,(()=>{for(const t of z.find(In))qn.getOrCreateInstance(t).show()})),N.on(window,Hn,(()=>{for(const t of z.find("[aria-modal][class*=show][class*=offcanvas-]"))"fixed"!==getComputedStyle(t).position&&qn.getOrCreateInstance(t).hide()})),R(qn),m(qn);const Vn={"*":["class","dir","id","lang","role",/^aria-[\w-]*$/i],a:["target","href","title","rel"],area:[],b:[],br:[],col:[],code:[],div:[],em:[],hr:[],h1:[],h2:[],h3:[],h4:[],h5:[],h6:[],i:[],img:["src","srcset","alt","title","width","height"],li:[],ol:[],p:[],pre:[],s:[],small:[],span:[],sub:[],sup:[],strong:[],u:[],ul:[]},Kn=new Set(["background","cite","href","itemtype","longdesc","poster","src","xlink:href"]),Qn=/^(?!javascript:)(?:[a-z0-9+.-]+:|[^&:/?#]*(?:[/?#]|$))/i,Xn=(t,e)=>{const i=t.nodeName.toLowerCase();return e.includes(i)?!Kn.has(i)||Boolean(Qn.test(t.nodeValue)):e.filter((t=>t instanceof RegExp)).some((t=>t.test(i)))},Yn={allowList:Vn,content:{},extraClass:"",html:!1,sanitize:!0,sanitizeFn:null,template:"
"},Un={allowList:"object",content:"object",extraClass:"(string|function)",html:"boolean",sanitize:"boolean",sanitizeFn:"(null|function)",template:"string"},Gn={entry:"(string|element|function|null)",selector:"(string|element)"};class Jn extends H{constructor(t){super(),this._config=this._getConfig(t)}static get Default(){return Yn}static get DefaultType(){return Un}static get NAME(){return"TemplateFactory"}getContent(){return Object.values(this._config.content).map((t=>this._resolvePossibleFunction(t))).filter(Boolean)}hasContent(){return this.getContent().length>0}changeContent(t){return this._checkContent(t),this._config.content={...this._config.content,...t},this}toHtml(){const t=document.createElement("div");t.innerHTML=this._maybeSanitize(this._config.template);for(const[e,i]of Object.entries(this._config.content))this._setContent(t,i,e);const e=t.children[0],i=this._resolvePossibleFunction(this._config.extraClass);return i&&e.classList.add(...i.split(" ")),e}_typeCheckConfig(t){super._typeCheckConfig(t),this._checkContent(t.content)}_checkContent(t){for(const[e,i]of Object.entries(t))super._typeCheckConfig({selector:e,entry:i},Gn)}_setContent(t,e,i){const n=z.findOne(i,t);n&&((e=this._resolvePossibleFunction(e))?o(e)?this._putElementInTemplate(r(e),n):this._config.html?n.innerHTML=this._maybeSanitize(e):n.textContent=e:n.remove())}_maybeSanitize(t){return this._config.sanitize?function(t,e,i){if(!t.length)return t;if(i&&"function"==typeof i)return i(t);const n=(new window.DOMParser).parseFromString(t,"text/html"),s=[].concat(...n.body.querySelectorAll("*"));for(const t of s){const i=t.nodeName.toLowerCase();if(!Object.keys(e).includes(i)){t.remove();continue}const n=[].concat(...t.attributes),s=[].concat(e["*"]||[],e[i]||[]);for(const e of n)Xn(e,s)||t.removeAttribute(e.nodeName)}return n.body.innerHTML}(t,this._config.allowList,this._config.sanitizeFn):t}_resolvePossibleFunction(t){return g(t,[this])}_putElementInTemplate(t,e){if(this._config.html)return e.innerHTML="",void e.append(t);e.textContent=t.textContent}}const Zn=new Set(["sanitize","allowList","sanitizeFn"]),ts="fade",es="show",is=".modal",ns="hide.bs.modal",ss="hover",os="focus",rs={AUTO:"auto",TOP:"top",RIGHT:p()?"left":"right",BOTTOM:"bottom",LEFT:p()?"right":"left"},as={allowList:Vn,animation:!0,boundary:"clippingParents",container:!1,customClass:"",delay:0,fallbackPlacements:["top","right","bottom","left"],html:!1,offset:[0,6],placement:"top",popperConfig:null,sanitize:!0,sanitizeFn:null,selector:!1,template:'',title:"",trigger:"hover focus"},ls={allowList:"object",animation:"boolean",boundary:"(string|element)",container:"(string|element|boolean)",customClass:"(string|function)",delay:"(number|object)",fallbackPlacements:"array",html:"boolean",offset:"(array|string|function)",placement:"(string|function)",popperConfig:"(null|object|function)",sanitize:"boolean",sanitizeFn:"(null|function)",selector:"(string|boolean)",template:"string",title:"(string|element|function)",trigger:"string"};class cs extends W{constructor(t,e){if(void 0===vi)throw new TypeError("Bootstrap's tooltips require Popper (https://popper.js.org)");super(t,e),this._isEnabled=!0,this._timeout=0,this._isHovered=null,this._activeTrigger={},this._popper=null,this._templateFactory=null,this._newContent=null,this.tip=null,this._setListeners(),this._config.selector||this._fixTitle()}static get Default(){return as}static get DefaultType(){return ls}static get NAME(){return"tooltip"}enable(){this._isEnabled=!0}disable(){this._isEnabled=!1}toggleEnabled(){this._isEnabled=!this._isEnabled}toggle(){this._isEnabled&&(this._activeTrigger.click=!this._activeTrigger.click,this._isShown()?this._leave():this._enter())}dispose(){clearTimeout(this._timeout),N.off(this._element.closest(is),ns,this._hideModalHandler),this._element.getAttribute("data-bs-original-title")&&this._element.setAttribute("title",this._element.getAttribute("data-bs-original-title")),this._disposePopper(),super.dispose()}show(){if("none"===this._element.style.display)throw new Error("Please use show on visible elements");if(!this._isWithContent()||!this._isEnabled)return;const t=N.trigger(this._element,this.constructor.eventName("show")),e=(c(this._element)||this._element.ownerDocument.documentElement).contains(this._element);if(t.defaultPrevented||!e)return;this._disposePopper();const i=this._getTipElement();this._element.setAttribute("aria-describedby",i.getAttribute("id"));const{container:n}=this._config;if(this._element.ownerDocument.documentElement.contains(this.tip)||(n.append(i),N.trigger(this._element,this.constructor.eventName("inserted"))),this._popper=this._createPopper(i),i.classList.add(es),"ontouchstart"in document.documentElement)for(const t of[].concat(...document.body.children))N.on(t,"mouseover",h);this._queueCallback((()=>{N.trigger(this._element,this.constructor.eventName("shown")),!1===this._isHovered&&this._leave(),this._isHovered=!1}),this.tip,this._isAnimated())}hide(){if(this._isShown()&&!N.trigger(this._element,this.constructor.eventName("hide")).defaultPrevented){if(this._getTipElement().classList.remove(es),"ontouchstart"in document.documentElement)for(const t of[].concat(...document.body.children))N.off(t,"mouseover",h);this._activeTrigger.click=!1,this._activeTrigger[os]=!1,this._activeTrigger[ss]=!1,this._isHovered=null,this._queueCallback((()=>{this._isWithActiveTrigger()||(this._isHovered||this._disposePopper(),this._element.removeAttribute("aria-describedby"),N.trigger(this._element,this.constructor.eventName("hidden")))}),this.tip,this._isAnimated())}}update(){this._popper&&this._popper.update()}_isWithContent(){return Boolean(this._getTitle())}_getTipElement(){return this.tip||(this.tip=this._createTipElement(this._newContent||this._getContentForTemplate())),this.tip}_createTipElement(t){const e=this._getTemplateFactory(t).toHtml();if(!e)return null;e.classList.remove(ts,es),e.classList.add(`bs-${this.constructor.NAME}-auto`);const i=(t=>{do{t+=Math.floor(1e6*Math.random())}while(document.getElementById(t));return t})(this.constructor.NAME).toString();return e.setAttribute("id",i),this._isAnimated()&&e.classList.add(ts),e}setContent(t){this._newContent=t,this._isShown()&&(this._disposePopper(),this.show())}_getTemplateFactory(t){return this._templateFactory?this._templateFactory.changeContent(t):this._templateFactory=new Jn({...this._config,content:t,extraClass:this._resolvePossibleFunction(this._config.customClass)}),this._templateFactory}_getContentForTemplate(){return{".tooltip-inner":this._getTitle()}}_getTitle(){return this._resolvePossibleFunction(this._config.title)||this._element.getAttribute("data-bs-original-title")}_initializeOnDelegatedTarget(t){return this.constructor.getOrCreateInstance(t.delegateTarget,this._getDelegateConfig())}_isAnimated(){return this._config.animation||this.tip&&this.tip.classList.contains(ts)}_isShown(){return this.tip&&this.tip.classList.contains(es)}_createPopper(t){const e=g(this._config.placement,[this,t,this._element]),i=rs[e.toUpperCase()];return bi(this._element,t,this._getPopperConfig(i))}_getOffset(){const{offset:t}=this._config;return"string"==typeof t?t.split(",").map((t=>Number.parseInt(t,10))):"function"==typeof t?e=>t(e,this._element):t}_resolvePossibleFunction(t){return g(t,[this._element])}_getPopperConfig(t){const e={placement:t,modifiers:[{name:"flip",options:{fallbackPlacements:this._config.fallbackPlacements}},{name:"offset",options:{offset:this._getOffset()}},{name:"preventOverflow",options:{boundary:this._config.boundary}},{name:"arrow",options:{element:`.${this.constructor.NAME}-arrow`}},{name:"preSetPlacement",enabled:!0,phase:"beforeMain",fn:t=>{this._getTipElement().setAttribute("data-popper-placement",t.state.placement)}}]};return{...e,...g(this._config.popperConfig,[e])}}_setListeners(){const t=this._config.trigger.split(" ");for(const e of t)if("click"===e)N.on(this._element,this.constructor.eventName("click"),this._config.selector,(t=>{this._initializeOnDelegatedTarget(t).toggle()}));else if("manual"!==e){const t=e===ss?this.constructor.eventName("mouseenter"):this.constructor.eventName("focusin"),i=e===ss?this.constructor.eventName("mouseleave"):this.constructor.eventName("focusout");N.on(this._element,t,this._config.selector,(t=>{const e=this._initializeOnDelegatedTarget(t);e._activeTrigger["focusin"===t.type?os:ss]=!0,e._enter()})),N.on(this._element,i,this._config.selector,(t=>{const e=this._initializeOnDelegatedTarget(t);e._activeTrigger["focusout"===t.type?os:ss]=e._element.contains(t.relatedTarget),e._leave()}))}this._hideModalHandler=()=>{this._element&&this.hide()},N.on(this._element.closest(is),ns,this._hideModalHandler)}_fixTitle(){const t=this._element.getAttribute("title");t&&(this._element.getAttribute("aria-label")||this._element.textContent.trim()||this._element.setAttribute("aria-label",t),this._element.setAttribute("data-bs-original-title",t),this._element.removeAttribute("title"))}_enter(){this._isShown()||this._isHovered?this._isHovered=!0:(this._isHovered=!0,this._setTimeout((()=>{this._isHovered&&this.show()}),this._config.delay.show))}_leave(){this._isWithActiveTrigger()||(this._isHovered=!1,this._setTimeout((()=>{this._isHovered||this.hide()}),this._config.delay.hide))}_setTimeout(t,e){clearTimeout(this._timeout),this._timeout=setTimeout(t,e)}_isWithActiveTrigger(){return Object.values(this._activeTrigger).includes(!0)}_getConfig(t){const e=F.getDataAttributes(this._element);for(const t of Object.keys(e))Zn.has(t)&&delete e[t];return t={...e,..."object"==typeof t&&t?t:{}},t=this._mergeConfigObj(t),t=this._configAfterMerge(t),this._typeCheckConfig(t),t}_configAfterMerge(t){return t.container=!1===t.container?document.body:r(t.container),"number"==typeof t.delay&&(t.delay={show:t.delay,hide:t.delay}),"number"==typeof t.title&&(t.title=t.title.toString()),"number"==typeof t.content&&(t.content=t.content.toString()),t}_getDelegateConfig(){const t={};for(const[e,i]of Object.entries(this._config))this.constructor.Default[e]!==i&&(t[e]=i);return t.selector=!1,t.trigger="manual",t}_disposePopper(){this._popper&&(this._popper.destroy(),this._popper=null),this.tip&&(this.tip.remove(),this.tip=null)}static jQueryInterface(t){return this.each((function(){const e=cs.getOrCreateInstance(this,t);if("string"==typeof t){if(void 0===e[t])throw new TypeError(`No method named "${t}"`);e[t]()}}))}}m(cs);const hs={...cs.Default,content:"",offset:[0,8],placement:"right",template:'',trigger:"click"},ds={...cs.DefaultType,content:"(null|string|element|function)"};class us extends cs{static get Default(){return hs}static get DefaultType(){return ds}static get NAME(){return"popover"}_isWithContent(){return this._getTitle()||this._getContent()}_getContentForTemplate(){return{".popover-header":this._getTitle(),".popover-body":this._getContent()}}_getContent(){return this._resolvePossibleFunction(this._config.content)}static jQueryInterface(t){return this.each((function(){const e=us.getOrCreateInstance(this,t);if("string"==typeof t){if(void 0===e[t])throw new TypeError(`No method named "${t}"`);e[t]()}}))}}m(us);const fs=".bs.scrollspy",ps=`activate${fs}`,ms=`click${fs}`,gs=`load${fs}.data-api`,_s="active",bs="[href]",vs=".nav-link",ys=`${vs}, .nav-item > ${vs}, .list-group-item`,ws={offset:null,rootMargin:"0px 0px -25%",smoothScroll:!1,target:null,threshold:[.1,.5,1]},As={offset:"(number|null)",rootMargin:"string",smoothScroll:"boolean",target:"element",threshold:"array"};class Es extends W{constructor(t,e){super(t,e),this._targetLinks=new Map,this._observableSections=new Map,this._rootElement="visible"===getComputedStyle(this._element).overflowY?null:this._element,this._activeTarget=null,this._observer=null,this._previousScrollData={visibleEntryTop:0,parentScrollTop:0},this.refresh()}static get Default(){return ws}static get DefaultType(){return As}static get NAME(){return"scrollspy"}refresh(){this._initializeTargetsAndObservables(),this._maybeEnableSmoothScroll(),this._observer?this._observer.disconnect():this._observer=this._getNewObserver();for(const t of this._observableSections.values())this._observer.observe(t)}dispose(){this._observer.disconnect(),super.dispose()}_configAfterMerge(t){return t.target=r(t.target)||document.body,t.rootMargin=t.offset?`${t.offset}px 0px -30%`:t.rootMargin,"string"==typeof t.threshold&&(t.threshold=t.threshold.split(",").map((t=>Number.parseFloat(t)))),t}_maybeEnableSmoothScroll(){this._config.smoothScroll&&(N.off(this._config.target,ms),N.on(this._config.target,ms,bs,(t=>{const e=this._observableSections.get(t.target.hash);if(e){t.preventDefault();const i=this._rootElement||window,n=e.offsetTop-this._element.offsetTop;if(i.scrollTo)return void i.scrollTo({top:n,behavior:"smooth"});i.scrollTop=n}})))}_getNewObserver(){const t={root:this._rootElement,threshold:this._config.threshold,rootMargin:this._config.rootMargin};return new IntersectionObserver((t=>this._observerCallback(t)),t)}_observerCallback(t){const e=t=>this._targetLinks.get(`#${t.target.id}`),i=t=>{this._previousScrollData.visibleEntryTop=t.target.offsetTop,this._process(e(t))},n=(this._rootElement||document.documentElement).scrollTop,s=n>=this._previousScrollData.parentScrollTop;this._previousScrollData.parentScrollTop=n;for(const o of t){if(!o.isIntersecting){this._activeTarget=null,this._clearActiveClass(e(o));continue}const t=o.target.offsetTop>=this._previousScrollData.visibleEntryTop;if(s&&t){if(i(o),!n)return}else s||t||i(o)}}_initializeTargetsAndObservables(){this._targetLinks=new Map,this._observableSections=new Map;const t=z.find(bs,this._config.target);for(const e of t){if(!e.hash||l(e))continue;const t=z.findOne(decodeURI(e.hash),this._element);a(t)&&(this._targetLinks.set(decodeURI(e.hash),e),this._observableSections.set(e.hash,t))}}_process(t){this._activeTarget!==t&&(this._clearActiveClass(this._config.target),this._activeTarget=t,t.classList.add(_s),this._activateParents(t),N.trigger(this._element,ps,{relatedTarget:t}))}_activateParents(t){if(t.classList.contains("dropdown-item"))z.findOne(".dropdown-toggle",t.closest(".dropdown")).classList.add(_s);else for(const e of z.parents(t,".nav, .list-group"))for(const t of z.prev(e,ys))t.classList.add(_s)}_clearActiveClass(t){t.classList.remove(_s);const e=z.find(`${bs}.${_s}`,t);for(const t of e)t.classList.remove(_s)}static jQueryInterface(t){return this.each((function(){const e=Es.getOrCreateInstance(this,t);if("string"==typeof t){if(void 0===e[t]||t.startsWith("_")||"constructor"===t)throw new TypeError(`No method named "${t}"`);e[t]()}}))}}N.on(window,gs,(()=>{for(const t of z.find('[data-bs-spy="scroll"]'))Es.getOrCreateInstance(t)})),m(Es);const Ts=".bs.tab",Cs=`hide${Ts}`,Os=`hidden${Ts}`,xs=`show${Ts}`,ks=`shown${Ts}`,Ls=`click${Ts}`,Ss=`keydown${Ts}`,Ds=`load${Ts}`,$s="ArrowLeft",Is="ArrowRight",Ns="ArrowUp",Ps="ArrowDown",Ms="Home",js="End",Fs="active",Hs="fade",Ws="show",Bs=":not(.dropdown-toggle)",zs='[data-bs-toggle="tab"], [data-bs-toggle="pill"], [data-bs-toggle="list"]',Rs=`.nav-link${Bs}, .list-group-item${Bs}, [role="tab"]${Bs}, ${zs}`,qs=`.${Fs}[data-bs-toggle="tab"], .${Fs}[data-bs-toggle="pill"], .${Fs}[data-bs-toggle="list"]`;class Vs extends W{constructor(t){super(t),this._parent=this._element.closest('.list-group, .nav, [role="tablist"]'),this._parent&&(this._setInitialAttributes(this._parent,this._getChildren()),N.on(this._element,Ss,(t=>this._keydown(t))))}static get NAME(){return"tab"}show(){const t=this._element;if(this._elemIsActive(t))return;const e=this._getActiveElem(),i=e?N.trigger(e,Cs,{relatedTarget:t}):null;N.trigger(t,xs,{relatedTarget:e}).defaultPrevented||i&&i.defaultPrevented||(this._deactivate(e,t),this._activate(t,e))}_activate(t,e){t&&(t.classList.add(Fs),this._activate(z.getElementFromSelector(t)),this._queueCallback((()=>{"tab"===t.getAttribute("role")?(t.removeAttribute("tabindex"),t.setAttribute("aria-selected",!0),this._toggleDropDown(t,!0),N.trigger(t,ks,{relatedTarget:e})):t.classList.add(Ws)}),t,t.classList.contains(Hs)))}_deactivate(t,e){t&&(t.classList.remove(Fs),t.blur(),this._deactivate(z.getElementFromSelector(t)),this._queueCallback((()=>{"tab"===t.getAttribute("role")?(t.setAttribute("aria-selected",!1),t.setAttribute("tabindex","-1"),this._toggleDropDown(t,!1),N.trigger(t,Os,{relatedTarget:e})):t.classList.remove(Ws)}),t,t.classList.contains(Hs)))}_keydown(t){if(![$s,Is,Ns,Ps,Ms,js].includes(t.key))return;t.stopPropagation(),t.preventDefault();const e=this._getChildren().filter((t=>!l(t)));let i;if([Ms,js].includes(t.key))i=e[t.key===Ms?0:e.length-1];else{const n=[Is,Ps].includes(t.key);i=b(e,t.target,n,!0)}i&&(i.focus({preventScroll:!0}),Vs.getOrCreateInstance(i).show())}_getChildren(){return z.find(Rs,this._parent)}_getActiveElem(){return this._getChildren().find((t=>this._elemIsActive(t)))||null}_setInitialAttributes(t,e){this._setAttributeIfNotExists(t,"role","tablist");for(const t of e)this._setInitialAttributesOnChild(t)}_setInitialAttributesOnChild(t){t=this._getInnerElement(t);const e=this._elemIsActive(t),i=this._getOuterElement(t);t.setAttribute("aria-selected",e),i!==t&&this._setAttributeIfNotExists(i,"role","presentation"),e||t.setAttribute("tabindex","-1"),this._setAttributeIfNotExists(t,"role","tab"),this._setInitialAttributesOnTargetPanel(t)}_setInitialAttributesOnTargetPanel(t){const e=z.getElementFromSelector(t);e&&(this._setAttributeIfNotExists(e,"role","tabpanel"),t.id&&this._setAttributeIfNotExists(e,"aria-labelledby",`${t.id}`))}_toggleDropDown(t,e){const i=this._getOuterElement(t);if(!i.classList.contains("dropdown"))return;const n=(t,n)=>{const s=z.findOne(t,i);s&&s.classList.toggle(n,e)};n(".dropdown-toggle",Fs),n(".dropdown-menu",Ws),i.setAttribute("aria-expanded",e)}_setAttributeIfNotExists(t,e,i){t.hasAttribute(e)||t.setAttribute(e,i)}_elemIsActive(t){return t.classList.contains(Fs)}_getInnerElement(t){return t.matches(Rs)?t:z.findOne(Rs,t)}_getOuterElement(t){return t.closest(".nav-item, .list-group-item")||t}static jQueryInterface(t){return this.each((function(){const e=Vs.getOrCreateInstance(this);if("string"==typeof t){if(void 0===e[t]||t.startsWith("_")||"constructor"===t)throw new TypeError(`No method named "${t}"`);e[t]()}}))}}N.on(document,Ls,zs,(function(t){["A","AREA"].includes(this.tagName)&&t.preventDefault(),l(this)||Vs.getOrCreateInstance(this).show()})),N.on(window,Ds,(()=>{for(const t of z.find(qs))Vs.getOrCreateInstance(t)})),m(Vs);const Ks=".bs.toast",Qs=`mouseover${Ks}`,Xs=`mouseout${Ks}`,Ys=`focusin${Ks}`,Us=`focusout${Ks}`,Gs=`hide${Ks}`,Js=`hidden${Ks}`,Zs=`show${Ks}`,to=`shown${Ks}`,eo="hide",io="show",no="showing",so={animation:"boolean",autohide:"boolean",delay:"number"},oo={animation:!0,autohide:!0,delay:5e3};class ro extends W{constructor(t,e){super(t,e),this._timeout=null,this._hasMouseInteraction=!1,this._hasKeyboardInteraction=!1,this._setListeners()}static get Default(){return oo}static get DefaultType(){return so}static get NAME(){return"toast"}show(){N.trigger(this._element,Zs).defaultPrevented||(this._clearTimeout(),this._config.animation&&this._element.classList.add("fade"),this._element.classList.remove(eo),d(this._element),this._element.classList.add(io,no),this._queueCallback((()=>{this._element.classList.remove(no),N.trigger(this._element,to),this._maybeScheduleHide()}),this._element,this._config.animation))}hide(){this.isShown()&&(N.trigger(this._element,Gs).defaultPrevented||(this._element.classList.add(no),this._queueCallback((()=>{this._element.classList.add(eo),this._element.classList.remove(no,io),N.trigger(this._element,Js)}),this._element,this._config.animation)))}dispose(){this._clearTimeout(),this.isShown()&&this._element.classList.remove(io),super.dispose()}isShown(){return this._element.classList.contains(io)}_maybeScheduleHide(){this._config.autohide&&(this._hasMouseInteraction||this._hasKeyboardInteraction||(this._timeout=setTimeout((()=>{this.hide()}),this._config.delay)))}_onInteraction(t,e){switch(t.type){case"mouseover":case"mouseout":this._hasMouseInteraction=e;break;case"focusin":case"focusout":this._hasKeyboardInteraction=e}if(e)return void this._clearTimeout();const i=t.relatedTarget;this._element===i||this._element.contains(i)||this._maybeScheduleHide()}_setListeners(){N.on(this._element,Qs,(t=>this._onInteraction(t,!0))),N.on(this._element,Xs,(t=>this._onInteraction(t,!1))),N.on(this._element,Ys,(t=>this._onInteraction(t,!0))),N.on(this._element,Us,(t=>this._onInteraction(t,!1)))}_clearTimeout(){clearTimeout(this._timeout),this._timeout=null}static jQueryInterface(t){return this.each((function(){const e=ro.getOrCreateInstance(this,t);if("string"==typeof t){if(void 0===e[t])throw new TypeError(`No method named "${t}"`);e[t](this)}}))}}return R(ro),m(ro),{Alert:Q,Button:Y,Carousel:xt,Collapse:Bt,Dropdown:qi,Modal:On,Offcanvas:qn,Popover:us,ScrollSpy:Es,Tab:Vs,Toast:ro,Tooltip:cs}})); +//# sourceMappingURL=bootstrap.bundle.min.js.map \ No newline at end of file diff --git a/docs/deps/bootstrap-5.3.1/bootstrap.bundle.min.js.map b/docs/deps/bootstrap-5.3.1/bootstrap.bundle.min.js.map new file mode 100644 index 00000000..3863da8b --- /dev/null +++ b/docs/deps/bootstrap-5.3.1/bootstrap.bundle.min.js.map @@ -0,0 +1 @@ +{"version":3,"names":["elementMap","Map","Data","set","element","key","instance","has","instanceMap","get","size","console","error","Array","from","keys","remove","delete","TRANSITION_END","parseSelector","selector","window","CSS","escape","replace","match","id","triggerTransitionEnd","dispatchEvent","Event","isElement","object","jquery","nodeType","getElement","length","document","querySelector","isVisible","getClientRects","elementIsVisible","getComputedStyle","getPropertyValue","closedDetails","closest","summary","parentNode","isDisabled","Node","ELEMENT_NODE","classList","contains","disabled","hasAttribute","getAttribute","findShadowRoot","documentElement","attachShadow","getRootNode","root","ShadowRoot","noop","reflow","offsetHeight","getjQuery","jQuery","body","DOMContentLoadedCallbacks","isRTL","dir","defineJQueryPlugin","plugin","callback","$","name","NAME","JQUERY_NO_CONFLICT","fn","jQueryInterface","Constructor","noConflict","readyState","addEventListener","push","execute","possibleCallback","args","defaultValue","executeAfterTransition","transitionElement","waitForTransition","emulatedDuration","transitionDuration","transitionDelay","floatTransitionDuration","Number","parseFloat","floatTransitionDelay","split","getTransitionDurationFromElement","called","handler","target","removeEventListener","setTimeout","getNextActiveElement","list","activeElement","shouldGetNext","isCycleAllowed","listLength","index","indexOf","Math","max","min","namespaceRegex","stripNameRegex","stripUidRegex","eventRegistry","uidEvent","customEvents","mouseenter","mouseleave","nativeEvents","Set","makeEventUid","uid","getElementEvents","findHandler","events","callable","delegationSelector","Object","values","find","event","normalizeParameters","originalTypeEvent","delegationFunction","isDelegated","typeEvent","getTypeEvent","addHandler","oneOff","wrapFunction","relatedTarget","delegateTarget","call","this","handlers","previousFunction","domElements","querySelectorAll","domElement","hydrateObj","EventHandler","off","type","apply","bootstrapDelegationHandler","bootstrapHandler","removeHandler","Boolean","removeNamespacedHandlers","namespace","storeElementEvent","handlerKey","entries","includes","on","one","inNamespace","isNamespace","startsWith","elementEvent","slice","keyHandlers","trigger","jQueryEvent","bubbles","nativeDispatch","defaultPrevented","isPropagationStopped","isImmediatePropagationStopped","isDefaultPrevented","evt","cancelable","preventDefault","obj","meta","value","_unused","defineProperty","configurable","normalizeData","toString","JSON","parse","decodeURIComponent","normalizeDataKey","chr","toLowerCase","Manipulator","setDataAttribute","setAttribute","removeDataAttribute","removeAttribute","getDataAttributes","attributes","bsKeys","dataset","filter","pureKey","charAt","getDataAttribute","Config","Default","DefaultType","Error","_getConfig","config","_mergeConfigObj","_configAfterMerge","_typeCheckConfig","jsonConfig","constructor","configTypes","property","expectedTypes","valueType","prototype","RegExp","test","TypeError","toUpperCase","BaseComponent","super","_element","_config","DATA_KEY","dispose","EVENT_KEY","propertyName","getOwnPropertyNames","_queueCallback","isAnimated","getInstance","getOrCreateInstance","VERSION","eventName","getSelector","hrefAttribute","trim","SelectorEngine","concat","Element","findOne","children","child","matches","parents","ancestor","prev","previous","previousElementSibling","next","nextElementSibling","focusableChildren","focusables","map","join","el","getSelectorFromElement","getElementFromSelector","getMultipleElementsFromSelector","enableDismissTrigger","component","method","clickEvent","tagName","EVENT_CLOSE","EVENT_CLOSED","Alert","close","_destroyElement","each","data","undefined","SELECTOR_DATA_TOGGLE","Button","toggle","button","EVENT_TOUCHSTART","EVENT_TOUCHMOVE","EVENT_TOUCHEND","EVENT_POINTERDOWN","EVENT_POINTERUP","endCallback","leftCallback","rightCallback","Swipe","isSupported","_deltaX","_supportPointerEvents","PointerEvent","_initEvents","_start","_eventIsPointerPenTouch","clientX","touches","_end","_handleSwipe","_move","absDeltaX","abs","direction","add","pointerType","navigator","maxTouchPoints","DATA_API_KEY","ORDER_NEXT","ORDER_PREV","DIRECTION_LEFT","DIRECTION_RIGHT","EVENT_SLIDE","EVENT_SLID","EVENT_KEYDOWN","EVENT_MOUSEENTER","EVENT_MOUSELEAVE","EVENT_DRAG_START","EVENT_LOAD_DATA_API","EVENT_CLICK_DATA_API","CLASS_NAME_CAROUSEL","CLASS_NAME_ACTIVE","SELECTOR_ACTIVE","SELECTOR_ITEM","SELECTOR_ACTIVE_ITEM","KEY_TO_DIRECTION","ArrowLeft","ArrowRight","interval","keyboard","pause","ride","touch","wrap","Carousel","_interval","_activeElement","_isSliding","touchTimeout","_swipeHelper","_indicatorsElement","_addEventListeners","cycle","_slide","nextWhenVisible","hidden","_clearInterval","_updateInterval","setInterval","_maybeEnableCycle","to","items","_getItems","activeIndex","_getItemIndex","_getActive","order","defaultInterval","_keydown","_addTouchEventListeners","img","swipeConfig","_directionToOrder","endCallBack","clearTimeout","_setActiveIndicatorElement","activeIndicator","newActiveIndicator","elementInterval","parseInt","isNext","nextElement","nextElementIndex","triggerEvent","_orderToDirection","isCycling","directionalClassName","orderClassName","completeCallBack","_isAnimated","clearInterval","carousel","slideIndex","carousels","EVENT_SHOW","EVENT_SHOWN","EVENT_HIDE","EVENT_HIDDEN","CLASS_NAME_SHOW","CLASS_NAME_COLLAPSE","CLASS_NAME_COLLAPSING","CLASS_NAME_DEEPER_CHILDREN","parent","Collapse","_isTransitioning","_triggerArray","toggleList","elem","filterElement","foundElement","_initializeChildren","_addAriaAndCollapsedClass","_isShown","hide","show","activeChildren","_getFirstLevelChildren","activeInstance","dimension","_getDimension","style","scrollSize","complete","getBoundingClientRect","selected","triggerArray","isOpen","top","bottom","right","left","auto","basePlacements","start","end","clippingParents","viewport","popper","reference","variationPlacements","reduce","acc","placement","placements","beforeRead","read","afterRead","beforeMain","main","afterMain","beforeWrite","write","afterWrite","modifierPhases","getNodeName","nodeName","getWindow","node","ownerDocument","defaultView","isHTMLElement","HTMLElement","isShadowRoot","applyStyles$1","enabled","phase","_ref","state","elements","forEach","styles","assign","effect","_ref2","initialStyles","position","options","strategy","margin","arrow","hasOwnProperty","attribute","requires","getBasePlacement","round","getUAString","uaData","userAgentData","brands","isArray","item","brand","version","userAgent","isLayoutViewport","includeScale","isFixedStrategy","clientRect","scaleX","scaleY","offsetWidth","width","height","visualViewport","addVisualOffsets","x","offsetLeft","y","offsetTop","getLayoutRect","rootNode","isSameNode","host","isTableElement","getDocumentElement","getParentNode","assignedSlot","getTrueOffsetParent","offsetParent","getOffsetParent","isFirefox","currentNode","css","transform","perspective","contain","willChange","getContainingBlock","getMainAxisFromPlacement","within","mathMax","mathMin","mergePaddingObject","paddingObject","expandToHashMap","hashMap","arrow$1","_state$modifiersData$","arrowElement","popperOffsets","modifiersData","basePlacement","axis","len","padding","rects","toPaddingObject","arrowRect","minProp","maxProp","endDiff","startDiff","arrowOffsetParent","clientSize","clientHeight","clientWidth","centerToReference","center","offset","axisProp","centerOffset","_options$element","requiresIfExists","getVariation","unsetSides","mapToStyles","_Object$assign2","popperRect","variation","offsets","gpuAcceleration","adaptive","roundOffsets","isFixed","_offsets$x","_offsets$y","_ref3","hasX","hasY","sideX","sideY","win","heightProp","widthProp","_Object$assign","commonStyles","_ref4","dpr","devicePixelRatio","roundOffsetsByDPR","computeStyles$1","_ref5","_options$gpuAccelerat","_options$adaptive","_options$roundOffsets","passive","eventListeners","_options$scroll","scroll","_options$resize","resize","scrollParents","scrollParent","update","hash","getOppositePlacement","matched","getOppositeVariationPlacement","getWindowScroll","scrollLeft","pageXOffset","scrollTop","pageYOffset","getWindowScrollBarX","isScrollParent","_getComputedStyle","overflow","overflowX","overflowY","getScrollParent","listScrollParents","_element$ownerDocumen","isBody","updatedList","rectToClientRect","rect","getClientRectFromMixedType","clippingParent","html","layoutViewport","getViewportRect","clientTop","clientLeft","getInnerBoundingClientRect","winScroll","scrollWidth","scrollHeight","getDocumentRect","computeOffsets","commonX","commonY","mainAxis","detectOverflow","_options","_options$placement","_options$strategy","_options$boundary","boundary","_options$rootBoundary","rootBoundary","_options$elementConte","elementContext","_options$altBoundary","altBoundary","_options$padding","altContext","clippingClientRect","mainClippingParents","clipperElement","getClippingParents","firstClippingParent","clippingRect","accRect","getClippingRect","contextElement","referenceClientRect","popperClientRect","elementClientRect","overflowOffsets","offsetData","multiply","computeAutoPlacement","flipVariations","_options$allowedAutoP","allowedAutoPlacements","allPlacements","allowedPlacements","overflows","sort","a","b","flip$1","_skip","_options$mainAxis","checkMainAxis","_options$altAxis","altAxis","checkAltAxis","specifiedFallbackPlacements","fallbackPlacements","_options$flipVariatio","preferredPlacement","oppositePlacement","getExpandedFallbackPlacements","referenceRect","checksMap","makeFallbackChecks","firstFittingPlacement","i","_basePlacement","isStartVariation","isVertical","mainVariationSide","altVariationSide","checks","every","check","_loop","_i","fittingPlacement","reset","getSideOffsets","preventedOffsets","isAnySideFullyClipped","some","side","hide$1","preventOverflow","referenceOverflow","popperAltOverflow","referenceClippingOffsets","popperEscapeOffsets","isReferenceHidden","hasPopperEscaped","offset$1","_options$offset","invertDistance","skidding","distance","distanceAndSkiddingToXY","_data$state$placement","popperOffsets$1","preventOverflow$1","_options$tether","tether","_options$tetherOffset","tetherOffset","isBasePlacement","tetherOffsetValue","normalizedTetherOffsetValue","offsetModifierState","_offsetModifierState$","mainSide","altSide","additive","minLen","maxLen","arrowPaddingObject","arrowPaddingMin","arrowPaddingMax","arrowLen","minOffset","maxOffset","clientOffset","offsetModifierValue","tetherMax","preventedOffset","_offsetModifierState$2","_mainSide","_altSide","_offset","_len","_min","_max","isOriginSide","_offsetModifierValue","_tetherMin","_tetherMax","_preventedOffset","v","withinMaxClamp","getCompositeRect","elementOrVirtualElement","isOffsetParentAnElement","offsetParentIsScaled","isElementScaled","modifiers","visited","result","modifier","dep","depModifier","DEFAULT_OPTIONS","areValidElements","arguments","_key","popperGenerator","generatorOptions","_generatorOptions","_generatorOptions$def","defaultModifiers","_generatorOptions$def2","defaultOptions","pending","orderedModifiers","effectCleanupFns","isDestroyed","setOptions","setOptionsAction","cleanupModifierEffects","merged","orderModifiers","current","existing","m","_ref$options","cleanupFn","forceUpdate","_state$elements","_state$orderedModifie","_state$orderedModifie2","Promise","resolve","then","destroy","onFirstUpdate","createPopper","computeStyles","applyStyles","flip","ARROW_UP_KEY","ARROW_DOWN_KEY","EVENT_KEYDOWN_DATA_API","EVENT_KEYUP_DATA_API","SELECTOR_DATA_TOGGLE_SHOWN","SELECTOR_MENU","PLACEMENT_TOP","PLACEMENT_TOPEND","PLACEMENT_BOTTOM","PLACEMENT_BOTTOMEND","PLACEMENT_RIGHT","PLACEMENT_LEFT","autoClose","display","popperConfig","Dropdown","_popper","_parent","_menu","_inNavbar","_detectNavbar","_createPopper","focus","_completeHide","Popper","referenceElement","_getPopperConfig","_getPlacement","parentDropdown","isEnd","_getOffset","popperData","defaultBsPopperConfig","_selectMenuItem","clearMenus","openToggles","context","composedPath","isMenuTarget","dataApiKeydownHandler","isInput","isEscapeEvent","isUpOrDownEvent","getToggleButton","stopPropagation","EVENT_MOUSEDOWN","className","clickCallback","rootElement","Backdrop","_isAppended","_append","_getElement","_emulateAnimation","backdrop","createElement","append","EVENT_FOCUSIN","EVENT_KEYDOWN_TAB","TAB_NAV_BACKWARD","autofocus","trapElement","FocusTrap","_isActive","_lastTabNavDirection","activate","_handleFocusin","_handleKeydown","deactivate","shiftKey","SELECTOR_FIXED_CONTENT","SELECTOR_STICKY_CONTENT","PROPERTY_PADDING","PROPERTY_MARGIN","ScrollBarHelper","getWidth","documentWidth","innerWidth","_disableOverFlow","_setElementAttributes","calculatedValue","_resetElementAttributes","isOverflowing","_saveInitialAttribute","styleProperty","scrollbarWidth","_applyManipulationCallback","setProperty","actualValue","removeProperty","callBack","sel","EVENT_HIDE_PREVENTED","EVENT_RESIZE","EVENT_CLICK_DISMISS","EVENT_MOUSEDOWN_DISMISS","EVENT_KEYDOWN_DISMISS","CLASS_NAME_OPEN","CLASS_NAME_STATIC","Modal","_dialog","_backdrop","_initializeBackDrop","_focustrap","_initializeFocusTrap","_scrollBar","_adjustDialog","_showElement","_hideModal","handleUpdate","modalBody","transitionComplete","_triggerBackdropTransition","event2","_resetAdjustments","isModalOverflowing","initialOverflowY","isBodyOverflowing","paddingLeft","paddingRight","showEvent","alreadyOpen","CLASS_NAME_SHOWING","CLASS_NAME_HIDING","OPEN_SELECTOR","Offcanvas","blur","completeCallback","DefaultAllowlist","area","br","col","code","div","em","hr","h1","h2","h3","h4","h5","h6","li","ol","p","pre","s","small","span","sub","sup","strong","u","ul","uriAttributes","SAFE_URL_PATTERN","allowedAttribute","allowedAttributeList","attributeName","nodeValue","attributeRegex","regex","allowList","content","extraClass","sanitize","sanitizeFn","template","DefaultContentType","entry","TemplateFactory","getContent","_resolvePossibleFunction","hasContent","changeContent","_checkContent","toHtml","templateWrapper","innerHTML","_maybeSanitize","text","_setContent","arg","templateElement","_putElementInTemplate","textContent","unsafeHtml","sanitizeFunction","createdDocument","DOMParser","parseFromString","elementName","attributeList","allowedAttributes","sanitizeHtml","DISALLOWED_ATTRIBUTES","CLASS_NAME_FADE","SELECTOR_MODAL","EVENT_MODAL_HIDE","TRIGGER_HOVER","TRIGGER_FOCUS","AttachmentMap","AUTO","TOP","RIGHT","BOTTOM","LEFT","animation","container","customClass","delay","title","Tooltip","_isEnabled","_timeout","_isHovered","_activeTrigger","_templateFactory","_newContent","tip","_setListeners","_fixTitle","enable","disable","toggleEnabled","click","_leave","_enter","_hideModalHandler","_disposePopper","_isWithContent","isInTheDom","_getTipElement","_isWithActiveTrigger","_getTitle","_createTipElement","_getContentForTemplate","_getTemplateFactory","tipId","prefix","floor","random","getElementById","getUID","setContent","_initializeOnDelegatedTarget","_getDelegateConfig","attachment","triggers","eventIn","eventOut","_setTimeout","timeout","dataAttributes","dataAttribute","Popover","_getContent","EVENT_ACTIVATE","EVENT_CLICK","SELECTOR_TARGET_LINKS","SELECTOR_NAV_LINKS","SELECTOR_LINK_ITEMS","rootMargin","smoothScroll","threshold","ScrollSpy","_targetLinks","_observableSections","_rootElement","_activeTarget","_observer","_previousScrollData","visibleEntryTop","parentScrollTop","refresh","_initializeTargetsAndObservables","_maybeEnableSmoothScroll","disconnect","_getNewObserver","section","observe","observableSection","scrollTo","behavior","IntersectionObserver","_observerCallback","targetElement","_process","userScrollsDown","isIntersecting","_clearActiveClass","entryIsLowerThanPrevious","targetLinks","anchor","decodeURI","_activateParents","listGroup","activeNodes","spy","ARROW_LEFT_KEY","ARROW_RIGHT_KEY","HOME_KEY","END_KEY","NOT_SELECTOR_DROPDOWN_TOGGLE","SELECTOR_INNER_ELEM","SELECTOR_DATA_TOGGLE_ACTIVE","Tab","_setInitialAttributes","_getChildren","innerElem","_elemIsActive","active","_getActiveElem","hideEvent","_deactivate","_activate","relatedElem","_toggleDropDown","nextActiveElement","preventScroll","_setAttributeIfNotExists","_setInitialAttributesOnChild","_getInnerElement","isActive","outerElem","_getOuterElement","_setInitialAttributesOnTargetPanel","open","EVENT_MOUSEOVER","EVENT_MOUSEOUT","EVENT_FOCUSOUT","CLASS_NAME_HIDE","autohide","Toast","_hasMouseInteraction","_hasKeyboardInteraction","_clearTimeout","_maybeScheduleHide","isShown","_onInteraction","isInteracting"],"sources":["../../js/src/dom/data.js","../../js/src/util/index.js","../../js/src/dom/event-handler.js","../../js/src/dom/manipulator.js","../../js/src/util/config.js","../../js/src/base-component.js","../../js/src/dom/selector-engine.js","../../js/src/util/component-functions.js","../../js/src/alert.js","../../js/src/button.js","../../js/src/util/swipe.js","../../js/src/carousel.js","../../js/src/collapse.js","../../node_modules/@popperjs/core/lib/enums.js","../../node_modules/@popperjs/core/lib/dom-utils/getNodeName.js","../../node_modules/@popperjs/core/lib/dom-utils/getWindow.js","../../node_modules/@popperjs/core/lib/dom-utils/instanceOf.js","../../node_modules/@popperjs/core/lib/modifiers/applyStyles.js","../../node_modules/@popperjs/core/lib/utils/getBasePlacement.js","../../node_modules/@popperjs/core/lib/utils/math.js","../../node_modules/@popperjs/core/lib/utils/userAgent.js","../../node_modules/@popperjs/core/lib/dom-utils/isLayoutViewport.js","../../node_modules/@popperjs/core/lib/dom-utils/getBoundingClientRect.js","../../node_modules/@popperjs/core/lib/dom-utils/getLayoutRect.js","../../node_modules/@popperjs/core/lib/dom-utils/contains.js","../../node_modules/@popperjs/core/lib/dom-utils/getComputedStyle.js","../../node_modules/@popperjs/core/lib/dom-utils/isTableElement.js","../../node_modules/@popperjs/core/lib/dom-utils/getDocumentElement.js","../../node_modules/@popperjs/core/lib/dom-utils/getParentNode.js","../../node_modules/@popperjs/core/lib/dom-utils/getOffsetParent.js","../../node_modules/@popperjs/core/lib/utils/getMainAxisFromPlacement.js","../../node_modules/@popperjs/core/lib/utils/within.js","../../node_modules/@popperjs/core/lib/utils/mergePaddingObject.js","../../node_modules/@popperjs/core/lib/utils/getFreshSideObject.js","../../node_modules/@popperjs/core/lib/utils/expandToHashMap.js","../../node_modules/@popperjs/core/lib/modifiers/arrow.js","../../node_modules/@popperjs/core/lib/utils/getVariation.js","../../node_modules/@popperjs/core/lib/modifiers/computeStyles.js","../../node_modules/@popperjs/core/lib/modifiers/eventListeners.js","../../node_modules/@popperjs/core/lib/utils/getOppositePlacement.js","../../node_modules/@popperjs/core/lib/utils/getOppositeVariationPlacement.js","../../node_modules/@popperjs/core/lib/dom-utils/getWindowScroll.js","../../node_modules/@popperjs/core/lib/dom-utils/getWindowScrollBarX.js","../../node_modules/@popperjs/core/lib/dom-utils/isScrollParent.js","../../node_modules/@popperjs/core/lib/dom-utils/getScrollParent.js","../../node_modules/@popperjs/core/lib/dom-utils/listScrollParents.js","../../node_modules/@popperjs/core/lib/utils/rectToClientRect.js","../../node_modules/@popperjs/core/lib/dom-utils/getClippingRect.js","../../node_modules/@popperjs/core/lib/dom-utils/getViewportRect.js","../../node_modules/@popperjs/core/lib/dom-utils/getDocumentRect.js","../../node_modules/@popperjs/core/lib/utils/computeOffsets.js","../../node_modules/@popperjs/core/lib/utils/detectOverflow.js","../../node_modules/@popperjs/core/lib/utils/computeAutoPlacement.js","../../node_modules/@popperjs/core/lib/modifiers/flip.js","../../node_modules/@popperjs/core/lib/modifiers/hide.js","../../node_modules/@popperjs/core/lib/modifiers/offset.js","../../node_modules/@popperjs/core/lib/modifiers/popperOffsets.js","../../node_modules/@popperjs/core/lib/modifiers/preventOverflow.js","../../node_modules/@popperjs/core/lib/utils/getAltAxis.js","../../node_modules/@popperjs/core/lib/dom-utils/getCompositeRect.js","../../node_modules/@popperjs/core/lib/dom-utils/getNodeScroll.js","../../node_modules/@popperjs/core/lib/dom-utils/getHTMLElementScroll.js","../../node_modules/@popperjs/core/lib/utils/orderModifiers.js","../../node_modules/@popperjs/core/lib/createPopper.js","../../node_modules/@popperjs/core/lib/utils/debounce.js","../../node_modules/@popperjs/core/lib/utils/mergeByName.js","../../node_modules/@popperjs/core/lib/popper-lite.js","../../node_modules/@popperjs/core/lib/popper.js","../../js/src/dropdown.js","../../js/src/util/backdrop.js","../../js/src/util/focustrap.js","../../js/src/util/scrollbar.js","../../js/src/modal.js","../../js/src/offcanvas.js","../../js/src/util/sanitizer.js","../../js/src/util/template-factory.js","../../js/src/tooltip.js","../../js/src/popover.js","../../js/src/scrollspy.js","../../js/src/tab.js","../../js/src/toast.js","../../js/index.umd.js"],"sourcesContent":["/**\n * --------------------------------------------------------------------------\n * Bootstrap dom/data.js\n * Licensed under MIT (https://github.com/twbs/bootstrap/blob/main/LICENSE)\n * --------------------------------------------------------------------------\n */\n\n/**\n * Constants\n */\n\nconst elementMap = new Map()\n\nexport default {\n set(element, key, instance) {\n if (!elementMap.has(element)) {\n elementMap.set(element, new Map())\n }\n\n const instanceMap = elementMap.get(element)\n\n // make it clear we only want one instance per element\n // can be removed later when multiple key/instances are fine to be used\n if (!instanceMap.has(key) && instanceMap.size !== 0) {\n // eslint-disable-next-line no-console\n console.error(`Bootstrap doesn't allow more than one instance per element. Bound instance: ${Array.from(instanceMap.keys())[0]}.`)\n return\n }\n\n instanceMap.set(key, instance)\n },\n\n get(element, key) {\n if (elementMap.has(element)) {\n return elementMap.get(element).get(key) || null\n }\n\n return null\n },\n\n remove(element, key) {\n if (!elementMap.has(element)) {\n return\n }\n\n const instanceMap = elementMap.get(element)\n\n instanceMap.delete(key)\n\n // free up element references if there are no instances left for an element\n if (instanceMap.size === 0) {\n elementMap.delete(element)\n }\n }\n}\n","/**\n * --------------------------------------------------------------------------\n * Bootstrap util/index.js\n * Licensed under MIT (https://github.com/twbs/bootstrap/blob/main/LICENSE)\n * --------------------------------------------------------------------------\n */\n\nconst MAX_UID = 1_000_000\nconst MILLISECONDS_MULTIPLIER = 1000\nconst TRANSITION_END = 'transitionend'\n\n/**\n * Properly escape IDs selectors to handle weird IDs\n * @param {string} selector\n * @returns {string}\n */\nconst parseSelector = selector => {\n if (selector && window.CSS && window.CSS.escape) {\n // document.querySelector needs escaping to handle IDs (html5+) containing for instance /\n selector = selector.replace(/#([^\\s\"#']+)/g, (match, id) => `#${CSS.escape(id)}`)\n }\n\n return selector\n}\n\n// Shout-out Angus Croll (https://goo.gl/pxwQGp)\nconst toType = object => {\n if (object === null || object === undefined) {\n return `${object}`\n }\n\n return Object.prototype.toString.call(object).match(/\\s([a-z]+)/i)[1].toLowerCase()\n}\n\n/**\n * Public Util API\n */\n\nconst getUID = prefix => {\n do {\n prefix += Math.floor(Math.random() * MAX_UID)\n } while (document.getElementById(prefix))\n\n return prefix\n}\n\nconst getTransitionDurationFromElement = element => {\n if (!element) {\n return 0\n }\n\n // Get transition-duration of the element\n let { transitionDuration, transitionDelay } = window.getComputedStyle(element)\n\n const floatTransitionDuration = Number.parseFloat(transitionDuration)\n const floatTransitionDelay = Number.parseFloat(transitionDelay)\n\n // Return 0 if element or transition duration is not found\n if (!floatTransitionDuration && !floatTransitionDelay) {\n return 0\n }\n\n // If multiple durations are defined, take the first\n transitionDuration = transitionDuration.split(',')[0]\n transitionDelay = transitionDelay.split(',')[0]\n\n return (Number.parseFloat(transitionDuration) + Number.parseFloat(transitionDelay)) * MILLISECONDS_MULTIPLIER\n}\n\nconst triggerTransitionEnd = element => {\n element.dispatchEvent(new Event(TRANSITION_END))\n}\n\nconst isElement = object => {\n if (!object || typeof object !== 'object') {\n return false\n }\n\n if (typeof object.jquery !== 'undefined') {\n object = object[0]\n }\n\n return typeof object.nodeType !== 'undefined'\n}\n\nconst getElement = object => {\n // it's a jQuery object or a node element\n if (isElement(object)) {\n return object.jquery ? object[0] : object\n }\n\n if (typeof object === 'string' && object.length > 0) {\n return document.querySelector(parseSelector(object))\n }\n\n return null\n}\n\nconst isVisible = element => {\n if (!isElement(element) || element.getClientRects().length === 0) {\n return false\n }\n\n const elementIsVisible = getComputedStyle(element).getPropertyValue('visibility') === 'visible'\n // Handle `details` element as its content may falsie appear visible when it is closed\n const closedDetails = element.closest('details:not([open])')\n\n if (!closedDetails) {\n return elementIsVisible\n }\n\n if (closedDetails !== element) {\n const summary = element.closest('summary')\n if (summary && summary.parentNode !== closedDetails) {\n return false\n }\n\n if (summary === null) {\n return false\n }\n }\n\n return elementIsVisible\n}\n\nconst isDisabled = element => {\n if (!element || element.nodeType !== Node.ELEMENT_NODE) {\n return true\n }\n\n if (element.classList.contains('disabled')) {\n return true\n }\n\n if (typeof element.disabled !== 'undefined') {\n return element.disabled\n }\n\n return element.hasAttribute('disabled') && element.getAttribute('disabled') !== 'false'\n}\n\nconst findShadowRoot = element => {\n if (!document.documentElement.attachShadow) {\n return null\n }\n\n // Can find the shadow root otherwise it'll return the document\n if (typeof element.getRootNode === 'function') {\n const root = element.getRootNode()\n return root instanceof ShadowRoot ? root : null\n }\n\n if (element instanceof ShadowRoot) {\n return element\n }\n\n // when we don't find a shadow root\n if (!element.parentNode) {\n return null\n }\n\n return findShadowRoot(element.parentNode)\n}\n\nconst noop = () => {}\n\n/**\n * Trick to restart an element's animation\n *\n * @param {HTMLElement} element\n * @return void\n *\n * @see https://www.charistheo.io/blog/2021/02/restart-a-css-animation-with-javascript/#restarting-a-css-animation\n */\nconst reflow = element => {\n element.offsetHeight // eslint-disable-line no-unused-expressions\n}\n\nconst getjQuery = () => {\n if (window.jQuery && !document.body.hasAttribute('data-bs-no-jquery')) {\n return window.jQuery\n }\n\n return null\n}\n\nconst DOMContentLoadedCallbacks = []\n\nconst onDOMContentLoaded = callback => {\n if (document.readyState === 'loading') {\n // add listener on the first call when the document is in loading state\n if (!DOMContentLoadedCallbacks.length) {\n document.addEventListener('DOMContentLoaded', () => {\n for (const callback of DOMContentLoadedCallbacks) {\n callback()\n }\n })\n }\n\n DOMContentLoadedCallbacks.push(callback)\n } else {\n callback()\n }\n}\n\nconst isRTL = () => document.documentElement.dir === 'rtl'\n\nconst defineJQueryPlugin = plugin => {\n onDOMContentLoaded(() => {\n const $ = getjQuery()\n /* istanbul ignore if */\n if ($) {\n const name = plugin.NAME\n const JQUERY_NO_CONFLICT = $.fn[name]\n $.fn[name] = plugin.jQueryInterface\n $.fn[name].Constructor = plugin\n $.fn[name].noConflict = () => {\n $.fn[name] = JQUERY_NO_CONFLICT\n return plugin.jQueryInterface\n }\n }\n })\n}\n\nconst execute = (possibleCallback, args = [], defaultValue = possibleCallback) => {\n return typeof possibleCallback === 'function' ? possibleCallback(...args) : defaultValue\n}\n\nconst executeAfterTransition = (callback, transitionElement, waitForTransition = true) => {\n if (!waitForTransition) {\n execute(callback)\n return\n }\n\n const durationPadding = 5\n const emulatedDuration = getTransitionDurationFromElement(transitionElement) + durationPadding\n\n let called = false\n\n const handler = ({ target }) => {\n if (target !== transitionElement) {\n return\n }\n\n called = true\n transitionElement.removeEventListener(TRANSITION_END, handler)\n execute(callback)\n }\n\n transitionElement.addEventListener(TRANSITION_END, handler)\n setTimeout(() => {\n if (!called) {\n triggerTransitionEnd(transitionElement)\n }\n }, emulatedDuration)\n}\n\n/**\n * Return the previous/next element of a list.\n *\n * @param {array} list The list of elements\n * @param activeElement The active element\n * @param shouldGetNext Choose to get next or previous element\n * @param isCycleAllowed\n * @return {Element|elem} The proper element\n */\nconst getNextActiveElement = (list, activeElement, shouldGetNext, isCycleAllowed) => {\n const listLength = list.length\n let index = list.indexOf(activeElement)\n\n // if the element does not exist in the list return an element\n // depending on the direction and if cycle is allowed\n if (index === -1) {\n return !shouldGetNext && isCycleAllowed ? list[listLength - 1] : list[0]\n }\n\n index += shouldGetNext ? 1 : -1\n\n if (isCycleAllowed) {\n index = (index + listLength) % listLength\n }\n\n return list[Math.max(0, Math.min(index, listLength - 1))]\n}\n\nexport {\n defineJQueryPlugin,\n execute,\n executeAfterTransition,\n findShadowRoot,\n getElement,\n getjQuery,\n getNextActiveElement,\n getTransitionDurationFromElement,\n getUID,\n isDisabled,\n isElement,\n isRTL,\n isVisible,\n noop,\n onDOMContentLoaded,\n parseSelector,\n reflow,\n triggerTransitionEnd,\n toType\n}\n","/**\n * --------------------------------------------------------------------------\n * Bootstrap dom/event-handler.js\n * Licensed under MIT (https://github.com/twbs/bootstrap/blob/main/LICENSE)\n * --------------------------------------------------------------------------\n */\n\nimport { getjQuery } from '../util/index.js'\n\n/**\n * Constants\n */\n\nconst namespaceRegex = /[^.]*(?=\\..*)\\.|.*/\nconst stripNameRegex = /\\..*/\nconst stripUidRegex = /::\\d+$/\nconst eventRegistry = {} // Events storage\nlet uidEvent = 1\nconst customEvents = {\n mouseenter: 'mouseover',\n mouseleave: 'mouseout'\n}\n\nconst nativeEvents = new Set([\n 'click',\n 'dblclick',\n 'mouseup',\n 'mousedown',\n 'contextmenu',\n 'mousewheel',\n 'DOMMouseScroll',\n 'mouseover',\n 'mouseout',\n 'mousemove',\n 'selectstart',\n 'selectend',\n 'keydown',\n 'keypress',\n 'keyup',\n 'orientationchange',\n 'touchstart',\n 'touchmove',\n 'touchend',\n 'touchcancel',\n 'pointerdown',\n 'pointermove',\n 'pointerup',\n 'pointerleave',\n 'pointercancel',\n 'gesturestart',\n 'gesturechange',\n 'gestureend',\n 'focus',\n 'blur',\n 'change',\n 'reset',\n 'select',\n 'submit',\n 'focusin',\n 'focusout',\n 'load',\n 'unload',\n 'beforeunload',\n 'resize',\n 'move',\n 'DOMContentLoaded',\n 'readystatechange',\n 'error',\n 'abort',\n 'scroll'\n])\n\n/**\n * Private methods\n */\n\nfunction makeEventUid(element, uid) {\n return (uid && `${uid}::${uidEvent++}`) || element.uidEvent || uidEvent++\n}\n\nfunction getElementEvents(element) {\n const uid = makeEventUid(element)\n\n element.uidEvent = uid\n eventRegistry[uid] = eventRegistry[uid] || {}\n\n return eventRegistry[uid]\n}\n\nfunction bootstrapHandler(element, fn) {\n return function handler(event) {\n hydrateObj(event, { delegateTarget: element })\n\n if (handler.oneOff) {\n EventHandler.off(element, event.type, fn)\n }\n\n return fn.apply(element, [event])\n }\n}\n\nfunction bootstrapDelegationHandler(element, selector, fn) {\n return function handler(event) {\n const domElements = element.querySelectorAll(selector)\n\n for (let { target } = event; target && target !== this; target = target.parentNode) {\n for (const domElement of domElements) {\n if (domElement !== target) {\n continue\n }\n\n hydrateObj(event, { delegateTarget: target })\n\n if (handler.oneOff) {\n EventHandler.off(element, event.type, selector, fn)\n }\n\n return fn.apply(target, [event])\n }\n }\n }\n}\n\nfunction findHandler(events, callable, delegationSelector = null) {\n return Object.values(events)\n .find(event => event.callable === callable && event.delegationSelector === delegationSelector)\n}\n\nfunction normalizeParameters(originalTypeEvent, handler, delegationFunction) {\n const isDelegated = typeof handler === 'string'\n // TODO: tooltip passes `false` instead of selector, so we need to check\n const callable = isDelegated ? delegationFunction : (handler || delegationFunction)\n let typeEvent = getTypeEvent(originalTypeEvent)\n\n if (!nativeEvents.has(typeEvent)) {\n typeEvent = originalTypeEvent\n }\n\n return [isDelegated, callable, typeEvent]\n}\n\nfunction addHandler(element, originalTypeEvent, handler, delegationFunction, oneOff) {\n if (typeof originalTypeEvent !== 'string' || !element) {\n return\n }\n\n let [isDelegated, callable, typeEvent] = normalizeParameters(originalTypeEvent, handler, delegationFunction)\n\n // in case of mouseenter or mouseleave wrap the handler within a function that checks for its DOM position\n // this prevents the handler from being dispatched the same way as mouseover or mouseout does\n if (originalTypeEvent in customEvents) {\n const wrapFunction = fn => {\n return function (event) {\n if (!event.relatedTarget || (event.relatedTarget !== event.delegateTarget && !event.delegateTarget.contains(event.relatedTarget))) {\n return fn.call(this, event)\n }\n }\n }\n\n callable = wrapFunction(callable)\n }\n\n const events = getElementEvents(element)\n const handlers = events[typeEvent] || (events[typeEvent] = {})\n const previousFunction = findHandler(handlers, callable, isDelegated ? handler : null)\n\n if (previousFunction) {\n previousFunction.oneOff = previousFunction.oneOff && oneOff\n\n return\n }\n\n const uid = makeEventUid(callable, originalTypeEvent.replace(namespaceRegex, ''))\n const fn = isDelegated ?\n bootstrapDelegationHandler(element, handler, callable) :\n bootstrapHandler(element, callable)\n\n fn.delegationSelector = isDelegated ? handler : null\n fn.callable = callable\n fn.oneOff = oneOff\n fn.uidEvent = uid\n handlers[uid] = fn\n\n element.addEventListener(typeEvent, fn, isDelegated)\n}\n\nfunction removeHandler(element, events, typeEvent, handler, delegationSelector) {\n const fn = findHandler(events[typeEvent], handler, delegationSelector)\n\n if (!fn) {\n return\n }\n\n element.removeEventListener(typeEvent, fn, Boolean(delegationSelector))\n delete events[typeEvent][fn.uidEvent]\n}\n\nfunction removeNamespacedHandlers(element, events, typeEvent, namespace) {\n const storeElementEvent = events[typeEvent] || {}\n\n for (const [handlerKey, event] of Object.entries(storeElementEvent)) {\n if (handlerKey.includes(namespace)) {\n removeHandler(element, events, typeEvent, event.callable, event.delegationSelector)\n }\n }\n}\n\nfunction getTypeEvent(event) {\n // allow to get the native events from namespaced events ('click.bs.button' --> 'click')\n event = event.replace(stripNameRegex, '')\n return customEvents[event] || event\n}\n\nconst EventHandler = {\n on(element, event, handler, delegationFunction) {\n addHandler(element, event, handler, delegationFunction, false)\n },\n\n one(element, event, handler, delegationFunction) {\n addHandler(element, event, handler, delegationFunction, true)\n },\n\n off(element, originalTypeEvent, handler, delegationFunction) {\n if (typeof originalTypeEvent !== 'string' || !element) {\n return\n }\n\n const [isDelegated, callable, typeEvent] = normalizeParameters(originalTypeEvent, handler, delegationFunction)\n const inNamespace = typeEvent !== originalTypeEvent\n const events = getElementEvents(element)\n const storeElementEvent = events[typeEvent] || {}\n const isNamespace = originalTypeEvent.startsWith('.')\n\n if (typeof callable !== 'undefined') {\n // Simplest case: handler is passed, remove that listener ONLY.\n if (!Object.keys(storeElementEvent).length) {\n return\n }\n\n removeHandler(element, events, typeEvent, callable, isDelegated ? handler : null)\n return\n }\n\n if (isNamespace) {\n for (const elementEvent of Object.keys(events)) {\n removeNamespacedHandlers(element, events, elementEvent, originalTypeEvent.slice(1))\n }\n }\n\n for (const [keyHandlers, event] of Object.entries(storeElementEvent)) {\n const handlerKey = keyHandlers.replace(stripUidRegex, '')\n\n if (!inNamespace || originalTypeEvent.includes(handlerKey)) {\n removeHandler(element, events, typeEvent, event.callable, event.delegationSelector)\n }\n }\n },\n\n trigger(element, event, args) {\n if (typeof event !== 'string' || !element) {\n return null\n }\n\n const $ = getjQuery()\n const typeEvent = getTypeEvent(event)\n const inNamespace = event !== typeEvent\n\n let jQueryEvent = null\n let bubbles = true\n let nativeDispatch = true\n let defaultPrevented = false\n\n if (inNamespace && $) {\n jQueryEvent = $.Event(event, args)\n\n $(element).trigger(jQueryEvent)\n bubbles = !jQueryEvent.isPropagationStopped()\n nativeDispatch = !jQueryEvent.isImmediatePropagationStopped()\n defaultPrevented = jQueryEvent.isDefaultPrevented()\n }\n\n const evt = hydrateObj(new Event(event, { bubbles, cancelable: true }), args)\n\n if (defaultPrevented) {\n evt.preventDefault()\n }\n\n if (nativeDispatch) {\n element.dispatchEvent(evt)\n }\n\n if (evt.defaultPrevented && jQueryEvent) {\n jQueryEvent.preventDefault()\n }\n\n return evt\n }\n}\n\nfunction hydrateObj(obj, meta = {}) {\n for (const [key, value] of Object.entries(meta)) {\n try {\n obj[key] = value\n } catch {\n Object.defineProperty(obj, key, {\n configurable: true,\n get() {\n return value\n }\n })\n }\n }\n\n return obj\n}\n\nexport default EventHandler\n","/**\n * --------------------------------------------------------------------------\n * Bootstrap dom/manipulator.js\n * Licensed under MIT (https://github.com/twbs/bootstrap/blob/main/LICENSE)\n * --------------------------------------------------------------------------\n */\n\nfunction normalizeData(value) {\n if (value === 'true') {\n return true\n }\n\n if (value === 'false') {\n return false\n }\n\n if (value === Number(value).toString()) {\n return Number(value)\n }\n\n if (value === '' || value === 'null') {\n return null\n }\n\n if (typeof value !== 'string') {\n return value\n }\n\n try {\n return JSON.parse(decodeURIComponent(value))\n } catch {\n return value\n }\n}\n\nfunction normalizeDataKey(key) {\n return key.replace(/[A-Z]/g, chr => `-${chr.toLowerCase()}`)\n}\n\nconst Manipulator = {\n setDataAttribute(element, key, value) {\n element.setAttribute(`data-bs-${normalizeDataKey(key)}`, value)\n },\n\n removeDataAttribute(element, key) {\n element.removeAttribute(`data-bs-${normalizeDataKey(key)}`)\n },\n\n getDataAttributes(element) {\n if (!element) {\n return {}\n }\n\n const attributes = {}\n const bsKeys = Object.keys(element.dataset).filter(key => key.startsWith('bs') && !key.startsWith('bsConfig'))\n\n for (const key of bsKeys) {\n let pureKey = key.replace(/^bs/, '')\n pureKey = pureKey.charAt(0).toLowerCase() + pureKey.slice(1, pureKey.length)\n attributes[pureKey] = normalizeData(element.dataset[key])\n }\n\n return attributes\n },\n\n getDataAttribute(element, key) {\n return normalizeData(element.getAttribute(`data-bs-${normalizeDataKey(key)}`))\n }\n}\n\nexport default Manipulator\n","/**\n * --------------------------------------------------------------------------\n * Bootstrap util/config.js\n * Licensed under MIT (https://github.com/twbs/bootstrap/blob/main/LICENSE)\n * --------------------------------------------------------------------------\n */\n\nimport Manipulator from '../dom/manipulator.js'\nimport { isElement, toType } from './index.js'\n\n/**\n * Class definition\n */\n\nclass Config {\n // Getters\n static get Default() {\n return {}\n }\n\n static get DefaultType() {\n return {}\n }\n\n static get NAME() {\n throw new Error('You have to implement the static method \"NAME\", for each component!')\n }\n\n _getConfig(config) {\n config = this._mergeConfigObj(config)\n config = this._configAfterMerge(config)\n this._typeCheckConfig(config)\n return config\n }\n\n _configAfterMerge(config) {\n return config\n }\n\n _mergeConfigObj(config, element) {\n const jsonConfig = isElement(element) ? Manipulator.getDataAttribute(element, 'config') : {} // try to parse\n\n return {\n ...this.constructor.Default,\n ...(typeof jsonConfig === 'object' ? jsonConfig : {}),\n ...(isElement(element) ? Manipulator.getDataAttributes(element) : {}),\n ...(typeof config === 'object' ? config : {})\n }\n }\n\n _typeCheckConfig(config, configTypes = this.constructor.DefaultType) {\n for (const [property, expectedTypes] of Object.entries(configTypes)) {\n const value = config[property]\n const valueType = isElement(value) ? 'element' : toType(value)\n\n if (!new RegExp(expectedTypes).test(valueType)) {\n throw new TypeError(\n `${this.constructor.NAME.toUpperCase()}: Option \"${property}\" provided type \"${valueType}\" but expected type \"${expectedTypes}\".`\n )\n }\n }\n }\n}\n\nexport default Config\n","/**\n * --------------------------------------------------------------------------\n * Bootstrap base-component.js\n * Licensed under MIT (https://github.com/twbs/bootstrap/blob/main/LICENSE)\n * --------------------------------------------------------------------------\n */\n\nimport Data from './dom/data.js'\nimport EventHandler from './dom/event-handler.js'\nimport Config from './util/config.js'\nimport { executeAfterTransition, getElement } from './util/index.js'\n\n/**\n * Constants\n */\n\nconst VERSION = '5.3.1'\n\n/**\n * Class definition\n */\n\nclass BaseComponent extends Config {\n constructor(element, config) {\n super()\n\n element = getElement(element)\n if (!element) {\n return\n }\n\n this._element = element\n this._config = this._getConfig(config)\n\n Data.set(this._element, this.constructor.DATA_KEY, this)\n }\n\n // Public\n dispose() {\n Data.remove(this._element, this.constructor.DATA_KEY)\n EventHandler.off(this._element, this.constructor.EVENT_KEY)\n\n for (const propertyName of Object.getOwnPropertyNames(this)) {\n this[propertyName] = null\n }\n }\n\n _queueCallback(callback, element, isAnimated = true) {\n executeAfterTransition(callback, element, isAnimated)\n }\n\n _getConfig(config) {\n config = this._mergeConfigObj(config, this._element)\n config = this._configAfterMerge(config)\n this._typeCheckConfig(config)\n return config\n }\n\n // Static\n static getInstance(element) {\n return Data.get(getElement(element), this.DATA_KEY)\n }\n\n static getOrCreateInstance(element, config = {}) {\n return this.getInstance(element) || new this(element, typeof config === 'object' ? config : null)\n }\n\n static get VERSION() {\n return VERSION\n }\n\n static get DATA_KEY() {\n return `bs.${this.NAME}`\n }\n\n static get EVENT_KEY() {\n return `.${this.DATA_KEY}`\n }\n\n static eventName(name) {\n return `${name}${this.EVENT_KEY}`\n }\n}\n\nexport default BaseComponent\n","/**\n * --------------------------------------------------------------------------\n * Bootstrap dom/selector-engine.js\n * Licensed under MIT (https://github.com/twbs/bootstrap/blob/main/LICENSE)\n * --------------------------------------------------------------------------\n */\n\nimport { isDisabled, isVisible, parseSelector } from '../util/index.js'\n\nconst getSelector = element => {\n let selector = element.getAttribute('data-bs-target')\n\n if (!selector || selector === '#') {\n let hrefAttribute = element.getAttribute('href')\n\n // The only valid content that could double as a selector are IDs or classes,\n // so everything starting with `#` or `.`. If a \"real\" URL is used as the selector,\n // `document.querySelector` will rightfully complain it is invalid.\n // See https://github.com/twbs/bootstrap/issues/32273\n if (!hrefAttribute || (!hrefAttribute.includes('#') && !hrefAttribute.startsWith('.'))) {\n return null\n }\n\n // Just in case some CMS puts out a full URL with the anchor appended\n if (hrefAttribute.includes('#') && !hrefAttribute.startsWith('#')) {\n hrefAttribute = `#${hrefAttribute.split('#')[1]}`\n }\n\n selector = hrefAttribute && hrefAttribute !== '#' ? hrefAttribute.trim() : null\n }\n\n return parseSelector(selector)\n}\n\nconst SelectorEngine = {\n find(selector, element = document.documentElement) {\n return [].concat(...Element.prototype.querySelectorAll.call(element, selector))\n },\n\n findOne(selector, element = document.documentElement) {\n return Element.prototype.querySelector.call(element, selector)\n },\n\n children(element, selector) {\n return [].concat(...element.children).filter(child => child.matches(selector))\n },\n\n parents(element, selector) {\n const parents = []\n let ancestor = element.parentNode.closest(selector)\n\n while (ancestor) {\n parents.push(ancestor)\n ancestor = ancestor.parentNode.closest(selector)\n }\n\n return parents\n },\n\n prev(element, selector) {\n let previous = element.previousElementSibling\n\n while (previous) {\n if (previous.matches(selector)) {\n return [previous]\n }\n\n previous = previous.previousElementSibling\n }\n\n return []\n },\n // TODO: this is now unused; remove later along with prev()\n next(element, selector) {\n let next = element.nextElementSibling\n\n while (next) {\n if (next.matches(selector)) {\n return [next]\n }\n\n next = next.nextElementSibling\n }\n\n return []\n },\n\n focusableChildren(element) {\n const focusables = [\n 'a',\n 'button',\n 'input',\n 'textarea',\n 'select',\n 'details',\n '[tabindex]',\n '[contenteditable=\"true\"]'\n ].map(selector => `${selector}:not([tabindex^=\"-\"])`).join(',')\n\n return this.find(focusables, element).filter(el => !isDisabled(el) && isVisible(el))\n },\n\n getSelectorFromElement(element) {\n const selector = getSelector(element)\n\n if (selector) {\n return SelectorEngine.findOne(selector) ? selector : null\n }\n\n return null\n },\n\n getElementFromSelector(element) {\n const selector = getSelector(element)\n\n return selector ? SelectorEngine.findOne(selector) : null\n },\n\n getMultipleElementsFromSelector(element) {\n const selector = getSelector(element)\n\n return selector ? SelectorEngine.find(selector) : []\n }\n}\n\nexport default SelectorEngine\n","/**\n * --------------------------------------------------------------------------\n * Bootstrap util/component-functions.js\n * Licensed under MIT (https://github.com/twbs/bootstrap/blob/main/LICENSE)\n * --------------------------------------------------------------------------\n */\n\nimport EventHandler from '../dom/event-handler.js'\nimport SelectorEngine from '../dom/selector-engine.js'\nimport { isDisabled } from './index.js'\n\nconst enableDismissTrigger = (component, method = 'hide') => {\n const clickEvent = `click.dismiss${component.EVENT_KEY}`\n const name = component.NAME\n\n EventHandler.on(document, clickEvent, `[data-bs-dismiss=\"${name}\"]`, function (event) {\n if (['A', 'AREA'].includes(this.tagName)) {\n event.preventDefault()\n }\n\n if (isDisabled(this)) {\n return\n }\n\n const target = SelectorEngine.getElementFromSelector(this) || this.closest(`.${name}`)\n const instance = component.getOrCreateInstance(target)\n\n // Method argument is left, for Alert and only, as it doesn't implement the 'hide' method\n instance[method]()\n })\n}\n\nexport {\n enableDismissTrigger\n}\n","/**\n * --------------------------------------------------------------------------\n * Bootstrap alert.js\n * Licensed under MIT (https://github.com/twbs/bootstrap/blob/main/LICENSE)\n * --------------------------------------------------------------------------\n */\n\nimport BaseComponent from './base-component.js'\nimport EventHandler from './dom/event-handler.js'\nimport { enableDismissTrigger } from './util/component-functions.js'\nimport { defineJQueryPlugin } from './util/index.js'\n\n/**\n * Constants\n */\n\nconst NAME = 'alert'\nconst DATA_KEY = 'bs.alert'\nconst EVENT_KEY = `.${DATA_KEY}`\n\nconst EVENT_CLOSE = `close${EVENT_KEY}`\nconst EVENT_CLOSED = `closed${EVENT_KEY}`\nconst CLASS_NAME_FADE = 'fade'\nconst CLASS_NAME_SHOW = 'show'\n\n/**\n * Class definition\n */\n\nclass Alert extends BaseComponent {\n // Getters\n static get NAME() {\n return NAME\n }\n\n // Public\n close() {\n const closeEvent = EventHandler.trigger(this._element, EVENT_CLOSE)\n\n if (closeEvent.defaultPrevented) {\n return\n }\n\n this._element.classList.remove(CLASS_NAME_SHOW)\n\n const isAnimated = this._element.classList.contains(CLASS_NAME_FADE)\n this._queueCallback(() => this._destroyElement(), this._element, isAnimated)\n }\n\n // Private\n _destroyElement() {\n this._element.remove()\n EventHandler.trigger(this._element, EVENT_CLOSED)\n this.dispose()\n }\n\n // Static\n static jQueryInterface(config) {\n return this.each(function () {\n const data = Alert.getOrCreateInstance(this)\n\n if (typeof config !== 'string') {\n return\n }\n\n if (data[config] === undefined || config.startsWith('_') || config === 'constructor') {\n throw new TypeError(`No method named \"${config}\"`)\n }\n\n data[config](this)\n })\n }\n}\n\n/**\n * Data API implementation\n */\n\nenableDismissTrigger(Alert, 'close')\n\n/**\n * jQuery\n */\n\ndefineJQueryPlugin(Alert)\n\nexport default Alert\n","/**\n * --------------------------------------------------------------------------\n * Bootstrap button.js\n * Licensed under MIT (https://github.com/twbs/bootstrap/blob/main/LICENSE)\n * --------------------------------------------------------------------------\n */\n\nimport BaseComponent from './base-component.js'\nimport EventHandler from './dom/event-handler.js'\nimport { defineJQueryPlugin } from './util/index.js'\n\n/**\n * Constants\n */\n\nconst NAME = 'button'\nconst DATA_KEY = 'bs.button'\nconst EVENT_KEY = `.${DATA_KEY}`\nconst DATA_API_KEY = '.data-api'\n\nconst CLASS_NAME_ACTIVE = 'active'\nconst SELECTOR_DATA_TOGGLE = '[data-bs-toggle=\"button\"]'\nconst EVENT_CLICK_DATA_API = `click${EVENT_KEY}${DATA_API_KEY}`\n\n/**\n * Class definition\n */\n\nclass Button extends BaseComponent {\n // Getters\n static get NAME() {\n return NAME\n }\n\n // Public\n toggle() {\n // Toggle class and sync the `aria-pressed` attribute with the return value of the `.toggle()` method\n this._element.setAttribute('aria-pressed', this._element.classList.toggle(CLASS_NAME_ACTIVE))\n }\n\n // Static\n static jQueryInterface(config) {\n return this.each(function () {\n const data = Button.getOrCreateInstance(this)\n\n if (config === 'toggle') {\n data[config]()\n }\n })\n }\n}\n\n/**\n * Data API implementation\n */\n\nEventHandler.on(document, EVENT_CLICK_DATA_API, SELECTOR_DATA_TOGGLE, event => {\n event.preventDefault()\n\n const button = event.target.closest(SELECTOR_DATA_TOGGLE)\n const data = Button.getOrCreateInstance(button)\n\n data.toggle()\n})\n\n/**\n * jQuery\n */\n\ndefineJQueryPlugin(Button)\n\nexport default Button\n","/**\n * --------------------------------------------------------------------------\n * Bootstrap util/swipe.js\n * Licensed under MIT (https://github.com/twbs/bootstrap/blob/main/LICENSE)\n * --------------------------------------------------------------------------\n */\n\nimport EventHandler from '../dom/event-handler.js'\nimport Config from './config.js'\nimport { execute } from './index.js'\n\n/**\n * Constants\n */\n\nconst NAME = 'swipe'\nconst EVENT_KEY = '.bs.swipe'\nconst EVENT_TOUCHSTART = `touchstart${EVENT_KEY}`\nconst EVENT_TOUCHMOVE = `touchmove${EVENT_KEY}`\nconst EVENT_TOUCHEND = `touchend${EVENT_KEY}`\nconst EVENT_POINTERDOWN = `pointerdown${EVENT_KEY}`\nconst EVENT_POINTERUP = `pointerup${EVENT_KEY}`\nconst POINTER_TYPE_TOUCH = 'touch'\nconst POINTER_TYPE_PEN = 'pen'\nconst CLASS_NAME_POINTER_EVENT = 'pointer-event'\nconst SWIPE_THRESHOLD = 40\n\nconst Default = {\n endCallback: null,\n leftCallback: null,\n rightCallback: null\n}\n\nconst DefaultType = {\n endCallback: '(function|null)',\n leftCallback: '(function|null)',\n rightCallback: '(function|null)'\n}\n\n/**\n * Class definition\n */\n\nclass Swipe extends Config {\n constructor(element, config) {\n super()\n this._element = element\n\n if (!element || !Swipe.isSupported()) {\n return\n }\n\n this._config = this._getConfig(config)\n this._deltaX = 0\n this._supportPointerEvents = Boolean(window.PointerEvent)\n this._initEvents()\n }\n\n // Getters\n static get Default() {\n return Default\n }\n\n static get DefaultType() {\n return DefaultType\n }\n\n static get NAME() {\n return NAME\n }\n\n // Public\n dispose() {\n EventHandler.off(this._element, EVENT_KEY)\n }\n\n // Private\n _start(event) {\n if (!this._supportPointerEvents) {\n this._deltaX = event.touches[0].clientX\n\n return\n }\n\n if (this._eventIsPointerPenTouch(event)) {\n this._deltaX = event.clientX\n }\n }\n\n _end(event) {\n if (this._eventIsPointerPenTouch(event)) {\n this._deltaX = event.clientX - this._deltaX\n }\n\n this._handleSwipe()\n execute(this._config.endCallback)\n }\n\n _move(event) {\n this._deltaX = event.touches && event.touches.length > 1 ?\n 0 :\n event.touches[0].clientX - this._deltaX\n }\n\n _handleSwipe() {\n const absDeltaX = Math.abs(this._deltaX)\n\n if (absDeltaX <= SWIPE_THRESHOLD) {\n return\n }\n\n const direction = absDeltaX / this._deltaX\n\n this._deltaX = 0\n\n if (!direction) {\n return\n }\n\n execute(direction > 0 ? this._config.rightCallback : this._config.leftCallback)\n }\n\n _initEvents() {\n if (this._supportPointerEvents) {\n EventHandler.on(this._element, EVENT_POINTERDOWN, event => this._start(event))\n EventHandler.on(this._element, EVENT_POINTERUP, event => this._end(event))\n\n this._element.classList.add(CLASS_NAME_POINTER_EVENT)\n } else {\n EventHandler.on(this._element, EVENT_TOUCHSTART, event => this._start(event))\n EventHandler.on(this._element, EVENT_TOUCHMOVE, event => this._move(event))\n EventHandler.on(this._element, EVENT_TOUCHEND, event => this._end(event))\n }\n }\n\n _eventIsPointerPenTouch(event) {\n return this._supportPointerEvents && (event.pointerType === POINTER_TYPE_PEN || event.pointerType === POINTER_TYPE_TOUCH)\n }\n\n // Static\n static isSupported() {\n return 'ontouchstart' in document.documentElement || navigator.maxTouchPoints > 0\n }\n}\n\nexport default Swipe\n","/**\n * --------------------------------------------------------------------------\n * Bootstrap carousel.js\n * Licensed under MIT (https://github.com/twbs/bootstrap/blob/main/LICENSE)\n * --------------------------------------------------------------------------\n */\n\nimport BaseComponent from './base-component.js'\nimport EventHandler from './dom/event-handler.js'\nimport Manipulator from './dom/manipulator.js'\nimport SelectorEngine from './dom/selector-engine.js'\nimport {\n defineJQueryPlugin,\n getNextActiveElement,\n isRTL,\n isVisible,\n reflow,\n triggerTransitionEnd\n} from './util/index.js'\nimport Swipe from './util/swipe.js'\n\n/**\n * Constants\n */\n\nconst NAME = 'carousel'\nconst DATA_KEY = 'bs.carousel'\nconst EVENT_KEY = `.${DATA_KEY}`\nconst DATA_API_KEY = '.data-api'\n\nconst ARROW_LEFT_KEY = 'ArrowLeft'\nconst ARROW_RIGHT_KEY = 'ArrowRight'\nconst TOUCHEVENT_COMPAT_WAIT = 500 // Time for mouse compat events to fire after touch\n\nconst ORDER_NEXT = 'next'\nconst ORDER_PREV = 'prev'\nconst DIRECTION_LEFT = 'left'\nconst DIRECTION_RIGHT = 'right'\n\nconst EVENT_SLIDE = `slide${EVENT_KEY}`\nconst EVENT_SLID = `slid${EVENT_KEY}`\nconst EVENT_KEYDOWN = `keydown${EVENT_KEY}`\nconst EVENT_MOUSEENTER = `mouseenter${EVENT_KEY}`\nconst EVENT_MOUSELEAVE = `mouseleave${EVENT_KEY}`\nconst EVENT_DRAG_START = `dragstart${EVENT_KEY}`\nconst EVENT_LOAD_DATA_API = `load${EVENT_KEY}${DATA_API_KEY}`\nconst EVENT_CLICK_DATA_API = `click${EVENT_KEY}${DATA_API_KEY}`\n\nconst CLASS_NAME_CAROUSEL = 'carousel'\nconst CLASS_NAME_ACTIVE = 'active'\nconst CLASS_NAME_SLIDE = 'slide'\nconst CLASS_NAME_END = 'carousel-item-end'\nconst CLASS_NAME_START = 'carousel-item-start'\nconst CLASS_NAME_NEXT = 'carousel-item-next'\nconst CLASS_NAME_PREV = 'carousel-item-prev'\n\nconst SELECTOR_ACTIVE = '.active'\nconst SELECTOR_ITEM = '.carousel-item'\nconst SELECTOR_ACTIVE_ITEM = SELECTOR_ACTIVE + SELECTOR_ITEM\nconst SELECTOR_ITEM_IMG = '.carousel-item img'\nconst SELECTOR_INDICATORS = '.carousel-indicators'\nconst SELECTOR_DATA_SLIDE = '[data-bs-slide], [data-bs-slide-to]'\nconst SELECTOR_DATA_RIDE = '[data-bs-ride=\"carousel\"]'\n\nconst KEY_TO_DIRECTION = {\n [ARROW_LEFT_KEY]: DIRECTION_RIGHT,\n [ARROW_RIGHT_KEY]: DIRECTION_LEFT\n}\n\nconst Default = {\n interval: 5000,\n keyboard: true,\n pause: 'hover',\n ride: false,\n touch: true,\n wrap: true\n}\n\nconst DefaultType = {\n interval: '(number|boolean)', // TODO:v6 remove boolean support\n keyboard: 'boolean',\n pause: '(string|boolean)',\n ride: '(boolean|string)',\n touch: 'boolean',\n wrap: 'boolean'\n}\n\n/**\n * Class definition\n */\n\nclass Carousel extends BaseComponent {\n constructor(element, config) {\n super(element, config)\n\n this._interval = null\n this._activeElement = null\n this._isSliding = false\n this.touchTimeout = null\n this._swipeHelper = null\n\n this._indicatorsElement = SelectorEngine.findOne(SELECTOR_INDICATORS, this._element)\n this._addEventListeners()\n\n if (this._config.ride === CLASS_NAME_CAROUSEL) {\n this.cycle()\n }\n }\n\n // Getters\n static get Default() {\n return Default\n }\n\n static get DefaultType() {\n return DefaultType\n }\n\n static get NAME() {\n return NAME\n }\n\n // Public\n next() {\n this._slide(ORDER_NEXT)\n }\n\n nextWhenVisible() {\n // FIXME TODO use `document.visibilityState`\n // Don't call next when the page isn't visible\n // or the carousel or its parent isn't visible\n if (!document.hidden && isVisible(this._element)) {\n this.next()\n }\n }\n\n prev() {\n this._slide(ORDER_PREV)\n }\n\n pause() {\n if (this._isSliding) {\n triggerTransitionEnd(this._element)\n }\n\n this._clearInterval()\n }\n\n cycle() {\n this._clearInterval()\n this._updateInterval()\n\n this._interval = setInterval(() => this.nextWhenVisible(), this._config.interval)\n }\n\n _maybeEnableCycle() {\n if (!this._config.ride) {\n return\n }\n\n if (this._isSliding) {\n EventHandler.one(this._element, EVENT_SLID, () => this.cycle())\n return\n }\n\n this.cycle()\n }\n\n to(index) {\n const items = this._getItems()\n if (index > items.length - 1 || index < 0) {\n return\n }\n\n if (this._isSliding) {\n EventHandler.one(this._element, EVENT_SLID, () => this.to(index))\n return\n }\n\n const activeIndex = this._getItemIndex(this._getActive())\n if (activeIndex === index) {\n return\n }\n\n const order = index > activeIndex ? ORDER_NEXT : ORDER_PREV\n\n this._slide(order, items[index])\n }\n\n dispose() {\n if (this._swipeHelper) {\n this._swipeHelper.dispose()\n }\n\n super.dispose()\n }\n\n // Private\n _configAfterMerge(config) {\n config.defaultInterval = config.interval\n return config\n }\n\n _addEventListeners() {\n if (this._config.keyboard) {\n EventHandler.on(this._element, EVENT_KEYDOWN, event => this._keydown(event))\n }\n\n if (this._config.pause === 'hover') {\n EventHandler.on(this._element, EVENT_MOUSEENTER, () => this.pause())\n EventHandler.on(this._element, EVENT_MOUSELEAVE, () => this._maybeEnableCycle())\n }\n\n if (this._config.touch && Swipe.isSupported()) {\n this._addTouchEventListeners()\n }\n }\n\n _addTouchEventListeners() {\n for (const img of SelectorEngine.find(SELECTOR_ITEM_IMG, this._element)) {\n EventHandler.on(img, EVENT_DRAG_START, event => event.preventDefault())\n }\n\n const endCallBack = () => {\n if (this._config.pause !== 'hover') {\n return\n }\n\n // If it's a touch-enabled device, mouseenter/leave are fired as\n // part of the mouse compatibility events on first tap - the carousel\n // would stop cycling until user tapped out of it;\n // here, we listen for touchend, explicitly pause the carousel\n // (as if it's the second time we tap on it, mouseenter compat event\n // is NOT fired) and after a timeout (to allow for mouse compatibility\n // events to fire) we explicitly restart cycling\n\n this.pause()\n if (this.touchTimeout) {\n clearTimeout(this.touchTimeout)\n }\n\n this.touchTimeout = setTimeout(() => this._maybeEnableCycle(), TOUCHEVENT_COMPAT_WAIT + this._config.interval)\n }\n\n const swipeConfig = {\n leftCallback: () => this._slide(this._directionToOrder(DIRECTION_LEFT)),\n rightCallback: () => this._slide(this._directionToOrder(DIRECTION_RIGHT)),\n endCallback: endCallBack\n }\n\n this._swipeHelper = new Swipe(this._element, swipeConfig)\n }\n\n _keydown(event) {\n if (/input|textarea/i.test(event.target.tagName)) {\n return\n }\n\n const direction = KEY_TO_DIRECTION[event.key]\n if (direction) {\n event.preventDefault()\n this._slide(this._directionToOrder(direction))\n }\n }\n\n _getItemIndex(element) {\n return this._getItems().indexOf(element)\n }\n\n _setActiveIndicatorElement(index) {\n if (!this._indicatorsElement) {\n return\n }\n\n const activeIndicator = SelectorEngine.findOne(SELECTOR_ACTIVE, this._indicatorsElement)\n\n activeIndicator.classList.remove(CLASS_NAME_ACTIVE)\n activeIndicator.removeAttribute('aria-current')\n\n const newActiveIndicator = SelectorEngine.findOne(`[data-bs-slide-to=\"${index}\"]`, this._indicatorsElement)\n\n if (newActiveIndicator) {\n newActiveIndicator.classList.add(CLASS_NAME_ACTIVE)\n newActiveIndicator.setAttribute('aria-current', 'true')\n }\n }\n\n _updateInterval() {\n const element = this._activeElement || this._getActive()\n\n if (!element) {\n return\n }\n\n const elementInterval = Number.parseInt(element.getAttribute('data-bs-interval'), 10)\n\n this._config.interval = elementInterval || this._config.defaultInterval\n }\n\n _slide(order, element = null) {\n if (this._isSliding) {\n return\n }\n\n const activeElement = this._getActive()\n const isNext = order === ORDER_NEXT\n const nextElement = element || getNextActiveElement(this._getItems(), activeElement, isNext, this._config.wrap)\n\n if (nextElement === activeElement) {\n return\n }\n\n const nextElementIndex = this._getItemIndex(nextElement)\n\n const triggerEvent = eventName => {\n return EventHandler.trigger(this._element, eventName, {\n relatedTarget: nextElement,\n direction: this._orderToDirection(order),\n from: this._getItemIndex(activeElement),\n to: nextElementIndex\n })\n }\n\n const slideEvent = triggerEvent(EVENT_SLIDE)\n\n if (slideEvent.defaultPrevented) {\n return\n }\n\n if (!activeElement || !nextElement) {\n // Some weirdness is happening, so we bail\n // TODO: change tests that use empty divs to avoid this check\n return\n }\n\n const isCycling = Boolean(this._interval)\n this.pause()\n\n this._isSliding = true\n\n this._setActiveIndicatorElement(nextElementIndex)\n this._activeElement = nextElement\n\n const directionalClassName = isNext ? CLASS_NAME_START : CLASS_NAME_END\n const orderClassName = isNext ? CLASS_NAME_NEXT : CLASS_NAME_PREV\n\n nextElement.classList.add(orderClassName)\n\n reflow(nextElement)\n\n activeElement.classList.add(directionalClassName)\n nextElement.classList.add(directionalClassName)\n\n const completeCallBack = () => {\n nextElement.classList.remove(directionalClassName, orderClassName)\n nextElement.classList.add(CLASS_NAME_ACTIVE)\n\n activeElement.classList.remove(CLASS_NAME_ACTIVE, orderClassName, directionalClassName)\n\n this._isSliding = false\n\n triggerEvent(EVENT_SLID)\n }\n\n this._queueCallback(completeCallBack, activeElement, this._isAnimated())\n\n if (isCycling) {\n this.cycle()\n }\n }\n\n _isAnimated() {\n return this._element.classList.contains(CLASS_NAME_SLIDE)\n }\n\n _getActive() {\n return SelectorEngine.findOne(SELECTOR_ACTIVE_ITEM, this._element)\n }\n\n _getItems() {\n return SelectorEngine.find(SELECTOR_ITEM, this._element)\n }\n\n _clearInterval() {\n if (this._interval) {\n clearInterval(this._interval)\n this._interval = null\n }\n }\n\n _directionToOrder(direction) {\n if (isRTL()) {\n return direction === DIRECTION_LEFT ? ORDER_PREV : ORDER_NEXT\n }\n\n return direction === DIRECTION_LEFT ? ORDER_NEXT : ORDER_PREV\n }\n\n _orderToDirection(order) {\n if (isRTL()) {\n return order === ORDER_PREV ? DIRECTION_LEFT : DIRECTION_RIGHT\n }\n\n return order === ORDER_PREV ? DIRECTION_RIGHT : DIRECTION_LEFT\n }\n\n // Static\n static jQueryInterface(config) {\n return this.each(function () {\n const data = Carousel.getOrCreateInstance(this, config)\n\n if (typeof config === 'number') {\n data.to(config)\n return\n }\n\n if (typeof config === 'string') {\n if (data[config] === undefined || config.startsWith('_') || config === 'constructor') {\n throw new TypeError(`No method named \"${config}\"`)\n }\n\n data[config]()\n }\n })\n }\n}\n\n/**\n * Data API implementation\n */\n\nEventHandler.on(document, EVENT_CLICK_DATA_API, SELECTOR_DATA_SLIDE, function (event) {\n const target = SelectorEngine.getElementFromSelector(this)\n\n if (!target || !target.classList.contains(CLASS_NAME_CAROUSEL)) {\n return\n }\n\n event.preventDefault()\n\n const carousel = Carousel.getOrCreateInstance(target)\n const slideIndex = this.getAttribute('data-bs-slide-to')\n\n if (slideIndex) {\n carousel.to(slideIndex)\n carousel._maybeEnableCycle()\n return\n }\n\n if (Manipulator.getDataAttribute(this, 'slide') === 'next') {\n carousel.next()\n carousel._maybeEnableCycle()\n return\n }\n\n carousel.prev()\n carousel._maybeEnableCycle()\n})\n\nEventHandler.on(window, EVENT_LOAD_DATA_API, () => {\n const carousels = SelectorEngine.find(SELECTOR_DATA_RIDE)\n\n for (const carousel of carousels) {\n Carousel.getOrCreateInstance(carousel)\n }\n})\n\n/**\n * jQuery\n */\n\ndefineJQueryPlugin(Carousel)\n\nexport default Carousel\n","/**\n * --------------------------------------------------------------------------\n * Bootstrap collapse.js\n * Licensed under MIT (https://github.com/twbs/bootstrap/blob/main/LICENSE)\n * --------------------------------------------------------------------------\n */\n\nimport BaseComponent from './base-component.js'\nimport EventHandler from './dom/event-handler.js'\nimport SelectorEngine from './dom/selector-engine.js'\nimport {\n defineJQueryPlugin,\n getElement,\n reflow\n} from './util/index.js'\n\n/**\n * Constants\n */\n\nconst NAME = 'collapse'\nconst DATA_KEY = 'bs.collapse'\nconst EVENT_KEY = `.${DATA_KEY}`\nconst DATA_API_KEY = '.data-api'\n\nconst EVENT_SHOW = `show${EVENT_KEY}`\nconst EVENT_SHOWN = `shown${EVENT_KEY}`\nconst EVENT_HIDE = `hide${EVENT_KEY}`\nconst EVENT_HIDDEN = `hidden${EVENT_KEY}`\nconst EVENT_CLICK_DATA_API = `click${EVENT_KEY}${DATA_API_KEY}`\n\nconst CLASS_NAME_SHOW = 'show'\nconst CLASS_NAME_COLLAPSE = 'collapse'\nconst CLASS_NAME_COLLAPSING = 'collapsing'\nconst CLASS_NAME_COLLAPSED = 'collapsed'\nconst CLASS_NAME_DEEPER_CHILDREN = `:scope .${CLASS_NAME_COLLAPSE} .${CLASS_NAME_COLLAPSE}`\nconst CLASS_NAME_HORIZONTAL = 'collapse-horizontal'\n\nconst WIDTH = 'width'\nconst HEIGHT = 'height'\n\nconst SELECTOR_ACTIVES = '.collapse.show, .collapse.collapsing'\nconst SELECTOR_DATA_TOGGLE = '[data-bs-toggle=\"collapse\"]'\n\nconst Default = {\n parent: null,\n toggle: true\n}\n\nconst DefaultType = {\n parent: '(null|element)',\n toggle: 'boolean'\n}\n\n/**\n * Class definition\n */\n\nclass Collapse extends BaseComponent {\n constructor(element, config) {\n super(element, config)\n\n this._isTransitioning = false\n this._triggerArray = []\n\n const toggleList = SelectorEngine.find(SELECTOR_DATA_TOGGLE)\n\n for (const elem of toggleList) {\n const selector = SelectorEngine.getSelectorFromElement(elem)\n const filterElement = SelectorEngine.find(selector)\n .filter(foundElement => foundElement === this._element)\n\n if (selector !== null && filterElement.length) {\n this._triggerArray.push(elem)\n }\n }\n\n this._initializeChildren()\n\n if (!this._config.parent) {\n this._addAriaAndCollapsedClass(this._triggerArray, this._isShown())\n }\n\n if (this._config.toggle) {\n this.toggle()\n }\n }\n\n // Getters\n static get Default() {\n return Default\n }\n\n static get DefaultType() {\n return DefaultType\n }\n\n static get NAME() {\n return NAME\n }\n\n // Public\n toggle() {\n if (this._isShown()) {\n this.hide()\n } else {\n this.show()\n }\n }\n\n show() {\n if (this._isTransitioning || this._isShown()) {\n return\n }\n\n let activeChildren = []\n\n // find active children\n if (this._config.parent) {\n activeChildren = this._getFirstLevelChildren(SELECTOR_ACTIVES)\n .filter(element => element !== this._element)\n .map(element => Collapse.getOrCreateInstance(element, { toggle: false }))\n }\n\n if (activeChildren.length && activeChildren[0]._isTransitioning) {\n return\n }\n\n const startEvent = EventHandler.trigger(this._element, EVENT_SHOW)\n if (startEvent.defaultPrevented) {\n return\n }\n\n for (const activeInstance of activeChildren) {\n activeInstance.hide()\n }\n\n const dimension = this._getDimension()\n\n this._element.classList.remove(CLASS_NAME_COLLAPSE)\n this._element.classList.add(CLASS_NAME_COLLAPSING)\n\n this._element.style[dimension] = 0\n\n this._addAriaAndCollapsedClass(this._triggerArray, true)\n this._isTransitioning = true\n\n const complete = () => {\n this._isTransitioning = false\n\n this._element.classList.remove(CLASS_NAME_COLLAPSING)\n this._element.classList.add(CLASS_NAME_COLLAPSE, CLASS_NAME_SHOW)\n\n this._element.style[dimension] = ''\n\n EventHandler.trigger(this._element, EVENT_SHOWN)\n }\n\n const capitalizedDimension = dimension[0].toUpperCase() + dimension.slice(1)\n const scrollSize = `scroll${capitalizedDimension}`\n\n this._queueCallback(complete, this._element, true)\n this._element.style[dimension] = `${this._element[scrollSize]}px`\n }\n\n hide() {\n if (this._isTransitioning || !this._isShown()) {\n return\n }\n\n const startEvent = EventHandler.trigger(this._element, EVENT_HIDE)\n if (startEvent.defaultPrevented) {\n return\n }\n\n const dimension = this._getDimension()\n\n this._element.style[dimension] = `${this._element.getBoundingClientRect()[dimension]}px`\n\n reflow(this._element)\n\n this._element.classList.add(CLASS_NAME_COLLAPSING)\n this._element.classList.remove(CLASS_NAME_COLLAPSE, CLASS_NAME_SHOW)\n\n for (const trigger of this._triggerArray) {\n const element = SelectorEngine.getElementFromSelector(trigger)\n\n if (element && !this._isShown(element)) {\n this._addAriaAndCollapsedClass([trigger], false)\n }\n }\n\n this._isTransitioning = true\n\n const complete = () => {\n this._isTransitioning = false\n this._element.classList.remove(CLASS_NAME_COLLAPSING)\n this._element.classList.add(CLASS_NAME_COLLAPSE)\n EventHandler.trigger(this._element, EVENT_HIDDEN)\n }\n\n this._element.style[dimension] = ''\n\n this._queueCallback(complete, this._element, true)\n }\n\n _isShown(element = this._element) {\n return element.classList.contains(CLASS_NAME_SHOW)\n }\n\n // Private\n _configAfterMerge(config) {\n config.toggle = Boolean(config.toggle) // Coerce string values\n config.parent = getElement(config.parent)\n return config\n }\n\n _getDimension() {\n return this._element.classList.contains(CLASS_NAME_HORIZONTAL) ? WIDTH : HEIGHT\n }\n\n _initializeChildren() {\n if (!this._config.parent) {\n return\n }\n\n const children = this._getFirstLevelChildren(SELECTOR_DATA_TOGGLE)\n\n for (const element of children) {\n const selected = SelectorEngine.getElementFromSelector(element)\n\n if (selected) {\n this._addAriaAndCollapsedClass([element], this._isShown(selected))\n }\n }\n }\n\n _getFirstLevelChildren(selector) {\n const children = SelectorEngine.find(CLASS_NAME_DEEPER_CHILDREN, this._config.parent)\n // remove children if greater depth\n return SelectorEngine.find(selector, this._config.parent).filter(element => !children.includes(element))\n }\n\n _addAriaAndCollapsedClass(triggerArray, isOpen) {\n if (!triggerArray.length) {\n return\n }\n\n for (const element of triggerArray) {\n element.classList.toggle(CLASS_NAME_COLLAPSED, !isOpen)\n element.setAttribute('aria-expanded', isOpen)\n }\n }\n\n // Static\n static jQueryInterface(config) {\n const _config = {}\n if (typeof config === 'string' && /show|hide/.test(config)) {\n _config.toggle = false\n }\n\n return this.each(function () {\n const data = Collapse.getOrCreateInstance(this, _config)\n\n if (typeof config === 'string') {\n if (typeof data[config] === 'undefined') {\n throw new TypeError(`No method named \"${config}\"`)\n }\n\n data[config]()\n }\n })\n }\n}\n\n/**\n * Data API implementation\n */\n\nEventHandler.on(document, EVENT_CLICK_DATA_API, SELECTOR_DATA_TOGGLE, function (event) {\n // preventDefault only for elements (which change the URL) not inside the collapsible element\n if (event.target.tagName === 'A' || (event.delegateTarget && event.delegateTarget.tagName === 'A')) {\n event.preventDefault()\n }\n\n for (const element of SelectorEngine.getMultipleElementsFromSelector(this)) {\n Collapse.getOrCreateInstance(element, { toggle: false }).toggle()\n }\n})\n\n/**\n * jQuery\n */\n\ndefineJQueryPlugin(Collapse)\n\nexport default Collapse\n","export var top = 'top';\nexport var bottom = 'bottom';\nexport var right = 'right';\nexport var left = 'left';\nexport var auto = 'auto';\nexport var basePlacements = [top, bottom, right, left];\nexport var start = 'start';\nexport var end = 'end';\nexport var clippingParents = 'clippingParents';\nexport var viewport = 'viewport';\nexport var popper = 'popper';\nexport var reference = 'reference';\nexport var variationPlacements = /*#__PURE__*/basePlacements.reduce(function (acc, placement) {\n return acc.concat([placement + \"-\" + start, placement + \"-\" + end]);\n}, []);\nexport var placements = /*#__PURE__*/[].concat(basePlacements, [auto]).reduce(function (acc, placement) {\n return acc.concat([placement, placement + \"-\" + start, placement + \"-\" + end]);\n}, []); // modifiers that need to read the DOM\n\nexport var beforeRead = 'beforeRead';\nexport var read = 'read';\nexport var afterRead = 'afterRead'; // pure-logic modifiers\n\nexport var beforeMain = 'beforeMain';\nexport var main = 'main';\nexport var afterMain = 'afterMain'; // modifier with the purpose to write to the DOM (or write into a framework state)\n\nexport var beforeWrite = 'beforeWrite';\nexport var write = 'write';\nexport var afterWrite = 'afterWrite';\nexport var modifierPhases = [beforeRead, read, afterRead, beforeMain, main, afterMain, beforeWrite, write, afterWrite];","export default function getNodeName(element) {\n return element ? (element.nodeName || '').toLowerCase() : null;\n}","export default function getWindow(node) {\n if (node == null) {\n return window;\n }\n\n if (node.toString() !== '[object Window]') {\n var ownerDocument = node.ownerDocument;\n return ownerDocument ? ownerDocument.defaultView || window : window;\n }\n\n return node;\n}","import getWindow from \"./getWindow.js\";\n\nfunction isElement(node) {\n var OwnElement = getWindow(node).Element;\n return node instanceof OwnElement || node instanceof Element;\n}\n\nfunction isHTMLElement(node) {\n var OwnElement = getWindow(node).HTMLElement;\n return node instanceof OwnElement || node instanceof HTMLElement;\n}\n\nfunction isShadowRoot(node) {\n // IE 11 has no ShadowRoot\n if (typeof ShadowRoot === 'undefined') {\n return false;\n }\n\n var OwnElement = getWindow(node).ShadowRoot;\n return node instanceof OwnElement || node instanceof ShadowRoot;\n}\n\nexport { isElement, isHTMLElement, isShadowRoot };","import getNodeName from \"../dom-utils/getNodeName.js\";\nimport { isHTMLElement } from \"../dom-utils/instanceOf.js\"; // This modifier takes the styles prepared by the `computeStyles` modifier\n// and applies them to the HTMLElements such as popper and arrow\n\nfunction applyStyles(_ref) {\n var state = _ref.state;\n Object.keys(state.elements).forEach(function (name) {\n var style = state.styles[name] || {};\n var attributes = state.attributes[name] || {};\n var element = state.elements[name]; // arrow is optional + virtual elements\n\n if (!isHTMLElement(element) || !getNodeName(element)) {\n return;\n } // Flow doesn't support to extend this property, but it's the most\n // effective way to apply styles to an HTMLElement\n // $FlowFixMe[cannot-write]\n\n\n Object.assign(element.style, style);\n Object.keys(attributes).forEach(function (name) {\n var value = attributes[name];\n\n if (value === false) {\n element.removeAttribute(name);\n } else {\n element.setAttribute(name, value === true ? '' : value);\n }\n });\n });\n}\n\nfunction effect(_ref2) {\n var state = _ref2.state;\n var initialStyles = {\n popper: {\n position: state.options.strategy,\n left: '0',\n top: '0',\n margin: '0'\n },\n arrow: {\n position: 'absolute'\n },\n reference: {}\n };\n Object.assign(state.elements.popper.style, initialStyles.popper);\n state.styles = initialStyles;\n\n if (state.elements.arrow) {\n Object.assign(state.elements.arrow.style, initialStyles.arrow);\n }\n\n return function () {\n Object.keys(state.elements).forEach(function (name) {\n var element = state.elements[name];\n var attributes = state.attributes[name] || {};\n var styleProperties = Object.keys(state.styles.hasOwnProperty(name) ? state.styles[name] : initialStyles[name]); // Set all values to an empty string to unset them\n\n var style = styleProperties.reduce(function (style, property) {\n style[property] = '';\n return style;\n }, {}); // arrow is optional + virtual elements\n\n if (!isHTMLElement(element) || !getNodeName(element)) {\n return;\n }\n\n Object.assign(element.style, style);\n Object.keys(attributes).forEach(function (attribute) {\n element.removeAttribute(attribute);\n });\n });\n };\n} // eslint-disable-next-line import/no-unused-modules\n\n\nexport default {\n name: 'applyStyles',\n enabled: true,\n phase: 'write',\n fn: applyStyles,\n effect: effect,\n requires: ['computeStyles']\n};","import { auto } from \"../enums.js\";\nexport default function getBasePlacement(placement) {\n return placement.split('-')[0];\n}","export var max = Math.max;\nexport var min = Math.min;\nexport var round = Math.round;","export default function getUAString() {\n var uaData = navigator.userAgentData;\n\n if (uaData != null && uaData.brands && Array.isArray(uaData.brands)) {\n return uaData.brands.map(function (item) {\n return item.brand + \"/\" + item.version;\n }).join(' ');\n }\n\n return navigator.userAgent;\n}","import getUAString from \"../utils/userAgent.js\";\nexport default function isLayoutViewport() {\n return !/^((?!chrome|android).)*safari/i.test(getUAString());\n}","import { isElement, isHTMLElement } from \"./instanceOf.js\";\nimport { round } from \"../utils/math.js\";\nimport getWindow from \"./getWindow.js\";\nimport isLayoutViewport from \"./isLayoutViewport.js\";\nexport default function getBoundingClientRect(element, includeScale, isFixedStrategy) {\n if (includeScale === void 0) {\n includeScale = false;\n }\n\n if (isFixedStrategy === void 0) {\n isFixedStrategy = false;\n }\n\n var clientRect = element.getBoundingClientRect();\n var scaleX = 1;\n var scaleY = 1;\n\n if (includeScale && isHTMLElement(element)) {\n scaleX = element.offsetWidth > 0 ? round(clientRect.width) / element.offsetWidth || 1 : 1;\n scaleY = element.offsetHeight > 0 ? round(clientRect.height) / element.offsetHeight || 1 : 1;\n }\n\n var _ref = isElement(element) ? getWindow(element) : window,\n visualViewport = _ref.visualViewport;\n\n var addVisualOffsets = !isLayoutViewport() && isFixedStrategy;\n var x = (clientRect.left + (addVisualOffsets && visualViewport ? visualViewport.offsetLeft : 0)) / scaleX;\n var y = (clientRect.top + (addVisualOffsets && visualViewport ? visualViewport.offsetTop : 0)) / scaleY;\n var width = clientRect.width / scaleX;\n var height = clientRect.height / scaleY;\n return {\n width: width,\n height: height,\n top: y,\n right: x + width,\n bottom: y + height,\n left: x,\n x: x,\n y: y\n };\n}","import getBoundingClientRect from \"./getBoundingClientRect.js\"; // Returns the layout rect of an element relative to its offsetParent. Layout\n// means it doesn't take into account transforms.\n\nexport default function getLayoutRect(element) {\n var clientRect = getBoundingClientRect(element); // Use the clientRect sizes if it's not been transformed.\n // Fixes https://github.com/popperjs/popper-core/issues/1223\n\n var width = element.offsetWidth;\n var height = element.offsetHeight;\n\n if (Math.abs(clientRect.width - width) <= 1) {\n width = clientRect.width;\n }\n\n if (Math.abs(clientRect.height - height) <= 1) {\n height = clientRect.height;\n }\n\n return {\n x: element.offsetLeft,\n y: element.offsetTop,\n width: width,\n height: height\n };\n}","import { isShadowRoot } from \"./instanceOf.js\";\nexport default function contains(parent, child) {\n var rootNode = child.getRootNode && child.getRootNode(); // First, attempt with faster native method\n\n if (parent.contains(child)) {\n return true;\n } // then fallback to custom implementation with Shadow DOM support\n else if (rootNode && isShadowRoot(rootNode)) {\n var next = child;\n\n do {\n if (next && parent.isSameNode(next)) {\n return true;\n } // $FlowFixMe[prop-missing]: need a better way to handle this...\n\n\n next = next.parentNode || next.host;\n } while (next);\n } // Give up, the result is false\n\n\n return false;\n}","import getWindow from \"./getWindow.js\";\nexport default function getComputedStyle(element) {\n return getWindow(element).getComputedStyle(element);\n}","import getNodeName from \"./getNodeName.js\";\nexport default function isTableElement(element) {\n return ['table', 'td', 'th'].indexOf(getNodeName(element)) >= 0;\n}","import { isElement } from \"./instanceOf.js\";\nexport default function getDocumentElement(element) {\n // $FlowFixMe[incompatible-return]: assume body is always available\n return ((isElement(element) ? element.ownerDocument : // $FlowFixMe[prop-missing]\n element.document) || window.document).documentElement;\n}","import getNodeName from \"./getNodeName.js\";\nimport getDocumentElement from \"./getDocumentElement.js\";\nimport { isShadowRoot } from \"./instanceOf.js\";\nexport default function getParentNode(element) {\n if (getNodeName(element) === 'html') {\n return element;\n }\n\n return (// this is a quicker (but less type safe) way to save quite some bytes from the bundle\n // $FlowFixMe[incompatible-return]\n // $FlowFixMe[prop-missing]\n element.assignedSlot || // step into the shadow DOM of the parent of a slotted node\n element.parentNode || ( // DOM Element detected\n isShadowRoot(element) ? element.host : null) || // ShadowRoot detected\n // $FlowFixMe[incompatible-call]: HTMLElement is a Node\n getDocumentElement(element) // fallback\n\n );\n}","import getWindow from \"./getWindow.js\";\nimport getNodeName from \"./getNodeName.js\";\nimport getComputedStyle from \"./getComputedStyle.js\";\nimport { isHTMLElement, isShadowRoot } from \"./instanceOf.js\";\nimport isTableElement from \"./isTableElement.js\";\nimport getParentNode from \"./getParentNode.js\";\nimport getUAString from \"../utils/userAgent.js\";\n\nfunction getTrueOffsetParent(element) {\n if (!isHTMLElement(element) || // https://github.com/popperjs/popper-core/issues/837\n getComputedStyle(element).position === 'fixed') {\n return null;\n }\n\n return element.offsetParent;\n} // `.offsetParent` reports `null` for fixed elements, while absolute elements\n// return the containing block\n\n\nfunction getContainingBlock(element) {\n var isFirefox = /firefox/i.test(getUAString());\n var isIE = /Trident/i.test(getUAString());\n\n if (isIE && isHTMLElement(element)) {\n // In IE 9, 10 and 11 fixed elements containing block is always established by the viewport\n var elementCss = getComputedStyle(element);\n\n if (elementCss.position === 'fixed') {\n return null;\n }\n }\n\n var currentNode = getParentNode(element);\n\n if (isShadowRoot(currentNode)) {\n currentNode = currentNode.host;\n }\n\n while (isHTMLElement(currentNode) && ['html', 'body'].indexOf(getNodeName(currentNode)) < 0) {\n var css = getComputedStyle(currentNode); // This is non-exhaustive but covers the most common CSS properties that\n // create a containing block.\n // https://developer.mozilla.org/en-US/docs/Web/CSS/Containing_block#identifying_the_containing_block\n\n if (css.transform !== 'none' || css.perspective !== 'none' || css.contain === 'paint' || ['transform', 'perspective'].indexOf(css.willChange) !== -1 || isFirefox && css.willChange === 'filter' || isFirefox && css.filter && css.filter !== 'none') {\n return currentNode;\n } else {\n currentNode = currentNode.parentNode;\n }\n }\n\n return null;\n} // Gets the closest ancestor positioned element. Handles some edge cases,\n// such as table ancestors and cross browser bugs.\n\n\nexport default function getOffsetParent(element) {\n var window = getWindow(element);\n var offsetParent = getTrueOffsetParent(element);\n\n while (offsetParent && isTableElement(offsetParent) && getComputedStyle(offsetParent).position === 'static') {\n offsetParent = getTrueOffsetParent(offsetParent);\n }\n\n if (offsetParent && (getNodeName(offsetParent) === 'html' || getNodeName(offsetParent) === 'body' && getComputedStyle(offsetParent).position === 'static')) {\n return window;\n }\n\n return offsetParent || getContainingBlock(element) || window;\n}","export default function getMainAxisFromPlacement(placement) {\n return ['top', 'bottom'].indexOf(placement) >= 0 ? 'x' : 'y';\n}","import { max as mathMax, min as mathMin } from \"./math.js\";\nexport function within(min, value, max) {\n return mathMax(min, mathMin(value, max));\n}\nexport function withinMaxClamp(min, value, max) {\n var v = within(min, value, max);\n return v > max ? max : v;\n}","import getFreshSideObject from \"./getFreshSideObject.js\";\nexport default function mergePaddingObject(paddingObject) {\n return Object.assign({}, getFreshSideObject(), paddingObject);\n}","export default function getFreshSideObject() {\n return {\n top: 0,\n right: 0,\n bottom: 0,\n left: 0\n };\n}","export default function expandToHashMap(value, keys) {\n return keys.reduce(function (hashMap, key) {\n hashMap[key] = value;\n return hashMap;\n }, {});\n}","import getBasePlacement from \"../utils/getBasePlacement.js\";\nimport getLayoutRect from \"../dom-utils/getLayoutRect.js\";\nimport contains from \"../dom-utils/contains.js\";\nimport getOffsetParent from \"../dom-utils/getOffsetParent.js\";\nimport getMainAxisFromPlacement from \"../utils/getMainAxisFromPlacement.js\";\nimport { within } from \"../utils/within.js\";\nimport mergePaddingObject from \"../utils/mergePaddingObject.js\";\nimport expandToHashMap from \"../utils/expandToHashMap.js\";\nimport { left, right, basePlacements, top, bottom } from \"../enums.js\"; // eslint-disable-next-line import/no-unused-modules\n\nvar toPaddingObject = function toPaddingObject(padding, state) {\n padding = typeof padding === 'function' ? padding(Object.assign({}, state.rects, {\n placement: state.placement\n })) : padding;\n return mergePaddingObject(typeof padding !== 'number' ? padding : expandToHashMap(padding, basePlacements));\n};\n\nfunction arrow(_ref) {\n var _state$modifiersData$;\n\n var state = _ref.state,\n name = _ref.name,\n options = _ref.options;\n var arrowElement = state.elements.arrow;\n var popperOffsets = state.modifiersData.popperOffsets;\n var basePlacement = getBasePlacement(state.placement);\n var axis = getMainAxisFromPlacement(basePlacement);\n var isVertical = [left, right].indexOf(basePlacement) >= 0;\n var len = isVertical ? 'height' : 'width';\n\n if (!arrowElement || !popperOffsets) {\n return;\n }\n\n var paddingObject = toPaddingObject(options.padding, state);\n var arrowRect = getLayoutRect(arrowElement);\n var minProp = axis === 'y' ? top : left;\n var maxProp = axis === 'y' ? bottom : right;\n var endDiff = state.rects.reference[len] + state.rects.reference[axis] - popperOffsets[axis] - state.rects.popper[len];\n var startDiff = popperOffsets[axis] - state.rects.reference[axis];\n var arrowOffsetParent = getOffsetParent(arrowElement);\n var clientSize = arrowOffsetParent ? axis === 'y' ? arrowOffsetParent.clientHeight || 0 : arrowOffsetParent.clientWidth || 0 : 0;\n var centerToReference = endDiff / 2 - startDiff / 2; // Make sure the arrow doesn't overflow the popper if the center point is\n // outside of the popper bounds\n\n var min = paddingObject[minProp];\n var max = clientSize - arrowRect[len] - paddingObject[maxProp];\n var center = clientSize / 2 - arrowRect[len] / 2 + centerToReference;\n var offset = within(min, center, max); // Prevents breaking syntax highlighting...\n\n var axisProp = axis;\n state.modifiersData[name] = (_state$modifiersData$ = {}, _state$modifiersData$[axisProp] = offset, _state$modifiersData$.centerOffset = offset - center, _state$modifiersData$);\n}\n\nfunction effect(_ref2) {\n var state = _ref2.state,\n options = _ref2.options;\n var _options$element = options.element,\n arrowElement = _options$element === void 0 ? '[data-popper-arrow]' : _options$element;\n\n if (arrowElement == null) {\n return;\n } // CSS selector\n\n\n if (typeof arrowElement === 'string') {\n arrowElement = state.elements.popper.querySelector(arrowElement);\n\n if (!arrowElement) {\n return;\n }\n }\n\n if (!contains(state.elements.popper, arrowElement)) {\n return;\n }\n\n state.elements.arrow = arrowElement;\n} // eslint-disable-next-line import/no-unused-modules\n\n\nexport default {\n name: 'arrow',\n enabled: true,\n phase: 'main',\n fn: arrow,\n effect: effect,\n requires: ['popperOffsets'],\n requiresIfExists: ['preventOverflow']\n};","export default function getVariation(placement) {\n return placement.split('-')[1];\n}","import { top, left, right, bottom, end } from \"../enums.js\";\nimport getOffsetParent from \"../dom-utils/getOffsetParent.js\";\nimport getWindow from \"../dom-utils/getWindow.js\";\nimport getDocumentElement from \"../dom-utils/getDocumentElement.js\";\nimport getComputedStyle from \"../dom-utils/getComputedStyle.js\";\nimport getBasePlacement from \"../utils/getBasePlacement.js\";\nimport getVariation from \"../utils/getVariation.js\";\nimport { round } from \"../utils/math.js\"; // eslint-disable-next-line import/no-unused-modules\n\nvar unsetSides = {\n top: 'auto',\n right: 'auto',\n bottom: 'auto',\n left: 'auto'\n}; // Round the offsets to the nearest suitable subpixel based on the DPR.\n// Zooming can change the DPR, but it seems to report a value that will\n// cleanly divide the values into the appropriate subpixels.\n\nfunction roundOffsetsByDPR(_ref, win) {\n var x = _ref.x,\n y = _ref.y;\n var dpr = win.devicePixelRatio || 1;\n return {\n x: round(x * dpr) / dpr || 0,\n y: round(y * dpr) / dpr || 0\n };\n}\n\nexport function mapToStyles(_ref2) {\n var _Object$assign2;\n\n var popper = _ref2.popper,\n popperRect = _ref2.popperRect,\n placement = _ref2.placement,\n variation = _ref2.variation,\n offsets = _ref2.offsets,\n position = _ref2.position,\n gpuAcceleration = _ref2.gpuAcceleration,\n adaptive = _ref2.adaptive,\n roundOffsets = _ref2.roundOffsets,\n isFixed = _ref2.isFixed;\n var _offsets$x = offsets.x,\n x = _offsets$x === void 0 ? 0 : _offsets$x,\n _offsets$y = offsets.y,\n y = _offsets$y === void 0 ? 0 : _offsets$y;\n\n var _ref3 = typeof roundOffsets === 'function' ? roundOffsets({\n x: x,\n y: y\n }) : {\n x: x,\n y: y\n };\n\n x = _ref3.x;\n y = _ref3.y;\n var hasX = offsets.hasOwnProperty('x');\n var hasY = offsets.hasOwnProperty('y');\n var sideX = left;\n var sideY = top;\n var win = window;\n\n if (adaptive) {\n var offsetParent = getOffsetParent(popper);\n var heightProp = 'clientHeight';\n var widthProp = 'clientWidth';\n\n if (offsetParent === getWindow(popper)) {\n offsetParent = getDocumentElement(popper);\n\n if (getComputedStyle(offsetParent).position !== 'static' && position === 'absolute') {\n heightProp = 'scrollHeight';\n widthProp = 'scrollWidth';\n }\n } // $FlowFixMe[incompatible-cast]: force type refinement, we compare offsetParent with window above, but Flow doesn't detect it\n\n\n offsetParent = offsetParent;\n\n if (placement === top || (placement === left || placement === right) && variation === end) {\n sideY = bottom;\n var offsetY = isFixed && offsetParent === win && win.visualViewport ? win.visualViewport.height : // $FlowFixMe[prop-missing]\n offsetParent[heightProp];\n y -= offsetY - popperRect.height;\n y *= gpuAcceleration ? 1 : -1;\n }\n\n if (placement === left || (placement === top || placement === bottom) && variation === end) {\n sideX = right;\n var offsetX = isFixed && offsetParent === win && win.visualViewport ? win.visualViewport.width : // $FlowFixMe[prop-missing]\n offsetParent[widthProp];\n x -= offsetX - popperRect.width;\n x *= gpuAcceleration ? 1 : -1;\n }\n }\n\n var commonStyles = Object.assign({\n position: position\n }, adaptive && unsetSides);\n\n var _ref4 = roundOffsets === true ? roundOffsetsByDPR({\n x: x,\n y: y\n }, getWindow(popper)) : {\n x: x,\n y: y\n };\n\n x = _ref4.x;\n y = _ref4.y;\n\n if (gpuAcceleration) {\n var _Object$assign;\n\n return Object.assign({}, commonStyles, (_Object$assign = {}, _Object$assign[sideY] = hasY ? '0' : '', _Object$assign[sideX] = hasX ? '0' : '', _Object$assign.transform = (win.devicePixelRatio || 1) <= 1 ? \"translate(\" + x + \"px, \" + y + \"px)\" : \"translate3d(\" + x + \"px, \" + y + \"px, 0)\", _Object$assign));\n }\n\n return Object.assign({}, commonStyles, (_Object$assign2 = {}, _Object$assign2[sideY] = hasY ? y + \"px\" : '', _Object$assign2[sideX] = hasX ? x + \"px\" : '', _Object$assign2.transform = '', _Object$assign2));\n}\n\nfunction computeStyles(_ref5) {\n var state = _ref5.state,\n options = _ref5.options;\n var _options$gpuAccelerat = options.gpuAcceleration,\n gpuAcceleration = _options$gpuAccelerat === void 0 ? true : _options$gpuAccelerat,\n _options$adaptive = options.adaptive,\n adaptive = _options$adaptive === void 0 ? true : _options$adaptive,\n _options$roundOffsets = options.roundOffsets,\n roundOffsets = _options$roundOffsets === void 0 ? true : _options$roundOffsets;\n var commonStyles = {\n placement: getBasePlacement(state.placement),\n variation: getVariation(state.placement),\n popper: state.elements.popper,\n popperRect: state.rects.popper,\n gpuAcceleration: gpuAcceleration,\n isFixed: state.options.strategy === 'fixed'\n };\n\n if (state.modifiersData.popperOffsets != null) {\n state.styles.popper = Object.assign({}, state.styles.popper, mapToStyles(Object.assign({}, commonStyles, {\n offsets: state.modifiersData.popperOffsets,\n position: state.options.strategy,\n adaptive: adaptive,\n roundOffsets: roundOffsets\n })));\n }\n\n if (state.modifiersData.arrow != null) {\n state.styles.arrow = Object.assign({}, state.styles.arrow, mapToStyles(Object.assign({}, commonStyles, {\n offsets: state.modifiersData.arrow,\n position: 'absolute',\n adaptive: false,\n roundOffsets: roundOffsets\n })));\n }\n\n state.attributes.popper = Object.assign({}, state.attributes.popper, {\n 'data-popper-placement': state.placement\n });\n} // eslint-disable-next-line import/no-unused-modules\n\n\nexport default {\n name: 'computeStyles',\n enabled: true,\n phase: 'beforeWrite',\n fn: computeStyles,\n data: {}\n};","import getWindow from \"../dom-utils/getWindow.js\"; // eslint-disable-next-line import/no-unused-modules\n\nvar passive = {\n passive: true\n};\n\nfunction effect(_ref) {\n var state = _ref.state,\n instance = _ref.instance,\n options = _ref.options;\n var _options$scroll = options.scroll,\n scroll = _options$scroll === void 0 ? true : _options$scroll,\n _options$resize = options.resize,\n resize = _options$resize === void 0 ? true : _options$resize;\n var window = getWindow(state.elements.popper);\n var scrollParents = [].concat(state.scrollParents.reference, state.scrollParents.popper);\n\n if (scroll) {\n scrollParents.forEach(function (scrollParent) {\n scrollParent.addEventListener('scroll', instance.update, passive);\n });\n }\n\n if (resize) {\n window.addEventListener('resize', instance.update, passive);\n }\n\n return function () {\n if (scroll) {\n scrollParents.forEach(function (scrollParent) {\n scrollParent.removeEventListener('scroll', instance.update, passive);\n });\n }\n\n if (resize) {\n window.removeEventListener('resize', instance.update, passive);\n }\n };\n} // eslint-disable-next-line import/no-unused-modules\n\n\nexport default {\n name: 'eventListeners',\n enabled: true,\n phase: 'write',\n fn: function fn() {},\n effect: effect,\n data: {}\n};","var hash = {\n left: 'right',\n right: 'left',\n bottom: 'top',\n top: 'bottom'\n};\nexport default function getOppositePlacement(placement) {\n return placement.replace(/left|right|bottom|top/g, function (matched) {\n return hash[matched];\n });\n}","var hash = {\n start: 'end',\n end: 'start'\n};\nexport default function getOppositeVariationPlacement(placement) {\n return placement.replace(/start|end/g, function (matched) {\n return hash[matched];\n });\n}","import getWindow from \"./getWindow.js\";\nexport default function getWindowScroll(node) {\n var win = getWindow(node);\n var scrollLeft = win.pageXOffset;\n var scrollTop = win.pageYOffset;\n return {\n scrollLeft: scrollLeft,\n scrollTop: scrollTop\n };\n}","import getBoundingClientRect from \"./getBoundingClientRect.js\";\nimport getDocumentElement from \"./getDocumentElement.js\";\nimport getWindowScroll from \"./getWindowScroll.js\";\nexport default function getWindowScrollBarX(element) {\n // If has a CSS width greater than the viewport, then this will be\n // incorrect for RTL.\n // Popper 1 is broken in this case and never had a bug report so let's assume\n // it's not an issue. I don't think anyone ever specifies width on \n // anyway.\n // Browsers where the left scrollbar doesn't cause an issue report `0` for\n // this (e.g. Edge 2019, IE11, Safari)\n return getBoundingClientRect(getDocumentElement(element)).left + getWindowScroll(element).scrollLeft;\n}","import getComputedStyle from \"./getComputedStyle.js\";\nexport default function isScrollParent(element) {\n // Firefox wants us to check `-x` and `-y` variations as well\n var _getComputedStyle = getComputedStyle(element),\n overflow = _getComputedStyle.overflow,\n overflowX = _getComputedStyle.overflowX,\n overflowY = _getComputedStyle.overflowY;\n\n return /auto|scroll|overlay|hidden/.test(overflow + overflowY + overflowX);\n}","import getParentNode from \"./getParentNode.js\";\nimport isScrollParent from \"./isScrollParent.js\";\nimport getNodeName from \"./getNodeName.js\";\nimport { isHTMLElement } from \"./instanceOf.js\";\nexport default function getScrollParent(node) {\n if (['html', 'body', '#document'].indexOf(getNodeName(node)) >= 0) {\n // $FlowFixMe[incompatible-return]: assume body is always available\n return node.ownerDocument.body;\n }\n\n if (isHTMLElement(node) && isScrollParent(node)) {\n return node;\n }\n\n return getScrollParent(getParentNode(node));\n}","import getScrollParent from \"./getScrollParent.js\";\nimport getParentNode from \"./getParentNode.js\";\nimport getWindow from \"./getWindow.js\";\nimport isScrollParent from \"./isScrollParent.js\";\n/*\ngiven a DOM element, return the list of all scroll parents, up the list of ancesors\nuntil we get to the top window object. This list is what we attach scroll listeners\nto, because if any of these parent elements scroll, we'll need to re-calculate the\nreference element's position.\n*/\n\nexport default function listScrollParents(element, list) {\n var _element$ownerDocumen;\n\n if (list === void 0) {\n list = [];\n }\n\n var scrollParent = getScrollParent(element);\n var isBody = scrollParent === ((_element$ownerDocumen = element.ownerDocument) == null ? void 0 : _element$ownerDocumen.body);\n var win = getWindow(scrollParent);\n var target = isBody ? [win].concat(win.visualViewport || [], isScrollParent(scrollParent) ? scrollParent : []) : scrollParent;\n var updatedList = list.concat(target);\n return isBody ? updatedList : // $FlowFixMe[incompatible-call]: isBody tells us target will be an HTMLElement here\n updatedList.concat(listScrollParents(getParentNode(target)));\n}","export default function rectToClientRect(rect) {\n return Object.assign({}, rect, {\n left: rect.x,\n top: rect.y,\n right: rect.x + rect.width,\n bottom: rect.y + rect.height\n });\n}","import { viewport } from \"../enums.js\";\nimport getViewportRect from \"./getViewportRect.js\";\nimport getDocumentRect from \"./getDocumentRect.js\";\nimport listScrollParents from \"./listScrollParents.js\";\nimport getOffsetParent from \"./getOffsetParent.js\";\nimport getDocumentElement from \"./getDocumentElement.js\";\nimport getComputedStyle from \"./getComputedStyle.js\";\nimport { isElement, isHTMLElement } from \"./instanceOf.js\";\nimport getBoundingClientRect from \"./getBoundingClientRect.js\";\nimport getParentNode from \"./getParentNode.js\";\nimport contains from \"./contains.js\";\nimport getNodeName from \"./getNodeName.js\";\nimport rectToClientRect from \"../utils/rectToClientRect.js\";\nimport { max, min } from \"../utils/math.js\";\n\nfunction getInnerBoundingClientRect(element, strategy) {\n var rect = getBoundingClientRect(element, false, strategy === 'fixed');\n rect.top = rect.top + element.clientTop;\n rect.left = rect.left + element.clientLeft;\n rect.bottom = rect.top + element.clientHeight;\n rect.right = rect.left + element.clientWidth;\n rect.width = element.clientWidth;\n rect.height = element.clientHeight;\n rect.x = rect.left;\n rect.y = rect.top;\n return rect;\n}\n\nfunction getClientRectFromMixedType(element, clippingParent, strategy) {\n return clippingParent === viewport ? rectToClientRect(getViewportRect(element, strategy)) : isElement(clippingParent) ? getInnerBoundingClientRect(clippingParent, strategy) : rectToClientRect(getDocumentRect(getDocumentElement(element)));\n} // A \"clipping parent\" is an overflowable container with the characteristic of\n// clipping (or hiding) overflowing elements with a position different from\n// `initial`\n\n\nfunction getClippingParents(element) {\n var clippingParents = listScrollParents(getParentNode(element));\n var canEscapeClipping = ['absolute', 'fixed'].indexOf(getComputedStyle(element).position) >= 0;\n var clipperElement = canEscapeClipping && isHTMLElement(element) ? getOffsetParent(element) : element;\n\n if (!isElement(clipperElement)) {\n return [];\n } // $FlowFixMe[incompatible-return]: https://github.com/facebook/flow/issues/1414\n\n\n return clippingParents.filter(function (clippingParent) {\n return isElement(clippingParent) && contains(clippingParent, clipperElement) && getNodeName(clippingParent) !== 'body';\n });\n} // Gets the maximum area that the element is visible in due to any number of\n// clipping parents\n\n\nexport default function getClippingRect(element, boundary, rootBoundary, strategy) {\n var mainClippingParents = boundary === 'clippingParents' ? getClippingParents(element) : [].concat(boundary);\n var clippingParents = [].concat(mainClippingParents, [rootBoundary]);\n var firstClippingParent = clippingParents[0];\n var clippingRect = clippingParents.reduce(function (accRect, clippingParent) {\n var rect = getClientRectFromMixedType(element, clippingParent, strategy);\n accRect.top = max(rect.top, accRect.top);\n accRect.right = min(rect.right, accRect.right);\n accRect.bottom = min(rect.bottom, accRect.bottom);\n accRect.left = max(rect.left, accRect.left);\n return accRect;\n }, getClientRectFromMixedType(element, firstClippingParent, strategy));\n clippingRect.width = clippingRect.right - clippingRect.left;\n clippingRect.height = clippingRect.bottom - clippingRect.top;\n clippingRect.x = clippingRect.left;\n clippingRect.y = clippingRect.top;\n return clippingRect;\n}","import getWindow from \"./getWindow.js\";\nimport getDocumentElement from \"./getDocumentElement.js\";\nimport getWindowScrollBarX from \"./getWindowScrollBarX.js\";\nimport isLayoutViewport from \"./isLayoutViewport.js\";\nexport default function getViewportRect(element, strategy) {\n var win = getWindow(element);\n var html = getDocumentElement(element);\n var visualViewport = win.visualViewport;\n var width = html.clientWidth;\n var height = html.clientHeight;\n var x = 0;\n var y = 0;\n\n if (visualViewport) {\n width = visualViewport.width;\n height = visualViewport.height;\n var layoutViewport = isLayoutViewport();\n\n if (layoutViewport || !layoutViewport && strategy === 'fixed') {\n x = visualViewport.offsetLeft;\n y = visualViewport.offsetTop;\n }\n }\n\n return {\n width: width,\n height: height,\n x: x + getWindowScrollBarX(element),\n y: y\n };\n}","import getDocumentElement from \"./getDocumentElement.js\";\nimport getComputedStyle from \"./getComputedStyle.js\";\nimport getWindowScrollBarX from \"./getWindowScrollBarX.js\";\nimport getWindowScroll from \"./getWindowScroll.js\";\nimport { max } from \"../utils/math.js\"; // Gets the entire size of the scrollable document area, even extending outside\n// of the `` and `` rect bounds if horizontally scrollable\n\nexport default function getDocumentRect(element) {\n var _element$ownerDocumen;\n\n var html = getDocumentElement(element);\n var winScroll = getWindowScroll(element);\n var body = (_element$ownerDocumen = element.ownerDocument) == null ? void 0 : _element$ownerDocumen.body;\n var width = max(html.scrollWidth, html.clientWidth, body ? body.scrollWidth : 0, body ? body.clientWidth : 0);\n var height = max(html.scrollHeight, html.clientHeight, body ? body.scrollHeight : 0, body ? body.clientHeight : 0);\n var x = -winScroll.scrollLeft + getWindowScrollBarX(element);\n var y = -winScroll.scrollTop;\n\n if (getComputedStyle(body || html).direction === 'rtl') {\n x += max(html.clientWidth, body ? body.clientWidth : 0) - width;\n }\n\n return {\n width: width,\n height: height,\n x: x,\n y: y\n };\n}","import getBasePlacement from \"./getBasePlacement.js\";\nimport getVariation from \"./getVariation.js\";\nimport getMainAxisFromPlacement from \"./getMainAxisFromPlacement.js\";\nimport { top, right, bottom, left, start, end } from \"../enums.js\";\nexport default function computeOffsets(_ref) {\n var reference = _ref.reference,\n element = _ref.element,\n placement = _ref.placement;\n var basePlacement = placement ? getBasePlacement(placement) : null;\n var variation = placement ? getVariation(placement) : null;\n var commonX = reference.x + reference.width / 2 - element.width / 2;\n var commonY = reference.y + reference.height / 2 - element.height / 2;\n var offsets;\n\n switch (basePlacement) {\n case top:\n offsets = {\n x: commonX,\n y: reference.y - element.height\n };\n break;\n\n case bottom:\n offsets = {\n x: commonX,\n y: reference.y + reference.height\n };\n break;\n\n case right:\n offsets = {\n x: reference.x + reference.width,\n y: commonY\n };\n break;\n\n case left:\n offsets = {\n x: reference.x - element.width,\n y: commonY\n };\n break;\n\n default:\n offsets = {\n x: reference.x,\n y: reference.y\n };\n }\n\n var mainAxis = basePlacement ? getMainAxisFromPlacement(basePlacement) : null;\n\n if (mainAxis != null) {\n var len = mainAxis === 'y' ? 'height' : 'width';\n\n switch (variation) {\n case start:\n offsets[mainAxis] = offsets[mainAxis] - (reference[len] / 2 - element[len] / 2);\n break;\n\n case end:\n offsets[mainAxis] = offsets[mainAxis] + (reference[len] / 2 - element[len] / 2);\n break;\n\n default:\n }\n }\n\n return offsets;\n}","import getClippingRect from \"../dom-utils/getClippingRect.js\";\nimport getDocumentElement from \"../dom-utils/getDocumentElement.js\";\nimport getBoundingClientRect from \"../dom-utils/getBoundingClientRect.js\";\nimport computeOffsets from \"./computeOffsets.js\";\nimport rectToClientRect from \"./rectToClientRect.js\";\nimport { clippingParents, reference, popper, bottom, top, right, basePlacements, viewport } from \"../enums.js\";\nimport { isElement } from \"../dom-utils/instanceOf.js\";\nimport mergePaddingObject from \"./mergePaddingObject.js\";\nimport expandToHashMap from \"./expandToHashMap.js\"; // eslint-disable-next-line import/no-unused-modules\n\nexport default function detectOverflow(state, options) {\n if (options === void 0) {\n options = {};\n }\n\n var _options = options,\n _options$placement = _options.placement,\n placement = _options$placement === void 0 ? state.placement : _options$placement,\n _options$strategy = _options.strategy,\n strategy = _options$strategy === void 0 ? state.strategy : _options$strategy,\n _options$boundary = _options.boundary,\n boundary = _options$boundary === void 0 ? clippingParents : _options$boundary,\n _options$rootBoundary = _options.rootBoundary,\n rootBoundary = _options$rootBoundary === void 0 ? viewport : _options$rootBoundary,\n _options$elementConte = _options.elementContext,\n elementContext = _options$elementConte === void 0 ? popper : _options$elementConte,\n _options$altBoundary = _options.altBoundary,\n altBoundary = _options$altBoundary === void 0 ? false : _options$altBoundary,\n _options$padding = _options.padding,\n padding = _options$padding === void 0 ? 0 : _options$padding;\n var paddingObject = mergePaddingObject(typeof padding !== 'number' ? padding : expandToHashMap(padding, basePlacements));\n var altContext = elementContext === popper ? reference : popper;\n var popperRect = state.rects.popper;\n var element = state.elements[altBoundary ? altContext : elementContext];\n var clippingClientRect = getClippingRect(isElement(element) ? element : element.contextElement || getDocumentElement(state.elements.popper), boundary, rootBoundary, strategy);\n var referenceClientRect = getBoundingClientRect(state.elements.reference);\n var popperOffsets = computeOffsets({\n reference: referenceClientRect,\n element: popperRect,\n strategy: 'absolute',\n placement: placement\n });\n var popperClientRect = rectToClientRect(Object.assign({}, popperRect, popperOffsets));\n var elementClientRect = elementContext === popper ? popperClientRect : referenceClientRect; // positive = overflowing the clipping rect\n // 0 or negative = within the clipping rect\n\n var overflowOffsets = {\n top: clippingClientRect.top - elementClientRect.top + paddingObject.top,\n bottom: elementClientRect.bottom - clippingClientRect.bottom + paddingObject.bottom,\n left: clippingClientRect.left - elementClientRect.left + paddingObject.left,\n right: elementClientRect.right - clippingClientRect.right + paddingObject.right\n };\n var offsetData = state.modifiersData.offset; // Offsets can be applied only to the popper element\n\n if (elementContext === popper && offsetData) {\n var offset = offsetData[placement];\n Object.keys(overflowOffsets).forEach(function (key) {\n var multiply = [right, bottom].indexOf(key) >= 0 ? 1 : -1;\n var axis = [top, bottom].indexOf(key) >= 0 ? 'y' : 'x';\n overflowOffsets[key] += offset[axis] * multiply;\n });\n }\n\n return overflowOffsets;\n}","import getVariation from \"./getVariation.js\";\nimport { variationPlacements, basePlacements, placements as allPlacements } from \"../enums.js\";\nimport detectOverflow from \"./detectOverflow.js\";\nimport getBasePlacement from \"./getBasePlacement.js\";\nexport default function computeAutoPlacement(state, options) {\n if (options === void 0) {\n options = {};\n }\n\n var _options = options,\n placement = _options.placement,\n boundary = _options.boundary,\n rootBoundary = _options.rootBoundary,\n padding = _options.padding,\n flipVariations = _options.flipVariations,\n _options$allowedAutoP = _options.allowedAutoPlacements,\n allowedAutoPlacements = _options$allowedAutoP === void 0 ? allPlacements : _options$allowedAutoP;\n var variation = getVariation(placement);\n var placements = variation ? flipVariations ? variationPlacements : variationPlacements.filter(function (placement) {\n return getVariation(placement) === variation;\n }) : basePlacements;\n var allowedPlacements = placements.filter(function (placement) {\n return allowedAutoPlacements.indexOf(placement) >= 0;\n });\n\n if (allowedPlacements.length === 0) {\n allowedPlacements = placements;\n } // $FlowFixMe[incompatible-type]: Flow seems to have problems with two array unions...\n\n\n var overflows = allowedPlacements.reduce(function (acc, placement) {\n acc[placement] = detectOverflow(state, {\n placement: placement,\n boundary: boundary,\n rootBoundary: rootBoundary,\n padding: padding\n })[getBasePlacement(placement)];\n return acc;\n }, {});\n return Object.keys(overflows).sort(function (a, b) {\n return overflows[a] - overflows[b];\n });\n}","import getOppositePlacement from \"../utils/getOppositePlacement.js\";\nimport getBasePlacement from \"../utils/getBasePlacement.js\";\nimport getOppositeVariationPlacement from \"../utils/getOppositeVariationPlacement.js\";\nimport detectOverflow from \"../utils/detectOverflow.js\";\nimport computeAutoPlacement from \"../utils/computeAutoPlacement.js\";\nimport { bottom, top, start, right, left, auto } from \"../enums.js\";\nimport getVariation from \"../utils/getVariation.js\"; // eslint-disable-next-line import/no-unused-modules\n\nfunction getExpandedFallbackPlacements(placement) {\n if (getBasePlacement(placement) === auto) {\n return [];\n }\n\n var oppositePlacement = getOppositePlacement(placement);\n return [getOppositeVariationPlacement(placement), oppositePlacement, getOppositeVariationPlacement(oppositePlacement)];\n}\n\nfunction flip(_ref) {\n var state = _ref.state,\n options = _ref.options,\n name = _ref.name;\n\n if (state.modifiersData[name]._skip) {\n return;\n }\n\n var _options$mainAxis = options.mainAxis,\n checkMainAxis = _options$mainAxis === void 0 ? true : _options$mainAxis,\n _options$altAxis = options.altAxis,\n checkAltAxis = _options$altAxis === void 0 ? true : _options$altAxis,\n specifiedFallbackPlacements = options.fallbackPlacements,\n padding = options.padding,\n boundary = options.boundary,\n rootBoundary = options.rootBoundary,\n altBoundary = options.altBoundary,\n _options$flipVariatio = options.flipVariations,\n flipVariations = _options$flipVariatio === void 0 ? true : _options$flipVariatio,\n allowedAutoPlacements = options.allowedAutoPlacements;\n var preferredPlacement = state.options.placement;\n var basePlacement = getBasePlacement(preferredPlacement);\n var isBasePlacement = basePlacement === preferredPlacement;\n var fallbackPlacements = specifiedFallbackPlacements || (isBasePlacement || !flipVariations ? [getOppositePlacement(preferredPlacement)] : getExpandedFallbackPlacements(preferredPlacement));\n var placements = [preferredPlacement].concat(fallbackPlacements).reduce(function (acc, placement) {\n return acc.concat(getBasePlacement(placement) === auto ? computeAutoPlacement(state, {\n placement: placement,\n boundary: boundary,\n rootBoundary: rootBoundary,\n padding: padding,\n flipVariations: flipVariations,\n allowedAutoPlacements: allowedAutoPlacements\n }) : placement);\n }, []);\n var referenceRect = state.rects.reference;\n var popperRect = state.rects.popper;\n var checksMap = new Map();\n var makeFallbackChecks = true;\n var firstFittingPlacement = placements[0];\n\n for (var i = 0; i < placements.length; i++) {\n var placement = placements[i];\n\n var _basePlacement = getBasePlacement(placement);\n\n var isStartVariation = getVariation(placement) === start;\n var isVertical = [top, bottom].indexOf(_basePlacement) >= 0;\n var len = isVertical ? 'width' : 'height';\n var overflow = detectOverflow(state, {\n placement: placement,\n boundary: boundary,\n rootBoundary: rootBoundary,\n altBoundary: altBoundary,\n padding: padding\n });\n var mainVariationSide = isVertical ? isStartVariation ? right : left : isStartVariation ? bottom : top;\n\n if (referenceRect[len] > popperRect[len]) {\n mainVariationSide = getOppositePlacement(mainVariationSide);\n }\n\n var altVariationSide = getOppositePlacement(mainVariationSide);\n var checks = [];\n\n if (checkMainAxis) {\n checks.push(overflow[_basePlacement] <= 0);\n }\n\n if (checkAltAxis) {\n checks.push(overflow[mainVariationSide] <= 0, overflow[altVariationSide] <= 0);\n }\n\n if (checks.every(function (check) {\n return check;\n })) {\n firstFittingPlacement = placement;\n makeFallbackChecks = false;\n break;\n }\n\n checksMap.set(placement, checks);\n }\n\n if (makeFallbackChecks) {\n // `2` may be desired in some cases – research later\n var numberOfChecks = flipVariations ? 3 : 1;\n\n var _loop = function _loop(_i) {\n var fittingPlacement = placements.find(function (placement) {\n var checks = checksMap.get(placement);\n\n if (checks) {\n return checks.slice(0, _i).every(function (check) {\n return check;\n });\n }\n });\n\n if (fittingPlacement) {\n firstFittingPlacement = fittingPlacement;\n return \"break\";\n }\n };\n\n for (var _i = numberOfChecks; _i > 0; _i--) {\n var _ret = _loop(_i);\n\n if (_ret === \"break\") break;\n }\n }\n\n if (state.placement !== firstFittingPlacement) {\n state.modifiersData[name]._skip = true;\n state.placement = firstFittingPlacement;\n state.reset = true;\n }\n} // eslint-disable-next-line import/no-unused-modules\n\n\nexport default {\n name: 'flip',\n enabled: true,\n phase: 'main',\n fn: flip,\n requiresIfExists: ['offset'],\n data: {\n _skip: false\n }\n};","import { top, bottom, left, right } from \"../enums.js\";\nimport detectOverflow from \"../utils/detectOverflow.js\";\n\nfunction getSideOffsets(overflow, rect, preventedOffsets) {\n if (preventedOffsets === void 0) {\n preventedOffsets = {\n x: 0,\n y: 0\n };\n }\n\n return {\n top: overflow.top - rect.height - preventedOffsets.y,\n right: overflow.right - rect.width + preventedOffsets.x,\n bottom: overflow.bottom - rect.height + preventedOffsets.y,\n left: overflow.left - rect.width - preventedOffsets.x\n };\n}\n\nfunction isAnySideFullyClipped(overflow) {\n return [top, right, bottom, left].some(function (side) {\n return overflow[side] >= 0;\n });\n}\n\nfunction hide(_ref) {\n var state = _ref.state,\n name = _ref.name;\n var referenceRect = state.rects.reference;\n var popperRect = state.rects.popper;\n var preventedOffsets = state.modifiersData.preventOverflow;\n var referenceOverflow = detectOverflow(state, {\n elementContext: 'reference'\n });\n var popperAltOverflow = detectOverflow(state, {\n altBoundary: true\n });\n var referenceClippingOffsets = getSideOffsets(referenceOverflow, referenceRect);\n var popperEscapeOffsets = getSideOffsets(popperAltOverflow, popperRect, preventedOffsets);\n var isReferenceHidden = isAnySideFullyClipped(referenceClippingOffsets);\n var hasPopperEscaped = isAnySideFullyClipped(popperEscapeOffsets);\n state.modifiersData[name] = {\n referenceClippingOffsets: referenceClippingOffsets,\n popperEscapeOffsets: popperEscapeOffsets,\n isReferenceHidden: isReferenceHidden,\n hasPopperEscaped: hasPopperEscaped\n };\n state.attributes.popper = Object.assign({}, state.attributes.popper, {\n 'data-popper-reference-hidden': isReferenceHidden,\n 'data-popper-escaped': hasPopperEscaped\n });\n} // eslint-disable-next-line import/no-unused-modules\n\n\nexport default {\n name: 'hide',\n enabled: true,\n phase: 'main',\n requiresIfExists: ['preventOverflow'],\n fn: hide\n};","import getBasePlacement from \"../utils/getBasePlacement.js\";\nimport { top, left, right, placements } from \"../enums.js\"; // eslint-disable-next-line import/no-unused-modules\n\nexport function distanceAndSkiddingToXY(placement, rects, offset) {\n var basePlacement = getBasePlacement(placement);\n var invertDistance = [left, top].indexOf(basePlacement) >= 0 ? -1 : 1;\n\n var _ref = typeof offset === 'function' ? offset(Object.assign({}, rects, {\n placement: placement\n })) : offset,\n skidding = _ref[0],\n distance = _ref[1];\n\n skidding = skidding || 0;\n distance = (distance || 0) * invertDistance;\n return [left, right].indexOf(basePlacement) >= 0 ? {\n x: distance,\n y: skidding\n } : {\n x: skidding,\n y: distance\n };\n}\n\nfunction offset(_ref2) {\n var state = _ref2.state,\n options = _ref2.options,\n name = _ref2.name;\n var _options$offset = options.offset,\n offset = _options$offset === void 0 ? [0, 0] : _options$offset;\n var data = placements.reduce(function (acc, placement) {\n acc[placement] = distanceAndSkiddingToXY(placement, state.rects, offset);\n return acc;\n }, {});\n var _data$state$placement = data[state.placement],\n x = _data$state$placement.x,\n y = _data$state$placement.y;\n\n if (state.modifiersData.popperOffsets != null) {\n state.modifiersData.popperOffsets.x += x;\n state.modifiersData.popperOffsets.y += y;\n }\n\n state.modifiersData[name] = data;\n} // eslint-disable-next-line import/no-unused-modules\n\n\nexport default {\n name: 'offset',\n enabled: true,\n phase: 'main',\n requires: ['popperOffsets'],\n fn: offset\n};","import computeOffsets from \"../utils/computeOffsets.js\";\n\nfunction popperOffsets(_ref) {\n var state = _ref.state,\n name = _ref.name;\n // Offsets are the actual position the popper needs to have to be\n // properly positioned near its reference element\n // This is the most basic placement, and will be adjusted by\n // the modifiers in the next step\n state.modifiersData[name] = computeOffsets({\n reference: state.rects.reference,\n element: state.rects.popper,\n strategy: 'absolute',\n placement: state.placement\n });\n} // eslint-disable-next-line import/no-unused-modules\n\n\nexport default {\n name: 'popperOffsets',\n enabled: true,\n phase: 'read',\n fn: popperOffsets,\n data: {}\n};","import { top, left, right, bottom, start } from \"../enums.js\";\nimport getBasePlacement from \"../utils/getBasePlacement.js\";\nimport getMainAxisFromPlacement from \"../utils/getMainAxisFromPlacement.js\";\nimport getAltAxis from \"../utils/getAltAxis.js\";\nimport { within, withinMaxClamp } from \"../utils/within.js\";\nimport getLayoutRect from \"../dom-utils/getLayoutRect.js\";\nimport getOffsetParent from \"../dom-utils/getOffsetParent.js\";\nimport detectOverflow from \"../utils/detectOverflow.js\";\nimport getVariation from \"../utils/getVariation.js\";\nimport getFreshSideObject from \"../utils/getFreshSideObject.js\";\nimport { min as mathMin, max as mathMax } from \"../utils/math.js\";\n\nfunction preventOverflow(_ref) {\n var state = _ref.state,\n options = _ref.options,\n name = _ref.name;\n var _options$mainAxis = options.mainAxis,\n checkMainAxis = _options$mainAxis === void 0 ? true : _options$mainAxis,\n _options$altAxis = options.altAxis,\n checkAltAxis = _options$altAxis === void 0 ? false : _options$altAxis,\n boundary = options.boundary,\n rootBoundary = options.rootBoundary,\n altBoundary = options.altBoundary,\n padding = options.padding,\n _options$tether = options.tether,\n tether = _options$tether === void 0 ? true : _options$tether,\n _options$tetherOffset = options.tetherOffset,\n tetherOffset = _options$tetherOffset === void 0 ? 0 : _options$tetherOffset;\n var overflow = detectOverflow(state, {\n boundary: boundary,\n rootBoundary: rootBoundary,\n padding: padding,\n altBoundary: altBoundary\n });\n var basePlacement = getBasePlacement(state.placement);\n var variation = getVariation(state.placement);\n var isBasePlacement = !variation;\n var mainAxis = getMainAxisFromPlacement(basePlacement);\n var altAxis = getAltAxis(mainAxis);\n var popperOffsets = state.modifiersData.popperOffsets;\n var referenceRect = state.rects.reference;\n var popperRect = state.rects.popper;\n var tetherOffsetValue = typeof tetherOffset === 'function' ? tetherOffset(Object.assign({}, state.rects, {\n placement: state.placement\n })) : tetherOffset;\n var normalizedTetherOffsetValue = typeof tetherOffsetValue === 'number' ? {\n mainAxis: tetherOffsetValue,\n altAxis: tetherOffsetValue\n } : Object.assign({\n mainAxis: 0,\n altAxis: 0\n }, tetherOffsetValue);\n var offsetModifierState = state.modifiersData.offset ? state.modifiersData.offset[state.placement] : null;\n var data = {\n x: 0,\n y: 0\n };\n\n if (!popperOffsets) {\n return;\n }\n\n if (checkMainAxis) {\n var _offsetModifierState$;\n\n var mainSide = mainAxis === 'y' ? top : left;\n var altSide = mainAxis === 'y' ? bottom : right;\n var len = mainAxis === 'y' ? 'height' : 'width';\n var offset = popperOffsets[mainAxis];\n var min = offset + overflow[mainSide];\n var max = offset - overflow[altSide];\n var additive = tether ? -popperRect[len] / 2 : 0;\n var minLen = variation === start ? referenceRect[len] : popperRect[len];\n var maxLen = variation === start ? -popperRect[len] : -referenceRect[len]; // We need to include the arrow in the calculation so the arrow doesn't go\n // outside the reference bounds\n\n var arrowElement = state.elements.arrow;\n var arrowRect = tether && arrowElement ? getLayoutRect(arrowElement) : {\n width: 0,\n height: 0\n };\n var arrowPaddingObject = state.modifiersData['arrow#persistent'] ? state.modifiersData['arrow#persistent'].padding : getFreshSideObject();\n var arrowPaddingMin = arrowPaddingObject[mainSide];\n var arrowPaddingMax = arrowPaddingObject[altSide]; // If the reference length is smaller than the arrow length, we don't want\n // to include its full size in the calculation. If the reference is small\n // and near the edge of a boundary, the popper can overflow even if the\n // reference is not overflowing as well (e.g. virtual elements with no\n // width or height)\n\n var arrowLen = within(0, referenceRect[len], arrowRect[len]);\n var minOffset = isBasePlacement ? referenceRect[len] / 2 - additive - arrowLen - arrowPaddingMin - normalizedTetherOffsetValue.mainAxis : minLen - arrowLen - arrowPaddingMin - normalizedTetherOffsetValue.mainAxis;\n var maxOffset = isBasePlacement ? -referenceRect[len] / 2 + additive + arrowLen + arrowPaddingMax + normalizedTetherOffsetValue.mainAxis : maxLen + arrowLen + arrowPaddingMax + normalizedTetherOffsetValue.mainAxis;\n var arrowOffsetParent = state.elements.arrow && getOffsetParent(state.elements.arrow);\n var clientOffset = arrowOffsetParent ? mainAxis === 'y' ? arrowOffsetParent.clientTop || 0 : arrowOffsetParent.clientLeft || 0 : 0;\n var offsetModifierValue = (_offsetModifierState$ = offsetModifierState == null ? void 0 : offsetModifierState[mainAxis]) != null ? _offsetModifierState$ : 0;\n var tetherMin = offset + minOffset - offsetModifierValue - clientOffset;\n var tetherMax = offset + maxOffset - offsetModifierValue;\n var preventedOffset = within(tether ? mathMin(min, tetherMin) : min, offset, tether ? mathMax(max, tetherMax) : max);\n popperOffsets[mainAxis] = preventedOffset;\n data[mainAxis] = preventedOffset - offset;\n }\n\n if (checkAltAxis) {\n var _offsetModifierState$2;\n\n var _mainSide = mainAxis === 'x' ? top : left;\n\n var _altSide = mainAxis === 'x' ? bottom : right;\n\n var _offset = popperOffsets[altAxis];\n\n var _len = altAxis === 'y' ? 'height' : 'width';\n\n var _min = _offset + overflow[_mainSide];\n\n var _max = _offset - overflow[_altSide];\n\n var isOriginSide = [top, left].indexOf(basePlacement) !== -1;\n\n var _offsetModifierValue = (_offsetModifierState$2 = offsetModifierState == null ? void 0 : offsetModifierState[altAxis]) != null ? _offsetModifierState$2 : 0;\n\n var _tetherMin = isOriginSide ? _min : _offset - referenceRect[_len] - popperRect[_len] - _offsetModifierValue + normalizedTetherOffsetValue.altAxis;\n\n var _tetherMax = isOriginSide ? _offset + referenceRect[_len] + popperRect[_len] - _offsetModifierValue - normalizedTetherOffsetValue.altAxis : _max;\n\n var _preventedOffset = tether && isOriginSide ? withinMaxClamp(_tetherMin, _offset, _tetherMax) : within(tether ? _tetherMin : _min, _offset, tether ? _tetherMax : _max);\n\n popperOffsets[altAxis] = _preventedOffset;\n data[altAxis] = _preventedOffset - _offset;\n }\n\n state.modifiersData[name] = data;\n} // eslint-disable-next-line import/no-unused-modules\n\n\nexport default {\n name: 'preventOverflow',\n enabled: true,\n phase: 'main',\n fn: preventOverflow,\n requiresIfExists: ['offset']\n};","export default function getAltAxis(axis) {\n return axis === 'x' ? 'y' : 'x';\n}","import getBoundingClientRect from \"./getBoundingClientRect.js\";\nimport getNodeScroll from \"./getNodeScroll.js\";\nimport getNodeName from \"./getNodeName.js\";\nimport { isHTMLElement } from \"./instanceOf.js\";\nimport getWindowScrollBarX from \"./getWindowScrollBarX.js\";\nimport getDocumentElement from \"./getDocumentElement.js\";\nimport isScrollParent from \"./isScrollParent.js\";\nimport { round } from \"../utils/math.js\";\n\nfunction isElementScaled(element) {\n var rect = element.getBoundingClientRect();\n var scaleX = round(rect.width) / element.offsetWidth || 1;\n var scaleY = round(rect.height) / element.offsetHeight || 1;\n return scaleX !== 1 || scaleY !== 1;\n} // Returns the composite rect of an element relative to its offsetParent.\n// Composite means it takes into account transforms as well as layout.\n\n\nexport default function getCompositeRect(elementOrVirtualElement, offsetParent, isFixed) {\n if (isFixed === void 0) {\n isFixed = false;\n }\n\n var isOffsetParentAnElement = isHTMLElement(offsetParent);\n var offsetParentIsScaled = isHTMLElement(offsetParent) && isElementScaled(offsetParent);\n var documentElement = getDocumentElement(offsetParent);\n var rect = getBoundingClientRect(elementOrVirtualElement, offsetParentIsScaled, isFixed);\n var scroll = {\n scrollLeft: 0,\n scrollTop: 0\n };\n var offsets = {\n x: 0,\n y: 0\n };\n\n if (isOffsetParentAnElement || !isOffsetParentAnElement && !isFixed) {\n if (getNodeName(offsetParent) !== 'body' || // https://github.com/popperjs/popper-core/issues/1078\n isScrollParent(documentElement)) {\n scroll = getNodeScroll(offsetParent);\n }\n\n if (isHTMLElement(offsetParent)) {\n offsets = getBoundingClientRect(offsetParent, true);\n offsets.x += offsetParent.clientLeft;\n offsets.y += offsetParent.clientTop;\n } else if (documentElement) {\n offsets.x = getWindowScrollBarX(documentElement);\n }\n }\n\n return {\n x: rect.left + scroll.scrollLeft - offsets.x,\n y: rect.top + scroll.scrollTop - offsets.y,\n width: rect.width,\n height: rect.height\n };\n}","import getWindowScroll from \"./getWindowScroll.js\";\nimport getWindow from \"./getWindow.js\";\nimport { isHTMLElement } from \"./instanceOf.js\";\nimport getHTMLElementScroll from \"./getHTMLElementScroll.js\";\nexport default function getNodeScroll(node) {\n if (node === getWindow(node) || !isHTMLElement(node)) {\n return getWindowScroll(node);\n } else {\n return getHTMLElementScroll(node);\n }\n}","export default function getHTMLElementScroll(element) {\n return {\n scrollLeft: element.scrollLeft,\n scrollTop: element.scrollTop\n };\n}","import { modifierPhases } from \"../enums.js\"; // source: https://stackoverflow.com/questions/49875255\n\nfunction order(modifiers) {\n var map = new Map();\n var visited = new Set();\n var result = [];\n modifiers.forEach(function (modifier) {\n map.set(modifier.name, modifier);\n }); // On visiting object, check for its dependencies and visit them recursively\n\n function sort(modifier) {\n visited.add(modifier.name);\n var requires = [].concat(modifier.requires || [], modifier.requiresIfExists || []);\n requires.forEach(function (dep) {\n if (!visited.has(dep)) {\n var depModifier = map.get(dep);\n\n if (depModifier) {\n sort(depModifier);\n }\n }\n });\n result.push(modifier);\n }\n\n modifiers.forEach(function (modifier) {\n if (!visited.has(modifier.name)) {\n // check for visited object\n sort(modifier);\n }\n });\n return result;\n}\n\nexport default function orderModifiers(modifiers) {\n // order based on dependencies\n var orderedModifiers = order(modifiers); // order based on phase\n\n return modifierPhases.reduce(function (acc, phase) {\n return acc.concat(orderedModifiers.filter(function (modifier) {\n return modifier.phase === phase;\n }));\n }, []);\n}","import getCompositeRect from \"./dom-utils/getCompositeRect.js\";\nimport getLayoutRect from \"./dom-utils/getLayoutRect.js\";\nimport listScrollParents from \"./dom-utils/listScrollParents.js\";\nimport getOffsetParent from \"./dom-utils/getOffsetParent.js\";\nimport orderModifiers from \"./utils/orderModifiers.js\";\nimport debounce from \"./utils/debounce.js\";\nimport mergeByName from \"./utils/mergeByName.js\";\nimport detectOverflow from \"./utils/detectOverflow.js\";\nimport { isElement } from \"./dom-utils/instanceOf.js\";\nvar DEFAULT_OPTIONS = {\n placement: 'bottom',\n modifiers: [],\n strategy: 'absolute'\n};\n\nfunction areValidElements() {\n for (var _len = arguments.length, args = new Array(_len), _key = 0; _key < _len; _key++) {\n args[_key] = arguments[_key];\n }\n\n return !args.some(function (element) {\n return !(element && typeof element.getBoundingClientRect === 'function');\n });\n}\n\nexport function popperGenerator(generatorOptions) {\n if (generatorOptions === void 0) {\n generatorOptions = {};\n }\n\n var _generatorOptions = generatorOptions,\n _generatorOptions$def = _generatorOptions.defaultModifiers,\n defaultModifiers = _generatorOptions$def === void 0 ? [] : _generatorOptions$def,\n _generatorOptions$def2 = _generatorOptions.defaultOptions,\n defaultOptions = _generatorOptions$def2 === void 0 ? DEFAULT_OPTIONS : _generatorOptions$def2;\n return function createPopper(reference, popper, options) {\n if (options === void 0) {\n options = defaultOptions;\n }\n\n var state = {\n placement: 'bottom',\n orderedModifiers: [],\n options: Object.assign({}, DEFAULT_OPTIONS, defaultOptions),\n modifiersData: {},\n elements: {\n reference: reference,\n popper: popper\n },\n attributes: {},\n styles: {}\n };\n var effectCleanupFns = [];\n var isDestroyed = false;\n var instance = {\n state: state,\n setOptions: function setOptions(setOptionsAction) {\n var options = typeof setOptionsAction === 'function' ? setOptionsAction(state.options) : setOptionsAction;\n cleanupModifierEffects();\n state.options = Object.assign({}, defaultOptions, state.options, options);\n state.scrollParents = {\n reference: isElement(reference) ? listScrollParents(reference) : reference.contextElement ? listScrollParents(reference.contextElement) : [],\n popper: listScrollParents(popper)\n }; // Orders the modifiers based on their dependencies and `phase`\n // properties\n\n var orderedModifiers = orderModifiers(mergeByName([].concat(defaultModifiers, state.options.modifiers))); // Strip out disabled modifiers\n\n state.orderedModifiers = orderedModifiers.filter(function (m) {\n return m.enabled;\n });\n runModifierEffects();\n return instance.update();\n },\n // Sync update – it will always be executed, even if not necessary. This\n // is useful for low frequency updates where sync behavior simplifies the\n // logic.\n // For high frequency updates (e.g. `resize` and `scroll` events), always\n // prefer the async Popper#update method\n forceUpdate: function forceUpdate() {\n if (isDestroyed) {\n return;\n }\n\n var _state$elements = state.elements,\n reference = _state$elements.reference,\n popper = _state$elements.popper; // Don't proceed if `reference` or `popper` are not valid elements\n // anymore\n\n if (!areValidElements(reference, popper)) {\n return;\n } // Store the reference and popper rects to be read by modifiers\n\n\n state.rects = {\n reference: getCompositeRect(reference, getOffsetParent(popper), state.options.strategy === 'fixed'),\n popper: getLayoutRect(popper)\n }; // Modifiers have the ability to reset the current update cycle. The\n // most common use case for this is the `flip` modifier changing the\n // placement, which then needs to re-run all the modifiers, because the\n // logic was previously ran for the previous placement and is therefore\n // stale/incorrect\n\n state.reset = false;\n state.placement = state.options.placement; // On each update cycle, the `modifiersData` property for each modifier\n // is filled with the initial data specified by the modifier. This means\n // it doesn't persist and is fresh on each update.\n // To ensure persistent data, use `${name}#persistent`\n\n state.orderedModifiers.forEach(function (modifier) {\n return state.modifiersData[modifier.name] = Object.assign({}, modifier.data);\n });\n\n for (var index = 0; index < state.orderedModifiers.length; index++) {\n if (state.reset === true) {\n state.reset = false;\n index = -1;\n continue;\n }\n\n var _state$orderedModifie = state.orderedModifiers[index],\n fn = _state$orderedModifie.fn,\n _state$orderedModifie2 = _state$orderedModifie.options,\n _options = _state$orderedModifie2 === void 0 ? {} : _state$orderedModifie2,\n name = _state$orderedModifie.name;\n\n if (typeof fn === 'function') {\n state = fn({\n state: state,\n options: _options,\n name: name,\n instance: instance\n }) || state;\n }\n }\n },\n // Async and optimistically optimized update – it will not be executed if\n // not necessary (debounced to run at most once-per-tick)\n update: debounce(function () {\n return new Promise(function (resolve) {\n instance.forceUpdate();\n resolve(state);\n });\n }),\n destroy: function destroy() {\n cleanupModifierEffects();\n isDestroyed = true;\n }\n };\n\n if (!areValidElements(reference, popper)) {\n return instance;\n }\n\n instance.setOptions(options).then(function (state) {\n if (!isDestroyed && options.onFirstUpdate) {\n options.onFirstUpdate(state);\n }\n }); // Modifiers have the ability to execute arbitrary code before the first\n // update cycle runs. They will be executed in the same order as the update\n // cycle. This is useful when a modifier adds some persistent data that\n // other modifiers need to use, but the modifier is run after the dependent\n // one.\n\n function runModifierEffects() {\n state.orderedModifiers.forEach(function (_ref) {\n var name = _ref.name,\n _ref$options = _ref.options,\n options = _ref$options === void 0 ? {} : _ref$options,\n effect = _ref.effect;\n\n if (typeof effect === 'function') {\n var cleanupFn = effect({\n state: state,\n name: name,\n instance: instance,\n options: options\n });\n\n var noopFn = function noopFn() {};\n\n effectCleanupFns.push(cleanupFn || noopFn);\n }\n });\n }\n\n function cleanupModifierEffects() {\n effectCleanupFns.forEach(function (fn) {\n return fn();\n });\n effectCleanupFns = [];\n }\n\n return instance;\n };\n}\nexport var createPopper = /*#__PURE__*/popperGenerator(); // eslint-disable-next-line import/no-unused-modules\n\nexport { detectOverflow };","export default function debounce(fn) {\n var pending;\n return function () {\n if (!pending) {\n pending = new Promise(function (resolve) {\n Promise.resolve().then(function () {\n pending = undefined;\n resolve(fn());\n });\n });\n }\n\n return pending;\n };\n}","export default function mergeByName(modifiers) {\n var merged = modifiers.reduce(function (merged, current) {\n var existing = merged[current.name];\n merged[current.name] = existing ? Object.assign({}, existing, current, {\n options: Object.assign({}, existing.options, current.options),\n data: Object.assign({}, existing.data, current.data)\n }) : current;\n return merged;\n }, {}); // IE11 does not support Object.values\n\n return Object.keys(merged).map(function (key) {\n return merged[key];\n });\n}","import { popperGenerator, detectOverflow } from \"./createPopper.js\";\nimport eventListeners from \"./modifiers/eventListeners.js\";\nimport popperOffsets from \"./modifiers/popperOffsets.js\";\nimport computeStyles from \"./modifiers/computeStyles.js\";\nimport applyStyles from \"./modifiers/applyStyles.js\";\nvar defaultModifiers = [eventListeners, popperOffsets, computeStyles, applyStyles];\nvar createPopper = /*#__PURE__*/popperGenerator({\n defaultModifiers: defaultModifiers\n}); // eslint-disable-next-line import/no-unused-modules\n\nexport { createPopper, popperGenerator, defaultModifiers, detectOverflow };","import { popperGenerator, detectOverflow } from \"./createPopper.js\";\nimport eventListeners from \"./modifiers/eventListeners.js\";\nimport popperOffsets from \"./modifiers/popperOffsets.js\";\nimport computeStyles from \"./modifiers/computeStyles.js\";\nimport applyStyles from \"./modifiers/applyStyles.js\";\nimport offset from \"./modifiers/offset.js\";\nimport flip from \"./modifiers/flip.js\";\nimport preventOverflow from \"./modifiers/preventOverflow.js\";\nimport arrow from \"./modifiers/arrow.js\";\nimport hide from \"./modifiers/hide.js\";\nvar defaultModifiers = [eventListeners, popperOffsets, computeStyles, applyStyles, offset, flip, preventOverflow, arrow, hide];\nvar createPopper = /*#__PURE__*/popperGenerator({\n defaultModifiers: defaultModifiers\n}); // eslint-disable-next-line import/no-unused-modules\n\nexport { createPopper, popperGenerator, defaultModifiers, detectOverflow }; // eslint-disable-next-line import/no-unused-modules\n\nexport { createPopper as createPopperLite } from \"./popper-lite.js\"; // eslint-disable-next-line import/no-unused-modules\n\nexport * from \"./modifiers/index.js\";","/**\n * --------------------------------------------------------------------------\n * Bootstrap dropdown.js\n * Licensed under MIT (https://github.com/twbs/bootstrap/blob/main/LICENSE)\n * --------------------------------------------------------------------------\n */\n\nimport * as Popper from '@popperjs/core'\nimport BaseComponent from './base-component.js'\nimport EventHandler from './dom/event-handler.js'\nimport Manipulator from './dom/manipulator.js'\nimport SelectorEngine from './dom/selector-engine.js'\nimport {\n defineJQueryPlugin,\n execute,\n getElement,\n getNextActiveElement,\n isDisabled,\n isElement,\n isRTL,\n isVisible,\n noop\n} from './util/index.js'\n\n/**\n * Constants\n */\n\nconst NAME = 'dropdown'\nconst DATA_KEY = 'bs.dropdown'\nconst EVENT_KEY = `.${DATA_KEY}`\nconst DATA_API_KEY = '.data-api'\n\nconst ESCAPE_KEY = 'Escape'\nconst TAB_KEY = 'Tab'\nconst ARROW_UP_KEY = 'ArrowUp'\nconst ARROW_DOWN_KEY = 'ArrowDown'\nconst RIGHT_MOUSE_BUTTON = 2 // MouseEvent.button value for the secondary button, usually the right button\n\nconst EVENT_HIDE = `hide${EVENT_KEY}`\nconst EVENT_HIDDEN = `hidden${EVENT_KEY}`\nconst EVENT_SHOW = `show${EVENT_KEY}`\nconst EVENT_SHOWN = `shown${EVENT_KEY}`\nconst EVENT_CLICK_DATA_API = `click${EVENT_KEY}${DATA_API_KEY}`\nconst EVENT_KEYDOWN_DATA_API = `keydown${EVENT_KEY}${DATA_API_KEY}`\nconst EVENT_KEYUP_DATA_API = `keyup${EVENT_KEY}${DATA_API_KEY}`\n\nconst CLASS_NAME_SHOW = 'show'\nconst CLASS_NAME_DROPUP = 'dropup'\nconst CLASS_NAME_DROPEND = 'dropend'\nconst CLASS_NAME_DROPSTART = 'dropstart'\nconst CLASS_NAME_DROPUP_CENTER = 'dropup-center'\nconst CLASS_NAME_DROPDOWN_CENTER = 'dropdown-center'\n\nconst SELECTOR_DATA_TOGGLE = '[data-bs-toggle=\"dropdown\"]:not(.disabled):not(:disabled)'\nconst SELECTOR_DATA_TOGGLE_SHOWN = `${SELECTOR_DATA_TOGGLE}.${CLASS_NAME_SHOW}`\nconst SELECTOR_MENU = '.dropdown-menu'\nconst SELECTOR_NAVBAR = '.navbar'\nconst SELECTOR_NAVBAR_NAV = '.navbar-nav'\nconst SELECTOR_VISIBLE_ITEMS = '.dropdown-menu .dropdown-item:not(.disabled):not(:disabled)'\n\nconst PLACEMENT_TOP = isRTL() ? 'top-end' : 'top-start'\nconst PLACEMENT_TOPEND = isRTL() ? 'top-start' : 'top-end'\nconst PLACEMENT_BOTTOM = isRTL() ? 'bottom-end' : 'bottom-start'\nconst PLACEMENT_BOTTOMEND = isRTL() ? 'bottom-start' : 'bottom-end'\nconst PLACEMENT_RIGHT = isRTL() ? 'left-start' : 'right-start'\nconst PLACEMENT_LEFT = isRTL() ? 'right-start' : 'left-start'\nconst PLACEMENT_TOPCENTER = 'top'\nconst PLACEMENT_BOTTOMCENTER = 'bottom'\n\nconst Default = {\n autoClose: true,\n boundary: 'clippingParents',\n display: 'dynamic',\n offset: [0, 2],\n popperConfig: null,\n reference: 'toggle'\n}\n\nconst DefaultType = {\n autoClose: '(boolean|string)',\n boundary: '(string|element)',\n display: 'string',\n offset: '(array|string|function)',\n popperConfig: '(null|object|function)',\n reference: '(string|element|object)'\n}\n\n/**\n * Class definition\n */\n\nclass Dropdown extends BaseComponent {\n constructor(element, config) {\n super(element, config)\n\n this._popper = null\n this._parent = this._element.parentNode // dropdown wrapper\n // TODO: v6 revert #37011 & change markup https://getbootstrap.com/docs/5.3/forms/input-group/\n this._menu = SelectorEngine.next(this._element, SELECTOR_MENU)[0] ||\n SelectorEngine.prev(this._element, SELECTOR_MENU)[0] ||\n SelectorEngine.findOne(SELECTOR_MENU, this._parent)\n this._inNavbar = this._detectNavbar()\n }\n\n // Getters\n static get Default() {\n return Default\n }\n\n static get DefaultType() {\n return DefaultType\n }\n\n static get NAME() {\n return NAME\n }\n\n // Public\n toggle() {\n return this._isShown() ? this.hide() : this.show()\n }\n\n show() {\n if (isDisabled(this._element) || this._isShown()) {\n return\n }\n\n const relatedTarget = {\n relatedTarget: this._element\n }\n\n const showEvent = EventHandler.trigger(this._element, EVENT_SHOW, relatedTarget)\n\n if (showEvent.defaultPrevented) {\n return\n }\n\n this._createPopper()\n\n // If this is a touch-enabled device we add extra\n // empty mouseover listeners to the body's immediate children;\n // only needed because of broken event delegation on iOS\n // https://www.quirksmode.org/blog/archives/2014/02/mouse_event_bub.html\n if ('ontouchstart' in document.documentElement && !this._parent.closest(SELECTOR_NAVBAR_NAV)) {\n for (const element of [].concat(...document.body.children)) {\n EventHandler.on(element, 'mouseover', noop)\n }\n }\n\n this._element.focus()\n this._element.setAttribute('aria-expanded', true)\n\n this._menu.classList.add(CLASS_NAME_SHOW)\n this._element.classList.add(CLASS_NAME_SHOW)\n EventHandler.trigger(this._element, EVENT_SHOWN, relatedTarget)\n }\n\n hide() {\n if (isDisabled(this._element) || !this._isShown()) {\n return\n }\n\n const relatedTarget = {\n relatedTarget: this._element\n }\n\n this._completeHide(relatedTarget)\n }\n\n dispose() {\n if (this._popper) {\n this._popper.destroy()\n }\n\n super.dispose()\n }\n\n update() {\n this._inNavbar = this._detectNavbar()\n if (this._popper) {\n this._popper.update()\n }\n }\n\n // Private\n _completeHide(relatedTarget) {\n const hideEvent = EventHandler.trigger(this._element, EVENT_HIDE, relatedTarget)\n if (hideEvent.defaultPrevented) {\n return\n }\n\n // If this is a touch-enabled device we remove the extra\n // empty mouseover listeners we added for iOS support\n if ('ontouchstart' in document.documentElement) {\n for (const element of [].concat(...document.body.children)) {\n EventHandler.off(element, 'mouseover', noop)\n }\n }\n\n if (this._popper) {\n this._popper.destroy()\n }\n\n this._menu.classList.remove(CLASS_NAME_SHOW)\n this._element.classList.remove(CLASS_NAME_SHOW)\n this._element.setAttribute('aria-expanded', 'false')\n Manipulator.removeDataAttribute(this._menu, 'popper')\n EventHandler.trigger(this._element, EVENT_HIDDEN, relatedTarget)\n }\n\n _getConfig(config) {\n config = super._getConfig(config)\n\n if (typeof config.reference === 'object' && !isElement(config.reference) &&\n typeof config.reference.getBoundingClientRect !== 'function'\n ) {\n // Popper virtual elements require a getBoundingClientRect method\n throw new TypeError(`${NAME.toUpperCase()}: Option \"reference\" provided type \"object\" without a required \"getBoundingClientRect\" method.`)\n }\n\n return config\n }\n\n _createPopper() {\n if (typeof Popper === 'undefined') {\n throw new TypeError('Bootstrap\\'s dropdowns require Popper (https://popper.js.org)')\n }\n\n let referenceElement = this._element\n\n if (this._config.reference === 'parent') {\n referenceElement = this._parent\n } else if (isElement(this._config.reference)) {\n referenceElement = getElement(this._config.reference)\n } else if (typeof this._config.reference === 'object') {\n referenceElement = this._config.reference\n }\n\n const popperConfig = this._getPopperConfig()\n this._popper = Popper.createPopper(referenceElement, this._menu, popperConfig)\n }\n\n _isShown() {\n return this._menu.classList.contains(CLASS_NAME_SHOW)\n }\n\n _getPlacement() {\n const parentDropdown = this._parent\n\n if (parentDropdown.classList.contains(CLASS_NAME_DROPEND)) {\n return PLACEMENT_RIGHT\n }\n\n if (parentDropdown.classList.contains(CLASS_NAME_DROPSTART)) {\n return PLACEMENT_LEFT\n }\n\n if (parentDropdown.classList.contains(CLASS_NAME_DROPUP_CENTER)) {\n return PLACEMENT_TOPCENTER\n }\n\n if (parentDropdown.classList.contains(CLASS_NAME_DROPDOWN_CENTER)) {\n return PLACEMENT_BOTTOMCENTER\n }\n\n // We need to trim the value because custom properties can also include spaces\n const isEnd = getComputedStyle(this._menu).getPropertyValue('--bs-position').trim() === 'end'\n\n if (parentDropdown.classList.contains(CLASS_NAME_DROPUP)) {\n return isEnd ? PLACEMENT_TOPEND : PLACEMENT_TOP\n }\n\n return isEnd ? PLACEMENT_BOTTOMEND : PLACEMENT_BOTTOM\n }\n\n _detectNavbar() {\n return this._element.closest(SELECTOR_NAVBAR) !== null\n }\n\n _getOffset() {\n const { offset } = this._config\n\n if (typeof offset === 'string') {\n return offset.split(',').map(value => Number.parseInt(value, 10))\n }\n\n if (typeof offset === 'function') {\n return popperData => offset(popperData, this._element)\n }\n\n return offset\n }\n\n _getPopperConfig() {\n const defaultBsPopperConfig = {\n placement: this._getPlacement(),\n modifiers: [{\n name: 'preventOverflow',\n options: {\n boundary: this._config.boundary\n }\n },\n {\n name: 'offset',\n options: {\n offset: this._getOffset()\n }\n }]\n }\n\n // Disable Popper if we have a static display or Dropdown is in Navbar\n if (this._inNavbar || this._config.display === 'static') {\n Manipulator.setDataAttribute(this._menu, 'popper', 'static') // TODO: v6 remove\n defaultBsPopperConfig.modifiers = [{\n name: 'applyStyles',\n enabled: false\n }]\n }\n\n return {\n ...defaultBsPopperConfig,\n ...execute(this._config.popperConfig, [defaultBsPopperConfig])\n }\n }\n\n _selectMenuItem({ key, target }) {\n const items = SelectorEngine.find(SELECTOR_VISIBLE_ITEMS, this._menu).filter(element => isVisible(element))\n\n if (!items.length) {\n return\n }\n\n // if target isn't included in items (e.g. when expanding the dropdown)\n // allow cycling to get the last item in case key equals ARROW_UP_KEY\n getNextActiveElement(items, target, key === ARROW_DOWN_KEY, !items.includes(target)).focus()\n }\n\n // Static\n static jQueryInterface(config) {\n return this.each(function () {\n const data = Dropdown.getOrCreateInstance(this, config)\n\n if (typeof config !== 'string') {\n return\n }\n\n if (typeof data[config] === 'undefined') {\n throw new TypeError(`No method named \"${config}\"`)\n }\n\n data[config]()\n })\n }\n\n static clearMenus(event) {\n if (event.button === RIGHT_MOUSE_BUTTON || (event.type === 'keyup' && event.key !== TAB_KEY)) {\n return\n }\n\n const openToggles = SelectorEngine.find(SELECTOR_DATA_TOGGLE_SHOWN)\n\n for (const toggle of openToggles) {\n const context = Dropdown.getInstance(toggle)\n if (!context || context._config.autoClose === false) {\n continue\n }\n\n const composedPath = event.composedPath()\n const isMenuTarget = composedPath.includes(context._menu)\n if (\n composedPath.includes(context._element) ||\n (context._config.autoClose === 'inside' && !isMenuTarget) ||\n (context._config.autoClose === 'outside' && isMenuTarget)\n ) {\n continue\n }\n\n // Tab navigation through the dropdown menu or events from contained inputs shouldn't close the menu\n if (context._menu.contains(event.target) && ((event.type === 'keyup' && event.key === TAB_KEY) || /input|select|option|textarea|form/i.test(event.target.tagName))) {\n continue\n }\n\n const relatedTarget = { relatedTarget: context._element }\n\n if (event.type === 'click') {\n relatedTarget.clickEvent = event\n }\n\n context._completeHide(relatedTarget)\n }\n }\n\n static dataApiKeydownHandler(event) {\n // If not an UP | DOWN | ESCAPE key => not a dropdown command\n // If input/textarea && if key is other than ESCAPE => not a dropdown command\n\n const isInput = /input|textarea/i.test(event.target.tagName)\n const isEscapeEvent = event.key === ESCAPE_KEY\n const isUpOrDownEvent = [ARROW_UP_KEY, ARROW_DOWN_KEY].includes(event.key)\n\n if (!isUpOrDownEvent && !isEscapeEvent) {\n return\n }\n\n if (isInput && !isEscapeEvent) {\n return\n }\n\n event.preventDefault()\n\n // TODO: v6 revert #37011 & change markup https://getbootstrap.com/docs/5.3/forms/input-group/\n const getToggleButton = this.matches(SELECTOR_DATA_TOGGLE) ?\n this :\n (SelectorEngine.prev(this, SELECTOR_DATA_TOGGLE)[0] ||\n SelectorEngine.next(this, SELECTOR_DATA_TOGGLE)[0] ||\n SelectorEngine.findOne(SELECTOR_DATA_TOGGLE, event.delegateTarget.parentNode))\n\n const instance = Dropdown.getOrCreateInstance(getToggleButton)\n\n if (isUpOrDownEvent) {\n event.stopPropagation()\n instance.show()\n instance._selectMenuItem(event)\n return\n }\n\n if (instance._isShown()) { // else is escape and we check if it is shown\n event.stopPropagation()\n instance.hide()\n getToggleButton.focus()\n }\n }\n}\n\n/**\n * Data API implementation\n */\n\nEventHandler.on(document, EVENT_KEYDOWN_DATA_API, SELECTOR_DATA_TOGGLE, Dropdown.dataApiKeydownHandler)\nEventHandler.on(document, EVENT_KEYDOWN_DATA_API, SELECTOR_MENU, Dropdown.dataApiKeydownHandler)\nEventHandler.on(document, EVENT_CLICK_DATA_API, Dropdown.clearMenus)\nEventHandler.on(document, EVENT_KEYUP_DATA_API, Dropdown.clearMenus)\nEventHandler.on(document, EVENT_CLICK_DATA_API, SELECTOR_DATA_TOGGLE, function (event) {\n event.preventDefault()\n Dropdown.getOrCreateInstance(this).toggle()\n})\n\n/**\n * jQuery\n */\n\ndefineJQueryPlugin(Dropdown)\n\nexport default Dropdown\n","/**\n * --------------------------------------------------------------------------\n * Bootstrap util/backdrop.js\n * Licensed under MIT (https://github.com/twbs/bootstrap/blob/main/LICENSE)\n * --------------------------------------------------------------------------\n */\n\nimport EventHandler from '../dom/event-handler.js'\nimport Config from './config.js'\nimport { execute, executeAfterTransition, getElement, reflow } from './index.js'\n\n/**\n * Constants\n */\n\nconst NAME = 'backdrop'\nconst CLASS_NAME_FADE = 'fade'\nconst CLASS_NAME_SHOW = 'show'\nconst EVENT_MOUSEDOWN = `mousedown.bs.${NAME}`\n\nconst Default = {\n className: 'modal-backdrop',\n clickCallback: null,\n isAnimated: false,\n isVisible: true, // if false, we use the backdrop helper without adding any element to the dom\n rootElement: 'body' // give the choice to place backdrop under different elements\n}\n\nconst DefaultType = {\n className: 'string',\n clickCallback: '(function|null)',\n isAnimated: 'boolean',\n isVisible: 'boolean',\n rootElement: '(element|string)'\n}\n\n/**\n * Class definition\n */\n\nclass Backdrop extends Config {\n constructor(config) {\n super()\n this._config = this._getConfig(config)\n this._isAppended = false\n this._element = null\n }\n\n // Getters\n static get Default() {\n return Default\n }\n\n static get DefaultType() {\n return DefaultType\n }\n\n static get NAME() {\n return NAME\n }\n\n // Public\n show(callback) {\n if (!this._config.isVisible) {\n execute(callback)\n return\n }\n\n this._append()\n\n const element = this._getElement()\n if (this._config.isAnimated) {\n reflow(element)\n }\n\n element.classList.add(CLASS_NAME_SHOW)\n\n this._emulateAnimation(() => {\n execute(callback)\n })\n }\n\n hide(callback) {\n if (!this._config.isVisible) {\n execute(callback)\n return\n }\n\n this._getElement().classList.remove(CLASS_NAME_SHOW)\n\n this._emulateAnimation(() => {\n this.dispose()\n execute(callback)\n })\n }\n\n dispose() {\n if (!this._isAppended) {\n return\n }\n\n EventHandler.off(this._element, EVENT_MOUSEDOWN)\n\n this._element.remove()\n this._isAppended = false\n }\n\n // Private\n _getElement() {\n if (!this._element) {\n const backdrop = document.createElement('div')\n backdrop.className = this._config.className\n if (this._config.isAnimated) {\n backdrop.classList.add(CLASS_NAME_FADE)\n }\n\n this._element = backdrop\n }\n\n return this._element\n }\n\n _configAfterMerge(config) {\n // use getElement() with the default \"body\" to get a fresh Element on each instantiation\n config.rootElement = getElement(config.rootElement)\n return config\n }\n\n _append() {\n if (this._isAppended) {\n return\n }\n\n const element = this._getElement()\n this._config.rootElement.append(element)\n\n EventHandler.on(element, EVENT_MOUSEDOWN, () => {\n execute(this._config.clickCallback)\n })\n\n this._isAppended = true\n }\n\n _emulateAnimation(callback) {\n executeAfterTransition(callback, this._getElement(), this._config.isAnimated)\n }\n}\n\nexport default Backdrop\n","/**\n * --------------------------------------------------------------------------\n * Bootstrap util/focustrap.js\n * Licensed under MIT (https://github.com/twbs/bootstrap/blob/main/LICENSE)\n * --------------------------------------------------------------------------\n */\n\nimport EventHandler from '../dom/event-handler.js'\nimport SelectorEngine from '../dom/selector-engine.js'\nimport Config from './config.js'\n\n/**\n * Constants\n */\n\nconst NAME = 'focustrap'\nconst DATA_KEY = 'bs.focustrap'\nconst EVENT_KEY = `.${DATA_KEY}`\nconst EVENT_FOCUSIN = `focusin${EVENT_KEY}`\nconst EVENT_KEYDOWN_TAB = `keydown.tab${EVENT_KEY}`\n\nconst TAB_KEY = 'Tab'\nconst TAB_NAV_FORWARD = 'forward'\nconst TAB_NAV_BACKWARD = 'backward'\n\nconst Default = {\n autofocus: true,\n trapElement: null // The element to trap focus inside of\n}\n\nconst DefaultType = {\n autofocus: 'boolean',\n trapElement: 'element'\n}\n\n/**\n * Class definition\n */\n\nclass FocusTrap extends Config {\n constructor(config) {\n super()\n this._config = this._getConfig(config)\n this._isActive = false\n this._lastTabNavDirection = null\n }\n\n // Getters\n static get Default() {\n return Default\n }\n\n static get DefaultType() {\n return DefaultType\n }\n\n static get NAME() {\n return NAME\n }\n\n // Public\n activate() {\n if (this._isActive) {\n return\n }\n\n if (this._config.autofocus) {\n this._config.trapElement.focus()\n }\n\n EventHandler.off(document, EVENT_KEY) // guard against infinite focus loop\n EventHandler.on(document, EVENT_FOCUSIN, event => this._handleFocusin(event))\n EventHandler.on(document, EVENT_KEYDOWN_TAB, event => this._handleKeydown(event))\n\n this._isActive = true\n }\n\n deactivate() {\n if (!this._isActive) {\n return\n }\n\n this._isActive = false\n EventHandler.off(document, EVENT_KEY)\n }\n\n // Private\n _handleFocusin(event) {\n const { trapElement } = this._config\n\n if (event.target === document || event.target === trapElement || trapElement.contains(event.target)) {\n return\n }\n\n const elements = SelectorEngine.focusableChildren(trapElement)\n\n if (elements.length === 0) {\n trapElement.focus()\n } else if (this._lastTabNavDirection === TAB_NAV_BACKWARD) {\n elements[elements.length - 1].focus()\n } else {\n elements[0].focus()\n }\n }\n\n _handleKeydown(event) {\n if (event.key !== TAB_KEY) {\n return\n }\n\n this._lastTabNavDirection = event.shiftKey ? TAB_NAV_BACKWARD : TAB_NAV_FORWARD\n }\n}\n\nexport default FocusTrap\n","/**\n * --------------------------------------------------------------------------\n * Bootstrap util/scrollBar.js\n * Licensed under MIT (https://github.com/twbs/bootstrap/blob/main/LICENSE)\n * --------------------------------------------------------------------------\n */\n\nimport Manipulator from '../dom/manipulator.js'\nimport SelectorEngine from '../dom/selector-engine.js'\nimport { isElement } from './index.js'\n\n/**\n * Constants\n */\n\nconst SELECTOR_FIXED_CONTENT = '.fixed-top, .fixed-bottom, .is-fixed, .sticky-top'\nconst SELECTOR_STICKY_CONTENT = '.sticky-top'\nconst PROPERTY_PADDING = 'padding-right'\nconst PROPERTY_MARGIN = 'margin-right'\n\n/**\n * Class definition\n */\n\nclass ScrollBarHelper {\n constructor() {\n this._element = document.body\n }\n\n // Public\n getWidth() {\n // https://developer.mozilla.org/en-US/docs/Web/API/Window/innerWidth#usage_notes\n const documentWidth = document.documentElement.clientWidth\n return Math.abs(window.innerWidth - documentWidth)\n }\n\n hide() {\n const width = this.getWidth()\n this._disableOverFlow()\n // give padding to element to balance the hidden scrollbar width\n this._setElementAttributes(this._element, PROPERTY_PADDING, calculatedValue => calculatedValue + width)\n // trick: We adjust positive paddingRight and negative marginRight to sticky-top elements to keep showing fullwidth\n this._setElementAttributes(SELECTOR_FIXED_CONTENT, PROPERTY_PADDING, calculatedValue => calculatedValue + width)\n this._setElementAttributes(SELECTOR_STICKY_CONTENT, PROPERTY_MARGIN, calculatedValue => calculatedValue - width)\n }\n\n reset() {\n this._resetElementAttributes(this._element, 'overflow')\n this._resetElementAttributes(this._element, PROPERTY_PADDING)\n this._resetElementAttributes(SELECTOR_FIXED_CONTENT, PROPERTY_PADDING)\n this._resetElementAttributes(SELECTOR_STICKY_CONTENT, PROPERTY_MARGIN)\n }\n\n isOverflowing() {\n return this.getWidth() > 0\n }\n\n // Private\n _disableOverFlow() {\n this._saveInitialAttribute(this._element, 'overflow')\n this._element.style.overflow = 'hidden'\n }\n\n _setElementAttributes(selector, styleProperty, callback) {\n const scrollbarWidth = this.getWidth()\n const manipulationCallBack = element => {\n if (element !== this._element && window.innerWidth > element.clientWidth + scrollbarWidth) {\n return\n }\n\n this._saveInitialAttribute(element, styleProperty)\n const calculatedValue = window.getComputedStyle(element).getPropertyValue(styleProperty)\n element.style.setProperty(styleProperty, `${callback(Number.parseFloat(calculatedValue))}px`)\n }\n\n this._applyManipulationCallback(selector, manipulationCallBack)\n }\n\n _saveInitialAttribute(element, styleProperty) {\n const actualValue = element.style.getPropertyValue(styleProperty)\n if (actualValue) {\n Manipulator.setDataAttribute(element, styleProperty, actualValue)\n }\n }\n\n _resetElementAttributes(selector, styleProperty) {\n const manipulationCallBack = element => {\n const value = Manipulator.getDataAttribute(element, styleProperty)\n // We only want to remove the property if the value is `null`; the value can also be zero\n if (value === null) {\n element.style.removeProperty(styleProperty)\n return\n }\n\n Manipulator.removeDataAttribute(element, styleProperty)\n element.style.setProperty(styleProperty, value)\n }\n\n this._applyManipulationCallback(selector, manipulationCallBack)\n }\n\n _applyManipulationCallback(selector, callBack) {\n if (isElement(selector)) {\n callBack(selector)\n return\n }\n\n for (const sel of SelectorEngine.find(selector, this._element)) {\n callBack(sel)\n }\n }\n}\n\nexport default ScrollBarHelper\n","/**\n * --------------------------------------------------------------------------\n * Bootstrap modal.js\n * Licensed under MIT (https://github.com/twbs/bootstrap/blob/main/LICENSE)\n * --------------------------------------------------------------------------\n */\n\nimport BaseComponent from './base-component.js'\nimport EventHandler from './dom/event-handler.js'\nimport SelectorEngine from './dom/selector-engine.js'\nimport Backdrop from './util/backdrop.js'\nimport { enableDismissTrigger } from './util/component-functions.js'\nimport FocusTrap from './util/focustrap.js'\nimport { defineJQueryPlugin, isRTL, isVisible, reflow } from './util/index.js'\nimport ScrollBarHelper from './util/scrollbar.js'\n\n/**\n * Constants\n */\n\nconst NAME = 'modal'\nconst DATA_KEY = 'bs.modal'\nconst EVENT_KEY = `.${DATA_KEY}`\nconst DATA_API_KEY = '.data-api'\nconst ESCAPE_KEY = 'Escape'\n\nconst EVENT_HIDE = `hide${EVENT_KEY}`\nconst EVENT_HIDE_PREVENTED = `hidePrevented${EVENT_KEY}`\nconst EVENT_HIDDEN = `hidden${EVENT_KEY}`\nconst EVENT_SHOW = `show${EVENT_KEY}`\nconst EVENT_SHOWN = `shown${EVENT_KEY}`\nconst EVENT_RESIZE = `resize${EVENT_KEY}`\nconst EVENT_CLICK_DISMISS = `click.dismiss${EVENT_KEY}`\nconst EVENT_MOUSEDOWN_DISMISS = `mousedown.dismiss${EVENT_KEY}`\nconst EVENT_KEYDOWN_DISMISS = `keydown.dismiss${EVENT_KEY}`\nconst EVENT_CLICK_DATA_API = `click${EVENT_KEY}${DATA_API_KEY}`\n\nconst CLASS_NAME_OPEN = 'modal-open'\nconst CLASS_NAME_FADE = 'fade'\nconst CLASS_NAME_SHOW = 'show'\nconst CLASS_NAME_STATIC = 'modal-static'\n\nconst OPEN_SELECTOR = '.modal.show'\nconst SELECTOR_DIALOG = '.modal-dialog'\nconst SELECTOR_MODAL_BODY = '.modal-body'\nconst SELECTOR_DATA_TOGGLE = '[data-bs-toggle=\"modal\"]'\n\nconst Default = {\n backdrop: true,\n focus: true,\n keyboard: true\n}\n\nconst DefaultType = {\n backdrop: '(boolean|string)',\n focus: 'boolean',\n keyboard: 'boolean'\n}\n\n/**\n * Class definition\n */\n\nclass Modal extends BaseComponent {\n constructor(element, config) {\n super(element, config)\n\n this._dialog = SelectorEngine.findOne(SELECTOR_DIALOG, this._element)\n this._backdrop = this._initializeBackDrop()\n this._focustrap = this._initializeFocusTrap()\n this._isShown = false\n this._isTransitioning = false\n this._scrollBar = new ScrollBarHelper()\n\n this._addEventListeners()\n }\n\n // Getters\n static get Default() {\n return Default\n }\n\n static get DefaultType() {\n return DefaultType\n }\n\n static get NAME() {\n return NAME\n }\n\n // Public\n toggle(relatedTarget) {\n return this._isShown ? this.hide() : this.show(relatedTarget)\n }\n\n show(relatedTarget) {\n if (this._isShown || this._isTransitioning) {\n return\n }\n\n const showEvent = EventHandler.trigger(this._element, EVENT_SHOW, {\n relatedTarget\n })\n\n if (showEvent.defaultPrevented) {\n return\n }\n\n this._isShown = true\n this._isTransitioning = true\n\n this._scrollBar.hide()\n\n document.body.classList.add(CLASS_NAME_OPEN)\n\n this._adjustDialog()\n\n this._backdrop.show(() => this._showElement(relatedTarget))\n }\n\n hide() {\n if (!this._isShown || this._isTransitioning) {\n return\n }\n\n const hideEvent = EventHandler.trigger(this._element, EVENT_HIDE)\n\n if (hideEvent.defaultPrevented) {\n return\n }\n\n this._isShown = false\n this._isTransitioning = true\n this._focustrap.deactivate()\n\n this._element.classList.remove(CLASS_NAME_SHOW)\n\n this._queueCallback(() => this._hideModal(), this._element, this._isAnimated())\n }\n\n dispose() {\n EventHandler.off(window, EVENT_KEY)\n EventHandler.off(this._dialog, EVENT_KEY)\n\n this._backdrop.dispose()\n this._focustrap.deactivate()\n\n super.dispose()\n }\n\n handleUpdate() {\n this._adjustDialog()\n }\n\n // Private\n _initializeBackDrop() {\n return new Backdrop({\n isVisible: Boolean(this._config.backdrop), // 'static' option will be translated to true, and booleans will keep their value,\n isAnimated: this._isAnimated()\n })\n }\n\n _initializeFocusTrap() {\n return new FocusTrap({\n trapElement: this._element\n })\n }\n\n _showElement(relatedTarget) {\n // try to append dynamic modal\n if (!document.body.contains(this._element)) {\n document.body.append(this._element)\n }\n\n this._element.style.display = 'block'\n this._element.removeAttribute('aria-hidden')\n this._element.setAttribute('aria-modal', true)\n this._element.setAttribute('role', 'dialog')\n this._element.scrollTop = 0\n\n const modalBody = SelectorEngine.findOne(SELECTOR_MODAL_BODY, this._dialog)\n if (modalBody) {\n modalBody.scrollTop = 0\n }\n\n reflow(this._element)\n\n this._element.classList.add(CLASS_NAME_SHOW)\n\n const transitionComplete = () => {\n if (this._config.focus) {\n this._focustrap.activate()\n }\n\n this._isTransitioning = false\n EventHandler.trigger(this._element, EVENT_SHOWN, {\n relatedTarget\n })\n }\n\n this._queueCallback(transitionComplete, this._dialog, this._isAnimated())\n }\n\n _addEventListeners() {\n EventHandler.on(this._element, EVENT_KEYDOWN_DISMISS, event => {\n if (event.key !== ESCAPE_KEY) {\n return\n }\n\n if (this._config.keyboard) {\n this.hide()\n return\n }\n\n this._triggerBackdropTransition()\n })\n\n EventHandler.on(window, EVENT_RESIZE, () => {\n if (this._isShown && !this._isTransitioning) {\n this._adjustDialog()\n }\n })\n\n EventHandler.on(this._element, EVENT_MOUSEDOWN_DISMISS, event => {\n // a bad trick to segregate clicks that may start inside dialog but end outside, and avoid listen to scrollbar clicks\n EventHandler.one(this._element, EVENT_CLICK_DISMISS, event2 => {\n if (this._element !== event.target || this._element !== event2.target) {\n return\n }\n\n if (this._config.backdrop === 'static') {\n this._triggerBackdropTransition()\n return\n }\n\n if (this._config.backdrop) {\n this.hide()\n }\n })\n })\n }\n\n _hideModal() {\n this._element.style.display = 'none'\n this._element.setAttribute('aria-hidden', true)\n this._element.removeAttribute('aria-modal')\n this._element.removeAttribute('role')\n this._isTransitioning = false\n\n this._backdrop.hide(() => {\n document.body.classList.remove(CLASS_NAME_OPEN)\n this._resetAdjustments()\n this._scrollBar.reset()\n EventHandler.trigger(this._element, EVENT_HIDDEN)\n })\n }\n\n _isAnimated() {\n return this._element.classList.contains(CLASS_NAME_FADE)\n }\n\n _triggerBackdropTransition() {\n const hideEvent = EventHandler.trigger(this._element, EVENT_HIDE_PREVENTED)\n if (hideEvent.defaultPrevented) {\n return\n }\n\n const isModalOverflowing = this._element.scrollHeight > document.documentElement.clientHeight\n const initialOverflowY = this._element.style.overflowY\n // return if the following background transition hasn't yet completed\n if (initialOverflowY === 'hidden' || this._element.classList.contains(CLASS_NAME_STATIC)) {\n return\n }\n\n if (!isModalOverflowing) {\n this._element.style.overflowY = 'hidden'\n }\n\n this._element.classList.add(CLASS_NAME_STATIC)\n this._queueCallback(() => {\n this._element.classList.remove(CLASS_NAME_STATIC)\n this._queueCallback(() => {\n this._element.style.overflowY = initialOverflowY\n }, this._dialog)\n }, this._dialog)\n\n this._element.focus()\n }\n\n /**\n * The following methods are used to handle overflowing modals\n */\n\n _adjustDialog() {\n const isModalOverflowing = this._element.scrollHeight > document.documentElement.clientHeight\n const scrollbarWidth = this._scrollBar.getWidth()\n const isBodyOverflowing = scrollbarWidth > 0\n\n if (isBodyOverflowing && !isModalOverflowing) {\n const property = isRTL() ? 'paddingLeft' : 'paddingRight'\n this._element.style[property] = `${scrollbarWidth}px`\n }\n\n if (!isBodyOverflowing && isModalOverflowing) {\n const property = isRTL() ? 'paddingRight' : 'paddingLeft'\n this._element.style[property] = `${scrollbarWidth}px`\n }\n }\n\n _resetAdjustments() {\n this._element.style.paddingLeft = ''\n this._element.style.paddingRight = ''\n }\n\n // Static\n static jQueryInterface(config, relatedTarget) {\n return this.each(function () {\n const data = Modal.getOrCreateInstance(this, config)\n\n if (typeof config !== 'string') {\n return\n }\n\n if (typeof data[config] === 'undefined') {\n throw new TypeError(`No method named \"${config}\"`)\n }\n\n data[config](relatedTarget)\n })\n }\n}\n\n/**\n * Data API implementation\n */\n\nEventHandler.on(document, EVENT_CLICK_DATA_API, SELECTOR_DATA_TOGGLE, function (event) {\n const target = SelectorEngine.getElementFromSelector(this)\n\n if (['A', 'AREA'].includes(this.tagName)) {\n event.preventDefault()\n }\n\n EventHandler.one(target, EVENT_SHOW, showEvent => {\n if (showEvent.defaultPrevented) {\n // only register focus restorer if modal will actually get shown\n return\n }\n\n EventHandler.one(target, EVENT_HIDDEN, () => {\n if (isVisible(this)) {\n this.focus()\n }\n })\n })\n\n // avoid conflict when clicking modal toggler while another one is open\n const alreadyOpen = SelectorEngine.findOne(OPEN_SELECTOR)\n if (alreadyOpen) {\n Modal.getInstance(alreadyOpen).hide()\n }\n\n const data = Modal.getOrCreateInstance(target)\n\n data.toggle(this)\n})\n\nenableDismissTrigger(Modal)\n\n/**\n * jQuery\n */\n\ndefineJQueryPlugin(Modal)\n\nexport default Modal\n","/**\n * --------------------------------------------------------------------------\n * Bootstrap offcanvas.js\n * Licensed under MIT (https://github.com/twbs/bootstrap/blob/main/LICENSE)\n * --------------------------------------------------------------------------\n */\n\nimport BaseComponent from './base-component.js'\nimport EventHandler from './dom/event-handler.js'\nimport SelectorEngine from './dom/selector-engine.js'\nimport Backdrop from './util/backdrop.js'\nimport { enableDismissTrigger } from './util/component-functions.js'\nimport FocusTrap from './util/focustrap.js'\nimport {\n defineJQueryPlugin,\n isDisabled,\n isVisible\n} from './util/index.js'\nimport ScrollBarHelper from './util/scrollbar.js'\n\n/**\n * Constants\n */\n\nconst NAME = 'offcanvas'\nconst DATA_KEY = 'bs.offcanvas'\nconst EVENT_KEY = `.${DATA_KEY}`\nconst DATA_API_KEY = '.data-api'\nconst EVENT_LOAD_DATA_API = `load${EVENT_KEY}${DATA_API_KEY}`\nconst ESCAPE_KEY = 'Escape'\n\nconst CLASS_NAME_SHOW = 'show'\nconst CLASS_NAME_SHOWING = 'showing'\nconst CLASS_NAME_HIDING = 'hiding'\nconst CLASS_NAME_BACKDROP = 'offcanvas-backdrop'\nconst OPEN_SELECTOR = '.offcanvas.show'\n\nconst EVENT_SHOW = `show${EVENT_KEY}`\nconst EVENT_SHOWN = `shown${EVENT_KEY}`\nconst EVENT_HIDE = `hide${EVENT_KEY}`\nconst EVENT_HIDE_PREVENTED = `hidePrevented${EVENT_KEY}`\nconst EVENT_HIDDEN = `hidden${EVENT_KEY}`\nconst EVENT_RESIZE = `resize${EVENT_KEY}`\nconst EVENT_CLICK_DATA_API = `click${EVENT_KEY}${DATA_API_KEY}`\nconst EVENT_KEYDOWN_DISMISS = `keydown.dismiss${EVENT_KEY}`\n\nconst SELECTOR_DATA_TOGGLE = '[data-bs-toggle=\"offcanvas\"]'\n\nconst Default = {\n backdrop: true,\n keyboard: true,\n scroll: false\n}\n\nconst DefaultType = {\n backdrop: '(boolean|string)',\n keyboard: 'boolean',\n scroll: 'boolean'\n}\n\n/**\n * Class definition\n */\n\nclass Offcanvas extends BaseComponent {\n constructor(element, config) {\n super(element, config)\n\n this._isShown = false\n this._backdrop = this._initializeBackDrop()\n this._focustrap = this._initializeFocusTrap()\n this._addEventListeners()\n }\n\n // Getters\n static get Default() {\n return Default\n }\n\n static get DefaultType() {\n return DefaultType\n }\n\n static get NAME() {\n return NAME\n }\n\n // Public\n toggle(relatedTarget) {\n return this._isShown ? this.hide() : this.show(relatedTarget)\n }\n\n show(relatedTarget) {\n if (this._isShown) {\n return\n }\n\n const showEvent = EventHandler.trigger(this._element, EVENT_SHOW, { relatedTarget })\n\n if (showEvent.defaultPrevented) {\n return\n }\n\n this._isShown = true\n this._backdrop.show()\n\n if (!this._config.scroll) {\n new ScrollBarHelper().hide()\n }\n\n this._element.setAttribute('aria-modal', true)\n this._element.setAttribute('role', 'dialog')\n this._element.classList.add(CLASS_NAME_SHOWING)\n\n const completeCallBack = () => {\n if (!this._config.scroll || this._config.backdrop) {\n this._focustrap.activate()\n }\n\n this._element.classList.add(CLASS_NAME_SHOW)\n this._element.classList.remove(CLASS_NAME_SHOWING)\n EventHandler.trigger(this._element, EVENT_SHOWN, { relatedTarget })\n }\n\n this._queueCallback(completeCallBack, this._element, true)\n }\n\n hide() {\n if (!this._isShown) {\n return\n }\n\n const hideEvent = EventHandler.trigger(this._element, EVENT_HIDE)\n\n if (hideEvent.defaultPrevented) {\n return\n }\n\n this._focustrap.deactivate()\n this._element.blur()\n this._isShown = false\n this._element.classList.add(CLASS_NAME_HIDING)\n this._backdrop.hide()\n\n const completeCallback = () => {\n this._element.classList.remove(CLASS_NAME_SHOW, CLASS_NAME_HIDING)\n this._element.removeAttribute('aria-modal')\n this._element.removeAttribute('role')\n\n if (!this._config.scroll) {\n new ScrollBarHelper().reset()\n }\n\n EventHandler.trigger(this._element, EVENT_HIDDEN)\n }\n\n this._queueCallback(completeCallback, this._element, true)\n }\n\n dispose() {\n this._backdrop.dispose()\n this._focustrap.deactivate()\n super.dispose()\n }\n\n // Private\n _initializeBackDrop() {\n const clickCallback = () => {\n if (this._config.backdrop === 'static') {\n EventHandler.trigger(this._element, EVENT_HIDE_PREVENTED)\n return\n }\n\n this.hide()\n }\n\n // 'static' option will be translated to true, and booleans will keep their value\n const isVisible = Boolean(this._config.backdrop)\n\n return new Backdrop({\n className: CLASS_NAME_BACKDROP,\n isVisible,\n isAnimated: true,\n rootElement: this._element.parentNode,\n clickCallback: isVisible ? clickCallback : null\n })\n }\n\n _initializeFocusTrap() {\n return new FocusTrap({\n trapElement: this._element\n })\n }\n\n _addEventListeners() {\n EventHandler.on(this._element, EVENT_KEYDOWN_DISMISS, event => {\n if (event.key !== ESCAPE_KEY) {\n return\n }\n\n if (this._config.keyboard) {\n this.hide()\n return\n }\n\n EventHandler.trigger(this._element, EVENT_HIDE_PREVENTED)\n })\n }\n\n // Static\n static jQueryInterface(config) {\n return this.each(function () {\n const data = Offcanvas.getOrCreateInstance(this, config)\n\n if (typeof config !== 'string') {\n return\n }\n\n if (data[config] === undefined || config.startsWith('_') || config === 'constructor') {\n throw new TypeError(`No method named \"${config}\"`)\n }\n\n data[config](this)\n })\n }\n}\n\n/**\n * Data API implementation\n */\n\nEventHandler.on(document, EVENT_CLICK_DATA_API, SELECTOR_DATA_TOGGLE, function (event) {\n const target = SelectorEngine.getElementFromSelector(this)\n\n if (['A', 'AREA'].includes(this.tagName)) {\n event.preventDefault()\n }\n\n if (isDisabled(this)) {\n return\n }\n\n EventHandler.one(target, EVENT_HIDDEN, () => {\n // focus on trigger when it is closed\n if (isVisible(this)) {\n this.focus()\n }\n })\n\n // avoid conflict when clicking a toggler of an offcanvas, while another is open\n const alreadyOpen = SelectorEngine.findOne(OPEN_SELECTOR)\n if (alreadyOpen && alreadyOpen !== target) {\n Offcanvas.getInstance(alreadyOpen).hide()\n }\n\n const data = Offcanvas.getOrCreateInstance(target)\n data.toggle(this)\n})\n\nEventHandler.on(window, EVENT_LOAD_DATA_API, () => {\n for (const selector of SelectorEngine.find(OPEN_SELECTOR)) {\n Offcanvas.getOrCreateInstance(selector).show()\n }\n})\n\nEventHandler.on(window, EVENT_RESIZE, () => {\n for (const element of SelectorEngine.find('[aria-modal][class*=show][class*=offcanvas-]')) {\n if (getComputedStyle(element).position !== 'fixed') {\n Offcanvas.getOrCreateInstance(element).hide()\n }\n }\n})\n\nenableDismissTrigger(Offcanvas)\n\n/**\n * jQuery\n */\n\ndefineJQueryPlugin(Offcanvas)\n\nexport default Offcanvas\n","/**\n * --------------------------------------------------------------------------\n * Bootstrap util/sanitizer.js\n * Licensed under MIT (https://github.com/twbs/bootstrap/blob/main/LICENSE)\n * --------------------------------------------------------------------------\n */\n\n// js-docs-start allow-list\nconst ARIA_ATTRIBUTE_PATTERN = /^aria-[\\w-]*$/i\n\nexport const DefaultAllowlist = {\n // Global attributes allowed on any supplied element below.\n '*': ['class', 'dir', 'id', 'lang', 'role', ARIA_ATTRIBUTE_PATTERN],\n a: ['target', 'href', 'title', 'rel'],\n area: [],\n b: [],\n br: [],\n col: [],\n code: [],\n div: [],\n em: [],\n hr: [],\n h1: [],\n h2: [],\n h3: [],\n h4: [],\n h5: [],\n h6: [],\n i: [],\n img: ['src', 'srcset', 'alt', 'title', 'width', 'height'],\n li: [],\n ol: [],\n p: [],\n pre: [],\n s: [],\n small: [],\n span: [],\n sub: [],\n sup: [],\n strong: [],\n u: [],\n ul: []\n}\n// js-docs-end allow-list\n\nconst uriAttributes = new Set([\n 'background',\n 'cite',\n 'href',\n 'itemtype',\n 'longdesc',\n 'poster',\n 'src',\n 'xlink:href'\n])\n\n/**\n * A pattern that recognizes URLs that are safe wrt. XSS in URL navigation\n * contexts.\n *\n * Shout-out to Angular https://github.com/angular/angular/blob/15.2.8/packages/core/src/sanitization/url_sanitizer.ts#L38\n */\n// eslint-disable-next-line unicorn/better-regex\nconst SAFE_URL_PATTERN = /^(?!javascript:)(?:[a-z0-9+.-]+:|[^&:/?#]*(?:[/?#]|$))/i\n\nconst allowedAttribute = (attribute, allowedAttributeList) => {\n const attributeName = attribute.nodeName.toLowerCase()\n\n if (allowedAttributeList.includes(attributeName)) {\n if (uriAttributes.has(attributeName)) {\n return Boolean(SAFE_URL_PATTERN.test(attribute.nodeValue))\n }\n\n return true\n }\n\n // Check if a regular expression validates the attribute.\n return allowedAttributeList.filter(attributeRegex => attributeRegex instanceof RegExp)\n .some(regex => regex.test(attributeName))\n}\n\nexport function sanitizeHtml(unsafeHtml, allowList, sanitizeFunction) {\n if (!unsafeHtml.length) {\n return unsafeHtml\n }\n\n if (sanitizeFunction && typeof sanitizeFunction === 'function') {\n return sanitizeFunction(unsafeHtml)\n }\n\n const domParser = new window.DOMParser()\n const createdDocument = domParser.parseFromString(unsafeHtml, 'text/html')\n const elements = [].concat(...createdDocument.body.querySelectorAll('*'))\n\n for (const element of elements) {\n const elementName = element.nodeName.toLowerCase()\n\n if (!Object.keys(allowList).includes(elementName)) {\n element.remove()\n continue\n }\n\n const attributeList = [].concat(...element.attributes)\n const allowedAttributes = [].concat(allowList['*'] || [], allowList[elementName] || [])\n\n for (const attribute of attributeList) {\n if (!allowedAttribute(attribute, allowedAttributes)) {\n element.removeAttribute(attribute.nodeName)\n }\n }\n }\n\n return createdDocument.body.innerHTML\n}\n","/**\n * --------------------------------------------------------------------------\n * Bootstrap util/template-factory.js\n * Licensed under MIT (https://github.com/twbs/bootstrap/blob/main/LICENSE)\n * --------------------------------------------------------------------------\n */\n\nimport SelectorEngine from '../dom/selector-engine.js'\nimport Config from './config.js'\nimport { DefaultAllowlist, sanitizeHtml } from './sanitizer.js'\nimport { execute, getElement, isElement } from './index.js'\n\n/**\n * Constants\n */\n\nconst NAME = 'TemplateFactory'\n\nconst Default = {\n allowList: DefaultAllowlist,\n content: {}, // { selector : text , selector2 : text2 , }\n extraClass: '',\n html: false,\n sanitize: true,\n sanitizeFn: null,\n template: '
'\n}\n\nconst DefaultType = {\n allowList: 'object',\n content: 'object',\n extraClass: '(string|function)',\n html: 'boolean',\n sanitize: 'boolean',\n sanitizeFn: '(null|function)',\n template: 'string'\n}\n\nconst DefaultContentType = {\n entry: '(string|element|function|null)',\n selector: '(string|element)'\n}\n\n/**\n * Class definition\n */\n\nclass TemplateFactory extends Config {\n constructor(config) {\n super()\n this._config = this._getConfig(config)\n }\n\n // Getters\n static get Default() {\n return Default\n }\n\n static get DefaultType() {\n return DefaultType\n }\n\n static get NAME() {\n return NAME\n }\n\n // Public\n getContent() {\n return Object.values(this._config.content)\n .map(config => this._resolvePossibleFunction(config))\n .filter(Boolean)\n }\n\n hasContent() {\n return this.getContent().length > 0\n }\n\n changeContent(content) {\n this._checkContent(content)\n this._config.content = { ...this._config.content, ...content }\n return this\n }\n\n toHtml() {\n const templateWrapper = document.createElement('div')\n templateWrapper.innerHTML = this._maybeSanitize(this._config.template)\n\n for (const [selector, text] of Object.entries(this._config.content)) {\n this._setContent(templateWrapper, text, selector)\n }\n\n const template = templateWrapper.children[0]\n const extraClass = this._resolvePossibleFunction(this._config.extraClass)\n\n if (extraClass) {\n template.classList.add(...extraClass.split(' '))\n }\n\n return template\n }\n\n // Private\n _typeCheckConfig(config) {\n super._typeCheckConfig(config)\n this._checkContent(config.content)\n }\n\n _checkContent(arg) {\n for (const [selector, content] of Object.entries(arg)) {\n super._typeCheckConfig({ selector, entry: content }, DefaultContentType)\n }\n }\n\n _setContent(template, content, selector) {\n const templateElement = SelectorEngine.findOne(selector, template)\n\n if (!templateElement) {\n return\n }\n\n content = this._resolvePossibleFunction(content)\n\n if (!content) {\n templateElement.remove()\n return\n }\n\n if (isElement(content)) {\n this._putElementInTemplate(getElement(content), templateElement)\n return\n }\n\n if (this._config.html) {\n templateElement.innerHTML = this._maybeSanitize(content)\n return\n }\n\n templateElement.textContent = content\n }\n\n _maybeSanitize(arg) {\n return this._config.sanitize ? sanitizeHtml(arg, this._config.allowList, this._config.sanitizeFn) : arg\n }\n\n _resolvePossibleFunction(arg) {\n return execute(arg, [this])\n }\n\n _putElementInTemplate(element, templateElement) {\n if (this._config.html) {\n templateElement.innerHTML = ''\n templateElement.append(element)\n return\n }\n\n templateElement.textContent = element.textContent\n }\n}\n\nexport default TemplateFactory\n","/**\n * --------------------------------------------------------------------------\n * Bootstrap tooltip.js\n * Licensed under MIT (https://github.com/twbs/bootstrap/blob/main/LICENSE)\n * --------------------------------------------------------------------------\n */\n\nimport * as Popper from '@popperjs/core'\nimport BaseComponent from './base-component.js'\nimport EventHandler from './dom/event-handler.js'\nimport Manipulator from './dom/manipulator.js'\nimport { defineJQueryPlugin, execute, findShadowRoot, getElement, getUID, isRTL, noop } from './util/index.js'\nimport { DefaultAllowlist } from './util/sanitizer.js'\nimport TemplateFactory from './util/template-factory.js'\n\n/**\n * Constants\n */\n\nconst NAME = 'tooltip'\nconst DISALLOWED_ATTRIBUTES = new Set(['sanitize', 'allowList', 'sanitizeFn'])\n\nconst CLASS_NAME_FADE = 'fade'\nconst CLASS_NAME_MODAL = 'modal'\nconst CLASS_NAME_SHOW = 'show'\n\nconst SELECTOR_TOOLTIP_INNER = '.tooltip-inner'\nconst SELECTOR_MODAL = `.${CLASS_NAME_MODAL}`\n\nconst EVENT_MODAL_HIDE = 'hide.bs.modal'\n\nconst TRIGGER_HOVER = 'hover'\nconst TRIGGER_FOCUS = 'focus'\nconst TRIGGER_CLICK = 'click'\nconst TRIGGER_MANUAL = 'manual'\n\nconst EVENT_HIDE = 'hide'\nconst EVENT_HIDDEN = 'hidden'\nconst EVENT_SHOW = 'show'\nconst EVENT_SHOWN = 'shown'\nconst EVENT_INSERTED = 'inserted'\nconst EVENT_CLICK = 'click'\nconst EVENT_FOCUSIN = 'focusin'\nconst EVENT_FOCUSOUT = 'focusout'\nconst EVENT_MOUSEENTER = 'mouseenter'\nconst EVENT_MOUSELEAVE = 'mouseleave'\n\nconst AttachmentMap = {\n AUTO: 'auto',\n TOP: 'top',\n RIGHT: isRTL() ? 'left' : 'right',\n BOTTOM: 'bottom',\n LEFT: isRTL() ? 'right' : 'left'\n}\n\nconst Default = {\n allowList: DefaultAllowlist,\n animation: true,\n boundary: 'clippingParents',\n container: false,\n customClass: '',\n delay: 0,\n fallbackPlacements: ['top', 'right', 'bottom', 'left'],\n html: false,\n offset: [0, 6],\n placement: 'top',\n popperConfig: null,\n sanitize: true,\n sanitizeFn: null,\n selector: false,\n template: '
' +\n '
' +\n '
' +\n '
',\n title: '',\n trigger: 'hover focus'\n}\n\nconst DefaultType = {\n allowList: 'object',\n animation: 'boolean',\n boundary: '(string|element)',\n container: '(string|element|boolean)',\n customClass: '(string|function)',\n delay: '(number|object)',\n fallbackPlacements: 'array',\n html: 'boolean',\n offset: '(array|string|function)',\n placement: '(string|function)',\n popperConfig: '(null|object|function)',\n sanitize: 'boolean',\n sanitizeFn: '(null|function)',\n selector: '(string|boolean)',\n template: 'string',\n title: '(string|element|function)',\n trigger: 'string'\n}\n\n/**\n * Class definition\n */\n\nclass Tooltip extends BaseComponent {\n constructor(element, config) {\n if (typeof Popper === 'undefined') {\n throw new TypeError('Bootstrap\\'s tooltips require Popper (https://popper.js.org)')\n }\n\n super(element, config)\n\n // Private\n this._isEnabled = true\n this._timeout = 0\n this._isHovered = null\n this._activeTrigger = {}\n this._popper = null\n this._templateFactory = null\n this._newContent = null\n\n // Protected\n this.tip = null\n\n this._setListeners()\n\n if (!this._config.selector) {\n this._fixTitle()\n }\n }\n\n // Getters\n static get Default() {\n return Default\n }\n\n static get DefaultType() {\n return DefaultType\n }\n\n static get NAME() {\n return NAME\n }\n\n // Public\n enable() {\n this._isEnabled = true\n }\n\n disable() {\n this._isEnabled = false\n }\n\n toggleEnabled() {\n this._isEnabled = !this._isEnabled\n }\n\n toggle() {\n if (!this._isEnabled) {\n return\n }\n\n this._activeTrigger.click = !this._activeTrigger.click\n if (this._isShown()) {\n this._leave()\n return\n }\n\n this._enter()\n }\n\n dispose() {\n clearTimeout(this._timeout)\n\n EventHandler.off(this._element.closest(SELECTOR_MODAL), EVENT_MODAL_HIDE, this._hideModalHandler)\n\n if (this._element.getAttribute('data-bs-original-title')) {\n this._element.setAttribute('title', this._element.getAttribute('data-bs-original-title'))\n }\n\n this._disposePopper()\n super.dispose()\n }\n\n show() {\n if (this._element.style.display === 'none') {\n throw new Error('Please use show on visible elements')\n }\n\n if (!(this._isWithContent() && this._isEnabled)) {\n return\n }\n\n const showEvent = EventHandler.trigger(this._element, this.constructor.eventName(EVENT_SHOW))\n const shadowRoot = findShadowRoot(this._element)\n const isInTheDom = (shadowRoot || this._element.ownerDocument.documentElement).contains(this._element)\n\n if (showEvent.defaultPrevented || !isInTheDom) {\n return\n }\n\n // TODO: v6 remove this or make it optional\n this._disposePopper()\n\n const tip = this._getTipElement()\n\n this._element.setAttribute('aria-describedby', tip.getAttribute('id'))\n\n const { container } = this._config\n\n if (!this._element.ownerDocument.documentElement.contains(this.tip)) {\n container.append(tip)\n EventHandler.trigger(this._element, this.constructor.eventName(EVENT_INSERTED))\n }\n\n this._popper = this._createPopper(tip)\n\n tip.classList.add(CLASS_NAME_SHOW)\n\n // If this is a touch-enabled device we add extra\n // empty mouseover listeners to the body's immediate children;\n // only needed because of broken event delegation on iOS\n // https://www.quirksmode.org/blog/archives/2014/02/mouse_event_bub.html\n if ('ontouchstart' in document.documentElement) {\n for (const element of [].concat(...document.body.children)) {\n EventHandler.on(element, 'mouseover', noop)\n }\n }\n\n const complete = () => {\n EventHandler.trigger(this._element, this.constructor.eventName(EVENT_SHOWN))\n\n if (this._isHovered === false) {\n this._leave()\n }\n\n this._isHovered = false\n }\n\n this._queueCallback(complete, this.tip, this._isAnimated())\n }\n\n hide() {\n if (!this._isShown()) {\n return\n }\n\n const hideEvent = EventHandler.trigger(this._element, this.constructor.eventName(EVENT_HIDE))\n if (hideEvent.defaultPrevented) {\n return\n }\n\n const tip = this._getTipElement()\n tip.classList.remove(CLASS_NAME_SHOW)\n\n // If this is a touch-enabled device we remove the extra\n // empty mouseover listeners we added for iOS support\n if ('ontouchstart' in document.documentElement) {\n for (const element of [].concat(...document.body.children)) {\n EventHandler.off(element, 'mouseover', noop)\n }\n }\n\n this._activeTrigger[TRIGGER_CLICK] = false\n this._activeTrigger[TRIGGER_FOCUS] = false\n this._activeTrigger[TRIGGER_HOVER] = false\n this._isHovered = null // it is a trick to support manual triggering\n\n const complete = () => {\n if (this._isWithActiveTrigger()) {\n return\n }\n\n if (!this._isHovered) {\n this._disposePopper()\n }\n\n this._element.removeAttribute('aria-describedby')\n EventHandler.trigger(this._element, this.constructor.eventName(EVENT_HIDDEN))\n }\n\n this._queueCallback(complete, this.tip, this._isAnimated())\n }\n\n update() {\n if (this._popper) {\n this._popper.update()\n }\n }\n\n // Protected\n _isWithContent() {\n return Boolean(this._getTitle())\n }\n\n _getTipElement() {\n if (!this.tip) {\n this.tip = this._createTipElement(this._newContent || this._getContentForTemplate())\n }\n\n return this.tip\n }\n\n _createTipElement(content) {\n const tip = this._getTemplateFactory(content).toHtml()\n\n // TODO: remove this check in v6\n if (!tip) {\n return null\n }\n\n tip.classList.remove(CLASS_NAME_FADE, CLASS_NAME_SHOW)\n // TODO: v6 the following can be achieved with CSS only\n tip.classList.add(`bs-${this.constructor.NAME}-auto`)\n\n const tipId = getUID(this.constructor.NAME).toString()\n\n tip.setAttribute('id', tipId)\n\n if (this._isAnimated()) {\n tip.classList.add(CLASS_NAME_FADE)\n }\n\n return tip\n }\n\n setContent(content) {\n this._newContent = content\n if (this._isShown()) {\n this._disposePopper()\n this.show()\n }\n }\n\n _getTemplateFactory(content) {\n if (this._templateFactory) {\n this._templateFactory.changeContent(content)\n } else {\n this._templateFactory = new TemplateFactory({\n ...this._config,\n // the `content` var has to be after `this._config`\n // to override config.content in case of popover\n content,\n extraClass: this._resolvePossibleFunction(this._config.customClass)\n })\n }\n\n return this._templateFactory\n }\n\n _getContentForTemplate() {\n return {\n [SELECTOR_TOOLTIP_INNER]: this._getTitle()\n }\n }\n\n _getTitle() {\n return this._resolvePossibleFunction(this._config.title) || this._element.getAttribute('data-bs-original-title')\n }\n\n // Private\n _initializeOnDelegatedTarget(event) {\n return this.constructor.getOrCreateInstance(event.delegateTarget, this._getDelegateConfig())\n }\n\n _isAnimated() {\n return this._config.animation || (this.tip && this.tip.classList.contains(CLASS_NAME_FADE))\n }\n\n _isShown() {\n return this.tip && this.tip.classList.contains(CLASS_NAME_SHOW)\n }\n\n _createPopper(tip) {\n const placement = execute(this._config.placement, [this, tip, this._element])\n const attachment = AttachmentMap[placement.toUpperCase()]\n return Popper.createPopper(this._element, tip, this._getPopperConfig(attachment))\n }\n\n _getOffset() {\n const { offset } = this._config\n\n if (typeof offset === 'string') {\n return offset.split(',').map(value => Number.parseInt(value, 10))\n }\n\n if (typeof offset === 'function') {\n return popperData => offset(popperData, this._element)\n }\n\n return offset\n }\n\n _resolvePossibleFunction(arg) {\n return execute(arg, [this._element])\n }\n\n _getPopperConfig(attachment) {\n const defaultBsPopperConfig = {\n placement: attachment,\n modifiers: [\n {\n name: 'flip',\n options: {\n fallbackPlacements: this._config.fallbackPlacements\n }\n },\n {\n name: 'offset',\n options: {\n offset: this._getOffset()\n }\n },\n {\n name: 'preventOverflow',\n options: {\n boundary: this._config.boundary\n }\n },\n {\n name: 'arrow',\n options: {\n element: `.${this.constructor.NAME}-arrow`\n }\n },\n {\n name: 'preSetPlacement',\n enabled: true,\n phase: 'beforeMain',\n fn: data => {\n // Pre-set Popper's placement attribute in order to read the arrow sizes properly.\n // Otherwise, Popper mixes up the width and height dimensions since the initial arrow style is for top placement\n this._getTipElement().setAttribute('data-popper-placement', data.state.placement)\n }\n }\n ]\n }\n\n return {\n ...defaultBsPopperConfig,\n ...execute(this._config.popperConfig, [defaultBsPopperConfig])\n }\n }\n\n _setListeners() {\n const triggers = this._config.trigger.split(' ')\n\n for (const trigger of triggers) {\n if (trigger === 'click') {\n EventHandler.on(this._element, this.constructor.eventName(EVENT_CLICK), this._config.selector, event => {\n const context = this._initializeOnDelegatedTarget(event)\n context.toggle()\n })\n } else if (trigger !== TRIGGER_MANUAL) {\n const eventIn = trigger === TRIGGER_HOVER ?\n this.constructor.eventName(EVENT_MOUSEENTER) :\n this.constructor.eventName(EVENT_FOCUSIN)\n const eventOut = trigger === TRIGGER_HOVER ?\n this.constructor.eventName(EVENT_MOUSELEAVE) :\n this.constructor.eventName(EVENT_FOCUSOUT)\n\n EventHandler.on(this._element, eventIn, this._config.selector, event => {\n const context = this._initializeOnDelegatedTarget(event)\n context._activeTrigger[event.type === 'focusin' ? TRIGGER_FOCUS : TRIGGER_HOVER] = true\n context._enter()\n })\n EventHandler.on(this._element, eventOut, this._config.selector, event => {\n const context = this._initializeOnDelegatedTarget(event)\n context._activeTrigger[event.type === 'focusout' ? TRIGGER_FOCUS : TRIGGER_HOVER] =\n context._element.contains(event.relatedTarget)\n\n context._leave()\n })\n }\n }\n\n this._hideModalHandler = () => {\n if (this._element) {\n this.hide()\n }\n }\n\n EventHandler.on(this._element.closest(SELECTOR_MODAL), EVENT_MODAL_HIDE, this._hideModalHandler)\n }\n\n _fixTitle() {\n const title = this._element.getAttribute('title')\n\n if (!title) {\n return\n }\n\n if (!this._element.getAttribute('aria-label') && !this._element.textContent.trim()) {\n this._element.setAttribute('aria-label', title)\n }\n\n this._element.setAttribute('data-bs-original-title', title) // DO NOT USE IT. Is only for backwards compatibility\n this._element.removeAttribute('title')\n }\n\n _enter() {\n if (this._isShown() || this._isHovered) {\n this._isHovered = true\n return\n }\n\n this._isHovered = true\n\n this._setTimeout(() => {\n if (this._isHovered) {\n this.show()\n }\n }, this._config.delay.show)\n }\n\n _leave() {\n if (this._isWithActiveTrigger()) {\n return\n }\n\n this._isHovered = false\n\n this._setTimeout(() => {\n if (!this._isHovered) {\n this.hide()\n }\n }, this._config.delay.hide)\n }\n\n _setTimeout(handler, timeout) {\n clearTimeout(this._timeout)\n this._timeout = setTimeout(handler, timeout)\n }\n\n _isWithActiveTrigger() {\n return Object.values(this._activeTrigger).includes(true)\n }\n\n _getConfig(config) {\n const dataAttributes = Manipulator.getDataAttributes(this._element)\n\n for (const dataAttribute of Object.keys(dataAttributes)) {\n if (DISALLOWED_ATTRIBUTES.has(dataAttribute)) {\n delete dataAttributes[dataAttribute]\n }\n }\n\n config = {\n ...dataAttributes,\n ...(typeof config === 'object' && config ? config : {})\n }\n config = this._mergeConfigObj(config)\n config = this._configAfterMerge(config)\n this._typeCheckConfig(config)\n return config\n }\n\n _configAfterMerge(config) {\n config.container = config.container === false ? document.body : getElement(config.container)\n\n if (typeof config.delay === 'number') {\n config.delay = {\n show: config.delay,\n hide: config.delay\n }\n }\n\n if (typeof config.title === 'number') {\n config.title = config.title.toString()\n }\n\n if (typeof config.content === 'number') {\n config.content = config.content.toString()\n }\n\n return config\n }\n\n _getDelegateConfig() {\n const config = {}\n\n for (const [key, value] of Object.entries(this._config)) {\n if (this.constructor.Default[key] !== value) {\n config[key] = value\n }\n }\n\n config.selector = false\n config.trigger = 'manual'\n\n // In the future can be replaced with:\n // const keysWithDifferentValues = Object.entries(this._config).filter(entry => this.constructor.Default[entry[0]] !== this._config[entry[0]])\n // `Object.fromEntries(keysWithDifferentValues)`\n return config\n }\n\n _disposePopper() {\n if (this._popper) {\n this._popper.destroy()\n this._popper = null\n }\n\n if (this.tip) {\n this.tip.remove()\n this.tip = null\n }\n }\n\n // Static\n static jQueryInterface(config) {\n return this.each(function () {\n const data = Tooltip.getOrCreateInstance(this, config)\n\n if (typeof config !== 'string') {\n return\n }\n\n if (typeof data[config] === 'undefined') {\n throw new TypeError(`No method named \"${config}\"`)\n }\n\n data[config]()\n })\n }\n}\n\n/**\n * jQuery\n */\n\ndefineJQueryPlugin(Tooltip)\n\nexport default Tooltip\n","/**\n * --------------------------------------------------------------------------\n * Bootstrap popover.js\n * Licensed under MIT (https://github.com/twbs/bootstrap/blob/main/LICENSE)\n * --------------------------------------------------------------------------\n */\n\nimport Tooltip from './tooltip.js'\nimport { defineJQueryPlugin } from './util/index.js'\n\n/**\n * Constants\n */\n\nconst NAME = 'popover'\n\nconst SELECTOR_TITLE = '.popover-header'\nconst SELECTOR_CONTENT = '.popover-body'\n\nconst Default = {\n ...Tooltip.Default,\n content: '',\n offset: [0, 8],\n placement: 'right',\n template: '
' +\n '
' +\n '

' +\n '
' +\n '
',\n trigger: 'click'\n}\n\nconst DefaultType = {\n ...Tooltip.DefaultType,\n content: '(null|string|element|function)'\n}\n\n/**\n * Class definition\n */\n\nclass Popover extends Tooltip {\n // Getters\n static get Default() {\n return Default\n }\n\n static get DefaultType() {\n return DefaultType\n }\n\n static get NAME() {\n return NAME\n }\n\n // Overrides\n _isWithContent() {\n return this._getTitle() || this._getContent()\n }\n\n // Private\n _getContentForTemplate() {\n return {\n [SELECTOR_TITLE]: this._getTitle(),\n [SELECTOR_CONTENT]: this._getContent()\n }\n }\n\n _getContent() {\n return this._resolvePossibleFunction(this._config.content)\n }\n\n // Static\n static jQueryInterface(config) {\n return this.each(function () {\n const data = Popover.getOrCreateInstance(this, config)\n\n if (typeof config !== 'string') {\n return\n }\n\n if (typeof data[config] === 'undefined') {\n throw new TypeError(`No method named \"${config}\"`)\n }\n\n data[config]()\n })\n }\n}\n\n/**\n * jQuery\n */\n\ndefineJQueryPlugin(Popover)\n\nexport default Popover\n","/**\n * --------------------------------------------------------------------------\n * Bootstrap scrollspy.js\n * Licensed under MIT (https://github.com/twbs/bootstrap/blob/main/LICENSE)\n * --------------------------------------------------------------------------\n */\n\nimport BaseComponent from './base-component.js'\nimport EventHandler from './dom/event-handler.js'\nimport SelectorEngine from './dom/selector-engine.js'\nimport { defineJQueryPlugin, getElement, isDisabled, isVisible } from './util/index.js'\n\n/**\n * Constants\n */\n\nconst NAME = 'scrollspy'\nconst DATA_KEY = 'bs.scrollspy'\nconst EVENT_KEY = `.${DATA_KEY}`\nconst DATA_API_KEY = '.data-api'\n\nconst EVENT_ACTIVATE = `activate${EVENT_KEY}`\nconst EVENT_CLICK = `click${EVENT_KEY}`\nconst EVENT_LOAD_DATA_API = `load${EVENT_KEY}${DATA_API_KEY}`\n\nconst CLASS_NAME_DROPDOWN_ITEM = 'dropdown-item'\nconst CLASS_NAME_ACTIVE = 'active'\n\nconst SELECTOR_DATA_SPY = '[data-bs-spy=\"scroll\"]'\nconst SELECTOR_TARGET_LINKS = '[href]'\nconst SELECTOR_NAV_LIST_GROUP = '.nav, .list-group'\nconst SELECTOR_NAV_LINKS = '.nav-link'\nconst SELECTOR_NAV_ITEMS = '.nav-item'\nconst SELECTOR_LIST_ITEMS = '.list-group-item'\nconst SELECTOR_LINK_ITEMS = `${SELECTOR_NAV_LINKS}, ${SELECTOR_NAV_ITEMS} > ${SELECTOR_NAV_LINKS}, ${SELECTOR_LIST_ITEMS}`\nconst SELECTOR_DROPDOWN = '.dropdown'\nconst SELECTOR_DROPDOWN_TOGGLE = '.dropdown-toggle'\n\nconst Default = {\n offset: null, // TODO: v6 @deprecated, keep it for backwards compatibility reasons\n rootMargin: '0px 0px -25%',\n smoothScroll: false,\n target: null,\n threshold: [0.1, 0.5, 1]\n}\n\nconst DefaultType = {\n offset: '(number|null)', // TODO v6 @deprecated, keep it for backwards compatibility reasons\n rootMargin: 'string',\n smoothScroll: 'boolean',\n target: 'element',\n threshold: 'array'\n}\n\n/**\n * Class definition\n */\n\nclass ScrollSpy extends BaseComponent {\n constructor(element, config) {\n super(element, config)\n\n // this._element is the observablesContainer and config.target the menu links wrapper\n this._targetLinks = new Map()\n this._observableSections = new Map()\n this._rootElement = getComputedStyle(this._element).overflowY === 'visible' ? null : this._element\n this._activeTarget = null\n this._observer = null\n this._previousScrollData = {\n visibleEntryTop: 0,\n parentScrollTop: 0\n }\n this.refresh() // initialize\n }\n\n // Getters\n static get Default() {\n return Default\n }\n\n static get DefaultType() {\n return DefaultType\n }\n\n static get NAME() {\n return NAME\n }\n\n // Public\n refresh() {\n this._initializeTargetsAndObservables()\n this._maybeEnableSmoothScroll()\n\n if (this._observer) {\n this._observer.disconnect()\n } else {\n this._observer = this._getNewObserver()\n }\n\n for (const section of this._observableSections.values()) {\n this._observer.observe(section)\n }\n }\n\n dispose() {\n this._observer.disconnect()\n super.dispose()\n }\n\n // Private\n _configAfterMerge(config) {\n // TODO: on v6 target should be given explicitly & remove the {target: 'ss-target'} case\n config.target = getElement(config.target) || document.body\n\n // TODO: v6 Only for backwards compatibility reasons. Use rootMargin only\n config.rootMargin = config.offset ? `${config.offset}px 0px -30%` : config.rootMargin\n\n if (typeof config.threshold === 'string') {\n config.threshold = config.threshold.split(',').map(value => Number.parseFloat(value))\n }\n\n return config\n }\n\n _maybeEnableSmoothScroll() {\n if (!this._config.smoothScroll) {\n return\n }\n\n // unregister any previous listeners\n EventHandler.off(this._config.target, EVENT_CLICK)\n\n EventHandler.on(this._config.target, EVENT_CLICK, SELECTOR_TARGET_LINKS, event => {\n const observableSection = this._observableSections.get(event.target.hash)\n if (observableSection) {\n event.preventDefault()\n const root = this._rootElement || window\n const height = observableSection.offsetTop - this._element.offsetTop\n if (root.scrollTo) {\n root.scrollTo({ top: height, behavior: 'smooth' })\n return\n }\n\n // Chrome 60 doesn't support `scrollTo`\n root.scrollTop = height\n }\n })\n }\n\n _getNewObserver() {\n const options = {\n root: this._rootElement,\n threshold: this._config.threshold,\n rootMargin: this._config.rootMargin\n }\n\n return new IntersectionObserver(entries => this._observerCallback(entries), options)\n }\n\n // The logic of selection\n _observerCallback(entries) {\n const targetElement = entry => this._targetLinks.get(`#${entry.target.id}`)\n const activate = entry => {\n this._previousScrollData.visibleEntryTop = entry.target.offsetTop\n this._process(targetElement(entry))\n }\n\n const parentScrollTop = (this._rootElement || document.documentElement).scrollTop\n const userScrollsDown = parentScrollTop >= this._previousScrollData.parentScrollTop\n this._previousScrollData.parentScrollTop = parentScrollTop\n\n for (const entry of entries) {\n if (!entry.isIntersecting) {\n this._activeTarget = null\n this._clearActiveClass(targetElement(entry))\n\n continue\n }\n\n const entryIsLowerThanPrevious = entry.target.offsetTop >= this._previousScrollData.visibleEntryTop\n // if we are scrolling down, pick the bigger offsetTop\n if (userScrollsDown && entryIsLowerThanPrevious) {\n activate(entry)\n // if parent isn't scrolled, let's keep the first visible item, breaking the iteration\n if (!parentScrollTop) {\n return\n }\n\n continue\n }\n\n // if we are scrolling up, pick the smallest offsetTop\n if (!userScrollsDown && !entryIsLowerThanPrevious) {\n activate(entry)\n }\n }\n }\n\n _initializeTargetsAndObservables() {\n this._targetLinks = new Map()\n this._observableSections = new Map()\n\n const targetLinks = SelectorEngine.find(SELECTOR_TARGET_LINKS, this._config.target)\n\n for (const anchor of targetLinks) {\n // ensure that the anchor has an id and is not disabled\n if (!anchor.hash || isDisabled(anchor)) {\n continue\n }\n\n const observableSection = SelectorEngine.findOne(decodeURI(anchor.hash), this._element)\n\n // ensure that the observableSection exists & is visible\n if (isVisible(observableSection)) {\n this._targetLinks.set(decodeURI(anchor.hash), anchor)\n this._observableSections.set(anchor.hash, observableSection)\n }\n }\n }\n\n _process(target) {\n if (this._activeTarget === target) {\n return\n }\n\n this._clearActiveClass(this._config.target)\n this._activeTarget = target\n target.classList.add(CLASS_NAME_ACTIVE)\n this._activateParents(target)\n\n EventHandler.trigger(this._element, EVENT_ACTIVATE, { relatedTarget: target })\n }\n\n _activateParents(target) {\n // Activate dropdown parents\n if (target.classList.contains(CLASS_NAME_DROPDOWN_ITEM)) {\n SelectorEngine.findOne(SELECTOR_DROPDOWN_TOGGLE, target.closest(SELECTOR_DROPDOWN))\n .classList.add(CLASS_NAME_ACTIVE)\n return\n }\n\n for (const listGroup of SelectorEngine.parents(target, SELECTOR_NAV_LIST_GROUP)) {\n // Set triggered links parents as active\n // With both
    and
')},createChildNavList:function(e){var t=this.createNavList();return e.append(t),t},generateNavEl:function(e,t){var n=a('');n.attr("href","#"+e),n.text(t);var r=a("
  • ");return r.append(n),r},generateNavItem:function(e){var t=this.generateAnchor(e),n=a(e),r=n.data("toc-text")||n.text();return this.generateNavEl(t,r)},getTopLevel:function(e){for(var t=1;t<=6;t++){if(1 + + + + + + + + + + + + diff --git a/docs/deps/font-awesome-6.5.2/css/all.css b/docs/deps/font-awesome-6.5.2/css/all.css new file mode 100644 index 00000000..151dd57c --- /dev/null +++ b/docs/deps/font-awesome-6.5.2/css/all.css @@ -0,0 +1,8028 @@ +/*! + * Font Awesome Free 6.5.2 by @fontawesome - https://fontawesome.com + * License - https://fontawesome.com/license/free (Icons: CC BY 4.0, Fonts: SIL OFL 1.1, Code: MIT License) + * Copyright 2024 Fonticons, Inc. + */ +.fa { + font-family: var(--fa-style-family, "Font Awesome 6 Free"); + font-weight: var(--fa-style, 900); } + +.fa, +.fa-classic, +.fa-sharp, +.fas, +.fa-solid, +.far, +.fa-regular, +.fab, +.fa-brands { + -moz-osx-font-smoothing: grayscale; + -webkit-font-smoothing: antialiased; + display: var(--fa-display, inline-block); + font-style: normal; + font-variant: normal; + line-height: 1; + text-rendering: auto; } + +.fas, +.fa-classic, +.fa-solid, +.far, +.fa-regular { + font-family: 'Font Awesome 6 Free'; } + +.fab, +.fa-brands { + font-family: 'Font Awesome 6 Brands'; } + +.fa-1x { + font-size: 1em; } + +.fa-2x { + font-size: 2em; } + +.fa-3x { + font-size: 3em; } + +.fa-4x { + font-size: 4em; } + +.fa-5x { + font-size: 5em; } + +.fa-6x { + font-size: 6em; } + +.fa-7x { + font-size: 7em; } + +.fa-8x { + font-size: 8em; } + +.fa-9x { + font-size: 9em; } + +.fa-10x { + font-size: 10em; } + +.fa-2xs { + font-size: 0.625em; + line-height: 0.1em; + vertical-align: 0.225em; } + +.fa-xs { + font-size: 0.75em; + line-height: 0.08333em; + vertical-align: 0.125em; } + +.fa-sm { + font-size: 0.875em; + line-height: 0.07143em; + vertical-align: 0.05357em; } + +.fa-lg { + font-size: 1.25em; + line-height: 0.05em; + vertical-align: -0.075em; } + +.fa-xl { + font-size: 1.5em; + line-height: 0.04167em; + vertical-align: -0.125em; } + +.fa-2xl { + font-size: 2em; + line-height: 0.03125em; + vertical-align: -0.1875em; } + +.fa-fw { + text-align: center; + width: 1.25em; } + +.fa-ul { + list-style-type: none; + margin-left: var(--fa-li-margin, 2.5em); + padding-left: 0; } + .fa-ul > li { + position: relative; } + +.fa-li { + left: calc(var(--fa-li-width, 2em) * -1); + position: absolute; + text-align: center; + width: var(--fa-li-width, 2em); + line-height: inherit; } + +.fa-border { + border-color: var(--fa-border-color, #eee); + border-radius: var(--fa-border-radius, 0.1em); + border-style: var(--fa-border-style, solid); + border-width: var(--fa-border-width, 0.08em); + padding: var(--fa-border-padding, 0.2em 0.25em 0.15em); } + +.fa-pull-left { + float: left; + margin-right: var(--fa-pull-margin, 0.3em); } + +.fa-pull-right { + float: right; + margin-left: var(--fa-pull-margin, 0.3em); } + +.fa-beat { + -webkit-animation-name: fa-beat; + animation-name: fa-beat; + -webkit-animation-delay: var(--fa-animation-delay, 0s); + animation-delay: var(--fa-animation-delay, 0s); + -webkit-animation-direction: var(--fa-animation-direction, normal); + animation-direction: var(--fa-animation-direction, normal); + -webkit-animation-duration: var(--fa-animation-duration, 1s); + animation-duration: var(--fa-animation-duration, 1s); + -webkit-animation-iteration-count: var(--fa-animation-iteration-count, infinite); + animation-iteration-count: var(--fa-animation-iteration-count, infinite); + -webkit-animation-timing-function: var(--fa-animation-timing, ease-in-out); + animation-timing-function: var(--fa-animation-timing, ease-in-out); } + +.fa-bounce { + -webkit-animation-name: fa-bounce; + animation-name: fa-bounce; + -webkit-animation-delay: var(--fa-animation-delay, 0s); + animation-delay: var(--fa-animation-delay, 0s); + -webkit-animation-direction: var(--fa-animation-direction, normal); + animation-direction: var(--fa-animation-direction, normal); + -webkit-animation-duration: var(--fa-animation-duration, 1s); + animation-duration: var(--fa-animation-duration, 1s); + -webkit-animation-iteration-count: var(--fa-animation-iteration-count, infinite); + animation-iteration-count: var(--fa-animation-iteration-count, infinite); + -webkit-animation-timing-function: var(--fa-animation-timing, cubic-bezier(0.28, 0.84, 0.42, 1)); + animation-timing-function: var(--fa-animation-timing, cubic-bezier(0.28, 0.84, 0.42, 1)); } + +.fa-fade { + -webkit-animation-name: fa-fade; + animation-name: fa-fade; + -webkit-animation-delay: var(--fa-animation-delay, 0s); + animation-delay: var(--fa-animation-delay, 0s); + -webkit-animation-direction: var(--fa-animation-direction, normal); + animation-direction: var(--fa-animation-direction, normal); + -webkit-animation-duration: var(--fa-animation-duration, 1s); + animation-duration: var(--fa-animation-duration, 1s); + -webkit-animation-iteration-count: var(--fa-animation-iteration-count, infinite); + animation-iteration-count: var(--fa-animation-iteration-count, infinite); + -webkit-animation-timing-function: var(--fa-animation-timing, cubic-bezier(0.4, 0, 0.6, 1)); + animation-timing-function: var(--fa-animation-timing, cubic-bezier(0.4, 0, 0.6, 1)); } + +.fa-beat-fade { + -webkit-animation-name: fa-beat-fade; + animation-name: fa-beat-fade; + -webkit-animation-delay: var(--fa-animation-delay, 0s); + animation-delay: var(--fa-animation-delay, 0s); + -webkit-animation-direction: var(--fa-animation-direction, normal); + animation-direction: var(--fa-animation-direction, normal); + -webkit-animation-duration: var(--fa-animation-duration, 1s); + animation-duration: var(--fa-animation-duration, 1s); + -webkit-animation-iteration-count: var(--fa-animation-iteration-count, infinite); + animation-iteration-count: var(--fa-animation-iteration-count, infinite); + -webkit-animation-timing-function: var(--fa-animation-timing, cubic-bezier(0.4, 0, 0.6, 1)); + animation-timing-function: var(--fa-animation-timing, cubic-bezier(0.4, 0, 0.6, 1)); } + +.fa-flip { + -webkit-animation-name: fa-flip; + animation-name: fa-flip; + -webkit-animation-delay: var(--fa-animation-delay, 0s); + animation-delay: var(--fa-animation-delay, 0s); + -webkit-animation-direction: var(--fa-animation-direction, normal); + animation-direction: var(--fa-animation-direction, normal); + -webkit-animation-duration: var(--fa-animation-duration, 1s); + animation-duration: var(--fa-animation-duration, 1s); + -webkit-animation-iteration-count: var(--fa-animation-iteration-count, infinite); + animation-iteration-count: var(--fa-animation-iteration-count, infinite); + -webkit-animation-timing-function: var(--fa-animation-timing, ease-in-out); + animation-timing-function: var(--fa-animation-timing, ease-in-out); } + +.fa-shake { + -webkit-animation-name: fa-shake; + animation-name: fa-shake; + -webkit-animation-delay: var(--fa-animation-delay, 0s); + animation-delay: var(--fa-animation-delay, 0s); + -webkit-animation-direction: var(--fa-animation-direction, normal); + animation-direction: var(--fa-animation-direction, normal); + -webkit-animation-duration: var(--fa-animation-duration, 1s); + animation-duration: var(--fa-animation-duration, 1s); + -webkit-animation-iteration-count: var(--fa-animation-iteration-count, infinite); + animation-iteration-count: var(--fa-animation-iteration-count, infinite); + -webkit-animation-timing-function: var(--fa-animation-timing, linear); + animation-timing-function: var(--fa-animation-timing, linear); } + +.fa-spin { + -webkit-animation-name: fa-spin; + animation-name: fa-spin; + -webkit-animation-delay: var(--fa-animation-delay, 0s); + animation-delay: var(--fa-animation-delay, 0s); + -webkit-animation-direction: var(--fa-animation-direction, normal); + animation-direction: var(--fa-animation-direction, normal); + -webkit-animation-duration: var(--fa-animation-duration, 2s); + animation-duration: var(--fa-animation-duration, 2s); + -webkit-animation-iteration-count: var(--fa-animation-iteration-count, infinite); + animation-iteration-count: var(--fa-animation-iteration-count, infinite); + -webkit-animation-timing-function: var(--fa-animation-timing, linear); + animation-timing-function: var(--fa-animation-timing, linear); } + +.fa-spin-reverse { + --fa-animation-direction: reverse; } + +.fa-pulse, +.fa-spin-pulse { + -webkit-animation-name: fa-spin; + animation-name: fa-spin; + -webkit-animation-direction: var(--fa-animation-direction, normal); + animation-direction: var(--fa-animation-direction, normal); + -webkit-animation-duration: var(--fa-animation-duration, 1s); + animation-duration: var(--fa-animation-duration, 1s); + -webkit-animation-iteration-count: var(--fa-animation-iteration-count, infinite); + animation-iteration-count: var(--fa-animation-iteration-count, infinite); + -webkit-animation-timing-function: var(--fa-animation-timing, steps(8)); + animation-timing-function: var(--fa-animation-timing, steps(8)); } + +@media (prefers-reduced-motion: reduce) { + .fa-beat, + .fa-bounce, + .fa-fade, + .fa-beat-fade, + .fa-flip, + .fa-pulse, + .fa-shake, + .fa-spin, + .fa-spin-pulse { + -webkit-animation-delay: -1ms; + animation-delay: -1ms; + -webkit-animation-duration: 1ms; + animation-duration: 1ms; + -webkit-animation-iteration-count: 1; + animation-iteration-count: 1; + -webkit-transition-delay: 0s; + transition-delay: 0s; + -webkit-transition-duration: 0s; + transition-duration: 0s; } } + +@-webkit-keyframes fa-beat { + 0%, 90% { + -webkit-transform: scale(1); + transform: scale(1); } + 45% { + -webkit-transform: scale(var(--fa-beat-scale, 1.25)); + transform: scale(var(--fa-beat-scale, 1.25)); } } + +@keyframes fa-beat { + 0%, 90% { + -webkit-transform: scale(1); + transform: scale(1); } + 45% { + -webkit-transform: scale(var(--fa-beat-scale, 1.25)); + transform: scale(var(--fa-beat-scale, 1.25)); } } + +@-webkit-keyframes fa-bounce { + 0% { + -webkit-transform: scale(1, 1) translateY(0); + transform: scale(1, 1) translateY(0); } + 10% { + -webkit-transform: scale(var(--fa-bounce-start-scale-x, 1.1), var(--fa-bounce-start-scale-y, 0.9)) translateY(0); + transform: scale(var(--fa-bounce-start-scale-x, 1.1), var(--fa-bounce-start-scale-y, 0.9)) translateY(0); } + 30% { + -webkit-transform: scale(var(--fa-bounce-jump-scale-x, 0.9), var(--fa-bounce-jump-scale-y, 1.1)) translateY(var(--fa-bounce-height, -0.5em)); + transform: scale(var(--fa-bounce-jump-scale-x, 0.9), var(--fa-bounce-jump-scale-y, 1.1)) translateY(var(--fa-bounce-height, -0.5em)); } + 50% { + -webkit-transform: scale(var(--fa-bounce-land-scale-x, 1.05), var(--fa-bounce-land-scale-y, 0.95)) translateY(0); + transform: scale(var(--fa-bounce-land-scale-x, 1.05), var(--fa-bounce-land-scale-y, 0.95)) translateY(0); } + 57% { + -webkit-transform: scale(1, 1) translateY(var(--fa-bounce-rebound, -0.125em)); + transform: scale(1, 1) translateY(var(--fa-bounce-rebound, -0.125em)); } + 64% { + -webkit-transform: scale(1, 1) translateY(0); + transform: scale(1, 1) translateY(0); } + 100% { + -webkit-transform: scale(1, 1) translateY(0); + transform: scale(1, 1) translateY(0); } } + +@keyframes fa-bounce { + 0% { + -webkit-transform: scale(1, 1) translateY(0); + transform: scale(1, 1) translateY(0); } + 10% { + -webkit-transform: scale(var(--fa-bounce-start-scale-x, 1.1), var(--fa-bounce-start-scale-y, 0.9)) translateY(0); + transform: scale(var(--fa-bounce-start-scale-x, 1.1), var(--fa-bounce-start-scale-y, 0.9)) translateY(0); } + 30% { + -webkit-transform: scale(var(--fa-bounce-jump-scale-x, 0.9), var(--fa-bounce-jump-scale-y, 1.1)) translateY(var(--fa-bounce-height, -0.5em)); + transform: scale(var(--fa-bounce-jump-scale-x, 0.9), var(--fa-bounce-jump-scale-y, 1.1)) translateY(var(--fa-bounce-height, -0.5em)); } + 50% { + -webkit-transform: scale(var(--fa-bounce-land-scale-x, 1.05), var(--fa-bounce-land-scale-y, 0.95)) translateY(0); + transform: scale(var(--fa-bounce-land-scale-x, 1.05), var(--fa-bounce-land-scale-y, 0.95)) translateY(0); } + 57% { + -webkit-transform: scale(1, 1) translateY(var(--fa-bounce-rebound, -0.125em)); + transform: scale(1, 1) translateY(var(--fa-bounce-rebound, -0.125em)); } + 64% { + -webkit-transform: scale(1, 1) translateY(0); + transform: scale(1, 1) translateY(0); } + 100% { + -webkit-transform: scale(1, 1) translateY(0); + transform: scale(1, 1) translateY(0); } } + +@-webkit-keyframes fa-fade { + 50% { + opacity: var(--fa-fade-opacity, 0.4); } } + +@keyframes fa-fade { + 50% { + opacity: var(--fa-fade-opacity, 0.4); } } + +@-webkit-keyframes fa-beat-fade { + 0%, 100% { + opacity: var(--fa-beat-fade-opacity, 0.4); + -webkit-transform: scale(1); + transform: scale(1); } + 50% { + opacity: 1; + -webkit-transform: scale(var(--fa-beat-fade-scale, 1.125)); + transform: scale(var(--fa-beat-fade-scale, 1.125)); } } + +@keyframes fa-beat-fade { + 0%, 100% { + opacity: var(--fa-beat-fade-opacity, 0.4); + -webkit-transform: scale(1); + transform: scale(1); } + 50% { + opacity: 1; + -webkit-transform: scale(var(--fa-beat-fade-scale, 1.125)); + transform: scale(var(--fa-beat-fade-scale, 1.125)); } } + +@-webkit-keyframes fa-flip { + 50% { + -webkit-transform: rotate3d(var(--fa-flip-x, 0), var(--fa-flip-y, 1), var(--fa-flip-z, 0), var(--fa-flip-angle, -180deg)); + transform: rotate3d(var(--fa-flip-x, 0), var(--fa-flip-y, 1), var(--fa-flip-z, 0), var(--fa-flip-angle, -180deg)); } } + +@keyframes fa-flip { + 50% { + -webkit-transform: rotate3d(var(--fa-flip-x, 0), var(--fa-flip-y, 1), var(--fa-flip-z, 0), var(--fa-flip-angle, -180deg)); + transform: rotate3d(var(--fa-flip-x, 0), var(--fa-flip-y, 1), var(--fa-flip-z, 0), var(--fa-flip-angle, -180deg)); } } + +@-webkit-keyframes fa-shake { + 0% { + -webkit-transform: rotate(-15deg); + transform: rotate(-15deg); } + 4% { + -webkit-transform: rotate(15deg); + transform: rotate(15deg); } + 8%, 24% { + -webkit-transform: rotate(-18deg); + transform: rotate(-18deg); } + 12%, 28% { + -webkit-transform: rotate(18deg); + transform: rotate(18deg); } + 16% { + -webkit-transform: rotate(-22deg); + transform: rotate(-22deg); } + 20% { + -webkit-transform: rotate(22deg); + transform: rotate(22deg); } + 32% { + -webkit-transform: rotate(-12deg); + transform: rotate(-12deg); } + 36% { + -webkit-transform: rotate(12deg); + transform: rotate(12deg); } + 40%, 100% { + -webkit-transform: rotate(0deg); + transform: rotate(0deg); } } + +@keyframes fa-shake { + 0% { + -webkit-transform: rotate(-15deg); + transform: rotate(-15deg); } + 4% { + -webkit-transform: rotate(15deg); + transform: rotate(15deg); } + 8%, 24% { + -webkit-transform: rotate(-18deg); + transform: rotate(-18deg); } + 12%, 28% { + -webkit-transform: rotate(18deg); + transform: rotate(18deg); } + 16% { + -webkit-transform: rotate(-22deg); + transform: rotate(-22deg); } + 20% { + -webkit-transform: rotate(22deg); + transform: rotate(22deg); } + 32% { + -webkit-transform: rotate(-12deg); + transform: rotate(-12deg); } + 36% { + -webkit-transform: rotate(12deg); + transform: rotate(12deg); } + 40%, 100% { + -webkit-transform: rotate(0deg); + transform: rotate(0deg); } } + +@-webkit-keyframes fa-spin { + 0% { + -webkit-transform: rotate(0deg); + transform: rotate(0deg); } + 100% { + -webkit-transform: rotate(360deg); + transform: rotate(360deg); } } + +@keyframes fa-spin { + 0% { + -webkit-transform: rotate(0deg); + transform: rotate(0deg); } + 100% { + -webkit-transform: rotate(360deg); + transform: rotate(360deg); } } + +.fa-rotate-90 { + -webkit-transform: rotate(90deg); + transform: rotate(90deg); } + +.fa-rotate-180 { + -webkit-transform: rotate(180deg); + transform: rotate(180deg); } + +.fa-rotate-270 { + -webkit-transform: rotate(270deg); + transform: rotate(270deg); } + +.fa-flip-horizontal { + -webkit-transform: scale(-1, 1); + transform: scale(-1, 1); } + +.fa-flip-vertical { + -webkit-transform: scale(1, -1); + transform: scale(1, -1); } + +.fa-flip-both, +.fa-flip-horizontal.fa-flip-vertical { + -webkit-transform: scale(-1, -1); + transform: scale(-1, -1); } + +.fa-rotate-by { + -webkit-transform: rotate(var(--fa-rotate-angle, 0)); + transform: rotate(var(--fa-rotate-angle, 0)); } + +.fa-stack { + display: inline-block; + height: 2em; + line-height: 2em; + position: relative; + vertical-align: middle; + width: 2.5em; } + +.fa-stack-1x, +.fa-stack-2x { + left: 0; + position: absolute; + text-align: center; + width: 100%; + z-index: var(--fa-stack-z-index, auto); } + +.fa-stack-1x { + line-height: inherit; } + +.fa-stack-2x { + font-size: 2em; } + +.fa-inverse { + color: var(--fa-inverse, #fff); } + +/* Font Awesome uses the Unicode Private Use Area (PUA) to ensure screen +readers do not read off random characters that represent icons */ + +.fa-0::before { + content: "\30"; } + +.fa-1::before { + content: "\31"; } + +.fa-2::before { + content: "\32"; } + +.fa-3::before { + content: "\33"; } + +.fa-4::before { + content: "\34"; } + +.fa-5::before { + content: "\35"; } + +.fa-6::before { + content: "\36"; } + +.fa-7::before { + content: "\37"; } + +.fa-8::before { + content: "\38"; } + +.fa-9::before { + content: "\39"; } + +.fa-fill-drip::before { + content: "\f576"; } + +.fa-arrows-to-circle::before { + content: "\e4bd"; } + +.fa-circle-chevron-right::before { + content: "\f138"; } + +.fa-chevron-circle-right::before { + content: "\f138"; } + +.fa-at::before { + content: "\40"; } + +.fa-trash-can::before { + content: "\f2ed"; } + +.fa-trash-alt::before { + content: "\f2ed"; } + +.fa-text-height::before { + content: "\f034"; } + +.fa-user-xmark::before { + content: "\f235"; } + +.fa-user-times::before { + content: "\f235"; } + +.fa-stethoscope::before { + content: "\f0f1"; } + +.fa-message::before { + content: "\f27a"; } + +.fa-comment-alt::before { + content: "\f27a"; } + +.fa-info::before { + content: "\f129"; } + +.fa-down-left-and-up-right-to-center::before { + content: "\f422"; } + +.fa-compress-alt::before { + content: "\f422"; } + +.fa-explosion::before { + content: "\e4e9"; } + +.fa-file-lines::before { + content: "\f15c"; } + +.fa-file-alt::before { + content: "\f15c"; } + +.fa-file-text::before { + content: "\f15c"; } + +.fa-wave-square::before { + content: "\f83e"; } + +.fa-ring::before { + content: "\f70b"; } + +.fa-building-un::before { + content: "\e4d9"; } + +.fa-dice-three::before { + content: "\f527"; } + +.fa-calendar-days::before { + content: "\f073"; } + +.fa-calendar-alt::before { + content: "\f073"; } + +.fa-anchor-circle-check::before { + content: "\e4aa"; } + +.fa-building-circle-arrow-right::before { + content: "\e4d1"; } + +.fa-volleyball::before { + content: "\f45f"; } + +.fa-volleyball-ball::before { + content: "\f45f"; } + +.fa-arrows-up-to-line::before { + content: "\e4c2"; } + +.fa-sort-down::before { + content: "\f0dd"; } + +.fa-sort-desc::before { + content: "\f0dd"; } + +.fa-circle-minus::before { + content: "\f056"; } + +.fa-minus-circle::before { + content: "\f056"; } + +.fa-door-open::before { + content: "\f52b"; } + +.fa-right-from-bracket::before { + content: "\f2f5"; } + +.fa-sign-out-alt::before { + content: "\f2f5"; } + +.fa-atom::before { + content: "\f5d2"; } + +.fa-soap::before { + content: "\e06e"; } + +.fa-icons::before { + content: "\f86d"; } + +.fa-heart-music-camera-bolt::before { + content: "\f86d"; } + +.fa-microphone-lines-slash::before { + content: "\f539"; } + +.fa-microphone-alt-slash::before { + content: "\f539"; } + +.fa-bridge-circle-check::before { + content: "\e4c9"; } + +.fa-pump-medical::before { + content: "\e06a"; } + +.fa-fingerprint::before { + content: "\f577"; } + +.fa-hand-point-right::before { + content: "\f0a4"; } + +.fa-magnifying-glass-location::before { + content: "\f689"; } + +.fa-search-location::before { + content: "\f689"; } + +.fa-forward-step::before { + content: "\f051"; } + +.fa-step-forward::before { + content: "\f051"; } + +.fa-face-smile-beam::before { + content: "\f5b8"; } + +.fa-smile-beam::before { + content: "\f5b8"; } + +.fa-flag-checkered::before { + content: "\f11e"; } + +.fa-football::before { + content: "\f44e"; } + +.fa-football-ball::before { + content: "\f44e"; } + +.fa-school-circle-exclamation::before { + content: "\e56c"; } + +.fa-crop::before { + content: "\f125"; } + +.fa-angles-down::before { + content: "\f103"; } + +.fa-angle-double-down::before { + content: "\f103"; } + +.fa-users-rectangle::before { + content: "\e594"; } + +.fa-people-roof::before { + content: "\e537"; } + +.fa-people-line::before { + content: "\e534"; } + +.fa-beer-mug-empty::before { + content: "\f0fc"; } + +.fa-beer::before { + content: "\f0fc"; } + +.fa-diagram-predecessor::before { + content: "\e477"; } + +.fa-arrow-up-long::before { + content: "\f176"; } + +.fa-long-arrow-up::before { + content: "\f176"; } + +.fa-fire-flame-simple::before { + content: "\f46a"; } + +.fa-burn::before { + content: "\f46a"; } + +.fa-person::before { + content: "\f183"; } + +.fa-male::before { + content: "\f183"; } + +.fa-laptop::before { + content: "\f109"; } + +.fa-file-csv::before { + content: "\f6dd"; } + +.fa-menorah::before { + content: "\f676"; } + +.fa-truck-plane::before { + content: "\e58f"; } + +.fa-record-vinyl::before { + content: "\f8d9"; } + +.fa-face-grin-stars::before { + content: "\f587"; } + +.fa-grin-stars::before { + content: "\f587"; } + +.fa-bong::before { + content: "\f55c"; } + +.fa-spaghetti-monster-flying::before { + content: "\f67b"; } + +.fa-pastafarianism::before { + content: "\f67b"; } + +.fa-arrow-down-up-across-line::before { + content: "\e4af"; } + +.fa-spoon::before { + content: "\f2e5"; } + +.fa-utensil-spoon::before { + content: "\f2e5"; } + +.fa-jar-wheat::before { + content: "\e517"; } + +.fa-envelopes-bulk::before { + content: "\f674"; } + +.fa-mail-bulk::before { + content: "\f674"; } + +.fa-file-circle-exclamation::before { + content: "\e4eb"; } + +.fa-circle-h::before { + content: "\f47e"; } + +.fa-hospital-symbol::before { + content: "\f47e"; } + +.fa-pager::before { + content: "\f815"; } + +.fa-address-book::before { + content: "\f2b9"; } + +.fa-contact-book::before { + content: "\f2b9"; } + +.fa-strikethrough::before { + content: "\f0cc"; } + +.fa-k::before { + content: "\4b"; } + +.fa-landmark-flag::before { + content: "\e51c"; } + +.fa-pencil::before { + content: "\f303"; } + +.fa-pencil-alt::before { + content: "\f303"; } + +.fa-backward::before { + content: "\f04a"; } + +.fa-caret-right::before { + content: "\f0da"; } + +.fa-comments::before { + content: "\f086"; } + +.fa-paste::before { + content: "\f0ea"; } + +.fa-file-clipboard::before { + content: "\f0ea"; } + +.fa-code-pull-request::before { + content: "\e13c"; } + +.fa-clipboard-list::before { + content: "\f46d"; } + +.fa-truck-ramp-box::before { + content: "\f4de"; } + +.fa-truck-loading::before { + content: "\f4de"; } + +.fa-user-check::before { + content: "\f4fc"; } + +.fa-vial-virus::before { + content: "\e597"; } + +.fa-sheet-plastic::before { + content: "\e571"; } + +.fa-blog::before { + content: "\f781"; } + +.fa-user-ninja::before { + content: "\f504"; } + +.fa-person-arrow-up-from-line::before { + content: "\e539"; } + +.fa-scroll-torah::before { + content: "\f6a0"; } + +.fa-torah::before { + content: "\f6a0"; } + +.fa-broom-ball::before { + content: "\f458"; } + +.fa-quidditch::before { + content: "\f458"; } + +.fa-quidditch-broom-ball::before { + content: "\f458"; } + +.fa-toggle-off::before { + content: "\f204"; } + +.fa-box-archive::before { + content: "\f187"; } + +.fa-archive::before { + content: "\f187"; } + +.fa-person-drowning::before { + content: "\e545"; } + +.fa-arrow-down-9-1::before { + content: "\f886"; } + +.fa-sort-numeric-desc::before { + content: "\f886"; } + +.fa-sort-numeric-down-alt::before { + content: "\f886"; } + +.fa-face-grin-tongue-squint::before { + content: "\f58a"; } + +.fa-grin-tongue-squint::before { + content: "\f58a"; } + +.fa-spray-can::before { + content: "\f5bd"; } + +.fa-truck-monster::before { + content: "\f63b"; } + +.fa-w::before { + content: "\57"; } + +.fa-earth-africa::before { + content: "\f57c"; } + +.fa-globe-africa::before { + content: "\f57c"; } + +.fa-rainbow::before { + content: "\f75b"; } + +.fa-circle-notch::before { + content: "\f1ce"; } + +.fa-tablet-screen-button::before { + content: "\f3fa"; } + +.fa-tablet-alt::before { + content: "\f3fa"; } + +.fa-paw::before { + content: "\f1b0"; } + +.fa-cloud::before { + content: "\f0c2"; } + +.fa-trowel-bricks::before { + content: "\e58a"; } + +.fa-face-flushed::before { + content: "\f579"; } + +.fa-flushed::before { + content: "\f579"; } + +.fa-hospital-user::before { + content: "\f80d"; } + +.fa-tent-arrow-left-right::before { + content: "\e57f"; } + +.fa-gavel::before { + content: "\f0e3"; } + +.fa-legal::before { + content: "\f0e3"; } + +.fa-binoculars::before { + content: "\f1e5"; } + +.fa-microphone-slash::before { + content: "\f131"; } + +.fa-box-tissue::before { + content: "\e05b"; } + +.fa-motorcycle::before { + content: "\f21c"; } + +.fa-bell-concierge::before { + content: "\f562"; } + +.fa-concierge-bell::before { + content: "\f562"; } + +.fa-pen-ruler::before { + content: "\f5ae"; } + +.fa-pencil-ruler::before { + content: "\f5ae"; } + +.fa-people-arrows::before { + content: "\e068"; } + +.fa-people-arrows-left-right::before { + content: "\e068"; } + +.fa-mars-and-venus-burst::before { + content: "\e523"; } + +.fa-square-caret-right::before { + content: "\f152"; } + +.fa-caret-square-right::before { + content: "\f152"; } + +.fa-scissors::before { + content: "\f0c4"; } + +.fa-cut::before { + content: "\f0c4"; } + +.fa-sun-plant-wilt::before { + content: "\e57a"; } + +.fa-toilets-portable::before { + content: "\e584"; } + +.fa-hockey-puck::before { + content: "\f453"; } + +.fa-table::before { + content: "\f0ce"; } + +.fa-magnifying-glass-arrow-right::before { + content: "\e521"; } + +.fa-tachograph-digital::before { + content: "\f566"; } + +.fa-digital-tachograph::before { + content: "\f566"; } + +.fa-users-slash::before { + content: "\e073"; } + +.fa-clover::before { + content: "\e139"; } + +.fa-reply::before { + content: "\f3e5"; } + +.fa-mail-reply::before { + content: "\f3e5"; } + +.fa-star-and-crescent::before { + content: "\f699"; } + +.fa-house-fire::before { + content: "\e50c"; } + +.fa-square-minus::before { + content: "\f146"; } + +.fa-minus-square::before { + content: "\f146"; } + +.fa-helicopter::before { + content: "\f533"; } + +.fa-compass::before { + content: "\f14e"; } + +.fa-square-caret-down::before { + content: "\f150"; } + +.fa-caret-square-down::before { + content: "\f150"; } + +.fa-file-circle-question::before { + content: "\e4ef"; } + +.fa-laptop-code::before { + content: "\f5fc"; } + +.fa-swatchbook::before { + content: "\f5c3"; } + +.fa-prescription-bottle::before { + content: "\f485"; } + +.fa-bars::before { + content: "\f0c9"; } + +.fa-navicon::before { + content: "\f0c9"; } + +.fa-people-group::before { + content: "\e533"; } + +.fa-hourglass-end::before { + content: "\f253"; } + +.fa-hourglass-3::before { + content: "\f253"; } + +.fa-heart-crack::before { + content: "\f7a9"; } + +.fa-heart-broken::before { + content: "\f7a9"; } + +.fa-square-up-right::before { + content: "\f360"; } + +.fa-external-link-square-alt::before { + content: "\f360"; } + +.fa-face-kiss-beam::before { + content: "\f597"; } + +.fa-kiss-beam::before { + content: "\f597"; } + +.fa-film::before { + content: "\f008"; } + +.fa-ruler-horizontal::before { + content: "\f547"; } + +.fa-people-robbery::before { + content: "\e536"; } + +.fa-lightbulb::before { + content: "\f0eb"; } + +.fa-caret-left::before { + content: "\f0d9"; } + +.fa-circle-exclamation::before { + content: "\f06a"; } + +.fa-exclamation-circle::before { + content: "\f06a"; } + +.fa-school-circle-xmark::before { + content: "\e56d"; } + +.fa-arrow-right-from-bracket::before { + content: "\f08b"; } + +.fa-sign-out::before { + content: "\f08b"; } + +.fa-circle-chevron-down::before { + content: "\f13a"; } + +.fa-chevron-circle-down::before { + content: "\f13a"; } + +.fa-unlock-keyhole::before { + content: "\f13e"; } + +.fa-unlock-alt::before { + content: "\f13e"; } + +.fa-cloud-showers-heavy::before { + content: "\f740"; } + +.fa-headphones-simple::before { + content: "\f58f"; } + +.fa-headphones-alt::before { + content: "\f58f"; } + +.fa-sitemap::before { + content: "\f0e8"; } + +.fa-circle-dollar-to-slot::before { + content: "\f4b9"; } + +.fa-donate::before { + content: "\f4b9"; } + +.fa-memory::before { + content: "\f538"; } + +.fa-road-spikes::before { + content: "\e568"; } + +.fa-fire-burner::before { + content: "\e4f1"; } + +.fa-flag::before { + content: "\f024"; } + +.fa-hanukiah::before { + content: "\f6e6"; } + +.fa-feather::before { + content: "\f52d"; } + +.fa-volume-low::before { + content: "\f027"; } + +.fa-volume-down::before { + content: "\f027"; } + +.fa-comment-slash::before { + content: "\f4b3"; } + +.fa-cloud-sun-rain::before { + content: "\f743"; } + +.fa-compress::before { + content: "\f066"; } + +.fa-wheat-awn::before { + content: "\e2cd"; } + +.fa-wheat-alt::before { + content: "\e2cd"; } + +.fa-ankh::before { + content: "\f644"; } + +.fa-hands-holding-child::before { + content: "\e4fa"; } + +.fa-asterisk::before { + content: "\2a"; } + +.fa-square-check::before { + content: "\f14a"; } + +.fa-check-square::before { + content: "\f14a"; } + +.fa-peseta-sign::before { + content: "\e221"; } + +.fa-heading::before { + content: "\f1dc"; } + +.fa-header::before { + content: "\f1dc"; } + +.fa-ghost::before { + content: "\f6e2"; } + +.fa-list::before { + content: "\f03a"; } + +.fa-list-squares::before { + content: "\f03a"; } + +.fa-square-phone-flip::before { + content: "\f87b"; } + +.fa-phone-square-alt::before { + content: "\f87b"; } + +.fa-cart-plus::before { + content: "\f217"; } + +.fa-gamepad::before { + content: "\f11b"; } + +.fa-circle-dot::before { + content: "\f192"; } + +.fa-dot-circle::before { + content: "\f192"; } + +.fa-face-dizzy::before { + content: "\f567"; } + +.fa-dizzy::before { + content: "\f567"; } + +.fa-egg::before { + content: "\f7fb"; } + +.fa-house-medical-circle-xmark::before { + content: "\e513"; } + +.fa-campground::before { + content: "\f6bb"; } + +.fa-folder-plus::before { + content: "\f65e"; } + +.fa-futbol::before { + content: "\f1e3"; } + +.fa-futbol-ball::before { + content: "\f1e3"; } + +.fa-soccer-ball::before { + content: "\f1e3"; } + +.fa-paintbrush::before { + content: "\f1fc"; } + +.fa-paint-brush::before { + content: "\f1fc"; } + +.fa-lock::before { + content: "\f023"; } + +.fa-gas-pump::before { + content: "\f52f"; } + +.fa-hot-tub-person::before { + content: "\f593"; } + +.fa-hot-tub::before { + content: "\f593"; } + +.fa-map-location::before { + content: "\f59f"; } + +.fa-map-marked::before { + content: "\f59f"; } + +.fa-house-flood-water::before { + content: "\e50e"; } + +.fa-tree::before { + content: "\f1bb"; } + +.fa-bridge-lock::before { + content: "\e4cc"; } + +.fa-sack-dollar::before { + content: "\f81d"; } + +.fa-pen-to-square::before { + content: "\f044"; } + +.fa-edit::before { + content: "\f044"; } + +.fa-car-side::before { + content: "\f5e4"; } + +.fa-share-nodes::before { + content: "\f1e0"; } + +.fa-share-alt::before { + content: "\f1e0"; } + +.fa-heart-circle-minus::before { + content: "\e4ff"; } + +.fa-hourglass-half::before { + content: "\f252"; } + +.fa-hourglass-2::before { + content: "\f252"; } + +.fa-microscope::before { + content: "\f610"; } + +.fa-sink::before { + content: "\e06d"; } + +.fa-bag-shopping::before { + content: "\f290"; } + +.fa-shopping-bag::before { + content: "\f290"; } + +.fa-arrow-down-z-a::before { + content: "\f881"; } + +.fa-sort-alpha-desc::before { + content: "\f881"; } + +.fa-sort-alpha-down-alt::before { + content: "\f881"; } + +.fa-mitten::before { + content: "\f7b5"; } + +.fa-person-rays::before { + content: "\e54d"; } + +.fa-users::before { + content: "\f0c0"; } + +.fa-eye-slash::before { + content: "\f070"; } + +.fa-flask-vial::before { + content: "\e4f3"; } + +.fa-hand::before { + content: "\f256"; } + +.fa-hand-paper::before { + content: "\f256"; } + +.fa-om::before { + content: "\f679"; } + +.fa-worm::before { + content: "\e599"; } + +.fa-house-circle-xmark::before { + content: "\e50b"; } + +.fa-plug::before { + content: "\f1e6"; } + +.fa-chevron-up::before { + content: "\f077"; } + +.fa-hand-spock::before { + content: "\f259"; } + +.fa-stopwatch::before { + content: "\f2f2"; } + +.fa-face-kiss::before { + content: "\f596"; } + +.fa-kiss::before { + content: "\f596"; } + +.fa-bridge-circle-xmark::before { + content: "\e4cb"; } + +.fa-face-grin-tongue::before { + content: "\f589"; } + +.fa-grin-tongue::before { + content: "\f589"; } + +.fa-chess-bishop::before { + content: "\f43a"; } + +.fa-face-grin-wink::before { + content: "\f58c"; } + +.fa-grin-wink::before { + content: "\f58c"; } + +.fa-ear-deaf::before { + content: "\f2a4"; } + +.fa-deaf::before { + content: "\f2a4"; } + +.fa-deafness::before { + content: "\f2a4"; } + +.fa-hard-of-hearing::before { + content: "\f2a4"; } + +.fa-road-circle-check::before { + content: "\e564"; } + +.fa-dice-five::before { + content: "\f523"; } + +.fa-square-rss::before { + content: "\f143"; } + +.fa-rss-square::before { + content: "\f143"; } + +.fa-land-mine-on::before { + content: "\e51b"; } + +.fa-i-cursor::before { + content: "\f246"; } + +.fa-stamp::before { + content: "\f5bf"; } + +.fa-stairs::before { + content: "\e289"; } + +.fa-i::before { + content: "\49"; } + +.fa-hryvnia-sign::before { + content: "\f6f2"; } + +.fa-hryvnia::before { + content: "\f6f2"; } + +.fa-pills::before { + content: "\f484"; } + +.fa-face-grin-wide::before { + content: "\f581"; } + +.fa-grin-alt::before { + content: "\f581"; } + +.fa-tooth::before { + content: "\f5c9"; } + +.fa-v::before { + content: "\56"; } + +.fa-bangladeshi-taka-sign::before { + content: "\e2e6"; } + +.fa-bicycle::before { + content: "\f206"; } + +.fa-staff-snake::before { + content: "\e579"; } + +.fa-rod-asclepius::before { + content: "\e579"; } + +.fa-rod-snake::before { + content: "\e579"; } + +.fa-staff-aesculapius::before { + content: "\e579"; } + +.fa-head-side-cough-slash::before { + content: "\e062"; } + +.fa-truck-medical::before { + content: "\f0f9"; } + +.fa-ambulance::before { + content: "\f0f9"; } + +.fa-wheat-awn-circle-exclamation::before { + content: "\e598"; } + +.fa-snowman::before { + content: "\f7d0"; } + +.fa-mortar-pestle::before { + content: "\f5a7"; } + +.fa-road-barrier::before { + content: "\e562"; } + +.fa-school::before { + content: "\f549"; } + +.fa-igloo::before { + content: "\f7ae"; } + +.fa-joint::before { + content: "\f595"; } + +.fa-angle-right::before { + content: "\f105"; } + +.fa-horse::before { + content: "\f6f0"; } + +.fa-q::before { + content: "\51"; } + +.fa-g::before { + content: "\47"; } + +.fa-notes-medical::before { + content: "\f481"; } + +.fa-temperature-half::before { + content: "\f2c9"; } + +.fa-temperature-2::before { + content: "\f2c9"; } + +.fa-thermometer-2::before { + content: "\f2c9"; } + +.fa-thermometer-half::before { + content: "\f2c9"; } + +.fa-dong-sign::before { + content: "\e169"; } + +.fa-capsules::before { + content: "\f46b"; } + +.fa-poo-storm::before { + content: "\f75a"; } + +.fa-poo-bolt::before { + content: "\f75a"; } + +.fa-face-frown-open::before { + content: "\f57a"; } + +.fa-frown-open::before { + content: "\f57a"; } + +.fa-hand-point-up::before { + content: "\f0a6"; } + +.fa-money-bill::before { + content: "\f0d6"; } + +.fa-bookmark::before { + content: "\f02e"; } + +.fa-align-justify::before { + content: "\f039"; } + +.fa-umbrella-beach::before { + content: "\f5ca"; } + +.fa-helmet-un::before { + content: "\e503"; } + +.fa-bullseye::before { + content: "\f140"; } + +.fa-bacon::before { + content: "\f7e5"; } + +.fa-hand-point-down::before { + content: "\f0a7"; } + +.fa-arrow-up-from-bracket::before { + content: "\e09a"; } + +.fa-folder::before { + content: "\f07b"; } + +.fa-folder-blank::before { + content: "\f07b"; } + +.fa-file-waveform::before { + content: "\f478"; } + +.fa-file-medical-alt::before { + content: "\f478"; } + +.fa-radiation::before { + content: "\f7b9"; } + +.fa-chart-simple::before { + content: "\e473"; } + +.fa-mars-stroke::before { + content: "\f229"; } + +.fa-vial::before { + content: "\f492"; } + +.fa-gauge::before { + content: "\f624"; } + +.fa-dashboard::before { + content: "\f624"; } + +.fa-gauge-med::before { + content: "\f624"; } + +.fa-tachometer-alt-average::before { + content: "\f624"; } + +.fa-wand-magic-sparkles::before { + content: "\e2ca"; } + +.fa-magic-wand-sparkles::before { + content: "\e2ca"; } + +.fa-e::before { + content: "\45"; } + +.fa-pen-clip::before { + content: "\f305"; } + +.fa-pen-alt::before { + content: "\f305"; } + +.fa-bridge-circle-exclamation::before { + content: "\e4ca"; } + +.fa-user::before { + content: "\f007"; } + +.fa-school-circle-check::before { + content: "\e56b"; } + +.fa-dumpster::before { + content: "\f793"; } + +.fa-van-shuttle::before { + content: "\f5b6"; } + +.fa-shuttle-van::before { + content: "\f5b6"; } + +.fa-building-user::before { + content: "\e4da"; } + +.fa-square-caret-left::before { + content: "\f191"; } + +.fa-caret-square-left::before { + content: "\f191"; } + +.fa-highlighter::before { + content: "\f591"; } + +.fa-key::before { + content: "\f084"; } + +.fa-bullhorn::before { + content: "\f0a1"; } + +.fa-globe::before { + content: "\f0ac"; } + +.fa-synagogue::before { + content: "\f69b"; } + +.fa-person-half-dress::before { + content: "\e548"; } + +.fa-road-bridge::before { + content: "\e563"; } + +.fa-location-arrow::before { + content: "\f124"; } + +.fa-c::before { + content: "\43"; } + +.fa-tablet-button::before { + content: "\f10a"; } + +.fa-building-lock::before { + content: "\e4d6"; } + +.fa-pizza-slice::before { + content: "\f818"; } + +.fa-money-bill-wave::before { + content: "\f53a"; } + +.fa-chart-area::before { + content: "\f1fe"; } + +.fa-area-chart::before { + content: "\f1fe"; } + +.fa-house-flag::before { + content: "\e50d"; } + +.fa-person-circle-minus::before { + content: "\e540"; } + +.fa-ban::before { + content: "\f05e"; } + +.fa-cancel::before { + content: "\f05e"; } + +.fa-camera-rotate::before { + content: "\e0d8"; } + +.fa-spray-can-sparkles::before { + content: "\f5d0"; } + +.fa-air-freshener::before { + content: "\f5d0"; } + +.fa-star::before { + content: "\f005"; } + +.fa-repeat::before { + content: "\f363"; } + +.fa-cross::before { + content: "\f654"; } + +.fa-box::before { + content: "\f466"; } + +.fa-venus-mars::before { + content: "\f228"; } + +.fa-arrow-pointer::before { + content: "\f245"; } + +.fa-mouse-pointer::before { + content: "\f245"; } + +.fa-maximize::before { + content: "\f31e"; } + +.fa-expand-arrows-alt::before { + content: "\f31e"; } + +.fa-charging-station::before { + content: "\f5e7"; } + +.fa-shapes::before { + content: "\f61f"; } + +.fa-triangle-circle-square::before { + content: "\f61f"; } + +.fa-shuffle::before { + content: "\f074"; } + +.fa-random::before { + content: "\f074"; } + +.fa-person-running::before { + content: "\f70c"; } + +.fa-running::before { + content: "\f70c"; } + +.fa-mobile-retro::before { + content: "\e527"; } + +.fa-grip-lines-vertical::before { + content: "\f7a5"; } + +.fa-spider::before { + content: "\f717"; } + +.fa-hands-bound::before { + content: "\e4f9"; } + +.fa-file-invoice-dollar::before { + content: "\f571"; } + +.fa-plane-circle-exclamation::before { + content: "\e556"; } + +.fa-x-ray::before { + content: "\f497"; } + +.fa-spell-check::before { + content: "\f891"; } + +.fa-slash::before { + content: "\f715"; } + +.fa-computer-mouse::before { + content: "\f8cc"; } + +.fa-mouse::before { + content: "\f8cc"; } + +.fa-arrow-right-to-bracket::before { + content: "\f090"; } + +.fa-sign-in::before { + content: "\f090"; } + +.fa-shop-slash::before { + content: "\e070"; } + +.fa-store-alt-slash::before { + content: "\e070"; } + +.fa-server::before { + content: "\f233"; } + +.fa-virus-covid-slash::before { + content: "\e4a9"; } + +.fa-shop-lock::before { + content: "\e4a5"; } + +.fa-hourglass-start::before { + content: "\f251"; } + +.fa-hourglass-1::before { + content: "\f251"; } + +.fa-blender-phone::before { + content: "\f6b6"; } + +.fa-building-wheat::before { + content: "\e4db"; } + +.fa-person-breastfeeding::before { + content: "\e53a"; } + +.fa-right-to-bracket::before { + content: "\f2f6"; } + +.fa-sign-in-alt::before { + content: "\f2f6"; } + +.fa-venus::before { + content: "\f221"; } + +.fa-passport::before { + content: "\f5ab"; } + +.fa-heart-pulse::before { + content: "\f21e"; } + +.fa-heartbeat::before { + content: "\f21e"; } + +.fa-people-carry-box::before { + content: "\f4ce"; } + +.fa-people-carry::before { + content: "\f4ce"; } + +.fa-temperature-high::before { + content: "\f769"; } + +.fa-microchip::before { + content: "\f2db"; } + +.fa-crown::before { + content: "\f521"; } + +.fa-weight-hanging::before { + content: "\f5cd"; } + +.fa-xmarks-lines::before { + content: "\e59a"; } + +.fa-file-prescription::before { + content: "\f572"; } + +.fa-weight-scale::before { + content: "\f496"; } + +.fa-weight::before { + content: "\f496"; } + +.fa-user-group::before { + content: "\f500"; } + +.fa-user-friends::before { + content: "\f500"; } + +.fa-arrow-up-a-z::before { + content: "\f15e"; } + +.fa-sort-alpha-up::before { + content: "\f15e"; } + +.fa-chess-knight::before { + content: "\f441"; } + +.fa-face-laugh-squint::before { + content: "\f59b"; } + +.fa-laugh-squint::before { + content: "\f59b"; } + +.fa-wheelchair::before { + content: "\f193"; } + +.fa-circle-arrow-up::before { + content: "\f0aa"; } + +.fa-arrow-circle-up::before { + content: "\f0aa"; } + +.fa-toggle-on::before { + content: "\f205"; } + +.fa-person-walking::before { + content: "\f554"; } + +.fa-walking::before { + content: "\f554"; } + +.fa-l::before { + content: "\4c"; } + +.fa-fire::before { + content: "\f06d"; } + +.fa-bed-pulse::before { + content: "\f487"; } + +.fa-procedures::before { + content: "\f487"; } + +.fa-shuttle-space::before { + content: "\f197"; } + +.fa-space-shuttle::before { + content: "\f197"; } + +.fa-face-laugh::before { + content: "\f599"; } + +.fa-laugh::before { + content: "\f599"; } + +.fa-folder-open::before { + content: "\f07c"; } + +.fa-heart-circle-plus::before { + content: "\e500"; } + +.fa-code-fork::before { + content: "\e13b"; } + +.fa-city::before { + content: "\f64f"; } + +.fa-microphone-lines::before { + content: "\f3c9"; } + +.fa-microphone-alt::before { + content: "\f3c9"; } + +.fa-pepper-hot::before { + content: "\f816"; } + +.fa-unlock::before { + content: "\f09c"; } + +.fa-colon-sign::before { + content: "\e140"; } + +.fa-headset::before { + content: "\f590"; } + +.fa-store-slash::before { + content: "\e071"; } + +.fa-road-circle-xmark::before { + content: "\e566"; } + +.fa-user-minus::before { + content: "\f503"; } + +.fa-mars-stroke-up::before { + content: "\f22a"; } + +.fa-mars-stroke-v::before { + content: "\f22a"; } + +.fa-champagne-glasses::before { + content: "\f79f"; } + +.fa-glass-cheers::before { + content: "\f79f"; } + +.fa-clipboard::before { + content: "\f328"; } + +.fa-house-circle-exclamation::before { + content: "\e50a"; } + +.fa-file-arrow-up::before { + content: "\f574"; } + +.fa-file-upload::before { + content: "\f574"; } + +.fa-wifi::before { + content: "\f1eb"; } + +.fa-wifi-3::before { + content: "\f1eb"; } + +.fa-wifi-strong::before { + content: "\f1eb"; } + +.fa-bath::before { + content: "\f2cd"; } + +.fa-bathtub::before { + content: "\f2cd"; } + +.fa-underline::before { + content: "\f0cd"; } + +.fa-user-pen::before { + content: "\f4ff"; } + +.fa-user-edit::before { + content: "\f4ff"; } + +.fa-signature::before { + content: "\f5b7"; } + +.fa-stroopwafel::before { + content: "\f551"; } + +.fa-bold::before { + content: "\f032"; } + +.fa-anchor-lock::before { + content: "\e4ad"; } + +.fa-building-ngo::before { + content: "\e4d7"; } + +.fa-manat-sign::before { + content: "\e1d5"; } + +.fa-not-equal::before { + content: "\f53e"; } + +.fa-border-top-left::before { + content: "\f853"; } + +.fa-border-style::before { + content: "\f853"; } + +.fa-map-location-dot::before { + content: "\f5a0"; } + +.fa-map-marked-alt::before { + content: "\f5a0"; } + +.fa-jedi::before { + content: "\f669"; } + +.fa-square-poll-vertical::before { + content: "\f681"; } + +.fa-poll::before { + content: "\f681"; } + +.fa-mug-hot::before { + content: "\f7b6"; } + +.fa-car-battery::before { + content: "\f5df"; } + +.fa-battery-car::before { + content: "\f5df"; } + +.fa-gift::before { + content: "\f06b"; } + +.fa-dice-two::before { + content: "\f528"; } + +.fa-chess-queen::before { + content: "\f445"; } + +.fa-glasses::before { + content: "\f530"; } + +.fa-chess-board::before { + content: "\f43c"; } + +.fa-building-circle-check::before { + content: "\e4d2"; } + +.fa-person-chalkboard::before { + content: "\e53d"; } + +.fa-mars-stroke-right::before { + content: "\f22b"; } + +.fa-mars-stroke-h::before { + content: "\f22b"; } + +.fa-hand-back-fist::before { + content: "\f255"; } + +.fa-hand-rock::before { + content: "\f255"; } + +.fa-square-caret-up::before { + content: "\f151"; } + +.fa-caret-square-up::before { + content: "\f151"; } + +.fa-cloud-showers-water::before { + content: "\e4e4"; } + +.fa-chart-bar::before { + content: "\f080"; } + +.fa-bar-chart::before { + content: "\f080"; } + +.fa-hands-bubbles::before { + content: "\e05e"; } + +.fa-hands-wash::before { + content: "\e05e"; } + +.fa-less-than-equal::before { + content: "\f537"; } + +.fa-train::before { + content: "\f238"; } + +.fa-eye-low-vision::before { + content: "\f2a8"; } + +.fa-low-vision::before { + content: "\f2a8"; } + +.fa-crow::before { + content: "\f520"; } + +.fa-sailboat::before { + content: "\e445"; } + +.fa-window-restore::before { + content: "\f2d2"; } + +.fa-square-plus::before { + content: "\f0fe"; } + +.fa-plus-square::before { + content: "\f0fe"; } + +.fa-torii-gate::before { + content: "\f6a1"; } + +.fa-frog::before { + content: "\f52e"; } + +.fa-bucket::before { + content: "\e4cf"; } + +.fa-image::before { + content: "\f03e"; } + +.fa-microphone::before { + content: "\f130"; } + +.fa-cow::before { + content: "\f6c8"; } + +.fa-caret-up::before { + content: "\f0d8"; } + +.fa-screwdriver::before { + content: "\f54a"; } + +.fa-folder-closed::before { + content: "\e185"; } + +.fa-house-tsunami::before { + content: "\e515"; } + +.fa-square-nfi::before { + content: "\e576"; } + +.fa-arrow-up-from-ground-water::before { + content: "\e4b5"; } + +.fa-martini-glass::before { + content: "\f57b"; } + +.fa-glass-martini-alt::before { + content: "\f57b"; } + +.fa-rotate-left::before { + content: "\f2ea"; } + +.fa-rotate-back::before { + content: "\f2ea"; } + +.fa-rotate-backward::before { + content: "\f2ea"; } + +.fa-undo-alt::before { + content: "\f2ea"; } + +.fa-table-columns::before { + content: "\f0db"; } + +.fa-columns::before { + content: "\f0db"; } + +.fa-lemon::before { + content: "\f094"; } + +.fa-head-side-mask::before { + content: "\e063"; } + +.fa-handshake::before { + content: "\f2b5"; } + +.fa-gem::before { + content: "\f3a5"; } + +.fa-dolly::before { + content: "\f472"; } + +.fa-dolly-box::before { + content: "\f472"; } + +.fa-smoking::before { + content: "\f48d"; } + +.fa-minimize::before { + content: "\f78c"; } + +.fa-compress-arrows-alt::before { + content: "\f78c"; } + +.fa-monument::before { + content: "\f5a6"; } + +.fa-snowplow::before { + content: "\f7d2"; } + +.fa-angles-right::before { + content: "\f101"; } + +.fa-angle-double-right::before { + content: "\f101"; } + +.fa-cannabis::before { + content: "\f55f"; } + +.fa-circle-play::before { + content: "\f144"; } + +.fa-play-circle::before { + content: "\f144"; } + +.fa-tablets::before { + content: "\f490"; } + +.fa-ethernet::before { + content: "\f796"; } + +.fa-euro-sign::before { + content: "\f153"; } + +.fa-eur::before { + content: "\f153"; } + +.fa-euro::before { + content: "\f153"; } + +.fa-chair::before { + content: "\f6c0"; } + +.fa-circle-check::before { + content: "\f058"; } + +.fa-check-circle::before { + content: "\f058"; } + +.fa-circle-stop::before { + content: "\f28d"; } + +.fa-stop-circle::before { + content: "\f28d"; } + +.fa-compass-drafting::before { + content: "\f568"; } + +.fa-drafting-compass::before { + content: "\f568"; } + +.fa-plate-wheat::before { + content: "\e55a"; } + +.fa-icicles::before { + content: "\f7ad"; } + +.fa-person-shelter::before { + content: "\e54f"; } + +.fa-neuter::before { + content: "\f22c"; } + +.fa-id-badge::before { + content: "\f2c1"; } + +.fa-marker::before { + content: "\f5a1"; } + +.fa-face-laugh-beam::before { + content: "\f59a"; } + +.fa-laugh-beam::before { + content: "\f59a"; } + +.fa-helicopter-symbol::before { + content: "\e502"; } + +.fa-universal-access::before { + content: "\f29a"; } + +.fa-circle-chevron-up::before { + content: "\f139"; } + +.fa-chevron-circle-up::before { + content: "\f139"; } + +.fa-lari-sign::before { + content: "\e1c8"; } + +.fa-volcano::before { + content: "\f770"; } + +.fa-person-walking-dashed-line-arrow-right::before { + content: "\e553"; } + +.fa-sterling-sign::before { + content: "\f154"; } + +.fa-gbp::before { + content: "\f154"; } + +.fa-pound-sign::before { + content: "\f154"; } + +.fa-viruses::before { + content: "\e076"; } + +.fa-square-person-confined::before { + content: "\e577"; } + +.fa-user-tie::before { + content: "\f508"; } + +.fa-arrow-down-long::before { + content: "\f175"; } + +.fa-long-arrow-down::before { + content: "\f175"; } + +.fa-tent-arrow-down-to-line::before { + content: "\e57e"; } + +.fa-certificate::before { + content: "\f0a3"; } + +.fa-reply-all::before { + content: "\f122"; } + +.fa-mail-reply-all::before { + content: "\f122"; } + +.fa-suitcase::before { + content: "\f0f2"; } + +.fa-person-skating::before { + content: "\f7c5"; } + +.fa-skating::before { + content: "\f7c5"; } + +.fa-filter-circle-dollar::before { + content: "\f662"; } + +.fa-funnel-dollar::before { + content: "\f662"; } + +.fa-camera-retro::before { + content: "\f083"; } + +.fa-circle-arrow-down::before { + content: "\f0ab"; } + +.fa-arrow-circle-down::before { + content: "\f0ab"; } + +.fa-file-import::before { + content: "\f56f"; } + +.fa-arrow-right-to-file::before { + content: "\f56f"; } + +.fa-square-arrow-up-right::before { + content: "\f14c"; } + +.fa-external-link-square::before { + content: "\f14c"; } + +.fa-box-open::before { + content: "\f49e"; } + +.fa-scroll::before { + content: "\f70e"; } + +.fa-spa::before { + content: "\f5bb"; } + +.fa-location-pin-lock::before { + content: "\e51f"; } + +.fa-pause::before { + content: "\f04c"; } + +.fa-hill-avalanche::before { + content: "\e507"; } + +.fa-temperature-empty::before { + content: "\f2cb"; } + +.fa-temperature-0::before { + content: "\f2cb"; } + +.fa-thermometer-0::before { + content: "\f2cb"; } + +.fa-thermometer-empty::before { + content: "\f2cb"; } + +.fa-bomb::before { + content: "\f1e2"; } + +.fa-registered::before { + content: "\f25d"; } + +.fa-address-card::before { + content: "\f2bb"; } + +.fa-contact-card::before { + content: "\f2bb"; } + +.fa-vcard::before { + content: "\f2bb"; } + +.fa-scale-unbalanced-flip::before { + content: "\f516"; } + +.fa-balance-scale-right::before { + content: "\f516"; } + +.fa-subscript::before { + content: "\f12c"; } + +.fa-diamond-turn-right::before { + content: "\f5eb"; } + +.fa-directions::before { + content: "\f5eb"; } + +.fa-burst::before { + content: "\e4dc"; } + +.fa-house-laptop::before { + content: "\e066"; } + +.fa-laptop-house::before { + content: "\e066"; } + +.fa-face-tired::before { + content: "\f5c8"; } + +.fa-tired::before { + content: "\f5c8"; } + +.fa-money-bills::before { + content: "\e1f3"; } + +.fa-smog::before { + content: "\f75f"; } + +.fa-crutch::before { + content: "\f7f7"; } + +.fa-cloud-arrow-up::before { + content: "\f0ee"; } + +.fa-cloud-upload::before { + content: "\f0ee"; } + +.fa-cloud-upload-alt::before { + content: "\f0ee"; } + +.fa-palette::before { + content: "\f53f"; } + +.fa-arrows-turn-right::before { + content: "\e4c0"; } + +.fa-vest::before { + content: "\e085"; } + +.fa-ferry::before { + content: "\e4ea"; } + +.fa-arrows-down-to-people::before { + content: "\e4b9"; } + +.fa-seedling::before { + content: "\f4d8"; } + +.fa-sprout::before { + content: "\f4d8"; } + +.fa-left-right::before { + content: "\f337"; } + +.fa-arrows-alt-h::before { + content: "\f337"; } + +.fa-boxes-packing::before { + content: "\e4c7"; } + +.fa-circle-arrow-left::before { + content: "\f0a8"; } + +.fa-arrow-circle-left::before { + content: "\f0a8"; } + +.fa-group-arrows-rotate::before { + content: "\e4f6"; } + +.fa-bowl-food::before { + content: "\e4c6"; } + +.fa-candy-cane::before { + content: "\f786"; } + +.fa-arrow-down-wide-short::before { + content: "\f160"; } + +.fa-sort-amount-asc::before { + content: "\f160"; } + +.fa-sort-amount-down::before { + content: "\f160"; } + +.fa-cloud-bolt::before { + content: "\f76c"; } + +.fa-thunderstorm::before { + content: "\f76c"; } + +.fa-text-slash::before { + content: "\f87d"; } + +.fa-remove-format::before { + content: "\f87d"; } + +.fa-face-smile-wink::before { + content: "\f4da"; } + +.fa-smile-wink::before { + content: "\f4da"; } + +.fa-file-word::before { + content: "\f1c2"; } + +.fa-file-powerpoint::before { + content: "\f1c4"; } + +.fa-arrows-left-right::before { + content: "\f07e"; } + +.fa-arrows-h::before { + content: "\f07e"; } + +.fa-house-lock::before { + content: "\e510"; } + +.fa-cloud-arrow-down::before { + content: "\f0ed"; } + +.fa-cloud-download::before { + content: "\f0ed"; } + +.fa-cloud-download-alt::before { + content: "\f0ed"; } + +.fa-children::before { + content: "\e4e1"; } + +.fa-chalkboard::before { + content: "\f51b"; } + +.fa-blackboard::before { + content: "\f51b"; } + +.fa-user-large-slash::before { + content: "\f4fa"; } + +.fa-user-alt-slash::before { + content: "\f4fa"; } + +.fa-envelope-open::before { + content: "\f2b6"; } + +.fa-handshake-simple-slash::before { + content: "\e05f"; } + +.fa-handshake-alt-slash::before { + content: "\e05f"; } + +.fa-mattress-pillow::before { + content: "\e525"; } + +.fa-guarani-sign::before { + content: "\e19a"; } + +.fa-arrows-rotate::before { + content: "\f021"; } + +.fa-refresh::before { + content: "\f021"; } + +.fa-sync::before { + content: "\f021"; } + +.fa-fire-extinguisher::before { + content: "\f134"; } + +.fa-cruzeiro-sign::before { + content: "\e152"; } + +.fa-greater-than-equal::before { + content: "\f532"; } + +.fa-shield-halved::before { + content: "\f3ed"; } + +.fa-shield-alt::before { + content: "\f3ed"; } + +.fa-book-atlas::before { + content: "\f558"; } + +.fa-atlas::before { + content: "\f558"; } + +.fa-virus::before { + content: "\e074"; } + +.fa-envelope-circle-check::before { + content: "\e4e8"; } + +.fa-layer-group::before { + content: "\f5fd"; } + +.fa-arrows-to-dot::before { + content: "\e4be"; } + +.fa-archway::before { + content: "\f557"; } + +.fa-heart-circle-check::before { + content: "\e4fd"; } + +.fa-house-chimney-crack::before { + content: "\f6f1"; } + +.fa-house-damage::before { + content: "\f6f1"; } + +.fa-file-zipper::before { + content: "\f1c6"; } + +.fa-file-archive::before { + content: "\f1c6"; } + +.fa-square::before { + content: "\f0c8"; } + +.fa-martini-glass-empty::before { + content: "\f000"; } + +.fa-glass-martini::before { + content: "\f000"; } + +.fa-couch::before { + content: "\f4b8"; } + +.fa-cedi-sign::before { + content: "\e0df"; } + +.fa-italic::before { + content: "\f033"; } + +.fa-table-cells-column-lock::before { + content: "\e678"; } + +.fa-church::before { + content: "\f51d"; } + +.fa-comments-dollar::before { + content: "\f653"; } + +.fa-democrat::before { + content: "\f747"; } + +.fa-z::before { + content: "\5a"; } + +.fa-person-skiing::before { + content: "\f7c9"; } + +.fa-skiing::before { + content: "\f7c9"; } + +.fa-road-lock::before { + content: "\e567"; } + +.fa-a::before { + content: "\41"; } + +.fa-temperature-arrow-down::before { + content: "\e03f"; } + +.fa-temperature-down::before { + content: "\e03f"; } + +.fa-feather-pointed::before { + content: "\f56b"; } + +.fa-feather-alt::before { + content: "\f56b"; } + +.fa-p::before { + content: "\50"; } + +.fa-snowflake::before { + content: "\f2dc"; } + +.fa-newspaper::before { + content: "\f1ea"; } + +.fa-rectangle-ad::before { + content: "\f641"; } + +.fa-ad::before { + content: "\f641"; } + +.fa-circle-arrow-right::before { + content: "\f0a9"; } + +.fa-arrow-circle-right::before { + content: "\f0a9"; } + +.fa-filter-circle-xmark::before { + content: "\e17b"; } + +.fa-locust::before { + content: "\e520"; } + +.fa-sort::before { + content: "\f0dc"; } + +.fa-unsorted::before { + content: "\f0dc"; } + +.fa-list-ol::before { + content: "\f0cb"; } + +.fa-list-1-2::before { + content: "\f0cb"; } + +.fa-list-numeric::before { + content: "\f0cb"; } + +.fa-person-dress-burst::before { + content: "\e544"; } + +.fa-money-check-dollar::before { + content: "\f53d"; } + +.fa-money-check-alt::before { + content: "\f53d"; } + +.fa-vector-square::before { + content: "\f5cb"; } + +.fa-bread-slice::before { + content: "\f7ec"; } + +.fa-language::before { + content: "\f1ab"; } + +.fa-face-kiss-wink-heart::before { + content: "\f598"; } + +.fa-kiss-wink-heart::before { + content: "\f598"; } + +.fa-filter::before { + content: "\f0b0"; } + +.fa-question::before { + content: "\3f"; } + +.fa-file-signature::before { + content: "\f573"; } + +.fa-up-down-left-right::before { + content: "\f0b2"; } + +.fa-arrows-alt::before { + content: "\f0b2"; } + +.fa-house-chimney-user::before { + content: "\e065"; } + +.fa-hand-holding-heart::before { + content: "\f4be"; } + +.fa-puzzle-piece::before { + content: "\f12e"; } + +.fa-money-check::before { + content: "\f53c"; } + +.fa-star-half-stroke::before { + content: "\f5c0"; } + +.fa-star-half-alt::before { + content: "\f5c0"; } + +.fa-code::before { + content: "\f121"; } + +.fa-whiskey-glass::before { + content: "\f7a0"; } + +.fa-glass-whiskey::before { + content: "\f7a0"; } + +.fa-building-circle-exclamation::before { + content: "\e4d3"; } + +.fa-magnifying-glass-chart::before { + content: "\e522"; } + +.fa-arrow-up-right-from-square::before { + content: "\f08e"; } + +.fa-external-link::before { + content: "\f08e"; } + +.fa-cubes-stacked::before { + content: "\e4e6"; } + +.fa-won-sign::before { + content: "\f159"; } + +.fa-krw::before { + content: "\f159"; } + +.fa-won::before { + content: "\f159"; } + +.fa-virus-covid::before { + content: "\e4a8"; } + +.fa-austral-sign::before { + content: "\e0a9"; } + +.fa-f::before { + content: "\46"; } + +.fa-leaf::before { + content: "\f06c"; } + +.fa-road::before { + content: "\f018"; } + +.fa-taxi::before { + content: "\f1ba"; } + +.fa-cab::before { + content: "\f1ba"; } + +.fa-person-circle-plus::before { + content: "\e541"; } + +.fa-chart-pie::before { + content: "\f200"; } + +.fa-pie-chart::before { + content: "\f200"; } + +.fa-bolt-lightning::before { + content: "\e0b7"; } + +.fa-sack-xmark::before { + content: "\e56a"; } + +.fa-file-excel::before { + content: "\f1c3"; } + +.fa-file-contract::before { + content: "\f56c"; } + +.fa-fish-fins::before { + content: "\e4f2"; } + +.fa-building-flag::before { + content: "\e4d5"; } + +.fa-face-grin-beam::before { + content: "\f582"; } + +.fa-grin-beam::before { + content: "\f582"; } + +.fa-object-ungroup::before { + content: "\f248"; } + +.fa-poop::before { + content: "\f619"; } + +.fa-location-pin::before { + content: "\f041"; } + +.fa-map-marker::before { + content: "\f041"; } + +.fa-kaaba::before { + content: "\f66b"; } + +.fa-toilet-paper::before { + content: "\f71e"; } + +.fa-helmet-safety::before { + content: "\f807"; } + +.fa-hard-hat::before { + content: "\f807"; } + +.fa-hat-hard::before { + content: "\f807"; } + +.fa-eject::before { + content: "\f052"; } + +.fa-circle-right::before { + content: "\f35a"; } + +.fa-arrow-alt-circle-right::before { + content: "\f35a"; } + +.fa-plane-circle-check::before { + content: "\e555"; } + +.fa-face-rolling-eyes::before { + content: "\f5a5"; } + +.fa-meh-rolling-eyes::before { + content: "\f5a5"; } + +.fa-object-group::before { + content: "\f247"; } + +.fa-chart-line::before { + content: "\f201"; } + +.fa-line-chart::before { + content: "\f201"; } + +.fa-mask-ventilator::before { + content: "\e524"; } + +.fa-arrow-right::before { + content: "\f061"; } + +.fa-signs-post::before { + content: "\f277"; } + +.fa-map-signs::before { + content: "\f277"; } + +.fa-cash-register::before { + content: "\f788"; } + +.fa-person-circle-question::before { + content: "\e542"; } + +.fa-h::before { + content: "\48"; } + +.fa-tarp::before { + content: "\e57b"; } + +.fa-screwdriver-wrench::before { + content: "\f7d9"; } + +.fa-tools::before { + content: "\f7d9"; } + +.fa-arrows-to-eye::before { + content: "\e4bf"; } + +.fa-plug-circle-bolt::before { + content: "\e55b"; } + +.fa-heart::before { + content: "\f004"; } + +.fa-mars-and-venus::before { + content: "\f224"; } + +.fa-house-user::before { + content: "\e1b0"; } + +.fa-home-user::before { + content: "\e1b0"; } + +.fa-dumpster-fire::before { + content: "\f794"; } + +.fa-house-crack::before { + content: "\e3b1"; } + +.fa-martini-glass-citrus::before { + content: "\f561"; } + +.fa-cocktail::before { + content: "\f561"; } + +.fa-face-surprise::before { + content: "\f5c2"; } + +.fa-surprise::before { + content: "\f5c2"; } + +.fa-bottle-water::before { + content: "\e4c5"; } + +.fa-circle-pause::before { + content: "\f28b"; } + +.fa-pause-circle::before { + content: "\f28b"; } + +.fa-toilet-paper-slash::before { + content: "\e072"; } + +.fa-apple-whole::before { + content: "\f5d1"; } + +.fa-apple-alt::before { + content: "\f5d1"; } + +.fa-kitchen-set::before { + content: "\e51a"; } + +.fa-r::before { + content: "\52"; } + +.fa-temperature-quarter::before { + content: "\f2ca"; } + +.fa-temperature-1::before { + content: "\f2ca"; } + +.fa-thermometer-1::before { + content: "\f2ca"; } + +.fa-thermometer-quarter::before { + content: "\f2ca"; } + +.fa-cube::before { + content: "\f1b2"; } + +.fa-bitcoin-sign::before { + content: "\e0b4"; } + +.fa-shield-dog::before { + content: "\e573"; } + +.fa-solar-panel::before { + content: "\f5ba"; } + +.fa-lock-open::before { + content: "\f3c1"; } + +.fa-elevator::before { + content: "\e16d"; } + +.fa-money-bill-transfer::before { + content: "\e528"; } + +.fa-money-bill-trend-up::before { + content: "\e529"; } + +.fa-house-flood-water-circle-arrow-right::before { + content: "\e50f"; } + +.fa-square-poll-horizontal::before { + content: "\f682"; } + +.fa-poll-h::before { + content: "\f682"; } + +.fa-circle::before { + content: "\f111"; } + +.fa-backward-fast::before { + content: "\f049"; } + +.fa-fast-backward::before { + content: "\f049"; } + +.fa-recycle::before { + content: "\f1b8"; } + +.fa-user-astronaut::before { + content: "\f4fb"; } + +.fa-plane-slash::before { + content: "\e069"; } + +.fa-trademark::before { + content: "\f25c"; } + +.fa-basketball::before { + content: "\f434"; } + +.fa-basketball-ball::before { + content: "\f434"; } + +.fa-satellite-dish::before { + content: "\f7c0"; } + +.fa-circle-up::before { + content: "\f35b"; } + +.fa-arrow-alt-circle-up::before { + content: "\f35b"; } + +.fa-mobile-screen-button::before { + content: "\f3cd"; } + +.fa-mobile-alt::before { + content: "\f3cd"; } + +.fa-volume-high::before { + content: "\f028"; } + +.fa-volume-up::before { + content: "\f028"; } + +.fa-users-rays::before { + content: "\e593"; } + +.fa-wallet::before { + content: "\f555"; } + +.fa-clipboard-check::before { + content: "\f46c"; } + +.fa-file-audio::before { + content: "\f1c7"; } + +.fa-burger::before { + content: "\f805"; } + +.fa-hamburger::before { + content: "\f805"; } + +.fa-wrench::before { + content: "\f0ad"; } + +.fa-bugs::before { + content: "\e4d0"; } + +.fa-rupee-sign::before { + content: "\f156"; } + +.fa-rupee::before { + content: "\f156"; } + +.fa-file-image::before { + content: "\f1c5"; } + +.fa-circle-question::before { + content: "\f059"; } + +.fa-question-circle::before { + content: "\f059"; } + +.fa-plane-departure::before { + content: "\f5b0"; } + +.fa-handshake-slash::before { + content: "\e060"; } + +.fa-book-bookmark::before { + content: "\e0bb"; } + +.fa-code-branch::before { + content: "\f126"; } + +.fa-hat-cowboy::before { + content: "\f8c0"; } + +.fa-bridge::before { + content: "\e4c8"; } + +.fa-phone-flip::before { + content: "\f879"; } + +.fa-phone-alt::before { + content: "\f879"; } + +.fa-truck-front::before { + content: "\e2b7"; } + +.fa-cat::before { + content: "\f6be"; } + +.fa-anchor-circle-exclamation::before { + content: "\e4ab"; } + +.fa-truck-field::before { + content: "\e58d"; } + +.fa-route::before { + content: "\f4d7"; } + +.fa-clipboard-question::before { + content: "\e4e3"; } + +.fa-panorama::before { + content: "\e209"; } + +.fa-comment-medical::before { + content: "\f7f5"; } + +.fa-teeth-open::before { + content: "\f62f"; } + +.fa-file-circle-minus::before { + content: "\e4ed"; } + +.fa-tags::before { + content: "\f02c"; } + +.fa-wine-glass::before { + content: "\f4e3"; } + +.fa-forward-fast::before { + content: "\f050"; } + +.fa-fast-forward::before { + content: "\f050"; } + +.fa-face-meh-blank::before { + content: "\f5a4"; } + +.fa-meh-blank::before { + content: "\f5a4"; } + +.fa-square-parking::before { + content: "\f540"; } + +.fa-parking::before { + content: "\f540"; } + +.fa-house-signal::before { + content: "\e012"; } + +.fa-bars-progress::before { + content: "\f828"; } + +.fa-tasks-alt::before { + content: "\f828"; } + +.fa-faucet-drip::before { + content: "\e006"; } + +.fa-cart-flatbed::before { + content: "\f474"; } + +.fa-dolly-flatbed::before { + content: "\f474"; } + +.fa-ban-smoking::before { + content: "\f54d"; } + +.fa-smoking-ban::before { + content: "\f54d"; } + +.fa-terminal::before { + content: "\f120"; } + +.fa-mobile-button::before { + content: "\f10b"; } + +.fa-house-medical-flag::before { + content: "\e514"; } + +.fa-basket-shopping::before { + content: "\f291"; } + +.fa-shopping-basket::before { + content: "\f291"; } + +.fa-tape::before { + content: "\f4db"; } + +.fa-bus-simple::before { + content: "\f55e"; } + +.fa-bus-alt::before { + content: "\f55e"; } + +.fa-eye::before { + content: "\f06e"; } + +.fa-face-sad-cry::before { + content: "\f5b3"; } + +.fa-sad-cry::before { + content: "\f5b3"; } + +.fa-audio-description::before { + content: "\f29e"; } + +.fa-person-military-to-person::before { + content: "\e54c"; } + +.fa-file-shield::before { + content: "\e4f0"; } + +.fa-user-slash::before { + content: "\f506"; } + +.fa-pen::before { + content: "\f304"; } + +.fa-tower-observation::before { + content: "\e586"; } + +.fa-file-code::before { + content: "\f1c9"; } + +.fa-signal::before { + content: "\f012"; } + +.fa-signal-5::before { + content: "\f012"; } + +.fa-signal-perfect::before { + content: "\f012"; } + +.fa-bus::before { + content: "\f207"; } + +.fa-heart-circle-xmark::before { + content: "\e501"; } + +.fa-house-chimney::before { + content: "\e3af"; } + +.fa-home-lg::before { + content: "\e3af"; } + +.fa-window-maximize::before { + content: "\f2d0"; } + +.fa-face-frown::before { + content: "\f119"; } + +.fa-frown::before { + content: "\f119"; } + +.fa-prescription::before { + content: "\f5b1"; } + +.fa-shop::before { + content: "\f54f"; } + +.fa-store-alt::before { + content: "\f54f"; } + +.fa-floppy-disk::before { + content: "\f0c7"; } + +.fa-save::before { + content: "\f0c7"; } + +.fa-vihara::before { + content: "\f6a7"; } + +.fa-scale-unbalanced::before { + content: "\f515"; } + +.fa-balance-scale-left::before { + content: "\f515"; } + +.fa-sort-up::before { + content: "\f0de"; } + +.fa-sort-asc::before { + content: "\f0de"; } + +.fa-comment-dots::before { + content: "\f4ad"; } + +.fa-commenting::before { + content: "\f4ad"; } + +.fa-plant-wilt::before { + content: "\e5aa"; } + +.fa-diamond::before { + content: "\f219"; } + +.fa-face-grin-squint::before { + content: "\f585"; } + +.fa-grin-squint::before { + content: "\f585"; } + +.fa-hand-holding-dollar::before { + content: "\f4c0"; } + +.fa-hand-holding-usd::before { + content: "\f4c0"; } + +.fa-bacterium::before { + content: "\e05a"; } + +.fa-hand-pointer::before { + content: "\f25a"; } + +.fa-drum-steelpan::before { + content: "\f56a"; } + +.fa-hand-scissors::before { + content: "\f257"; } + +.fa-hands-praying::before { + content: "\f684"; } + +.fa-praying-hands::before { + content: "\f684"; } + +.fa-arrow-rotate-right::before { + content: "\f01e"; } + +.fa-arrow-right-rotate::before { + content: "\f01e"; } + +.fa-arrow-rotate-forward::before { + content: "\f01e"; } + +.fa-redo::before { + content: "\f01e"; } + +.fa-biohazard::before { + content: "\f780"; } + +.fa-location-crosshairs::before { + content: "\f601"; } + +.fa-location::before { + content: "\f601"; } + +.fa-mars-double::before { + content: "\f227"; } + +.fa-child-dress::before { + content: "\e59c"; } + +.fa-users-between-lines::before { + content: "\e591"; } + +.fa-lungs-virus::before { + content: "\e067"; } + +.fa-face-grin-tears::before { + content: "\f588"; } + +.fa-grin-tears::before { + content: "\f588"; } + +.fa-phone::before { + content: "\f095"; } + +.fa-calendar-xmark::before { + content: "\f273"; } + +.fa-calendar-times::before { + content: "\f273"; } + +.fa-child-reaching::before { + content: "\e59d"; } + +.fa-head-side-virus::before { + content: "\e064"; } + +.fa-user-gear::before { + content: "\f4fe"; } + +.fa-user-cog::before { + content: "\f4fe"; } + +.fa-arrow-up-1-9::before { + content: "\f163"; } + +.fa-sort-numeric-up::before { + content: "\f163"; } + +.fa-door-closed::before { + content: "\f52a"; } + +.fa-shield-virus::before { + content: "\e06c"; } + +.fa-dice-six::before { + content: "\f526"; } + +.fa-mosquito-net::before { + content: "\e52c"; } + +.fa-bridge-water::before { + content: "\e4ce"; } + +.fa-person-booth::before { + content: "\f756"; } + +.fa-text-width::before { + content: "\f035"; } + +.fa-hat-wizard::before { + content: "\f6e8"; } + +.fa-pen-fancy::before { + content: "\f5ac"; } + +.fa-person-digging::before { + content: "\f85e"; } + +.fa-digging::before { + content: "\f85e"; } + +.fa-trash::before { + content: "\f1f8"; } + +.fa-gauge-simple::before { + content: "\f629"; } + +.fa-gauge-simple-med::before { + content: "\f629"; } + +.fa-tachometer-average::before { + content: "\f629"; } + +.fa-book-medical::before { + content: "\f7e6"; } + +.fa-poo::before { + content: "\f2fe"; } + +.fa-quote-right::before { + content: "\f10e"; } + +.fa-quote-right-alt::before { + content: "\f10e"; } + +.fa-shirt::before { + content: "\f553"; } + +.fa-t-shirt::before { + content: "\f553"; } + +.fa-tshirt::before { + content: "\f553"; } + +.fa-cubes::before { + content: "\f1b3"; } + +.fa-divide::before { + content: "\f529"; } + +.fa-tenge-sign::before { + content: "\f7d7"; } + +.fa-tenge::before { + content: "\f7d7"; } + +.fa-headphones::before { + content: "\f025"; } + +.fa-hands-holding::before { + content: "\f4c2"; } + +.fa-hands-clapping::before { + content: "\e1a8"; } + +.fa-republican::before { + content: "\f75e"; } + +.fa-arrow-left::before { + content: "\f060"; } + +.fa-person-circle-xmark::before { + content: "\e543"; } + +.fa-ruler::before { + content: "\f545"; } + +.fa-align-left::before { + content: "\f036"; } + +.fa-dice-d6::before { + content: "\f6d1"; } + +.fa-restroom::before { + content: "\f7bd"; } + +.fa-j::before { + content: "\4a"; } + +.fa-users-viewfinder::before { + content: "\e595"; } + +.fa-file-video::before { + content: "\f1c8"; } + +.fa-up-right-from-square::before { + content: "\f35d"; } + +.fa-external-link-alt::before { + content: "\f35d"; } + +.fa-table-cells::before { + content: "\f00a"; } + +.fa-th::before { + content: "\f00a"; } + +.fa-file-pdf::before { + content: "\f1c1"; } + +.fa-book-bible::before { + content: "\f647"; } + +.fa-bible::before { + content: "\f647"; } + +.fa-o::before { + content: "\4f"; } + +.fa-suitcase-medical::before { + content: "\f0fa"; } + +.fa-medkit::before { + content: "\f0fa"; } + +.fa-user-secret::before { + content: "\f21b"; } + +.fa-otter::before { + content: "\f700"; } + +.fa-person-dress::before { + content: "\f182"; } + +.fa-female::before { + content: "\f182"; } + +.fa-comment-dollar::before { + content: "\f651"; } + +.fa-business-time::before { + content: "\f64a"; } + +.fa-briefcase-clock::before { + content: "\f64a"; } + +.fa-table-cells-large::before { + content: "\f009"; } + +.fa-th-large::before { + content: "\f009"; } + +.fa-book-tanakh::before { + content: "\f827"; } + +.fa-tanakh::before { + content: "\f827"; } + +.fa-phone-volume::before { + content: "\f2a0"; } + +.fa-volume-control-phone::before { + content: "\f2a0"; } + +.fa-hat-cowboy-side::before { + content: "\f8c1"; } + +.fa-clipboard-user::before { + content: "\f7f3"; } + +.fa-child::before { + content: "\f1ae"; } + +.fa-lira-sign::before { + content: "\f195"; } + +.fa-satellite::before { + content: "\f7bf"; } + +.fa-plane-lock::before { + content: "\e558"; } + +.fa-tag::before { + content: "\f02b"; } + +.fa-comment::before { + content: "\f075"; } + +.fa-cake-candles::before { + content: "\f1fd"; } + +.fa-birthday-cake::before { + content: "\f1fd"; } + +.fa-cake::before { + content: "\f1fd"; } + +.fa-envelope::before { + content: "\f0e0"; } + +.fa-angles-up::before { + content: "\f102"; } + +.fa-angle-double-up::before { + content: "\f102"; } + +.fa-paperclip::before { + content: "\f0c6"; } + +.fa-arrow-right-to-city::before { + content: "\e4b3"; } + +.fa-ribbon::before { + content: "\f4d6"; } + +.fa-lungs::before { + content: "\f604"; } + +.fa-arrow-up-9-1::before { + content: "\f887"; } + +.fa-sort-numeric-up-alt::before { + content: "\f887"; } + +.fa-litecoin-sign::before { + content: "\e1d3"; } + +.fa-border-none::before { + content: "\f850"; } + +.fa-circle-nodes::before { + content: "\e4e2"; } + +.fa-parachute-box::before { + content: "\f4cd"; } + +.fa-indent::before { + content: "\f03c"; } + +.fa-truck-field-un::before { + content: "\e58e"; } + +.fa-hourglass::before { + content: "\f254"; } + +.fa-hourglass-empty::before { + content: "\f254"; } + +.fa-mountain::before { + content: "\f6fc"; } + +.fa-user-doctor::before { + content: "\f0f0"; } + +.fa-user-md::before { + content: "\f0f0"; } + +.fa-circle-info::before { + content: "\f05a"; } + +.fa-info-circle::before { + content: "\f05a"; } + +.fa-cloud-meatball::before { + content: "\f73b"; } + +.fa-camera::before { + content: "\f030"; } + +.fa-camera-alt::before { + content: "\f030"; } + +.fa-square-virus::before { + content: "\e578"; } + +.fa-meteor::before { + content: "\f753"; } + +.fa-car-on::before { + content: "\e4dd"; } + +.fa-sleigh::before { + content: "\f7cc"; } + +.fa-arrow-down-1-9::before { + content: "\f162"; } + +.fa-sort-numeric-asc::before { + content: "\f162"; } + +.fa-sort-numeric-down::before { + content: "\f162"; } + +.fa-hand-holding-droplet::before { + content: "\f4c1"; } + +.fa-hand-holding-water::before { + content: "\f4c1"; } + +.fa-water::before { + content: "\f773"; } + +.fa-calendar-check::before { + content: "\f274"; } + +.fa-braille::before { + content: "\f2a1"; } + +.fa-prescription-bottle-medical::before { + content: "\f486"; } + +.fa-prescription-bottle-alt::before { + content: "\f486"; } + +.fa-landmark::before { + content: "\f66f"; } + +.fa-truck::before { + content: "\f0d1"; } + +.fa-crosshairs::before { + content: "\f05b"; } + +.fa-person-cane::before { + content: "\e53c"; } + +.fa-tent::before { + content: "\e57d"; } + +.fa-vest-patches::before { + content: "\e086"; } + +.fa-check-double::before { + content: "\f560"; } + +.fa-arrow-down-a-z::before { + content: "\f15d"; } + +.fa-sort-alpha-asc::before { + content: "\f15d"; } + +.fa-sort-alpha-down::before { + content: "\f15d"; } + +.fa-money-bill-wheat::before { + content: "\e52a"; } + +.fa-cookie::before { + content: "\f563"; } + +.fa-arrow-rotate-left::before { + content: "\f0e2"; } + +.fa-arrow-left-rotate::before { + content: "\f0e2"; } + +.fa-arrow-rotate-back::before { + content: "\f0e2"; } + +.fa-arrow-rotate-backward::before { + content: "\f0e2"; } + +.fa-undo::before { + content: "\f0e2"; } + +.fa-hard-drive::before { + content: "\f0a0"; } + +.fa-hdd::before { + content: "\f0a0"; } + +.fa-face-grin-squint-tears::before { + content: "\f586"; } + +.fa-grin-squint-tears::before { + content: "\f586"; } + +.fa-dumbbell::before { + content: "\f44b"; } + +.fa-rectangle-list::before { + content: "\f022"; } + +.fa-list-alt::before { + content: "\f022"; } + +.fa-tarp-droplet::before { + content: "\e57c"; } + +.fa-house-medical-circle-check::before { + content: "\e511"; } + +.fa-person-skiing-nordic::before { + content: "\f7ca"; } + +.fa-skiing-nordic::before { + content: "\f7ca"; } + +.fa-calendar-plus::before { + content: "\f271"; } + +.fa-plane-arrival::before { + content: "\f5af"; } + +.fa-circle-left::before { + content: "\f359"; } + +.fa-arrow-alt-circle-left::before { + content: "\f359"; } + +.fa-train-subway::before { + content: "\f239"; } + +.fa-subway::before { + content: "\f239"; } + +.fa-chart-gantt::before { + content: "\e0e4"; } + +.fa-indian-rupee-sign::before { + content: "\e1bc"; } + +.fa-indian-rupee::before { + content: "\e1bc"; } + +.fa-inr::before { + content: "\e1bc"; } + +.fa-crop-simple::before { + content: "\f565"; } + +.fa-crop-alt::before { + content: "\f565"; } + +.fa-money-bill-1::before { + content: "\f3d1"; } + +.fa-money-bill-alt::before { + content: "\f3d1"; } + +.fa-left-long::before { + content: "\f30a"; } + +.fa-long-arrow-alt-left::before { + content: "\f30a"; } + +.fa-dna::before { + content: "\f471"; } + +.fa-virus-slash::before { + content: "\e075"; } + +.fa-minus::before { + content: "\f068"; } + +.fa-subtract::before { + content: "\f068"; } + +.fa-chess::before { + content: "\f439"; } + +.fa-arrow-left-long::before { + content: "\f177"; } + +.fa-long-arrow-left::before { + content: "\f177"; } + +.fa-plug-circle-check::before { + content: "\e55c"; } + +.fa-street-view::before { + content: "\f21d"; } + +.fa-franc-sign::before { + content: "\e18f"; } + +.fa-volume-off::before { + content: "\f026"; } + +.fa-hands-asl-interpreting::before { + content: "\f2a3"; } + +.fa-american-sign-language-interpreting::before { + content: "\f2a3"; } + +.fa-asl-interpreting::before { + content: "\f2a3"; } + +.fa-hands-american-sign-language-interpreting::before { + content: "\f2a3"; } + +.fa-gear::before { + content: "\f013"; } + +.fa-cog::before { + content: "\f013"; } + +.fa-droplet-slash::before { + content: "\f5c7"; } + +.fa-tint-slash::before { + content: "\f5c7"; } + +.fa-mosque::before { + content: "\f678"; } + +.fa-mosquito::before { + content: "\e52b"; } + +.fa-star-of-david::before { + content: "\f69a"; } + +.fa-person-military-rifle::before { + content: "\e54b"; } + +.fa-cart-shopping::before { + content: "\f07a"; } + +.fa-shopping-cart::before { + content: "\f07a"; } + +.fa-vials::before { + content: "\f493"; } + +.fa-plug-circle-plus::before { + content: "\e55f"; } + +.fa-place-of-worship::before { + content: "\f67f"; } + +.fa-grip-vertical::before { + content: "\f58e"; } + +.fa-arrow-turn-up::before { + content: "\f148"; } + +.fa-level-up::before { + content: "\f148"; } + +.fa-u::before { + content: "\55"; } + +.fa-square-root-variable::before { + content: "\f698"; } + +.fa-square-root-alt::before { + content: "\f698"; } + +.fa-clock::before { + content: "\f017"; } + +.fa-clock-four::before { + content: "\f017"; } + +.fa-backward-step::before { + content: "\f048"; } + +.fa-step-backward::before { + content: "\f048"; } + +.fa-pallet::before { + content: "\f482"; } + +.fa-faucet::before { + content: "\e005"; } + +.fa-baseball-bat-ball::before { + content: "\f432"; } + +.fa-s::before { + content: "\53"; } + +.fa-timeline::before { + content: "\e29c"; } + +.fa-keyboard::before { + content: "\f11c"; } + +.fa-caret-down::before { + content: "\f0d7"; } + +.fa-house-chimney-medical::before { + content: "\f7f2"; } + +.fa-clinic-medical::before { + content: "\f7f2"; } + +.fa-temperature-three-quarters::before { + content: "\f2c8"; } + +.fa-temperature-3::before { + content: "\f2c8"; } + +.fa-thermometer-3::before { + content: "\f2c8"; } + +.fa-thermometer-three-quarters::before { + content: "\f2c8"; } + +.fa-mobile-screen::before { + content: "\f3cf"; } + +.fa-mobile-android-alt::before { + content: "\f3cf"; } + +.fa-plane-up::before { + content: "\e22d"; } + +.fa-piggy-bank::before { + content: "\f4d3"; } + +.fa-battery-half::before { + content: "\f242"; } + +.fa-battery-3::before { + content: "\f242"; } + +.fa-mountain-city::before { + content: "\e52e"; } + +.fa-coins::before { + content: "\f51e"; } + +.fa-khanda::before { + content: "\f66d"; } + +.fa-sliders::before { + content: "\f1de"; } + +.fa-sliders-h::before { + content: "\f1de"; } + +.fa-folder-tree::before { + content: "\f802"; } + +.fa-network-wired::before { + content: "\f6ff"; } + +.fa-map-pin::before { + content: "\f276"; } + +.fa-hamsa::before { + content: "\f665"; } + +.fa-cent-sign::before { + content: "\e3f5"; } + +.fa-flask::before { + content: "\f0c3"; } + +.fa-person-pregnant::before { + content: "\e31e"; } + +.fa-wand-sparkles::before { + content: "\f72b"; } + +.fa-ellipsis-vertical::before { + content: "\f142"; } + +.fa-ellipsis-v::before { + content: "\f142"; } + +.fa-ticket::before { + content: "\f145"; } + +.fa-power-off::before { + content: "\f011"; } + +.fa-right-long::before { + content: "\f30b"; } + +.fa-long-arrow-alt-right::before { + content: "\f30b"; } + +.fa-flag-usa::before { + content: "\f74d"; } + +.fa-laptop-file::before { + content: "\e51d"; } + +.fa-tty::before { + content: "\f1e4"; } + +.fa-teletype::before { + content: "\f1e4"; } + +.fa-diagram-next::before { + content: "\e476"; } + +.fa-person-rifle::before { + content: "\e54e"; } + +.fa-house-medical-circle-exclamation::before { + content: "\e512"; } + +.fa-closed-captioning::before { + content: "\f20a"; } + +.fa-person-hiking::before { + content: "\f6ec"; } + +.fa-hiking::before { + content: "\f6ec"; } + +.fa-venus-double::before { + content: "\f226"; } + +.fa-images::before { + content: "\f302"; } + +.fa-calculator::before { + content: "\f1ec"; } + +.fa-people-pulling::before { + content: "\e535"; } + +.fa-n::before { + content: "\4e"; } + +.fa-cable-car::before { + content: "\f7da"; } + +.fa-tram::before { + content: "\f7da"; } + +.fa-cloud-rain::before { + content: "\f73d"; } + +.fa-building-circle-xmark::before { + content: "\e4d4"; } + +.fa-ship::before { + content: "\f21a"; } + +.fa-arrows-down-to-line::before { + content: "\e4b8"; } + +.fa-download::before { + content: "\f019"; } + +.fa-face-grin::before { + content: "\f580"; } + +.fa-grin::before { + content: "\f580"; } + +.fa-delete-left::before { + content: "\f55a"; } + +.fa-backspace::before { + content: "\f55a"; } + +.fa-eye-dropper::before { + content: "\f1fb"; } + +.fa-eye-dropper-empty::before { + content: "\f1fb"; } + +.fa-eyedropper::before { + content: "\f1fb"; } + +.fa-file-circle-check::before { + content: "\e5a0"; } + +.fa-forward::before { + content: "\f04e"; } + +.fa-mobile::before { + content: "\f3ce"; } + +.fa-mobile-android::before { + content: "\f3ce"; } + +.fa-mobile-phone::before { + content: "\f3ce"; } + +.fa-face-meh::before { + content: "\f11a"; } + +.fa-meh::before { + content: "\f11a"; } + +.fa-align-center::before { + content: "\f037"; } + +.fa-book-skull::before { + content: "\f6b7"; } + +.fa-book-dead::before { + content: "\f6b7"; } + +.fa-id-card::before { + content: "\f2c2"; } + +.fa-drivers-license::before { + content: "\f2c2"; } + +.fa-outdent::before { + content: "\f03b"; } + +.fa-dedent::before { + content: "\f03b"; } + +.fa-heart-circle-exclamation::before { + content: "\e4fe"; } + +.fa-house::before { + content: "\f015"; } + +.fa-home::before { + content: "\f015"; } + +.fa-home-alt::before { + content: "\f015"; } + +.fa-home-lg-alt::before { + content: "\f015"; } + +.fa-calendar-week::before { + content: "\f784"; } + +.fa-laptop-medical::before { + content: "\f812"; } + +.fa-b::before { + content: "\42"; } + +.fa-file-medical::before { + content: "\f477"; } + +.fa-dice-one::before { + content: "\f525"; } + +.fa-kiwi-bird::before { + content: "\f535"; } + +.fa-arrow-right-arrow-left::before { + content: "\f0ec"; } + +.fa-exchange::before { + content: "\f0ec"; } + +.fa-rotate-right::before { + content: "\f2f9"; } + +.fa-redo-alt::before { + content: "\f2f9"; } + +.fa-rotate-forward::before { + content: "\f2f9"; } + +.fa-utensils::before { + content: "\f2e7"; } + +.fa-cutlery::before { + content: "\f2e7"; } + +.fa-arrow-up-wide-short::before { + content: "\f161"; } + +.fa-sort-amount-up::before { + content: "\f161"; } + +.fa-mill-sign::before { + content: "\e1ed"; } + +.fa-bowl-rice::before { + content: "\e2eb"; } + +.fa-skull::before { + content: "\f54c"; } + +.fa-tower-broadcast::before { + content: "\f519"; } + +.fa-broadcast-tower::before { + content: "\f519"; } + +.fa-truck-pickup::before { + content: "\f63c"; } + +.fa-up-long::before { + content: "\f30c"; } + +.fa-long-arrow-alt-up::before { + content: "\f30c"; } + +.fa-stop::before { + content: "\f04d"; } + +.fa-code-merge::before { + content: "\f387"; } + +.fa-upload::before { + content: "\f093"; } + +.fa-hurricane::before { + content: "\f751"; } + +.fa-mound::before { + content: "\e52d"; } + +.fa-toilet-portable::before { + content: "\e583"; } + +.fa-compact-disc::before { + content: "\f51f"; } + +.fa-file-arrow-down::before { + content: "\f56d"; } + +.fa-file-download::before { + content: "\f56d"; } + +.fa-caravan::before { + content: "\f8ff"; } + +.fa-shield-cat::before { + content: "\e572"; } + +.fa-bolt::before { + content: "\f0e7"; } + +.fa-zap::before { + content: "\f0e7"; } + +.fa-glass-water::before { + content: "\e4f4"; } + +.fa-oil-well::before { + content: "\e532"; } + +.fa-vault::before { + content: "\e2c5"; } + +.fa-mars::before { + content: "\f222"; } + +.fa-toilet::before { + content: "\f7d8"; } + +.fa-plane-circle-xmark::before { + content: "\e557"; } + +.fa-yen-sign::before { + content: "\f157"; } + +.fa-cny::before { + content: "\f157"; } + +.fa-jpy::before { + content: "\f157"; } + +.fa-rmb::before { + content: "\f157"; } + +.fa-yen::before { + content: "\f157"; } + +.fa-ruble-sign::before { + content: "\f158"; } + +.fa-rouble::before { + content: "\f158"; } + +.fa-rub::before { + content: "\f158"; } + +.fa-ruble::before { + content: "\f158"; } + +.fa-sun::before { + content: "\f185"; } + +.fa-guitar::before { + content: "\f7a6"; } + +.fa-face-laugh-wink::before { + content: "\f59c"; } + +.fa-laugh-wink::before { + content: "\f59c"; } + +.fa-horse-head::before { + content: "\f7ab"; } + +.fa-bore-hole::before { + content: "\e4c3"; } + +.fa-industry::before { + content: "\f275"; } + +.fa-circle-down::before { + content: "\f358"; } + +.fa-arrow-alt-circle-down::before { + content: "\f358"; } + +.fa-arrows-turn-to-dots::before { + content: "\e4c1"; } + +.fa-florin-sign::before { + content: "\e184"; } + +.fa-arrow-down-short-wide::before { + content: "\f884"; } + +.fa-sort-amount-desc::before { + content: "\f884"; } + +.fa-sort-amount-down-alt::before { + content: "\f884"; } + +.fa-less-than::before { + content: "\3c"; } + +.fa-angle-down::before { + content: "\f107"; } + +.fa-car-tunnel::before { + content: "\e4de"; } + +.fa-head-side-cough::before { + content: "\e061"; } + +.fa-grip-lines::before { + content: "\f7a4"; } + +.fa-thumbs-down::before { + content: "\f165"; } + +.fa-user-lock::before { + content: "\f502"; } + +.fa-arrow-right-long::before { + content: "\f178"; } + +.fa-long-arrow-right::before { + content: "\f178"; } + +.fa-anchor-circle-xmark::before { + content: "\e4ac"; } + +.fa-ellipsis::before { + content: "\f141"; } + +.fa-ellipsis-h::before { + content: "\f141"; } + +.fa-chess-pawn::before { + content: "\f443"; } + +.fa-kit-medical::before { + content: "\f479"; } + +.fa-first-aid::before { + content: "\f479"; } + +.fa-person-through-window::before { + content: "\e5a9"; } + +.fa-toolbox::before { + content: "\f552"; } + +.fa-hands-holding-circle::before { + content: "\e4fb"; } + +.fa-bug::before { + content: "\f188"; } + +.fa-credit-card::before { + content: "\f09d"; } + +.fa-credit-card-alt::before { + content: "\f09d"; } + +.fa-car::before { + content: "\f1b9"; } + +.fa-automobile::before { + content: "\f1b9"; } + +.fa-hand-holding-hand::before { + content: "\e4f7"; } + +.fa-book-open-reader::before { + content: "\f5da"; } + +.fa-book-reader::before { + content: "\f5da"; } + +.fa-mountain-sun::before { + content: "\e52f"; } + +.fa-arrows-left-right-to-line::before { + content: "\e4ba"; } + +.fa-dice-d20::before { + content: "\f6cf"; } + +.fa-truck-droplet::before { + content: "\e58c"; } + +.fa-file-circle-xmark::before { + content: "\e5a1"; } + +.fa-temperature-arrow-up::before { + content: "\e040"; } + +.fa-temperature-up::before { + content: "\e040"; } + +.fa-medal::before { + content: "\f5a2"; } + +.fa-bed::before { + content: "\f236"; } + +.fa-square-h::before { + content: "\f0fd"; } + +.fa-h-square::before { + content: "\f0fd"; } + +.fa-podcast::before { + content: "\f2ce"; } + +.fa-temperature-full::before { + content: "\f2c7"; } + +.fa-temperature-4::before { + content: "\f2c7"; } + +.fa-thermometer-4::before { + content: "\f2c7"; } + +.fa-thermometer-full::before { + content: "\f2c7"; } + +.fa-bell::before { + content: "\f0f3"; } + +.fa-superscript::before { + content: "\f12b"; } + +.fa-plug-circle-xmark::before { + content: "\e560"; } + +.fa-star-of-life::before { + content: "\f621"; } + +.fa-phone-slash::before { + content: "\f3dd"; } + +.fa-paint-roller::before { + content: "\f5aa"; } + +.fa-handshake-angle::before { + content: "\f4c4"; } + +.fa-hands-helping::before { + content: "\f4c4"; } + +.fa-location-dot::before { + content: "\f3c5"; } + +.fa-map-marker-alt::before { + content: "\f3c5"; } + +.fa-file::before { + content: "\f15b"; } + +.fa-greater-than::before { + content: "\3e"; } + +.fa-person-swimming::before { + content: "\f5c4"; } + +.fa-swimmer::before { + content: "\f5c4"; } + +.fa-arrow-down::before { + content: "\f063"; } + +.fa-droplet::before { + content: "\f043"; } + +.fa-tint::before { + content: "\f043"; } + +.fa-eraser::before { + content: "\f12d"; } + +.fa-earth-americas::before { + content: "\f57d"; } + +.fa-earth::before { + content: "\f57d"; } + +.fa-earth-america::before { + content: "\f57d"; } + +.fa-globe-americas::before { + content: "\f57d"; } + +.fa-person-burst::before { + content: "\e53b"; } + +.fa-dove::before { + content: "\f4ba"; } + +.fa-battery-empty::before { + content: "\f244"; } + +.fa-battery-0::before { + content: "\f244"; } + +.fa-socks::before { + content: "\f696"; } + +.fa-inbox::before { + content: "\f01c"; } + +.fa-section::before { + content: "\e447"; } + +.fa-gauge-high::before { + content: "\f625"; } + +.fa-tachometer-alt::before { + content: "\f625"; } + +.fa-tachometer-alt-fast::before { + content: "\f625"; } + +.fa-envelope-open-text::before { + content: "\f658"; } + +.fa-hospital::before { + content: "\f0f8"; } + +.fa-hospital-alt::before { + content: "\f0f8"; } + +.fa-hospital-wide::before { + content: "\f0f8"; } + +.fa-wine-bottle::before { + content: "\f72f"; } + +.fa-chess-rook::before { + content: "\f447"; } + +.fa-bars-staggered::before { + content: "\f550"; } + +.fa-reorder::before { + content: "\f550"; } + +.fa-stream::before { + content: "\f550"; } + +.fa-dharmachakra::before { + content: "\f655"; } + +.fa-hotdog::before { + content: "\f80f"; } + +.fa-person-walking-with-cane::before { + content: "\f29d"; } + +.fa-blind::before { + content: "\f29d"; } + +.fa-drum::before { + content: "\f569"; } + +.fa-ice-cream::before { + content: "\f810"; } + +.fa-heart-circle-bolt::before { + content: "\e4fc"; } + +.fa-fax::before { + content: "\f1ac"; } + +.fa-paragraph::before { + content: "\f1dd"; } + +.fa-check-to-slot::before { + content: "\f772"; } + +.fa-vote-yea::before { + content: "\f772"; } + +.fa-star-half::before { + content: "\f089"; } + +.fa-boxes-stacked::before { + content: "\f468"; } + +.fa-boxes::before { + content: "\f468"; } + +.fa-boxes-alt::before { + content: "\f468"; } + +.fa-link::before { + content: "\f0c1"; } + +.fa-chain::before { + content: "\f0c1"; } + +.fa-ear-listen::before { + content: "\f2a2"; } + +.fa-assistive-listening-systems::before { + content: "\f2a2"; } + +.fa-tree-city::before { + content: "\e587"; } + +.fa-play::before { + content: "\f04b"; } + +.fa-font::before { + content: "\f031"; } + +.fa-table-cells-row-lock::before { + content: "\e67a"; } + +.fa-rupiah-sign::before { + content: "\e23d"; } + +.fa-magnifying-glass::before { + content: "\f002"; } + +.fa-search::before { + content: "\f002"; } + +.fa-table-tennis-paddle-ball::before { + content: "\f45d"; } + +.fa-ping-pong-paddle-ball::before { + content: "\f45d"; } + +.fa-table-tennis::before { + content: "\f45d"; } + +.fa-person-dots-from-line::before { + content: "\f470"; } + +.fa-diagnoses::before { + content: "\f470"; } + +.fa-trash-can-arrow-up::before { + content: "\f82a"; } + +.fa-trash-restore-alt::before { + content: "\f82a"; } + +.fa-naira-sign::before { + content: "\e1f6"; } + +.fa-cart-arrow-down::before { + content: "\f218"; } + +.fa-walkie-talkie::before { + content: "\f8ef"; } + +.fa-file-pen::before { + content: "\f31c"; } + +.fa-file-edit::before { + content: "\f31c"; } + +.fa-receipt::before { + content: "\f543"; } + +.fa-square-pen::before { + content: "\f14b"; } + +.fa-pen-square::before { + content: "\f14b"; } + +.fa-pencil-square::before { + content: "\f14b"; } + +.fa-suitcase-rolling::before { + content: "\f5c1"; } + +.fa-person-circle-exclamation::before { + content: "\e53f"; } + +.fa-chevron-down::before { + content: "\f078"; } + +.fa-battery-full::before { + content: "\f240"; } + +.fa-battery::before { + content: "\f240"; } + +.fa-battery-5::before { + content: "\f240"; } + +.fa-skull-crossbones::before { + content: "\f714"; } + +.fa-code-compare::before { + content: "\e13a"; } + +.fa-list-ul::before { + content: "\f0ca"; } + +.fa-list-dots::before { + content: "\f0ca"; } + +.fa-school-lock::before { + content: "\e56f"; } + +.fa-tower-cell::before { + content: "\e585"; } + +.fa-down-long::before { + content: "\f309"; } + +.fa-long-arrow-alt-down::before { + content: "\f309"; } + +.fa-ranking-star::before { + content: "\e561"; } + +.fa-chess-king::before { + content: "\f43f"; } + +.fa-person-harassing::before { + content: "\e549"; } + +.fa-brazilian-real-sign::before { + content: "\e46c"; } + +.fa-landmark-dome::before { + content: "\f752"; } + +.fa-landmark-alt::before { + content: "\f752"; } + +.fa-arrow-up::before { + content: "\f062"; } + +.fa-tv::before { + content: "\f26c"; } + +.fa-television::before { + content: "\f26c"; } + +.fa-tv-alt::before { + content: "\f26c"; } + +.fa-shrimp::before { + content: "\e448"; } + +.fa-list-check::before { + content: "\f0ae"; } + +.fa-tasks::before { + content: "\f0ae"; } + +.fa-jug-detergent::before { + content: "\e519"; } + +.fa-circle-user::before { + content: "\f2bd"; } + +.fa-user-circle::before { + content: "\f2bd"; } + +.fa-user-shield::before { + content: "\f505"; } + +.fa-wind::before { + content: "\f72e"; } + +.fa-car-burst::before { + content: "\f5e1"; } + +.fa-car-crash::before { + content: "\f5e1"; } + +.fa-y::before { + content: "\59"; } + +.fa-person-snowboarding::before { + content: "\f7ce"; } + +.fa-snowboarding::before { + content: "\f7ce"; } + +.fa-truck-fast::before { + content: "\f48b"; } + +.fa-shipping-fast::before { + content: "\f48b"; } + +.fa-fish::before { + content: "\f578"; } + +.fa-user-graduate::before { + content: "\f501"; } + +.fa-circle-half-stroke::before { + content: "\f042"; } + +.fa-adjust::before { + content: "\f042"; } + +.fa-clapperboard::before { + content: "\e131"; } + +.fa-circle-radiation::before { + content: "\f7ba"; } + +.fa-radiation-alt::before { + content: "\f7ba"; } + +.fa-baseball::before { + content: "\f433"; } + +.fa-baseball-ball::before { + content: "\f433"; } + +.fa-jet-fighter-up::before { + content: "\e518"; } + +.fa-diagram-project::before { + content: "\f542"; } + +.fa-project-diagram::before { + content: "\f542"; } + +.fa-copy::before { + content: "\f0c5"; } + +.fa-volume-xmark::before { + content: "\f6a9"; } + +.fa-volume-mute::before { + content: "\f6a9"; } + +.fa-volume-times::before { + content: "\f6a9"; } + +.fa-hand-sparkles::before { + content: "\e05d"; } + +.fa-grip::before { + content: "\f58d"; } + +.fa-grip-horizontal::before { + content: "\f58d"; } + +.fa-share-from-square::before { + content: "\f14d"; } + +.fa-share-square::before { + content: "\f14d"; } + +.fa-child-combatant::before { + content: "\e4e0"; } + +.fa-child-rifle::before { + content: "\e4e0"; } + +.fa-gun::before { + content: "\e19b"; } + +.fa-square-phone::before { + content: "\f098"; } + +.fa-phone-square::before { + content: "\f098"; } + +.fa-plus::before { + content: "\2b"; } + +.fa-add::before { + content: "\2b"; } + +.fa-expand::before { + content: "\f065"; } + +.fa-computer::before { + content: "\e4e5"; } + +.fa-xmark::before { + content: "\f00d"; } + +.fa-close::before { + content: "\f00d"; } + +.fa-multiply::before { + content: "\f00d"; } + +.fa-remove::before { + content: "\f00d"; } + +.fa-times::before { + content: "\f00d"; } + +.fa-arrows-up-down-left-right::before { + content: "\f047"; } + +.fa-arrows::before { + content: "\f047"; } + +.fa-chalkboard-user::before { + content: "\f51c"; } + +.fa-chalkboard-teacher::before { + content: "\f51c"; } + +.fa-peso-sign::before { + content: "\e222"; } + +.fa-building-shield::before { + content: "\e4d8"; } + +.fa-baby::before { + content: "\f77c"; } + +.fa-users-line::before { + content: "\e592"; } + +.fa-quote-left::before { + content: "\f10d"; } + +.fa-quote-left-alt::before { + content: "\f10d"; } + +.fa-tractor::before { + content: "\f722"; } + +.fa-trash-arrow-up::before { + content: "\f829"; } + +.fa-trash-restore::before { + content: "\f829"; } + +.fa-arrow-down-up-lock::before { + content: "\e4b0"; } + +.fa-lines-leaning::before { + content: "\e51e"; } + +.fa-ruler-combined::before { + content: "\f546"; } + +.fa-copyright::before { + content: "\f1f9"; } + +.fa-equals::before { + content: "\3d"; } + +.fa-blender::before { + content: "\f517"; } + +.fa-teeth::before { + content: "\f62e"; } + +.fa-shekel-sign::before { + content: "\f20b"; } + +.fa-ils::before { + content: "\f20b"; } + +.fa-shekel::before { + content: "\f20b"; } + +.fa-sheqel::before { + content: "\f20b"; } + +.fa-sheqel-sign::before { + content: "\f20b"; } + +.fa-map::before { + content: "\f279"; } + +.fa-rocket::before { + content: "\f135"; } + +.fa-photo-film::before { + content: "\f87c"; } + +.fa-photo-video::before { + content: "\f87c"; } + +.fa-folder-minus::before { + content: "\f65d"; } + +.fa-store::before { + content: "\f54e"; } + +.fa-arrow-trend-up::before { + content: "\e098"; } + +.fa-plug-circle-minus::before { + content: "\e55e"; } + +.fa-sign-hanging::before { + content: "\f4d9"; } + +.fa-sign::before { + content: "\f4d9"; } + +.fa-bezier-curve::before { + content: "\f55b"; } + +.fa-bell-slash::before { + content: "\f1f6"; } + +.fa-tablet::before { + content: "\f3fb"; } + +.fa-tablet-android::before { + content: "\f3fb"; } + +.fa-school-flag::before { + content: "\e56e"; } + +.fa-fill::before { + content: "\f575"; } + +.fa-angle-up::before { + content: "\f106"; } + +.fa-drumstick-bite::before { + content: "\f6d7"; } + +.fa-holly-berry::before { + content: "\f7aa"; } + +.fa-chevron-left::before { + content: "\f053"; } + +.fa-bacteria::before { + content: "\e059"; } + +.fa-hand-lizard::before { + content: "\f258"; } + +.fa-notdef::before { + content: "\e1fe"; } + +.fa-disease::before { + content: "\f7fa"; } + +.fa-briefcase-medical::before { + content: "\f469"; } + +.fa-genderless::before { + content: "\f22d"; } + +.fa-chevron-right::before { + content: "\f054"; } + +.fa-retweet::before { + content: "\f079"; } + +.fa-car-rear::before { + content: "\f5de"; } + +.fa-car-alt::before { + content: "\f5de"; } + +.fa-pump-soap::before { + content: "\e06b"; } + +.fa-video-slash::before { + content: "\f4e2"; } + +.fa-battery-quarter::before { + content: "\f243"; } + +.fa-battery-2::before { + content: "\f243"; } + +.fa-radio::before { + content: "\f8d7"; } + +.fa-baby-carriage::before { + content: "\f77d"; } + +.fa-carriage-baby::before { + content: "\f77d"; } + +.fa-traffic-light::before { + content: "\f637"; } + +.fa-thermometer::before { + content: "\f491"; } + +.fa-vr-cardboard::before { + content: "\f729"; } + +.fa-hand-middle-finger::before { + content: "\f806"; } + +.fa-percent::before { + content: "\25"; } + +.fa-percentage::before { + content: "\25"; } + +.fa-truck-moving::before { + content: "\f4df"; } + +.fa-glass-water-droplet::before { + content: "\e4f5"; } + +.fa-display::before { + content: "\e163"; } + +.fa-face-smile::before { + content: "\f118"; } + +.fa-smile::before { + content: "\f118"; } + +.fa-thumbtack::before { + content: "\f08d"; } + +.fa-thumb-tack::before { + content: "\f08d"; } + +.fa-trophy::before { + content: "\f091"; } + +.fa-person-praying::before { + content: "\f683"; } + +.fa-pray::before { + content: "\f683"; } + +.fa-hammer::before { + content: "\f6e3"; } + +.fa-hand-peace::before { + content: "\f25b"; } + +.fa-rotate::before { + content: "\f2f1"; } + +.fa-sync-alt::before { + content: "\f2f1"; } + +.fa-spinner::before { + content: "\f110"; } + +.fa-robot::before { + content: "\f544"; } + +.fa-peace::before { + content: "\f67c"; } + +.fa-gears::before { + content: "\f085"; } + +.fa-cogs::before { + content: "\f085"; } + +.fa-warehouse::before { + content: "\f494"; } + +.fa-arrow-up-right-dots::before { + content: "\e4b7"; } + +.fa-splotch::before { + content: "\f5bc"; } + +.fa-face-grin-hearts::before { + content: "\f584"; } + +.fa-grin-hearts::before { + content: "\f584"; } + +.fa-dice-four::before { + content: "\f524"; } + +.fa-sim-card::before { + content: "\f7c4"; } + +.fa-transgender::before { + content: "\f225"; } + +.fa-transgender-alt::before { + content: "\f225"; } + +.fa-mercury::before { + content: "\f223"; } + +.fa-arrow-turn-down::before { + content: "\f149"; } + +.fa-level-down::before { + content: "\f149"; } + +.fa-person-falling-burst::before { + content: "\e547"; } + +.fa-award::before { + content: "\f559"; } + +.fa-ticket-simple::before { + content: "\f3ff"; } + +.fa-ticket-alt::before { + content: "\f3ff"; } + +.fa-building::before { + content: "\f1ad"; } + +.fa-angles-left::before { + content: "\f100"; } + +.fa-angle-double-left::before { + content: "\f100"; } + +.fa-qrcode::before { + content: "\f029"; } + +.fa-clock-rotate-left::before { + content: "\f1da"; } + +.fa-history::before { + content: "\f1da"; } + +.fa-face-grin-beam-sweat::before { + content: "\f583"; } + +.fa-grin-beam-sweat::before { + content: "\f583"; } + +.fa-file-export::before { + content: "\f56e"; } + +.fa-arrow-right-from-file::before { + content: "\f56e"; } + +.fa-shield::before { + content: "\f132"; } + +.fa-shield-blank::before { + content: "\f132"; } + +.fa-arrow-up-short-wide::before { + content: "\f885"; } + +.fa-sort-amount-up-alt::before { + content: "\f885"; } + +.fa-house-medical::before { + content: "\e3b2"; } + +.fa-golf-ball-tee::before { + content: "\f450"; } + +.fa-golf-ball::before { + content: "\f450"; } + +.fa-circle-chevron-left::before { + content: "\f137"; } + +.fa-chevron-circle-left::before { + content: "\f137"; } + +.fa-house-chimney-window::before { + content: "\e00d"; } + +.fa-pen-nib::before { + content: "\f5ad"; } + +.fa-tent-arrow-turn-left::before { + content: "\e580"; } + +.fa-tents::before { + content: "\e582"; } + +.fa-wand-magic::before { + content: "\f0d0"; } + +.fa-magic::before { + content: "\f0d0"; } + +.fa-dog::before { + content: "\f6d3"; } + +.fa-carrot::before { + content: "\f787"; } + +.fa-moon::before { + content: "\f186"; } + +.fa-wine-glass-empty::before { + content: "\f5ce"; } + +.fa-wine-glass-alt::before { + content: "\f5ce"; } + +.fa-cheese::before { + content: "\f7ef"; } + +.fa-yin-yang::before { + content: "\f6ad"; } + +.fa-music::before { + content: "\f001"; } + +.fa-code-commit::before { + content: "\f386"; } + +.fa-temperature-low::before { + content: "\f76b"; } + +.fa-person-biking::before { + content: "\f84a"; } + +.fa-biking::before { + content: "\f84a"; } + +.fa-broom::before { + content: "\f51a"; } + +.fa-shield-heart::before { + content: "\e574"; } + +.fa-gopuram::before { + content: "\f664"; } + +.fa-earth-oceania::before { + content: "\e47b"; } + +.fa-globe-oceania::before { + content: "\e47b"; } + +.fa-square-xmark::before { + content: "\f2d3"; } + +.fa-times-square::before { + content: "\f2d3"; } + +.fa-xmark-square::before { + content: "\f2d3"; } + +.fa-hashtag::before { + content: "\23"; } + +.fa-up-right-and-down-left-from-center::before { + content: "\f424"; } + +.fa-expand-alt::before { + content: "\f424"; } + +.fa-oil-can::before { + content: "\f613"; } + +.fa-t::before { + content: "\54"; } + +.fa-hippo::before { + content: "\f6ed"; } + +.fa-chart-column::before { + content: "\e0e3"; } + +.fa-infinity::before { + content: "\f534"; } + +.fa-vial-circle-check::before { + content: "\e596"; } + +.fa-person-arrow-down-to-line::before { + content: "\e538"; } + +.fa-voicemail::before { + content: "\f897"; } + +.fa-fan::before { + content: "\f863"; } + +.fa-person-walking-luggage::before { + content: "\e554"; } + +.fa-up-down::before { + content: "\f338"; } + +.fa-arrows-alt-v::before { + content: "\f338"; } + +.fa-cloud-moon-rain::before { + content: "\f73c"; } + +.fa-calendar::before { + content: "\f133"; } + +.fa-trailer::before { + content: "\e041"; } + +.fa-bahai::before { + content: "\f666"; } + +.fa-haykal::before { + content: "\f666"; } + +.fa-sd-card::before { + content: "\f7c2"; } + +.fa-dragon::before { + content: "\f6d5"; } + +.fa-shoe-prints::before { + content: "\f54b"; } + +.fa-circle-plus::before { + content: "\f055"; } + +.fa-plus-circle::before { + content: "\f055"; } + +.fa-face-grin-tongue-wink::before { + content: "\f58b"; } + +.fa-grin-tongue-wink::before { + content: "\f58b"; } + +.fa-hand-holding::before { + content: "\f4bd"; } + +.fa-plug-circle-exclamation::before { + content: "\e55d"; } + +.fa-link-slash::before { + content: "\f127"; } + +.fa-chain-broken::before { + content: "\f127"; } + +.fa-chain-slash::before { + content: "\f127"; } + +.fa-unlink::before { + content: "\f127"; } + +.fa-clone::before { + content: "\f24d"; } + +.fa-person-walking-arrow-loop-left::before { + content: "\e551"; } + +.fa-arrow-up-z-a::before { + content: "\f882"; } + +.fa-sort-alpha-up-alt::before { + content: "\f882"; } + +.fa-fire-flame-curved::before { + content: "\f7e4"; } + +.fa-fire-alt::before { + content: "\f7e4"; } + +.fa-tornado::before { + content: "\f76f"; } + +.fa-file-circle-plus::before { + content: "\e494"; } + +.fa-book-quran::before { + content: "\f687"; } + +.fa-quran::before { + content: "\f687"; } + +.fa-anchor::before { + content: "\f13d"; } + +.fa-border-all::before { + content: "\f84c"; } + +.fa-face-angry::before { + content: "\f556"; } + +.fa-angry::before { + content: "\f556"; } + +.fa-cookie-bite::before { + content: "\f564"; } + +.fa-arrow-trend-down::before { + content: "\e097"; } + +.fa-rss::before { + content: "\f09e"; } + +.fa-feed::before { + content: "\f09e"; } + +.fa-draw-polygon::before { + content: "\f5ee"; } + +.fa-scale-balanced::before { + content: "\f24e"; } + +.fa-balance-scale::before { + content: "\f24e"; } + +.fa-gauge-simple-high::before { + content: "\f62a"; } + +.fa-tachometer::before { + content: "\f62a"; } + +.fa-tachometer-fast::before { + content: "\f62a"; } + +.fa-shower::before { + content: "\f2cc"; } + +.fa-desktop::before { + content: "\f390"; } + +.fa-desktop-alt::before { + content: "\f390"; } + +.fa-m::before { + content: "\4d"; } + +.fa-table-list::before { + content: "\f00b"; } + +.fa-th-list::before { + content: "\f00b"; } + +.fa-comment-sms::before { + content: "\f7cd"; } + +.fa-sms::before { + content: "\f7cd"; } + +.fa-book::before { + content: "\f02d"; } + +.fa-user-plus::before { + content: "\f234"; } + +.fa-check::before { + content: "\f00c"; } + +.fa-battery-three-quarters::before { + content: "\f241"; } + +.fa-battery-4::before { + content: "\f241"; } + +.fa-house-circle-check::before { + content: "\e509"; } + +.fa-angle-left::before { + content: "\f104"; } + +.fa-diagram-successor::before { + content: "\e47a"; } + +.fa-truck-arrow-right::before { + content: "\e58b"; } + +.fa-arrows-split-up-and-left::before { + content: "\e4bc"; } + +.fa-hand-fist::before { + content: "\f6de"; } + +.fa-fist-raised::before { + content: "\f6de"; } + +.fa-cloud-moon::before { + content: "\f6c3"; } + +.fa-briefcase::before { + content: "\f0b1"; } + +.fa-person-falling::before { + content: "\e546"; } + +.fa-image-portrait::before { + content: "\f3e0"; } + +.fa-portrait::before { + content: "\f3e0"; } + +.fa-user-tag::before { + content: "\f507"; } + +.fa-rug::before { + content: "\e569"; } + +.fa-earth-europe::before { + content: "\f7a2"; } + +.fa-globe-europe::before { + content: "\f7a2"; } + +.fa-cart-flatbed-suitcase::before { + content: "\f59d"; } + +.fa-luggage-cart::before { + content: "\f59d"; } + +.fa-rectangle-xmark::before { + content: "\f410"; } + +.fa-rectangle-times::before { + content: "\f410"; } + +.fa-times-rectangle::before { + content: "\f410"; } + +.fa-window-close::before { + content: "\f410"; } + +.fa-baht-sign::before { + content: "\e0ac"; } + +.fa-book-open::before { + content: "\f518"; } + +.fa-book-journal-whills::before { + content: "\f66a"; } + +.fa-journal-whills::before { + content: "\f66a"; } + +.fa-handcuffs::before { + content: "\e4f8"; } + +.fa-triangle-exclamation::before { + content: "\f071"; } + +.fa-exclamation-triangle::before { + content: "\f071"; } + +.fa-warning::before { + content: "\f071"; } + +.fa-database::before { + content: "\f1c0"; } + +.fa-share::before { + content: "\f064"; } + +.fa-mail-forward::before { + content: "\f064"; } + +.fa-bottle-droplet::before { + content: "\e4c4"; } + +.fa-mask-face::before { + content: "\e1d7"; } + +.fa-hill-rockslide::before { + content: "\e508"; } + +.fa-right-left::before { + content: "\f362"; } + +.fa-exchange-alt::before { + content: "\f362"; } + +.fa-paper-plane::before { + content: "\f1d8"; } + +.fa-road-circle-exclamation::before { + content: "\e565"; } + +.fa-dungeon::before { + content: "\f6d9"; } + +.fa-align-right::before { + content: "\f038"; } + +.fa-money-bill-1-wave::before { + content: "\f53b"; } + +.fa-money-bill-wave-alt::before { + content: "\f53b"; } + +.fa-life-ring::before { + content: "\f1cd"; } + +.fa-hands::before { + content: "\f2a7"; } + +.fa-sign-language::before { + content: "\f2a7"; } + +.fa-signing::before { + content: "\f2a7"; } + +.fa-calendar-day::before { + content: "\f783"; } + +.fa-water-ladder::before { + content: "\f5c5"; } + +.fa-ladder-water::before { + content: "\f5c5"; } + +.fa-swimming-pool::before { + content: "\f5c5"; } + +.fa-arrows-up-down::before { + content: "\f07d"; } + +.fa-arrows-v::before { + content: "\f07d"; } + +.fa-face-grimace::before { + content: "\f57f"; } + +.fa-grimace::before { + content: "\f57f"; } + +.fa-wheelchair-move::before { + content: "\e2ce"; } + +.fa-wheelchair-alt::before { + content: "\e2ce"; } + +.fa-turn-down::before { + content: "\f3be"; } + +.fa-level-down-alt::before { + content: "\f3be"; } + +.fa-person-walking-arrow-right::before { + content: "\e552"; } + +.fa-square-envelope::before { + content: "\f199"; } + +.fa-envelope-square::before { + content: "\f199"; } + +.fa-dice::before { + content: "\f522"; } + +.fa-bowling-ball::before { + content: "\f436"; } + +.fa-brain::before { + content: "\f5dc"; } + +.fa-bandage::before { + content: "\f462"; } + +.fa-band-aid::before { + content: "\f462"; } + +.fa-calendar-minus::before { + content: "\f272"; } + +.fa-circle-xmark::before { + content: "\f057"; } + +.fa-times-circle::before { + content: "\f057"; } + +.fa-xmark-circle::before { + content: "\f057"; } + +.fa-gifts::before { + content: "\f79c"; } + +.fa-hotel::before { + content: "\f594"; } + +.fa-earth-asia::before { + content: "\f57e"; } + +.fa-globe-asia::before { + content: "\f57e"; } + +.fa-id-card-clip::before { + content: "\f47f"; } + +.fa-id-card-alt::before { + content: "\f47f"; } + +.fa-magnifying-glass-plus::before { + content: "\f00e"; } + +.fa-search-plus::before { + content: "\f00e"; } + +.fa-thumbs-up::before { + content: "\f164"; } + +.fa-user-clock::before { + content: "\f4fd"; } + +.fa-hand-dots::before { + content: "\f461"; } + +.fa-allergies::before { + content: "\f461"; } + +.fa-file-invoice::before { + content: "\f570"; } + +.fa-window-minimize::before { + content: "\f2d1"; } + +.fa-mug-saucer::before { + content: "\f0f4"; } + +.fa-coffee::before { + content: "\f0f4"; } + +.fa-brush::before { + content: "\f55d"; } + +.fa-mask::before { + content: "\f6fa"; } + +.fa-magnifying-glass-minus::before { + content: "\f010"; } + +.fa-search-minus::before { + content: "\f010"; } + +.fa-ruler-vertical::before { + content: "\f548"; } + +.fa-user-large::before { + content: "\f406"; } + +.fa-user-alt::before { + content: "\f406"; } + +.fa-train-tram::before { + content: "\e5b4"; } + +.fa-user-nurse::before { + content: "\f82f"; } + +.fa-syringe::before { + content: "\f48e"; } + +.fa-cloud-sun::before { + content: "\f6c4"; } + +.fa-stopwatch-20::before { + content: "\e06f"; } + +.fa-square-full::before { + content: "\f45c"; } + +.fa-magnet::before { + content: "\f076"; } + +.fa-jar::before { + content: "\e516"; } + +.fa-note-sticky::before { + content: "\f249"; } + +.fa-sticky-note::before { + content: "\f249"; } + +.fa-bug-slash::before { + content: "\e490"; } + +.fa-arrow-up-from-water-pump::before { + content: "\e4b6"; } + +.fa-bone::before { + content: "\f5d7"; } + +.fa-user-injured::before { + content: "\f728"; } + +.fa-face-sad-tear::before { + content: "\f5b4"; } + +.fa-sad-tear::before { + content: "\f5b4"; } + +.fa-plane::before { + content: "\f072"; } + +.fa-tent-arrows-down::before { + content: "\e581"; } + +.fa-exclamation::before { + content: "\21"; } + +.fa-arrows-spin::before { + content: "\e4bb"; } + +.fa-print::before { + content: "\f02f"; } + +.fa-turkish-lira-sign::before { + content: "\e2bb"; } + +.fa-try::before { + content: "\e2bb"; } + +.fa-turkish-lira::before { + content: "\e2bb"; } + +.fa-dollar-sign::before { + content: "\24"; } + +.fa-dollar::before { + content: "\24"; } + +.fa-usd::before { + content: "\24"; } + +.fa-x::before { + content: "\58"; } + +.fa-magnifying-glass-dollar::before { + content: "\f688"; } + +.fa-search-dollar::before { + content: "\f688"; } + +.fa-users-gear::before { + content: "\f509"; } + +.fa-users-cog::before { + content: "\f509"; } + +.fa-person-military-pointing::before { + content: "\e54a"; } + +.fa-building-columns::before { + content: "\f19c"; } + +.fa-bank::before { + content: "\f19c"; } + +.fa-institution::before { + content: "\f19c"; } + +.fa-museum::before { + content: "\f19c"; } + +.fa-university::before { + content: "\f19c"; } + +.fa-umbrella::before { + content: "\f0e9"; } + +.fa-trowel::before { + content: "\e589"; } + +.fa-d::before { + content: "\44"; } + +.fa-stapler::before { + content: "\e5af"; } + +.fa-masks-theater::before { + content: "\f630"; } + +.fa-theater-masks::before { + content: "\f630"; } + +.fa-kip-sign::before { + content: "\e1c4"; } + +.fa-hand-point-left::before { + content: "\f0a5"; } + +.fa-handshake-simple::before { + content: "\f4c6"; } + +.fa-handshake-alt::before { + content: "\f4c6"; } + +.fa-jet-fighter::before { + content: "\f0fb"; } + +.fa-fighter-jet::before { + content: "\f0fb"; } + +.fa-square-share-nodes::before { + content: "\f1e1"; } + +.fa-share-alt-square::before { + content: "\f1e1"; } + +.fa-barcode::before { + content: "\f02a"; } + +.fa-plus-minus::before { + content: "\e43c"; } + +.fa-video::before { + content: "\f03d"; } + +.fa-video-camera::before { + content: "\f03d"; } + +.fa-graduation-cap::before { + content: "\f19d"; } + +.fa-mortar-board::before { + content: "\f19d"; } + +.fa-hand-holding-medical::before { + content: "\e05c"; } + +.fa-person-circle-check::before { + content: "\e53e"; } + +.fa-turn-up::before { + content: "\f3bf"; } + +.fa-level-up-alt::before { + content: "\f3bf"; } + +.sr-only, +.fa-sr-only { + position: absolute; + width: 1px; + height: 1px; + padding: 0; + margin: -1px; + overflow: hidden; + clip: rect(0, 0, 0, 0); + white-space: nowrap; + border-width: 0; } + +.sr-only-focusable:not(:focus), +.fa-sr-only-focusable:not(:focus) { + position: absolute; + width: 1px; + height: 1px; + padding: 0; + margin: -1px; + overflow: hidden; + clip: rect(0, 0, 0, 0); + white-space: nowrap; + border-width: 0; } +:root, :host { + --fa-style-family-brands: 'Font Awesome 6 Brands'; + --fa-font-brands: normal 400 1em/1 'Font Awesome 6 Brands'; } + +@font-face { + font-family: 'Font Awesome 6 Brands'; + font-style: normal; + font-weight: 400; + font-display: block; + src: url("../webfonts/fa-brands-400.woff2") format("woff2"), url("../webfonts/fa-brands-400.ttf") format("truetype"); } + +.fab, +.fa-brands { + font-weight: 400; } + +.fa-monero:before { + content: "\f3d0"; } + +.fa-hooli:before { + content: "\f427"; } + +.fa-yelp:before { + content: "\f1e9"; } + +.fa-cc-visa:before { + content: "\f1f0"; } + +.fa-lastfm:before { + content: "\f202"; } + +.fa-shopware:before { + content: "\f5b5"; } + +.fa-creative-commons-nc:before { + content: "\f4e8"; } + +.fa-aws:before { + content: "\f375"; } + +.fa-redhat:before { + content: "\f7bc"; } + +.fa-yoast:before { + content: "\f2b1"; } + +.fa-cloudflare:before { + content: "\e07d"; } + +.fa-ups:before { + content: "\f7e0"; } + +.fa-pixiv:before { + content: "\e640"; } + +.fa-wpexplorer:before { + content: "\f2de"; } + +.fa-dyalog:before { + content: "\f399"; } + +.fa-bity:before { + content: "\f37a"; } + +.fa-stackpath:before { + content: "\f842"; } + +.fa-buysellads:before { + content: "\f20d"; } + +.fa-first-order:before { + content: "\f2b0"; } + +.fa-modx:before { + content: "\f285"; } + +.fa-guilded:before { + content: "\e07e"; } + +.fa-vnv:before { + content: "\f40b"; } + +.fa-square-js:before { + content: "\f3b9"; } + +.fa-js-square:before { + content: "\f3b9"; } + +.fa-microsoft:before { + content: "\f3ca"; } + +.fa-qq:before { + content: "\f1d6"; } + +.fa-orcid:before { + content: "\f8d2"; } + +.fa-java:before { + content: "\f4e4"; } + +.fa-invision:before { + content: "\f7b0"; } + +.fa-creative-commons-pd-alt:before { + content: "\f4ed"; } + +.fa-centercode:before { + content: "\f380"; } + +.fa-glide-g:before { + content: "\f2a6"; } + +.fa-drupal:before { + content: "\f1a9"; } + +.fa-jxl:before { + content: "\e67b"; } + +.fa-hire-a-helper:before { + content: "\f3b0"; } + +.fa-creative-commons-by:before { + content: "\f4e7"; } + +.fa-unity:before { + content: "\e049"; } + +.fa-whmcs:before { + content: "\f40d"; } + +.fa-rocketchat:before { + content: "\f3e8"; } + +.fa-vk:before { + content: "\f189"; } + +.fa-untappd:before { + content: "\f405"; } + +.fa-mailchimp:before { + content: "\f59e"; } + +.fa-css3-alt:before { + content: "\f38b"; } + +.fa-square-reddit:before { + content: "\f1a2"; } + +.fa-reddit-square:before { + content: "\f1a2"; } + +.fa-vimeo-v:before { + content: "\f27d"; } + +.fa-contao:before { + content: "\f26d"; } + +.fa-square-font-awesome:before { + content: "\e5ad"; } + +.fa-deskpro:before { + content: "\f38f"; } + +.fa-brave:before { + content: "\e63c"; } + +.fa-sistrix:before { + content: "\f3ee"; } + +.fa-square-instagram:before { + content: "\e055"; } + +.fa-instagram-square:before { + content: "\e055"; } + +.fa-battle-net:before { + content: "\f835"; } + +.fa-the-red-yeti:before { + content: "\f69d"; } + +.fa-square-hacker-news:before { + content: "\f3af"; } + +.fa-hacker-news-square:before { + content: "\f3af"; } + +.fa-edge:before { + content: "\f282"; } + +.fa-threads:before { + content: "\e618"; } + +.fa-napster:before { + content: "\f3d2"; } + +.fa-square-snapchat:before { + content: "\f2ad"; } + +.fa-snapchat-square:before { + content: "\f2ad"; } + +.fa-google-plus-g:before { + content: "\f0d5"; } + +.fa-artstation:before { + content: "\f77a"; } + +.fa-markdown:before { + content: "\f60f"; } + +.fa-sourcetree:before { + content: "\f7d3"; } + +.fa-google-plus:before { + content: "\f2b3"; } + +.fa-diaspora:before { + content: "\f791"; } + +.fa-foursquare:before { + content: "\f180"; } + +.fa-stack-overflow:before { + content: "\f16c"; } + +.fa-github-alt:before { + content: "\f113"; } + +.fa-phoenix-squadron:before { + content: "\f511"; } + +.fa-pagelines:before { + content: "\f18c"; } + +.fa-algolia:before { + content: "\f36c"; } + +.fa-red-river:before { + content: "\f3e3"; } + +.fa-creative-commons-sa:before { + content: "\f4ef"; } + +.fa-safari:before { + content: "\f267"; } + +.fa-google:before { + content: "\f1a0"; } + +.fa-square-font-awesome-stroke:before { + content: "\f35c"; } + +.fa-font-awesome-alt:before { + content: "\f35c"; } + +.fa-atlassian:before { + content: "\f77b"; } + +.fa-linkedin-in:before { + content: "\f0e1"; } + +.fa-digital-ocean:before { + content: "\f391"; } + +.fa-nimblr:before { + content: "\f5a8"; } + +.fa-chromecast:before { + content: "\f838"; } + +.fa-evernote:before { + content: "\f839"; } + +.fa-hacker-news:before { + content: "\f1d4"; } + +.fa-creative-commons-sampling:before { + content: "\f4f0"; } + +.fa-adversal:before { + content: "\f36a"; } + +.fa-creative-commons:before { + content: "\f25e"; } + +.fa-watchman-monitoring:before { + content: "\e087"; } + +.fa-fonticons:before { + content: "\f280"; } + +.fa-weixin:before { + content: "\f1d7"; } + +.fa-shirtsinbulk:before { + content: "\f214"; } + +.fa-codepen:before { + content: "\f1cb"; } + +.fa-git-alt:before { + content: "\f841"; } + +.fa-lyft:before { + content: "\f3c3"; } + +.fa-rev:before { + content: "\f5b2"; } + +.fa-windows:before { + content: "\f17a"; } + +.fa-wizards-of-the-coast:before { + content: "\f730"; } + +.fa-square-viadeo:before { + content: "\f2aa"; } + +.fa-viadeo-square:before { + content: "\f2aa"; } + +.fa-meetup:before { + content: "\f2e0"; } + +.fa-centos:before { + content: "\f789"; } + +.fa-adn:before { + content: "\f170"; } + +.fa-cloudsmith:before { + content: "\f384"; } + +.fa-opensuse:before { + content: "\e62b"; } + +.fa-pied-piper-alt:before { + content: "\f1a8"; } + +.fa-square-dribbble:before { + content: "\f397"; } + +.fa-dribbble-square:before { + content: "\f397"; } + +.fa-codiepie:before { + content: "\f284"; } + +.fa-node:before { + content: "\f419"; } + +.fa-mix:before { + content: "\f3cb"; } + +.fa-steam:before { + content: "\f1b6"; } + +.fa-cc-apple-pay:before { + content: "\f416"; } + +.fa-scribd:before { + content: "\f28a"; } + +.fa-debian:before { + content: "\e60b"; } + +.fa-openid:before { + content: "\f19b"; } + +.fa-instalod:before { + content: "\e081"; } + +.fa-expeditedssl:before { + content: "\f23e"; } + +.fa-sellcast:before { + content: "\f2da"; } + +.fa-square-twitter:before { + content: "\f081"; } + +.fa-twitter-square:before { + content: "\f081"; } + +.fa-r-project:before { + content: "\f4f7"; } + +.fa-delicious:before { + content: "\f1a5"; } + +.fa-freebsd:before { + content: "\f3a4"; } + +.fa-vuejs:before { + content: "\f41f"; } + +.fa-accusoft:before { + content: "\f369"; } + +.fa-ioxhost:before { + content: "\f208"; } + +.fa-fonticons-fi:before { + content: "\f3a2"; } + +.fa-app-store:before { + content: "\f36f"; } + +.fa-cc-mastercard:before { + content: "\f1f1"; } + +.fa-itunes-note:before { + content: "\f3b5"; } + +.fa-golang:before { + content: "\e40f"; } + +.fa-kickstarter:before { + content: "\f3bb"; } + +.fa-square-kickstarter:before { + content: "\f3bb"; } + +.fa-grav:before { + content: "\f2d6"; } + +.fa-weibo:before { + content: "\f18a"; } + +.fa-uncharted:before { + content: "\e084"; } + +.fa-firstdraft:before { + content: "\f3a1"; } + +.fa-square-youtube:before { + content: "\f431"; } + +.fa-youtube-square:before { + content: "\f431"; } + +.fa-wikipedia-w:before { + content: "\f266"; } + +.fa-wpressr:before { + content: "\f3e4"; } + +.fa-rendact:before { + content: "\f3e4"; } + +.fa-angellist:before { + content: "\f209"; } + +.fa-galactic-republic:before { + content: "\f50c"; } + +.fa-nfc-directional:before { + content: "\e530"; } + +.fa-skype:before { + content: "\f17e"; } + +.fa-joget:before { + content: "\f3b7"; } + +.fa-fedora:before { + content: "\f798"; } + +.fa-stripe-s:before { + content: "\f42a"; } + +.fa-meta:before { + content: "\e49b"; } + +.fa-laravel:before { + content: "\f3bd"; } + +.fa-hotjar:before { + content: "\f3b1"; } + +.fa-bluetooth-b:before { + content: "\f294"; } + +.fa-square-letterboxd:before { + content: "\e62e"; } + +.fa-sticker-mule:before { + content: "\f3f7"; } + +.fa-creative-commons-zero:before { + content: "\f4f3"; } + +.fa-hips:before { + content: "\f452"; } + +.fa-behance:before { + content: "\f1b4"; } + +.fa-reddit:before { + content: "\f1a1"; } + +.fa-discord:before { + content: "\f392"; } + +.fa-chrome:before { + content: "\f268"; } + +.fa-app-store-ios:before { + content: "\f370"; } + +.fa-cc-discover:before { + content: "\f1f2"; } + +.fa-wpbeginner:before { + content: "\f297"; } + +.fa-confluence:before { + content: "\f78d"; } + +.fa-shoelace:before { + content: "\e60c"; } + +.fa-mdb:before { + content: "\f8ca"; } + +.fa-dochub:before { + content: "\f394"; } + +.fa-accessible-icon:before { + content: "\f368"; } + +.fa-ebay:before { + content: "\f4f4"; } + +.fa-amazon:before { + content: "\f270"; } + +.fa-unsplash:before { + content: "\e07c"; } + +.fa-yarn:before { + content: "\f7e3"; } + +.fa-square-steam:before { + content: "\f1b7"; } + +.fa-steam-square:before { + content: "\f1b7"; } + +.fa-500px:before { + content: "\f26e"; } + +.fa-square-vimeo:before { + content: "\f194"; } + +.fa-vimeo-square:before { + content: "\f194"; } + +.fa-asymmetrik:before { + content: "\f372"; } + +.fa-font-awesome:before { + content: "\f2b4"; } + +.fa-font-awesome-flag:before { + content: "\f2b4"; } + +.fa-font-awesome-logo-full:before { + content: "\f2b4"; } + +.fa-gratipay:before { + content: "\f184"; } + +.fa-apple:before { + content: "\f179"; } + +.fa-hive:before { + content: "\e07f"; } + +.fa-gitkraken:before { + content: "\f3a6"; } + +.fa-keybase:before { + content: "\f4f5"; } + +.fa-apple-pay:before { + content: "\f415"; } + +.fa-padlet:before { + content: "\e4a0"; } + +.fa-amazon-pay:before { + content: "\f42c"; } + +.fa-square-github:before { + content: "\f092"; } + +.fa-github-square:before { + content: "\f092"; } + +.fa-stumbleupon:before { + content: "\f1a4"; } + +.fa-fedex:before { + content: "\f797"; } + +.fa-phoenix-framework:before { + content: "\f3dc"; } + +.fa-shopify:before { + content: "\e057"; } + +.fa-neos:before { + content: "\f612"; } + +.fa-square-threads:before { + content: "\e619"; } + +.fa-hackerrank:before { + content: "\f5f7"; } + +.fa-researchgate:before { + content: "\f4f8"; } + +.fa-swift:before { + content: "\f8e1"; } + +.fa-angular:before { + content: "\f420"; } + +.fa-speakap:before { + content: "\f3f3"; } + +.fa-angrycreative:before { + content: "\f36e"; } + +.fa-y-combinator:before { + content: "\f23b"; } + +.fa-empire:before { + content: "\f1d1"; } + +.fa-envira:before { + content: "\f299"; } + +.fa-google-scholar:before { + content: "\e63b"; } + +.fa-square-gitlab:before { + content: "\e5ae"; } + +.fa-gitlab-square:before { + content: "\e5ae"; } + +.fa-studiovinari:before { + content: "\f3f8"; } + +.fa-pied-piper:before { + content: "\f2ae"; } + +.fa-wordpress:before { + content: "\f19a"; } + +.fa-product-hunt:before { + content: "\f288"; } + +.fa-firefox:before { + content: "\f269"; } + +.fa-linode:before { + content: "\f2b8"; } + +.fa-goodreads:before { + content: "\f3a8"; } + +.fa-square-odnoklassniki:before { + content: "\f264"; } + +.fa-odnoklassniki-square:before { + content: "\f264"; } + +.fa-jsfiddle:before { + content: "\f1cc"; } + +.fa-sith:before { + content: "\f512"; } + +.fa-themeisle:before { + content: "\f2b2"; } + +.fa-page4:before { + content: "\f3d7"; } + +.fa-hashnode:before { + content: "\e499"; } + +.fa-react:before { + content: "\f41b"; } + +.fa-cc-paypal:before { + content: "\f1f4"; } + +.fa-squarespace:before { + content: "\f5be"; } + +.fa-cc-stripe:before { + content: "\f1f5"; } + +.fa-creative-commons-share:before { + content: "\f4f2"; } + +.fa-bitcoin:before { + content: "\f379"; } + +.fa-keycdn:before { + content: "\f3ba"; } + +.fa-opera:before { + content: "\f26a"; } + +.fa-itch-io:before { + content: "\f83a"; } + +.fa-umbraco:before { + content: "\f8e8"; } + +.fa-galactic-senate:before { + content: "\f50d"; } + +.fa-ubuntu:before { + content: "\f7df"; } + +.fa-draft2digital:before { + content: "\f396"; } + +.fa-stripe:before { + content: "\f429"; } + +.fa-houzz:before { + content: "\f27c"; } + +.fa-gg:before { + content: "\f260"; } + +.fa-dhl:before { + content: "\f790"; } + +.fa-square-pinterest:before { + content: "\f0d3"; } + +.fa-pinterest-square:before { + content: "\f0d3"; } + +.fa-xing:before { + content: "\f168"; } + +.fa-blackberry:before { + content: "\f37b"; } + +.fa-creative-commons-pd:before { + content: "\f4ec"; } + +.fa-playstation:before { + content: "\f3df"; } + +.fa-quinscape:before { + content: "\f459"; } + +.fa-less:before { + content: "\f41d"; } + +.fa-blogger-b:before { + content: "\f37d"; } + +.fa-opencart:before { + content: "\f23d"; } + +.fa-vine:before { + content: "\f1ca"; } + +.fa-signal-messenger:before { + content: "\e663"; } + +.fa-paypal:before { + content: "\f1ed"; } + +.fa-gitlab:before { + content: "\f296"; } + +.fa-typo3:before { + content: "\f42b"; } + +.fa-reddit-alien:before { + content: "\f281"; } + +.fa-yahoo:before { + content: "\f19e"; } + +.fa-dailymotion:before { + content: "\e052"; } + +.fa-affiliatetheme:before { + content: "\f36b"; } + +.fa-pied-piper-pp:before { + content: "\f1a7"; } + +.fa-bootstrap:before { + content: "\f836"; } + +.fa-odnoklassniki:before { + content: "\f263"; } + +.fa-nfc-symbol:before { + content: "\e531"; } + +.fa-mintbit:before { + content: "\e62f"; } + +.fa-ethereum:before { + content: "\f42e"; } + +.fa-speaker-deck:before { + content: "\f83c"; } + +.fa-creative-commons-nc-eu:before { + content: "\f4e9"; } + +.fa-patreon:before { + content: "\f3d9"; } + +.fa-avianex:before { + content: "\f374"; } + +.fa-ello:before { + content: "\f5f1"; } + +.fa-gofore:before { + content: "\f3a7"; } + +.fa-bimobject:before { + content: "\f378"; } + +.fa-brave-reverse:before { + content: "\e63d"; } + +.fa-facebook-f:before { + content: "\f39e"; } + +.fa-square-google-plus:before { + content: "\f0d4"; } + +.fa-google-plus-square:before { + content: "\f0d4"; } + +.fa-web-awesome:before { + content: "\e682"; } + +.fa-mandalorian:before { + content: "\f50f"; } + +.fa-first-order-alt:before { + content: "\f50a"; } + +.fa-osi:before { + content: "\f41a"; } + +.fa-google-wallet:before { + content: "\f1ee"; } + +.fa-d-and-d-beyond:before { + content: "\f6ca"; } + +.fa-periscope:before { + content: "\f3da"; } + +.fa-fulcrum:before { + content: "\f50b"; } + +.fa-cloudscale:before { + content: "\f383"; } + +.fa-forumbee:before { + content: "\f211"; } + +.fa-mizuni:before { + content: "\f3cc"; } + +.fa-schlix:before { + content: "\f3ea"; } + +.fa-square-xing:before { + content: "\f169"; } + +.fa-xing-square:before { + content: "\f169"; } + +.fa-bandcamp:before { + content: "\f2d5"; } + +.fa-wpforms:before { + content: "\f298"; } + +.fa-cloudversify:before { + content: "\f385"; } + +.fa-usps:before { + content: "\f7e1"; } + +.fa-megaport:before { + content: "\f5a3"; } + +.fa-magento:before { + content: "\f3c4"; } + +.fa-spotify:before { + content: "\f1bc"; } + +.fa-optin-monster:before { + content: "\f23c"; } + +.fa-fly:before { + content: "\f417"; } + +.fa-aviato:before { + content: "\f421"; } + +.fa-itunes:before { + content: "\f3b4"; } + +.fa-cuttlefish:before { + content: "\f38c"; } + +.fa-blogger:before { + content: "\f37c"; } + +.fa-flickr:before { + content: "\f16e"; } + +.fa-viber:before { + content: "\f409"; } + +.fa-soundcloud:before { + content: "\f1be"; } + +.fa-digg:before { + content: "\f1a6"; } + +.fa-tencent-weibo:before { + content: "\f1d5"; } + +.fa-letterboxd:before { + content: "\e62d"; } + +.fa-symfony:before { + content: "\f83d"; } + +.fa-maxcdn:before { + content: "\f136"; } + +.fa-etsy:before { + content: "\f2d7"; } + +.fa-facebook-messenger:before { + content: "\f39f"; } + +.fa-audible:before { + content: "\f373"; } + +.fa-think-peaks:before { + content: "\f731"; } + +.fa-bilibili:before { + content: "\e3d9"; } + +.fa-erlang:before { + content: "\f39d"; } + +.fa-x-twitter:before { + content: "\e61b"; } + +.fa-cotton-bureau:before { + content: "\f89e"; } + +.fa-dashcube:before { + content: "\f210"; } + +.fa-42-group:before { + content: "\e080"; } + +.fa-innosoft:before { + content: "\e080"; } + +.fa-stack-exchange:before { + content: "\f18d"; } + +.fa-elementor:before { + content: "\f430"; } + +.fa-square-pied-piper:before { + content: "\e01e"; } + +.fa-pied-piper-square:before { + content: "\e01e"; } + +.fa-creative-commons-nd:before { + content: "\f4eb"; } + +.fa-palfed:before { + content: "\f3d8"; } + +.fa-superpowers:before { + content: "\f2dd"; } + +.fa-resolving:before { + content: "\f3e7"; } + +.fa-xbox:before { + content: "\f412"; } + +.fa-square-web-awesome-stroke:before { + content: "\e684"; } + +.fa-searchengin:before { + content: "\f3eb"; } + +.fa-tiktok:before { + content: "\e07b"; } + +.fa-square-facebook:before { + content: "\f082"; } + +.fa-facebook-square:before { + content: "\f082"; } + +.fa-renren:before { + content: "\f18b"; } + +.fa-linux:before { + content: "\f17c"; } + +.fa-glide:before { + content: "\f2a5"; } + +.fa-linkedin:before { + content: "\f08c"; } + +.fa-hubspot:before { + content: "\f3b2"; } + +.fa-deploydog:before { + content: "\f38e"; } + +.fa-twitch:before { + content: "\f1e8"; } + +.fa-ravelry:before { + content: "\f2d9"; } + +.fa-mixer:before { + content: "\e056"; } + +.fa-square-lastfm:before { + content: "\f203"; } + +.fa-lastfm-square:before { + content: "\f203"; } + +.fa-vimeo:before { + content: "\f40a"; } + +.fa-mendeley:before { + content: "\f7b3"; } + +.fa-uniregistry:before { + content: "\f404"; } + +.fa-figma:before { + content: "\f799"; } + +.fa-creative-commons-remix:before { + content: "\f4ee"; } + +.fa-cc-amazon-pay:before { + content: "\f42d"; } + +.fa-dropbox:before { + content: "\f16b"; } + +.fa-instagram:before { + content: "\f16d"; } + +.fa-cmplid:before { + content: "\e360"; } + +.fa-upwork:before { + content: "\e641"; } + +.fa-facebook:before { + content: "\f09a"; } + +.fa-gripfire:before { + content: "\f3ac"; } + +.fa-jedi-order:before { + content: "\f50e"; } + +.fa-uikit:before { + content: "\f403"; } + +.fa-fort-awesome-alt:before { + content: "\f3a3"; } + +.fa-phabricator:before { + content: "\f3db"; } + +.fa-ussunnah:before { + content: "\f407"; } + +.fa-earlybirds:before { + content: "\f39a"; } + +.fa-trade-federation:before { + content: "\f513"; } + +.fa-autoprefixer:before { + content: "\f41c"; } + +.fa-whatsapp:before { + content: "\f232"; } + +.fa-square-upwork:before { + content: "\e67c"; } + +.fa-slideshare:before { + content: "\f1e7"; } + +.fa-google-play:before { + content: "\f3ab"; } + +.fa-viadeo:before { + content: "\f2a9"; } + +.fa-line:before { + content: "\f3c0"; } + +.fa-google-drive:before { + content: "\f3aa"; } + +.fa-servicestack:before { + content: "\f3ec"; } + +.fa-simplybuilt:before { + content: "\f215"; } + +.fa-bitbucket:before { + content: "\f171"; } + +.fa-imdb:before { + content: "\f2d8"; } + +.fa-deezer:before { + content: "\e077"; } + +.fa-raspberry-pi:before { + content: "\f7bb"; } + +.fa-jira:before { + content: "\f7b1"; } + +.fa-docker:before { + content: "\f395"; } + +.fa-screenpal:before { + content: "\e570"; } + +.fa-bluetooth:before { + content: "\f293"; } + +.fa-gitter:before { + content: "\f426"; } + +.fa-d-and-d:before { + content: "\f38d"; } + +.fa-microblog:before { + content: "\e01a"; } + +.fa-cc-diners-club:before { + content: "\f24c"; } + +.fa-gg-circle:before { + content: "\f261"; } + +.fa-pied-piper-hat:before { + content: "\f4e5"; } + +.fa-kickstarter-k:before { + content: "\f3bc"; } + +.fa-yandex:before { + content: "\f413"; } + +.fa-readme:before { + content: "\f4d5"; } + +.fa-html5:before { + content: "\f13b"; } + +.fa-sellsy:before { + content: "\f213"; } + +.fa-square-web-awesome:before { + content: "\e683"; } + +.fa-sass:before { + content: "\f41e"; } + +.fa-wirsindhandwerk:before { + content: "\e2d0"; } + +.fa-wsh:before { + content: "\e2d0"; } + +.fa-buromobelexperte:before { + content: "\f37f"; } + +.fa-salesforce:before { + content: "\f83b"; } + +.fa-octopus-deploy:before { + content: "\e082"; } + +.fa-medapps:before { + content: "\f3c6"; } + +.fa-ns8:before { + content: "\f3d5"; } + +.fa-pinterest-p:before { + content: "\f231"; } + +.fa-apper:before { + content: "\f371"; } + +.fa-fort-awesome:before { + content: "\f286"; } + +.fa-waze:before { + content: "\f83f"; } + +.fa-bluesky:before { + content: "\e671"; } + +.fa-cc-jcb:before { + content: "\f24b"; } + +.fa-snapchat:before { + content: "\f2ab"; } + +.fa-snapchat-ghost:before { + content: "\f2ab"; } + +.fa-fantasy-flight-games:before { + content: "\f6dc"; } + +.fa-rust:before { + content: "\e07a"; } + +.fa-wix:before { + content: "\f5cf"; } + +.fa-square-behance:before { + content: "\f1b5"; } + +.fa-behance-square:before { + content: "\f1b5"; } + +.fa-supple:before { + content: "\f3f9"; } + +.fa-webflow:before { + content: "\e65c"; } + +.fa-rebel:before { + content: "\f1d0"; } + +.fa-css3:before { + content: "\f13c"; } + +.fa-staylinked:before { + content: "\f3f5"; } + +.fa-kaggle:before { + content: "\f5fa"; } + +.fa-space-awesome:before { + content: "\e5ac"; } + +.fa-deviantart:before { + content: "\f1bd"; } + +.fa-cpanel:before { + content: "\f388"; } + +.fa-goodreads-g:before { + content: "\f3a9"; } + +.fa-square-git:before { + content: "\f1d2"; } + +.fa-git-square:before { + content: "\f1d2"; } + +.fa-square-tumblr:before { + content: "\f174"; } + +.fa-tumblr-square:before { + content: "\f174"; } + +.fa-trello:before { + content: "\f181"; } + +.fa-creative-commons-nc-jp:before { + content: "\f4ea"; } + +.fa-get-pocket:before { + content: "\f265"; } + +.fa-perbyte:before { + content: "\e083"; } + +.fa-grunt:before { + content: "\f3ad"; } + +.fa-weebly:before { + content: "\f5cc"; } + +.fa-connectdevelop:before { + content: "\f20e"; } + +.fa-leanpub:before { + content: "\f212"; } + +.fa-black-tie:before { + content: "\f27e"; } + +.fa-themeco:before { + content: "\f5c6"; } + +.fa-python:before { + content: "\f3e2"; } + +.fa-android:before { + content: "\f17b"; } + +.fa-bots:before { + content: "\e340"; } + +.fa-free-code-camp:before { + content: "\f2c5"; } + +.fa-hornbill:before { + content: "\f592"; } + +.fa-js:before { + content: "\f3b8"; } + +.fa-ideal:before { + content: "\e013"; } + +.fa-git:before { + content: "\f1d3"; } + +.fa-dev:before { + content: "\f6cc"; } + +.fa-sketch:before { + content: "\f7c6"; } + +.fa-yandex-international:before { + content: "\f414"; } + +.fa-cc-amex:before { + content: "\f1f3"; } + +.fa-uber:before { + content: "\f402"; } + +.fa-github:before { + content: "\f09b"; } + +.fa-php:before { + content: "\f457"; } + +.fa-alipay:before { + content: "\f642"; } + +.fa-youtube:before { + content: "\f167"; } + +.fa-skyatlas:before { + content: "\f216"; } + +.fa-firefox-browser:before { + content: "\e007"; } + +.fa-replyd:before { + content: "\f3e6"; } + +.fa-suse:before { + content: "\f7d6"; } + +.fa-jenkins:before { + content: "\f3b6"; } + +.fa-twitter:before { + content: "\f099"; } + +.fa-rockrms:before { + content: "\f3e9"; } + +.fa-pinterest:before { + content: "\f0d2"; } + +.fa-buffer:before { + content: "\f837"; } + +.fa-npm:before { + content: "\f3d4"; } + +.fa-yammer:before { + content: "\f840"; } + +.fa-btc:before { + content: "\f15a"; } + +.fa-dribbble:before { + content: "\f17d"; } + +.fa-stumbleupon-circle:before { + content: "\f1a3"; } + +.fa-internet-explorer:before { + content: "\f26b"; } + +.fa-stubber:before { + content: "\e5c7"; } + +.fa-telegram:before { + content: "\f2c6"; } + +.fa-telegram-plane:before { + content: "\f2c6"; } + +.fa-old-republic:before { + content: "\f510"; } + +.fa-odysee:before { + content: "\e5c6"; } + +.fa-square-whatsapp:before { + content: "\f40c"; } + +.fa-whatsapp-square:before { + content: "\f40c"; } + +.fa-node-js:before { + content: "\f3d3"; } + +.fa-edge-legacy:before { + content: "\e078"; } + +.fa-slack:before { + content: "\f198"; } + +.fa-slack-hash:before { + content: "\f198"; } + +.fa-medrt:before { + content: "\f3c8"; } + +.fa-usb:before { + content: "\f287"; } + +.fa-tumblr:before { + content: "\f173"; } + +.fa-vaadin:before { + content: "\f408"; } + +.fa-quora:before { + content: "\f2c4"; } + +.fa-square-x-twitter:before { + content: "\e61a"; } + +.fa-reacteurope:before { + content: "\f75d"; } + +.fa-medium:before { + content: "\f23a"; } + +.fa-medium-m:before { + content: "\f23a"; } + +.fa-amilia:before { + content: "\f36d"; } + +.fa-mixcloud:before { + content: "\f289"; } + +.fa-flipboard:before { + content: "\f44d"; } + +.fa-viacoin:before { + content: "\f237"; } + +.fa-critical-role:before { + content: "\f6c9"; } + +.fa-sitrox:before { + content: "\e44a"; } + +.fa-discourse:before { + content: "\f393"; } + +.fa-joomla:before { + content: "\f1aa"; } + +.fa-mastodon:before { + content: "\f4f6"; } + +.fa-airbnb:before { + content: "\f834"; } + +.fa-wolf-pack-battalion:before { + content: "\f514"; } + +.fa-buy-n-large:before { + content: "\f8a6"; } + +.fa-gulp:before { + content: "\f3ae"; } + +.fa-creative-commons-sampling-plus:before { + content: "\f4f1"; } + +.fa-strava:before { + content: "\f428"; } + +.fa-ember:before { + content: "\f423"; } + +.fa-canadian-maple-leaf:before { + content: "\f785"; } + +.fa-teamspeak:before { + content: "\f4f9"; } + +.fa-pushed:before { + content: "\f3e1"; } + +.fa-wordpress-simple:before { + content: "\f411"; } + +.fa-nutritionix:before { + content: "\f3d6"; } + +.fa-wodu:before { + content: "\e088"; } + +.fa-google-pay:before { + content: "\e079"; } + +.fa-intercom:before { + content: "\f7af"; } + +.fa-zhihu:before { + content: "\f63f"; } + +.fa-korvue:before { + content: "\f42f"; } + +.fa-pix:before { + content: "\e43a"; } + +.fa-steam-symbol:before { + content: "\f3f6"; } +:root, :host { + --fa-style-family-classic: 'Font Awesome 6 Free'; + --fa-font-regular: normal 400 1em/1 'Font Awesome 6 Free'; } + +@font-face { + font-family: 'Font Awesome 6 Free'; + font-style: normal; + font-weight: 400; + font-display: block; + src: url("../webfonts/fa-regular-400.woff2") format("woff2"), url("../webfonts/fa-regular-400.ttf") format("truetype"); } + +.far, +.fa-regular { + font-weight: 400; } +:root, :host { + --fa-style-family-classic: 'Font Awesome 6 Free'; + --fa-font-solid: normal 900 1em/1 'Font Awesome 6 Free'; } + +@font-face { + font-family: 'Font Awesome 6 Free'; + font-style: normal; + font-weight: 900; + font-display: block; + src: url("../webfonts/fa-solid-900.woff2") format("woff2"), url("../webfonts/fa-solid-900.ttf") format("truetype"); } + +.fas, +.fa-solid { + font-weight: 900; } +@font-face { + font-family: 'Font Awesome 5 Brands'; + font-display: block; + font-weight: 400; + src: url("../webfonts/fa-brands-400.woff2") format("woff2"), url("../webfonts/fa-brands-400.ttf") format("truetype"); } + +@font-face { + font-family: 'Font Awesome 5 Free'; + font-display: block; + font-weight: 900; + src: url("../webfonts/fa-solid-900.woff2") format("woff2"), url("../webfonts/fa-solid-900.ttf") format("truetype"); } + +@font-face { + font-family: 'Font Awesome 5 Free'; + font-display: block; + font-weight: 400; + src: url("../webfonts/fa-regular-400.woff2") format("woff2"), url("../webfonts/fa-regular-400.ttf") format("truetype"); } +@font-face { + font-family: 'FontAwesome'; + font-display: block; + src: url("../webfonts/fa-solid-900.woff2") format("woff2"), url("../webfonts/fa-solid-900.ttf") format("truetype"); } + +@font-face { + font-family: 'FontAwesome'; + font-display: block; + src: url("../webfonts/fa-brands-400.woff2") format("woff2"), url("../webfonts/fa-brands-400.ttf") format("truetype"); } + +@font-face { + font-family: 'FontAwesome'; + font-display: block; + src: url("../webfonts/fa-regular-400.woff2") format("woff2"), url("../webfonts/fa-regular-400.ttf") format("truetype"); } + +@font-face { + font-family: 'FontAwesome'; + font-display: block; + src: url("../webfonts/fa-v4compatibility.woff2") format("woff2"), url("../webfonts/fa-v4compatibility.ttf") format("truetype"); } diff --git a/docs/deps/font-awesome-6.5.2/css/all.min.css b/docs/deps/font-awesome-6.5.2/css/all.min.css new file mode 100644 index 00000000..269bceea --- /dev/null +++ b/docs/deps/font-awesome-6.5.2/css/all.min.css @@ -0,0 +1,9 @@ +/*! + * Font Awesome Free 6.5.2 by @fontawesome - https://fontawesome.com + * License - https://fontawesome.com/license/free (Icons: CC BY 4.0, Fonts: SIL OFL 1.1, Code: MIT License) + * Copyright 2024 Fonticons, Inc. + */ +.fa{font-family:var(--fa-style-family,"Font Awesome 6 Free");font-weight:var(--fa-style,900)}.fa,.fa-brands,.fa-classic,.fa-regular,.fa-sharp,.fa-solid,.fab,.far,.fas{-moz-osx-font-smoothing:grayscale;-webkit-font-smoothing:antialiased;display:var(--fa-display,inline-block);font-style:normal;font-variant:normal;line-height:1;text-rendering:auto}.fa-classic,.fa-regular,.fa-solid,.far,.fas{font-family:"Font Awesome 6 Free"}.fa-brands,.fab{font-family:"Font Awesome 6 Brands"}.fa-1x{font-size:1em}.fa-2x{font-size:2em}.fa-3x{font-size:3em}.fa-4x{font-size:4em}.fa-5x{font-size:5em}.fa-6x{font-size:6em}.fa-7x{font-size:7em}.fa-8x{font-size:8em}.fa-9x{font-size:9em}.fa-10x{font-size:10em}.fa-2xs{font-size:.625em;line-height:.1em;vertical-align:.225em}.fa-xs{font-size:.75em;line-height:.08333em;vertical-align:.125em}.fa-sm{font-size:.875em;line-height:.07143em;vertical-align:.05357em}.fa-lg{font-size:1.25em;line-height:.05em;vertical-align:-.075em}.fa-xl{font-size:1.5em;line-height:.04167em;vertical-align:-.125em}.fa-2xl{font-size:2em;line-height:.03125em;vertical-align:-.1875em}.fa-fw{text-align:center;width:1.25em}.fa-ul{list-style-type:none;margin-left:var(--fa-li-margin,2.5em);padding-left:0}.fa-ul>li{position:relative}.fa-li{left:calc(var(--fa-li-width, 2em)*-1);position:absolute;text-align:center;width:var(--fa-li-width,2em);line-height:inherit}.fa-border{border-radius:var(--fa-border-radius,.1em);border:var(--fa-border-width,.08em) var(--fa-border-style,solid) var(--fa-border-color,#eee);padding:var(--fa-border-padding,.2em .25em .15em)}.fa-pull-left{float:left;margin-right:var(--fa-pull-margin,.3em)}.fa-pull-right{float:right;margin-left:var(--fa-pull-margin,.3em)}.fa-beat{-webkit-animation-name:fa-beat;animation-name:fa-beat;-webkit-animation-delay:var(--fa-animation-delay,0s);animation-delay:var(--fa-animation-delay,0s);-webkit-animation-direction:var(--fa-animation-direction,normal);animation-direction:var(--fa-animation-direction,normal);-webkit-animation-duration:var(--fa-animation-duration,1s);animation-duration:var(--fa-animation-duration,1s);-webkit-animation-iteration-count:var(--fa-animation-iteration-count,infinite);animation-iteration-count:var(--fa-animation-iteration-count,infinite);-webkit-animation-timing-function:var(--fa-animation-timing,ease-in-out);animation-timing-function:var(--fa-animation-timing,ease-in-out)}.fa-bounce{-webkit-animation-name:fa-bounce;animation-name:fa-bounce;-webkit-animation-delay:var(--fa-animation-delay,0s);animation-delay:var(--fa-animation-delay,0s);-webkit-animation-direction:var(--fa-animation-direction,normal);animation-direction:var(--fa-animation-direction,normal);-webkit-animation-duration:var(--fa-animation-duration,1s);animation-duration:var(--fa-animation-duration,1s);-webkit-animation-iteration-count:var(--fa-animation-iteration-count,infinite);animation-iteration-count:var(--fa-animation-iteration-count,infinite);-webkit-animation-timing-function:var(--fa-animation-timing,cubic-bezier(.28,.84,.42,1));animation-timing-function:var(--fa-animation-timing,cubic-bezier(.28,.84,.42,1))}.fa-fade{-webkit-animation-name:fa-fade;animation-name:fa-fade;-webkit-animation-iteration-count:var(--fa-animation-iteration-count,infinite);animation-iteration-count:var(--fa-animation-iteration-count,infinite);-webkit-animation-timing-function:var(--fa-animation-timing,cubic-bezier(.4,0,.6,1));animation-timing-function:var(--fa-animation-timing,cubic-bezier(.4,0,.6,1))}.fa-beat-fade,.fa-fade{-webkit-animation-delay:var(--fa-animation-delay,0s);animation-delay:var(--fa-animation-delay,0s);-webkit-animation-direction:var(--fa-animation-direction,normal);animation-direction:var(--fa-animation-direction,normal);-webkit-animation-duration:var(--fa-animation-duration,1s);animation-duration:var(--fa-animation-duration,1s)}.fa-beat-fade{-webkit-animation-name:fa-beat-fade;animation-name:fa-beat-fade;-webkit-animation-iteration-count:var(--fa-animation-iteration-count,infinite);animation-iteration-count:var(--fa-animation-iteration-count,infinite);-webkit-animation-timing-function:var(--fa-animation-timing,cubic-bezier(.4,0,.6,1));animation-timing-function:var(--fa-animation-timing,cubic-bezier(.4,0,.6,1))}.fa-flip{-webkit-animation-name:fa-flip;animation-name:fa-flip;-webkit-animation-delay:var(--fa-animation-delay,0s);animation-delay:var(--fa-animation-delay,0s);-webkit-animation-direction:var(--fa-animation-direction,normal);animation-direction:var(--fa-animation-direction,normal);-webkit-animation-duration:var(--fa-animation-duration,1s);animation-duration:var(--fa-animation-duration,1s);-webkit-animation-iteration-count:var(--fa-animation-iteration-count,infinite);animation-iteration-count:var(--fa-animation-iteration-count,infinite);-webkit-animation-timing-function:var(--fa-animation-timing,ease-in-out);animation-timing-function:var(--fa-animation-timing,ease-in-out)}.fa-shake{-webkit-animation-name:fa-shake;animation-name:fa-shake;-webkit-animation-duration:var(--fa-animation-duration,1s);animation-duration:var(--fa-animation-duration,1s);-webkit-animation-iteration-count:var(--fa-animation-iteration-count,infinite);animation-iteration-count:var(--fa-animation-iteration-count,infinite);-webkit-animation-timing-function:var(--fa-animation-timing,linear);animation-timing-function:var(--fa-animation-timing,linear)}.fa-shake,.fa-spin{-webkit-animation-delay:var(--fa-animation-delay,0s);animation-delay:var(--fa-animation-delay,0s);-webkit-animation-direction:var(--fa-animation-direction,normal);animation-direction:var(--fa-animation-direction,normal)}.fa-spin{-webkit-animation-name:fa-spin;animation-name:fa-spin;-webkit-animation-duration:var(--fa-animation-duration,2s);animation-duration:var(--fa-animation-duration,2s);-webkit-animation-iteration-count:var(--fa-animation-iteration-count,infinite);animation-iteration-count:var(--fa-animation-iteration-count,infinite);-webkit-animation-timing-function:var(--fa-animation-timing,linear);animation-timing-function:var(--fa-animation-timing,linear)}.fa-spin-reverse{--fa-animation-direction:reverse}.fa-pulse,.fa-spin-pulse{-webkit-animation-name:fa-spin;animation-name:fa-spin;-webkit-animation-direction:var(--fa-animation-direction,normal);animation-direction:var(--fa-animation-direction,normal);-webkit-animation-duration:var(--fa-animation-duration,1s);animation-duration:var(--fa-animation-duration,1s);-webkit-animation-iteration-count:var(--fa-animation-iteration-count,infinite);animation-iteration-count:var(--fa-animation-iteration-count,infinite);-webkit-animation-timing-function:var(--fa-animation-timing,steps(8));animation-timing-function:var(--fa-animation-timing,steps(8))}@media (prefers-reduced-motion:reduce){.fa-beat,.fa-beat-fade,.fa-bounce,.fa-fade,.fa-flip,.fa-pulse,.fa-shake,.fa-spin,.fa-spin-pulse{-webkit-animation-delay:-1ms;animation-delay:-1ms;-webkit-animation-duration:1ms;animation-duration:1ms;-webkit-animation-iteration-count:1;animation-iteration-count:1;-webkit-transition-delay:0s;transition-delay:0s;-webkit-transition-duration:0s;transition-duration:0s}}@-webkit-keyframes fa-beat{0%,90%{-webkit-transform:scale(1);transform:scale(1)}45%{-webkit-transform:scale(var(--fa-beat-scale,1.25));transform:scale(var(--fa-beat-scale,1.25))}}@keyframes fa-beat{0%,90%{-webkit-transform:scale(1);transform:scale(1)}45%{-webkit-transform:scale(var(--fa-beat-scale,1.25));transform:scale(var(--fa-beat-scale,1.25))}}@-webkit-keyframes fa-bounce{0%{-webkit-transform:scale(1) translateY(0);transform:scale(1) translateY(0)}10%{-webkit-transform:scale(var(--fa-bounce-start-scale-x,1.1),var(--fa-bounce-start-scale-y,.9)) translateY(0);transform:scale(var(--fa-bounce-start-scale-x,1.1),var(--fa-bounce-start-scale-y,.9)) translateY(0)}30%{-webkit-transform:scale(var(--fa-bounce-jump-scale-x,.9),var(--fa-bounce-jump-scale-y,1.1)) translateY(var(--fa-bounce-height,-.5em));transform:scale(var(--fa-bounce-jump-scale-x,.9),var(--fa-bounce-jump-scale-y,1.1)) translateY(var(--fa-bounce-height,-.5em))}50%{-webkit-transform:scale(var(--fa-bounce-land-scale-x,1.05),var(--fa-bounce-land-scale-y,.95)) translateY(0);transform:scale(var(--fa-bounce-land-scale-x,1.05),var(--fa-bounce-land-scale-y,.95)) translateY(0)}57%{-webkit-transform:scale(1) translateY(var(--fa-bounce-rebound,-.125em));transform:scale(1) translateY(var(--fa-bounce-rebound,-.125em))}64%{-webkit-transform:scale(1) translateY(0);transform:scale(1) translateY(0)}to{-webkit-transform:scale(1) translateY(0);transform:scale(1) translateY(0)}}@keyframes fa-bounce{0%{-webkit-transform:scale(1) translateY(0);transform:scale(1) translateY(0)}10%{-webkit-transform:scale(var(--fa-bounce-start-scale-x,1.1),var(--fa-bounce-start-scale-y,.9)) translateY(0);transform:scale(var(--fa-bounce-start-scale-x,1.1),var(--fa-bounce-start-scale-y,.9)) translateY(0)}30%{-webkit-transform:scale(var(--fa-bounce-jump-scale-x,.9),var(--fa-bounce-jump-scale-y,1.1)) translateY(var(--fa-bounce-height,-.5em));transform:scale(var(--fa-bounce-jump-scale-x,.9),var(--fa-bounce-jump-scale-y,1.1)) translateY(var(--fa-bounce-height,-.5em))}50%{-webkit-transform:scale(var(--fa-bounce-land-scale-x,1.05),var(--fa-bounce-land-scale-y,.95)) translateY(0);transform:scale(var(--fa-bounce-land-scale-x,1.05),var(--fa-bounce-land-scale-y,.95)) translateY(0)}57%{-webkit-transform:scale(1) translateY(var(--fa-bounce-rebound,-.125em));transform:scale(1) translateY(var(--fa-bounce-rebound,-.125em))}64%{-webkit-transform:scale(1) translateY(0);transform:scale(1) translateY(0)}to{-webkit-transform:scale(1) translateY(0);transform:scale(1) translateY(0)}}@-webkit-keyframes fa-fade{50%{opacity:var(--fa-fade-opacity,.4)}}@keyframes fa-fade{50%{opacity:var(--fa-fade-opacity,.4)}}@-webkit-keyframes fa-beat-fade{0%,to{opacity:var(--fa-beat-fade-opacity,.4);-webkit-transform:scale(1);transform:scale(1)}50%{opacity:1;-webkit-transform:scale(var(--fa-beat-fade-scale,1.125));transform:scale(var(--fa-beat-fade-scale,1.125))}}@keyframes fa-beat-fade{0%,to{opacity:var(--fa-beat-fade-opacity,.4);-webkit-transform:scale(1);transform:scale(1)}50%{opacity:1;-webkit-transform:scale(var(--fa-beat-fade-scale,1.125));transform:scale(var(--fa-beat-fade-scale,1.125))}}@-webkit-keyframes fa-flip{50%{-webkit-transform:rotate3d(var(--fa-flip-x,0),var(--fa-flip-y,1),var(--fa-flip-z,0),var(--fa-flip-angle,-180deg));transform:rotate3d(var(--fa-flip-x,0),var(--fa-flip-y,1),var(--fa-flip-z,0),var(--fa-flip-angle,-180deg))}}@keyframes fa-flip{50%{-webkit-transform:rotate3d(var(--fa-flip-x,0),var(--fa-flip-y,1),var(--fa-flip-z,0),var(--fa-flip-angle,-180deg));transform:rotate3d(var(--fa-flip-x,0),var(--fa-flip-y,1),var(--fa-flip-z,0),var(--fa-flip-angle,-180deg))}}@-webkit-keyframes fa-shake{0%{-webkit-transform:rotate(-15deg);transform:rotate(-15deg)}4%{-webkit-transform:rotate(15deg);transform:rotate(15deg)}8%,24%{-webkit-transform:rotate(-18deg);transform:rotate(-18deg)}12%,28%{-webkit-transform:rotate(18deg);transform:rotate(18deg)}16%{-webkit-transform:rotate(-22deg);transform:rotate(-22deg)}20%{-webkit-transform:rotate(22deg);transform:rotate(22deg)}32%{-webkit-transform:rotate(-12deg);transform:rotate(-12deg)}36%{-webkit-transform:rotate(12deg);transform:rotate(12deg)}40%,to{-webkit-transform:rotate(0deg);transform:rotate(0deg)}}@keyframes fa-shake{0%{-webkit-transform:rotate(-15deg);transform:rotate(-15deg)}4%{-webkit-transform:rotate(15deg);transform:rotate(15deg)}8%,24%{-webkit-transform:rotate(-18deg);transform:rotate(-18deg)}12%,28%{-webkit-transform:rotate(18deg);transform:rotate(18deg)}16%{-webkit-transform:rotate(-22deg);transform:rotate(-22deg)}20%{-webkit-transform:rotate(22deg);transform:rotate(22deg)}32%{-webkit-transform:rotate(-12deg);transform:rotate(-12deg)}36%{-webkit-transform:rotate(12deg);transform:rotate(12deg)}40%,to{-webkit-transform:rotate(0deg);transform:rotate(0deg)}}@-webkit-keyframes fa-spin{0%{-webkit-transform:rotate(0deg);transform:rotate(0deg)}to{-webkit-transform:rotate(1turn);transform:rotate(1turn)}}@keyframes fa-spin{0%{-webkit-transform:rotate(0deg);transform:rotate(0deg)}to{-webkit-transform:rotate(1turn);transform:rotate(1turn)}}.fa-rotate-90{-webkit-transform:rotate(90deg);transform:rotate(90deg)}.fa-rotate-180{-webkit-transform:rotate(180deg);transform:rotate(180deg)}.fa-rotate-270{-webkit-transform:rotate(270deg);transform:rotate(270deg)}.fa-flip-horizontal{-webkit-transform:scaleX(-1);transform:scaleX(-1)}.fa-flip-vertical{-webkit-transform:scaleY(-1);transform:scaleY(-1)}.fa-flip-both,.fa-flip-horizontal.fa-flip-vertical{-webkit-transform:scale(-1);transform:scale(-1)}.fa-rotate-by{-webkit-transform:rotate(var(--fa-rotate-angle,0));transform:rotate(var(--fa-rotate-angle,0))}.fa-stack{display:inline-block;height:2em;line-height:2em;position:relative;vertical-align:middle;width:2.5em}.fa-stack-1x,.fa-stack-2x{left:0;position:absolute;text-align:center;width:100%;z-index:var(--fa-stack-z-index,auto)}.fa-stack-1x{line-height:inherit}.fa-stack-2x{font-size:2em}.fa-inverse{color:var(--fa-inverse,#fff)} + +.fa-0:before{content:"\30"}.fa-1:before{content:"\31"}.fa-2:before{content:"\32"}.fa-3:before{content:"\33"}.fa-4:before{content:"\34"}.fa-5:before{content:"\35"}.fa-6:before{content:"\36"}.fa-7:before{content:"\37"}.fa-8:before{content:"\38"}.fa-9:before{content:"\39"}.fa-fill-drip:before{content:"\f576"}.fa-arrows-to-circle:before{content:"\e4bd"}.fa-chevron-circle-right:before,.fa-circle-chevron-right:before{content:"\f138"}.fa-at:before{content:"\40"}.fa-trash-alt:before,.fa-trash-can:before{content:"\f2ed"}.fa-text-height:before{content:"\f034"}.fa-user-times:before,.fa-user-xmark:before{content:"\f235"}.fa-stethoscope:before{content:"\f0f1"}.fa-comment-alt:before,.fa-message:before{content:"\f27a"}.fa-info:before{content:"\f129"}.fa-compress-alt:before,.fa-down-left-and-up-right-to-center:before{content:"\f422"}.fa-explosion:before{content:"\e4e9"}.fa-file-alt:before,.fa-file-lines:before,.fa-file-text:before{content:"\f15c"}.fa-wave-square:before{content:"\f83e"}.fa-ring:before{content:"\f70b"}.fa-building-un:before{content:"\e4d9"}.fa-dice-three:before{content:"\f527"}.fa-calendar-alt:before,.fa-calendar-days:before{content:"\f073"}.fa-anchor-circle-check:before{content:"\e4aa"}.fa-building-circle-arrow-right:before{content:"\e4d1"}.fa-volleyball-ball:before,.fa-volleyball:before{content:"\f45f"}.fa-arrows-up-to-line:before{content:"\e4c2"}.fa-sort-desc:before,.fa-sort-down:before{content:"\f0dd"}.fa-circle-minus:before,.fa-minus-circle:before{content:"\f056"}.fa-door-open:before{content:"\f52b"}.fa-right-from-bracket:before,.fa-sign-out-alt:before{content:"\f2f5"}.fa-atom:before{content:"\f5d2"}.fa-soap:before{content:"\e06e"}.fa-heart-music-camera-bolt:before,.fa-icons:before{content:"\f86d"}.fa-microphone-alt-slash:before,.fa-microphone-lines-slash:before{content:"\f539"}.fa-bridge-circle-check:before{content:"\e4c9"}.fa-pump-medical:before{content:"\e06a"}.fa-fingerprint:before{content:"\f577"}.fa-hand-point-right:before{content:"\f0a4"}.fa-magnifying-glass-location:before,.fa-search-location:before{content:"\f689"}.fa-forward-step:before,.fa-step-forward:before{content:"\f051"}.fa-face-smile-beam:before,.fa-smile-beam:before{content:"\f5b8"}.fa-flag-checkered:before{content:"\f11e"}.fa-football-ball:before,.fa-football:before{content:"\f44e"}.fa-school-circle-exclamation:before{content:"\e56c"}.fa-crop:before{content:"\f125"}.fa-angle-double-down:before,.fa-angles-down:before{content:"\f103"}.fa-users-rectangle:before{content:"\e594"}.fa-people-roof:before{content:"\e537"}.fa-people-line:before{content:"\e534"}.fa-beer-mug-empty:before,.fa-beer:before{content:"\f0fc"}.fa-diagram-predecessor:before{content:"\e477"}.fa-arrow-up-long:before,.fa-long-arrow-up:before{content:"\f176"}.fa-burn:before,.fa-fire-flame-simple:before{content:"\f46a"}.fa-male:before,.fa-person:before{content:"\f183"}.fa-laptop:before{content:"\f109"}.fa-file-csv:before{content:"\f6dd"}.fa-menorah:before{content:"\f676"}.fa-truck-plane:before{content:"\e58f"}.fa-record-vinyl:before{content:"\f8d9"}.fa-face-grin-stars:before,.fa-grin-stars:before{content:"\f587"}.fa-bong:before{content:"\f55c"}.fa-pastafarianism:before,.fa-spaghetti-monster-flying:before{content:"\f67b"}.fa-arrow-down-up-across-line:before{content:"\e4af"}.fa-spoon:before,.fa-utensil-spoon:before{content:"\f2e5"}.fa-jar-wheat:before{content:"\e517"}.fa-envelopes-bulk:before,.fa-mail-bulk:before{content:"\f674"}.fa-file-circle-exclamation:before{content:"\e4eb"}.fa-circle-h:before,.fa-hospital-symbol:before{content:"\f47e"}.fa-pager:before{content:"\f815"}.fa-address-book:before,.fa-contact-book:before{content:"\f2b9"}.fa-strikethrough:before{content:"\f0cc"}.fa-k:before{content:"\4b"}.fa-landmark-flag:before{content:"\e51c"}.fa-pencil-alt:before,.fa-pencil:before{content:"\f303"}.fa-backward:before{content:"\f04a"}.fa-caret-right:before{content:"\f0da"}.fa-comments:before{content:"\f086"}.fa-file-clipboard:before,.fa-paste:before{content:"\f0ea"}.fa-code-pull-request:before{content:"\e13c"}.fa-clipboard-list:before{content:"\f46d"}.fa-truck-loading:before,.fa-truck-ramp-box:before{content:"\f4de"}.fa-user-check:before{content:"\f4fc"}.fa-vial-virus:before{content:"\e597"}.fa-sheet-plastic:before{content:"\e571"}.fa-blog:before{content:"\f781"}.fa-user-ninja:before{content:"\f504"}.fa-person-arrow-up-from-line:before{content:"\e539"}.fa-scroll-torah:before,.fa-torah:before{content:"\f6a0"}.fa-broom-ball:before,.fa-quidditch-broom-ball:before,.fa-quidditch:before{content:"\f458"}.fa-toggle-off:before{content:"\f204"}.fa-archive:before,.fa-box-archive:before{content:"\f187"}.fa-person-drowning:before{content:"\e545"}.fa-arrow-down-9-1:before,.fa-sort-numeric-desc:before,.fa-sort-numeric-down-alt:before{content:"\f886"}.fa-face-grin-tongue-squint:before,.fa-grin-tongue-squint:before{content:"\f58a"}.fa-spray-can:before{content:"\f5bd"}.fa-truck-monster:before{content:"\f63b"}.fa-w:before{content:"\57"}.fa-earth-africa:before,.fa-globe-africa:before{content:"\f57c"}.fa-rainbow:before{content:"\f75b"}.fa-circle-notch:before{content:"\f1ce"}.fa-tablet-alt:before,.fa-tablet-screen-button:before{content:"\f3fa"}.fa-paw:before{content:"\f1b0"}.fa-cloud:before{content:"\f0c2"}.fa-trowel-bricks:before{content:"\e58a"}.fa-face-flushed:before,.fa-flushed:before{content:"\f579"}.fa-hospital-user:before{content:"\f80d"}.fa-tent-arrow-left-right:before{content:"\e57f"}.fa-gavel:before,.fa-legal:before{content:"\f0e3"}.fa-binoculars:before{content:"\f1e5"}.fa-microphone-slash:before{content:"\f131"}.fa-box-tissue:before{content:"\e05b"}.fa-motorcycle:before{content:"\f21c"}.fa-bell-concierge:before,.fa-concierge-bell:before{content:"\f562"}.fa-pen-ruler:before,.fa-pencil-ruler:before{content:"\f5ae"}.fa-people-arrows-left-right:before,.fa-people-arrows:before{content:"\e068"}.fa-mars-and-venus-burst:before{content:"\e523"}.fa-caret-square-right:before,.fa-square-caret-right:before{content:"\f152"}.fa-cut:before,.fa-scissors:before{content:"\f0c4"}.fa-sun-plant-wilt:before{content:"\e57a"}.fa-toilets-portable:before{content:"\e584"}.fa-hockey-puck:before{content:"\f453"}.fa-table:before{content:"\f0ce"}.fa-magnifying-glass-arrow-right:before{content:"\e521"}.fa-digital-tachograph:before,.fa-tachograph-digital:before{content:"\f566"}.fa-users-slash:before{content:"\e073"}.fa-clover:before{content:"\e139"}.fa-mail-reply:before,.fa-reply:before{content:"\f3e5"}.fa-star-and-crescent:before{content:"\f699"}.fa-house-fire:before{content:"\e50c"}.fa-minus-square:before,.fa-square-minus:before{content:"\f146"}.fa-helicopter:before{content:"\f533"}.fa-compass:before{content:"\f14e"}.fa-caret-square-down:before,.fa-square-caret-down:before{content:"\f150"}.fa-file-circle-question:before{content:"\e4ef"}.fa-laptop-code:before{content:"\f5fc"}.fa-swatchbook:before{content:"\f5c3"}.fa-prescription-bottle:before{content:"\f485"}.fa-bars:before,.fa-navicon:before{content:"\f0c9"}.fa-people-group:before{content:"\e533"}.fa-hourglass-3:before,.fa-hourglass-end:before{content:"\f253"}.fa-heart-broken:before,.fa-heart-crack:before{content:"\f7a9"}.fa-external-link-square-alt:before,.fa-square-up-right:before{content:"\f360"}.fa-face-kiss-beam:before,.fa-kiss-beam:before{content:"\f597"}.fa-film:before{content:"\f008"}.fa-ruler-horizontal:before{content:"\f547"}.fa-people-robbery:before{content:"\e536"}.fa-lightbulb:before{content:"\f0eb"}.fa-caret-left:before{content:"\f0d9"}.fa-circle-exclamation:before,.fa-exclamation-circle:before{content:"\f06a"}.fa-school-circle-xmark:before{content:"\e56d"}.fa-arrow-right-from-bracket:before,.fa-sign-out:before{content:"\f08b"}.fa-chevron-circle-down:before,.fa-circle-chevron-down:before{content:"\f13a"}.fa-unlock-alt:before,.fa-unlock-keyhole:before{content:"\f13e"}.fa-cloud-showers-heavy:before{content:"\f740"}.fa-headphones-alt:before,.fa-headphones-simple:before{content:"\f58f"}.fa-sitemap:before{content:"\f0e8"}.fa-circle-dollar-to-slot:before,.fa-donate:before{content:"\f4b9"}.fa-memory:before{content:"\f538"}.fa-road-spikes:before{content:"\e568"}.fa-fire-burner:before{content:"\e4f1"}.fa-flag:before{content:"\f024"}.fa-hanukiah:before{content:"\f6e6"}.fa-feather:before{content:"\f52d"}.fa-volume-down:before,.fa-volume-low:before{content:"\f027"}.fa-comment-slash:before{content:"\f4b3"}.fa-cloud-sun-rain:before{content:"\f743"}.fa-compress:before{content:"\f066"}.fa-wheat-alt:before,.fa-wheat-awn:before{content:"\e2cd"}.fa-ankh:before{content:"\f644"}.fa-hands-holding-child:before{content:"\e4fa"}.fa-asterisk:before{content:"\2a"}.fa-check-square:before,.fa-square-check:before{content:"\f14a"}.fa-peseta-sign:before{content:"\e221"}.fa-header:before,.fa-heading:before{content:"\f1dc"}.fa-ghost:before{content:"\f6e2"}.fa-list-squares:before,.fa-list:before{content:"\f03a"}.fa-phone-square-alt:before,.fa-square-phone-flip:before{content:"\f87b"}.fa-cart-plus:before{content:"\f217"}.fa-gamepad:before{content:"\f11b"}.fa-circle-dot:before,.fa-dot-circle:before{content:"\f192"}.fa-dizzy:before,.fa-face-dizzy:before{content:"\f567"}.fa-egg:before{content:"\f7fb"}.fa-house-medical-circle-xmark:before{content:"\e513"}.fa-campground:before{content:"\f6bb"}.fa-folder-plus:before{content:"\f65e"}.fa-futbol-ball:before,.fa-futbol:before,.fa-soccer-ball:before{content:"\f1e3"}.fa-paint-brush:before,.fa-paintbrush:before{content:"\f1fc"}.fa-lock:before{content:"\f023"}.fa-gas-pump:before{content:"\f52f"}.fa-hot-tub-person:before,.fa-hot-tub:before{content:"\f593"}.fa-map-location:before,.fa-map-marked:before{content:"\f59f"}.fa-house-flood-water:before{content:"\e50e"}.fa-tree:before{content:"\f1bb"}.fa-bridge-lock:before{content:"\e4cc"}.fa-sack-dollar:before{content:"\f81d"}.fa-edit:before,.fa-pen-to-square:before{content:"\f044"}.fa-car-side:before{content:"\f5e4"}.fa-share-alt:before,.fa-share-nodes:before{content:"\f1e0"}.fa-heart-circle-minus:before{content:"\e4ff"}.fa-hourglass-2:before,.fa-hourglass-half:before{content:"\f252"}.fa-microscope:before{content:"\f610"}.fa-sink:before{content:"\e06d"}.fa-bag-shopping:before,.fa-shopping-bag:before{content:"\f290"}.fa-arrow-down-z-a:before,.fa-sort-alpha-desc:before,.fa-sort-alpha-down-alt:before{content:"\f881"}.fa-mitten:before{content:"\f7b5"}.fa-person-rays:before{content:"\e54d"}.fa-users:before{content:"\f0c0"}.fa-eye-slash:before{content:"\f070"}.fa-flask-vial:before{content:"\e4f3"}.fa-hand-paper:before,.fa-hand:before{content:"\f256"}.fa-om:before{content:"\f679"}.fa-worm:before{content:"\e599"}.fa-house-circle-xmark:before{content:"\e50b"}.fa-plug:before{content:"\f1e6"}.fa-chevron-up:before{content:"\f077"}.fa-hand-spock:before{content:"\f259"}.fa-stopwatch:before{content:"\f2f2"}.fa-face-kiss:before,.fa-kiss:before{content:"\f596"}.fa-bridge-circle-xmark:before{content:"\e4cb"}.fa-face-grin-tongue:before,.fa-grin-tongue:before{content:"\f589"}.fa-chess-bishop:before{content:"\f43a"}.fa-face-grin-wink:before,.fa-grin-wink:before{content:"\f58c"}.fa-deaf:before,.fa-deafness:before,.fa-ear-deaf:before,.fa-hard-of-hearing:before{content:"\f2a4"}.fa-road-circle-check:before{content:"\e564"}.fa-dice-five:before{content:"\f523"}.fa-rss-square:before,.fa-square-rss:before{content:"\f143"}.fa-land-mine-on:before{content:"\e51b"}.fa-i-cursor:before{content:"\f246"}.fa-stamp:before{content:"\f5bf"}.fa-stairs:before{content:"\e289"}.fa-i:before{content:"\49"}.fa-hryvnia-sign:before,.fa-hryvnia:before{content:"\f6f2"}.fa-pills:before{content:"\f484"}.fa-face-grin-wide:before,.fa-grin-alt:before{content:"\f581"}.fa-tooth:before{content:"\f5c9"}.fa-v:before{content:"\56"}.fa-bangladeshi-taka-sign:before{content:"\e2e6"}.fa-bicycle:before{content:"\f206"}.fa-rod-asclepius:before,.fa-rod-snake:before,.fa-staff-aesculapius:before,.fa-staff-snake:before{content:"\e579"}.fa-head-side-cough-slash:before{content:"\e062"}.fa-ambulance:before,.fa-truck-medical:before{content:"\f0f9"}.fa-wheat-awn-circle-exclamation:before{content:"\e598"}.fa-snowman:before{content:"\f7d0"}.fa-mortar-pestle:before{content:"\f5a7"}.fa-road-barrier:before{content:"\e562"}.fa-school:before{content:"\f549"}.fa-igloo:before{content:"\f7ae"}.fa-joint:before{content:"\f595"}.fa-angle-right:before{content:"\f105"}.fa-horse:before{content:"\f6f0"}.fa-q:before{content:"\51"}.fa-g:before{content:"\47"}.fa-notes-medical:before{content:"\f481"}.fa-temperature-2:before,.fa-temperature-half:before,.fa-thermometer-2:before,.fa-thermometer-half:before{content:"\f2c9"}.fa-dong-sign:before{content:"\e169"}.fa-capsules:before{content:"\f46b"}.fa-poo-bolt:before,.fa-poo-storm:before{content:"\f75a"}.fa-face-frown-open:before,.fa-frown-open:before{content:"\f57a"}.fa-hand-point-up:before{content:"\f0a6"}.fa-money-bill:before{content:"\f0d6"}.fa-bookmark:before{content:"\f02e"}.fa-align-justify:before{content:"\f039"}.fa-umbrella-beach:before{content:"\f5ca"}.fa-helmet-un:before{content:"\e503"}.fa-bullseye:before{content:"\f140"}.fa-bacon:before{content:"\f7e5"}.fa-hand-point-down:before{content:"\f0a7"}.fa-arrow-up-from-bracket:before{content:"\e09a"}.fa-folder-blank:before,.fa-folder:before{content:"\f07b"}.fa-file-medical-alt:before,.fa-file-waveform:before{content:"\f478"}.fa-radiation:before{content:"\f7b9"}.fa-chart-simple:before{content:"\e473"}.fa-mars-stroke:before{content:"\f229"}.fa-vial:before{content:"\f492"}.fa-dashboard:before,.fa-gauge-med:before,.fa-gauge:before,.fa-tachometer-alt-average:before{content:"\f624"}.fa-magic-wand-sparkles:before,.fa-wand-magic-sparkles:before{content:"\e2ca"}.fa-e:before{content:"\45"}.fa-pen-alt:before,.fa-pen-clip:before{content:"\f305"}.fa-bridge-circle-exclamation:before{content:"\e4ca"}.fa-user:before{content:"\f007"}.fa-school-circle-check:before{content:"\e56b"}.fa-dumpster:before{content:"\f793"}.fa-shuttle-van:before,.fa-van-shuttle:before{content:"\f5b6"}.fa-building-user:before{content:"\e4da"}.fa-caret-square-left:before,.fa-square-caret-left:before{content:"\f191"}.fa-highlighter:before{content:"\f591"}.fa-key:before{content:"\f084"}.fa-bullhorn:before{content:"\f0a1"}.fa-globe:before{content:"\f0ac"}.fa-synagogue:before{content:"\f69b"}.fa-person-half-dress:before{content:"\e548"}.fa-road-bridge:before{content:"\e563"}.fa-location-arrow:before{content:"\f124"}.fa-c:before{content:"\43"}.fa-tablet-button:before{content:"\f10a"}.fa-building-lock:before{content:"\e4d6"}.fa-pizza-slice:before{content:"\f818"}.fa-money-bill-wave:before{content:"\f53a"}.fa-area-chart:before,.fa-chart-area:before{content:"\f1fe"}.fa-house-flag:before{content:"\e50d"}.fa-person-circle-minus:before{content:"\e540"}.fa-ban:before,.fa-cancel:before{content:"\f05e"}.fa-camera-rotate:before{content:"\e0d8"}.fa-air-freshener:before,.fa-spray-can-sparkles:before{content:"\f5d0"}.fa-star:before{content:"\f005"}.fa-repeat:before{content:"\f363"}.fa-cross:before{content:"\f654"}.fa-box:before{content:"\f466"}.fa-venus-mars:before{content:"\f228"}.fa-arrow-pointer:before,.fa-mouse-pointer:before{content:"\f245"}.fa-expand-arrows-alt:before,.fa-maximize:before{content:"\f31e"}.fa-charging-station:before{content:"\f5e7"}.fa-shapes:before,.fa-triangle-circle-square:before{content:"\f61f"}.fa-random:before,.fa-shuffle:before{content:"\f074"}.fa-person-running:before,.fa-running:before{content:"\f70c"}.fa-mobile-retro:before{content:"\e527"}.fa-grip-lines-vertical:before{content:"\f7a5"}.fa-spider:before{content:"\f717"}.fa-hands-bound:before{content:"\e4f9"}.fa-file-invoice-dollar:before{content:"\f571"}.fa-plane-circle-exclamation:before{content:"\e556"}.fa-x-ray:before{content:"\f497"}.fa-spell-check:before{content:"\f891"}.fa-slash:before{content:"\f715"}.fa-computer-mouse:before,.fa-mouse:before{content:"\f8cc"}.fa-arrow-right-to-bracket:before,.fa-sign-in:before{content:"\f090"}.fa-shop-slash:before,.fa-store-alt-slash:before{content:"\e070"}.fa-server:before{content:"\f233"}.fa-virus-covid-slash:before{content:"\e4a9"}.fa-shop-lock:before{content:"\e4a5"}.fa-hourglass-1:before,.fa-hourglass-start:before{content:"\f251"}.fa-blender-phone:before{content:"\f6b6"}.fa-building-wheat:before{content:"\e4db"}.fa-person-breastfeeding:before{content:"\e53a"}.fa-right-to-bracket:before,.fa-sign-in-alt:before{content:"\f2f6"}.fa-venus:before{content:"\f221"}.fa-passport:before{content:"\f5ab"}.fa-heart-pulse:before,.fa-heartbeat:before{content:"\f21e"}.fa-people-carry-box:before,.fa-people-carry:before{content:"\f4ce"}.fa-temperature-high:before{content:"\f769"}.fa-microchip:before{content:"\f2db"}.fa-crown:before{content:"\f521"}.fa-weight-hanging:before{content:"\f5cd"}.fa-xmarks-lines:before{content:"\e59a"}.fa-file-prescription:before{content:"\f572"}.fa-weight-scale:before,.fa-weight:before{content:"\f496"}.fa-user-friends:before,.fa-user-group:before{content:"\f500"}.fa-arrow-up-a-z:before,.fa-sort-alpha-up:before{content:"\f15e"}.fa-chess-knight:before{content:"\f441"}.fa-face-laugh-squint:before,.fa-laugh-squint:before{content:"\f59b"}.fa-wheelchair:before{content:"\f193"}.fa-arrow-circle-up:before,.fa-circle-arrow-up:before{content:"\f0aa"}.fa-toggle-on:before{content:"\f205"}.fa-person-walking:before,.fa-walking:before{content:"\f554"}.fa-l:before{content:"\4c"}.fa-fire:before{content:"\f06d"}.fa-bed-pulse:before,.fa-procedures:before{content:"\f487"}.fa-shuttle-space:before,.fa-space-shuttle:before{content:"\f197"}.fa-face-laugh:before,.fa-laugh:before{content:"\f599"}.fa-folder-open:before{content:"\f07c"}.fa-heart-circle-plus:before{content:"\e500"}.fa-code-fork:before{content:"\e13b"}.fa-city:before{content:"\f64f"}.fa-microphone-alt:before,.fa-microphone-lines:before{content:"\f3c9"}.fa-pepper-hot:before{content:"\f816"}.fa-unlock:before{content:"\f09c"}.fa-colon-sign:before{content:"\e140"}.fa-headset:before{content:"\f590"}.fa-store-slash:before{content:"\e071"}.fa-road-circle-xmark:before{content:"\e566"}.fa-user-minus:before{content:"\f503"}.fa-mars-stroke-up:before,.fa-mars-stroke-v:before{content:"\f22a"}.fa-champagne-glasses:before,.fa-glass-cheers:before{content:"\f79f"}.fa-clipboard:before{content:"\f328"}.fa-house-circle-exclamation:before{content:"\e50a"}.fa-file-arrow-up:before,.fa-file-upload:before{content:"\f574"}.fa-wifi-3:before,.fa-wifi-strong:before,.fa-wifi:before{content:"\f1eb"}.fa-bath:before,.fa-bathtub:before{content:"\f2cd"}.fa-underline:before{content:"\f0cd"}.fa-user-edit:before,.fa-user-pen:before{content:"\f4ff"}.fa-signature:before{content:"\f5b7"}.fa-stroopwafel:before{content:"\f551"}.fa-bold:before{content:"\f032"}.fa-anchor-lock:before{content:"\e4ad"}.fa-building-ngo:before{content:"\e4d7"}.fa-manat-sign:before{content:"\e1d5"}.fa-not-equal:before{content:"\f53e"}.fa-border-style:before,.fa-border-top-left:before{content:"\f853"}.fa-map-location-dot:before,.fa-map-marked-alt:before{content:"\f5a0"}.fa-jedi:before{content:"\f669"}.fa-poll:before,.fa-square-poll-vertical:before{content:"\f681"}.fa-mug-hot:before{content:"\f7b6"}.fa-battery-car:before,.fa-car-battery:before{content:"\f5df"}.fa-gift:before{content:"\f06b"}.fa-dice-two:before{content:"\f528"}.fa-chess-queen:before{content:"\f445"}.fa-glasses:before{content:"\f530"}.fa-chess-board:before{content:"\f43c"}.fa-building-circle-check:before{content:"\e4d2"}.fa-person-chalkboard:before{content:"\e53d"}.fa-mars-stroke-h:before,.fa-mars-stroke-right:before{content:"\f22b"}.fa-hand-back-fist:before,.fa-hand-rock:before{content:"\f255"}.fa-caret-square-up:before,.fa-square-caret-up:before{content:"\f151"}.fa-cloud-showers-water:before{content:"\e4e4"}.fa-bar-chart:before,.fa-chart-bar:before{content:"\f080"}.fa-hands-bubbles:before,.fa-hands-wash:before{content:"\e05e"}.fa-less-than-equal:before{content:"\f537"}.fa-train:before{content:"\f238"}.fa-eye-low-vision:before,.fa-low-vision:before{content:"\f2a8"}.fa-crow:before{content:"\f520"}.fa-sailboat:before{content:"\e445"}.fa-window-restore:before{content:"\f2d2"}.fa-plus-square:before,.fa-square-plus:before{content:"\f0fe"}.fa-torii-gate:before{content:"\f6a1"}.fa-frog:before{content:"\f52e"}.fa-bucket:before{content:"\e4cf"}.fa-image:before{content:"\f03e"}.fa-microphone:before{content:"\f130"}.fa-cow:before{content:"\f6c8"}.fa-caret-up:before{content:"\f0d8"}.fa-screwdriver:before{content:"\f54a"}.fa-folder-closed:before{content:"\e185"}.fa-house-tsunami:before{content:"\e515"}.fa-square-nfi:before{content:"\e576"}.fa-arrow-up-from-ground-water:before{content:"\e4b5"}.fa-glass-martini-alt:before,.fa-martini-glass:before{content:"\f57b"}.fa-rotate-back:before,.fa-rotate-backward:before,.fa-rotate-left:before,.fa-undo-alt:before{content:"\f2ea"}.fa-columns:before,.fa-table-columns:before{content:"\f0db"}.fa-lemon:before{content:"\f094"}.fa-head-side-mask:before{content:"\e063"}.fa-handshake:before{content:"\f2b5"}.fa-gem:before{content:"\f3a5"}.fa-dolly-box:before,.fa-dolly:before{content:"\f472"}.fa-smoking:before{content:"\f48d"}.fa-compress-arrows-alt:before,.fa-minimize:before{content:"\f78c"}.fa-monument:before{content:"\f5a6"}.fa-snowplow:before{content:"\f7d2"}.fa-angle-double-right:before,.fa-angles-right:before{content:"\f101"}.fa-cannabis:before{content:"\f55f"}.fa-circle-play:before,.fa-play-circle:before{content:"\f144"}.fa-tablets:before{content:"\f490"}.fa-ethernet:before{content:"\f796"}.fa-eur:before,.fa-euro-sign:before,.fa-euro:before{content:"\f153"}.fa-chair:before{content:"\f6c0"}.fa-check-circle:before,.fa-circle-check:before{content:"\f058"}.fa-circle-stop:before,.fa-stop-circle:before{content:"\f28d"}.fa-compass-drafting:before,.fa-drafting-compass:before{content:"\f568"}.fa-plate-wheat:before{content:"\e55a"}.fa-icicles:before{content:"\f7ad"}.fa-person-shelter:before{content:"\e54f"}.fa-neuter:before{content:"\f22c"}.fa-id-badge:before{content:"\f2c1"}.fa-marker:before{content:"\f5a1"}.fa-face-laugh-beam:before,.fa-laugh-beam:before{content:"\f59a"}.fa-helicopter-symbol:before{content:"\e502"}.fa-universal-access:before{content:"\f29a"}.fa-chevron-circle-up:before,.fa-circle-chevron-up:before{content:"\f139"}.fa-lari-sign:before{content:"\e1c8"}.fa-volcano:before{content:"\f770"}.fa-person-walking-dashed-line-arrow-right:before{content:"\e553"}.fa-gbp:before,.fa-pound-sign:before,.fa-sterling-sign:before{content:"\f154"}.fa-viruses:before{content:"\e076"}.fa-square-person-confined:before{content:"\e577"}.fa-user-tie:before{content:"\f508"}.fa-arrow-down-long:before,.fa-long-arrow-down:before{content:"\f175"}.fa-tent-arrow-down-to-line:before{content:"\e57e"}.fa-certificate:before{content:"\f0a3"}.fa-mail-reply-all:before,.fa-reply-all:before{content:"\f122"}.fa-suitcase:before{content:"\f0f2"}.fa-person-skating:before,.fa-skating:before{content:"\f7c5"}.fa-filter-circle-dollar:before,.fa-funnel-dollar:before{content:"\f662"}.fa-camera-retro:before{content:"\f083"}.fa-arrow-circle-down:before,.fa-circle-arrow-down:before{content:"\f0ab"}.fa-arrow-right-to-file:before,.fa-file-import:before{content:"\f56f"}.fa-external-link-square:before,.fa-square-arrow-up-right:before{content:"\f14c"}.fa-box-open:before{content:"\f49e"}.fa-scroll:before{content:"\f70e"}.fa-spa:before{content:"\f5bb"}.fa-location-pin-lock:before{content:"\e51f"}.fa-pause:before{content:"\f04c"}.fa-hill-avalanche:before{content:"\e507"}.fa-temperature-0:before,.fa-temperature-empty:before,.fa-thermometer-0:before,.fa-thermometer-empty:before{content:"\f2cb"}.fa-bomb:before{content:"\f1e2"}.fa-registered:before{content:"\f25d"}.fa-address-card:before,.fa-contact-card:before,.fa-vcard:before{content:"\f2bb"}.fa-balance-scale-right:before,.fa-scale-unbalanced-flip:before{content:"\f516"}.fa-subscript:before{content:"\f12c"}.fa-diamond-turn-right:before,.fa-directions:before{content:"\f5eb"}.fa-burst:before{content:"\e4dc"}.fa-house-laptop:before,.fa-laptop-house:before{content:"\e066"}.fa-face-tired:before,.fa-tired:before{content:"\f5c8"}.fa-money-bills:before{content:"\e1f3"}.fa-smog:before{content:"\f75f"}.fa-crutch:before{content:"\f7f7"}.fa-cloud-arrow-up:before,.fa-cloud-upload-alt:before,.fa-cloud-upload:before{content:"\f0ee"}.fa-palette:before{content:"\f53f"}.fa-arrows-turn-right:before{content:"\e4c0"}.fa-vest:before{content:"\e085"}.fa-ferry:before{content:"\e4ea"}.fa-arrows-down-to-people:before{content:"\e4b9"}.fa-seedling:before,.fa-sprout:before{content:"\f4d8"}.fa-arrows-alt-h:before,.fa-left-right:before{content:"\f337"}.fa-boxes-packing:before{content:"\e4c7"}.fa-arrow-circle-left:before,.fa-circle-arrow-left:before{content:"\f0a8"}.fa-group-arrows-rotate:before{content:"\e4f6"}.fa-bowl-food:before{content:"\e4c6"}.fa-candy-cane:before{content:"\f786"}.fa-arrow-down-wide-short:before,.fa-sort-amount-asc:before,.fa-sort-amount-down:before{content:"\f160"}.fa-cloud-bolt:before,.fa-thunderstorm:before{content:"\f76c"}.fa-remove-format:before,.fa-text-slash:before{content:"\f87d"}.fa-face-smile-wink:before,.fa-smile-wink:before{content:"\f4da"}.fa-file-word:before{content:"\f1c2"}.fa-file-powerpoint:before{content:"\f1c4"}.fa-arrows-h:before,.fa-arrows-left-right:before{content:"\f07e"}.fa-house-lock:before{content:"\e510"}.fa-cloud-arrow-down:before,.fa-cloud-download-alt:before,.fa-cloud-download:before{content:"\f0ed"}.fa-children:before{content:"\e4e1"}.fa-blackboard:before,.fa-chalkboard:before{content:"\f51b"}.fa-user-alt-slash:before,.fa-user-large-slash:before{content:"\f4fa"}.fa-envelope-open:before{content:"\f2b6"}.fa-handshake-alt-slash:before,.fa-handshake-simple-slash:before{content:"\e05f"}.fa-mattress-pillow:before{content:"\e525"}.fa-guarani-sign:before{content:"\e19a"}.fa-arrows-rotate:before,.fa-refresh:before,.fa-sync:before{content:"\f021"}.fa-fire-extinguisher:before{content:"\f134"}.fa-cruzeiro-sign:before{content:"\e152"}.fa-greater-than-equal:before{content:"\f532"}.fa-shield-alt:before,.fa-shield-halved:before{content:"\f3ed"}.fa-atlas:before,.fa-book-atlas:before{content:"\f558"}.fa-virus:before{content:"\e074"}.fa-envelope-circle-check:before{content:"\e4e8"}.fa-layer-group:before{content:"\f5fd"}.fa-arrows-to-dot:before{content:"\e4be"}.fa-archway:before{content:"\f557"}.fa-heart-circle-check:before{content:"\e4fd"}.fa-house-chimney-crack:before,.fa-house-damage:before{content:"\f6f1"}.fa-file-archive:before,.fa-file-zipper:before{content:"\f1c6"}.fa-square:before{content:"\f0c8"}.fa-glass-martini:before,.fa-martini-glass-empty:before{content:"\f000"}.fa-couch:before{content:"\f4b8"}.fa-cedi-sign:before{content:"\e0df"}.fa-italic:before{content:"\f033"}.fa-table-cells-column-lock:before{content:"\e678"}.fa-church:before{content:"\f51d"}.fa-comments-dollar:before{content:"\f653"}.fa-democrat:before{content:"\f747"}.fa-z:before{content:"\5a"}.fa-person-skiing:before,.fa-skiing:before{content:"\f7c9"}.fa-road-lock:before{content:"\e567"}.fa-a:before{content:"\41"}.fa-temperature-arrow-down:before,.fa-temperature-down:before{content:"\e03f"}.fa-feather-alt:before,.fa-feather-pointed:before{content:"\f56b"}.fa-p:before{content:"\50"}.fa-snowflake:before{content:"\f2dc"}.fa-newspaper:before{content:"\f1ea"}.fa-ad:before,.fa-rectangle-ad:before{content:"\f641"}.fa-arrow-circle-right:before,.fa-circle-arrow-right:before{content:"\f0a9"}.fa-filter-circle-xmark:before{content:"\e17b"}.fa-locust:before{content:"\e520"}.fa-sort:before,.fa-unsorted:before{content:"\f0dc"}.fa-list-1-2:before,.fa-list-numeric:before,.fa-list-ol:before{content:"\f0cb"}.fa-person-dress-burst:before{content:"\e544"}.fa-money-check-alt:before,.fa-money-check-dollar:before{content:"\f53d"}.fa-vector-square:before{content:"\f5cb"}.fa-bread-slice:before{content:"\f7ec"}.fa-language:before{content:"\f1ab"}.fa-face-kiss-wink-heart:before,.fa-kiss-wink-heart:before{content:"\f598"}.fa-filter:before{content:"\f0b0"}.fa-question:before{content:"\3f"}.fa-file-signature:before{content:"\f573"}.fa-arrows-alt:before,.fa-up-down-left-right:before{content:"\f0b2"}.fa-house-chimney-user:before{content:"\e065"}.fa-hand-holding-heart:before{content:"\f4be"}.fa-puzzle-piece:before{content:"\f12e"}.fa-money-check:before{content:"\f53c"}.fa-star-half-alt:before,.fa-star-half-stroke:before{content:"\f5c0"}.fa-code:before{content:"\f121"}.fa-glass-whiskey:before,.fa-whiskey-glass:before{content:"\f7a0"}.fa-building-circle-exclamation:before{content:"\e4d3"}.fa-magnifying-glass-chart:before{content:"\e522"}.fa-arrow-up-right-from-square:before,.fa-external-link:before{content:"\f08e"}.fa-cubes-stacked:before{content:"\e4e6"}.fa-krw:before,.fa-won-sign:before,.fa-won:before{content:"\f159"}.fa-virus-covid:before{content:"\e4a8"}.fa-austral-sign:before{content:"\e0a9"}.fa-f:before{content:"\46"}.fa-leaf:before{content:"\f06c"}.fa-road:before{content:"\f018"}.fa-cab:before,.fa-taxi:before{content:"\f1ba"}.fa-person-circle-plus:before{content:"\e541"}.fa-chart-pie:before,.fa-pie-chart:before{content:"\f200"}.fa-bolt-lightning:before{content:"\e0b7"}.fa-sack-xmark:before{content:"\e56a"}.fa-file-excel:before{content:"\f1c3"}.fa-file-contract:before{content:"\f56c"}.fa-fish-fins:before{content:"\e4f2"}.fa-building-flag:before{content:"\e4d5"}.fa-face-grin-beam:before,.fa-grin-beam:before{content:"\f582"}.fa-object-ungroup:before{content:"\f248"}.fa-poop:before{content:"\f619"}.fa-location-pin:before,.fa-map-marker:before{content:"\f041"}.fa-kaaba:before{content:"\f66b"}.fa-toilet-paper:before{content:"\f71e"}.fa-hard-hat:before,.fa-hat-hard:before,.fa-helmet-safety:before{content:"\f807"}.fa-eject:before{content:"\f052"}.fa-arrow-alt-circle-right:before,.fa-circle-right:before{content:"\f35a"}.fa-plane-circle-check:before{content:"\e555"}.fa-face-rolling-eyes:before,.fa-meh-rolling-eyes:before{content:"\f5a5"}.fa-object-group:before{content:"\f247"}.fa-chart-line:before,.fa-line-chart:before{content:"\f201"}.fa-mask-ventilator:before{content:"\e524"}.fa-arrow-right:before{content:"\f061"}.fa-map-signs:before,.fa-signs-post:before{content:"\f277"}.fa-cash-register:before{content:"\f788"}.fa-person-circle-question:before{content:"\e542"}.fa-h:before{content:"\48"}.fa-tarp:before{content:"\e57b"}.fa-screwdriver-wrench:before,.fa-tools:before{content:"\f7d9"}.fa-arrows-to-eye:before{content:"\e4bf"}.fa-plug-circle-bolt:before{content:"\e55b"}.fa-heart:before{content:"\f004"}.fa-mars-and-venus:before{content:"\f224"}.fa-home-user:before,.fa-house-user:before{content:"\e1b0"}.fa-dumpster-fire:before{content:"\f794"}.fa-house-crack:before{content:"\e3b1"}.fa-cocktail:before,.fa-martini-glass-citrus:before{content:"\f561"}.fa-face-surprise:before,.fa-surprise:before{content:"\f5c2"}.fa-bottle-water:before{content:"\e4c5"}.fa-circle-pause:before,.fa-pause-circle:before{content:"\f28b"}.fa-toilet-paper-slash:before{content:"\e072"}.fa-apple-alt:before,.fa-apple-whole:before{content:"\f5d1"}.fa-kitchen-set:before{content:"\e51a"}.fa-r:before{content:"\52"}.fa-temperature-1:before,.fa-temperature-quarter:before,.fa-thermometer-1:before,.fa-thermometer-quarter:before{content:"\f2ca"}.fa-cube:before{content:"\f1b2"}.fa-bitcoin-sign:before{content:"\e0b4"}.fa-shield-dog:before{content:"\e573"}.fa-solar-panel:before{content:"\f5ba"}.fa-lock-open:before{content:"\f3c1"}.fa-elevator:before{content:"\e16d"}.fa-money-bill-transfer:before{content:"\e528"}.fa-money-bill-trend-up:before{content:"\e529"}.fa-house-flood-water-circle-arrow-right:before{content:"\e50f"}.fa-poll-h:before,.fa-square-poll-horizontal:before{content:"\f682"}.fa-circle:before{content:"\f111"}.fa-backward-fast:before,.fa-fast-backward:before{content:"\f049"}.fa-recycle:before{content:"\f1b8"}.fa-user-astronaut:before{content:"\f4fb"}.fa-plane-slash:before{content:"\e069"}.fa-trademark:before{content:"\f25c"}.fa-basketball-ball:before,.fa-basketball:before{content:"\f434"}.fa-satellite-dish:before{content:"\f7c0"}.fa-arrow-alt-circle-up:before,.fa-circle-up:before{content:"\f35b"}.fa-mobile-alt:before,.fa-mobile-screen-button:before{content:"\f3cd"}.fa-volume-high:before,.fa-volume-up:before{content:"\f028"}.fa-users-rays:before{content:"\e593"}.fa-wallet:before{content:"\f555"}.fa-clipboard-check:before{content:"\f46c"}.fa-file-audio:before{content:"\f1c7"}.fa-burger:before,.fa-hamburger:before{content:"\f805"}.fa-wrench:before{content:"\f0ad"}.fa-bugs:before{content:"\e4d0"}.fa-rupee-sign:before,.fa-rupee:before{content:"\f156"}.fa-file-image:before{content:"\f1c5"}.fa-circle-question:before,.fa-question-circle:before{content:"\f059"}.fa-plane-departure:before{content:"\f5b0"}.fa-handshake-slash:before{content:"\e060"}.fa-book-bookmark:before{content:"\e0bb"}.fa-code-branch:before{content:"\f126"}.fa-hat-cowboy:before{content:"\f8c0"}.fa-bridge:before{content:"\e4c8"}.fa-phone-alt:before,.fa-phone-flip:before{content:"\f879"}.fa-truck-front:before{content:"\e2b7"}.fa-cat:before{content:"\f6be"}.fa-anchor-circle-exclamation:before{content:"\e4ab"}.fa-truck-field:before{content:"\e58d"}.fa-route:before{content:"\f4d7"}.fa-clipboard-question:before{content:"\e4e3"}.fa-panorama:before{content:"\e209"}.fa-comment-medical:before{content:"\f7f5"}.fa-teeth-open:before{content:"\f62f"}.fa-file-circle-minus:before{content:"\e4ed"}.fa-tags:before{content:"\f02c"}.fa-wine-glass:before{content:"\f4e3"}.fa-fast-forward:before,.fa-forward-fast:before{content:"\f050"}.fa-face-meh-blank:before,.fa-meh-blank:before{content:"\f5a4"}.fa-parking:before,.fa-square-parking:before{content:"\f540"}.fa-house-signal:before{content:"\e012"}.fa-bars-progress:before,.fa-tasks-alt:before{content:"\f828"}.fa-faucet-drip:before{content:"\e006"}.fa-cart-flatbed:before,.fa-dolly-flatbed:before{content:"\f474"}.fa-ban-smoking:before,.fa-smoking-ban:before{content:"\f54d"}.fa-terminal:before{content:"\f120"}.fa-mobile-button:before{content:"\f10b"}.fa-house-medical-flag:before{content:"\e514"}.fa-basket-shopping:before,.fa-shopping-basket:before{content:"\f291"}.fa-tape:before{content:"\f4db"}.fa-bus-alt:before,.fa-bus-simple:before{content:"\f55e"}.fa-eye:before{content:"\f06e"}.fa-face-sad-cry:before,.fa-sad-cry:before{content:"\f5b3"}.fa-audio-description:before{content:"\f29e"}.fa-person-military-to-person:before{content:"\e54c"}.fa-file-shield:before{content:"\e4f0"}.fa-user-slash:before{content:"\f506"}.fa-pen:before{content:"\f304"}.fa-tower-observation:before{content:"\e586"}.fa-file-code:before{content:"\f1c9"}.fa-signal-5:before,.fa-signal-perfect:before,.fa-signal:before{content:"\f012"}.fa-bus:before{content:"\f207"}.fa-heart-circle-xmark:before{content:"\e501"}.fa-home-lg:before,.fa-house-chimney:before{content:"\e3af"}.fa-window-maximize:before{content:"\f2d0"}.fa-face-frown:before,.fa-frown:before{content:"\f119"}.fa-prescription:before{content:"\f5b1"}.fa-shop:before,.fa-store-alt:before{content:"\f54f"}.fa-floppy-disk:before,.fa-save:before{content:"\f0c7"}.fa-vihara:before{content:"\f6a7"}.fa-balance-scale-left:before,.fa-scale-unbalanced:before{content:"\f515"}.fa-sort-asc:before,.fa-sort-up:before{content:"\f0de"}.fa-comment-dots:before,.fa-commenting:before{content:"\f4ad"}.fa-plant-wilt:before{content:"\e5aa"}.fa-diamond:before{content:"\f219"}.fa-face-grin-squint:before,.fa-grin-squint:before{content:"\f585"}.fa-hand-holding-dollar:before,.fa-hand-holding-usd:before{content:"\f4c0"}.fa-bacterium:before{content:"\e05a"}.fa-hand-pointer:before{content:"\f25a"}.fa-drum-steelpan:before{content:"\f56a"}.fa-hand-scissors:before{content:"\f257"}.fa-hands-praying:before,.fa-praying-hands:before{content:"\f684"}.fa-arrow-right-rotate:before,.fa-arrow-rotate-forward:before,.fa-arrow-rotate-right:before,.fa-redo:before{content:"\f01e"}.fa-biohazard:before{content:"\f780"}.fa-location-crosshairs:before,.fa-location:before{content:"\f601"}.fa-mars-double:before{content:"\f227"}.fa-child-dress:before{content:"\e59c"}.fa-users-between-lines:before{content:"\e591"}.fa-lungs-virus:before{content:"\e067"}.fa-face-grin-tears:before,.fa-grin-tears:before{content:"\f588"}.fa-phone:before{content:"\f095"}.fa-calendar-times:before,.fa-calendar-xmark:before{content:"\f273"}.fa-child-reaching:before{content:"\e59d"}.fa-head-side-virus:before{content:"\e064"}.fa-user-cog:before,.fa-user-gear:before{content:"\f4fe"}.fa-arrow-up-1-9:before,.fa-sort-numeric-up:before{content:"\f163"}.fa-door-closed:before{content:"\f52a"}.fa-shield-virus:before{content:"\e06c"}.fa-dice-six:before{content:"\f526"}.fa-mosquito-net:before{content:"\e52c"}.fa-bridge-water:before{content:"\e4ce"}.fa-person-booth:before{content:"\f756"}.fa-text-width:before{content:"\f035"}.fa-hat-wizard:before{content:"\f6e8"}.fa-pen-fancy:before{content:"\f5ac"}.fa-digging:before,.fa-person-digging:before{content:"\f85e"}.fa-trash:before{content:"\f1f8"}.fa-gauge-simple-med:before,.fa-gauge-simple:before,.fa-tachometer-average:before{content:"\f629"}.fa-book-medical:before{content:"\f7e6"}.fa-poo:before{content:"\f2fe"}.fa-quote-right-alt:before,.fa-quote-right:before{content:"\f10e"}.fa-shirt:before,.fa-t-shirt:before,.fa-tshirt:before{content:"\f553"}.fa-cubes:before{content:"\f1b3"}.fa-divide:before{content:"\f529"}.fa-tenge-sign:before,.fa-tenge:before{content:"\f7d7"}.fa-headphones:before{content:"\f025"}.fa-hands-holding:before{content:"\f4c2"}.fa-hands-clapping:before{content:"\e1a8"}.fa-republican:before{content:"\f75e"}.fa-arrow-left:before{content:"\f060"}.fa-person-circle-xmark:before{content:"\e543"}.fa-ruler:before{content:"\f545"}.fa-align-left:before{content:"\f036"}.fa-dice-d6:before{content:"\f6d1"}.fa-restroom:before{content:"\f7bd"}.fa-j:before{content:"\4a"}.fa-users-viewfinder:before{content:"\e595"}.fa-file-video:before{content:"\f1c8"}.fa-external-link-alt:before,.fa-up-right-from-square:before{content:"\f35d"}.fa-table-cells:before,.fa-th:before{content:"\f00a"}.fa-file-pdf:before{content:"\f1c1"}.fa-bible:before,.fa-book-bible:before{content:"\f647"}.fa-o:before{content:"\4f"}.fa-medkit:before,.fa-suitcase-medical:before{content:"\f0fa"}.fa-user-secret:before{content:"\f21b"}.fa-otter:before{content:"\f700"}.fa-female:before,.fa-person-dress:before{content:"\f182"}.fa-comment-dollar:before{content:"\f651"}.fa-briefcase-clock:before,.fa-business-time:before{content:"\f64a"}.fa-table-cells-large:before,.fa-th-large:before{content:"\f009"}.fa-book-tanakh:before,.fa-tanakh:before{content:"\f827"}.fa-phone-volume:before,.fa-volume-control-phone:before{content:"\f2a0"}.fa-hat-cowboy-side:before{content:"\f8c1"}.fa-clipboard-user:before{content:"\f7f3"}.fa-child:before{content:"\f1ae"}.fa-lira-sign:before{content:"\f195"}.fa-satellite:before{content:"\f7bf"}.fa-plane-lock:before{content:"\e558"}.fa-tag:before{content:"\f02b"}.fa-comment:before{content:"\f075"}.fa-birthday-cake:before,.fa-cake-candles:before,.fa-cake:before{content:"\f1fd"}.fa-envelope:before{content:"\f0e0"}.fa-angle-double-up:before,.fa-angles-up:before{content:"\f102"}.fa-paperclip:before{content:"\f0c6"}.fa-arrow-right-to-city:before{content:"\e4b3"}.fa-ribbon:before{content:"\f4d6"}.fa-lungs:before{content:"\f604"}.fa-arrow-up-9-1:before,.fa-sort-numeric-up-alt:before{content:"\f887"}.fa-litecoin-sign:before{content:"\e1d3"}.fa-border-none:before{content:"\f850"}.fa-circle-nodes:before{content:"\e4e2"}.fa-parachute-box:before{content:"\f4cd"}.fa-indent:before{content:"\f03c"}.fa-truck-field-un:before{content:"\e58e"}.fa-hourglass-empty:before,.fa-hourglass:before{content:"\f254"}.fa-mountain:before{content:"\f6fc"}.fa-user-doctor:before,.fa-user-md:before{content:"\f0f0"}.fa-circle-info:before,.fa-info-circle:before{content:"\f05a"}.fa-cloud-meatball:before{content:"\f73b"}.fa-camera-alt:before,.fa-camera:before{content:"\f030"}.fa-square-virus:before{content:"\e578"}.fa-meteor:before{content:"\f753"}.fa-car-on:before{content:"\e4dd"}.fa-sleigh:before{content:"\f7cc"}.fa-arrow-down-1-9:before,.fa-sort-numeric-asc:before,.fa-sort-numeric-down:before{content:"\f162"}.fa-hand-holding-droplet:before,.fa-hand-holding-water:before{content:"\f4c1"}.fa-water:before{content:"\f773"}.fa-calendar-check:before{content:"\f274"}.fa-braille:before{content:"\f2a1"}.fa-prescription-bottle-alt:before,.fa-prescription-bottle-medical:before{content:"\f486"}.fa-landmark:before{content:"\f66f"}.fa-truck:before{content:"\f0d1"}.fa-crosshairs:before{content:"\f05b"}.fa-person-cane:before{content:"\e53c"}.fa-tent:before{content:"\e57d"}.fa-vest-patches:before{content:"\e086"}.fa-check-double:before{content:"\f560"}.fa-arrow-down-a-z:before,.fa-sort-alpha-asc:before,.fa-sort-alpha-down:before{content:"\f15d"}.fa-money-bill-wheat:before{content:"\e52a"}.fa-cookie:before{content:"\f563"}.fa-arrow-left-rotate:before,.fa-arrow-rotate-back:before,.fa-arrow-rotate-backward:before,.fa-arrow-rotate-left:before,.fa-undo:before{content:"\f0e2"}.fa-hard-drive:before,.fa-hdd:before{content:"\f0a0"}.fa-face-grin-squint-tears:before,.fa-grin-squint-tears:before{content:"\f586"}.fa-dumbbell:before{content:"\f44b"}.fa-list-alt:before,.fa-rectangle-list:before{content:"\f022"}.fa-tarp-droplet:before{content:"\e57c"}.fa-house-medical-circle-check:before{content:"\e511"}.fa-person-skiing-nordic:before,.fa-skiing-nordic:before{content:"\f7ca"}.fa-calendar-plus:before{content:"\f271"}.fa-plane-arrival:before{content:"\f5af"}.fa-arrow-alt-circle-left:before,.fa-circle-left:before{content:"\f359"}.fa-subway:before,.fa-train-subway:before{content:"\f239"}.fa-chart-gantt:before{content:"\e0e4"}.fa-indian-rupee-sign:before,.fa-indian-rupee:before,.fa-inr:before{content:"\e1bc"}.fa-crop-alt:before,.fa-crop-simple:before{content:"\f565"}.fa-money-bill-1:before,.fa-money-bill-alt:before{content:"\f3d1"}.fa-left-long:before,.fa-long-arrow-alt-left:before{content:"\f30a"}.fa-dna:before{content:"\f471"}.fa-virus-slash:before{content:"\e075"}.fa-minus:before,.fa-subtract:before{content:"\f068"}.fa-chess:before{content:"\f439"}.fa-arrow-left-long:before,.fa-long-arrow-left:before{content:"\f177"}.fa-plug-circle-check:before{content:"\e55c"}.fa-street-view:before{content:"\f21d"}.fa-franc-sign:before{content:"\e18f"}.fa-volume-off:before{content:"\f026"}.fa-american-sign-language-interpreting:before,.fa-asl-interpreting:before,.fa-hands-american-sign-language-interpreting:before,.fa-hands-asl-interpreting:before{content:"\f2a3"}.fa-cog:before,.fa-gear:before{content:"\f013"}.fa-droplet-slash:before,.fa-tint-slash:before{content:"\f5c7"}.fa-mosque:before{content:"\f678"}.fa-mosquito:before{content:"\e52b"}.fa-star-of-david:before{content:"\f69a"}.fa-person-military-rifle:before{content:"\e54b"}.fa-cart-shopping:before,.fa-shopping-cart:before{content:"\f07a"}.fa-vials:before{content:"\f493"}.fa-plug-circle-plus:before{content:"\e55f"}.fa-place-of-worship:before{content:"\f67f"}.fa-grip-vertical:before{content:"\f58e"}.fa-arrow-turn-up:before,.fa-level-up:before{content:"\f148"}.fa-u:before{content:"\55"}.fa-square-root-alt:before,.fa-square-root-variable:before{content:"\f698"}.fa-clock-four:before,.fa-clock:before{content:"\f017"}.fa-backward-step:before,.fa-step-backward:before{content:"\f048"}.fa-pallet:before{content:"\f482"}.fa-faucet:before{content:"\e005"}.fa-baseball-bat-ball:before{content:"\f432"}.fa-s:before{content:"\53"}.fa-timeline:before{content:"\e29c"}.fa-keyboard:before{content:"\f11c"}.fa-caret-down:before{content:"\f0d7"}.fa-clinic-medical:before,.fa-house-chimney-medical:before{content:"\f7f2"}.fa-temperature-3:before,.fa-temperature-three-quarters:before,.fa-thermometer-3:before,.fa-thermometer-three-quarters:before{content:"\f2c8"}.fa-mobile-android-alt:before,.fa-mobile-screen:before{content:"\f3cf"}.fa-plane-up:before{content:"\e22d"}.fa-piggy-bank:before{content:"\f4d3"}.fa-battery-3:before,.fa-battery-half:before{content:"\f242"}.fa-mountain-city:before{content:"\e52e"}.fa-coins:before{content:"\f51e"}.fa-khanda:before{content:"\f66d"}.fa-sliders-h:before,.fa-sliders:before{content:"\f1de"}.fa-folder-tree:before{content:"\f802"}.fa-network-wired:before{content:"\f6ff"}.fa-map-pin:before{content:"\f276"}.fa-hamsa:before{content:"\f665"}.fa-cent-sign:before{content:"\e3f5"}.fa-flask:before{content:"\f0c3"}.fa-person-pregnant:before{content:"\e31e"}.fa-wand-sparkles:before{content:"\f72b"}.fa-ellipsis-v:before,.fa-ellipsis-vertical:before{content:"\f142"}.fa-ticket:before{content:"\f145"}.fa-power-off:before{content:"\f011"}.fa-long-arrow-alt-right:before,.fa-right-long:before{content:"\f30b"}.fa-flag-usa:before{content:"\f74d"}.fa-laptop-file:before{content:"\e51d"}.fa-teletype:before,.fa-tty:before{content:"\f1e4"}.fa-diagram-next:before{content:"\e476"}.fa-person-rifle:before{content:"\e54e"}.fa-house-medical-circle-exclamation:before{content:"\e512"}.fa-closed-captioning:before{content:"\f20a"}.fa-hiking:before,.fa-person-hiking:before{content:"\f6ec"}.fa-venus-double:before{content:"\f226"}.fa-images:before{content:"\f302"}.fa-calculator:before{content:"\f1ec"}.fa-people-pulling:before{content:"\e535"}.fa-n:before{content:"\4e"}.fa-cable-car:before,.fa-tram:before{content:"\f7da"}.fa-cloud-rain:before{content:"\f73d"}.fa-building-circle-xmark:before{content:"\e4d4"}.fa-ship:before{content:"\f21a"}.fa-arrows-down-to-line:before{content:"\e4b8"}.fa-download:before{content:"\f019"}.fa-face-grin:before,.fa-grin:before{content:"\f580"}.fa-backspace:before,.fa-delete-left:before{content:"\f55a"}.fa-eye-dropper-empty:before,.fa-eye-dropper:before,.fa-eyedropper:before{content:"\f1fb"}.fa-file-circle-check:before{content:"\e5a0"}.fa-forward:before{content:"\f04e"}.fa-mobile-android:before,.fa-mobile-phone:before,.fa-mobile:before{content:"\f3ce"}.fa-face-meh:before,.fa-meh:before{content:"\f11a"}.fa-align-center:before{content:"\f037"}.fa-book-dead:before,.fa-book-skull:before{content:"\f6b7"}.fa-drivers-license:before,.fa-id-card:before{content:"\f2c2"}.fa-dedent:before,.fa-outdent:before{content:"\f03b"}.fa-heart-circle-exclamation:before{content:"\e4fe"}.fa-home-alt:before,.fa-home-lg-alt:before,.fa-home:before,.fa-house:before{content:"\f015"}.fa-calendar-week:before{content:"\f784"}.fa-laptop-medical:before{content:"\f812"}.fa-b:before{content:"\42"}.fa-file-medical:before{content:"\f477"}.fa-dice-one:before{content:"\f525"}.fa-kiwi-bird:before{content:"\f535"}.fa-arrow-right-arrow-left:before,.fa-exchange:before{content:"\f0ec"}.fa-redo-alt:before,.fa-rotate-forward:before,.fa-rotate-right:before{content:"\f2f9"}.fa-cutlery:before,.fa-utensils:before{content:"\f2e7"}.fa-arrow-up-wide-short:before,.fa-sort-amount-up:before{content:"\f161"}.fa-mill-sign:before{content:"\e1ed"}.fa-bowl-rice:before{content:"\e2eb"}.fa-skull:before{content:"\f54c"}.fa-broadcast-tower:before,.fa-tower-broadcast:before{content:"\f519"}.fa-truck-pickup:before{content:"\f63c"}.fa-long-arrow-alt-up:before,.fa-up-long:before{content:"\f30c"}.fa-stop:before{content:"\f04d"}.fa-code-merge:before{content:"\f387"}.fa-upload:before{content:"\f093"}.fa-hurricane:before{content:"\f751"}.fa-mound:before{content:"\e52d"}.fa-toilet-portable:before{content:"\e583"}.fa-compact-disc:before{content:"\f51f"}.fa-file-arrow-down:before,.fa-file-download:before{content:"\f56d"}.fa-caravan:before{content:"\f8ff"}.fa-shield-cat:before{content:"\e572"}.fa-bolt:before,.fa-zap:before{content:"\f0e7"}.fa-glass-water:before{content:"\e4f4"}.fa-oil-well:before{content:"\e532"}.fa-vault:before{content:"\e2c5"}.fa-mars:before{content:"\f222"}.fa-toilet:before{content:"\f7d8"}.fa-plane-circle-xmark:before{content:"\e557"}.fa-cny:before,.fa-jpy:before,.fa-rmb:before,.fa-yen-sign:before,.fa-yen:before{content:"\f157"}.fa-rouble:before,.fa-rub:before,.fa-ruble-sign:before,.fa-ruble:before{content:"\f158"}.fa-sun:before{content:"\f185"}.fa-guitar:before{content:"\f7a6"}.fa-face-laugh-wink:before,.fa-laugh-wink:before{content:"\f59c"}.fa-horse-head:before{content:"\f7ab"}.fa-bore-hole:before{content:"\e4c3"}.fa-industry:before{content:"\f275"}.fa-arrow-alt-circle-down:before,.fa-circle-down:before{content:"\f358"}.fa-arrows-turn-to-dots:before{content:"\e4c1"}.fa-florin-sign:before{content:"\e184"}.fa-arrow-down-short-wide:before,.fa-sort-amount-desc:before,.fa-sort-amount-down-alt:before{content:"\f884"}.fa-less-than:before{content:"\3c"}.fa-angle-down:before{content:"\f107"}.fa-car-tunnel:before{content:"\e4de"}.fa-head-side-cough:before{content:"\e061"}.fa-grip-lines:before{content:"\f7a4"}.fa-thumbs-down:before{content:"\f165"}.fa-user-lock:before{content:"\f502"}.fa-arrow-right-long:before,.fa-long-arrow-right:before{content:"\f178"}.fa-anchor-circle-xmark:before{content:"\e4ac"}.fa-ellipsis-h:before,.fa-ellipsis:before{content:"\f141"}.fa-chess-pawn:before{content:"\f443"}.fa-first-aid:before,.fa-kit-medical:before{content:"\f479"}.fa-person-through-window:before{content:"\e5a9"}.fa-toolbox:before{content:"\f552"}.fa-hands-holding-circle:before{content:"\e4fb"}.fa-bug:before{content:"\f188"}.fa-credit-card-alt:before,.fa-credit-card:before{content:"\f09d"}.fa-automobile:before,.fa-car:before{content:"\f1b9"}.fa-hand-holding-hand:before{content:"\e4f7"}.fa-book-open-reader:before,.fa-book-reader:before{content:"\f5da"}.fa-mountain-sun:before{content:"\e52f"}.fa-arrows-left-right-to-line:before{content:"\e4ba"}.fa-dice-d20:before{content:"\f6cf"}.fa-truck-droplet:before{content:"\e58c"}.fa-file-circle-xmark:before{content:"\e5a1"}.fa-temperature-arrow-up:before,.fa-temperature-up:before{content:"\e040"}.fa-medal:before{content:"\f5a2"}.fa-bed:before{content:"\f236"}.fa-h-square:before,.fa-square-h:before{content:"\f0fd"}.fa-podcast:before{content:"\f2ce"}.fa-temperature-4:before,.fa-temperature-full:before,.fa-thermometer-4:before,.fa-thermometer-full:before{content:"\f2c7"}.fa-bell:before{content:"\f0f3"}.fa-superscript:before{content:"\f12b"}.fa-plug-circle-xmark:before{content:"\e560"}.fa-star-of-life:before{content:"\f621"}.fa-phone-slash:before{content:"\f3dd"}.fa-paint-roller:before{content:"\f5aa"}.fa-hands-helping:before,.fa-handshake-angle:before{content:"\f4c4"}.fa-location-dot:before,.fa-map-marker-alt:before{content:"\f3c5"}.fa-file:before{content:"\f15b"}.fa-greater-than:before{content:"\3e"}.fa-person-swimming:before,.fa-swimmer:before{content:"\f5c4"}.fa-arrow-down:before{content:"\f063"}.fa-droplet:before,.fa-tint:before{content:"\f043"}.fa-eraser:before{content:"\f12d"}.fa-earth-america:before,.fa-earth-americas:before,.fa-earth:before,.fa-globe-americas:before{content:"\f57d"}.fa-person-burst:before{content:"\e53b"}.fa-dove:before{content:"\f4ba"}.fa-battery-0:before,.fa-battery-empty:before{content:"\f244"}.fa-socks:before{content:"\f696"}.fa-inbox:before{content:"\f01c"}.fa-section:before{content:"\e447"}.fa-gauge-high:before,.fa-tachometer-alt-fast:before,.fa-tachometer-alt:before{content:"\f625"}.fa-envelope-open-text:before{content:"\f658"}.fa-hospital-alt:before,.fa-hospital-wide:before,.fa-hospital:before{content:"\f0f8"}.fa-wine-bottle:before{content:"\f72f"}.fa-chess-rook:before{content:"\f447"}.fa-bars-staggered:before,.fa-reorder:before,.fa-stream:before{content:"\f550"}.fa-dharmachakra:before{content:"\f655"}.fa-hotdog:before{content:"\f80f"}.fa-blind:before,.fa-person-walking-with-cane:before{content:"\f29d"}.fa-drum:before{content:"\f569"}.fa-ice-cream:before{content:"\f810"}.fa-heart-circle-bolt:before{content:"\e4fc"}.fa-fax:before{content:"\f1ac"}.fa-paragraph:before{content:"\f1dd"}.fa-check-to-slot:before,.fa-vote-yea:before{content:"\f772"}.fa-star-half:before{content:"\f089"}.fa-boxes-alt:before,.fa-boxes-stacked:before,.fa-boxes:before{content:"\f468"}.fa-chain:before,.fa-link:before{content:"\f0c1"}.fa-assistive-listening-systems:before,.fa-ear-listen:before{content:"\f2a2"}.fa-tree-city:before{content:"\e587"}.fa-play:before{content:"\f04b"}.fa-font:before{content:"\f031"}.fa-table-cells-row-lock:before{content:"\e67a"}.fa-rupiah-sign:before{content:"\e23d"}.fa-magnifying-glass:before,.fa-search:before{content:"\f002"}.fa-ping-pong-paddle-ball:before,.fa-table-tennis-paddle-ball:before,.fa-table-tennis:before{content:"\f45d"}.fa-diagnoses:before,.fa-person-dots-from-line:before{content:"\f470"}.fa-trash-can-arrow-up:before,.fa-trash-restore-alt:before{content:"\f82a"}.fa-naira-sign:before{content:"\e1f6"}.fa-cart-arrow-down:before{content:"\f218"}.fa-walkie-talkie:before{content:"\f8ef"}.fa-file-edit:before,.fa-file-pen:before{content:"\f31c"}.fa-receipt:before{content:"\f543"}.fa-pen-square:before,.fa-pencil-square:before,.fa-square-pen:before{content:"\f14b"}.fa-suitcase-rolling:before{content:"\f5c1"}.fa-person-circle-exclamation:before{content:"\e53f"}.fa-chevron-down:before{content:"\f078"}.fa-battery-5:before,.fa-battery-full:before,.fa-battery:before{content:"\f240"}.fa-skull-crossbones:before{content:"\f714"}.fa-code-compare:before{content:"\e13a"}.fa-list-dots:before,.fa-list-ul:before{content:"\f0ca"}.fa-school-lock:before{content:"\e56f"}.fa-tower-cell:before{content:"\e585"}.fa-down-long:before,.fa-long-arrow-alt-down:before{content:"\f309"}.fa-ranking-star:before{content:"\e561"}.fa-chess-king:before{content:"\f43f"}.fa-person-harassing:before{content:"\e549"}.fa-brazilian-real-sign:before{content:"\e46c"}.fa-landmark-alt:before,.fa-landmark-dome:before{content:"\f752"}.fa-arrow-up:before{content:"\f062"}.fa-television:before,.fa-tv-alt:before,.fa-tv:before{content:"\f26c"}.fa-shrimp:before{content:"\e448"}.fa-list-check:before,.fa-tasks:before{content:"\f0ae"}.fa-jug-detergent:before{content:"\e519"}.fa-circle-user:before,.fa-user-circle:before{content:"\f2bd"}.fa-user-shield:before{content:"\f505"}.fa-wind:before{content:"\f72e"}.fa-car-burst:before,.fa-car-crash:before{content:"\f5e1"}.fa-y:before{content:"\59"}.fa-person-snowboarding:before,.fa-snowboarding:before{content:"\f7ce"}.fa-shipping-fast:before,.fa-truck-fast:before{content:"\f48b"}.fa-fish:before{content:"\f578"}.fa-user-graduate:before{content:"\f501"}.fa-adjust:before,.fa-circle-half-stroke:before{content:"\f042"}.fa-clapperboard:before{content:"\e131"}.fa-circle-radiation:before,.fa-radiation-alt:before{content:"\f7ba"}.fa-baseball-ball:before,.fa-baseball:before{content:"\f433"}.fa-jet-fighter-up:before{content:"\e518"}.fa-diagram-project:before,.fa-project-diagram:before{content:"\f542"}.fa-copy:before{content:"\f0c5"}.fa-volume-mute:before,.fa-volume-times:before,.fa-volume-xmark:before{content:"\f6a9"}.fa-hand-sparkles:before{content:"\e05d"}.fa-grip-horizontal:before,.fa-grip:before{content:"\f58d"}.fa-share-from-square:before,.fa-share-square:before{content:"\f14d"}.fa-child-combatant:before,.fa-child-rifle:before{content:"\e4e0"}.fa-gun:before{content:"\e19b"}.fa-phone-square:before,.fa-square-phone:before{content:"\f098"}.fa-add:before,.fa-plus:before{content:"\2b"}.fa-expand:before{content:"\f065"}.fa-computer:before{content:"\e4e5"}.fa-close:before,.fa-multiply:before,.fa-remove:before,.fa-times:before,.fa-xmark:before{content:"\f00d"}.fa-arrows-up-down-left-right:before,.fa-arrows:before{content:"\f047"}.fa-chalkboard-teacher:before,.fa-chalkboard-user:before{content:"\f51c"}.fa-peso-sign:before{content:"\e222"}.fa-building-shield:before{content:"\e4d8"}.fa-baby:before{content:"\f77c"}.fa-users-line:before{content:"\e592"}.fa-quote-left-alt:before,.fa-quote-left:before{content:"\f10d"}.fa-tractor:before{content:"\f722"}.fa-trash-arrow-up:before,.fa-trash-restore:before{content:"\f829"}.fa-arrow-down-up-lock:before{content:"\e4b0"}.fa-lines-leaning:before{content:"\e51e"}.fa-ruler-combined:before{content:"\f546"}.fa-copyright:before{content:"\f1f9"}.fa-equals:before{content:"\3d"}.fa-blender:before{content:"\f517"}.fa-teeth:before{content:"\f62e"}.fa-ils:before,.fa-shekel-sign:before,.fa-shekel:before,.fa-sheqel-sign:before,.fa-sheqel:before{content:"\f20b"}.fa-map:before{content:"\f279"}.fa-rocket:before{content:"\f135"}.fa-photo-film:before,.fa-photo-video:before{content:"\f87c"}.fa-folder-minus:before{content:"\f65d"}.fa-store:before{content:"\f54e"}.fa-arrow-trend-up:before{content:"\e098"}.fa-plug-circle-minus:before{content:"\e55e"}.fa-sign-hanging:before,.fa-sign:before{content:"\f4d9"}.fa-bezier-curve:before{content:"\f55b"}.fa-bell-slash:before{content:"\f1f6"}.fa-tablet-android:before,.fa-tablet:before{content:"\f3fb"}.fa-school-flag:before{content:"\e56e"}.fa-fill:before{content:"\f575"}.fa-angle-up:before{content:"\f106"}.fa-drumstick-bite:before{content:"\f6d7"}.fa-holly-berry:before{content:"\f7aa"}.fa-chevron-left:before{content:"\f053"}.fa-bacteria:before{content:"\e059"}.fa-hand-lizard:before{content:"\f258"}.fa-notdef:before{content:"\e1fe"}.fa-disease:before{content:"\f7fa"}.fa-briefcase-medical:before{content:"\f469"}.fa-genderless:before{content:"\f22d"}.fa-chevron-right:before{content:"\f054"}.fa-retweet:before{content:"\f079"}.fa-car-alt:before,.fa-car-rear:before{content:"\f5de"}.fa-pump-soap:before{content:"\e06b"}.fa-video-slash:before{content:"\f4e2"}.fa-battery-2:before,.fa-battery-quarter:before{content:"\f243"}.fa-radio:before{content:"\f8d7"}.fa-baby-carriage:before,.fa-carriage-baby:before{content:"\f77d"}.fa-traffic-light:before{content:"\f637"}.fa-thermometer:before{content:"\f491"}.fa-vr-cardboard:before{content:"\f729"}.fa-hand-middle-finger:before{content:"\f806"}.fa-percent:before,.fa-percentage:before{content:"\25"}.fa-truck-moving:before{content:"\f4df"}.fa-glass-water-droplet:before{content:"\e4f5"}.fa-display:before{content:"\e163"}.fa-face-smile:before,.fa-smile:before{content:"\f118"}.fa-thumb-tack:before,.fa-thumbtack:before{content:"\f08d"}.fa-trophy:before{content:"\f091"}.fa-person-praying:before,.fa-pray:before{content:"\f683"}.fa-hammer:before{content:"\f6e3"}.fa-hand-peace:before{content:"\f25b"}.fa-rotate:before,.fa-sync-alt:before{content:"\f2f1"}.fa-spinner:before{content:"\f110"}.fa-robot:before{content:"\f544"}.fa-peace:before{content:"\f67c"}.fa-cogs:before,.fa-gears:before{content:"\f085"}.fa-warehouse:before{content:"\f494"}.fa-arrow-up-right-dots:before{content:"\e4b7"}.fa-splotch:before{content:"\f5bc"}.fa-face-grin-hearts:before,.fa-grin-hearts:before{content:"\f584"}.fa-dice-four:before{content:"\f524"}.fa-sim-card:before{content:"\f7c4"}.fa-transgender-alt:before,.fa-transgender:before{content:"\f225"}.fa-mercury:before{content:"\f223"}.fa-arrow-turn-down:before,.fa-level-down:before{content:"\f149"}.fa-person-falling-burst:before{content:"\e547"}.fa-award:before{content:"\f559"}.fa-ticket-alt:before,.fa-ticket-simple:before{content:"\f3ff"}.fa-building:before{content:"\f1ad"}.fa-angle-double-left:before,.fa-angles-left:before{content:"\f100"}.fa-qrcode:before{content:"\f029"}.fa-clock-rotate-left:before,.fa-history:before{content:"\f1da"}.fa-face-grin-beam-sweat:before,.fa-grin-beam-sweat:before{content:"\f583"}.fa-arrow-right-from-file:before,.fa-file-export:before{content:"\f56e"}.fa-shield-blank:before,.fa-shield:before{content:"\f132"}.fa-arrow-up-short-wide:before,.fa-sort-amount-up-alt:before{content:"\f885"}.fa-house-medical:before{content:"\e3b2"}.fa-golf-ball-tee:before,.fa-golf-ball:before{content:"\f450"}.fa-chevron-circle-left:before,.fa-circle-chevron-left:before{content:"\f137"}.fa-house-chimney-window:before{content:"\e00d"}.fa-pen-nib:before{content:"\f5ad"}.fa-tent-arrow-turn-left:before{content:"\e580"}.fa-tents:before{content:"\e582"}.fa-magic:before,.fa-wand-magic:before{content:"\f0d0"}.fa-dog:before{content:"\f6d3"}.fa-carrot:before{content:"\f787"}.fa-moon:before{content:"\f186"}.fa-wine-glass-alt:before,.fa-wine-glass-empty:before{content:"\f5ce"}.fa-cheese:before{content:"\f7ef"}.fa-yin-yang:before{content:"\f6ad"}.fa-music:before{content:"\f001"}.fa-code-commit:before{content:"\f386"}.fa-temperature-low:before{content:"\f76b"}.fa-biking:before,.fa-person-biking:before{content:"\f84a"}.fa-broom:before{content:"\f51a"}.fa-shield-heart:before{content:"\e574"}.fa-gopuram:before{content:"\f664"}.fa-earth-oceania:before,.fa-globe-oceania:before{content:"\e47b"}.fa-square-xmark:before,.fa-times-square:before,.fa-xmark-square:before{content:"\f2d3"}.fa-hashtag:before{content:"\23"}.fa-expand-alt:before,.fa-up-right-and-down-left-from-center:before{content:"\f424"}.fa-oil-can:before{content:"\f613"}.fa-t:before{content:"\54"}.fa-hippo:before{content:"\f6ed"}.fa-chart-column:before{content:"\e0e3"}.fa-infinity:before{content:"\f534"}.fa-vial-circle-check:before{content:"\e596"}.fa-person-arrow-down-to-line:before{content:"\e538"}.fa-voicemail:before{content:"\f897"}.fa-fan:before{content:"\f863"}.fa-person-walking-luggage:before{content:"\e554"}.fa-arrows-alt-v:before,.fa-up-down:before{content:"\f338"}.fa-cloud-moon-rain:before{content:"\f73c"}.fa-calendar:before{content:"\f133"}.fa-trailer:before{content:"\e041"}.fa-bahai:before,.fa-haykal:before{content:"\f666"}.fa-sd-card:before{content:"\f7c2"}.fa-dragon:before{content:"\f6d5"}.fa-shoe-prints:before{content:"\f54b"}.fa-circle-plus:before,.fa-plus-circle:before{content:"\f055"}.fa-face-grin-tongue-wink:before,.fa-grin-tongue-wink:before{content:"\f58b"}.fa-hand-holding:before{content:"\f4bd"}.fa-plug-circle-exclamation:before{content:"\e55d"}.fa-chain-broken:before,.fa-chain-slash:before,.fa-link-slash:before,.fa-unlink:before{content:"\f127"}.fa-clone:before{content:"\f24d"}.fa-person-walking-arrow-loop-left:before{content:"\e551"}.fa-arrow-up-z-a:before,.fa-sort-alpha-up-alt:before{content:"\f882"}.fa-fire-alt:before,.fa-fire-flame-curved:before{content:"\f7e4"}.fa-tornado:before{content:"\f76f"}.fa-file-circle-plus:before{content:"\e494"}.fa-book-quran:before,.fa-quran:before{content:"\f687"}.fa-anchor:before{content:"\f13d"}.fa-border-all:before{content:"\f84c"}.fa-angry:before,.fa-face-angry:before{content:"\f556"}.fa-cookie-bite:before{content:"\f564"}.fa-arrow-trend-down:before{content:"\e097"}.fa-feed:before,.fa-rss:before{content:"\f09e"}.fa-draw-polygon:before{content:"\f5ee"}.fa-balance-scale:before,.fa-scale-balanced:before{content:"\f24e"}.fa-gauge-simple-high:before,.fa-tachometer-fast:before,.fa-tachometer:before{content:"\f62a"}.fa-shower:before{content:"\f2cc"}.fa-desktop-alt:before,.fa-desktop:before{content:"\f390"}.fa-m:before{content:"\4d"}.fa-table-list:before,.fa-th-list:before{content:"\f00b"}.fa-comment-sms:before,.fa-sms:before{content:"\f7cd"}.fa-book:before{content:"\f02d"}.fa-user-plus:before{content:"\f234"}.fa-check:before{content:"\f00c"}.fa-battery-4:before,.fa-battery-three-quarters:before{content:"\f241"}.fa-house-circle-check:before{content:"\e509"}.fa-angle-left:before{content:"\f104"}.fa-diagram-successor:before{content:"\e47a"}.fa-truck-arrow-right:before{content:"\e58b"}.fa-arrows-split-up-and-left:before{content:"\e4bc"}.fa-fist-raised:before,.fa-hand-fist:before{content:"\f6de"}.fa-cloud-moon:before{content:"\f6c3"}.fa-briefcase:before{content:"\f0b1"}.fa-person-falling:before{content:"\e546"}.fa-image-portrait:before,.fa-portrait:before{content:"\f3e0"}.fa-user-tag:before{content:"\f507"}.fa-rug:before{content:"\e569"}.fa-earth-europe:before,.fa-globe-europe:before{content:"\f7a2"}.fa-cart-flatbed-suitcase:before,.fa-luggage-cart:before{content:"\f59d"}.fa-rectangle-times:before,.fa-rectangle-xmark:before,.fa-times-rectangle:before,.fa-window-close:before{content:"\f410"}.fa-baht-sign:before{content:"\e0ac"}.fa-book-open:before{content:"\f518"}.fa-book-journal-whills:before,.fa-journal-whills:before{content:"\f66a"}.fa-handcuffs:before{content:"\e4f8"}.fa-exclamation-triangle:before,.fa-triangle-exclamation:before,.fa-warning:before{content:"\f071"}.fa-database:before{content:"\f1c0"}.fa-mail-forward:before,.fa-share:before{content:"\f064"}.fa-bottle-droplet:before{content:"\e4c4"}.fa-mask-face:before{content:"\e1d7"}.fa-hill-rockslide:before{content:"\e508"}.fa-exchange-alt:before,.fa-right-left:before{content:"\f362"}.fa-paper-plane:before{content:"\f1d8"}.fa-road-circle-exclamation:before{content:"\e565"}.fa-dungeon:before{content:"\f6d9"}.fa-align-right:before{content:"\f038"}.fa-money-bill-1-wave:before,.fa-money-bill-wave-alt:before{content:"\f53b"}.fa-life-ring:before{content:"\f1cd"}.fa-hands:before,.fa-sign-language:before,.fa-signing:before{content:"\f2a7"}.fa-calendar-day:before{content:"\f783"}.fa-ladder-water:before,.fa-swimming-pool:before,.fa-water-ladder:before{content:"\f5c5"}.fa-arrows-up-down:before,.fa-arrows-v:before{content:"\f07d"}.fa-face-grimace:before,.fa-grimace:before{content:"\f57f"}.fa-wheelchair-alt:before,.fa-wheelchair-move:before{content:"\e2ce"}.fa-level-down-alt:before,.fa-turn-down:before{content:"\f3be"}.fa-person-walking-arrow-right:before{content:"\e552"}.fa-envelope-square:before,.fa-square-envelope:before{content:"\f199"}.fa-dice:before{content:"\f522"}.fa-bowling-ball:before{content:"\f436"}.fa-brain:before{content:"\f5dc"}.fa-band-aid:before,.fa-bandage:before{content:"\f462"}.fa-calendar-minus:before{content:"\f272"}.fa-circle-xmark:before,.fa-times-circle:before,.fa-xmark-circle:before{content:"\f057"}.fa-gifts:before{content:"\f79c"}.fa-hotel:before{content:"\f594"}.fa-earth-asia:before,.fa-globe-asia:before{content:"\f57e"}.fa-id-card-alt:before,.fa-id-card-clip:before{content:"\f47f"}.fa-magnifying-glass-plus:before,.fa-search-plus:before{content:"\f00e"}.fa-thumbs-up:before{content:"\f164"}.fa-user-clock:before{content:"\f4fd"}.fa-allergies:before,.fa-hand-dots:before{content:"\f461"}.fa-file-invoice:before{content:"\f570"}.fa-window-minimize:before{content:"\f2d1"}.fa-coffee:before,.fa-mug-saucer:before{content:"\f0f4"}.fa-brush:before{content:"\f55d"}.fa-mask:before{content:"\f6fa"}.fa-magnifying-glass-minus:before,.fa-search-minus:before{content:"\f010"}.fa-ruler-vertical:before{content:"\f548"}.fa-user-alt:before,.fa-user-large:before{content:"\f406"}.fa-train-tram:before{content:"\e5b4"}.fa-user-nurse:before{content:"\f82f"}.fa-syringe:before{content:"\f48e"}.fa-cloud-sun:before{content:"\f6c4"}.fa-stopwatch-20:before{content:"\e06f"}.fa-square-full:before{content:"\f45c"}.fa-magnet:before{content:"\f076"}.fa-jar:before{content:"\e516"}.fa-note-sticky:before,.fa-sticky-note:before{content:"\f249"}.fa-bug-slash:before{content:"\e490"}.fa-arrow-up-from-water-pump:before{content:"\e4b6"}.fa-bone:before{content:"\f5d7"}.fa-user-injured:before{content:"\f728"}.fa-face-sad-tear:before,.fa-sad-tear:before{content:"\f5b4"}.fa-plane:before{content:"\f072"}.fa-tent-arrows-down:before{content:"\e581"}.fa-exclamation:before{content:"\21"}.fa-arrows-spin:before{content:"\e4bb"}.fa-print:before{content:"\f02f"}.fa-try:before,.fa-turkish-lira-sign:before,.fa-turkish-lira:before{content:"\e2bb"}.fa-dollar-sign:before,.fa-dollar:before,.fa-usd:before{content:"\24"}.fa-x:before{content:"\58"}.fa-magnifying-glass-dollar:before,.fa-search-dollar:before{content:"\f688"}.fa-users-cog:before,.fa-users-gear:before{content:"\f509"}.fa-person-military-pointing:before{content:"\e54a"}.fa-bank:before,.fa-building-columns:before,.fa-institution:before,.fa-museum:before,.fa-university:before{content:"\f19c"}.fa-umbrella:before{content:"\f0e9"}.fa-trowel:before{content:"\e589"}.fa-d:before{content:"\44"}.fa-stapler:before{content:"\e5af"}.fa-masks-theater:before,.fa-theater-masks:before{content:"\f630"}.fa-kip-sign:before{content:"\e1c4"}.fa-hand-point-left:before{content:"\f0a5"}.fa-handshake-alt:before,.fa-handshake-simple:before{content:"\f4c6"}.fa-fighter-jet:before,.fa-jet-fighter:before{content:"\f0fb"}.fa-share-alt-square:before,.fa-square-share-nodes:before{content:"\f1e1"}.fa-barcode:before{content:"\f02a"}.fa-plus-minus:before{content:"\e43c"}.fa-video-camera:before,.fa-video:before{content:"\f03d"}.fa-graduation-cap:before,.fa-mortar-board:before{content:"\f19d"}.fa-hand-holding-medical:before{content:"\e05c"}.fa-person-circle-check:before{content:"\e53e"}.fa-level-up-alt:before,.fa-turn-up:before{content:"\f3bf"} +.fa-sr-only,.fa-sr-only-focusable:not(:focus),.sr-only,.sr-only-focusable:not(:focus){position:absolute;width:1px;height:1px;padding:0;margin:-1px;overflow:hidden;clip:rect(0,0,0,0);white-space:nowrap;border-width:0}:host,:root{--fa-style-family-brands:"Font Awesome 6 Brands";--fa-font-brands:normal 400 1em/1 "Font Awesome 6 Brands"}@font-face{font-family:"Font Awesome 6 Brands";font-style:normal;font-weight:400;font-display:block;src: url("../webfonts/fa-brands-400.woff2") format("woff2"), url("../webfonts/fa-brands-400.ttf") format("truetype"); }.fa-brands,.fab{font-weight:400}.fa-monero:before{content:"\f3d0"}.fa-hooli:before{content:"\f427"}.fa-yelp:before{content:"\f1e9"}.fa-cc-visa:before{content:"\f1f0"}.fa-lastfm:before{content:"\f202"}.fa-shopware:before{content:"\f5b5"}.fa-creative-commons-nc:before{content:"\f4e8"}.fa-aws:before{content:"\f375"}.fa-redhat:before{content:"\f7bc"}.fa-yoast:before{content:"\f2b1"}.fa-cloudflare:before{content:"\e07d"}.fa-ups:before{content:"\f7e0"}.fa-pixiv:before{content:"\e640"}.fa-wpexplorer:before{content:"\f2de"}.fa-dyalog:before{content:"\f399"}.fa-bity:before{content:"\f37a"}.fa-stackpath:before{content:"\f842"}.fa-buysellads:before{content:"\f20d"}.fa-first-order:before{content:"\f2b0"}.fa-modx:before{content:"\f285"}.fa-guilded:before{content:"\e07e"}.fa-vnv:before{content:"\f40b"}.fa-js-square:before,.fa-square-js:before{content:"\f3b9"}.fa-microsoft:before{content:"\f3ca"}.fa-qq:before{content:"\f1d6"}.fa-orcid:before{content:"\f8d2"}.fa-java:before{content:"\f4e4"}.fa-invision:before{content:"\f7b0"}.fa-creative-commons-pd-alt:before{content:"\f4ed"}.fa-centercode:before{content:"\f380"}.fa-glide-g:before{content:"\f2a6"}.fa-drupal:before{content:"\f1a9"}.fa-jxl:before{content:"\e67b"}.fa-hire-a-helper:before{content:"\f3b0"}.fa-creative-commons-by:before{content:"\f4e7"}.fa-unity:before{content:"\e049"}.fa-whmcs:before{content:"\f40d"}.fa-rocketchat:before{content:"\f3e8"}.fa-vk:before{content:"\f189"}.fa-untappd:before{content:"\f405"}.fa-mailchimp:before{content:"\f59e"}.fa-css3-alt:before{content:"\f38b"}.fa-reddit-square:before,.fa-square-reddit:before{content:"\f1a2"}.fa-vimeo-v:before{content:"\f27d"}.fa-contao:before{content:"\f26d"}.fa-square-font-awesome:before{content:"\e5ad"}.fa-deskpro:before{content:"\f38f"}.fa-brave:before{content:"\e63c"}.fa-sistrix:before{content:"\f3ee"}.fa-instagram-square:before,.fa-square-instagram:before{content:"\e055"}.fa-battle-net:before{content:"\f835"}.fa-the-red-yeti:before{content:"\f69d"}.fa-hacker-news-square:before,.fa-square-hacker-news:before{content:"\f3af"}.fa-edge:before{content:"\f282"}.fa-threads:before{content:"\e618"}.fa-napster:before{content:"\f3d2"}.fa-snapchat-square:before,.fa-square-snapchat:before{content:"\f2ad"}.fa-google-plus-g:before{content:"\f0d5"}.fa-artstation:before{content:"\f77a"}.fa-markdown:before{content:"\f60f"}.fa-sourcetree:before{content:"\f7d3"}.fa-google-plus:before{content:"\f2b3"}.fa-diaspora:before{content:"\f791"}.fa-foursquare:before{content:"\f180"}.fa-stack-overflow:before{content:"\f16c"}.fa-github-alt:before{content:"\f113"}.fa-phoenix-squadron:before{content:"\f511"}.fa-pagelines:before{content:"\f18c"}.fa-algolia:before{content:"\f36c"}.fa-red-river:before{content:"\f3e3"}.fa-creative-commons-sa:before{content:"\f4ef"}.fa-safari:before{content:"\f267"}.fa-google:before{content:"\f1a0"}.fa-font-awesome-alt:before,.fa-square-font-awesome-stroke:before{content:"\f35c"}.fa-atlassian:before{content:"\f77b"}.fa-linkedin-in:before{content:"\f0e1"}.fa-digital-ocean:before{content:"\f391"}.fa-nimblr:before{content:"\f5a8"}.fa-chromecast:before{content:"\f838"}.fa-evernote:before{content:"\f839"}.fa-hacker-news:before{content:"\f1d4"}.fa-creative-commons-sampling:before{content:"\f4f0"}.fa-adversal:before{content:"\f36a"}.fa-creative-commons:before{content:"\f25e"}.fa-watchman-monitoring:before{content:"\e087"}.fa-fonticons:before{content:"\f280"}.fa-weixin:before{content:"\f1d7"}.fa-shirtsinbulk:before{content:"\f214"}.fa-codepen:before{content:"\f1cb"}.fa-git-alt:before{content:"\f841"}.fa-lyft:before{content:"\f3c3"}.fa-rev:before{content:"\f5b2"}.fa-windows:before{content:"\f17a"}.fa-wizards-of-the-coast:before{content:"\f730"}.fa-square-viadeo:before,.fa-viadeo-square:before{content:"\f2aa"}.fa-meetup:before{content:"\f2e0"}.fa-centos:before{content:"\f789"}.fa-adn:before{content:"\f170"}.fa-cloudsmith:before{content:"\f384"}.fa-opensuse:before{content:"\e62b"}.fa-pied-piper-alt:before{content:"\f1a8"}.fa-dribbble-square:before,.fa-square-dribbble:before{content:"\f397"}.fa-codiepie:before{content:"\f284"}.fa-node:before{content:"\f419"}.fa-mix:before{content:"\f3cb"}.fa-steam:before{content:"\f1b6"}.fa-cc-apple-pay:before{content:"\f416"}.fa-scribd:before{content:"\f28a"}.fa-debian:before{content:"\e60b"}.fa-openid:before{content:"\f19b"}.fa-instalod:before{content:"\e081"}.fa-expeditedssl:before{content:"\f23e"}.fa-sellcast:before{content:"\f2da"}.fa-square-twitter:before,.fa-twitter-square:before{content:"\f081"}.fa-r-project:before{content:"\f4f7"}.fa-delicious:before{content:"\f1a5"}.fa-freebsd:before{content:"\f3a4"}.fa-vuejs:before{content:"\f41f"}.fa-accusoft:before{content:"\f369"}.fa-ioxhost:before{content:"\f208"}.fa-fonticons-fi:before{content:"\f3a2"}.fa-app-store:before{content:"\f36f"}.fa-cc-mastercard:before{content:"\f1f1"}.fa-itunes-note:before{content:"\f3b5"}.fa-golang:before{content:"\e40f"}.fa-kickstarter:before,.fa-square-kickstarter:before{content:"\f3bb"}.fa-grav:before{content:"\f2d6"}.fa-weibo:before{content:"\f18a"}.fa-uncharted:before{content:"\e084"}.fa-firstdraft:before{content:"\f3a1"}.fa-square-youtube:before,.fa-youtube-square:before{content:"\f431"}.fa-wikipedia-w:before{content:"\f266"}.fa-rendact:before,.fa-wpressr:before{content:"\f3e4"}.fa-angellist:before{content:"\f209"}.fa-galactic-republic:before{content:"\f50c"}.fa-nfc-directional:before{content:"\e530"}.fa-skype:before{content:"\f17e"}.fa-joget:before{content:"\f3b7"}.fa-fedora:before{content:"\f798"}.fa-stripe-s:before{content:"\f42a"}.fa-meta:before{content:"\e49b"}.fa-laravel:before{content:"\f3bd"}.fa-hotjar:before{content:"\f3b1"}.fa-bluetooth-b:before{content:"\f294"}.fa-square-letterboxd:before{content:"\e62e"}.fa-sticker-mule:before{content:"\f3f7"}.fa-creative-commons-zero:before{content:"\f4f3"}.fa-hips:before{content:"\f452"}.fa-behance:before{content:"\f1b4"}.fa-reddit:before{content:"\f1a1"}.fa-discord:before{content:"\f392"}.fa-chrome:before{content:"\f268"}.fa-app-store-ios:before{content:"\f370"}.fa-cc-discover:before{content:"\f1f2"}.fa-wpbeginner:before{content:"\f297"}.fa-confluence:before{content:"\f78d"}.fa-shoelace:before{content:"\e60c"}.fa-mdb:before{content:"\f8ca"}.fa-dochub:before{content:"\f394"}.fa-accessible-icon:before{content:"\f368"}.fa-ebay:before{content:"\f4f4"}.fa-amazon:before{content:"\f270"}.fa-unsplash:before{content:"\e07c"}.fa-yarn:before{content:"\f7e3"}.fa-square-steam:before,.fa-steam-square:before{content:"\f1b7"}.fa-500px:before{content:"\f26e"}.fa-square-vimeo:before,.fa-vimeo-square:before{content:"\f194"}.fa-asymmetrik:before{content:"\f372"}.fa-font-awesome-flag:before,.fa-font-awesome-logo-full:before,.fa-font-awesome:before{content:"\f2b4"}.fa-gratipay:before{content:"\f184"}.fa-apple:before{content:"\f179"}.fa-hive:before{content:"\e07f"}.fa-gitkraken:before{content:"\f3a6"}.fa-keybase:before{content:"\f4f5"}.fa-apple-pay:before{content:"\f415"}.fa-padlet:before{content:"\e4a0"}.fa-amazon-pay:before{content:"\f42c"}.fa-github-square:before,.fa-square-github:before{content:"\f092"}.fa-stumbleupon:before{content:"\f1a4"}.fa-fedex:before{content:"\f797"}.fa-phoenix-framework:before{content:"\f3dc"}.fa-shopify:before{content:"\e057"}.fa-neos:before{content:"\f612"}.fa-square-threads:before{content:"\e619"}.fa-hackerrank:before{content:"\f5f7"}.fa-researchgate:before{content:"\f4f8"}.fa-swift:before{content:"\f8e1"}.fa-angular:before{content:"\f420"}.fa-speakap:before{content:"\f3f3"}.fa-angrycreative:before{content:"\f36e"}.fa-y-combinator:before{content:"\f23b"}.fa-empire:before{content:"\f1d1"}.fa-envira:before{content:"\f299"}.fa-google-scholar:before{content:"\e63b"}.fa-gitlab-square:before,.fa-square-gitlab:before{content:"\e5ae"}.fa-studiovinari:before{content:"\f3f8"}.fa-pied-piper:before{content:"\f2ae"}.fa-wordpress:before{content:"\f19a"}.fa-product-hunt:before{content:"\f288"}.fa-firefox:before{content:"\f269"}.fa-linode:before{content:"\f2b8"}.fa-goodreads:before{content:"\f3a8"}.fa-odnoklassniki-square:before,.fa-square-odnoklassniki:before{content:"\f264"}.fa-jsfiddle:before{content:"\f1cc"}.fa-sith:before{content:"\f512"}.fa-themeisle:before{content:"\f2b2"}.fa-page4:before{content:"\f3d7"}.fa-hashnode:before{content:"\e499"}.fa-react:before{content:"\f41b"}.fa-cc-paypal:before{content:"\f1f4"}.fa-squarespace:before{content:"\f5be"}.fa-cc-stripe:before{content:"\f1f5"}.fa-creative-commons-share:before{content:"\f4f2"}.fa-bitcoin:before{content:"\f379"}.fa-keycdn:before{content:"\f3ba"}.fa-opera:before{content:"\f26a"}.fa-itch-io:before{content:"\f83a"}.fa-umbraco:before{content:"\f8e8"}.fa-galactic-senate:before{content:"\f50d"}.fa-ubuntu:before{content:"\f7df"}.fa-draft2digital:before{content:"\f396"}.fa-stripe:before{content:"\f429"}.fa-houzz:before{content:"\f27c"}.fa-gg:before{content:"\f260"}.fa-dhl:before{content:"\f790"}.fa-pinterest-square:before,.fa-square-pinterest:before{content:"\f0d3"}.fa-xing:before{content:"\f168"}.fa-blackberry:before{content:"\f37b"}.fa-creative-commons-pd:before{content:"\f4ec"}.fa-playstation:before{content:"\f3df"}.fa-quinscape:before{content:"\f459"}.fa-less:before{content:"\f41d"}.fa-blogger-b:before{content:"\f37d"}.fa-opencart:before{content:"\f23d"}.fa-vine:before{content:"\f1ca"}.fa-signal-messenger:before{content:"\e663"}.fa-paypal:before{content:"\f1ed"}.fa-gitlab:before{content:"\f296"}.fa-typo3:before{content:"\f42b"}.fa-reddit-alien:before{content:"\f281"}.fa-yahoo:before{content:"\f19e"}.fa-dailymotion:before{content:"\e052"}.fa-affiliatetheme:before{content:"\f36b"}.fa-pied-piper-pp:before{content:"\f1a7"}.fa-bootstrap:before{content:"\f836"}.fa-odnoklassniki:before{content:"\f263"}.fa-nfc-symbol:before{content:"\e531"}.fa-mintbit:before{content:"\e62f"}.fa-ethereum:before{content:"\f42e"}.fa-speaker-deck:before{content:"\f83c"}.fa-creative-commons-nc-eu:before{content:"\f4e9"}.fa-patreon:before{content:"\f3d9"}.fa-avianex:before{content:"\f374"}.fa-ello:before{content:"\f5f1"}.fa-gofore:before{content:"\f3a7"}.fa-bimobject:before{content:"\f378"}.fa-brave-reverse:before{content:"\e63d"}.fa-facebook-f:before{content:"\f39e"}.fa-google-plus-square:before,.fa-square-google-plus:before{content:"\f0d4"}.fa-web-awesome:before{content:"\e682"}.fa-mandalorian:before{content:"\f50f"}.fa-first-order-alt:before{content:"\f50a"}.fa-osi:before{content:"\f41a"}.fa-google-wallet:before{content:"\f1ee"}.fa-d-and-d-beyond:before{content:"\f6ca"}.fa-periscope:before{content:"\f3da"}.fa-fulcrum:before{content:"\f50b"}.fa-cloudscale:before{content:"\f383"}.fa-forumbee:before{content:"\f211"}.fa-mizuni:before{content:"\f3cc"}.fa-schlix:before{content:"\f3ea"}.fa-square-xing:before,.fa-xing-square:before{content:"\f169"}.fa-bandcamp:before{content:"\f2d5"}.fa-wpforms:before{content:"\f298"}.fa-cloudversify:before{content:"\f385"}.fa-usps:before{content:"\f7e1"}.fa-megaport:before{content:"\f5a3"}.fa-magento:before{content:"\f3c4"}.fa-spotify:before{content:"\f1bc"}.fa-optin-monster:before{content:"\f23c"}.fa-fly:before{content:"\f417"}.fa-aviato:before{content:"\f421"}.fa-itunes:before{content:"\f3b4"}.fa-cuttlefish:before{content:"\f38c"}.fa-blogger:before{content:"\f37c"}.fa-flickr:before{content:"\f16e"}.fa-viber:before{content:"\f409"}.fa-soundcloud:before{content:"\f1be"}.fa-digg:before{content:"\f1a6"}.fa-tencent-weibo:before{content:"\f1d5"}.fa-letterboxd:before{content:"\e62d"}.fa-symfony:before{content:"\f83d"}.fa-maxcdn:before{content:"\f136"}.fa-etsy:before{content:"\f2d7"}.fa-facebook-messenger:before{content:"\f39f"}.fa-audible:before{content:"\f373"}.fa-think-peaks:before{content:"\f731"}.fa-bilibili:before{content:"\e3d9"}.fa-erlang:before{content:"\f39d"}.fa-x-twitter:before{content:"\e61b"}.fa-cotton-bureau:before{content:"\f89e"}.fa-dashcube:before{content:"\f210"}.fa-42-group:before,.fa-innosoft:before{content:"\e080"}.fa-stack-exchange:before{content:"\f18d"}.fa-elementor:before{content:"\f430"}.fa-pied-piper-square:before,.fa-square-pied-piper:before{content:"\e01e"}.fa-creative-commons-nd:before{content:"\f4eb"}.fa-palfed:before{content:"\f3d8"}.fa-superpowers:before{content:"\f2dd"}.fa-resolving:before{content:"\f3e7"}.fa-xbox:before{content:"\f412"}.fa-square-web-awesome-stroke:before{content:"\e684"}.fa-searchengin:before{content:"\f3eb"}.fa-tiktok:before{content:"\e07b"}.fa-facebook-square:before,.fa-square-facebook:before{content:"\f082"}.fa-renren:before{content:"\f18b"}.fa-linux:before{content:"\f17c"}.fa-glide:before{content:"\f2a5"}.fa-linkedin:before{content:"\f08c"}.fa-hubspot:before{content:"\f3b2"}.fa-deploydog:before{content:"\f38e"}.fa-twitch:before{content:"\f1e8"}.fa-ravelry:before{content:"\f2d9"}.fa-mixer:before{content:"\e056"}.fa-lastfm-square:before,.fa-square-lastfm:before{content:"\f203"}.fa-vimeo:before{content:"\f40a"}.fa-mendeley:before{content:"\f7b3"}.fa-uniregistry:before{content:"\f404"}.fa-figma:before{content:"\f799"}.fa-creative-commons-remix:before{content:"\f4ee"}.fa-cc-amazon-pay:before{content:"\f42d"}.fa-dropbox:before{content:"\f16b"}.fa-instagram:before{content:"\f16d"}.fa-cmplid:before{content:"\e360"}.fa-upwork:before{content:"\e641"}.fa-facebook:before{content:"\f09a"}.fa-gripfire:before{content:"\f3ac"}.fa-jedi-order:before{content:"\f50e"}.fa-uikit:before{content:"\f403"}.fa-fort-awesome-alt:before{content:"\f3a3"}.fa-phabricator:before{content:"\f3db"}.fa-ussunnah:before{content:"\f407"}.fa-earlybirds:before{content:"\f39a"}.fa-trade-federation:before{content:"\f513"}.fa-autoprefixer:before{content:"\f41c"}.fa-whatsapp:before{content:"\f232"}.fa-square-upwork:before{content:"\e67c"}.fa-slideshare:before{content:"\f1e7"}.fa-google-play:before{content:"\f3ab"}.fa-viadeo:before{content:"\f2a9"}.fa-line:before{content:"\f3c0"}.fa-google-drive:before{content:"\f3aa"}.fa-servicestack:before{content:"\f3ec"}.fa-simplybuilt:before{content:"\f215"}.fa-bitbucket:before{content:"\f171"}.fa-imdb:before{content:"\f2d8"}.fa-deezer:before{content:"\e077"}.fa-raspberry-pi:before{content:"\f7bb"}.fa-jira:before{content:"\f7b1"}.fa-docker:before{content:"\f395"}.fa-screenpal:before{content:"\e570"}.fa-bluetooth:before{content:"\f293"}.fa-gitter:before{content:"\f426"}.fa-d-and-d:before{content:"\f38d"}.fa-microblog:before{content:"\e01a"}.fa-cc-diners-club:before{content:"\f24c"}.fa-gg-circle:before{content:"\f261"}.fa-pied-piper-hat:before{content:"\f4e5"}.fa-kickstarter-k:before{content:"\f3bc"}.fa-yandex:before{content:"\f413"}.fa-readme:before{content:"\f4d5"}.fa-html5:before{content:"\f13b"}.fa-sellsy:before{content:"\f213"}.fa-square-web-awesome:before{content:"\e683"}.fa-sass:before{content:"\f41e"}.fa-wirsindhandwerk:before,.fa-wsh:before{content:"\e2d0"}.fa-buromobelexperte:before{content:"\f37f"}.fa-salesforce:before{content:"\f83b"}.fa-octopus-deploy:before{content:"\e082"}.fa-medapps:before{content:"\f3c6"}.fa-ns8:before{content:"\f3d5"}.fa-pinterest-p:before{content:"\f231"}.fa-apper:before{content:"\f371"}.fa-fort-awesome:before{content:"\f286"}.fa-waze:before{content:"\f83f"}.fa-bluesky:before{content:"\e671"}.fa-cc-jcb:before{content:"\f24b"}.fa-snapchat-ghost:before,.fa-snapchat:before{content:"\f2ab"}.fa-fantasy-flight-games:before{content:"\f6dc"}.fa-rust:before{content:"\e07a"}.fa-wix:before{content:"\f5cf"}.fa-behance-square:before,.fa-square-behance:before{content:"\f1b5"}.fa-supple:before{content:"\f3f9"}.fa-webflow:before{content:"\e65c"}.fa-rebel:before{content:"\f1d0"}.fa-css3:before{content:"\f13c"}.fa-staylinked:before{content:"\f3f5"}.fa-kaggle:before{content:"\f5fa"}.fa-space-awesome:before{content:"\e5ac"}.fa-deviantart:before{content:"\f1bd"}.fa-cpanel:before{content:"\f388"}.fa-goodreads-g:before{content:"\f3a9"}.fa-git-square:before,.fa-square-git:before{content:"\f1d2"}.fa-square-tumblr:before,.fa-tumblr-square:before{content:"\f174"}.fa-trello:before{content:"\f181"}.fa-creative-commons-nc-jp:before{content:"\f4ea"}.fa-get-pocket:before{content:"\f265"}.fa-perbyte:before{content:"\e083"}.fa-grunt:before{content:"\f3ad"}.fa-weebly:before{content:"\f5cc"}.fa-connectdevelop:before{content:"\f20e"}.fa-leanpub:before{content:"\f212"}.fa-black-tie:before{content:"\f27e"}.fa-themeco:before{content:"\f5c6"}.fa-python:before{content:"\f3e2"}.fa-android:before{content:"\f17b"}.fa-bots:before{content:"\e340"}.fa-free-code-camp:before{content:"\f2c5"}.fa-hornbill:before{content:"\f592"}.fa-js:before{content:"\f3b8"}.fa-ideal:before{content:"\e013"}.fa-git:before{content:"\f1d3"}.fa-dev:before{content:"\f6cc"}.fa-sketch:before{content:"\f7c6"}.fa-yandex-international:before{content:"\f414"}.fa-cc-amex:before{content:"\f1f3"}.fa-uber:before{content:"\f402"}.fa-github:before{content:"\f09b"}.fa-php:before{content:"\f457"}.fa-alipay:before{content:"\f642"}.fa-youtube:before{content:"\f167"}.fa-skyatlas:before{content:"\f216"}.fa-firefox-browser:before{content:"\e007"}.fa-replyd:before{content:"\f3e6"}.fa-suse:before{content:"\f7d6"}.fa-jenkins:before{content:"\f3b6"}.fa-twitter:before{content:"\f099"}.fa-rockrms:before{content:"\f3e9"}.fa-pinterest:before{content:"\f0d2"}.fa-buffer:before{content:"\f837"}.fa-npm:before{content:"\f3d4"}.fa-yammer:before{content:"\f840"}.fa-btc:before{content:"\f15a"}.fa-dribbble:before{content:"\f17d"}.fa-stumbleupon-circle:before{content:"\f1a3"}.fa-internet-explorer:before{content:"\f26b"}.fa-stubber:before{content:"\e5c7"}.fa-telegram-plane:before,.fa-telegram:before{content:"\f2c6"}.fa-old-republic:before{content:"\f510"}.fa-odysee:before{content:"\e5c6"}.fa-square-whatsapp:before,.fa-whatsapp-square:before{content:"\f40c"}.fa-node-js:before{content:"\f3d3"}.fa-edge-legacy:before{content:"\e078"}.fa-slack-hash:before,.fa-slack:before{content:"\f198"}.fa-medrt:before{content:"\f3c8"}.fa-usb:before{content:"\f287"}.fa-tumblr:before{content:"\f173"}.fa-vaadin:before{content:"\f408"}.fa-quora:before{content:"\f2c4"}.fa-square-x-twitter:before{content:"\e61a"}.fa-reacteurope:before{content:"\f75d"}.fa-medium-m:before,.fa-medium:before{content:"\f23a"}.fa-amilia:before{content:"\f36d"}.fa-mixcloud:before{content:"\f289"}.fa-flipboard:before{content:"\f44d"}.fa-viacoin:before{content:"\f237"}.fa-critical-role:before{content:"\f6c9"}.fa-sitrox:before{content:"\e44a"}.fa-discourse:before{content:"\f393"}.fa-joomla:before{content:"\f1aa"}.fa-mastodon:before{content:"\f4f6"}.fa-airbnb:before{content:"\f834"}.fa-wolf-pack-battalion:before{content:"\f514"}.fa-buy-n-large:before{content:"\f8a6"}.fa-gulp:before{content:"\f3ae"}.fa-creative-commons-sampling-plus:before{content:"\f4f1"}.fa-strava:before{content:"\f428"}.fa-ember:before{content:"\f423"}.fa-canadian-maple-leaf:before{content:"\f785"}.fa-teamspeak:before{content:"\f4f9"}.fa-pushed:before{content:"\f3e1"}.fa-wordpress-simple:before{content:"\f411"}.fa-nutritionix:before{content:"\f3d6"}.fa-wodu:before{content:"\e088"}.fa-google-pay:before{content:"\e079"}.fa-intercom:before{content:"\f7af"}.fa-zhihu:before{content:"\f63f"}.fa-korvue:before{content:"\f42f"}.fa-pix:before{content:"\e43a"}.fa-steam-symbol:before{content:"\f3f6"}:host,:root{--fa-font-regular:normal 400 1em/1 "Font Awesome 6 Free"}@font-face{font-family:"Font Awesome 6 Free";font-style:normal;font-weight:400;font-display:block;src: url("../webfonts/fa-regular-400.woff2") format("woff2"), url("../webfonts/fa-regular-400.ttf") format("truetype"); }.fa-regular,.far{font-weight:400}:host,:root{--fa-style-family-classic:"Font Awesome 6 Free";--fa-font-solid:normal 900 1em/1 "Font Awesome 6 Free"}@font-face{font-family:"Font Awesome 6 Free";font-style:normal;font-weight:900;font-display:block;src: url("../webfonts/fa-solid-900.woff2") format("woff2"), url("../webfonts/fa-solid-900.ttf") format("truetype"); }.fa-solid,.fas{font-weight:900}@font-face{font-family:"Font Awesome 5 Brands";font-display:block;font-weight:400;src: url("../webfonts/fa-brands-400.woff2") format("woff2"), url("../webfonts/fa-brands-400.ttf") format("truetype"); }@font-face{font-family:"Font Awesome 5 Free";font-display:block;font-weight:900;src: url("../webfonts/fa-solid-900.woff2") format("woff2"), url("../webfonts/fa-solid-900.ttf") format("truetype"); }@font-face{font-family:"Font Awesome 5 Free";font-display:block;font-weight:400;src: url("../webfonts/fa-regular-400.woff2") format("woff2"), url("../webfonts/fa-regular-400.ttf") format("truetype"); }@font-face{font-family:"FontAwesome";font-display:block;src: url("../webfonts/fa-solid-900.woff2") format("woff2"), url("../webfonts/fa-solid-900.ttf") format("truetype"); }@font-face{font-family:"FontAwesome";font-display:block;src: url("../webfonts/fa-brands-400.woff2") format("woff2"), url("../webfonts/fa-brands-400.ttf") format("truetype"); }@font-face{font-family:"FontAwesome";font-display:block;src: url("../webfonts/fa-regular-400.woff2") format("woff2"), url("../webfonts/fa-regular-400.ttf") format("truetype"); }@font-face{font-family:"FontAwesome";font-display:block;src: url("../webfonts/fa-v4compatibility.woff2") format("woff2"), url("../webfonts/fa-v4compatibility.ttf") format("truetype"); } \ No newline at end of file diff --git a/docs/deps/font-awesome-6.5.2/css/v4-shims.css b/docs/deps/font-awesome-6.5.2/css/v4-shims.css new file mode 100644 index 00000000..ea60ea4d --- /dev/null +++ b/docs/deps/font-awesome-6.5.2/css/v4-shims.css @@ -0,0 +1,2194 @@ +/*! + * Font Awesome Free 6.5.2 by @fontawesome - https://fontawesome.com + * License - https://fontawesome.com/license/free (Icons: CC BY 4.0, Fonts: SIL OFL 1.1, Code: MIT License) + * Copyright 2024 Fonticons, Inc. + */ +.fa.fa-glass:before { + content: "\f000"; } + +.fa.fa-envelope-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-envelope-o:before { + content: "\f0e0"; } + +.fa.fa-star-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-star-o:before { + content: "\f005"; } + +.fa.fa-remove:before { + content: "\f00d"; } + +.fa.fa-close:before { + content: "\f00d"; } + +.fa.fa-gear:before { + content: "\f013"; } + +.fa.fa-trash-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-trash-o:before { + content: "\f2ed"; } + +.fa.fa-home:before { + content: "\f015"; } + +.fa.fa-file-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-file-o:before { + content: "\f15b"; } + +.fa.fa-clock-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-clock-o:before { + content: "\f017"; } + +.fa.fa-arrow-circle-o-down { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-arrow-circle-o-down:before { + content: "\f358"; } + +.fa.fa-arrow-circle-o-up { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-arrow-circle-o-up:before { + content: "\f35b"; } + +.fa.fa-play-circle-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-play-circle-o:before { + content: "\f144"; } + +.fa.fa-repeat:before { + content: "\f01e"; } + +.fa.fa-rotate-right:before { + content: "\f01e"; } + +.fa.fa-refresh:before { + content: "\f021"; } + +.fa.fa-list-alt { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-list-alt:before { + content: "\f022"; } + +.fa.fa-dedent:before { + content: "\f03b"; } + +.fa.fa-video-camera:before { + content: "\f03d"; } + +.fa.fa-picture-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-picture-o:before { + content: "\f03e"; } + +.fa.fa-photo { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-photo:before { + content: "\f03e"; } + +.fa.fa-image { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-image:before { + content: "\f03e"; } + +.fa.fa-map-marker:before { + content: "\f3c5"; } + +.fa.fa-pencil-square-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-pencil-square-o:before { + content: "\f044"; } + +.fa.fa-edit { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-edit:before { + content: "\f044"; } + +.fa.fa-share-square-o:before { + content: "\f14d"; } + +.fa.fa-check-square-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-check-square-o:before { + content: "\f14a"; } + +.fa.fa-arrows:before { + content: "\f0b2"; } + +.fa.fa-times-circle-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-times-circle-o:before { + content: "\f057"; } + +.fa.fa-check-circle-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-check-circle-o:before { + content: "\f058"; } + +.fa.fa-mail-forward:before { + content: "\f064"; } + +.fa.fa-expand:before { + content: "\f424"; } + +.fa.fa-compress:before { + content: "\f422"; } + +.fa.fa-eye { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-eye-slash { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-warning:before { + content: "\f071"; } + +.fa.fa-calendar:before { + content: "\f073"; } + +.fa.fa-arrows-v:before { + content: "\f338"; } + +.fa.fa-arrows-h:before { + content: "\f337"; } + +.fa.fa-bar-chart:before { + content: "\e0e3"; } + +.fa.fa-bar-chart-o:before { + content: "\e0e3"; } + +.fa.fa-twitter-square { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-twitter-square:before { + content: "\f081"; } + +.fa.fa-facebook-square { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-facebook-square:before { + content: "\f082"; } + +.fa.fa-gears:before { + content: "\f085"; } + +.fa.fa-thumbs-o-up { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-thumbs-o-up:before { + content: "\f164"; } + +.fa.fa-thumbs-o-down { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-thumbs-o-down:before { + content: "\f165"; } + +.fa.fa-heart-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-heart-o:before { + content: "\f004"; } + +.fa.fa-sign-out:before { + content: "\f2f5"; } + +.fa.fa-linkedin-square { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-linkedin-square:before { + content: "\f08c"; } + +.fa.fa-thumb-tack:before { + content: "\f08d"; } + +.fa.fa-external-link:before { + content: "\f35d"; } + +.fa.fa-sign-in:before { + content: "\f2f6"; } + +.fa.fa-github-square { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-github-square:before { + content: "\f092"; } + +.fa.fa-lemon-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-lemon-o:before { + content: "\f094"; } + +.fa.fa-square-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-square-o:before { + content: "\f0c8"; } + +.fa.fa-bookmark-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-bookmark-o:before { + content: "\f02e"; } + +.fa.fa-twitter { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-facebook { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-facebook:before { + content: "\f39e"; } + +.fa.fa-facebook-f { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-facebook-f:before { + content: "\f39e"; } + +.fa.fa-github { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-credit-card { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-feed:before { + content: "\f09e"; } + +.fa.fa-hdd-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-hdd-o:before { + content: "\f0a0"; } + +.fa.fa-hand-o-right { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-hand-o-right:before { + content: "\f0a4"; } + +.fa.fa-hand-o-left { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-hand-o-left:before { + content: "\f0a5"; } + +.fa.fa-hand-o-up { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-hand-o-up:before { + content: "\f0a6"; } + +.fa.fa-hand-o-down { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-hand-o-down:before { + content: "\f0a7"; } + +.fa.fa-globe:before { + content: "\f57d"; } + +.fa.fa-tasks:before { + content: "\f828"; } + +.fa.fa-arrows-alt:before { + content: "\f31e"; } + +.fa.fa-group:before { + content: "\f0c0"; } + +.fa.fa-chain:before { + content: "\f0c1"; } + +.fa.fa-cut:before { + content: "\f0c4"; } + +.fa.fa-files-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-files-o:before { + content: "\f0c5"; } + +.fa.fa-floppy-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-floppy-o:before { + content: "\f0c7"; } + +.fa.fa-save { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-save:before { + content: "\f0c7"; } + +.fa.fa-navicon:before { + content: "\f0c9"; } + +.fa.fa-reorder:before { + content: "\f0c9"; } + +.fa.fa-magic:before { + content: "\e2ca"; } + +.fa.fa-pinterest { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-pinterest-square { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-pinterest-square:before { + content: "\f0d3"; } + +.fa.fa-google-plus-square { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-google-plus-square:before { + content: "\f0d4"; } + +.fa.fa-google-plus { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-google-plus:before { + content: "\f0d5"; } + +.fa.fa-money:before { + content: "\f3d1"; } + +.fa.fa-unsorted:before { + content: "\f0dc"; } + +.fa.fa-sort-desc:before { + content: "\f0dd"; } + +.fa.fa-sort-asc:before { + content: "\f0de"; } + +.fa.fa-linkedin { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-linkedin:before { + content: "\f0e1"; } + +.fa.fa-rotate-left:before { + content: "\f0e2"; } + +.fa.fa-legal:before { + content: "\f0e3"; } + +.fa.fa-tachometer:before { + content: "\f625"; } + +.fa.fa-dashboard:before { + content: "\f625"; } + +.fa.fa-comment-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-comment-o:before { + content: "\f075"; } + +.fa.fa-comments-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-comments-o:before { + content: "\f086"; } + +.fa.fa-flash:before { + content: "\f0e7"; } + +.fa.fa-clipboard:before { + content: "\f0ea"; } + +.fa.fa-lightbulb-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-lightbulb-o:before { + content: "\f0eb"; } + +.fa.fa-exchange:before { + content: "\f362"; } + +.fa.fa-cloud-download:before { + content: "\f0ed"; } + +.fa.fa-cloud-upload:before { + content: "\f0ee"; } + +.fa.fa-bell-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-bell-o:before { + content: "\f0f3"; } + +.fa.fa-cutlery:before { + content: "\f2e7"; } + +.fa.fa-file-text-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-file-text-o:before { + content: "\f15c"; } + +.fa.fa-building-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-building-o:before { + content: "\f1ad"; } + +.fa.fa-hospital-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-hospital-o:before { + content: "\f0f8"; } + +.fa.fa-tablet:before { + content: "\f3fa"; } + +.fa.fa-mobile:before { + content: "\f3cd"; } + +.fa.fa-mobile-phone:before { + content: "\f3cd"; } + +.fa.fa-circle-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-circle-o:before { + content: "\f111"; } + +.fa.fa-mail-reply:before { + content: "\f3e5"; } + +.fa.fa-github-alt { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-folder-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-folder-o:before { + content: "\f07b"; } + +.fa.fa-folder-open-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-folder-open-o:before { + content: "\f07c"; } + +.fa.fa-smile-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-smile-o:before { + content: "\f118"; } + +.fa.fa-frown-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-frown-o:before { + content: "\f119"; } + +.fa.fa-meh-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-meh-o:before { + content: "\f11a"; } + +.fa.fa-keyboard-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-keyboard-o:before { + content: "\f11c"; } + +.fa.fa-flag-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-flag-o:before { + content: "\f024"; } + +.fa.fa-mail-reply-all:before { + content: "\f122"; } + +.fa.fa-star-half-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-star-half-o:before { + content: "\f5c0"; } + +.fa.fa-star-half-empty { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-star-half-empty:before { + content: "\f5c0"; } + +.fa.fa-star-half-full { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-star-half-full:before { + content: "\f5c0"; } + +.fa.fa-code-fork:before { + content: "\f126"; } + +.fa.fa-chain-broken:before { + content: "\f127"; } + +.fa.fa-unlink:before { + content: "\f127"; } + +.fa.fa-calendar-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-calendar-o:before { + content: "\f133"; } + +.fa.fa-maxcdn { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-html5 { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-css3 { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-unlock-alt:before { + content: "\f09c"; } + +.fa.fa-minus-square-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-minus-square-o:before { + content: "\f146"; } + +.fa.fa-level-up:before { + content: "\f3bf"; } + +.fa.fa-level-down:before { + content: "\f3be"; } + +.fa.fa-pencil-square:before { + content: "\f14b"; } + +.fa.fa-external-link-square:before { + content: "\f360"; } + +.fa.fa-compass { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-caret-square-o-down { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-caret-square-o-down:before { + content: "\f150"; } + +.fa.fa-toggle-down { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-toggle-down:before { + content: "\f150"; } + +.fa.fa-caret-square-o-up { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-caret-square-o-up:before { + content: "\f151"; } + +.fa.fa-toggle-up { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-toggle-up:before { + content: "\f151"; } + +.fa.fa-caret-square-o-right { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-caret-square-o-right:before { + content: "\f152"; } + +.fa.fa-toggle-right { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-toggle-right:before { + content: "\f152"; } + +.fa.fa-eur:before { + content: "\f153"; } + +.fa.fa-euro:before { + content: "\f153"; } + +.fa.fa-gbp:before { + content: "\f154"; } + +.fa.fa-usd:before { + content: "\24"; } + +.fa.fa-dollar:before { + content: "\24"; } + +.fa.fa-inr:before { + content: "\e1bc"; } + +.fa.fa-rupee:before { + content: "\e1bc"; } + +.fa.fa-jpy:before { + content: "\f157"; } + +.fa.fa-cny:before { + content: "\f157"; } + +.fa.fa-rmb:before { + content: "\f157"; } + +.fa.fa-yen:before { + content: "\f157"; } + +.fa.fa-rub:before { + content: "\f158"; } + +.fa.fa-ruble:before { + content: "\f158"; } + +.fa.fa-rouble:before { + content: "\f158"; } + +.fa.fa-krw:before { + content: "\f159"; } + +.fa.fa-won:before { + content: "\f159"; } + +.fa.fa-btc { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-bitcoin { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-bitcoin:before { + content: "\f15a"; } + +.fa.fa-file-text:before { + content: "\f15c"; } + +.fa.fa-sort-alpha-asc:before { + content: "\f15d"; } + +.fa.fa-sort-alpha-desc:before { + content: "\f881"; } + +.fa.fa-sort-amount-asc:before { + content: "\f884"; } + +.fa.fa-sort-amount-desc:before { + content: "\f160"; } + +.fa.fa-sort-numeric-asc:before { + content: "\f162"; } + +.fa.fa-sort-numeric-desc:before { + content: "\f886"; } + +.fa.fa-youtube-square { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-youtube-square:before { + content: "\f431"; } + +.fa.fa-youtube { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-xing { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-xing-square { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-xing-square:before { + content: "\f169"; } + +.fa.fa-youtube-play { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-youtube-play:before { + content: "\f167"; } + +.fa.fa-dropbox { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-stack-overflow { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-instagram { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-flickr { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-adn { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-bitbucket { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-bitbucket-square { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-bitbucket-square:before { + content: "\f171"; } + +.fa.fa-tumblr { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-tumblr-square { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-tumblr-square:before { + content: "\f174"; } + +.fa.fa-long-arrow-down:before { + content: "\f309"; } + +.fa.fa-long-arrow-up:before { + content: "\f30c"; } + +.fa.fa-long-arrow-left:before { + content: "\f30a"; } + +.fa.fa-long-arrow-right:before { + content: "\f30b"; } + +.fa.fa-apple { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-windows { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-android { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-linux { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-dribbble { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-skype { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-foursquare { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-trello { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-gratipay { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-gittip { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-gittip:before { + content: "\f184"; } + +.fa.fa-sun-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-sun-o:before { + content: "\f185"; } + +.fa.fa-moon-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-moon-o:before { + content: "\f186"; } + +.fa.fa-vk { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-weibo { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-renren { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-pagelines { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-stack-exchange { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-arrow-circle-o-right { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-arrow-circle-o-right:before { + content: "\f35a"; } + +.fa.fa-arrow-circle-o-left { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-arrow-circle-o-left:before { + content: "\f359"; } + +.fa.fa-caret-square-o-left { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-caret-square-o-left:before { + content: "\f191"; } + +.fa.fa-toggle-left { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-toggle-left:before { + content: "\f191"; } + +.fa.fa-dot-circle-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-dot-circle-o:before { + content: "\f192"; } + +.fa.fa-vimeo-square { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-vimeo-square:before { + content: "\f194"; } + +.fa.fa-try:before { + content: "\e2bb"; } + +.fa.fa-turkish-lira:before { + content: "\e2bb"; } + +.fa.fa-plus-square-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-plus-square-o:before { + content: "\f0fe"; } + +.fa.fa-slack { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-wordpress { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-openid { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-institution:before { + content: "\f19c"; } + +.fa.fa-bank:before { + content: "\f19c"; } + +.fa.fa-mortar-board:before { + content: "\f19d"; } + +.fa.fa-yahoo { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-google { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-reddit { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-reddit-square { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-reddit-square:before { + content: "\f1a2"; } + +.fa.fa-stumbleupon-circle { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-stumbleupon { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-delicious { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-digg { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-pied-piper-pp { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-pied-piper-alt { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-drupal { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-joomla { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-behance { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-behance-square { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-behance-square:before { + content: "\f1b5"; } + +.fa.fa-steam { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-steam-square { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-steam-square:before { + content: "\f1b7"; } + +.fa.fa-automobile:before { + content: "\f1b9"; } + +.fa.fa-cab:before { + content: "\f1ba"; } + +.fa.fa-spotify { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-deviantart { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-soundcloud { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-file-pdf-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-file-pdf-o:before { + content: "\f1c1"; } + +.fa.fa-file-word-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-file-word-o:before { + content: "\f1c2"; } + +.fa.fa-file-excel-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-file-excel-o:before { + content: "\f1c3"; } + +.fa.fa-file-powerpoint-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-file-powerpoint-o:before { + content: "\f1c4"; } + +.fa.fa-file-image-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-file-image-o:before { + content: "\f1c5"; } + +.fa.fa-file-photo-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-file-photo-o:before { + content: "\f1c5"; } + +.fa.fa-file-picture-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-file-picture-o:before { + content: "\f1c5"; } + +.fa.fa-file-archive-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-file-archive-o:before { + content: "\f1c6"; } + +.fa.fa-file-zip-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-file-zip-o:before { + content: "\f1c6"; } + +.fa.fa-file-audio-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-file-audio-o:before { + content: "\f1c7"; } + +.fa.fa-file-sound-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-file-sound-o:before { + content: "\f1c7"; } + +.fa.fa-file-video-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-file-video-o:before { + content: "\f1c8"; } + +.fa.fa-file-movie-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-file-movie-o:before { + content: "\f1c8"; } + +.fa.fa-file-code-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-file-code-o:before { + content: "\f1c9"; } + +.fa.fa-vine { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-codepen { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-jsfiddle { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-life-bouy:before { + content: "\f1cd"; } + +.fa.fa-life-buoy:before { + content: "\f1cd"; } + +.fa.fa-life-saver:before { + content: "\f1cd"; } + +.fa.fa-support:before { + content: "\f1cd"; } + +.fa.fa-circle-o-notch:before { + content: "\f1ce"; } + +.fa.fa-rebel { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-ra { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-ra:before { + content: "\f1d0"; } + +.fa.fa-resistance { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-resistance:before { + content: "\f1d0"; } + +.fa.fa-empire { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-ge { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-ge:before { + content: "\f1d1"; } + +.fa.fa-git-square { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-git-square:before { + content: "\f1d2"; } + +.fa.fa-git { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-hacker-news { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-y-combinator-square { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-y-combinator-square:before { + content: "\f1d4"; } + +.fa.fa-yc-square { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-yc-square:before { + content: "\f1d4"; } + +.fa.fa-tencent-weibo { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-qq { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-weixin { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-wechat { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-wechat:before { + content: "\f1d7"; } + +.fa.fa-send:before { + content: "\f1d8"; } + +.fa.fa-paper-plane-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-paper-plane-o:before { + content: "\f1d8"; } + +.fa.fa-send-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-send-o:before { + content: "\f1d8"; } + +.fa.fa-circle-thin { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-circle-thin:before { + content: "\f111"; } + +.fa.fa-header:before { + content: "\f1dc"; } + +.fa.fa-futbol-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-futbol-o:before { + content: "\f1e3"; } + +.fa.fa-soccer-ball-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-soccer-ball-o:before { + content: "\f1e3"; } + +.fa.fa-slideshare { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-twitch { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-yelp { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-newspaper-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-newspaper-o:before { + content: "\f1ea"; } + +.fa.fa-paypal { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-google-wallet { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-cc-visa { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-cc-mastercard { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-cc-discover { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-cc-amex { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-cc-paypal { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-cc-stripe { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-bell-slash-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-bell-slash-o:before { + content: "\f1f6"; } + +.fa.fa-trash:before { + content: "\f2ed"; } + +.fa.fa-copyright { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-eyedropper:before { + content: "\f1fb"; } + +.fa.fa-area-chart:before { + content: "\f1fe"; } + +.fa.fa-pie-chart:before { + content: "\f200"; } + +.fa.fa-line-chart:before { + content: "\f201"; } + +.fa.fa-lastfm { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-lastfm-square { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-lastfm-square:before { + content: "\f203"; } + +.fa.fa-ioxhost { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-angellist { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-cc { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-cc:before { + content: "\f20a"; } + +.fa.fa-ils:before { + content: "\f20b"; } + +.fa.fa-shekel:before { + content: "\f20b"; } + +.fa.fa-sheqel:before { + content: "\f20b"; } + +.fa.fa-buysellads { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-connectdevelop { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-dashcube { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-forumbee { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-leanpub { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-sellsy { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-shirtsinbulk { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-simplybuilt { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-skyatlas { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-diamond { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-diamond:before { + content: "\f3a5"; } + +.fa.fa-transgender:before { + content: "\f224"; } + +.fa.fa-intersex:before { + content: "\f224"; } + +.fa.fa-transgender-alt:before { + content: "\f225"; } + +.fa.fa-facebook-official { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-facebook-official:before { + content: "\f09a"; } + +.fa.fa-pinterest-p { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-whatsapp { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-hotel:before { + content: "\f236"; } + +.fa.fa-viacoin { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-medium { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-y-combinator { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-yc { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-yc:before { + content: "\f23b"; } + +.fa.fa-optin-monster { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-opencart { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-expeditedssl { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-battery-4:before { + content: "\f240"; } + +.fa.fa-battery:before { + content: "\f240"; } + +.fa.fa-battery-3:before { + content: "\f241"; } + +.fa.fa-battery-2:before { + content: "\f242"; } + +.fa.fa-battery-1:before { + content: "\f243"; } + +.fa.fa-battery-0:before { + content: "\f244"; } + +.fa.fa-object-group { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-object-ungroup { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-sticky-note-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-sticky-note-o:before { + content: "\f249"; } + +.fa.fa-cc-jcb { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-cc-diners-club { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-clone { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-hourglass-o:before { + content: "\f254"; } + +.fa.fa-hourglass-1:before { + content: "\f251"; } + +.fa.fa-hourglass-2:before { + content: "\f252"; } + +.fa.fa-hourglass-3:before { + content: "\f253"; } + +.fa.fa-hand-rock-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-hand-rock-o:before { + content: "\f255"; } + +.fa.fa-hand-grab-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-hand-grab-o:before { + content: "\f255"; } + +.fa.fa-hand-paper-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-hand-paper-o:before { + content: "\f256"; } + +.fa.fa-hand-stop-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-hand-stop-o:before { + content: "\f256"; } + +.fa.fa-hand-scissors-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-hand-scissors-o:before { + content: "\f257"; } + +.fa.fa-hand-lizard-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-hand-lizard-o:before { + content: "\f258"; } + +.fa.fa-hand-spock-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-hand-spock-o:before { + content: "\f259"; } + +.fa.fa-hand-pointer-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-hand-pointer-o:before { + content: "\f25a"; } + +.fa.fa-hand-peace-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-hand-peace-o:before { + content: "\f25b"; } + +.fa.fa-registered { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-creative-commons { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-gg { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-gg-circle { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-odnoklassniki { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-odnoklassniki-square { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-odnoklassniki-square:before { + content: "\f264"; } + +.fa.fa-get-pocket { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-wikipedia-w { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-safari { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-chrome { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-firefox { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-opera { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-internet-explorer { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-television:before { + content: "\f26c"; } + +.fa.fa-contao { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-500px { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-amazon { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-calendar-plus-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-calendar-plus-o:before { + content: "\f271"; } + +.fa.fa-calendar-minus-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-calendar-minus-o:before { + content: "\f272"; } + +.fa.fa-calendar-times-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-calendar-times-o:before { + content: "\f273"; } + +.fa.fa-calendar-check-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-calendar-check-o:before { + content: "\f274"; } + +.fa.fa-map-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-map-o:before { + content: "\f279"; } + +.fa.fa-commenting:before { + content: "\f4ad"; } + +.fa.fa-commenting-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-commenting-o:before { + content: "\f4ad"; } + +.fa.fa-houzz { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-vimeo { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-vimeo:before { + content: "\f27d"; } + +.fa.fa-black-tie { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-fonticons { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-reddit-alien { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-edge { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-credit-card-alt:before { + content: "\f09d"; } + +.fa.fa-codiepie { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-modx { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-fort-awesome { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-usb { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-product-hunt { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-mixcloud { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-scribd { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-pause-circle-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-pause-circle-o:before { + content: "\f28b"; } + +.fa.fa-stop-circle-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-stop-circle-o:before { + content: "\f28d"; } + +.fa.fa-bluetooth { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-bluetooth-b { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-gitlab { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-wpbeginner { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-wpforms { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-envira { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-wheelchair-alt { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-wheelchair-alt:before { + content: "\f368"; } + +.fa.fa-question-circle-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-question-circle-o:before { + content: "\f059"; } + +.fa.fa-volume-control-phone:before { + content: "\f2a0"; } + +.fa.fa-asl-interpreting:before { + content: "\f2a3"; } + +.fa.fa-deafness:before { + content: "\f2a4"; } + +.fa.fa-hard-of-hearing:before { + content: "\f2a4"; } + +.fa.fa-glide { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-glide-g { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-signing:before { + content: "\f2a7"; } + +.fa.fa-viadeo { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-viadeo-square { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-viadeo-square:before { + content: "\f2aa"; } + +.fa.fa-snapchat { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-snapchat-ghost { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-snapchat-ghost:before { + content: "\f2ab"; } + +.fa.fa-snapchat-square { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-snapchat-square:before { + content: "\f2ad"; } + +.fa.fa-pied-piper { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-first-order { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-yoast { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-themeisle { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-google-plus-official { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-google-plus-official:before { + content: "\f2b3"; } + +.fa.fa-google-plus-circle { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-google-plus-circle:before { + content: "\f2b3"; } + +.fa.fa-font-awesome { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-fa { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-fa:before { + content: "\f2b4"; } + +.fa.fa-handshake-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-handshake-o:before { + content: "\f2b5"; } + +.fa.fa-envelope-open-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-envelope-open-o:before { + content: "\f2b6"; } + +.fa.fa-linode { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-address-book-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-address-book-o:before { + content: "\f2b9"; } + +.fa.fa-vcard:before { + content: "\f2bb"; } + +.fa.fa-address-card-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-address-card-o:before { + content: "\f2bb"; } + +.fa.fa-vcard-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-vcard-o:before { + content: "\f2bb"; } + +.fa.fa-user-circle-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-user-circle-o:before { + content: "\f2bd"; } + +.fa.fa-user-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-user-o:before { + content: "\f007"; } + +.fa.fa-id-badge { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-drivers-license:before { + content: "\f2c2"; } + +.fa.fa-id-card-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-id-card-o:before { + content: "\f2c2"; } + +.fa.fa-drivers-license-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-drivers-license-o:before { + content: "\f2c2"; } + +.fa.fa-quora { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-free-code-camp { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-telegram { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-thermometer-4:before { + content: "\f2c7"; } + +.fa.fa-thermometer:before { + content: "\f2c7"; } + +.fa.fa-thermometer-3:before { + content: "\f2c8"; } + +.fa.fa-thermometer-2:before { + content: "\f2c9"; } + +.fa.fa-thermometer-1:before { + content: "\f2ca"; } + +.fa.fa-thermometer-0:before { + content: "\f2cb"; } + +.fa.fa-bathtub:before { + content: "\f2cd"; } + +.fa.fa-s15:before { + content: "\f2cd"; } + +.fa.fa-window-maximize { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-window-restore { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-times-rectangle:before { + content: "\f410"; } + +.fa.fa-window-close-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-window-close-o:before { + content: "\f410"; } + +.fa.fa-times-rectangle-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-times-rectangle-o:before { + content: "\f410"; } + +.fa.fa-bandcamp { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-grav { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-etsy { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-imdb { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-ravelry { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-eercast { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-eercast:before { + content: "\f2da"; } + +.fa.fa-snowflake-o { + font-family: 'Font Awesome 6 Free'; + font-weight: 400; } + +.fa.fa-snowflake-o:before { + content: "\f2dc"; } + +.fa.fa-superpowers { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-wpexplorer { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } + +.fa.fa-meetup { + font-family: 'Font Awesome 6 Brands'; + font-weight: 400; } diff --git a/docs/deps/font-awesome-6.5.2/css/v4-shims.min.css b/docs/deps/font-awesome-6.5.2/css/v4-shims.min.css new file mode 100644 index 00000000..09baf5fc --- /dev/null +++ b/docs/deps/font-awesome-6.5.2/css/v4-shims.min.css @@ -0,0 +1,6 @@ +/*! + * Font Awesome Free 6.5.2 by @fontawesome - https://fontawesome.com + * License - https://fontawesome.com/license/free (Icons: CC BY 4.0, Fonts: SIL OFL 1.1, Code: MIT License) + * Copyright 2024 Fonticons, Inc. + */ +.fa.fa-glass:before{content:"\f000"}.fa.fa-envelope-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-envelope-o:before{content:"\f0e0"}.fa.fa-star-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-star-o:before{content:"\f005"}.fa.fa-close:before,.fa.fa-remove:before{content:"\f00d"}.fa.fa-gear:before{content:"\f013"}.fa.fa-trash-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-trash-o:before{content:"\f2ed"}.fa.fa-home:before{content:"\f015"}.fa.fa-file-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-file-o:before{content:"\f15b"}.fa.fa-clock-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-clock-o:before{content:"\f017"}.fa.fa-arrow-circle-o-down{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-arrow-circle-o-down:before{content:"\f358"}.fa.fa-arrow-circle-o-up{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-arrow-circle-o-up:before{content:"\f35b"}.fa.fa-play-circle-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-play-circle-o:before{content:"\f144"}.fa.fa-repeat:before,.fa.fa-rotate-right:before{content:"\f01e"}.fa.fa-refresh:before{content:"\f021"}.fa.fa-list-alt{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-list-alt:before{content:"\f022"}.fa.fa-dedent:before{content:"\f03b"}.fa.fa-video-camera:before{content:"\f03d"}.fa.fa-picture-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-picture-o:before{content:"\f03e"}.fa.fa-photo{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-photo:before{content:"\f03e"}.fa.fa-image{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-image:before{content:"\f03e"}.fa.fa-map-marker:before{content:"\f3c5"}.fa.fa-pencil-square-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-pencil-square-o:before{content:"\f044"}.fa.fa-edit{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-edit:before{content:"\f044"}.fa.fa-share-square-o:before{content:"\f14d"}.fa.fa-check-square-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-check-square-o:before{content:"\f14a"}.fa.fa-arrows:before{content:"\f0b2"}.fa.fa-times-circle-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-times-circle-o:before{content:"\f057"}.fa.fa-check-circle-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-check-circle-o:before{content:"\f058"}.fa.fa-mail-forward:before{content:"\f064"}.fa.fa-expand:before{content:"\f424"}.fa.fa-compress:before{content:"\f422"}.fa.fa-eye,.fa.fa-eye-slash{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-warning:before{content:"\f071"}.fa.fa-calendar:before{content:"\f073"}.fa.fa-arrows-v:before{content:"\f338"}.fa.fa-arrows-h:before{content:"\f337"}.fa.fa-bar-chart-o:before,.fa.fa-bar-chart:before{content:"\e0e3"}.fa.fa-twitter-square{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-twitter-square:before{content:"\f081"}.fa.fa-facebook-square{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-facebook-square:before{content:"\f082"}.fa.fa-gears:before{content:"\f085"}.fa.fa-thumbs-o-up{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-thumbs-o-up:before{content:"\f164"}.fa.fa-thumbs-o-down{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-thumbs-o-down:before{content:"\f165"}.fa.fa-heart-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-heart-o:before{content:"\f004"}.fa.fa-sign-out:before{content:"\f2f5"}.fa.fa-linkedin-square{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-linkedin-square:before{content:"\f08c"}.fa.fa-thumb-tack:before{content:"\f08d"}.fa.fa-external-link:before{content:"\f35d"}.fa.fa-sign-in:before{content:"\f2f6"}.fa.fa-github-square{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-github-square:before{content:"\f092"}.fa.fa-lemon-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-lemon-o:before{content:"\f094"}.fa.fa-square-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-square-o:before{content:"\f0c8"}.fa.fa-bookmark-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-bookmark-o:before{content:"\f02e"}.fa.fa-facebook,.fa.fa-twitter{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-facebook:before{content:"\f39e"}.fa.fa-facebook-f{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-facebook-f:before{content:"\f39e"}.fa.fa-github{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-credit-card{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-feed:before{content:"\f09e"}.fa.fa-hdd-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-hdd-o:before{content:"\f0a0"}.fa.fa-hand-o-right{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-hand-o-right:before{content:"\f0a4"}.fa.fa-hand-o-left{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-hand-o-left:before{content:"\f0a5"}.fa.fa-hand-o-up{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-hand-o-up:before{content:"\f0a6"}.fa.fa-hand-o-down{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-hand-o-down:before{content:"\f0a7"}.fa.fa-globe:before{content:"\f57d"}.fa.fa-tasks:before{content:"\f828"}.fa.fa-arrows-alt:before{content:"\f31e"}.fa.fa-group:before{content:"\f0c0"}.fa.fa-chain:before{content:"\f0c1"}.fa.fa-cut:before{content:"\f0c4"}.fa.fa-files-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-files-o:before{content:"\f0c5"}.fa.fa-floppy-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-floppy-o:before{content:"\f0c7"}.fa.fa-save{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-save:before{content:"\f0c7"}.fa.fa-navicon:before,.fa.fa-reorder:before{content:"\f0c9"}.fa.fa-magic:before{content:"\e2ca"}.fa.fa-pinterest,.fa.fa-pinterest-square{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-pinterest-square:before{content:"\f0d3"}.fa.fa-google-plus-square{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-google-plus-square:before{content:"\f0d4"}.fa.fa-google-plus{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-google-plus:before{content:"\f0d5"}.fa.fa-money:before{content:"\f3d1"}.fa.fa-unsorted:before{content:"\f0dc"}.fa.fa-sort-desc:before{content:"\f0dd"}.fa.fa-sort-asc:before{content:"\f0de"}.fa.fa-linkedin{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-linkedin:before{content:"\f0e1"}.fa.fa-rotate-left:before{content:"\f0e2"}.fa.fa-legal:before{content:"\f0e3"}.fa.fa-dashboard:before,.fa.fa-tachometer:before{content:"\f625"}.fa.fa-comment-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-comment-o:before{content:"\f075"}.fa.fa-comments-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-comments-o:before{content:"\f086"}.fa.fa-flash:before{content:"\f0e7"}.fa.fa-clipboard:before{content:"\f0ea"}.fa.fa-lightbulb-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-lightbulb-o:before{content:"\f0eb"}.fa.fa-exchange:before{content:"\f362"}.fa.fa-cloud-download:before{content:"\f0ed"}.fa.fa-cloud-upload:before{content:"\f0ee"}.fa.fa-bell-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-bell-o:before{content:"\f0f3"}.fa.fa-cutlery:before{content:"\f2e7"}.fa.fa-file-text-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-file-text-o:before{content:"\f15c"}.fa.fa-building-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-building-o:before{content:"\f1ad"}.fa.fa-hospital-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-hospital-o:before{content:"\f0f8"}.fa.fa-tablet:before{content:"\f3fa"}.fa.fa-mobile-phone:before,.fa.fa-mobile:before{content:"\f3cd"}.fa.fa-circle-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-circle-o:before{content:"\f111"}.fa.fa-mail-reply:before{content:"\f3e5"}.fa.fa-github-alt{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-folder-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-folder-o:before{content:"\f07b"}.fa.fa-folder-open-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-folder-open-o:before{content:"\f07c"}.fa.fa-smile-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-smile-o:before{content:"\f118"}.fa.fa-frown-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-frown-o:before{content:"\f119"}.fa.fa-meh-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-meh-o:before{content:"\f11a"}.fa.fa-keyboard-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-keyboard-o:before{content:"\f11c"}.fa.fa-flag-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-flag-o:before{content:"\f024"}.fa.fa-mail-reply-all:before{content:"\f122"}.fa.fa-star-half-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-star-half-o:before{content:"\f5c0"}.fa.fa-star-half-empty{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-star-half-empty:before{content:"\f5c0"}.fa.fa-star-half-full{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-star-half-full:before{content:"\f5c0"}.fa.fa-code-fork:before{content:"\f126"}.fa.fa-chain-broken:before,.fa.fa-unlink:before{content:"\f127"}.fa.fa-calendar-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-calendar-o:before{content:"\f133"}.fa.fa-css3,.fa.fa-html5,.fa.fa-maxcdn{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-unlock-alt:before{content:"\f09c"}.fa.fa-minus-square-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-minus-square-o:before{content:"\f146"}.fa.fa-level-up:before{content:"\f3bf"}.fa.fa-level-down:before{content:"\f3be"}.fa.fa-pencil-square:before{content:"\f14b"}.fa.fa-external-link-square:before{content:"\f360"}.fa.fa-compass{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-caret-square-o-down{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-caret-square-o-down:before{content:"\f150"}.fa.fa-toggle-down{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-toggle-down:before{content:"\f150"}.fa.fa-caret-square-o-up{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-caret-square-o-up:before{content:"\f151"}.fa.fa-toggle-up{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-toggle-up:before{content:"\f151"}.fa.fa-caret-square-o-right{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-caret-square-o-right:before{content:"\f152"}.fa.fa-toggle-right{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-toggle-right:before{content:"\f152"}.fa.fa-eur:before,.fa.fa-euro:before{content:"\f153"}.fa.fa-gbp:before{content:"\f154"}.fa.fa-dollar:before,.fa.fa-usd:before{content:"\24"}.fa.fa-inr:before,.fa.fa-rupee:before{content:"\e1bc"}.fa.fa-cny:before,.fa.fa-jpy:before,.fa.fa-rmb:before,.fa.fa-yen:before{content:"\f157"}.fa.fa-rouble:before,.fa.fa-rub:before,.fa.fa-ruble:before{content:"\f158"}.fa.fa-krw:before,.fa.fa-won:before{content:"\f159"}.fa.fa-bitcoin,.fa.fa-btc{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-bitcoin:before{content:"\f15a"}.fa.fa-file-text:before{content:"\f15c"}.fa.fa-sort-alpha-asc:before{content:"\f15d"}.fa.fa-sort-alpha-desc:before{content:"\f881"}.fa.fa-sort-amount-asc:before{content:"\f884"}.fa.fa-sort-amount-desc:before{content:"\f160"}.fa.fa-sort-numeric-asc:before{content:"\f162"}.fa.fa-sort-numeric-desc:before{content:"\f886"}.fa.fa-youtube-square{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-youtube-square:before{content:"\f431"}.fa.fa-xing,.fa.fa-xing-square,.fa.fa-youtube{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-xing-square:before{content:"\f169"}.fa.fa-youtube-play{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-youtube-play:before{content:"\f167"}.fa.fa-adn,.fa.fa-bitbucket,.fa.fa-bitbucket-square,.fa.fa-dropbox,.fa.fa-flickr,.fa.fa-instagram,.fa.fa-stack-overflow{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-bitbucket-square:before{content:"\f171"}.fa.fa-tumblr,.fa.fa-tumblr-square{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-tumblr-square:before{content:"\f174"}.fa.fa-long-arrow-down:before{content:"\f309"}.fa.fa-long-arrow-up:before{content:"\f30c"}.fa.fa-long-arrow-left:before{content:"\f30a"}.fa.fa-long-arrow-right:before{content:"\f30b"}.fa.fa-android,.fa.fa-apple,.fa.fa-dribbble,.fa.fa-foursquare,.fa.fa-gittip,.fa.fa-gratipay,.fa.fa-linux,.fa.fa-skype,.fa.fa-trello,.fa.fa-windows{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-gittip:before{content:"\f184"}.fa.fa-sun-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-sun-o:before{content:"\f185"}.fa.fa-moon-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-moon-o:before{content:"\f186"}.fa.fa-pagelines,.fa.fa-renren,.fa.fa-stack-exchange,.fa.fa-vk,.fa.fa-weibo{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-arrow-circle-o-right{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-arrow-circle-o-right:before{content:"\f35a"}.fa.fa-arrow-circle-o-left{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-arrow-circle-o-left:before{content:"\f359"}.fa.fa-caret-square-o-left{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-caret-square-o-left:before{content:"\f191"}.fa.fa-toggle-left{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-toggle-left:before{content:"\f191"}.fa.fa-dot-circle-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-dot-circle-o:before{content:"\f192"}.fa.fa-vimeo-square{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-vimeo-square:before{content:"\f194"}.fa.fa-try:before,.fa.fa-turkish-lira:before{content:"\e2bb"}.fa.fa-plus-square-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-plus-square-o:before{content:"\f0fe"}.fa.fa-openid,.fa.fa-slack,.fa.fa-wordpress{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-bank:before,.fa.fa-institution:before{content:"\f19c"}.fa.fa-mortar-board:before{content:"\f19d"}.fa.fa-google,.fa.fa-reddit,.fa.fa-reddit-square,.fa.fa-yahoo{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-reddit-square:before{content:"\f1a2"}.fa.fa-behance,.fa.fa-behance-square,.fa.fa-delicious,.fa.fa-digg,.fa.fa-drupal,.fa.fa-joomla,.fa.fa-pied-piper-alt,.fa.fa-pied-piper-pp,.fa.fa-stumbleupon,.fa.fa-stumbleupon-circle{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-behance-square:before{content:"\f1b5"}.fa.fa-steam,.fa.fa-steam-square{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-steam-square:before{content:"\f1b7"}.fa.fa-automobile:before{content:"\f1b9"}.fa.fa-cab:before{content:"\f1ba"}.fa.fa-deviantart,.fa.fa-soundcloud,.fa.fa-spotify{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-file-pdf-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-file-pdf-o:before{content:"\f1c1"}.fa.fa-file-word-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-file-word-o:before{content:"\f1c2"}.fa.fa-file-excel-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-file-excel-o:before{content:"\f1c3"}.fa.fa-file-powerpoint-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-file-powerpoint-o:before{content:"\f1c4"}.fa.fa-file-image-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-file-image-o:before{content:"\f1c5"}.fa.fa-file-photo-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-file-photo-o:before{content:"\f1c5"}.fa.fa-file-picture-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-file-picture-o:before{content:"\f1c5"}.fa.fa-file-archive-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-file-archive-o:before{content:"\f1c6"}.fa.fa-file-zip-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-file-zip-o:before{content:"\f1c6"}.fa.fa-file-audio-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-file-audio-o:before{content:"\f1c7"}.fa.fa-file-sound-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-file-sound-o:before{content:"\f1c7"}.fa.fa-file-video-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-file-video-o:before{content:"\f1c8"}.fa.fa-file-movie-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-file-movie-o:before{content:"\f1c8"}.fa.fa-file-code-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-file-code-o:before{content:"\f1c9"}.fa.fa-codepen,.fa.fa-jsfiddle,.fa.fa-vine{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-life-bouy:before,.fa.fa-life-buoy:before,.fa.fa-life-saver:before,.fa.fa-support:before{content:"\f1cd"}.fa.fa-circle-o-notch:before{content:"\f1ce"}.fa.fa-ra,.fa.fa-rebel{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-ra:before{content:"\f1d0"}.fa.fa-resistance{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-resistance:before{content:"\f1d0"}.fa.fa-empire,.fa.fa-ge{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-ge:before{content:"\f1d1"}.fa.fa-git-square{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-git-square:before{content:"\f1d2"}.fa.fa-git,.fa.fa-hacker-news,.fa.fa-y-combinator-square{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-y-combinator-square:before{content:"\f1d4"}.fa.fa-yc-square{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-yc-square:before{content:"\f1d4"}.fa.fa-qq,.fa.fa-tencent-weibo,.fa.fa-wechat,.fa.fa-weixin{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-wechat:before{content:"\f1d7"}.fa.fa-send:before{content:"\f1d8"}.fa.fa-paper-plane-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-paper-plane-o:before{content:"\f1d8"}.fa.fa-send-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-send-o:before{content:"\f1d8"}.fa.fa-circle-thin{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-circle-thin:before{content:"\f111"}.fa.fa-header:before{content:"\f1dc"}.fa.fa-futbol-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-futbol-o:before{content:"\f1e3"}.fa.fa-soccer-ball-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-soccer-ball-o:before{content:"\f1e3"}.fa.fa-slideshare,.fa.fa-twitch,.fa.fa-yelp{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-newspaper-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-newspaper-o:before{content:"\f1ea"}.fa.fa-cc-amex,.fa.fa-cc-discover,.fa.fa-cc-mastercard,.fa.fa-cc-paypal,.fa.fa-cc-stripe,.fa.fa-cc-visa,.fa.fa-google-wallet,.fa.fa-paypal{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-bell-slash-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-bell-slash-o:before{content:"\f1f6"}.fa.fa-trash:before{content:"\f2ed"}.fa.fa-copyright{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-eyedropper:before{content:"\f1fb"}.fa.fa-area-chart:before{content:"\f1fe"}.fa.fa-pie-chart:before{content:"\f200"}.fa.fa-line-chart:before{content:"\f201"}.fa.fa-lastfm,.fa.fa-lastfm-square{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-lastfm-square:before{content:"\f203"}.fa.fa-angellist,.fa.fa-ioxhost{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-cc{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-cc:before{content:"\f20a"}.fa.fa-ils:before,.fa.fa-shekel:before,.fa.fa-sheqel:before{content:"\f20b"}.fa.fa-buysellads,.fa.fa-connectdevelop,.fa.fa-dashcube,.fa.fa-forumbee,.fa.fa-leanpub,.fa.fa-sellsy,.fa.fa-shirtsinbulk,.fa.fa-simplybuilt,.fa.fa-skyatlas{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-diamond{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-diamond:before{content:"\f3a5"}.fa.fa-intersex:before,.fa.fa-transgender:before{content:"\f224"}.fa.fa-transgender-alt:before{content:"\f225"}.fa.fa-facebook-official{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-facebook-official:before{content:"\f09a"}.fa.fa-pinterest-p,.fa.fa-whatsapp{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-hotel:before{content:"\f236"}.fa.fa-medium,.fa.fa-viacoin,.fa.fa-y-combinator,.fa.fa-yc{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-yc:before{content:"\f23b"}.fa.fa-expeditedssl,.fa.fa-opencart,.fa.fa-optin-monster{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-battery-4:before,.fa.fa-battery:before{content:"\f240"}.fa.fa-battery-3:before{content:"\f241"}.fa.fa-battery-2:before{content:"\f242"}.fa.fa-battery-1:before{content:"\f243"}.fa.fa-battery-0:before{content:"\f244"}.fa.fa-object-group,.fa.fa-object-ungroup,.fa.fa-sticky-note-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-sticky-note-o:before{content:"\f249"}.fa.fa-cc-diners-club,.fa.fa-cc-jcb{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-clone{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-hourglass-o:before{content:"\f254"}.fa.fa-hourglass-1:before{content:"\f251"}.fa.fa-hourglass-2:before{content:"\f252"}.fa.fa-hourglass-3:before{content:"\f253"}.fa.fa-hand-rock-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-hand-rock-o:before{content:"\f255"}.fa.fa-hand-grab-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-hand-grab-o:before{content:"\f255"}.fa.fa-hand-paper-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-hand-paper-o:before{content:"\f256"}.fa.fa-hand-stop-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-hand-stop-o:before{content:"\f256"}.fa.fa-hand-scissors-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-hand-scissors-o:before{content:"\f257"}.fa.fa-hand-lizard-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-hand-lizard-o:before{content:"\f258"}.fa.fa-hand-spock-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-hand-spock-o:before{content:"\f259"}.fa.fa-hand-pointer-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-hand-pointer-o:before{content:"\f25a"}.fa.fa-hand-peace-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-hand-peace-o:before{content:"\f25b"}.fa.fa-registered{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-creative-commons,.fa.fa-gg,.fa.fa-gg-circle,.fa.fa-odnoklassniki,.fa.fa-odnoklassniki-square{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-odnoklassniki-square:before{content:"\f264"}.fa.fa-chrome,.fa.fa-firefox,.fa.fa-get-pocket,.fa.fa-internet-explorer,.fa.fa-opera,.fa.fa-safari,.fa.fa-wikipedia-w{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-television:before{content:"\f26c"}.fa.fa-500px,.fa.fa-amazon,.fa.fa-contao{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-calendar-plus-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-calendar-plus-o:before{content:"\f271"}.fa.fa-calendar-minus-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-calendar-minus-o:before{content:"\f272"}.fa.fa-calendar-times-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-calendar-times-o:before{content:"\f273"}.fa.fa-calendar-check-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-calendar-check-o:before{content:"\f274"}.fa.fa-map-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-map-o:before{content:"\f279"}.fa.fa-commenting:before{content:"\f4ad"}.fa.fa-commenting-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-commenting-o:before{content:"\f4ad"}.fa.fa-houzz,.fa.fa-vimeo{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-vimeo:before{content:"\f27d"}.fa.fa-black-tie,.fa.fa-edge,.fa.fa-fonticons,.fa.fa-reddit-alien{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-credit-card-alt:before{content:"\f09d"}.fa.fa-codiepie,.fa.fa-fort-awesome,.fa.fa-mixcloud,.fa.fa-modx,.fa.fa-product-hunt,.fa.fa-scribd,.fa.fa-usb{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-pause-circle-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-pause-circle-o:before{content:"\f28b"}.fa.fa-stop-circle-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-stop-circle-o:before{content:"\f28d"}.fa.fa-bluetooth,.fa.fa-bluetooth-b,.fa.fa-envira,.fa.fa-gitlab,.fa.fa-wheelchair-alt,.fa.fa-wpbeginner,.fa.fa-wpforms{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-wheelchair-alt:before{content:"\f368"}.fa.fa-question-circle-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-question-circle-o:before{content:"\f059"}.fa.fa-volume-control-phone:before{content:"\f2a0"}.fa.fa-asl-interpreting:before{content:"\f2a3"}.fa.fa-deafness:before,.fa.fa-hard-of-hearing:before{content:"\f2a4"}.fa.fa-glide,.fa.fa-glide-g{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-signing:before{content:"\f2a7"}.fa.fa-viadeo,.fa.fa-viadeo-square{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-viadeo-square:before{content:"\f2aa"}.fa.fa-snapchat,.fa.fa-snapchat-ghost{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-snapchat-ghost:before{content:"\f2ab"}.fa.fa-snapchat-square{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-snapchat-square:before{content:"\f2ad"}.fa.fa-first-order,.fa.fa-google-plus-official,.fa.fa-pied-piper,.fa.fa-themeisle,.fa.fa-yoast{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-google-plus-official:before{content:"\f2b3"}.fa.fa-google-plus-circle{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-google-plus-circle:before{content:"\f2b3"}.fa.fa-fa,.fa.fa-font-awesome{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-fa:before{content:"\f2b4"}.fa.fa-handshake-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-handshake-o:before{content:"\f2b5"}.fa.fa-envelope-open-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-envelope-open-o:before{content:"\f2b6"}.fa.fa-linode{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-address-book-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-address-book-o:before{content:"\f2b9"}.fa.fa-vcard:before{content:"\f2bb"}.fa.fa-address-card-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-address-card-o:before{content:"\f2bb"}.fa.fa-vcard-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-vcard-o:before{content:"\f2bb"}.fa.fa-user-circle-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-user-circle-o:before{content:"\f2bd"}.fa.fa-user-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-user-o:before{content:"\f007"}.fa.fa-id-badge{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-drivers-license:before{content:"\f2c2"}.fa.fa-id-card-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-id-card-o:before{content:"\f2c2"}.fa.fa-drivers-license-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-drivers-license-o:before{content:"\f2c2"}.fa.fa-free-code-camp,.fa.fa-quora,.fa.fa-telegram{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-thermometer-4:before,.fa.fa-thermometer:before{content:"\f2c7"}.fa.fa-thermometer-3:before{content:"\f2c8"}.fa.fa-thermometer-2:before{content:"\f2c9"}.fa.fa-thermometer-1:before{content:"\f2ca"}.fa.fa-thermometer-0:before{content:"\f2cb"}.fa.fa-bathtub:before,.fa.fa-s15:before{content:"\f2cd"}.fa.fa-window-maximize,.fa.fa-window-restore{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-times-rectangle:before{content:"\f410"}.fa.fa-window-close-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-window-close-o:before{content:"\f410"}.fa.fa-times-rectangle-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-times-rectangle-o:before{content:"\f410"}.fa.fa-bandcamp,.fa.fa-eercast,.fa.fa-etsy,.fa.fa-grav,.fa.fa-imdb,.fa.fa-ravelry{font-family:"Font Awesome 6 Brands";font-weight:400}.fa.fa-eercast:before{content:"\f2da"}.fa.fa-snowflake-o{font-family:"Font Awesome 6 Free";font-weight:400}.fa.fa-snowflake-o:before{content:"\f2dc"}.fa.fa-meetup,.fa.fa-superpowers,.fa.fa-wpexplorer{font-family:"Font Awesome 6 Brands";font-weight:400} \ No newline at end of file diff --git a/docs/deps/font-awesome-6.5.2/webfonts/fa-brands-400.ttf b/docs/deps/font-awesome-6.5.2/webfonts/fa-brands-400.ttf new file mode 100644 index 00000000..1fbb1f7c Binary files /dev/null and b/docs/deps/font-awesome-6.5.2/webfonts/fa-brands-400.ttf differ diff --git a/docs/deps/font-awesome-6.5.2/webfonts/fa-brands-400.woff2 b/docs/deps/font-awesome-6.5.2/webfonts/fa-brands-400.woff2 new file mode 100644 index 00000000..5d280216 Binary files /dev/null and b/docs/deps/font-awesome-6.5.2/webfonts/fa-brands-400.woff2 differ diff --git a/docs/deps/font-awesome-6.5.2/webfonts/fa-regular-400.ttf b/docs/deps/font-awesome-6.5.2/webfonts/fa-regular-400.ttf new file mode 100644 index 00000000..549d68dc Binary files /dev/null and b/docs/deps/font-awesome-6.5.2/webfonts/fa-regular-400.ttf differ diff --git a/docs/deps/font-awesome-6.5.2/webfonts/fa-regular-400.woff2 b/docs/deps/font-awesome-6.5.2/webfonts/fa-regular-400.woff2 new file mode 100644 index 00000000..18400d7f Binary files /dev/null and b/docs/deps/font-awesome-6.5.2/webfonts/fa-regular-400.woff2 differ diff --git a/docs/deps/font-awesome-6.5.2/webfonts/fa-solid-900.ttf b/docs/deps/font-awesome-6.5.2/webfonts/fa-solid-900.ttf new file mode 100644 index 00000000..bb2a8695 Binary files /dev/null and b/docs/deps/font-awesome-6.5.2/webfonts/fa-solid-900.ttf differ diff --git a/docs/deps/font-awesome-6.5.2/webfonts/fa-solid-900.woff2 b/docs/deps/font-awesome-6.5.2/webfonts/fa-solid-900.woff2 new file mode 100644 index 00000000..758dd4f6 Binary files /dev/null and b/docs/deps/font-awesome-6.5.2/webfonts/fa-solid-900.woff2 differ diff --git a/docs/deps/font-awesome-6.5.2/webfonts/fa-v4compatibility.ttf b/docs/deps/font-awesome-6.5.2/webfonts/fa-v4compatibility.ttf new file mode 100644 index 00000000..8c5864c4 Binary files /dev/null and b/docs/deps/font-awesome-6.5.2/webfonts/fa-v4compatibility.ttf differ diff --git a/docs/deps/font-awesome-6.5.2/webfonts/fa-v4compatibility.woff2 b/docs/deps/font-awesome-6.5.2/webfonts/fa-v4compatibility.woff2 new file mode 100644 index 00000000..f94bec22 Binary files /dev/null and b/docs/deps/font-awesome-6.5.2/webfonts/fa-v4compatibility.woff2 differ diff --git a/docs/deps/headroom-0.11.0/headroom.min.js b/docs/deps/headroom-0.11.0/headroom.min.js new file mode 100644 index 00000000..433069fd --- /dev/null +++ b/docs/deps/headroom-0.11.0/headroom.min.js @@ -0,0 +1,7 @@ +/*! + * headroom.js v0.11.0 - Give your page some headroom. Hide your header until you need it + * Copyright (c) 2020 Nick Williams - http://wicky.nillia.ms/headroom.js + * License: MIT + */ + +!function(t,n){"object"==typeof exports&&"undefined"!=typeof module?module.exports=n():"function"==typeof define&&define.amd?define(n):(t=t||self).Headroom=n()}(this,function(){"use strict";function t(){return"undefined"!=typeof window}function d(t){return function(t){return t&&t.document&&function(t){return 9===t.nodeType}(t.document)}(t)?function(t){var n=t.document,o=n.body,s=n.documentElement;return{scrollHeight:function(){return Math.max(o.scrollHeight,s.scrollHeight,o.offsetHeight,s.offsetHeight,o.clientHeight,s.clientHeight)},height:function(){return t.innerHeight||s.clientHeight||o.clientHeight},scrollY:function(){return void 0!==t.pageYOffset?t.pageYOffset:(s||o.parentNode||o).scrollTop}}}(t):function(t){return{scrollHeight:function(){return Math.max(t.scrollHeight,t.offsetHeight,t.clientHeight)},height:function(){return Math.max(t.offsetHeight,t.clientHeight)},scrollY:function(){return t.scrollTop}}}(t)}function n(t,s,e){var n,o=function(){var n=!1;try{var t={get passive(){n=!0}};window.addEventListener("test",t,t),window.removeEventListener("test",t,t)}catch(t){n=!1}return n}(),i=!1,r=d(t),l=r.scrollY(),a={};function c(){var t=Math.round(r.scrollY()),n=r.height(),o=r.scrollHeight();a.scrollY=t,a.lastScrollY=l,a.direction=ls.tolerance[a.direction],e(a),l=t,i=!1}function h(){i||(i=!0,n=requestAnimationFrame(c))}var u=!!o&&{passive:!0,capture:!1};return t.addEventListener("scroll",h,u),c(),{destroy:function(){cancelAnimationFrame(n),t.removeEventListener("scroll",h,u)}}}function o(t,n){n=n||{},Object.assign(this,o.options,n),this.classes=Object.assign({},o.options.classes,n.classes),this.elem=t,this.tolerance=function(t){return t===Object(t)?t:{down:t,up:t}}(this.tolerance),this.initialised=!1,this.frozen=!1}return o.prototype={constructor:o,init:function(){return o.cutsTheMustard&&!this.initialised&&(this.addClass("initial"),this.initialised=!0,setTimeout(function(t){t.scrollTracker=n(t.scroller,{offset:t.offset,tolerance:t.tolerance},t.update.bind(t))},100,this)),this},destroy:function(){this.initialised=!1,Object.keys(this.classes).forEach(this.removeClass,this),this.scrollTracker.destroy()},unpin:function(){!this.hasClass("pinned")&&this.hasClass("unpinned")||(this.addClass("unpinned"),this.removeClass("pinned"),this.onUnpin&&this.onUnpin.call(this))},pin:function(){this.hasClass("unpinned")&&(this.addClass("pinned"),this.removeClass("unpinned"),this.onPin&&this.onPin.call(this))},freeze:function(){this.frozen=!0,this.addClass("frozen")},unfreeze:function(){this.frozen=!1,this.removeClass("frozen")},top:function(){this.hasClass("top")||(this.addClass("top"),this.removeClass("notTop"),this.onTop&&this.onTop.call(this))},notTop:function(){this.hasClass("notTop")||(this.addClass("notTop"),this.removeClass("top"),this.onNotTop&&this.onNotTop.call(this))},bottom:function(){this.hasClass("bottom")||(this.addClass("bottom"),this.removeClass("notBottom"),this.onBottom&&this.onBottom.call(this))},notBottom:function(){this.hasClass("notBottom")||(this.addClass("notBottom"),this.removeClass("bottom"),this.onNotBottom&&this.onNotBottom.call(this))},shouldUnpin:function(t){return"down"===t.direction&&!t.top&&t.toleranceExceeded},shouldPin:function(t){return"up"===t.direction&&t.toleranceExceeded||t.top},addClass:function(t){this.elem.classList.add.apply(this.elem.classList,this.classes[t].split(" "))},removeClass:function(t){this.elem.classList.remove.apply(this.elem.classList,this.classes[t].split(" "))},hasClass:function(t){return this.classes[t].split(" ").every(function(t){return this.classList.contains(t)},this.elem)},update:function(t){t.isOutOfBounds||!0!==this.frozen&&(t.top?this.top():this.notTop(),t.bottom?this.bottom():this.notBottom(),this.shouldUnpin(t)?this.unpin():this.shouldPin(t)&&this.pin())}},o.options={tolerance:{up:0,down:0},offset:0,scroller:t()?window:null,classes:{frozen:"headroom--frozen",pinned:"headroom--pinned",unpinned:"headroom--unpinned",top:"headroom--top",notTop:"headroom--not-top",bottom:"headroom--bottom",notBottom:"headroom--not-bottom",initial:"headroom"}},o.cutsTheMustard=!!(t()&&function(){}.bind&&"classList"in document.documentElement&&Object.assign&&Object.keys&&requestAnimationFrame),o}); \ No newline at end of file diff --git a/docs/deps/headroom-0.11.0/jQuery.headroom.min.js b/docs/deps/headroom-0.11.0/jQuery.headroom.min.js new file mode 100644 index 00000000..17f70c9e --- /dev/null +++ b/docs/deps/headroom-0.11.0/jQuery.headroom.min.js @@ -0,0 +1,7 @@ +/*! + * headroom.js v0.9.4 - Give your page some headroom. Hide your header until you need it + * Copyright (c) 2017 Nick Williams - http://wicky.nillia.ms/headroom.js + * License: MIT + */ + +!function(a){a&&(a.fn.headroom=function(b){return this.each(function(){var c=a(this),d=c.data("headroom"),e="object"==typeof b&&b;e=a.extend(!0,{},Headroom.options,e),d||(d=new Headroom(this,e),d.init(),c.data("headroom",d)),"string"==typeof b&&(d[b](),"destroy"===b&&c.removeData("headroom"))})},a("[data-headroom]").each(function(){var b=a(this);b.headroom(b.data())}))}(window.Zepto||window.jQuery); \ No newline at end of file diff --git a/docs/deps/jquery-3.6.0/jquery-3.6.0.js b/docs/deps/jquery-3.6.0/jquery-3.6.0.js new file mode 100644 index 00000000..fc6c299b --- /dev/null +++ b/docs/deps/jquery-3.6.0/jquery-3.6.0.js @@ -0,0 +1,10881 @@ +/*! + * jQuery JavaScript Library v3.6.0 + * https://jquery.com/ + * + * Includes Sizzle.js + * https://sizzlejs.com/ + * + * Copyright OpenJS Foundation and other contributors + * Released under the MIT license + * https://jquery.org/license + * + * Date: 2021-03-02T17:08Z + */ +( function( global, factory ) { + + "use strict"; + + if ( typeof module === "object" && typeof module.exports === "object" ) { + + // For CommonJS and CommonJS-like environments where a proper `window` + // is present, execute the factory and get jQuery. + // For environments that do not have a `window` with a `document` + // (such as Node.js), expose a factory as module.exports. + // This accentuates the need for the creation of a real `window`. + // e.g. var jQuery = require("jquery")(window); + // See ticket #14549 for more info. + module.exports = global.document ? + factory( global, true ) : + function( w ) { + if ( !w.document ) { + throw new Error( "jQuery requires a window with a document" ); + } + return factory( w ); + }; + } else { + factory( global ); + } + +// Pass this if window is not defined yet +} )( typeof window !== "undefined" ? window : this, function( window, noGlobal ) { + +// Edge <= 12 - 13+, Firefox <=18 - 45+, IE 10 - 11, Safari 5.1 - 9+, iOS 6 - 9.1 +// throw exceptions when non-strict code (e.g., ASP.NET 4.5) accesses strict mode +// arguments.callee.caller (trac-13335). But as of jQuery 3.0 (2016), strict mode should be common +// enough that all such attempts are guarded in a try block. +"use strict"; + +var arr = []; + +var getProto = Object.getPrototypeOf; + +var slice = arr.slice; + +var flat = arr.flat ? function( array ) { + return arr.flat.call( array ); +} : function( array ) { + return arr.concat.apply( [], array ); +}; + + +var push = arr.push; + +var indexOf = arr.indexOf; + +var class2type = {}; + +var toString = class2type.toString; + +var hasOwn = class2type.hasOwnProperty; + +var fnToString = hasOwn.toString; + +var ObjectFunctionString = fnToString.call( Object ); + +var support = {}; + +var isFunction = function isFunction( obj ) { + + // Support: Chrome <=57, Firefox <=52 + // In some browsers, typeof returns "function" for HTML elements + // (i.e., `typeof document.createElement( "object" ) === "function"`). + // We don't want to classify *any* DOM node as a function. + // Support: QtWeb <=3.8.5, WebKit <=534.34, wkhtmltopdf tool <=0.12.5 + // Plus for old WebKit, typeof returns "function" for HTML collections + // (e.g., `typeof document.getElementsByTagName("div") === "function"`). (gh-4756) + return typeof obj === "function" && typeof obj.nodeType !== "number" && + typeof obj.item !== "function"; + }; + + +var isWindow = function isWindow( obj ) { + return obj != null && obj === obj.window; + }; + + +var document = window.document; + + + + var preservedScriptAttributes = { + type: true, + src: true, + nonce: true, + noModule: true + }; + + function DOMEval( code, node, doc ) { + doc = doc || document; + + var i, val, + script = doc.createElement( "script" ); + + script.text = code; + if ( node ) { + for ( i in preservedScriptAttributes ) { + + // Support: Firefox 64+, Edge 18+ + // Some browsers don't support the "nonce" property on scripts. + // On the other hand, just using `getAttribute` is not enough as + // the `nonce` attribute is reset to an empty string whenever it + // becomes browsing-context connected. + // See https://github.com/whatwg/html/issues/2369 + // See https://html.spec.whatwg.org/#nonce-attributes + // The `node.getAttribute` check was added for the sake of + // `jQuery.globalEval` so that it can fake a nonce-containing node + // via an object. + val = node[ i ] || node.getAttribute && node.getAttribute( i ); + if ( val ) { + script.setAttribute( i, val ); + } + } + } + doc.head.appendChild( script ).parentNode.removeChild( script ); + } + + +function toType( obj ) { + if ( obj == null ) { + return obj + ""; + } + + // Support: Android <=2.3 only (functionish RegExp) + return typeof obj === "object" || typeof obj === "function" ? + class2type[ toString.call( obj ) ] || "object" : + typeof obj; +} +/* global Symbol */ +// Defining this global in .eslintrc.json would create a danger of using the global +// unguarded in another place, it seems safer to define global only for this module + + + +var + version = "3.6.0", + + // Define a local copy of jQuery + jQuery = function( selector, context ) { + + // The jQuery object is actually just the init constructor 'enhanced' + // Need init if jQuery is called (just allow error to be thrown if not included) + return new jQuery.fn.init( selector, context ); + }; + +jQuery.fn = jQuery.prototype = { + + // The current version of jQuery being used + jquery: version, + + constructor: jQuery, + + // The default length of a jQuery object is 0 + length: 0, + + toArray: function() { + return slice.call( this ); + }, + + // Get the Nth element in the matched element set OR + // Get the whole matched element set as a clean array + get: function( num ) { + + // Return all the elements in a clean array + if ( num == null ) { + return slice.call( this ); + } + + // Return just the one element from the set + return num < 0 ? this[ num + this.length ] : this[ num ]; + }, + + // Take an array of elements and push it onto the stack + // (returning the new matched element set) + pushStack: function( elems ) { + + // Build a new jQuery matched element set + var ret = jQuery.merge( this.constructor(), elems ); + + // Add the old object onto the stack (as a reference) + ret.prevObject = this; + + // Return the newly-formed element set + return ret; + }, + + // Execute a callback for every element in the matched set. + each: function( callback ) { + return jQuery.each( this, callback ); + }, + + map: function( callback ) { + return this.pushStack( jQuery.map( this, function( elem, i ) { + return callback.call( elem, i, elem ); + } ) ); + }, + + slice: function() { + return this.pushStack( slice.apply( this, arguments ) ); + }, + + first: function() { + return this.eq( 0 ); + }, + + last: function() { + return this.eq( -1 ); + }, + + even: function() { + return this.pushStack( jQuery.grep( this, function( _elem, i ) { + return ( i + 1 ) % 2; + } ) ); + }, + + odd: function() { + return this.pushStack( jQuery.grep( this, function( _elem, i ) { + return i % 2; + } ) ); + }, + + eq: function( i ) { + var len = this.length, + j = +i + ( i < 0 ? len : 0 ); + return this.pushStack( j >= 0 && j < len ? [ this[ j ] ] : [] ); + }, + + end: function() { + return this.prevObject || this.constructor(); + }, + + // For internal use only. + // Behaves like an Array's method, not like a jQuery method. + push: push, + sort: arr.sort, + splice: arr.splice +}; + +jQuery.extend = jQuery.fn.extend = function() { + var options, name, src, copy, copyIsArray, clone, + target = arguments[ 0 ] || {}, + i = 1, + length = arguments.length, + deep = false; + + // Handle a deep copy situation + if ( typeof target === "boolean" ) { + deep = target; + + // Skip the boolean and the target + target = arguments[ i ] || {}; + i++; + } + + // Handle case when target is a string or something (possible in deep copy) + if ( typeof target !== "object" && !isFunction( target ) ) { + target = {}; + } + + // Extend jQuery itself if only one argument is passed + if ( i === length ) { + target = this; + i--; + } + + for ( ; i < length; i++ ) { + + // Only deal with non-null/undefined values + if ( ( options = arguments[ i ] ) != null ) { + + // Extend the base object + for ( name in options ) { + copy = options[ name ]; + + // Prevent Object.prototype pollution + // Prevent never-ending loop + if ( name === "__proto__" || target === copy ) { + continue; + } + + // Recurse if we're merging plain objects or arrays + if ( deep && copy && ( jQuery.isPlainObject( copy ) || + ( copyIsArray = Array.isArray( copy ) ) ) ) { + src = target[ name ]; + + // Ensure proper type for the source value + if ( copyIsArray && !Array.isArray( src ) ) { + clone = []; + } else if ( !copyIsArray && !jQuery.isPlainObject( src ) ) { + clone = {}; + } else { + clone = src; + } + copyIsArray = false; + + // Never move original objects, clone them + target[ name ] = jQuery.extend( deep, clone, copy ); + + // Don't bring in undefined values + } else if ( copy !== undefined ) { + target[ name ] = copy; + } + } + } + } + + // Return the modified object + return target; +}; + +jQuery.extend( { + + // Unique for each copy of jQuery on the page + expando: "jQuery" + ( version + Math.random() ).replace( /\D/g, "" ), + + // Assume jQuery is ready without the ready module + isReady: true, + + error: function( msg ) { + throw new Error( msg ); + }, + + noop: function() {}, + + isPlainObject: function( obj ) { + var proto, Ctor; + + // Detect obvious negatives + // Use toString instead of jQuery.type to catch host objects + if ( !obj || toString.call( obj ) !== "[object Object]" ) { + return false; + } + + proto = getProto( obj ); + + // Objects with no prototype (e.g., `Object.create( null )`) are plain + if ( !proto ) { + return true; + } + + // Objects with prototype are plain iff they were constructed by a global Object function + Ctor = hasOwn.call( proto, "constructor" ) && proto.constructor; + return typeof Ctor === "function" && fnToString.call( Ctor ) === ObjectFunctionString; + }, + + isEmptyObject: function( obj ) { + var name; + + for ( name in obj ) { + return false; + } + return true; + }, + + // Evaluates a script in a provided context; falls back to the global one + // if not specified. + globalEval: function( code, options, doc ) { + DOMEval( code, { nonce: options && options.nonce }, doc ); + }, + + each: function( obj, callback ) { + var length, i = 0; + + if ( isArrayLike( obj ) ) { + length = obj.length; + for ( ; i < length; i++ ) { + if ( callback.call( obj[ i ], i, obj[ i ] ) === false ) { + break; + } + } + } else { + for ( i in obj ) { + if ( callback.call( obj[ i ], i, obj[ i ] ) === false ) { + break; + } + } + } + + return obj; + }, + + // results is for internal usage only + makeArray: function( arr, results ) { + var ret = results || []; + + if ( arr != null ) { + if ( isArrayLike( Object( arr ) ) ) { + jQuery.merge( ret, + typeof arr === "string" ? + [ arr ] : arr + ); + } else { + push.call( ret, arr ); + } + } + + return ret; + }, + + inArray: function( elem, arr, i ) { + return arr == null ? -1 : indexOf.call( arr, elem, i ); + }, + + // Support: Android <=4.0 only, PhantomJS 1 only + // push.apply(_, arraylike) throws on ancient WebKit + merge: function( first, second ) { + var len = +second.length, + j = 0, + i = first.length; + + for ( ; j < len; j++ ) { + first[ i++ ] = second[ j ]; + } + + first.length = i; + + return first; + }, + + grep: function( elems, callback, invert ) { + var callbackInverse, + matches = [], + i = 0, + length = elems.length, + callbackExpect = !invert; + + // Go through the array, only saving the items + // that pass the validator function + for ( ; i < length; i++ ) { + callbackInverse = !callback( elems[ i ], i ); + if ( callbackInverse !== callbackExpect ) { + matches.push( elems[ i ] ); + } + } + + return matches; + }, + + // arg is for internal usage only + map: function( elems, callback, arg ) { + var length, value, + i = 0, + ret = []; + + // Go through the array, translating each of the items to their new values + if ( isArrayLike( elems ) ) { + length = elems.length; + for ( ; i < length; i++ ) { + value = callback( elems[ i ], i, arg ); + + if ( value != null ) { + ret.push( value ); + } + } + + // Go through every key on the object, + } else { + for ( i in elems ) { + value = callback( elems[ i ], i, arg ); + + if ( value != null ) { + ret.push( value ); + } + } + } + + // Flatten any nested arrays + return flat( ret ); + }, + + // A global GUID counter for objects + guid: 1, + + // jQuery.support is not used in Core but other projects attach their + // properties to it so it needs to exist. + support: support +} ); + +if ( typeof Symbol === "function" ) { + jQuery.fn[ Symbol.iterator ] = arr[ Symbol.iterator ]; +} + +// Populate the class2type map +jQuery.each( "Boolean Number String Function Array Date RegExp Object Error Symbol".split( " " ), + function( _i, name ) { + class2type[ "[object " + name + "]" ] = name.toLowerCase(); + } ); + +function isArrayLike( obj ) { + + // Support: real iOS 8.2 only (not reproducible in simulator) + // `in` check used to prevent JIT error (gh-2145) + // hasOwn isn't used here due to false negatives + // regarding Nodelist length in IE + var length = !!obj && "length" in obj && obj.length, + type = toType( obj ); + + if ( isFunction( obj ) || isWindow( obj ) ) { + return false; + } + + return type === "array" || length === 0 || + typeof length === "number" && length > 0 && ( length - 1 ) in obj; +} +var Sizzle = +/*! + * Sizzle CSS Selector Engine v2.3.6 + * https://sizzlejs.com/ + * + * Copyright JS Foundation and other contributors + * Released under the MIT license + * https://js.foundation/ + * + * Date: 2021-02-16 + */ +( function( window ) { +var i, + support, + Expr, + getText, + isXML, + tokenize, + compile, + select, + outermostContext, + sortInput, + hasDuplicate, + + // Local document vars + setDocument, + document, + docElem, + documentIsHTML, + rbuggyQSA, + rbuggyMatches, + matches, + contains, + + // Instance-specific data + expando = "sizzle" + 1 * new Date(), + preferredDoc = window.document, + dirruns = 0, + done = 0, + classCache = createCache(), + tokenCache = createCache(), + compilerCache = createCache(), + nonnativeSelectorCache = createCache(), + sortOrder = function( a, b ) { + if ( a === b ) { + hasDuplicate = true; + } + return 0; + }, + + // Instance methods + hasOwn = ( {} ).hasOwnProperty, + arr = [], + pop = arr.pop, + pushNative = arr.push, + push = arr.push, + slice = arr.slice, + + // Use a stripped-down indexOf as it's faster than native + // https://jsperf.com/thor-indexof-vs-for/5 + indexOf = function( list, elem ) { + var i = 0, + len = list.length; + for ( ; i < len; i++ ) { + if ( list[ i ] === elem ) { + return i; + } + } + return -1; + }, + + booleans = "checked|selected|async|autofocus|autoplay|controls|defer|disabled|hidden|" + + "ismap|loop|multiple|open|readonly|required|scoped", + + // Regular expressions + + // http://www.w3.org/TR/css3-selectors/#whitespace + whitespace = "[\\x20\\t\\r\\n\\f]", + + // https://www.w3.org/TR/css-syntax-3/#ident-token-diagram + identifier = "(?:\\\\[\\da-fA-F]{1,6}" + whitespace + + "?|\\\\[^\\r\\n\\f]|[\\w-]|[^\0-\\x7f])+", + + // Attribute selectors: http://www.w3.org/TR/selectors/#attribute-selectors + attributes = "\\[" + whitespace + "*(" + identifier + ")(?:" + whitespace + + + // Operator (capture 2) + "*([*^$|!~]?=)" + whitespace + + + // "Attribute values must be CSS identifiers [capture 5] + // or strings [capture 3 or capture 4]" + "*(?:'((?:\\\\.|[^\\\\'])*)'|\"((?:\\\\.|[^\\\\\"])*)\"|(" + identifier + "))|)" + + whitespace + "*\\]", + + pseudos = ":(" + identifier + ")(?:\\((" + + + // To reduce the number of selectors needing tokenize in the preFilter, prefer arguments: + // 1. quoted (capture 3; capture 4 or capture 5) + "('((?:\\\\.|[^\\\\'])*)'|\"((?:\\\\.|[^\\\\\"])*)\")|" + + + // 2. simple (capture 6) + "((?:\\\\.|[^\\\\()[\\]]|" + attributes + ")*)|" + + + // 3. anything else (capture 2) + ".*" + + ")\\)|)", + + // Leading and non-escaped trailing whitespace, capturing some non-whitespace characters preceding the latter + rwhitespace = new RegExp( whitespace + "+", "g" ), + rtrim = new RegExp( "^" + whitespace + "+|((?:^|[^\\\\])(?:\\\\.)*)" + + whitespace + "+$", "g" ), + + rcomma = new RegExp( "^" + whitespace + "*," + whitespace + "*" ), + rcombinators = new RegExp( "^" + whitespace + "*([>+~]|" + whitespace + ")" + whitespace + + "*" ), + rdescend = new RegExp( whitespace + "|>" ), + + rpseudo = new RegExp( pseudos ), + ridentifier = new RegExp( "^" + identifier + "$" ), + + matchExpr = { + "ID": new RegExp( "^#(" + identifier + ")" ), + "CLASS": new RegExp( "^\\.(" + identifier + ")" ), + "TAG": new RegExp( "^(" + identifier + "|[*])" ), + "ATTR": new RegExp( "^" + attributes ), + "PSEUDO": new RegExp( "^" + pseudos ), + "CHILD": new RegExp( "^:(only|first|last|nth|nth-last)-(child|of-type)(?:\\(" + + whitespace + "*(even|odd|(([+-]|)(\\d*)n|)" + whitespace + "*(?:([+-]|)" + + whitespace + "*(\\d+)|))" + whitespace + "*\\)|)", "i" ), + "bool": new RegExp( "^(?:" + booleans + ")$", "i" ), + + // For use in libraries implementing .is() + // We use this for POS matching in `select` + "needsContext": new RegExp( "^" + whitespace + + "*[>+~]|:(even|odd|eq|gt|lt|nth|first|last)(?:\\(" + whitespace + + "*((?:-\\d)?\\d*)" + whitespace + "*\\)|)(?=[^-]|$)", "i" ) + }, + + rhtml = /HTML$/i, + rinputs = /^(?:input|select|textarea|button)$/i, + rheader = /^h\d$/i, + + rnative = /^[^{]+\{\s*\[native \w/, + + // Easily-parseable/retrievable ID or TAG or CLASS selectors + rquickExpr = /^(?:#([\w-]+)|(\w+)|\.([\w-]+))$/, + + rsibling = /[+~]/, + + // CSS escapes + // http://www.w3.org/TR/CSS21/syndata.html#escaped-characters + runescape = new RegExp( "\\\\[\\da-fA-F]{1,6}" + whitespace + "?|\\\\([^\\r\\n\\f])", "g" ), + funescape = function( escape, nonHex ) { + var high = "0x" + escape.slice( 1 ) - 0x10000; + + return nonHex ? + + // Strip the backslash prefix from a non-hex escape sequence + nonHex : + + // Replace a hexadecimal escape sequence with the encoded Unicode code point + // Support: IE <=11+ + // For values outside the Basic Multilingual Plane (BMP), manually construct a + // surrogate pair + high < 0 ? + String.fromCharCode( high + 0x10000 ) : + String.fromCharCode( high >> 10 | 0xD800, high & 0x3FF | 0xDC00 ); + }, + + // CSS string/identifier serialization + // https://drafts.csswg.org/cssom/#common-serializing-idioms + rcssescape = /([\0-\x1f\x7f]|^-?\d)|^-$|[^\0-\x1f\x7f-\uFFFF\w-]/g, + fcssescape = function( ch, asCodePoint ) { + if ( asCodePoint ) { + + // U+0000 NULL becomes U+FFFD REPLACEMENT CHARACTER + if ( ch === "\0" ) { + return "\uFFFD"; + } + + // Control characters and (dependent upon position) numbers get escaped as code points + return ch.slice( 0, -1 ) + "\\" + + ch.charCodeAt( ch.length - 1 ).toString( 16 ) + " "; + } + + // Other potentially-special ASCII characters get backslash-escaped + return "\\" + ch; + }, + + // Used for iframes + // See setDocument() + // Removing the function wrapper causes a "Permission Denied" + // error in IE + unloadHandler = function() { + setDocument(); + }, + + inDisabledFieldset = addCombinator( + function( elem ) { + return elem.disabled === true && elem.nodeName.toLowerCase() === "fieldset"; + }, + { dir: "parentNode", next: "legend" } + ); + +// Optimize for push.apply( _, NodeList ) +try { + push.apply( + ( arr = slice.call( preferredDoc.childNodes ) ), + preferredDoc.childNodes + ); + + // Support: Android<4.0 + // Detect silently failing push.apply + // eslint-disable-next-line no-unused-expressions + arr[ preferredDoc.childNodes.length ].nodeType; +} catch ( e ) { + push = { apply: arr.length ? + + // Leverage slice if possible + function( target, els ) { + pushNative.apply( target, slice.call( els ) ); + } : + + // Support: IE<9 + // Otherwise append directly + function( target, els ) { + var j = target.length, + i = 0; + + // Can't trust NodeList.length + while ( ( target[ j++ ] = els[ i++ ] ) ) {} + target.length = j - 1; + } + }; +} + +function Sizzle( selector, context, results, seed ) { + var m, i, elem, nid, match, groups, newSelector, + newContext = context && context.ownerDocument, + + // nodeType defaults to 9, since context defaults to document + nodeType = context ? context.nodeType : 9; + + results = results || []; + + // Return early from calls with invalid selector or context + if ( typeof selector !== "string" || !selector || + nodeType !== 1 && nodeType !== 9 && nodeType !== 11 ) { + + return results; + } + + // Try to shortcut find operations (as opposed to filters) in HTML documents + if ( !seed ) { + setDocument( context ); + context = context || document; + + if ( documentIsHTML ) { + + // If the selector is sufficiently simple, try using a "get*By*" DOM method + // (excepting DocumentFragment context, where the methods don't exist) + if ( nodeType !== 11 && ( match = rquickExpr.exec( selector ) ) ) { + + // ID selector + if ( ( m = match[ 1 ] ) ) { + + // Document context + if ( nodeType === 9 ) { + if ( ( elem = context.getElementById( m ) ) ) { + + // Support: IE, Opera, Webkit + // TODO: identify versions + // getElementById can match elements by name instead of ID + if ( elem.id === m ) { + results.push( elem ); + return results; + } + } else { + return results; + } + + // Element context + } else { + + // Support: IE, Opera, Webkit + // TODO: identify versions + // getElementById can match elements by name instead of ID + if ( newContext && ( elem = newContext.getElementById( m ) ) && + contains( context, elem ) && + elem.id === m ) { + + results.push( elem ); + return results; + } + } + + // Type selector + } else if ( match[ 2 ] ) { + push.apply( results, context.getElementsByTagName( selector ) ); + return results; + + // Class selector + } else if ( ( m = match[ 3 ] ) && support.getElementsByClassName && + context.getElementsByClassName ) { + + push.apply( results, context.getElementsByClassName( m ) ); + return results; + } + } + + // Take advantage of querySelectorAll + if ( support.qsa && + !nonnativeSelectorCache[ selector + " " ] && + ( !rbuggyQSA || !rbuggyQSA.test( selector ) ) && + + // Support: IE 8 only + // Exclude object elements + ( nodeType !== 1 || context.nodeName.toLowerCase() !== "object" ) ) { + + newSelector = selector; + newContext = context; + + // qSA considers elements outside a scoping root when evaluating child or + // descendant combinators, which is not what we want. + // In such cases, we work around the behavior by prefixing every selector in the + // list with an ID selector referencing the scope context. + // The technique has to be used as well when a leading combinator is used + // as such selectors are not recognized by querySelectorAll. + // Thanks to Andrew Dupont for this technique. + if ( nodeType === 1 && + ( rdescend.test( selector ) || rcombinators.test( selector ) ) ) { + + // Expand context for sibling selectors + newContext = rsibling.test( selector ) && testContext( context.parentNode ) || + context; + + // We can use :scope instead of the ID hack if the browser + // supports it & if we're not changing the context. + if ( newContext !== context || !support.scope ) { + + // Capture the context ID, setting it first if necessary + if ( ( nid = context.getAttribute( "id" ) ) ) { + nid = nid.replace( rcssescape, fcssescape ); + } else { + context.setAttribute( "id", ( nid = expando ) ); + } + } + + // Prefix every selector in the list + groups = tokenize( selector ); + i = groups.length; + while ( i-- ) { + groups[ i ] = ( nid ? "#" + nid : ":scope" ) + " " + + toSelector( groups[ i ] ); + } + newSelector = groups.join( "," ); + } + + try { + push.apply( results, + newContext.querySelectorAll( newSelector ) + ); + return results; + } catch ( qsaError ) { + nonnativeSelectorCache( selector, true ); + } finally { + if ( nid === expando ) { + context.removeAttribute( "id" ); + } + } + } + } + } + + // All others + return select( selector.replace( rtrim, "$1" ), context, results, seed ); +} + +/** + * Create key-value caches of limited size + * @returns {function(string, object)} Returns the Object data after storing it on itself with + * property name the (space-suffixed) string and (if the cache is larger than Expr.cacheLength) + * deleting the oldest entry + */ +function createCache() { + var keys = []; + + function cache( key, value ) { + + // Use (key + " ") to avoid collision with native prototype properties (see Issue #157) + if ( keys.push( key + " " ) > Expr.cacheLength ) { + + // Only keep the most recent entries + delete cache[ keys.shift() ]; + } + return ( cache[ key + " " ] = value ); + } + return cache; +} + +/** + * Mark a function for special use by Sizzle + * @param {Function} fn The function to mark + */ +function markFunction( fn ) { + fn[ expando ] = true; + return fn; +} + +/** + * Support testing using an element + * @param {Function} fn Passed the created element and returns a boolean result + */ +function assert( fn ) { + var el = document.createElement( "fieldset" ); + + try { + return !!fn( el ); + } catch ( e ) { + return false; + } finally { + + // Remove from its parent by default + if ( el.parentNode ) { + el.parentNode.removeChild( el ); + } + + // release memory in IE + el = null; + } +} + +/** + * Adds the same handler for all of the specified attrs + * @param {String} attrs Pipe-separated list of attributes + * @param {Function} handler The method that will be applied + */ +function addHandle( attrs, handler ) { + var arr = attrs.split( "|" ), + i = arr.length; + + while ( i-- ) { + Expr.attrHandle[ arr[ i ] ] = handler; + } +} + +/** + * Checks document order of two siblings + * @param {Element} a + * @param {Element} b + * @returns {Number} Returns less than 0 if a precedes b, greater than 0 if a follows b + */ +function siblingCheck( a, b ) { + var cur = b && a, + diff = cur && a.nodeType === 1 && b.nodeType === 1 && + a.sourceIndex - b.sourceIndex; + + // Use IE sourceIndex if available on both nodes + if ( diff ) { + return diff; + } + + // Check if b follows a + if ( cur ) { + while ( ( cur = cur.nextSibling ) ) { + if ( cur === b ) { + return -1; + } + } + } + + return a ? 1 : -1; +} + +/** + * Returns a function to use in pseudos for input types + * @param {String} type + */ +function createInputPseudo( type ) { + return function( elem ) { + var name = elem.nodeName.toLowerCase(); + return name === "input" && elem.type === type; + }; +} + +/** + * Returns a function to use in pseudos for buttons + * @param {String} type + */ +function createButtonPseudo( type ) { + return function( elem ) { + var name = elem.nodeName.toLowerCase(); + return ( name === "input" || name === "button" ) && elem.type === type; + }; +} + +/** + * Returns a function to use in pseudos for :enabled/:disabled + * @param {Boolean} disabled true for :disabled; false for :enabled + */ +function createDisabledPseudo( disabled ) { + + // Known :disabled false positives: fieldset[disabled] > legend:nth-of-type(n+2) :can-disable + return function( elem ) { + + // Only certain elements can match :enabled or :disabled + // https://html.spec.whatwg.org/multipage/scripting.html#selector-enabled + // https://html.spec.whatwg.org/multipage/scripting.html#selector-disabled + if ( "form" in elem ) { + + // Check for inherited disabledness on relevant non-disabled elements: + // * listed form-associated elements in a disabled fieldset + // https://html.spec.whatwg.org/multipage/forms.html#category-listed + // https://html.spec.whatwg.org/multipage/forms.html#concept-fe-disabled + // * option elements in a disabled optgroup + // https://html.spec.whatwg.org/multipage/forms.html#concept-option-disabled + // All such elements have a "form" property. + if ( elem.parentNode && elem.disabled === false ) { + + // Option elements defer to a parent optgroup if present + if ( "label" in elem ) { + if ( "label" in elem.parentNode ) { + return elem.parentNode.disabled === disabled; + } else { + return elem.disabled === disabled; + } + } + + // Support: IE 6 - 11 + // Use the isDisabled shortcut property to check for disabled fieldset ancestors + return elem.isDisabled === disabled || + + // Where there is no isDisabled, check manually + /* jshint -W018 */ + elem.isDisabled !== !disabled && + inDisabledFieldset( elem ) === disabled; + } + + return elem.disabled === disabled; + + // Try to winnow out elements that can't be disabled before trusting the disabled property. + // Some victims get caught in our net (label, legend, menu, track), but it shouldn't + // even exist on them, let alone have a boolean value. + } else if ( "label" in elem ) { + return elem.disabled === disabled; + } + + // Remaining elements are neither :enabled nor :disabled + return false; + }; +} + +/** + * Returns a function to use in pseudos for positionals + * @param {Function} fn + */ +function createPositionalPseudo( fn ) { + return markFunction( function( argument ) { + argument = +argument; + return markFunction( function( seed, matches ) { + var j, + matchIndexes = fn( [], seed.length, argument ), + i = matchIndexes.length; + + // Match elements found at the specified indexes + while ( i-- ) { + if ( seed[ ( j = matchIndexes[ i ] ) ] ) { + seed[ j ] = !( matches[ j ] = seed[ j ] ); + } + } + } ); + } ); +} + +/** + * Checks a node for validity as a Sizzle context + * @param {Element|Object=} context + * @returns {Element|Object|Boolean} The input node if acceptable, otherwise a falsy value + */ +function testContext( context ) { + return context && typeof context.getElementsByTagName !== "undefined" && context; +} + +// Expose support vars for convenience +support = Sizzle.support = {}; + +/** + * Detects XML nodes + * @param {Element|Object} elem An element or a document + * @returns {Boolean} True iff elem is a non-HTML XML node + */ +isXML = Sizzle.isXML = function( elem ) { + var namespace = elem && elem.namespaceURI, + docElem = elem && ( elem.ownerDocument || elem ).documentElement; + + // Support: IE <=8 + // Assume HTML when documentElement doesn't yet exist, such as inside loading iframes + // https://bugs.jquery.com/ticket/4833 + return !rhtml.test( namespace || docElem && docElem.nodeName || "HTML" ); +}; + +/** + * Sets document-related variables once based on the current document + * @param {Element|Object} [doc] An element or document object to use to set the document + * @returns {Object} Returns the current document + */ +setDocument = Sizzle.setDocument = function( node ) { + var hasCompare, subWindow, + doc = node ? node.ownerDocument || node : preferredDoc; + + // Return early if doc is invalid or already selected + // Support: IE 11+, Edge 17 - 18+ + // IE/Edge sometimes throw a "Permission denied" error when strict-comparing + // two documents; shallow comparisons work. + // eslint-disable-next-line eqeqeq + if ( doc == document || doc.nodeType !== 9 || !doc.documentElement ) { + return document; + } + + // Update global variables + document = doc; + docElem = document.documentElement; + documentIsHTML = !isXML( document ); + + // Support: IE 9 - 11+, Edge 12 - 18+ + // Accessing iframe documents after unload throws "permission denied" errors (jQuery #13936) + // Support: IE 11+, Edge 17 - 18+ + // IE/Edge sometimes throw a "Permission denied" error when strict-comparing + // two documents; shallow comparisons work. + // eslint-disable-next-line eqeqeq + if ( preferredDoc != document && + ( subWindow = document.defaultView ) && subWindow.top !== subWindow ) { + + // Support: IE 11, Edge + if ( subWindow.addEventListener ) { + subWindow.addEventListener( "unload", unloadHandler, false ); + + // Support: IE 9 - 10 only + } else if ( subWindow.attachEvent ) { + subWindow.attachEvent( "onunload", unloadHandler ); + } + } + + // Support: IE 8 - 11+, Edge 12 - 18+, Chrome <=16 - 25 only, Firefox <=3.6 - 31 only, + // Safari 4 - 5 only, Opera <=11.6 - 12.x only + // IE/Edge & older browsers don't support the :scope pseudo-class. + // Support: Safari 6.0 only + // Safari 6.0 supports :scope but it's an alias of :root there. + support.scope = assert( function( el ) { + docElem.appendChild( el ).appendChild( document.createElement( "div" ) ); + return typeof el.querySelectorAll !== "undefined" && + !el.querySelectorAll( ":scope fieldset div" ).length; + } ); + + /* Attributes + ---------------------------------------------------------------------- */ + + // Support: IE<8 + // Verify that getAttribute really returns attributes and not properties + // (excepting IE8 booleans) + support.attributes = assert( function( el ) { + el.className = "i"; + return !el.getAttribute( "className" ); + } ); + + /* getElement(s)By* + ---------------------------------------------------------------------- */ + + // Check if getElementsByTagName("*") returns only elements + support.getElementsByTagName = assert( function( el ) { + el.appendChild( document.createComment( "" ) ); + return !el.getElementsByTagName( "*" ).length; + } ); + + // Support: IE<9 + support.getElementsByClassName = rnative.test( document.getElementsByClassName ); + + // Support: IE<10 + // Check if getElementById returns elements by name + // The broken getElementById methods don't pick up programmatically-set names, + // so use a roundabout getElementsByName test + support.getById = assert( function( el ) { + docElem.appendChild( el ).id = expando; + return !document.getElementsByName || !document.getElementsByName( expando ).length; + } ); + + // ID filter and find + if ( support.getById ) { + Expr.filter[ "ID" ] = function( id ) { + var attrId = id.replace( runescape, funescape ); + return function( elem ) { + return elem.getAttribute( "id" ) === attrId; + }; + }; + Expr.find[ "ID" ] = function( id, context ) { + if ( typeof context.getElementById !== "undefined" && documentIsHTML ) { + var elem = context.getElementById( id ); + return elem ? [ elem ] : []; + } + }; + } else { + Expr.filter[ "ID" ] = function( id ) { + var attrId = id.replace( runescape, funescape ); + return function( elem ) { + var node = typeof elem.getAttributeNode !== "undefined" && + elem.getAttributeNode( "id" ); + return node && node.value === attrId; + }; + }; + + // Support: IE 6 - 7 only + // getElementById is not reliable as a find shortcut + Expr.find[ "ID" ] = function( id, context ) { + if ( typeof context.getElementById !== "undefined" && documentIsHTML ) { + var node, i, elems, + elem = context.getElementById( id ); + + if ( elem ) { + + // Verify the id attribute + node = elem.getAttributeNode( "id" ); + if ( node && node.value === id ) { + return [ elem ]; + } + + // Fall back on getElementsByName + elems = context.getElementsByName( id ); + i = 0; + while ( ( elem = elems[ i++ ] ) ) { + node = elem.getAttributeNode( "id" ); + if ( node && node.value === id ) { + return [ elem ]; + } + } + } + + return []; + } + }; + } + + // Tag + Expr.find[ "TAG" ] = support.getElementsByTagName ? + function( tag, context ) { + if ( typeof context.getElementsByTagName !== "undefined" ) { + return context.getElementsByTagName( tag ); + + // DocumentFragment nodes don't have gEBTN + } else if ( support.qsa ) { + return context.querySelectorAll( tag ); + } + } : + + function( tag, context ) { + var elem, + tmp = [], + i = 0, + + // By happy coincidence, a (broken) gEBTN appears on DocumentFragment nodes too + results = context.getElementsByTagName( tag ); + + // Filter out possible comments + if ( tag === "*" ) { + while ( ( elem = results[ i++ ] ) ) { + if ( elem.nodeType === 1 ) { + tmp.push( elem ); + } + } + + return tmp; + } + return results; + }; + + // Class + Expr.find[ "CLASS" ] = support.getElementsByClassName && function( className, context ) { + if ( typeof context.getElementsByClassName !== "undefined" && documentIsHTML ) { + return context.getElementsByClassName( className ); + } + }; + + /* QSA/matchesSelector + ---------------------------------------------------------------------- */ + + // QSA and matchesSelector support + + // matchesSelector(:active) reports false when true (IE9/Opera 11.5) + rbuggyMatches = []; + + // qSa(:focus) reports false when true (Chrome 21) + // We allow this because of a bug in IE8/9 that throws an error + // whenever `document.activeElement` is accessed on an iframe + // So, we allow :focus to pass through QSA all the time to avoid the IE error + // See https://bugs.jquery.com/ticket/13378 + rbuggyQSA = []; + + if ( ( support.qsa = rnative.test( document.querySelectorAll ) ) ) { + + // Build QSA regex + // Regex strategy adopted from Diego Perini + assert( function( el ) { + + var input; + + // Select is set to empty string on purpose + // This is to test IE's treatment of not explicitly + // setting a boolean content attribute, + // since its presence should be enough + // https://bugs.jquery.com/ticket/12359 + docElem.appendChild( el ).innerHTML = "" + + ""; + + // Support: IE8, Opera 11-12.16 + // Nothing should be selected when empty strings follow ^= or $= or *= + // The test attribute must be unknown in Opera but "safe" for WinRT + // https://msdn.microsoft.com/en-us/library/ie/hh465388.aspx#attribute_section + if ( el.querySelectorAll( "[msallowcapture^='']" ).length ) { + rbuggyQSA.push( "[*^$]=" + whitespace + "*(?:''|\"\")" ); + } + + // Support: IE8 + // Boolean attributes and "value" are not treated correctly + if ( !el.querySelectorAll( "[selected]" ).length ) { + rbuggyQSA.push( "\\[" + whitespace + "*(?:value|" + booleans + ")" ); + } + + // Support: Chrome<29, Android<4.4, Safari<7.0+, iOS<7.0+, PhantomJS<1.9.8+ + if ( !el.querySelectorAll( "[id~=" + expando + "-]" ).length ) { + rbuggyQSA.push( "~=" ); + } + + // Support: IE 11+, Edge 15 - 18+ + // IE 11/Edge don't find elements on a `[name='']` query in some cases. + // Adding a temporary attribute to the document before the selection works + // around the issue. + // Interestingly, IE 10 & older don't seem to have the issue. + input = document.createElement( "input" ); + input.setAttribute( "name", "" ); + el.appendChild( input ); + if ( !el.querySelectorAll( "[name='']" ).length ) { + rbuggyQSA.push( "\\[" + whitespace + "*name" + whitespace + "*=" + + whitespace + "*(?:''|\"\")" ); + } + + // Webkit/Opera - :checked should return selected option elements + // http://www.w3.org/TR/2011/REC-css3-selectors-20110929/#checked + // IE8 throws error here and will not see later tests + if ( !el.querySelectorAll( ":checked" ).length ) { + rbuggyQSA.push( ":checked" ); + } + + // Support: Safari 8+, iOS 8+ + // https://bugs.webkit.org/show_bug.cgi?id=136851 + // In-page `selector#id sibling-combinator selector` fails + if ( !el.querySelectorAll( "a#" + expando + "+*" ).length ) { + rbuggyQSA.push( ".#.+[+~]" ); + } + + // Support: Firefox <=3.6 - 5 only + // Old Firefox doesn't throw on a badly-escaped identifier. + el.querySelectorAll( "\\\f" ); + rbuggyQSA.push( "[\\r\\n\\f]" ); + } ); + + assert( function( el ) { + el.innerHTML = "" + + ""; + + // Support: Windows 8 Native Apps + // The type and name attributes are restricted during .innerHTML assignment + var input = document.createElement( "input" ); + input.setAttribute( "type", "hidden" ); + el.appendChild( input ).setAttribute( "name", "D" ); + + // Support: IE8 + // Enforce case-sensitivity of name attribute + if ( el.querySelectorAll( "[name=d]" ).length ) { + rbuggyQSA.push( "name" + whitespace + "*[*^$|!~]?=" ); + } + + // FF 3.5 - :enabled/:disabled and hidden elements (hidden elements are still enabled) + // IE8 throws error here and will not see later tests + if ( el.querySelectorAll( ":enabled" ).length !== 2 ) { + rbuggyQSA.push( ":enabled", ":disabled" ); + } + + // Support: IE9-11+ + // IE's :disabled selector does not pick up the children of disabled fieldsets + docElem.appendChild( el ).disabled = true; + if ( el.querySelectorAll( ":disabled" ).length !== 2 ) { + rbuggyQSA.push( ":enabled", ":disabled" ); + } + + // Support: Opera 10 - 11 only + // Opera 10-11 does not throw on post-comma invalid pseudos + el.querySelectorAll( "*,:x" ); + rbuggyQSA.push( ",.*:" ); + } ); + } + + if ( ( support.matchesSelector = rnative.test( ( matches = docElem.matches || + docElem.webkitMatchesSelector || + docElem.mozMatchesSelector || + docElem.oMatchesSelector || + docElem.msMatchesSelector ) ) ) ) { + + assert( function( el ) { + + // Check to see if it's possible to do matchesSelector + // on a disconnected node (IE 9) + support.disconnectedMatch = matches.call( el, "*" ); + + // This should fail with an exception + // Gecko does not error, returns false instead + matches.call( el, "[s!='']:x" ); + rbuggyMatches.push( "!=", pseudos ); + } ); + } + + rbuggyQSA = rbuggyQSA.length && new RegExp( rbuggyQSA.join( "|" ) ); + rbuggyMatches = rbuggyMatches.length && new RegExp( rbuggyMatches.join( "|" ) ); + + /* Contains + ---------------------------------------------------------------------- */ + hasCompare = rnative.test( docElem.compareDocumentPosition ); + + // Element contains another + // Purposefully self-exclusive + // As in, an element does not contain itself + contains = hasCompare || rnative.test( docElem.contains ) ? + function( a, b ) { + var adown = a.nodeType === 9 ? a.documentElement : a, + bup = b && b.parentNode; + return a === bup || !!( bup && bup.nodeType === 1 && ( + adown.contains ? + adown.contains( bup ) : + a.compareDocumentPosition && a.compareDocumentPosition( bup ) & 16 + ) ); + } : + function( a, b ) { + if ( b ) { + while ( ( b = b.parentNode ) ) { + if ( b === a ) { + return true; + } + } + } + return false; + }; + + /* Sorting + ---------------------------------------------------------------------- */ + + // Document order sorting + sortOrder = hasCompare ? + function( a, b ) { + + // Flag for duplicate removal + if ( a === b ) { + hasDuplicate = true; + return 0; + } + + // Sort on method existence if only one input has compareDocumentPosition + var compare = !a.compareDocumentPosition - !b.compareDocumentPosition; + if ( compare ) { + return compare; + } + + // Calculate position if both inputs belong to the same document + // Support: IE 11+, Edge 17 - 18+ + // IE/Edge sometimes throw a "Permission denied" error when strict-comparing + // two documents; shallow comparisons work. + // eslint-disable-next-line eqeqeq + compare = ( a.ownerDocument || a ) == ( b.ownerDocument || b ) ? + a.compareDocumentPosition( b ) : + + // Otherwise we know they are disconnected + 1; + + // Disconnected nodes + if ( compare & 1 || + ( !support.sortDetached && b.compareDocumentPosition( a ) === compare ) ) { + + // Choose the first element that is related to our preferred document + // Support: IE 11+, Edge 17 - 18+ + // IE/Edge sometimes throw a "Permission denied" error when strict-comparing + // two documents; shallow comparisons work. + // eslint-disable-next-line eqeqeq + if ( a == document || a.ownerDocument == preferredDoc && + contains( preferredDoc, a ) ) { + return -1; + } + + // Support: IE 11+, Edge 17 - 18+ + // IE/Edge sometimes throw a "Permission denied" error when strict-comparing + // two documents; shallow comparisons work. + // eslint-disable-next-line eqeqeq + if ( b == document || b.ownerDocument == preferredDoc && + contains( preferredDoc, b ) ) { + return 1; + } + + // Maintain original order + return sortInput ? + ( indexOf( sortInput, a ) - indexOf( sortInput, b ) ) : + 0; + } + + return compare & 4 ? -1 : 1; + } : + function( a, b ) { + + // Exit early if the nodes are identical + if ( a === b ) { + hasDuplicate = true; + return 0; + } + + var cur, + i = 0, + aup = a.parentNode, + bup = b.parentNode, + ap = [ a ], + bp = [ b ]; + + // Parentless nodes are either documents or disconnected + if ( !aup || !bup ) { + + // Support: IE 11+, Edge 17 - 18+ + // IE/Edge sometimes throw a "Permission denied" error when strict-comparing + // two documents; shallow comparisons work. + /* eslint-disable eqeqeq */ + return a == document ? -1 : + b == document ? 1 : + /* eslint-enable eqeqeq */ + aup ? -1 : + bup ? 1 : + sortInput ? + ( indexOf( sortInput, a ) - indexOf( sortInput, b ) ) : + 0; + + // If the nodes are siblings, we can do a quick check + } else if ( aup === bup ) { + return siblingCheck( a, b ); + } + + // Otherwise we need full lists of their ancestors for comparison + cur = a; + while ( ( cur = cur.parentNode ) ) { + ap.unshift( cur ); + } + cur = b; + while ( ( cur = cur.parentNode ) ) { + bp.unshift( cur ); + } + + // Walk down the tree looking for a discrepancy + while ( ap[ i ] === bp[ i ] ) { + i++; + } + + return i ? + + // Do a sibling check if the nodes have a common ancestor + siblingCheck( ap[ i ], bp[ i ] ) : + + // Otherwise nodes in our document sort first + // Support: IE 11+, Edge 17 - 18+ + // IE/Edge sometimes throw a "Permission denied" error when strict-comparing + // two documents; shallow comparisons work. + /* eslint-disable eqeqeq */ + ap[ i ] == preferredDoc ? -1 : + bp[ i ] == preferredDoc ? 1 : + /* eslint-enable eqeqeq */ + 0; + }; + + return document; +}; + +Sizzle.matches = function( expr, elements ) { + return Sizzle( expr, null, null, elements ); +}; + +Sizzle.matchesSelector = function( elem, expr ) { + setDocument( elem ); + + if ( support.matchesSelector && documentIsHTML && + !nonnativeSelectorCache[ expr + " " ] && + ( !rbuggyMatches || !rbuggyMatches.test( expr ) ) && + ( !rbuggyQSA || !rbuggyQSA.test( expr ) ) ) { + + try { + var ret = matches.call( elem, expr ); + + // IE 9's matchesSelector returns false on disconnected nodes + if ( ret || support.disconnectedMatch || + + // As well, disconnected nodes are said to be in a document + // fragment in IE 9 + elem.document && elem.document.nodeType !== 11 ) { + return ret; + } + } catch ( e ) { + nonnativeSelectorCache( expr, true ); + } + } + + return Sizzle( expr, document, null, [ elem ] ).length > 0; +}; + +Sizzle.contains = function( context, elem ) { + + // Set document vars if needed + // Support: IE 11+, Edge 17 - 18+ + // IE/Edge sometimes throw a "Permission denied" error when strict-comparing + // two documents; shallow comparisons work. + // eslint-disable-next-line eqeqeq + if ( ( context.ownerDocument || context ) != document ) { + setDocument( context ); + } + return contains( context, elem ); +}; + +Sizzle.attr = function( elem, name ) { + + // Set document vars if needed + // Support: IE 11+, Edge 17 - 18+ + // IE/Edge sometimes throw a "Permission denied" error when strict-comparing + // two documents; shallow comparisons work. + // eslint-disable-next-line eqeqeq + if ( ( elem.ownerDocument || elem ) != document ) { + setDocument( elem ); + } + + var fn = Expr.attrHandle[ name.toLowerCase() ], + + // Don't get fooled by Object.prototype properties (jQuery #13807) + val = fn && hasOwn.call( Expr.attrHandle, name.toLowerCase() ) ? + fn( elem, name, !documentIsHTML ) : + undefined; + + return val !== undefined ? + val : + support.attributes || !documentIsHTML ? + elem.getAttribute( name ) : + ( val = elem.getAttributeNode( name ) ) && val.specified ? + val.value : + null; +}; + +Sizzle.escape = function( sel ) { + return ( sel + "" ).replace( rcssescape, fcssescape ); +}; + +Sizzle.error = function( msg ) { + throw new Error( "Syntax error, unrecognized expression: " + msg ); +}; + +/** + * Document sorting and removing duplicates + * @param {ArrayLike} results + */ +Sizzle.uniqueSort = function( results ) { + var elem, + duplicates = [], + j = 0, + i = 0; + + // Unless we *know* we can detect duplicates, assume their presence + hasDuplicate = !support.detectDuplicates; + sortInput = !support.sortStable && results.slice( 0 ); + results.sort( sortOrder ); + + if ( hasDuplicate ) { + while ( ( elem = results[ i++ ] ) ) { + if ( elem === results[ i ] ) { + j = duplicates.push( i ); + } + } + while ( j-- ) { + results.splice( duplicates[ j ], 1 ); + } + } + + // Clear input after sorting to release objects + // See https://github.com/jquery/sizzle/pull/225 + sortInput = null; + + return results; +}; + +/** + * Utility function for retrieving the text value of an array of DOM nodes + * @param {Array|Element} elem + */ +getText = Sizzle.getText = function( elem ) { + var node, + ret = "", + i = 0, + nodeType = elem.nodeType; + + if ( !nodeType ) { + + // If no nodeType, this is expected to be an array + while ( ( node = elem[ i++ ] ) ) { + + // Do not traverse comment nodes + ret += getText( node ); + } + } else if ( nodeType === 1 || nodeType === 9 || nodeType === 11 ) { + + // Use textContent for elements + // innerText usage removed for consistency of new lines (jQuery #11153) + if ( typeof elem.textContent === "string" ) { + return elem.textContent; + } else { + + // Traverse its children + for ( elem = elem.firstChild; elem; elem = elem.nextSibling ) { + ret += getText( elem ); + } + } + } else if ( nodeType === 3 || nodeType === 4 ) { + return elem.nodeValue; + } + + // Do not include comment or processing instruction nodes + + return ret; +}; + +Expr = Sizzle.selectors = { + + // Can be adjusted by the user + cacheLength: 50, + + createPseudo: markFunction, + + match: matchExpr, + + attrHandle: {}, + + find: {}, + + relative: { + ">": { dir: "parentNode", first: true }, + " ": { dir: "parentNode" }, + "+": { dir: "previousSibling", first: true }, + "~": { dir: "previousSibling" } + }, + + preFilter: { + "ATTR": function( match ) { + match[ 1 ] = match[ 1 ].replace( runescape, funescape ); + + // Move the given value to match[3] whether quoted or unquoted + match[ 3 ] = ( match[ 3 ] || match[ 4 ] || + match[ 5 ] || "" ).replace( runescape, funescape ); + + if ( match[ 2 ] === "~=" ) { + match[ 3 ] = " " + match[ 3 ] + " "; + } + + return match.slice( 0, 4 ); + }, + + "CHILD": function( match ) { + + /* matches from matchExpr["CHILD"] + 1 type (only|nth|...) + 2 what (child|of-type) + 3 argument (even|odd|\d*|\d*n([+-]\d+)?|...) + 4 xn-component of xn+y argument ([+-]?\d*n|) + 5 sign of xn-component + 6 x of xn-component + 7 sign of y-component + 8 y of y-component + */ + match[ 1 ] = match[ 1 ].toLowerCase(); + + if ( match[ 1 ].slice( 0, 3 ) === "nth" ) { + + // nth-* requires argument + if ( !match[ 3 ] ) { + Sizzle.error( match[ 0 ] ); + } + + // numeric x and y parameters for Expr.filter.CHILD + // remember that false/true cast respectively to 0/1 + match[ 4 ] = +( match[ 4 ] ? + match[ 5 ] + ( match[ 6 ] || 1 ) : + 2 * ( match[ 3 ] === "even" || match[ 3 ] === "odd" ) ); + match[ 5 ] = +( ( match[ 7 ] + match[ 8 ] ) || match[ 3 ] === "odd" ); + + // other types prohibit arguments + } else if ( match[ 3 ] ) { + Sizzle.error( match[ 0 ] ); + } + + return match; + }, + + "PSEUDO": function( match ) { + var excess, + unquoted = !match[ 6 ] && match[ 2 ]; + + if ( matchExpr[ "CHILD" ].test( match[ 0 ] ) ) { + return null; + } + + // Accept quoted arguments as-is + if ( match[ 3 ] ) { + match[ 2 ] = match[ 4 ] || match[ 5 ] || ""; + + // Strip excess characters from unquoted arguments + } else if ( unquoted && rpseudo.test( unquoted ) && + + // Get excess from tokenize (recursively) + ( excess = tokenize( unquoted, true ) ) && + + // advance to the next closing parenthesis + ( excess = unquoted.indexOf( ")", unquoted.length - excess ) - unquoted.length ) ) { + + // excess is a negative index + match[ 0 ] = match[ 0 ].slice( 0, excess ); + match[ 2 ] = unquoted.slice( 0, excess ); + } + + // Return only captures needed by the pseudo filter method (type and argument) + return match.slice( 0, 3 ); + } + }, + + filter: { + + "TAG": function( nodeNameSelector ) { + var nodeName = nodeNameSelector.replace( runescape, funescape ).toLowerCase(); + return nodeNameSelector === "*" ? + function() { + return true; + } : + function( elem ) { + return elem.nodeName && elem.nodeName.toLowerCase() === nodeName; + }; + }, + + "CLASS": function( className ) { + var pattern = classCache[ className + " " ]; + + return pattern || + ( pattern = new RegExp( "(^|" + whitespace + + ")" + className + "(" + whitespace + "|$)" ) ) && classCache( + className, function( elem ) { + return pattern.test( + typeof elem.className === "string" && elem.className || + typeof elem.getAttribute !== "undefined" && + elem.getAttribute( "class" ) || + "" + ); + } ); + }, + + "ATTR": function( name, operator, check ) { + return function( elem ) { + var result = Sizzle.attr( elem, name ); + + if ( result == null ) { + return operator === "!="; + } + if ( !operator ) { + return true; + } + + result += ""; + + /* eslint-disable max-len */ + + return operator === "=" ? result === check : + operator === "!=" ? result !== check : + operator === "^=" ? check && result.indexOf( check ) === 0 : + operator === "*=" ? check && result.indexOf( check ) > -1 : + operator === "$=" ? check && result.slice( -check.length ) === check : + operator === "~=" ? ( " " + result.replace( rwhitespace, " " ) + " " ).indexOf( check ) > -1 : + operator === "|=" ? result === check || result.slice( 0, check.length + 1 ) === check + "-" : + false; + /* eslint-enable max-len */ + + }; + }, + + "CHILD": function( type, what, _argument, first, last ) { + var simple = type.slice( 0, 3 ) !== "nth", + forward = type.slice( -4 ) !== "last", + ofType = what === "of-type"; + + return first === 1 && last === 0 ? + + // Shortcut for :nth-*(n) + function( elem ) { + return !!elem.parentNode; + } : + + function( elem, _context, xml ) { + var cache, uniqueCache, outerCache, node, nodeIndex, start, + dir = simple !== forward ? "nextSibling" : "previousSibling", + parent = elem.parentNode, + name = ofType && elem.nodeName.toLowerCase(), + useCache = !xml && !ofType, + diff = false; + + if ( parent ) { + + // :(first|last|only)-(child|of-type) + if ( simple ) { + while ( dir ) { + node = elem; + while ( ( node = node[ dir ] ) ) { + if ( ofType ? + node.nodeName.toLowerCase() === name : + node.nodeType === 1 ) { + + return false; + } + } + + // Reverse direction for :only-* (if we haven't yet done so) + start = dir = type === "only" && !start && "nextSibling"; + } + return true; + } + + start = [ forward ? parent.firstChild : parent.lastChild ]; + + // non-xml :nth-child(...) stores cache data on `parent` + if ( forward && useCache ) { + + // Seek `elem` from a previously-cached index + + // ...in a gzip-friendly way + node = parent; + outerCache = node[ expando ] || ( node[ expando ] = {} ); + + // Support: IE <9 only + // Defend against cloned attroperties (jQuery gh-1709) + uniqueCache = outerCache[ node.uniqueID ] || + ( outerCache[ node.uniqueID ] = {} ); + + cache = uniqueCache[ type ] || []; + nodeIndex = cache[ 0 ] === dirruns && cache[ 1 ]; + diff = nodeIndex && cache[ 2 ]; + node = nodeIndex && parent.childNodes[ nodeIndex ]; + + while ( ( node = ++nodeIndex && node && node[ dir ] || + + // Fallback to seeking `elem` from the start + ( diff = nodeIndex = 0 ) || start.pop() ) ) { + + // When found, cache indexes on `parent` and break + if ( node.nodeType === 1 && ++diff && node === elem ) { + uniqueCache[ type ] = [ dirruns, nodeIndex, diff ]; + break; + } + } + + } else { + + // Use previously-cached element index if available + if ( useCache ) { + + // ...in a gzip-friendly way + node = elem; + outerCache = node[ expando ] || ( node[ expando ] = {} ); + + // Support: IE <9 only + // Defend against cloned attroperties (jQuery gh-1709) + uniqueCache = outerCache[ node.uniqueID ] || + ( outerCache[ node.uniqueID ] = {} ); + + cache = uniqueCache[ type ] || []; + nodeIndex = cache[ 0 ] === dirruns && cache[ 1 ]; + diff = nodeIndex; + } + + // xml :nth-child(...) + // or :nth-last-child(...) or :nth(-last)?-of-type(...) + if ( diff === false ) { + + // Use the same loop as above to seek `elem` from the start + while ( ( node = ++nodeIndex && node && node[ dir ] || + ( diff = nodeIndex = 0 ) || start.pop() ) ) { + + if ( ( ofType ? + node.nodeName.toLowerCase() === name : + node.nodeType === 1 ) && + ++diff ) { + + // Cache the index of each encountered element + if ( useCache ) { + outerCache = node[ expando ] || + ( node[ expando ] = {} ); + + // Support: IE <9 only + // Defend against cloned attroperties (jQuery gh-1709) + uniqueCache = outerCache[ node.uniqueID ] || + ( outerCache[ node.uniqueID ] = {} ); + + uniqueCache[ type ] = [ dirruns, diff ]; + } + + if ( node === elem ) { + break; + } + } + } + } + } + + // Incorporate the offset, then check against cycle size + diff -= last; + return diff === first || ( diff % first === 0 && diff / first >= 0 ); + } + }; + }, + + "PSEUDO": function( pseudo, argument ) { + + // pseudo-class names are case-insensitive + // http://www.w3.org/TR/selectors/#pseudo-classes + // Prioritize by case sensitivity in case custom pseudos are added with uppercase letters + // Remember that setFilters inherits from pseudos + var args, + fn = Expr.pseudos[ pseudo ] || Expr.setFilters[ pseudo.toLowerCase() ] || + Sizzle.error( "unsupported pseudo: " + pseudo ); + + // The user may use createPseudo to indicate that + // arguments are needed to create the filter function + // just as Sizzle does + if ( fn[ expando ] ) { + return fn( argument ); + } + + // But maintain support for old signatures + if ( fn.length > 1 ) { + args = [ pseudo, pseudo, "", argument ]; + return Expr.setFilters.hasOwnProperty( pseudo.toLowerCase() ) ? + markFunction( function( seed, matches ) { + var idx, + matched = fn( seed, argument ), + i = matched.length; + while ( i-- ) { + idx = indexOf( seed, matched[ i ] ); + seed[ idx ] = !( matches[ idx ] = matched[ i ] ); + } + } ) : + function( elem ) { + return fn( elem, 0, args ); + }; + } + + return fn; + } + }, + + pseudos: { + + // Potentially complex pseudos + "not": markFunction( function( selector ) { + + // Trim the selector passed to compile + // to avoid treating leading and trailing + // spaces as combinators + var input = [], + results = [], + matcher = compile( selector.replace( rtrim, "$1" ) ); + + return matcher[ expando ] ? + markFunction( function( seed, matches, _context, xml ) { + var elem, + unmatched = matcher( seed, null, xml, [] ), + i = seed.length; + + // Match elements unmatched by `matcher` + while ( i-- ) { + if ( ( elem = unmatched[ i ] ) ) { + seed[ i ] = !( matches[ i ] = elem ); + } + } + } ) : + function( elem, _context, xml ) { + input[ 0 ] = elem; + matcher( input, null, xml, results ); + + // Don't keep the element (issue #299) + input[ 0 ] = null; + return !results.pop(); + }; + } ), + + "has": markFunction( function( selector ) { + return function( elem ) { + return Sizzle( selector, elem ).length > 0; + }; + } ), + + "contains": markFunction( function( text ) { + text = text.replace( runescape, funescape ); + return function( elem ) { + return ( elem.textContent || getText( elem ) ).indexOf( text ) > -1; + }; + } ), + + // "Whether an element is represented by a :lang() selector + // is based solely on the element's language value + // being equal to the identifier C, + // or beginning with the identifier C immediately followed by "-". + // The matching of C against the element's language value is performed case-insensitively. + // The identifier C does not have to be a valid language name." + // http://www.w3.org/TR/selectors/#lang-pseudo + "lang": markFunction( function( lang ) { + + // lang value must be a valid identifier + if ( !ridentifier.test( lang || "" ) ) { + Sizzle.error( "unsupported lang: " + lang ); + } + lang = lang.replace( runescape, funescape ).toLowerCase(); + return function( elem ) { + var elemLang; + do { + if ( ( elemLang = documentIsHTML ? + elem.lang : + elem.getAttribute( "xml:lang" ) || elem.getAttribute( "lang" ) ) ) { + + elemLang = elemLang.toLowerCase(); + return elemLang === lang || elemLang.indexOf( lang + "-" ) === 0; + } + } while ( ( elem = elem.parentNode ) && elem.nodeType === 1 ); + return false; + }; + } ), + + // Miscellaneous + "target": function( elem ) { + var hash = window.location && window.location.hash; + return hash && hash.slice( 1 ) === elem.id; + }, + + "root": function( elem ) { + return elem === docElem; + }, + + "focus": function( elem ) { + return elem === document.activeElement && + ( !document.hasFocus || document.hasFocus() ) && + !!( elem.type || elem.href || ~elem.tabIndex ); + }, + + // Boolean properties + "enabled": createDisabledPseudo( false ), + "disabled": createDisabledPseudo( true ), + + "checked": function( elem ) { + + // In CSS3, :checked should return both checked and selected elements + // http://www.w3.org/TR/2011/REC-css3-selectors-20110929/#checked + var nodeName = elem.nodeName.toLowerCase(); + return ( nodeName === "input" && !!elem.checked ) || + ( nodeName === "option" && !!elem.selected ); + }, + + "selected": function( elem ) { + + // Accessing this property makes selected-by-default + // options in Safari work properly + if ( elem.parentNode ) { + // eslint-disable-next-line no-unused-expressions + elem.parentNode.selectedIndex; + } + + return elem.selected === true; + }, + + // Contents + "empty": function( elem ) { + + // http://www.w3.org/TR/selectors/#empty-pseudo + // :empty is negated by element (1) or content nodes (text: 3; cdata: 4; entity ref: 5), + // but not by others (comment: 8; processing instruction: 7; etc.) + // nodeType < 6 works because attributes (2) do not appear as children + for ( elem = elem.firstChild; elem; elem = elem.nextSibling ) { + if ( elem.nodeType < 6 ) { + return false; + } + } + return true; + }, + + "parent": function( elem ) { + return !Expr.pseudos[ "empty" ]( elem ); + }, + + // Element/input types + "header": function( elem ) { + return rheader.test( elem.nodeName ); + }, + + "input": function( elem ) { + return rinputs.test( elem.nodeName ); + }, + + "button": function( elem ) { + var name = elem.nodeName.toLowerCase(); + return name === "input" && elem.type === "button" || name === "button"; + }, + + "text": function( elem ) { + var attr; + return elem.nodeName.toLowerCase() === "input" && + elem.type === "text" && + + // Support: IE<8 + // New HTML5 attribute values (e.g., "search") appear with elem.type === "text" + ( ( attr = elem.getAttribute( "type" ) ) == null || + attr.toLowerCase() === "text" ); + }, + + // Position-in-collection + "first": createPositionalPseudo( function() { + return [ 0 ]; + } ), + + "last": createPositionalPseudo( function( _matchIndexes, length ) { + return [ length - 1 ]; + } ), + + "eq": createPositionalPseudo( function( _matchIndexes, length, argument ) { + return [ argument < 0 ? argument + length : argument ]; + } ), + + "even": createPositionalPseudo( function( matchIndexes, length ) { + var i = 0; + for ( ; i < length; i += 2 ) { + matchIndexes.push( i ); + } + return matchIndexes; + } ), + + "odd": createPositionalPseudo( function( matchIndexes, length ) { + var i = 1; + for ( ; i < length; i += 2 ) { + matchIndexes.push( i ); + } + return matchIndexes; + } ), + + "lt": createPositionalPseudo( function( matchIndexes, length, argument ) { + var i = argument < 0 ? + argument + length : + argument > length ? + length : + argument; + for ( ; --i >= 0; ) { + matchIndexes.push( i ); + } + return matchIndexes; + } ), + + "gt": createPositionalPseudo( function( matchIndexes, length, argument ) { + var i = argument < 0 ? argument + length : argument; + for ( ; ++i < length; ) { + matchIndexes.push( i ); + } + return matchIndexes; + } ) + } +}; + +Expr.pseudos[ "nth" ] = Expr.pseudos[ "eq" ]; + +// Add button/input type pseudos +for ( i in { radio: true, checkbox: true, file: true, password: true, image: true } ) { + Expr.pseudos[ i ] = createInputPseudo( i ); +} +for ( i in { submit: true, reset: true } ) { + Expr.pseudos[ i ] = createButtonPseudo( i ); +} + +// Easy API for creating new setFilters +function setFilters() {} +setFilters.prototype = Expr.filters = Expr.pseudos; +Expr.setFilters = new setFilters(); + +tokenize = Sizzle.tokenize = function( selector, parseOnly ) { + var matched, match, tokens, type, + soFar, groups, preFilters, + cached = tokenCache[ selector + " " ]; + + if ( cached ) { + return parseOnly ? 0 : cached.slice( 0 ); + } + + soFar = selector; + groups = []; + preFilters = Expr.preFilter; + + while ( soFar ) { + + // Comma and first run + if ( !matched || ( match = rcomma.exec( soFar ) ) ) { + if ( match ) { + + // Don't consume trailing commas as valid + soFar = soFar.slice( match[ 0 ].length ) || soFar; + } + groups.push( ( tokens = [] ) ); + } + + matched = false; + + // Combinators + if ( ( match = rcombinators.exec( soFar ) ) ) { + matched = match.shift(); + tokens.push( { + value: matched, + + // Cast descendant combinators to space + type: match[ 0 ].replace( rtrim, " " ) + } ); + soFar = soFar.slice( matched.length ); + } + + // Filters + for ( type in Expr.filter ) { + if ( ( match = matchExpr[ type ].exec( soFar ) ) && ( !preFilters[ type ] || + ( match = preFilters[ type ]( match ) ) ) ) { + matched = match.shift(); + tokens.push( { + value: matched, + type: type, + matches: match + } ); + soFar = soFar.slice( matched.length ); + } + } + + if ( !matched ) { + break; + } + } + + // Return the length of the invalid excess + // if we're just parsing + // Otherwise, throw an error or return tokens + return parseOnly ? + soFar.length : + soFar ? + Sizzle.error( selector ) : + + // Cache the tokens + tokenCache( selector, groups ).slice( 0 ); +}; + +function toSelector( tokens ) { + var i = 0, + len = tokens.length, + selector = ""; + for ( ; i < len; i++ ) { + selector += tokens[ i ].value; + } + return selector; +} + +function addCombinator( matcher, combinator, base ) { + var dir = combinator.dir, + skip = combinator.next, + key = skip || dir, + checkNonElements = base && key === "parentNode", + doneName = done++; + + return combinator.first ? + + // Check against closest ancestor/preceding element + function( elem, context, xml ) { + while ( ( elem = elem[ dir ] ) ) { + if ( elem.nodeType === 1 || checkNonElements ) { + return matcher( elem, context, xml ); + } + } + return false; + } : + + // Check against all ancestor/preceding elements + function( elem, context, xml ) { + var oldCache, uniqueCache, outerCache, + newCache = [ dirruns, doneName ]; + + // We can't set arbitrary data on XML nodes, so they don't benefit from combinator caching + if ( xml ) { + while ( ( elem = elem[ dir ] ) ) { + if ( elem.nodeType === 1 || checkNonElements ) { + if ( matcher( elem, context, xml ) ) { + return true; + } + } + } + } else { + while ( ( elem = elem[ dir ] ) ) { + if ( elem.nodeType === 1 || checkNonElements ) { + outerCache = elem[ expando ] || ( elem[ expando ] = {} ); + + // Support: IE <9 only + // Defend against cloned attroperties (jQuery gh-1709) + uniqueCache = outerCache[ elem.uniqueID ] || + ( outerCache[ elem.uniqueID ] = {} ); + + if ( skip && skip === elem.nodeName.toLowerCase() ) { + elem = elem[ dir ] || elem; + } else if ( ( oldCache = uniqueCache[ key ] ) && + oldCache[ 0 ] === dirruns && oldCache[ 1 ] === doneName ) { + + // Assign to newCache so results back-propagate to previous elements + return ( newCache[ 2 ] = oldCache[ 2 ] ); + } else { + + // Reuse newcache so results back-propagate to previous elements + uniqueCache[ key ] = newCache; + + // A match means we're done; a fail means we have to keep checking + if ( ( newCache[ 2 ] = matcher( elem, context, xml ) ) ) { + return true; + } + } + } + } + } + return false; + }; +} + +function elementMatcher( matchers ) { + return matchers.length > 1 ? + function( elem, context, xml ) { + var i = matchers.length; + while ( i-- ) { + if ( !matchers[ i ]( elem, context, xml ) ) { + return false; + } + } + return true; + } : + matchers[ 0 ]; +} + +function multipleContexts( selector, contexts, results ) { + var i = 0, + len = contexts.length; + for ( ; i < len; i++ ) { + Sizzle( selector, contexts[ i ], results ); + } + return results; +} + +function condense( unmatched, map, filter, context, xml ) { + var elem, + newUnmatched = [], + i = 0, + len = unmatched.length, + mapped = map != null; + + for ( ; i < len; i++ ) { + if ( ( elem = unmatched[ i ] ) ) { + if ( !filter || filter( elem, context, xml ) ) { + newUnmatched.push( elem ); + if ( mapped ) { + map.push( i ); + } + } + } + } + + return newUnmatched; +} + +function setMatcher( preFilter, selector, matcher, postFilter, postFinder, postSelector ) { + if ( postFilter && !postFilter[ expando ] ) { + postFilter = setMatcher( postFilter ); + } + if ( postFinder && !postFinder[ expando ] ) { + postFinder = setMatcher( postFinder, postSelector ); + } + return markFunction( function( seed, results, context, xml ) { + var temp, i, elem, + preMap = [], + postMap = [], + preexisting = results.length, + + // Get initial elements from seed or context + elems = seed || multipleContexts( + selector || "*", + context.nodeType ? [ context ] : context, + [] + ), + + // Prefilter to get matcher input, preserving a map for seed-results synchronization + matcherIn = preFilter && ( seed || !selector ) ? + condense( elems, preMap, preFilter, context, xml ) : + elems, + + matcherOut = matcher ? + + // If we have a postFinder, or filtered seed, or non-seed postFilter or preexisting results, + postFinder || ( seed ? preFilter : preexisting || postFilter ) ? + + // ...intermediate processing is necessary + [] : + + // ...otherwise use results directly + results : + matcherIn; + + // Find primary matches + if ( matcher ) { + matcher( matcherIn, matcherOut, context, xml ); + } + + // Apply postFilter + if ( postFilter ) { + temp = condense( matcherOut, postMap ); + postFilter( temp, [], context, xml ); + + // Un-match failing elements by moving them back to matcherIn + i = temp.length; + while ( i-- ) { + if ( ( elem = temp[ i ] ) ) { + matcherOut[ postMap[ i ] ] = !( matcherIn[ postMap[ i ] ] = elem ); + } + } + } + + if ( seed ) { + if ( postFinder || preFilter ) { + if ( postFinder ) { + + // Get the final matcherOut by condensing this intermediate into postFinder contexts + temp = []; + i = matcherOut.length; + while ( i-- ) { + if ( ( elem = matcherOut[ i ] ) ) { + + // Restore matcherIn since elem is not yet a final match + temp.push( ( matcherIn[ i ] = elem ) ); + } + } + postFinder( null, ( matcherOut = [] ), temp, xml ); + } + + // Move matched elements from seed to results to keep them synchronized + i = matcherOut.length; + while ( i-- ) { + if ( ( elem = matcherOut[ i ] ) && + ( temp = postFinder ? indexOf( seed, elem ) : preMap[ i ] ) > -1 ) { + + seed[ temp ] = !( results[ temp ] = elem ); + } + } + } + + // Add elements to results, through postFinder if defined + } else { + matcherOut = condense( + matcherOut === results ? + matcherOut.splice( preexisting, matcherOut.length ) : + matcherOut + ); + if ( postFinder ) { + postFinder( null, results, matcherOut, xml ); + } else { + push.apply( results, matcherOut ); + } + } + } ); +} + +function matcherFromTokens( tokens ) { + var checkContext, matcher, j, + len = tokens.length, + leadingRelative = Expr.relative[ tokens[ 0 ].type ], + implicitRelative = leadingRelative || Expr.relative[ " " ], + i = leadingRelative ? 1 : 0, + + // The foundational matcher ensures that elements are reachable from top-level context(s) + matchContext = addCombinator( function( elem ) { + return elem === checkContext; + }, implicitRelative, true ), + matchAnyContext = addCombinator( function( elem ) { + return indexOf( checkContext, elem ) > -1; + }, implicitRelative, true ), + matchers = [ function( elem, context, xml ) { + var ret = ( !leadingRelative && ( xml || context !== outermostContext ) ) || ( + ( checkContext = context ).nodeType ? + matchContext( elem, context, xml ) : + matchAnyContext( elem, context, xml ) ); + + // Avoid hanging onto element (issue #299) + checkContext = null; + return ret; + } ]; + + for ( ; i < len; i++ ) { + if ( ( matcher = Expr.relative[ tokens[ i ].type ] ) ) { + matchers = [ addCombinator( elementMatcher( matchers ), matcher ) ]; + } else { + matcher = Expr.filter[ tokens[ i ].type ].apply( null, tokens[ i ].matches ); + + // Return special upon seeing a positional matcher + if ( matcher[ expando ] ) { + + // Find the next relative operator (if any) for proper handling + j = ++i; + for ( ; j < len; j++ ) { + if ( Expr.relative[ tokens[ j ].type ] ) { + break; + } + } + return setMatcher( + i > 1 && elementMatcher( matchers ), + i > 1 && toSelector( + + // If the preceding token was a descendant combinator, insert an implicit any-element `*` + tokens + .slice( 0, i - 1 ) + .concat( { value: tokens[ i - 2 ].type === " " ? "*" : "" } ) + ).replace( rtrim, "$1" ), + matcher, + i < j && matcherFromTokens( tokens.slice( i, j ) ), + j < len && matcherFromTokens( ( tokens = tokens.slice( j ) ) ), + j < len && toSelector( tokens ) + ); + } + matchers.push( matcher ); + } + } + + return elementMatcher( matchers ); +} + +function matcherFromGroupMatchers( elementMatchers, setMatchers ) { + var bySet = setMatchers.length > 0, + byElement = elementMatchers.length > 0, + superMatcher = function( seed, context, xml, results, outermost ) { + var elem, j, matcher, + matchedCount = 0, + i = "0", + unmatched = seed && [], + setMatched = [], + contextBackup = outermostContext, + + // We must always have either seed elements or outermost context + elems = seed || byElement && Expr.find[ "TAG" ]( "*", outermost ), + + // Use integer dirruns iff this is the outermost matcher + dirrunsUnique = ( dirruns += contextBackup == null ? 1 : Math.random() || 0.1 ), + len = elems.length; + + if ( outermost ) { + + // Support: IE 11+, Edge 17 - 18+ + // IE/Edge sometimes throw a "Permission denied" error when strict-comparing + // two documents; shallow comparisons work. + // eslint-disable-next-line eqeqeq + outermostContext = context == document || context || outermost; + } + + // Add elements passing elementMatchers directly to results + // Support: IE<9, Safari + // Tolerate NodeList properties (IE: "length"; Safari: ) matching elements by id + for ( ; i !== len && ( elem = elems[ i ] ) != null; i++ ) { + if ( byElement && elem ) { + j = 0; + + // Support: IE 11+, Edge 17 - 18+ + // IE/Edge sometimes throw a "Permission denied" error when strict-comparing + // two documents; shallow comparisons work. + // eslint-disable-next-line eqeqeq + if ( !context && elem.ownerDocument != document ) { + setDocument( elem ); + xml = !documentIsHTML; + } + while ( ( matcher = elementMatchers[ j++ ] ) ) { + if ( matcher( elem, context || document, xml ) ) { + results.push( elem ); + break; + } + } + if ( outermost ) { + dirruns = dirrunsUnique; + } + } + + // Track unmatched elements for set filters + if ( bySet ) { + + // They will have gone through all possible matchers + if ( ( elem = !matcher && elem ) ) { + matchedCount--; + } + + // Lengthen the array for every element, matched or not + if ( seed ) { + unmatched.push( elem ); + } + } + } + + // `i` is now the count of elements visited above, and adding it to `matchedCount` + // makes the latter nonnegative. + matchedCount += i; + + // Apply set filters to unmatched elements + // NOTE: This can be skipped if there are no unmatched elements (i.e., `matchedCount` + // equals `i`), unless we didn't visit _any_ elements in the above loop because we have + // no element matchers and no seed. + // Incrementing an initially-string "0" `i` allows `i` to remain a string only in that + // case, which will result in a "00" `matchedCount` that differs from `i` but is also + // numerically zero. + if ( bySet && i !== matchedCount ) { + j = 0; + while ( ( matcher = setMatchers[ j++ ] ) ) { + matcher( unmatched, setMatched, context, xml ); + } + + if ( seed ) { + + // Reintegrate element matches to eliminate the need for sorting + if ( matchedCount > 0 ) { + while ( i-- ) { + if ( !( unmatched[ i ] || setMatched[ i ] ) ) { + setMatched[ i ] = pop.call( results ); + } + } + } + + // Discard index placeholder values to get only actual matches + setMatched = condense( setMatched ); + } + + // Add matches to results + push.apply( results, setMatched ); + + // Seedless set matches succeeding multiple successful matchers stipulate sorting + if ( outermost && !seed && setMatched.length > 0 && + ( matchedCount + setMatchers.length ) > 1 ) { + + Sizzle.uniqueSort( results ); + } + } + + // Override manipulation of globals by nested matchers + if ( outermost ) { + dirruns = dirrunsUnique; + outermostContext = contextBackup; + } + + return unmatched; + }; + + return bySet ? + markFunction( superMatcher ) : + superMatcher; +} + +compile = Sizzle.compile = function( selector, match /* Internal Use Only */ ) { + var i, + setMatchers = [], + elementMatchers = [], + cached = compilerCache[ selector + " " ]; + + if ( !cached ) { + + // Generate a function of recursive functions that can be used to check each element + if ( !match ) { + match = tokenize( selector ); + } + i = match.length; + while ( i-- ) { + cached = matcherFromTokens( match[ i ] ); + if ( cached[ expando ] ) { + setMatchers.push( cached ); + } else { + elementMatchers.push( cached ); + } + } + + // Cache the compiled function + cached = compilerCache( + selector, + matcherFromGroupMatchers( elementMatchers, setMatchers ) + ); + + // Save selector and tokenization + cached.selector = selector; + } + return cached; +}; + +/** + * A low-level selection function that works with Sizzle's compiled + * selector functions + * @param {String|Function} selector A selector or a pre-compiled + * selector function built with Sizzle.compile + * @param {Element} context + * @param {Array} [results] + * @param {Array} [seed] A set of elements to match against + */ +select = Sizzle.select = function( selector, context, results, seed ) { + var i, tokens, token, type, find, + compiled = typeof selector === "function" && selector, + match = !seed && tokenize( ( selector = compiled.selector || selector ) ); + + results = results || []; + + // Try to minimize operations if there is only one selector in the list and no seed + // (the latter of which guarantees us context) + if ( match.length === 1 ) { + + // Reduce context if the leading compound selector is an ID + tokens = match[ 0 ] = match[ 0 ].slice( 0 ); + if ( tokens.length > 2 && ( token = tokens[ 0 ] ).type === "ID" && + context.nodeType === 9 && documentIsHTML && Expr.relative[ tokens[ 1 ].type ] ) { + + context = ( Expr.find[ "ID" ]( token.matches[ 0 ] + .replace( runescape, funescape ), context ) || [] )[ 0 ]; + if ( !context ) { + return results; + + // Precompiled matchers will still verify ancestry, so step up a level + } else if ( compiled ) { + context = context.parentNode; + } + + selector = selector.slice( tokens.shift().value.length ); + } + + // Fetch a seed set for right-to-left matching + i = matchExpr[ "needsContext" ].test( selector ) ? 0 : tokens.length; + while ( i-- ) { + token = tokens[ i ]; + + // Abort if we hit a combinator + if ( Expr.relative[ ( type = token.type ) ] ) { + break; + } + if ( ( find = Expr.find[ type ] ) ) { + + // Search, expanding context for leading sibling combinators + if ( ( seed = find( + token.matches[ 0 ].replace( runescape, funescape ), + rsibling.test( tokens[ 0 ].type ) && testContext( context.parentNode ) || + context + ) ) ) { + + // If seed is empty or no tokens remain, we can return early + tokens.splice( i, 1 ); + selector = seed.length && toSelector( tokens ); + if ( !selector ) { + push.apply( results, seed ); + return results; + } + + break; + } + } + } + } + + // Compile and execute a filtering function if one is not provided + // Provide `match` to avoid retokenization if we modified the selector above + ( compiled || compile( selector, match ) )( + seed, + context, + !documentIsHTML, + results, + !context || rsibling.test( selector ) && testContext( context.parentNode ) || context + ); + return results; +}; + +// One-time assignments + +// Sort stability +support.sortStable = expando.split( "" ).sort( sortOrder ).join( "" ) === expando; + +// Support: Chrome 14-35+ +// Always assume duplicates if they aren't passed to the comparison function +support.detectDuplicates = !!hasDuplicate; + +// Initialize against the default document +setDocument(); + +// Support: Webkit<537.32 - Safari 6.0.3/Chrome 25 (fixed in Chrome 27) +// Detached nodes confoundingly follow *each other* +support.sortDetached = assert( function( el ) { + + // Should return 1, but returns 4 (following) + return el.compareDocumentPosition( document.createElement( "fieldset" ) ) & 1; +} ); + +// Support: IE<8 +// Prevent attribute/property "interpolation" +// https://msdn.microsoft.com/en-us/library/ms536429%28VS.85%29.aspx +if ( !assert( function( el ) { + el.innerHTML = ""; + return el.firstChild.getAttribute( "href" ) === "#"; +} ) ) { + addHandle( "type|href|height|width", function( elem, name, isXML ) { + if ( !isXML ) { + return elem.getAttribute( name, name.toLowerCase() === "type" ? 1 : 2 ); + } + } ); +} + +// Support: IE<9 +// Use defaultValue in place of getAttribute("value") +if ( !support.attributes || !assert( function( el ) { + el.innerHTML = ""; + el.firstChild.setAttribute( "value", "" ); + return el.firstChild.getAttribute( "value" ) === ""; +} ) ) { + addHandle( "value", function( elem, _name, isXML ) { + if ( !isXML && elem.nodeName.toLowerCase() === "input" ) { + return elem.defaultValue; + } + } ); +} + +// Support: IE<9 +// Use getAttributeNode to fetch booleans when getAttribute lies +if ( !assert( function( el ) { + return el.getAttribute( "disabled" ) == null; +} ) ) { + addHandle( booleans, function( elem, name, isXML ) { + var val; + if ( !isXML ) { + return elem[ name ] === true ? name.toLowerCase() : + ( val = elem.getAttributeNode( name ) ) && val.specified ? + val.value : + null; + } + } ); +} + +return Sizzle; + +} )( window ); + + + +jQuery.find = Sizzle; +jQuery.expr = Sizzle.selectors; + +// Deprecated +jQuery.expr[ ":" ] = jQuery.expr.pseudos; +jQuery.uniqueSort = jQuery.unique = Sizzle.uniqueSort; +jQuery.text = Sizzle.getText; +jQuery.isXMLDoc = Sizzle.isXML; +jQuery.contains = Sizzle.contains; +jQuery.escapeSelector = Sizzle.escape; + + + + +var dir = function( elem, dir, until ) { + var matched = [], + truncate = until !== undefined; + + while ( ( elem = elem[ dir ] ) && elem.nodeType !== 9 ) { + if ( elem.nodeType === 1 ) { + if ( truncate && jQuery( elem ).is( until ) ) { + break; + } + matched.push( elem ); + } + } + return matched; +}; + + +var siblings = function( n, elem ) { + var matched = []; + + for ( ; n; n = n.nextSibling ) { + if ( n.nodeType === 1 && n !== elem ) { + matched.push( n ); + } + } + + return matched; +}; + + +var rneedsContext = jQuery.expr.match.needsContext; + + + +function nodeName( elem, name ) { + + return elem.nodeName && elem.nodeName.toLowerCase() === name.toLowerCase(); + +} +var rsingleTag = ( /^<([a-z][^\/\0>:\x20\t\r\n\f]*)[\x20\t\r\n\f]*\/?>(?:<\/\1>|)$/i ); + + + +// Implement the identical functionality for filter and not +function winnow( elements, qualifier, not ) { + if ( isFunction( qualifier ) ) { + return jQuery.grep( elements, function( elem, i ) { + return !!qualifier.call( elem, i, elem ) !== not; + } ); + } + + // Single element + if ( qualifier.nodeType ) { + return jQuery.grep( elements, function( elem ) { + return ( elem === qualifier ) !== not; + } ); + } + + // Arraylike of elements (jQuery, arguments, Array) + if ( typeof qualifier !== "string" ) { + return jQuery.grep( elements, function( elem ) { + return ( indexOf.call( qualifier, elem ) > -1 ) !== not; + } ); + } + + // Filtered directly for both simple and complex selectors + return jQuery.filter( qualifier, elements, not ); +} + +jQuery.filter = function( expr, elems, not ) { + var elem = elems[ 0 ]; + + if ( not ) { + expr = ":not(" + expr + ")"; + } + + if ( elems.length === 1 && elem.nodeType === 1 ) { + return jQuery.find.matchesSelector( elem, expr ) ? [ elem ] : []; + } + + return jQuery.find.matches( expr, jQuery.grep( elems, function( elem ) { + return elem.nodeType === 1; + } ) ); +}; + +jQuery.fn.extend( { + find: function( selector ) { + var i, ret, + len = this.length, + self = this; + + if ( typeof selector !== "string" ) { + return this.pushStack( jQuery( selector ).filter( function() { + for ( i = 0; i < len; i++ ) { + if ( jQuery.contains( self[ i ], this ) ) { + return true; + } + } + } ) ); + } + + ret = this.pushStack( [] ); + + for ( i = 0; i < len; i++ ) { + jQuery.find( selector, self[ i ], ret ); + } + + return len > 1 ? jQuery.uniqueSort( ret ) : ret; + }, + filter: function( selector ) { + return this.pushStack( winnow( this, selector || [], false ) ); + }, + not: function( selector ) { + return this.pushStack( winnow( this, selector || [], true ) ); + }, + is: function( selector ) { + return !!winnow( + this, + + // If this is a positional/relative selector, check membership in the returned set + // so $("p:first").is("p:last") won't return true for a doc with two "p". + typeof selector === "string" && rneedsContext.test( selector ) ? + jQuery( selector ) : + selector || [], + false + ).length; + } +} ); + + +// Initialize a jQuery object + + +// A central reference to the root jQuery(document) +var rootjQuery, + + // A simple way to check for HTML strings + // Prioritize #id over to avoid XSS via location.hash (#9521) + // Strict HTML recognition (#11290: must start with <) + // Shortcut simple #id case for speed + rquickExpr = /^(?:\s*(<[\w\W]+>)[^>]*|#([\w-]+))$/, + + init = jQuery.fn.init = function( selector, context, root ) { + var match, elem; + + // HANDLE: $(""), $(null), $(undefined), $(false) + if ( !selector ) { + return this; + } + + // Method init() accepts an alternate rootjQuery + // so migrate can support jQuery.sub (gh-2101) + root = root || rootjQuery; + + // Handle HTML strings + if ( typeof selector === "string" ) { + if ( selector[ 0 ] === "<" && + selector[ selector.length - 1 ] === ">" && + selector.length >= 3 ) { + + // Assume that strings that start and end with <> are HTML and skip the regex check + match = [ null, selector, null ]; + + } else { + match = rquickExpr.exec( selector ); + } + + // Match html or make sure no context is specified for #id + if ( match && ( match[ 1 ] || !context ) ) { + + // HANDLE: $(html) -> $(array) + if ( match[ 1 ] ) { + context = context instanceof jQuery ? context[ 0 ] : context; + + // Option to run scripts is true for back-compat + // Intentionally let the error be thrown if parseHTML is not present + jQuery.merge( this, jQuery.parseHTML( + match[ 1 ], + context && context.nodeType ? context.ownerDocument || context : document, + true + ) ); + + // HANDLE: $(html, props) + if ( rsingleTag.test( match[ 1 ] ) && jQuery.isPlainObject( context ) ) { + for ( match in context ) { + + // Properties of context are called as methods if possible + if ( isFunction( this[ match ] ) ) { + this[ match ]( context[ match ] ); + + // ...and otherwise set as attributes + } else { + this.attr( match, context[ match ] ); + } + } + } + + return this; + + // HANDLE: $(#id) + } else { + elem = document.getElementById( match[ 2 ] ); + + if ( elem ) { + + // Inject the element directly into the jQuery object + this[ 0 ] = elem; + this.length = 1; + } + return this; + } + + // HANDLE: $(expr, $(...)) + } else if ( !context || context.jquery ) { + return ( context || root ).find( selector ); + + // HANDLE: $(expr, context) + // (which is just equivalent to: $(context).find(expr) + } else { + return this.constructor( context ).find( selector ); + } + + // HANDLE: $(DOMElement) + } else if ( selector.nodeType ) { + this[ 0 ] = selector; + this.length = 1; + return this; + + // HANDLE: $(function) + // Shortcut for document ready + } else if ( isFunction( selector ) ) { + return root.ready !== undefined ? + root.ready( selector ) : + + // Execute immediately if ready is not present + selector( jQuery ); + } + + return jQuery.makeArray( selector, this ); + }; + +// Give the init function the jQuery prototype for later instantiation +init.prototype = jQuery.fn; + +// Initialize central reference +rootjQuery = jQuery( document ); + + +var rparentsprev = /^(?:parents|prev(?:Until|All))/, + + // Methods guaranteed to produce a unique set when starting from a unique set + guaranteedUnique = { + children: true, + contents: true, + next: true, + prev: true + }; + +jQuery.fn.extend( { + has: function( target ) { + var targets = jQuery( target, this ), + l = targets.length; + + return this.filter( function() { + var i = 0; + for ( ; i < l; i++ ) { + if ( jQuery.contains( this, targets[ i ] ) ) { + return true; + } + } + } ); + }, + + closest: function( selectors, context ) { + var cur, + i = 0, + l = this.length, + matched = [], + targets = typeof selectors !== "string" && jQuery( selectors ); + + // Positional selectors never match, since there's no _selection_ context + if ( !rneedsContext.test( selectors ) ) { + for ( ; i < l; i++ ) { + for ( cur = this[ i ]; cur && cur !== context; cur = cur.parentNode ) { + + // Always skip document fragments + if ( cur.nodeType < 11 && ( targets ? + targets.index( cur ) > -1 : + + // Don't pass non-elements to Sizzle + cur.nodeType === 1 && + jQuery.find.matchesSelector( cur, selectors ) ) ) { + + matched.push( cur ); + break; + } + } + } + } + + return this.pushStack( matched.length > 1 ? jQuery.uniqueSort( matched ) : matched ); + }, + + // Determine the position of an element within the set + index: function( elem ) { + + // No argument, return index in parent + if ( !elem ) { + return ( this[ 0 ] && this[ 0 ].parentNode ) ? this.first().prevAll().length : -1; + } + + // Index in selector + if ( typeof elem === "string" ) { + return indexOf.call( jQuery( elem ), this[ 0 ] ); + } + + // Locate the position of the desired element + return indexOf.call( this, + + // If it receives a jQuery object, the first element is used + elem.jquery ? elem[ 0 ] : elem + ); + }, + + add: function( selector, context ) { + return this.pushStack( + jQuery.uniqueSort( + jQuery.merge( this.get(), jQuery( selector, context ) ) + ) + ); + }, + + addBack: function( selector ) { + return this.add( selector == null ? + this.prevObject : this.prevObject.filter( selector ) + ); + } +} ); + +function sibling( cur, dir ) { + while ( ( cur = cur[ dir ] ) && cur.nodeType !== 1 ) {} + return cur; +} + +jQuery.each( { + parent: function( elem ) { + var parent = elem.parentNode; + return parent && parent.nodeType !== 11 ? parent : null; + }, + parents: function( elem ) { + return dir( elem, "parentNode" ); + }, + parentsUntil: function( elem, _i, until ) { + return dir( elem, "parentNode", until ); + }, + next: function( elem ) { + return sibling( elem, "nextSibling" ); + }, + prev: function( elem ) { + return sibling( elem, "previousSibling" ); + }, + nextAll: function( elem ) { + return dir( elem, "nextSibling" ); + }, + prevAll: function( elem ) { + return dir( elem, "previousSibling" ); + }, + nextUntil: function( elem, _i, until ) { + return dir( elem, "nextSibling", until ); + }, + prevUntil: function( elem, _i, until ) { + return dir( elem, "previousSibling", until ); + }, + siblings: function( elem ) { + return siblings( ( elem.parentNode || {} ).firstChild, elem ); + }, + children: function( elem ) { + return siblings( elem.firstChild ); + }, + contents: function( elem ) { + if ( elem.contentDocument != null && + + // Support: IE 11+ + // elements with no `data` attribute has an object + // `contentDocument` with a `null` prototype. + getProto( elem.contentDocument ) ) { + + return elem.contentDocument; + } + + // Support: IE 9 - 11 only, iOS 7 only, Android Browser <=4.3 only + // Treat the template element as a regular one in browsers that + // don't support it. + if ( nodeName( elem, "template" ) ) { + elem = elem.content || elem; + } + + return jQuery.merge( [], elem.childNodes ); + } +}, function( name, fn ) { + jQuery.fn[ name ] = function( until, selector ) { + var matched = jQuery.map( this, fn, until ); + + if ( name.slice( -5 ) !== "Until" ) { + selector = until; + } + + if ( selector && typeof selector === "string" ) { + matched = jQuery.filter( selector, matched ); + } + + if ( this.length > 1 ) { + + // Remove duplicates + if ( !guaranteedUnique[ name ] ) { + jQuery.uniqueSort( matched ); + } + + // Reverse order for parents* and prev-derivatives + if ( rparentsprev.test( name ) ) { + matched.reverse(); + } + } + + return this.pushStack( matched ); + }; +} ); +var rnothtmlwhite = ( /[^\x20\t\r\n\f]+/g ); + + + +// Convert String-formatted options into Object-formatted ones +function createOptions( options ) { + var object = {}; + jQuery.each( options.match( rnothtmlwhite ) || [], function( _, flag ) { + object[ flag ] = true; + } ); + return object; +} + +/* + * Create a callback list using the following parameters: + * + * options: an optional list of space-separated options that will change how + * the callback list behaves or a more traditional option object + * + * By default a callback list will act like an event callback list and can be + * "fired" multiple times. + * + * Possible options: + * + * once: will ensure the callback list can only be fired once (like a Deferred) + * + * memory: will keep track of previous values and will call any callback added + * after the list has been fired right away with the latest "memorized" + * values (like a Deferred) + * + * unique: will ensure a callback can only be added once (no duplicate in the list) + * + * stopOnFalse: interrupt callings when a callback returns false + * + */ +jQuery.Callbacks = function( options ) { + + // Convert options from String-formatted to Object-formatted if needed + // (we check in cache first) + options = typeof options === "string" ? + createOptions( options ) : + jQuery.extend( {}, options ); + + var // Flag to know if list is currently firing + firing, + + // Last fire value for non-forgettable lists + memory, + + // Flag to know if list was already fired + fired, + + // Flag to prevent firing + locked, + + // Actual callback list + list = [], + + // Queue of execution data for repeatable lists + queue = [], + + // Index of currently firing callback (modified by add/remove as needed) + firingIndex = -1, + + // Fire callbacks + fire = function() { + + // Enforce single-firing + locked = locked || options.once; + + // Execute callbacks for all pending executions, + // respecting firingIndex overrides and runtime changes + fired = firing = true; + for ( ; queue.length; firingIndex = -1 ) { + memory = queue.shift(); + while ( ++firingIndex < list.length ) { + + // Run callback and check for early termination + if ( list[ firingIndex ].apply( memory[ 0 ], memory[ 1 ] ) === false && + options.stopOnFalse ) { + + // Jump to end and forget the data so .add doesn't re-fire + firingIndex = list.length; + memory = false; + } + } + } + + // Forget the data if we're done with it + if ( !options.memory ) { + memory = false; + } + + firing = false; + + // Clean up if we're done firing for good + if ( locked ) { + + // Keep an empty list if we have data for future add calls + if ( memory ) { + list = []; + + // Otherwise, this object is spent + } else { + list = ""; + } + } + }, + + // Actual Callbacks object + self = { + + // Add a callback or a collection of callbacks to the list + add: function() { + if ( list ) { + + // If we have memory from a past run, we should fire after adding + if ( memory && !firing ) { + firingIndex = list.length - 1; + queue.push( memory ); + } + + ( function add( args ) { + jQuery.each( args, function( _, arg ) { + if ( isFunction( arg ) ) { + if ( !options.unique || !self.has( arg ) ) { + list.push( arg ); + } + } else if ( arg && arg.length && toType( arg ) !== "string" ) { + + // Inspect recursively + add( arg ); + } + } ); + } )( arguments ); + + if ( memory && !firing ) { + fire(); + } + } + return this; + }, + + // Remove a callback from the list + remove: function() { + jQuery.each( arguments, function( _, arg ) { + var index; + while ( ( index = jQuery.inArray( arg, list, index ) ) > -1 ) { + list.splice( index, 1 ); + + // Handle firing indexes + if ( index <= firingIndex ) { + firingIndex--; + } + } + } ); + return this; + }, + + // Check if a given callback is in the list. + // If no argument is given, return whether or not list has callbacks attached. + has: function( fn ) { + return fn ? + jQuery.inArray( fn, list ) > -1 : + list.length > 0; + }, + + // Remove all callbacks from the list + empty: function() { + if ( list ) { + list = []; + } + return this; + }, + + // Disable .fire and .add + // Abort any current/pending executions + // Clear all callbacks and values + disable: function() { + locked = queue = []; + list = memory = ""; + return this; + }, + disabled: function() { + return !list; + }, + + // Disable .fire + // Also disable .add unless we have memory (since it would have no effect) + // Abort any pending executions + lock: function() { + locked = queue = []; + if ( !memory && !firing ) { + list = memory = ""; + } + return this; + }, + locked: function() { + return !!locked; + }, + + // Call all callbacks with the given context and arguments + fireWith: function( context, args ) { + if ( !locked ) { + args = args || []; + args = [ context, args.slice ? args.slice() : args ]; + queue.push( args ); + if ( !firing ) { + fire(); + } + } + return this; + }, + + // Call all the callbacks with the given arguments + fire: function() { + self.fireWith( this, arguments ); + return this; + }, + + // To know if the callbacks have already been called at least once + fired: function() { + return !!fired; + } + }; + + return self; +}; + + +function Identity( v ) { + return v; +} +function Thrower( ex ) { + throw ex; +} + +function adoptValue( value, resolve, reject, noValue ) { + var method; + + try { + + // Check for promise aspect first to privilege synchronous behavior + if ( value && isFunction( ( method = value.promise ) ) ) { + method.call( value ).done( resolve ).fail( reject ); + + // Other thenables + } else if ( value && isFunction( ( method = value.then ) ) ) { + method.call( value, resolve, reject ); + + // Other non-thenables + } else { + + // Control `resolve` arguments by letting Array#slice cast boolean `noValue` to integer: + // * false: [ value ].slice( 0 ) => resolve( value ) + // * true: [ value ].slice( 1 ) => resolve() + resolve.apply( undefined, [ value ].slice( noValue ) ); + } + + // For Promises/A+, convert exceptions into rejections + // Since jQuery.when doesn't unwrap thenables, we can skip the extra checks appearing in + // Deferred#then to conditionally suppress rejection. + } catch ( value ) { + + // Support: Android 4.0 only + // Strict mode functions invoked without .call/.apply get global-object context + reject.apply( undefined, [ value ] ); + } +} + +jQuery.extend( { + + Deferred: function( func ) { + var tuples = [ + + // action, add listener, callbacks, + // ... .then handlers, argument index, [final state] + [ "notify", "progress", jQuery.Callbacks( "memory" ), + jQuery.Callbacks( "memory" ), 2 ], + [ "resolve", "done", jQuery.Callbacks( "once memory" ), + jQuery.Callbacks( "once memory" ), 0, "resolved" ], + [ "reject", "fail", jQuery.Callbacks( "once memory" ), + jQuery.Callbacks( "once memory" ), 1, "rejected" ] + ], + state = "pending", + promise = { + state: function() { + return state; + }, + always: function() { + deferred.done( arguments ).fail( arguments ); + return this; + }, + "catch": function( fn ) { + return promise.then( null, fn ); + }, + + // Keep pipe for back-compat + pipe: function( /* fnDone, fnFail, fnProgress */ ) { + var fns = arguments; + + return jQuery.Deferred( function( newDefer ) { + jQuery.each( tuples, function( _i, tuple ) { + + // Map tuples (progress, done, fail) to arguments (done, fail, progress) + var fn = isFunction( fns[ tuple[ 4 ] ] ) && fns[ tuple[ 4 ] ]; + + // deferred.progress(function() { bind to newDefer or newDefer.notify }) + // deferred.done(function() { bind to newDefer or newDefer.resolve }) + // deferred.fail(function() { bind to newDefer or newDefer.reject }) + deferred[ tuple[ 1 ] ]( function() { + var returned = fn && fn.apply( this, arguments ); + if ( returned && isFunction( returned.promise ) ) { + returned.promise() + .progress( newDefer.notify ) + .done( newDefer.resolve ) + .fail( newDefer.reject ); + } else { + newDefer[ tuple[ 0 ] + "With" ]( + this, + fn ? [ returned ] : arguments + ); + } + } ); + } ); + fns = null; + } ).promise(); + }, + then: function( onFulfilled, onRejected, onProgress ) { + var maxDepth = 0; + function resolve( depth, deferred, handler, special ) { + return function() { + var that = this, + args = arguments, + mightThrow = function() { + var returned, then; + + // Support: Promises/A+ section 2.3.3.3.3 + // https://promisesaplus.com/#point-59 + // Ignore double-resolution attempts + if ( depth < maxDepth ) { + return; + } + + returned = handler.apply( that, args ); + + // Support: Promises/A+ section 2.3.1 + // https://promisesaplus.com/#point-48 + if ( returned === deferred.promise() ) { + throw new TypeError( "Thenable self-resolution" ); + } + + // Support: Promises/A+ sections 2.3.3.1, 3.5 + // https://promisesaplus.com/#point-54 + // https://promisesaplus.com/#point-75 + // Retrieve `then` only once + then = returned && + + // Support: Promises/A+ section 2.3.4 + // https://promisesaplus.com/#point-64 + // Only check objects and functions for thenability + ( typeof returned === "object" || + typeof returned === "function" ) && + returned.then; + + // Handle a returned thenable + if ( isFunction( then ) ) { + + // Special processors (notify) just wait for resolution + if ( special ) { + then.call( + returned, + resolve( maxDepth, deferred, Identity, special ), + resolve( maxDepth, deferred, Thrower, special ) + ); + + // Normal processors (resolve) also hook into progress + } else { + + // ...and disregard older resolution values + maxDepth++; + + then.call( + returned, + resolve( maxDepth, deferred, Identity, special ), + resolve( maxDepth, deferred, Thrower, special ), + resolve( maxDepth, deferred, Identity, + deferred.notifyWith ) + ); + } + + // Handle all other returned values + } else { + + // Only substitute handlers pass on context + // and multiple values (non-spec behavior) + if ( handler !== Identity ) { + that = undefined; + args = [ returned ]; + } + + // Process the value(s) + // Default process is resolve + ( special || deferred.resolveWith )( that, args ); + } + }, + + // Only normal processors (resolve) catch and reject exceptions + process = special ? + mightThrow : + function() { + try { + mightThrow(); + } catch ( e ) { + + if ( jQuery.Deferred.exceptionHook ) { + jQuery.Deferred.exceptionHook( e, + process.stackTrace ); + } + + // Support: Promises/A+ section 2.3.3.3.4.1 + // https://promisesaplus.com/#point-61 + // Ignore post-resolution exceptions + if ( depth + 1 >= maxDepth ) { + + // Only substitute handlers pass on context + // and multiple values (non-spec behavior) + if ( handler !== Thrower ) { + that = undefined; + args = [ e ]; + } + + deferred.rejectWith( that, args ); + } + } + }; + + // Support: Promises/A+ section 2.3.3.3.1 + // https://promisesaplus.com/#point-57 + // Re-resolve promises immediately to dodge false rejection from + // subsequent errors + if ( depth ) { + process(); + } else { + + // Call an optional hook to record the stack, in case of exception + // since it's otherwise lost when execution goes async + if ( jQuery.Deferred.getStackHook ) { + process.stackTrace = jQuery.Deferred.getStackHook(); + } + window.setTimeout( process ); + } + }; + } + + return jQuery.Deferred( function( newDefer ) { + + // progress_handlers.add( ... ) + tuples[ 0 ][ 3 ].add( + resolve( + 0, + newDefer, + isFunction( onProgress ) ? + onProgress : + Identity, + newDefer.notifyWith + ) + ); + + // fulfilled_handlers.add( ... ) + tuples[ 1 ][ 3 ].add( + resolve( + 0, + newDefer, + isFunction( onFulfilled ) ? + onFulfilled : + Identity + ) + ); + + // rejected_handlers.add( ... ) + tuples[ 2 ][ 3 ].add( + resolve( + 0, + newDefer, + isFunction( onRejected ) ? + onRejected : + Thrower + ) + ); + } ).promise(); + }, + + // Get a promise for this deferred + // If obj is provided, the promise aspect is added to the object + promise: function( obj ) { + return obj != null ? jQuery.extend( obj, promise ) : promise; + } + }, + deferred = {}; + + // Add list-specific methods + jQuery.each( tuples, function( i, tuple ) { + var list = tuple[ 2 ], + stateString = tuple[ 5 ]; + + // promise.progress = list.add + // promise.done = list.add + // promise.fail = list.add + promise[ tuple[ 1 ] ] = list.add; + + // Handle state + if ( stateString ) { + list.add( + function() { + + // state = "resolved" (i.e., fulfilled) + // state = "rejected" + state = stateString; + }, + + // rejected_callbacks.disable + // fulfilled_callbacks.disable + tuples[ 3 - i ][ 2 ].disable, + + // rejected_handlers.disable + // fulfilled_handlers.disable + tuples[ 3 - i ][ 3 ].disable, + + // progress_callbacks.lock + tuples[ 0 ][ 2 ].lock, + + // progress_handlers.lock + tuples[ 0 ][ 3 ].lock + ); + } + + // progress_handlers.fire + // fulfilled_handlers.fire + // rejected_handlers.fire + list.add( tuple[ 3 ].fire ); + + // deferred.notify = function() { deferred.notifyWith(...) } + // deferred.resolve = function() { deferred.resolveWith(...) } + // deferred.reject = function() { deferred.rejectWith(...) } + deferred[ tuple[ 0 ] ] = function() { + deferred[ tuple[ 0 ] + "With" ]( this === deferred ? undefined : this, arguments ); + return this; + }; + + // deferred.notifyWith = list.fireWith + // deferred.resolveWith = list.fireWith + // deferred.rejectWith = list.fireWith + deferred[ tuple[ 0 ] + "With" ] = list.fireWith; + } ); + + // Make the deferred a promise + promise.promise( deferred ); + + // Call given func if any + if ( func ) { + func.call( deferred, deferred ); + } + + // All done! + return deferred; + }, + + // Deferred helper + when: function( singleValue ) { + var + + // count of uncompleted subordinates + remaining = arguments.length, + + // count of unprocessed arguments + i = remaining, + + // subordinate fulfillment data + resolveContexts = Array( i ), + resolveValues = slice.call( arguments ), + + // the primary Deferred + primary = jQuery.Deferred(), + + // subordinate callback factory + updateFunc = function( i ) { + return function( value ) { + resolveContexts[ i ] = this; + resolveValues[ i ] = arguments.length > 1 ? slice.call( arguments ) : value; + if ( !( --remaining ) ) { + primary.resolveWith( resolveContexts, resolveValues ); + } + }; + }; + + // Single- and empty arguments are adopted like Promise.resolve + if ( remaining <= 1 ) { + adoptValue( singleValue, primary.done( updateFunc( i ) ).resolve, primary.reject, + !remaining ); + + // Use .then() to unwrap secondary thenables (cf. gh-3000) + if ( primary.state() === "pending" || + isFunction( resolveValues[ i ] && resolveValues[ i ].then ) ) { + + return primary.then(); + } + } + + // Multiple arguments are aggregated like Promise.all array elements + while ( i-- ) { + adoptValue( resolveValues[ i ], updateFunc( i ), primary.reject ); + } + + return primary.promise(); + } +} ); + + +// These usually indicate a programmer mistake during development, +// warn about them ASAP rather than swallowing them by default. +var rerrorNames = /^(Eval|Internal|Range|Reference|Syntax|Type|URI)Error$/; + +jQuery.Deferred.exceptionHook = function( error, stack ) { + + // Support: IE 8 - 9 only + // Console exists when dev tools are open, which can happen at any time + if ( window.console && window.console.warn && error && rerrorNames.test( error.name ) ) { + window.console.warn( "jQuery.Deferred exception: " + error.message, error.stack, stack ); + } +}; + + + + +jQuery.readyException = function( error ) { + window.setTimeout( function() { + throw error; + } ); +}; + + + + +// The deferred used on DOM ready +var readyList = jQuery.Deferred(); + +jQuery.fn.ready = function( fn ) { + + readyList + .then( fn ) + + // Wrap jQuery.readyException in a function so that the lookup + // happens at the time of error handling instead of callback + // registration. + .catch( function( error ) { + jQuery.readyException( error ); + } ); + + return this; +}; + +jQuery.extend( { + + // Is the DOM ready to be used? Set to true once it occurs. + isReady: false, + + // A counter to track how many items to wait for before + // the ready event fires. See #6781 + readyWait: 1, + + // Handle when the DOM is ready + ready: function( wait ) { + + // Abort if there are pending holds or we're already ready + if ( wait === true ? --jQuery.readyWait : jQuery.isReady ) { + return; + } + + // Remember that the DOM is ready + jQuery.isReady = true; + + // If a normal DOM Ready event fired, decrement, and wait if need be + if ( wait !== true && --jQuery.readyWait > 0 ) { + return; + } + + // If there are functions bound, to execute + readyList.resolveWith( document, [ jQuery ] ); + } +} ); + +jQuery.ready.then = readyList.then; + +// The ready event handler and self cleanup method +function completed() { + document.removeEventListener( "DOMContentLoaded", completed ); + window.removeEventListener( "load", completed ); + jQuery.ready(); +} + +// Catch cases where $(document).ready() is called +// after the browser event has already occurred. +// Support: IE <=9 - 10 only +// Older IE sometimes signals "interactive" too soon +if ( document.readyState === "complete" || + ( document.readyState !== "loading" && !document.documentElement.doScroll ) ) { + + // Handle it asynchronously to allow scripts the opportunity to delay ready + window.setTimeout( jQuery.ready ); + +} else { + + // Use the handy event callback + document.addEventListener( "DOMContentLoaded", completed ); + + // A fallback to window.onload, that will always work + window.addEventListener( "load", completed ); +} + + + + +// Multifunctional method to get and set values of a collection +// The value/s can optionally be executed if it's a function +var access = function( elems, fn, key, value, chainable, emptyGet, raw ) { + var i = 0, + len = elems.length, + bulk = key == null; + + // Sets many values + if ( toType( key ) === "object" ) { + chainable = true; + for ( i in key ) { + access( elems, fn, i, key[ i ], true, emptyGet, raw ); + } + + // Sets one value + } else if ( value !== undefined ) { + chainable = true; + + if ( !isFunction( value ) ) { + raw = true; + } + + if ( bulk ) { + + // Bulk operations run against the entire set + if ( raw ) { + fn.call( elems, value ); + fn = null; + + // ...except when executing function values + } else { + bulk = fn; + fn = function( elem, _key, value ) { + return bulk.call( jQuery( elem ), value ); + }; + } + } + + if ( fn ) { + for ( ; i < len; i++ ) { + fn( + elems[ i ], key, raw ? + value : + value.call( elems[ i ], i, fn( elems[ i ], key ) ) + ); + } + } + } + + if ( chainable ) { + return elems; + } + + // Gets + if ( bulk ) { + return fn.call( elems ); + } + + return len ? fn( elems[ 0 ], key ) : emptyGet; +}; + + +// Matches dashed string for camelizing +var rmsPrefix = /^-ms-/, + rdashAlpha = /-([a-z])/g; + +// Used by camelCase as callback to replace() +function fcamelCase( _all, letter ) { + return letter.toUpperCase(); +} + +// Convert dashed to camelCase; used by the css and data modules +// Support: IE <=9 - 11, Edge 12 - 15 +// Microsoft forgot to hump their vendor prefix (#9572) +function camelCase( string ) { + return string.replace( rmsPrefix, "ms-" ).replace( rdashAlpha, fcamelCase ); +} +var acceptData = function( owner ) { + + // Accepts only: + // - Node + // - Node.ELEMENT_NODE + // - Node.DOCUMENT_NODE + // - Object + // - Any + return owner.nodeType === 1 || owner.nodeType === 9 || !( +owner.nodeType ); +}; + + + + +function Data() { + this.expando = jQuery.expando + Data.uid++; +} + +Data.uid = 1; + +Data.prototype = { + + cache: function( owner ) { + + // Check if the owner object already has a cache + var value = owner[ this.expando ]; + + // If not, create one + if ( !value ) { + value = {}; + + // We can accept data for non-element nodes in modern browsers, + // but we should not, see #8335. + // Always return an empty object. + if ( acceptData( owner ) ) { + + // If it is a node unlikely to be stringify-ed or looped over + // use plain assignment + if ( owner.nodeType ) { + owner[ this.expando ] = value; + + // Otherwise secure it in a non-enumerable property + // configurable must be true to allow the property to be + // deleted when data is removed + } else { + Object.defineProperty( owner, this.expando, { + value: value, + configurable: true + } ); + } + } + } + + return value; + }, + set: function( owner, data, value ) { + var prop, + cache = this.cache( owner ); + + // Handle: [ owner, key, value ] args + // Always use camelCase key (gh-2257) + if ( typeof data === "string" ) { + cache[ camelCase( data ) ] = value; + + // Handle: [ owner, { properties } ] args + } else { + + // Copy the properties one-by-one to the cache object + for ( prop in data ) { + cache[ camelCase( prop ) ] = data[ prop ]; + } + } + return cache; + }, + get: function( owner, key ) { + return key === undefined ? + this.cache( owner ) : + + // Always use camelCase key (gh-2257) + owner[ this.expando ] && owner[ this.expando ][ camelCase( key ) ]; + }, + access: function( owner, key, value ) { + + // In cases where either: + // + // 1. No key was specified + // 2. A string key was specified, but no value provided + // + // Take the "read" path and allow the get method to determine + // which value to return, respectively either: + // + // 1. The entire cache object + // 2. The data stored at the key + // + if ( key === undefined || + ( ( key && typeof key === "string" ) && value === undefined ) ) { + + return this.get( owner, key ); + } + + // When the key is not a string, or both a key and value + // are specified, set or extend (existing objects) with either: + // + // 1. An object of properties + // 2. A key and value + // + this.set( owner, key, value ); + + // Since the "set" path can have two possible entry points + // return the expected data based on which path was taken[*] + return value !== undefined ? value : key; + }, + remove: function( owner, key ) { + var i, + cache = owner[ this.expando ]; + + if ( cache === undefined ) { + return; + } + + if ( key !== undefined ) { + + // Support array or space separated string of keys + if ( Array.isArray( key ) ) { + + // If key is an array of keys... + // We always set camelCase keys, so remove that. + key = key.map( camelCase ); + } else { + key = camelCase( key ); + + // If a key with the spaces exists, use it. + // Otherwise, create an array by matching non-whitespace + key = key in cache ? + [ key ] : + ( key.match( rnothtmlwhite ) || [] ); + } + + i = key.length; + + while ( i-- ) { + delete cache[ key[ i ] ]; + } + } + + // Remove the expando if there's no more data + if ( key === undefined || jQuery.isEmptyObject( cache ) ) { + + // Support: Chrome <=35 - 45 + // Webkit & Blink performance suffers when deleting properties + // from DOM nodes, so set to undefined instead + // https://bugs.chromium.org/p/chromium/issues/detail?id=378607 (bug restricted) + if ( owner.nodeType ) { + owner[ this.expando ] = undefined; + } else { + delete owner[ this.expando ]; + } + } + }, + hasData: function( owner ) { + var cache = owner[ this.expando ]; + return cache !== undefined && !jQuery.isEmptyObject( cache ); + } +}; +var dataPriv = new Data(); + +var dataUser = new Data(); + + + +// Implementation Summary +// +// 1. Enforce API surface and semantic compatibility with 1.9.x branch +// 2. Improve the module's maintainability by reducing the storage +// paths to a single mechanism. +// 3. Use the same single mechanism to support "private" and "user" data. +// 4. _Never_ expose "private" data to user code (TODO: Drop _data, _removeData) +// 5. Avoid exposing implementation details on user objects (eg. expando properties) +// 6. Provide a clear path for implementation upgrade to WeakMap in 2014 + +var rbrace = /^(?:\{[\w\W]*\}|\[[\w\W]*\])$/, + rmultiDash = /[A-Z]/g; + +function getData( data ) { + if ( data === "true" ) { + return true; + } + + if ( data === "false" ) { + return false; + } + + if ( data === "null" ) { + return null; + } + + // Only convert to a number if it doesn't change the string + if ( data === +data + "" ) { + return +data; + } + + if ( rbrace.test( data ) ) { + return JSON.parse( data ); + } + + return data; +} + +function dataAttr( elem, key, data ) { + var name; + + // If nothing was found internally, try to fetch any + // data from the HTML5 data-* attribute + if ( data === undefined && elem.nodeType === 1 ) { + name = "data-" + key.replace( rmultiDash, "-$&" ).toLowerCase(); + data = elem.getAttribute( name ); + + if ( typeof data === "string" ) { + try { + data = getData( data ); + } catch ( e ) {} + + // Make sure we set the data so it isn't changed later + dataUser.set( elem, key, data ); + } else { + data = undefined; + } + } + return data; +} + +jQuery.extend( { + hasData: function( elem ) { + return dataUser.hasData( elem ) || dataPriv.hasData( elem ); + }, + + data: function( elem, name, data ) { + return dataUser.access( elem, name, data ); + }, + + removeData: function( elem, name ) { + dataUser.remove( elem, name ); + }, + + // TODO: Now that all calls to _data and _removeData have been replaced + // with direct calls to dataPriv methods, these can be deprecated. + _data: function( elem, name, data ) { + return dataPriv.access( elem, name, data ); + }, + + _removeData: function( elem, name ) { + dataPriv.remove( elem, name ); + } +} ); + +jQuery.fn.extend( { + data: function( key, value ) { + var i, name, data, + elem = this[ 0 ], + attrs = elem && elem.attributes; + + // Gets all values + if ( key === undefined ) { + if ( this.length ) { + data = dataUser.get( elem ); + + if ( elem.nodeType === 1 && !dataPriv.get( elem, "hasDataAttrs" ) ) { + i = attrs.length; + while ( i-- ) { + + // Support: IE 11 only + // The attrs elements can be null (#14894) + if ( attrs[ i ] ) { + name = attrs[ i ].name; + if ( name.indexOf( "data-" ) === 0 ) { + name = camelCase( name.slice( 5 ) ); + dataAttr( elem, name, data[ name ] ); + } + } + } + dataPriv.set( elem, "hasDataAttrs", true ); + } + } + + return data; + } + + // Sets multiple values + if ( typeof key === "object" ) { + return this.each( function() { + dataUser.set( this, key ); + } ); + } + + return access( this, function( value ) { + var data; + + // The calling jQuery object (element matches) is not empty + // (and therefore has an element appears at this[ 0 ]) and the + // `value` parameter was not undefined. An empty jQuery object + // will result in `undefined` for elem = this[ 0 ] which will + // throw an exception if an attempt to read a data cache is made. + if ( elem && value === undefined ) { + + // Attempt to get data from the cache + // The key will always be camelCased in Data + data = dataUser.get( elem, key ); + if ( data !== undefined ) { + return data; + } + + // Attempt to "discover" the data in + // HTML5 custom data-* attrs + data = dataAttr( elem, key ); + if ( data !== undefined ) { + return data; + } + + // We tried really hard, but the data doesn't exist. + return; + } + + // Set the data... + this.each( function() { + + // We always store the camelCased key + dataUser.set( this, key, value ); + } ); + }, null, value, arguments.length > 1, null, true ); + }, + + removeData: function( key ) { + return this.each( function() { + dataUser.remove( this, key ); + } ); + } +} ); + + +jQuery.extend( { + queue: function( elem, type, data ) { + var queue; + + if ( elem ) { + type = ( type || "fx" ) + "queue"; + queue = dataPriv.get( elem, type ); + + // Speed up dequeue by getting out quickly if this is just a lookup + if ( data ) { + if ( !queue || Array.isArray( data ) ) { + queue = dataPriv.access( elem, type, jQuery.makeArray( data ) ); + } else { + queue.push( data ); + } + } + return queue || []; + } + }, + + dequeue: function( elem, type ) { + type = type || "fx"; + + var queue = jQuery.queue( elem, type ), + startLength = queue.length, + fn = queue.shift(), + hooks = jQuery._queueHooks( elem, type ), + next = function() { + jQuery.dequeue( elem, type ); + }; + + // If the fx queue is dequeued, always remove the progress sentinel + if ( fn === "inprogress" ) { + fn = queue.shift(); + startLength--; + } + + if ( fn ) { + + // Add a progress sentinel to prevent the fx queue from being + // automatically dequeued + if ( type === "fx" ) { + queue.unshift( "inprogress" ); + } + + // Clear up the last queue stop function + delete hooks.stop; + fn.call( elem, next, hooks ); + } + + if ( !startLength && hooks ) { + hooks.empty.fire(); + } + }, + + // Not public - generate a queueHooks object, or return the current one + _queueHooks: function( elem, type ) { + var key = type + "queueHooks"; + return dataPriv.get( elem, key ) || dataPriv.access( elem, key, { + empty: jQuery.Callbacks( "once memory" ).add( function() { + dataPriv.remove( elem, [ type + "queue", key ] ); + } ) + } ); + } +} ); + +jQuery.fn.extend( { + queue: function( type, data ) { + var setter = 2; + + if ( typeof type !== "string" ) { + data = type; + type = "fx"; + setter--; + } + + if ( arguments.length < setter ) { + return jQuery.queue( this[ 0 ], type ); + } + + return data === undefined ? + this : + this.each( function() { + var queue = jQuery.queue( this, type, data ); + + // Ensure a hooks for this queue + jQuery._queueHooks( this, type ); + + if ( type === "fx" && queue[ 0 ] !== "inprogress" ) { + jQuery.dequeue( this, type ); + } + } ); + }, + dequeue: function( type ) { + return this.each( function() { + jQuery.dequeue( this, type ); + } ); + }, + clearQueue: function( type ) { + return this.queue( type || "fx", [] ); + }, + + // Get a promise resolved when queues of a certain type + // are emptied (fx is the type by default) + promise: function( type, obj ) { + var tmp, + count = 1, + defer = jQuery.Deferred(), + elements = this, + i = this.length, + resolve = function() { + if ( !( --count ) ) { + defer.resolveWith( elements, [ elements ] ); + } + }; + + if ( typeof type !== "string" ) { + obj = type; + type = undefined; + } + type = type || "fx"; + + while ( i-- ) { + tmp = dataPriv.get( elements[ i ], type + "queueHooks" ); + if ( tmp && tmp.empty ) { + count++; + tmp.empty.add( resolve ); + } + } + resolve(); + return defer.promise( obj ); + } +} ); +var pnum = ( /[+-]?(?:\d*\.|)\d+(?:[eE][+-]?\d+|)/ ).source; + +var rcssNum = new RegExp( "^(?:([+-])=|)(" + pnum + ")([a-z%]*)$", "i" ); + + +var cssExpand = [ "Top", "Right", "Bottom", "Left" ]; + +var documentElement = document.documentElement; + + + + var isAttached = function( elem ) { + return jQuery.contains( elem.ownerDocument, elem ); + }, + composed = { composed: true }; + + // Support: IE 9 - 11+, Edge 12 - 18+, iOS 10.0 - 10.2 only + // Check attachment across shadow DOM boundaries when possible (gh-3504) + // Support: iOS 10.0-10.2 only + // Early iOS 10 versions support `attachShadow` but not `getRootNode`, + // leading to errors. We need to check for `getRootNode`. + if ( documentElement.getRootNode ) { + isAttached = function( elem ) { + return jQuery.contains( elem.ownerDocument, elem ) || + elem.getRootNode( composed ) === elem.ownerDocument; + }; + } +var isHiddenWithinTree = function( elem, el ) { + + // isHiddenWithinTree might be called from jQuery#filter function; + // in that case, element will be second argument + elem = el || elem; + + // Inline style trumps all + return elem.style.display === "none" || + elem.style.display === "" && + + // Otherwise, check computed style + // Support: Firefox <=43 - 45 + // Disconnected elements can have computed display: none, so first confirm that elem is + // in the document. + isAttached( elem ) && + + jQuery.css( elem, "display" ) === "none"; + }; + + + +function adjustCSS( elem, prop, valueParts, tween ) { + var adjusted, scale, + maxIterations = 20, + currentValue = tween ? + function() { + return tween.cur(); + } : + function() { + return jQuery.css( elem, prop, "" ); + }, + initial = currentValue(), + unit = valueParts && valueParts[ 3 ] || ( jQuery.cssNumber[ prop ] ? "" : "px" ), + + // Starting value computation is required for potential unit mismatches + initialInUnit = elem.nodeType && + ( jQuery.cssNumber[ prop ] || unit !== "px" && +initial ) && + rcssNum.exec( jQuery.css( elem, prop ) ); + + if ( initialInUnit && initialInUnit[ 3 ] !== unit ) { + + // Support: Firefox <=54 + // Halve the iteration target value to prevent interference from CSS upper bounds (gh-2144) + initial = initial / 2; + + // Trust units reported by jQuery.css + unit = unit || initialInUnit[ 3 ]; + + // Iteratively approximate from a nonzero starting point + initialInUnit = +initial || 1; + + while ( maxIterations-- ) { + + // Evaluate and update our best guess (doubling guesses that zero out). + // Finish if the scale equals or crosses 1 (making the old*new product non-positive). + jQuery.style( elem, prop, initialInUnit + unit ); + if ( ( 1 - scale ) * ( 1 - ( scale = currentValue() / initial || 0.5 ) ) <= 0 ) { + maxIterations = 0; + } + initialInUnit = initialInUnit / scale; + + } + + initialInUnit = initialInUnit * 2; + jQuery.style( elem, prop, initialInUnit + unit ); + + // Make sure we update the tween properties later on + valueParts = valueParts || []; + } + + if ( valueParts ) { + initialInUnit = +initialInUnit || +initial || 0; + + // Apply relative offset (+=/-=) if specified + adjusted = valueParts[ 1 ] ? + initialInUnit + ( valueParts[ 1 ] + 1 ) * valueParts[ 2 ] : + +valueParts[ 2 ]; + if ( tween ) { + tween.unit = unit; + tween.start = initialInUnit; + tween.end = adjusted; + } + } + return adjusted; +} + + +var defaultDisplayMap = {}; + +function getDefaultDisplay( elem ) { + var temp, + doc = elem.ownerDocument, + nodeName = elem.nodeName, + display = defaultDisplayMap[ nodeName ]; + + if ( display ) { + return display; + } + + temp = doc.body.appendChild( doc.createElement( nodeName ) ); + display = jQuery.css( temp, "display" ); + + temp.parentNode.removeChild( temp ); + + if ( display === "none" ) { + display = "block"; + } + defaultDisplayMap[ nodeName ] = display; + + return display; +} + +function showHide( elements, show ) { + var display, elem, + values = [], + index = 0, + length = elements.length; + + // Determine new display value for elements that need to change + for ( ; index < length; index++ ) { + elem = elements[ index ]; + if ( !elem.style ) { + continue; + } + + display = elem.style.display; + if ( show ) { + + // Since we force visibility upon cascade-hidden elements, an immediate (and slow) + // check is required in this first loop unless we have a nonempty display value (either + // inline or about-to-be-restored) + if ( display === "none" ) { + values[ index ] = dataPriv.get( elem, "display" ) || null; + if ( !values[ index ] ) { + elem.style.display = ""; + } + } + if ( elem.style.display === "" && isHiddenWithinTree( elem ) ) { + values[ index ] = getDefaultDisplay( elem ); + } + } else { + if ( display !== "none" ) { + values[ index ] = "none"; + + // Remember what we're overwriting + dataPriv.set( elem, "display", display ); + } + } + } + + // Set the display of the elements in a second loop to avoid constant reflow + for ( index = 0; index < length; index++ ) { + if ( values[ index ] != null ) { + elements[ index ].style.display = values[ index ]; + } + } + + return elements; +} + +jQuery.fn.extend( { + show: function() { + return showHide( this, true ); + }, + hide: function() { + return showHide( this ); + }, + toggle: function( state ) { + if ( typeof state === "boolean" ) { + return state ? this.show() : this.hide(); + } + + return this.each( function() { + if ( isHiddenWithinTree( this ) ) { + jQuery( this ).show(); + } else { + jQuery( this ).hide(); + } + } ); + } +} ); +var rcheckableType = ( /^(?:checkbox|radio)$/i ); + +var rtagName = ( /<([a-z][^\/\0>\x20\t\r\n\f]*)/i ); + +var rscriptType = ( /^$|^module$|\/(?:java|ecma)script/i ); + + + +( function() { + var fragment = document.createDocumentFragment(), + div = fragment.appendChild( document.createElement( "div" ) ), + input = document.createElement( "input" ); + + // Support: Android 4.0 - 4.3 only + // Check state lost if the name is set (#11217) + // Support: Windows Web Apps (WWA) + // `name` and `type` must use .setAttribute for WWA (#14901) + input.setAttribute( "type", "radio" ); + input.setAttribute( "checked", "checked" ); + input.setAttribute( "name", "t" ); + + div.appendChild( input ); + + // Support: Android <=4.1 only + // Older WebKit doesn't clone checked state correctly in fragments + support.checkClone = div.cloneNode( true ).cloneNode( true ).lastChild.checked; + + // Support: IE <=11 only + // Make sure textarea (and checkbox) defaultValue is properly cloned + div.innerHTML = ""; + support.noCloneChecked = !!div.cloneNode( true ).lastChild.defaultValue; + + // Support: IE <=9 only + // IE <=9 replaces "; + support.option = !!div.lastChild; +} )(); + + +// We have to close these tags to support XHTML (#13200) +var wrapMap = { + + // XHTML parsers do not magically insert elements in the + // same way that tag soup parsers do. So we cannot shorten + // this by omitting or other required elements. + thead: [ 1, "", "
    " ], + col: [ 2, "", "
    " ], + tr: [ 2, "", "
    " ], + td: [ 3, "", "
    " ], + + _default: [ 0, "", "" ] +}; + +wrapMap.tbody = wrapMap.tfoot = wrapMap.colgroup = wrapMap.caption = wrapMap.thead; +wrapMap.th = wrapMap.td; + +// Support: IE <=9 only +if ( !support.option ) { + wrapMap.optgroup = wrapMap.option = [ 1, "" ]; +} + + +function getAll( context, tag ) { + + // Support: IE <=9 - 11 only + // Use typeof to avoid zero-argument method invocation on host objects (#15151) + var ret; + + if ( typeof context.getElementsByTagName !== "undefined" ) { + ret = context.getElementsByTagName( tag || "*" ); + + } else if ( typeof context.querySelectorAll !== "undefined" ) { + ret = context.querySelectorAll( tag || "*" ); + + } else { + ret = []; + } + + if ( tag === undefined || tag && nodeName( context, tag ) ) { + return jQuery.merge( [ context ], ret ); + } + + return ret; +} + + +// Mark scripts as having already been evaluated +function setGlobalEval( elems, refElements ) { + var i = 0, + l = elems.length; + + for ( ; i < l; i++ ) { + dataPriv.set( + elems[ i ], + "globalEval", + !refElements || dataPriv.get( refElements[ i ], "globalEval" ) + ); + } +} + + +var rhtml = /<|&#?\w+;/; + +function buildFragment( elems, context, scripts, selection, ignored ) { + var elem, tmp, tag, wrap, attached, j, + fragment = context.createDocumentFragment(), + nodes = [], + i = 0, + l = elems.length; + + for ( ; i < l; i++ ) { + elem = elems[ i ]; + + if ( elem || elem === 0 ) { + + // Add nodes directly + if ( toType( elem ) === "object" ) { + + // Support: Android <=4.0 only, PhantomJS 1 only + // push.apply(_, arraylike) throws on ancient WebKit + jQuery.merge( nodes, elem.nodeType ? [ elem ] : elem ); + + // Convert non-html into a text node + } else if ( !rhtml.test( elem ) ) { + nodes.push( context.createTextNode( elem ) ); + + // Convert html into DOM nodes + } else { + tmp = tmp || fragment.appendChild( context.createElement( "div" ) ); + + // Deserialize a standard representation + tag = ( rtagName.exec( elem ) || [ "", "" ] )[ 1 ].toLowerCase(); + wrap = wrapMap[ tag ] || wrapMap._default; + tmp.innerHTML = wrap[ 1 ] + jQuery.htmlPrefilter( elem ) + wrap[ 2 ]; + + // Descend through wrappers to the right content + j = wrap[ 0 ]; + while ( j-- ) { + tmp = tmp.lastChild; + } + + // Support: Android <=4.0 only, PhantomJS 1 only + // push.apply(_, arraylike) throws on ancient WebKit + jQuery.merge( nodes, tmp.childNodes ); + + // Remember the top-level container + tmp = fragment.firstChild; + + // Ensure the created nodes are orphaned (#12392) + tmp.textContent = ""; + } + } + } + + // Remove wrapper from fragment + fragment.textContent = ""; + + i = 0; + while ( ( elem = nodes[ i++ ] ) ) { + + // Skip elements already in the context collection (trac-4087) + if ( selection && jQuery.inArray( elem, selection ) > -1 ) { + if ( ignored ) { + ignored.push( elem ); + } + continue; + } + + attached = isAttached( elem ); + + // Append to fragment + tmp = getAll( fragment.appendChild( elem ), "script" ); + + // Preserve script evaluation history + if ( attached ) { + setGlobalEval( tmp ); + } + + // Capture executables + if ( scripts ) { + j = 0; + while ( ( elem = tmp[ j++ ] ) ) { + if ( rscriptType.test( elem.type || "" ) ) { + scripts.push( elem ); + } + } + } + } + + return fragment; +} + + +var rtypenamespace = /^([^.]*)(?:\.(.+)|)/; + +function returnTrue() { + return true; +} + +function returnFalse() { + return false; +} + +// Support: IE <=9 - 11+ +// focus() and blur() are asynchronous, except when they are no-op. +// So expect focus to be synchronous when the element is already active, +// and blur to be synchronous when the element is not already active. +// (focus and blur are always synchronous in other supported browsers, +// this just defines when we can count on it). +function expectSync( elem, type ) { + return ( elem === safeActiveElement() ) === ( type === "focus" ); +} + +// Support: IE <=9 only +// Accessing document.activeElement can throw unexpectedly +// https://bugs.jquery.com/ticket/13393 +function safeActiveElement() { + try { + return document.activeElement; + } catch ( err ) { } +} + +function on( elem, types, selector, data, fn, one ) { + var origFn, type; + + // Types can be a map of types/handlers + if ( typeof types === "object" ) { + + // ( types-Object, selector, data ) + if ( typeof selector !== "string" ) { + + // ( types-Object, data ) + data = data || selector; + selector = undefined; + } + for ( type in types ) { + on( elem, type, selector, data, types[ type ], one ); + } + return elem; + } + + if ( data == null && fn == null ) { + + // ( types, fn ) + fn = selector; + data = selector = undefined; + } else if ( fn == null ) { + if ( typeof selector === "string" ) { + + // ( types, selector, fn ) + fn = data; + data = undefined; + } else { + + // ( types, data, fn ) + fn = data; + data = selector; + selector = undefined; + } + } + if ( fn === false ) { + fn = returnFalse; + } else if ( !fn ) { + return elem; + } + + if ( one === 1 ) { + origFn = fn; + fn = function( event ) { + + // Can use an empty set, since event contains the info + jQuery().off( event ); + return origFn.apply( this, arguments ); + }; + + // Use same guid so caller can remove using origFn + fn.guid = origFn.guid || ( origFn.guid = jQuery.guid++ ); + } + return elem.each( function() { + jQuery.event.add( this, types, fn, data, selector ); + } ); +} + +/* + * Helper functions for managing events -- not part of the public interface. + * Props to Dean Edwards' addEvent library for many of the ideas. + */ +jQuery.event = { + + global: {}, + + add: function( elem, types, handler, data, selector ) { + + var handleObjIn, eventHandle, tmp, + events, t, handleObj, + special, handlers, type, namespaces, origType, + elemData = dataPriv.get( elem ); + + // Only attach events to objects that accept data + if ( !acceptData( elem ) ) { + return; + } + + // Caller can pass in an object of custom data in lieu of the handler + if ( handler.handler ) { + handleObjIn = handler; + handler = handleObjIn.handler; + selector = handleObjIn.selector; + } + + // Ensure that invalid selectors throw exceptions at attach time + // Evaluate against documentElement in case elem is a non-element node (e.g., document) + if ( selector ) { + jQuery.find.matchesSelector( documentElement, selector ); + } + + // Make sure that the handler has a unique ID, used to find/remove it later + if ( !handler.guid ) { + handler.guid = jQuery.guid++; + } + + // Init the element's event structure and main handler, if this is the first + if ( !( events = elemData.events ) ) { + events = elemData.events = Object.create( null ); + } + if ( !( eventHandle = elemData.handle ) ) { + eventHandle = elemData.handle = function( e ) { + + // Discard the second event of a jQuery.event.trigger() and + // when an event is called after a page has unloaded + return typeof jQuery !== "undefined" && jQuery.event.triggered !== e.type ? + jQuery.event.dispatch.apply( elem, arguments ) : undefined; + }; + } + + // Handle multiple events separated by a space + types = ( types || "" ).match( rnothtmlwhite ) || [ "" ]; + t = types.length; + while ( t-- ) { + tmp = rtypenamespace.exec( types[ t ] ) || []; + type = origType = tmp[ 1 ]; + namespaces = ( tmp[ 2 ] || "" ).split( "." ).sort(); + + // There *must* be a type, no attaching namespace-only handlers + if ( !type ) { + continue; + } + + // If event changes its type, use the special event handlers for the changed type + special = jQuery.event.special[ type ] || {}; + + // If selector defined, determine special event api type, otherwise given type + type = ( selector ? special.delegateType : special.bindType ) || type; + + // Update special based on newly reset type + special = jQuery.event.special[ type ] || {}; + + // handleObj is passed to all event handlers + handleObj = jQuery.extend( { + type: type, + origType: origType, + data: data, + handler: handler, + guid: handler.guid, + selector: selector, + needsContext: selector && jQuery.expr.match.needsContext.test( selector ), + namespace: namespaces.join( "." ) + }, handleObjIn ); + + // Init the event handler queue if we're the first + if ( !( handlers = events[ type ] ) ) { + handlers = events[ type ] = []; + handlers.delegateCount = 0; + + // Only use addEventListener if the special events handler returns false + if ( !special.setup || + special.setup.call( elem, data, namespaces, eventHandle ) === false ) { + + if ( elem.addEventListener ) { + elem.addEventListener( type, eventHandle ); + } + } + } + + if ( special.add ) { + special.add.call( elem, handleObj ); + + if ( !handleObj.handler.guid ) { + handleObj.handler.guid = handler.guid; + } + } + + // Add to the element's handler list, delegates in front + if ( selector ) { + handlers.splice( handlers.delegateCount++, 0, handleObj ); + } else { + handlers.push( handleObj ); + } + + // Keep track of which events have ever been used, for event optimization + jQuery.event.global[ type ] = true; + } + + }, + + // Detach an event or set of events from an element + remove: function( elem, types, handler, selector, mappedTypes ) { + + var j, origCount, tmp, + events, t, handleObj, + special, handlers, type, namespaces, origType, + elemData = dataPriv.hasData( elem ) && dataPriv.get( elem ); + + if ( !elemData || !( events = elemData.events ) ) { + return; + } + + // Once for each type.namespace in types; type may be omitted + types = ( types || "" ).match( rnothtmlwhite ) || [ "" ]; + t = types.length; + while ( t-- ) { + tmp = rtypenamespace.exec( types[ t ] ) || []; + type = origType = tmp[ 1 ]; + namespaces = ( tmp[ 2 ] || "" ).split( "." ).sort(); + + // Unbind all events (on this namespace, if provided) for the element + if ( !type ) { + for ( type in events ) { + jQuery.event.remove( elem, type + types[ t ], handler, selector, true ); + } + continue; + } + + special = jQuery.event.special[ type ] || {}; + type = ( selector ? special.delegateType : special.bindType ) || type; + handlers = events[ type ] || []; + tmp = tmp[ 2 ] && + new RegExp( "(^|\\.)" + namespaces.join( "\\.(?:.*\\.|)" ) + "(\\.|$)" ); + + // Remove matching events + origCount = j = handlers.length; + while ( j-- ) { + handleObj = handlers[ j ]; + + if ( ( mappedTypes || origType === handleObj.origType ) && + ( !handler || handler.guid === handleObj.guid ) && + ( !tmp || tmp.test( handleObj.namespace ) ) && + ( !selector || selector === handleObj.selector || + selector === "**" && handleObj.selector ) ) { + handlers.splice( j, 1 ); + + if ( handleObj.selector ) { + handlers.delegateCount--; + } + if ( special.remove ) { + special.remove.call( elem, handleObj ); + } + } + } + + // Remove generic event handler if we removed something and no more handlers exist + // (avoids potential for endless recursion during removal of special event handlers) + if ( origCount && !handlers.length ) { + if ( !special.teardown || + special.teardown.call( elem, namespaces, elemData.handle ) === false ) { + + jQuery.removeEvent( elem, type, elemData.handle ); + } + + delete events[ type ]; + } + } + + // Remove data and the expando if it's no longer used + if ( jQuery.isEmptyObject( events ) ) { + dataPriv.remove( elem, "handle events" ); + } + }, + + dispatch: function( nativeEvent ) { + + var i, j, ret, matched, handleObj, handlerQueue, + args = new Array( arguments.length ), + + // Make a writable jQuery.Event from the native event object + event = jQuery.event.fix( nativeEvent ), + + handlers = ( + dataPriv.get( this, "events" ) || Object.create( null ) + )[ event.type ] || [], + special = jQuery.event.special[ event.type ] || {}; + + // Use the fix-ed jQuery.Event rather than the (read-only) native event + args[ 0 ] = event; + + for ( i = 1; i < arguments.length; i++ ) { + args[ i ] = arguments[ i ]; + } + + event.delegateTarget = this; + + // Call the preDispatch hook for the mapped type, and let it bail if desired + if ( special.preDispatch && special.preDispatch.call( this, event ) === false ) { + return; + } + + // Determine handlers + handlerQueue = jQuery.event.handlers.call( this, event, handlers ); + + // Run delegates first; they may want to stop propagation beneath us + i = 0; + while ( ( matched = handlerQueue[ i++ ] ) && !event.isPropagationStopped() ) { + event.currentTarget = matched.elem; + + j = 0; + while ( ( handleObj = matched.handlers[ j++ ] ) && + !event.isImmediatePropagationStopped() ) { + + // If the event is namespaced, then each handler is only invoked if it is + // specially universal or its namespaces are a superset of the event's. + if ( !event.rnamespace || handleObj.namespace === false || + event.rnamespace.test( handleObj.namespace ) ) { + + event.handleObj = handleObj; + event.data = handleObj.data; + + ret = ( ( jQuery.event.special[ handleObj.origType ] || {} ).handle || + handleObj.handler ).apply( matched.elem, args ); + + if ( ret !== undefined ) { + if ( ( event.result = ret ) === false ) { + event.preventDefault(); + event.stopPropagation(); + } + } + } + } + } + + // Call the postDispatch hook for the mapped type + if ( special.postDispatch ) { + special.postDispatch.call( this, event ); + } + + return event.result; + }, + + handlers: function( event, handlers ) { + var i, handleObj, sel, matchedHandlers, matchedSelectors, + handlerQueue = [], + delegateCount = handlers.delegateCount, + cur = event.target; + + // Find delegate handlers + if ( delegateCount && + + // Support: IE <=9 + // Black-hole SVG instance trees (trac-13180) + cur.nodeType && + + // Support: Firefox <=42 + // Suppress spec-violating clicks indicating a non-primary pointer button (trac-3861) + // https://www.w3.org/TR/DOM-Level-3-Events/#event-type-click + // Support: IE 11 only + // ...but not arrow key "clicks" of radio inputs, which can have `button` -1 (gh-2343) + !( event.type === "click" && event.button >= 1 ) ) { + + for ( ; cur !== this; cur = cur.parentNode || this ) { + + // Don't check non-elements (#13208) + // Don't process clicks on disabled elements (#6911, #8165, #11382, #11764) + if ( cur.nodeType === 1 && !( event.type === "click" && cur.disabled === true ) ) { + matchedHandlers = []; + matchedSelectors = {}; + for ( i = 0; i < delegateCount; i++ ) { + handleObj = handlers[ i ]; + + // Don't conflict with Object.prototype properties (#13203) + sel = handleObj.selector + " "; + + if ( matchedSelectors[ sel ] === undefined ) { + matchedSelectors[ sel ] = handleObj.needsContext ? + jQuery( sel, this ).index( cur ) > -1 : + jQuery.find( sel, this, null, [ cur ] ).length; + } + if ( matchedSelectors[ sel ] ) { + matchedHandlers.push( handleObj ); + } + } + if ( matchedHandlers.length ) { + handlerQueue.push( { elem: cur, handlers: matchedHandlers } ); + } + } + } + } + + // Add the remaining (directly-bound) handlers + cur = this; + if ( delegateCount < handlers.length ) { + handlerQueue.push( { elem: cur, handlers: handlers.slice( delegateCount ) } ); + } + + return handlerQueue; + }, + + addProp: function( name, hook ) { + Object.defineProperty( jQuery.Event.prototype, name, { + enumerable: true, + configurable: true, + + get: isFunction( hook ) ? + function() { + if ( this.originalEvent ) { + return hook( this.originalEvent ); + } + } : + function() { + if ( this.originalEvent ) { + return this.originalEvent[ name ]; + } + }, + + set: function( value ) { + Object.defineProperty( this, name, { + enumerable: true, + configurable: true, + writable: true, + value: value + } ); + } + } ); + }, + + fix: function( originalEvent ) { + return originalEvent[ jQuery.expando ] ? + originalEvent : + new jQuery.Event( originalEvent ); + }, + + special: { + load: { + + // Prevent triggered image.load events from bubbling to window.load + noBubble: true + }, + click: { + + // Utilize native event to ensure correct state for checkable inputs + setup: function( data ) { + + // For mutual compressibility with _default, replace `this` access with a local var. + // `|| data` is dead code meant only to preserve the variable through minification. + var el = this || data; + + // Claim the first handler + if ( rcheckableType.test( el.type ) && + el.click && nodeName( el, "input" ) ) { + + // dataPriv.set( el, "click", ... ) + leverageNative( el, "click", returnTrue ); + } + + // Return false to allow normal processing in the caller + return false; + }, + trigger: function( data ) { + + // For mutual compressibility with _default, replace `this` access with a local var. + // `|| data` is dead code meant only to preserve the variable through minification. + var el = this || data; + + // Force setup before triggering a click + if ( rcheckableType.test( el.type ) && + el.click && nodeName( el, "input" ) ) { + + leverageNative( el, "click" ); + } + + // Return non-false to allow normal event-path propagation + return true; + }, + + // For cross-browser consistency, suppress native .click() on links + // Also prevent it if we're currently inside a leveraged native-event stack + _default: function( event ) { + var target = event.target; + return rcheckableType.test( target.type ) && + target.click && nodeName( target, "input" ) && + dataPriv.get( target, "click" ) || + nodeName( target, "a" ); + } + }, + + beforeunload: { + postDispatch: function( event ) { + + // Support: Firefox 20+ + // Firefox doesn't alert if the returnValue field is not set. + if ( event.result !== undefined && event.originalEvent ) { + event.originalEvent.returnValue = event.result; + } + } + } + } +}; + +// Ensure the presence of an event listener that handles manually-triggered +// synthetic events by interrupting progress until reinvoked in response to +// *native* events that it fires directly, ensuring that state changes have +// already occurred before other listeners are invoked. +function leverageNative( el, type, expectSync ) { + + // Missing expectSync indicates a trigger call, which must force setup through jQuery.event.add + if ( !expectSync ) { + if ( dataPriv.get( el, type ) === undefined ) { + jQuery.event.add( el, type, returnTrue ); + } + return; + } + + // Register the controller as a special universal handler for all event namespaces + dataPriv.set( el, type, false ); + jQuery.event.add( el, type, { + namespace: false, + handler: function( event ) { + var notAsync, result, + saved = dataPriv.get( this, type ); + + if ( ( event.isTrigger & 1 ) && this[ type ] ) { + + // Interrupt processing of the outer synthetic .trigger()ed event + // Saved data should be false in such cases, but might be a leftover capture object + // from an async native handler (gh-4350) + if ( !saved.length ) { + + // Store arguments for use when handling the inner native event + // There will always be at least one argument (an event object), so this array + // will not be confused with a leftover capture object. + saved = slice.call( arguments ); + dataPriv.set( this, type, saved ); + + // Trigger the native event and capture its result + // Support: IE <=9 - 11+ + // focus() and blur() are asynchronous + notAsync = expectSync( this, type ); + this[ type ](); + result = dataPriv.get( this, type ); + if ( saved !== result || notAsync ) { + dataPriv.set( this, type, false ); + } else { + result = {}; + } + if ( saved !== result ) { + + // Cancel the outer synthetic event + event.stopImmediatePropagation(); + event.preventDefault(); + + // Support: Chrome 86+ + // In Chrome, if an element having a focusout handler is blurred by + // clicking outside of it, it invokes the handler synchronously. If + // that handler calls `.remove()` on the element, the data is cleared, + // leaving `result` undefined. We need to guard against this. + return result && result.value; + } + + // If this is an inner synthetic event for an event with a bubbling surrogate + // (focus or blur), assume that the surrogate already propagated from triggering the + // native event and prevent that from happening again here. + // This technically gets the ordering wrong w.r.t. to `.trigger()` (in which the + // bubbling surrogate propagates *after* the non-bubbling base), but that seems + // less bad than duplication. + } else if ( ( jQuery.event.special[ type ] || {} ).delegateType ) { + event.stopPropagation(); + } + + // If this is a native event triggered above, everything is now in order + // Fire an inner synthetic event with the original arguments + } else if ( saved.length ) { + + // ...and capture the result + dataPriv.set( this, type, { + value: jQuery.event.trigger( + + // Support: IE <=9 - 11+ + // Extend with the prototype to reset the above stopImmediatePropagation() + jQuery.extend( saved[ 0 ], jQuery.Event.prototype ), + saved.slice( 1 ), + this + ) + } ); + + // Abort handling of the native event + event.stopImmediatePropagation(); + } + } + } ); +} + +jQuery.removeEvent = function( elem, type, handle ) { + + // This "if" is needed for plain objects + if ( elem.removeEventListener ) { + elem.removeEventListener( type, handle ); + } +}; + +jQuery.Event = function( src, props ) { + + // Allow instantiation without the 'new' keyword + if ( !( this instanceof jQuery.Event ) ) { + return new jQuery.Event( src, props ); + } + + // Event object + if ( src && src.type ) { + this.originalEvent = src; + this.type = src.type; + + // Events bubbling up the document may have been marked as prevented + // by a handler lower down the tree; reflect the correct value. + this.isDefaultPrevented = src.defaultPrevented || + src.defaultPrevented === undefined && + + // Support: Android <=2.3 only + src.returnValue === false ? + returnTrue : + returnFalse; + + // Create target properties + // Support: Safari <=6 - 7 only + // Target should not be a text node (#504, #13143) + this.target = ( src.target && src.target.nodeType === 3 ) ? + src.target.parentNode : + src.target; + + this.currentTarget = src.currentTarget; + this.relatedTarget = src.relatedTarget; + + // Event type + } else { + this.type = src; + } + + // Put explicitly provided properties onto the event object + if ( props ) { + jQuery.extend( this, props ); + } + + // Create a timestamp if incoming event doesn't have one + this.timeStamp = src && src.timeStamp || Date.now(); + + // Mark it as fixed + this[ jQuery.expando ] = true; +}; + +// jQuery.Event is based on DOM3 Events as specified by the ECMAScript Language Binding +// https://www.w3.org/TR/2003/WD-DOM-Level-3-Events-20030331/ecma-script-binding.html +jQuery.Event.prototype = { + constructor: jQuery.Event, + isDefaultPrevented: returnFalse, + isPropagationStopped: returnFalse, + isImmediatePropagationStopped: returnFalse, + isSimulated: false, + + preventDefault: function() { + var e = this.originalEvent; + + this.isDefaultPrevented = returnTrue; + + if ( e && !this.isSimulated ) { + e.preventDefault(); + } + }, + stopPropagation: function() { + var e = this.originalEvent; + + this.isPropagationStopped = returnTrue; + + if ( e && !this.isSimulated ) { + e.stopPropagation(); + } + }, + stopImmediatePropagation: function() { + var e = this.originalEvent; + + this.isImmediatePropagationStopped = returnTrue; + + if ( e && !this.isSimulated ) { + e.stopImmediatePropagation(); + } + + this.stopPropagation(); + } +}; + +// Includes all common event props including KeyEvent and MouseEvent specific props +jQuery.each( { + altKey: true, + bubbles: true, + cancelable: true, + changedTouches: true, + ctrlKey: true, + detail: true, + eventPhase: true, + metaKey: true, + pageX: true, + pageY: true, + shiftKey: true, + view: true, + "char": true, + code: true, + charCode: true, + key: true, + keyCode: true, + button: true, + buttons: true, + clientX: true, + clientY: true, + offsetX: true, + offsetY: true, + pointerId: true, + pointerType: true, + screenX: true, + screenY: true, + targetTouches: true, + toElement: true, + touches: true, + which: true +}, jQuery.event.addProp ); + +jQuery.each( { focus: "focusin", blur: "focusout" }, function( type, delegateType ) { + jQuery.event.special[ type ] = { + + // Utilize native event if possible so blur/focus sequence is correct + setup: function() { + + // Claim the first handler + // dataPriv.set( this, "focus", ... ) + // dataPriv.set( this, "blur", ... ) + leverageNative( this, type, expectSync ); + + // Return false to allow normal processing in the caller + return false; + }, + trigger: function() { + + // Force setup before trigger + leverageNative( this, type ); + + // Return non-false to allow normal event-path propagation + return true; + }, + + // Suppress native focus or blur as it's already being fired + // in leverageNative. + _default: function() { + return true; + }, + + delegateType: delegateType + }; +} ); + +// Create mouseenter/leave events using mouseover/out and event-time checks +// so that event delegation works in jQuery. +// Do the same for pointerenter/pointerleave and pointerover/pointerout +// +// Support: Safari 7 only +// Safari sends mouseenter too often; see: +// https://bugs.chromium.org/p/chromium/issues/detail?id=470258 +// for the description of the bug (it existed in older Chrome versions as well). +jQuery.each( { + mouseenter: "mouseover", + mouseleave: "mouseout", + pointerenter: "pointerover", + pointerleave: "pointerout" +}, function( orig, fix ) { + jQuery.event.special[ orig ] = { + delegateType: fix, + bindType: fix, + + handle: function( event ) { + var ret, + target = this, + related = event.relatedTarget, + handleObj = event.handleObj; + + // For mouseenter/leave call the handler if related is outside the target. + // NB: No relatedTarget if the mouse left/entered the browser window + if ( !related || ( related !== target && !jQuery.contains( target, related ) ) ) { + event.type = handleObj.origType; + ret = handleObj.handler.apply( this, arguments ); + event.type = fix; + } + return ret; + } + }; +} ); + +jQuery.fn.extend( { + + on: function( types, selector, data, fn ) { + return on( this, types, selector, data, fn ); + }, + one: function( types, selector, data, fn ) { + return on( this, types, selector, data, fn, 1 ); + }, + off: function( types, selector, fn ) { + var handleObj, type; + if ( types && types.preventDefault && types.handleObj ) { + + // ( event ) dispatched jQuery.Event + handleObj = types.handleObj; + jQuery( types.delegateTarget ).off( + handleObj.namespace ? + handleObj.origType + "." + handleObj.namespace : + handleObj.origType, + handleObj.selector, + handleObj.handler + ); + return this; + } + if ( typeof types === "object" ) { + + // ( types-object [, selector] ) + for ( type in types ) { + this.off( type, selector, types[ type ] ); + } + return this; + } + if ( selector === false || typeof selector === "function" ) { + + // ( types [, fn] ) + fn = selector; + selector = undefined; + } + if ( fn === false ) { + fn = returnFalse; + } + return this.each( function() { + jQuery.event.remove( this, types, fn, selector ); + } ); + } +} ); + + +var + + // Support: IE <=10 - 11, Edge 12 - 13 only + // In IE/Edge using regex groups here causes severe slowdowns. + // See https://connect.microsoft.com/IE/feedback/details/1736512/ + rnoInnerhtml = /\s*$/g; + +// Prefer a tbody over its parent table for containing new rows +function manipulationTarget( elem, content ) { + if ( nodeName( elem, "table" ) && + nodeName( content.nodeType !== 11 ? content : content.firstChild, "tr" ) ) { + + return jQuery( elem ).children( "tbody" )[ 0 ] || elem; + } + + return elem; +} + +// Replace/restore the type attribute of script elements for safe DOM manipulation +function disableScript( elem ) { + elem.type = ( elem.getAttribute( "type" ) !== null ) + "/" + elem.type; + return elem; +} +function restoreScript( elem ) { + if ( ( elem.type || "" ).slice( 0, 5 ) === "true/" ) { + elem.type = elem.type.slice( 5 ); + } else { + elem.removeAttribute( "type" ); + } + + return elem; +} + +function cloneCopyEvent( src, dest ) { + var i, l, type, pdataOld, udataOld, udataCur, events; + + if ( dest.nodeType !== 1 ) { + return; + } + + // 1. Copy private data: events, handlers, etc. + if ( dataPriv.hasData( src ) ) { + pdataOld = dataPriv.get( src ); + events = pdataOld.events; + + if ( events ) { + dataPriv.remove( dest, "handle events" ); + + for ( type in events ) { + for ( i = 0, l = events[ type ].length; i < l; i++ ) { + jQuery.event.add( dest, type, events[ type ][ i ] ); + } + } + } + } + + // 2. Copy user data + if ( dataUser.hasData( src ) ) { + udataOld = dataUser.access( src ); + udataCur = jQuery.extend( {}, udataOld ); + + dataUser.set( dest, udataCur ); + } +} + +// Fix IE bugs, see support tests +function fixInput( src, dest ) { + var nodeName = dest.nodeName.toLowerCase(); + + // Fails to persist the checked state of a cloned checkbox or radio button. + if ( nodeName === "input" && rcheckableType.test( src.type ) ) { + dest.checked = src.checked; + + // Fails to return the selected option to the default selected state when cloning options + } else if ( nodeName === "input" || nodeName === "textarea" ) { + dest.defaultValue = src.defaultValue; + } +} + +function domManip( collection, args, callback, ignored ) { + + // Flatten any nested arrays + args = flat( args ); + + var fragment, first, scripts, hasScripts, node, doc, + i = 0, + l = collection.length, + iNoClone = l - 1, + value = args[ 0 ], + valueIsFunction = isFunction( value ); + + // We can't cloneNode fragments that contain checked, in WebKit + if ( valueIsFunction || + ( l > 1 && typeof value === "string" && + !support.checkClone && rchecked.test( value ) ) ) { + return collection.each( function( index ) { + var self = collection.eq( index ); + if ( valueIsFunction ) { + args[ 0 ] = value.call( this, index, self.html() ); + } + domManip( self, args, callback, ignored ); + } ); + } + + if ( l ) { + fragment = buildFragment( args, collection[ 0 ].ownerDocument, false, collection, ignored ); + first = fragment.firstChild; + + if ( fragment.childNodes.length === 1 ) { + fragment = first; + } + + // Require either new content or an interest in ignored elements to invoke the callback + if ( first || ignored ) { + scripts = jQuery.map( getAll( fragment, "script" ), disableScript ); + hasScripts = scripts.length; + + // Use the original fragment for the last item + // instead of the first because it can end up + // being emptied incorrectly in certain situations (#8070). + for ( ; i < l; i++ ) { + node = fragment; + + if ( i !== iNoClone ) { + node = jQuery.clone( node, true, true ); + + // Keep references to cloned scripts for later restoration + if ( hasScripts ) { + + // Support: Android <=4.0 only, PhantomJS 1 only + // push.apply(_, arraylike) throws on ancient WebKit + jQuery.merge( scripts, getAll( node, "script" ) ); + } + } + + callback.call( collection[ i ], node, i ); + } + + if ( hasScripts ) { + doc = scripts[ scripts.length - 1 ].ownerDocument; + + // Reenable scripts + jQuery.map( scripts, restoreScript ); + + // Evaluate executable scripts on first document insertion + for ( i = 0; i < hasScripts; i++ ) { + node = scripts[ i ]; + if ( rscriptType.test( node.type || "" ) && + !dataPriv.access( node, "globalEval" ) && + jQuery.contains( doc, node ) ) { + + if ( node.src && ( node.type || "" ).toLowerCase() !== "module" ) { + + // Optional AJAX dependency, but won't run scripts if not present + if ( jQuery._evalUrl && !node.noModule ) { + jQuery._evalUrl( node.src, { + nonce: node.nonce || node.getAttribute( "nonce" ) + }, doc ); + } + } else { + DOMEval( node.textContent.replace( rcleanScript, "" ), node, doc ); + } + } + } + } + } + } + + return collection; +} + +function remove( elem, selector, keepData ) { + var node, + nodes = selector ? jQuery.filter( selector, elem ) : elem, + i = 0; + + for ( ; ( node = nodes[ i ] ) != null; i++ ) { + if ( !keepData && node.nodeType === 1 ) { + jQuery.cleanData( getAll( node ) ); + } + + if ( node.parentNode ) { + if ( keepData && isAttached( node ) ) { + setGlobalEval( getAll( node, "script" ) ); + } + node.parentNode.removeChild( node ); + } + } + + return elem; +} + +jQuery.extend( { + htmlPrefilter: function( html ) { + return html; + }, + + clone: function( elem, dataAndEvents, deepDataAndEvents ) { + var i, l, srcElements, destElements, + clone = elem.cloneNode( true ), + inPage = isAttached( elem ); + + // Fix IE cloning issues + if ( !support.noCloneChecked && ( elem.nodeType === 1 || elem.nodeType === 11 ) && + !jQuery.isXMLDoc( elem ) ) { + + // We eschew Sizzle here for performance reasons: https://jsperf.com/getall-vs-sizzle/2 + destElements = getAll( clone ); + srcElements = getAll( elem ); + + for ( i = 0, l = srcElements.length; i < l; i++ ) { + fixInput( srcElements[ i ], destElements[ i ] ); + } + } + + // Copy the events from the original to the clone + if ( dataAndEvents ) { + if ( deepDataAndEvents ) { + srcElements = srcElements || getAll( elem ); + destElements = destElements || getAll( clone ); + + for ( i = 0, l = srcElements.length; i < l; i++ ) { + cloneCopyEvent( srcElements[ i ], destElements[ i ] ); + } + } else { + cloneCopyEvent( elem, clone ); + } + } + + // Preserve script evaluation history + destElements = getAll( clone, "script" ); + if ( destElements.length > 0 ) { + setGlobalEval( destElements, !inPage && getAll( elem, "script" ) ); + } + + // Return the cloned set + return clone; + }, + + cleanData: function( elems ) { + var data, elem, type, + special = jQuery.event.special, + i = 0; + + for ( ; ( elem = elems[ i ] ) !== undefined; i++ ) { + if ( acceptData( elem ) ) { + if ( ( data = elem[ dataPriv.expando ] ) ) { + if ( data.events ) { + for ( type in data.events ) { + if ( special[ type ] ) { + jQuery.event.remove( elem, type ); + + // This is a shortcut to avoid jQuery.event.remove's overhead + } else { + jQuery.removeEvent( elem, type, data.handle ); + } + } + } + + // Support: Chrome <=35 - 45+ + // Assign undefined instead of using delete, see Data#remove + elem[ dataPriv.expando ] = undefined; + } + if ( elem[ dataUser.expando ] ) { + + // Support: Chrome <=35 - 45+ + // Assign undefined instead of using delete, see Data#remove + elem[ dataUser.expando ] = undefined; + } + } + } + } +} ); + +jQuery.fn.extend( { + detach: function( selector ) { + return remove( this, selector, true ); + }, + + remove: function( selector ) { + return remove( this, selector ); + }, + + text: function( value ) { + return access( this, function( value ) { + return value === undefined ? + jQuery.text( this ) : + this.empty().each( function() { + if ( this.nodeType === 1 || this.nodeType === 11 || this.nodeType === 9 ) { + this.textContent = value; + } + } ); + }, null, value, arguments.length ); + }, + + append: function() { + return domManip( this, arguments, function( elem ) { + if ( this.nodeType === 1 || this.nodeType === 11 || this.nodeType === 9 ) { + var target = manipulationTarget( this, elem ); + target.appendChild( elem ); + } + } ); + }, + + prepend: function() { + return domManip( this, arguments, function( elem ) { + if ( this.nodeType === 1 || this.nodeType === 11 || this.nodeType === 9 ) { + var target = manipulationTarget( this, elem ); + target.insertBefore( elem, target.firstChild ); + } + } ); + }, + + before: function() { + return domManip( this, arguments, function( elem ) { + if ( this.parentNode ) { + this.parentNode.insertBefore( elem, this ); + } + } ); + }, + + after: function() { + return domManip( this, arguments, function( elem ) { + if ( this.parentNode ) { + this.parentNode.insertBefore( elem, this.nextSibling ); + } + } ); + }, + + empty: function() { + var elem, + i = 0; + + for ( ; ( elem = this[ i ] ) != null; i++ ) { + if ( elem.nodeType === 1 ) { + + // Prevent memory leaks + jQuery.cleanData( getAll( elem, false ) ); + + // Remove any remaining nodes + elem.textContent = ""; + } + } + + return this; + }, + + clone: function( dataAndEvents, deepDataAndEvents ) { + dataAndEvents = dataAndEvents == null ? false : dataAndEvents; + deepDataAndEvents = deepDataAndEvents == null ? dataAndEvents : deepDataAndEvents; + + return this.map( function() { + return jQuery.clone( this, dataAndEvents, deepDataAndEvents ); + } ); + }, + + html: function( value ) { + return access( this, function( value ) { + var elem = this[ 0 ] || {}, + i = 0, + l = this.length; + + if ( value === undefined && elem.nodeType === 1 ) { + return elem.innerHTML; + } + + // See if we can take a shortcut and just use innerHTML + if ( typeof value === "string" && !rnoInnerhtml.test( value ) && + !wrapMap[ ( rtagName.exec( value ) || [ "", "" ] )[ 1 ].toLowerCase() ] ) { + + value = jQuery.htmlPrefilter( value ); + + try { + for ( ; i < l; i++ ) { + elem = this[ i ] || {}; + + // Remove element nodes and prevent memory leaks + if ( elem.nodeType === 1 ) { + jQuery.cleanData( getAll( elem, false ) ); + elem.innerHTML = value; + } + } + + elem = 0; + + // If using innerHTML throws an exception, use the fallback method + } catch ( e ) {} + } + + if ( elem ) { + this.empty().append( value ); + } + }, null, value, arguments.length ); + }, + + replaceWith: function() { + var ignored = []; + + // Make the changes, replacing each non-ignored context element with the new content + return domManip( this, arguments, function( elem ) { + var parent = this.parentNode; + + if ( jQuery.inArray( this, ignored ) < 0 ) { + jQuery.cleanData( getAll( this ) ); + if ( parent ) { + parent.replaceChild( elem, this ); + } + } + + // Force callback invocation + }, ignored ); + } +} ); + +jQuery.each( { + appendTo: "append", + prependTo: "prepend", + insertBefore: "before", + insertAfter: "after", + replaceAll: "replaceWith" +}, function( name, original ) { + jQuery.fn[ name ] = function( selector ) { + var elems, + ret = [], + insert = jQuery( selector ), + last = insert.length - 1, + i = 0; + + for ( ; i <= last; i++ ) { + elems = i === last ? this : this.clone( true ); + jQuery( insert[ i ] )[ original ]( elems ); + + // Support: Android <=4.0 only, PhantomJS 1 only + // .get() because push.apply(_, arraylike) throws on ancient WebKit + push.apply( ret, elems.get() ); + } + + return this.pushStack( ret ); + }; +} ); +var rnumnonpx = new RegExp( "^(" + pnum + ")(?!px)[a-z%]+$", "i" ); + +var getStyles = function( elem ) { + + // Support: IE <=11 only, Firefox <=30 (#15098, #14150) + // IE throws on elements created in popups + // FF meanwhile throws on frame elements through "defaultView.getComputedStyle" + var view = elem.ownerDocument.defaultView; + + if ( !view || !view.opener ) { + view = window; + } + + return view.getComputedStyle( elem ); + }; + +var swap = function( elem, options, callback ) { + var ret, name, + old = {}; + + // Remember the old values, and insert the new ones + for ( name in options ) { + old[ name ] = elem.style[ name ]; + elem.style[ name ] = options[ name ]; + } + + ret = callback.call( elem ); + + // Revert the old values + for ( name in options ) { + elem.style[ name ] = old[ name ]; + } + + return ret; +}; + + +var rboxStyle = new RegExp( cssExpand.join( "|" ), "i" ); + + + +( function() { + + // Executing both pixelPosition & boxSizingReliable tests require only one layout + // so they're executed at the same time to save the second computation. + function computeStyleTests() { + + // This is a singleton, we need to execute it only once + if ( !div ) { + return; + } + + container.style.cssText = "position:absolute;left:-11111px;width:60px;" + + "margin-top:1px;padding:0;border:0"; + div.style.cssText = + "position:relative;display:block;box-sizing:border-box;overflow:scroll;" + + "margin:auto;border:1px;padding:1px;" + + "width:60%;top:1%"; + documentElement.appendChild( container ).appendChild( div ); + + var divStyle = window.getComputedStyle( div ); + pixelPositionVal = divStyle.top !== "1%"; + + // Support: Android 4.0 - 4.3 only, Firefox <=3 - 44 + reliableMarginLeftVal = roundPixelMeasures( divStyle.marginLeft ) === 12; + + // Support: Android 4.0 - 4.3 only, Safari <=9.1 - 10.1, iOS <=7.0 - 9.3 + // Some styles come back with percentage values, even though they shouldn't + div.style.right = "60%"; + pixelBoxStylesVal = roundPixelMeasures( divStyle.right ) === 36; + + // Support: IE 9 - 11 only + // Detect misreporting of content dimensions for box-sizing:border-box elements + boxSizingReliableVal = roundPixelMeasures( divStyle.width ) === 36; + + // Support: IE 9 only + // Detect overflow:scroll screwiness (gh-3699) + // Support: Chrome <=64 + // Don't get tricked when zoom affects offsetWidth (gh-4029) + div.style.position = "absolute"; + scrollboxSizeVal = roundPixelMeasures( div.offsetWidth / 3 ) === 12; + + documentElement.removeChild( container ); + + // Nullify the div so it wouldn't be stored in the memory and + // it will also be a sign that checks already performed + div = null; + } + + function roundPixelMeasures( measure ) { + return Math.round( parseFloat( measure ) ); + } + + var pixelPositionVal, boxSizingReliableVal, scrollboxSizeVal, pixelBoxStylesVal, + reliableTrDimensionsVal, reliableMarginLeftVal, + container = document.createElement( "div" ), + div = document.createElement( "div" ); + + // Finish early in limited (non-browser) environments + if ( !div.style ) { + return; + } + + // Support: IE <=9 - 11 only + // Style of cloned element affects source element cloned (#8908) + div.style.backgroundClip = "content-box"; + div.cloneNode( true ).style.backgroundClip = ""; + support.clearCloneStyle = div.style.backgroundClip === "content-box"; + + jQuery.extend( support, { + boxSizingReliable: function() { + computeStyleTests(); + return boxSizingReliableVal; + }, + pixelBoxStyles: function() { + computeStyleTests(); + return pixelBoxStylesVal; + }, + pixelPosition: function() { + computeStyleTests(); + return pixelPositionVal; + }, + reliableMarginLeft: function() { + computeStyleTests(); + return reliableMarginLeftVal; + }, + scrollboxSize: function() { + computeStyleTests(); + return scrollboxSizeVal; + }, + + // Support: IE 9 - 11+, Edge 15 - 18+ + // IE/Edge misreport `getComputedStyle` of table rows with width/height + // set in CSS while `offset*` properties report correct values. + // Behavior in IE 9 is more subtle than in newer versions & it passes + // some versions of this test; make sure not to make it pass there! + // + // Support: Firefox 70+ + // Only Firefox includes border widths + // in computed dimensions. (gh-4529) + reliableTrDimensions: function() { + var table, tr, trChild, trStyle; + if ( reliableTrDimensionsVal == null ) { + table = document.createElement( "table" ); + tr = document.createElement( "tr" ); + trChild = document.createElement( "div" ); + + table.style.cssText = "position:absolute;left:-11111px;border-collapse:separate"; + tr.style.cssText = "border:1px solid"; + + // Support: Chrome 86+ + // Height set through cssText does not get applied. + // Computed height then comes back as 0. + tr.style.height = "1px"; + trChild.style.height = "9px"; + + // Support: Android 8 Chrome 86+ + // In our bodyBackground.html iframe, + // display for all div elements is set to "inline", + // which causes a problem only in Android 8 Chrome 86. + // Ensuring the div is display: block + // gets around this issue. + trChild.style.display = "block"; + + documentElement + .appendChild( table ) + .appendChild( tr ) + .appendChild( trChild ); + + trStyle = window.getComputedStyle( tr ); + reliableTrDimensionsVal = ( parseInt( trStyle.height, 10 ) + + parseInt( trStyle.borderTopWidth, 10 ) + + parseInt( trStyle.borderBottomWidth, 10 ) ) === tr.offsetHeight; + + documentElement.removeChild( table ); + } + return reliableTrDimensionsVal; + } + } ); +} )(); + + +function curCSS( elem, name, computed ) { + var width, minWidth, maxWidth, ret, + + // Support: Firefox 51+ + // Retrieving style before computed somehow + // fixes an issue with getting wrong values + // on detached elements + style = elem.style; + + computed = computed || getStyles( elem ); + + // getPropertyValue is needed for: + // .css('filter') (IE 9 only, #12537) + // .css('--customProperty) (#3144) + if ( computed ) { + ret = computed.getPropertyValue( name ) || computed[ name ]; + + if ( ret === "" && !isAttached( elem ) ) { + ret = jQuery.style( elem, name ); + } + + // A tribute to the "awesome hack by Dean Edwards" + // Android Browser returns percentage for some values, + // but width seems to be reliably pixels. + // This is against the CSSOM draft spec: + // https://drafts.csswg.org/cssom/#resolved-values + if ( !support.pixelBoxStyles() && rnumnonpx.test( ret ) && rboxStyle.test( name ) ) { + + // Remember the original values + width = style.width; + minWidth = style.minWidth; + maxWidth = style.maxWidth; + + // Put in the new values to get a computed value out + style.minWidth = style.maxWidth = style.width = ret; + ret = computed.width; + + // Revert the changed values + style.width = width; + style.minWidth = minWidth; + style.maxWidth = maxWidth; + } + } + + return ret !== undefined ? + + // Support: IE <=9 - 11 only + // IE returns zIndex value as an integer. + ret + "" : + ret; +} + + +function addGetHookIf( conditionFn, hookFn ) { + + // Define the hook, we'll check on the first run if it's really needed. + return { + get: function() { + if ( conditionFn() ) { + + // Hook not needed (or it's not possible to use it due + // to missing dependency), remove it. + delete this.get; + return; + } + + // Hook needed; redefine it so that the support test is not executed again. + return ( this.get = hookFn ).apply( this, arguments ); + } + }; +} + + +var cssPrefixes = [ "Webkit", "Moz", "ms" ], + emptyStyle = document.createElement( "div" ).style, + vendorProps = {}; + +// Return a vendor-prefixed property or undefined +function vendorPropName( name ) { + + // Check for vendor prefixed names + var capName = name[ 0 ].toUpperCase() + name.slice( 1 ), + i = cssPrefixes.length; + + while ( i-- ) { + name = cssPrefixes[ i ] + capName; + if ( name in emptyStyle ) { + return name; + } + } +} + +// Return a potentially-mapped jQuery.cssProps or vendor prefixed property +function finalPropName( name ) { + var final = jQuery.cssProps[ name ] || vendorProps[ name ]; + + if ( final ) { + return final; + } + if ( name in emptyStyle ) { + return name; + } + return vendorProps[ name ] = vendorPropName( name ) || name; +} + + +var + + // Swappable if display is none or starts with table + // except "table", "table-cell", or "table-caption" + // See here for display values: https://developer.mozilla.org/en-US/docs/CSS/display + rdisplayswap = /^(none|table(?!-c[ea]).+)/, + rcustomProp = /^--/, + cssShow = { position: "absolute", visibility: "hidden", display: "block" }, + cssNormalTransform = { + letterSpacing: "0", + fontWeight: "400" + }; + +function setPositiveNumber( _elem, value, subtract ) { + + // Any relative (+/-) values have already been + // normalized at this point + var matches = rcssNum.exec( value ); + return matches ? + + // Guard against undefined "subtract", e.g., when used as in cssHooks + Math.max( 0, matches[ 2 ] - ( subtract || 0 ) ) + ( matches[ 3 ] || "px" ) : + value; +} + +function boxModelAdjustment( elem, dimension, box, isBorderBox, styles, computedVal ) { + var i = dimension === "width" ? 1 : 0, + extra = 0, + delta = 0; + + // Adjustment may not be necessary + if ( box === ( isBorderBox ? "border" : "content" ) ) { + return 0; + } + + for ( ; i < 4; i += 2 ) { + + // Both box models exclude margin + if ( box === "margin" ) { + delta += jQuery.css( elem, box + cssExpand[ i ], true, styles ); + } + + // If we get here with a content-box, we're seeking "padding" or "border" or "margin" + if ( !isBorderBox ) { + + // Add padding + delta += jQuery.css( elem, "padding" + cssExpand[ i ], true, styles ); + + // For "border" or "margin", add border + if ( box !== "padding" ) { + delta += jQuery.css( elem, "border" + cssExpand[ i ] + "Width", true, styles ); + + // But still keep track of it otherwise + } else { + extra += jQuery.css( elem, "border" + cssExpand[ i ] + "Width", true, styles ); + } + + // If we get here with a border-box (content + padding + border), we're seeking "content" or + // "padding" or "margin" + } else { + + // For "content", subtract padding + if ( box === "content" ) { + delta -= jQuery.css( elem, "padding" + cssExpand[ i ], true, styles ); + } + + // For "content" or "padding", subtract border + if ( box !== "margin" ) { + delta -= jQuery.css( elem, "border" + cssExpand[ i ] + "Width", true, styles ); + } + } + } + + // Account for positive content-box scroll gutter when requested by providing computedVal + if ( !isBorderBox && computedVal >= 0 ) { + + // offsetWidth/offsetHeight is a rounded sum of content, padding, scroll gutter, and border + // Assuming integer scroll gutter, subtract the rest and round down + delta += Math.max( 0, Math.ceil( + elem[ "offset" + dimension[ 0 ].toUpperCase() + dimension.slice( 1 ) ] - + computedVal - + delta - + extra - + 0.5 + + // If offsetWidth/offsetHeight is unknown, then we can't determine content-box scroll gutter + // Use an explicit zero to avoid NaN (gh-3964) + ) ) || 0; + } + + return delta; +} + +function getWidthOrHeight( elem, dimension, extra ) { + + // Start with computed style + var styles = getStyles( elem ), + + // To avoid forcing a reflow, only fetch boxSizing if we need it (gh-4322). + // Fake content-box until we know it's needed to know the true value. + boxSizingNeeded = !support.boxSizingReliable() || extra, + isBorderBox = boxSizingNeeded && + jQuery.css( elem, "boxSizing", false, styles ) === "border-box", + valueIsBorderBox = isBorderBox, + + val = curCSS( elem, dimension, styles ), + offsetProp = "offset" + dimension[ 0 ].toUpperCase() + dimension.slice( 1 ); + + // Support: Firefox <=54 + // Return a confounding non-pixel value or feign ignorance, as appropriate. + if ( rnumnonpx.test( val ) ) { + if ( !extra ) { + return val; + } + val = "auto"; + } + + + // Support: IE 9 - 11 only + // Use offsetWidth/offsetHeight for when box sizing is unreliable. + // In those cases, the computed value can be trusted to be border-box. + if ( ( !support.boxSizingReliable() && isBorderBox || + + // Support: IE 10 - 11+, Edge 15 - 18+ + // IE/Edge misreport `getComputedStyle` of table rows with width/height + // set in CSS while `offset*` properties report correct values. + // Interestingly, in some cases IE 9 doesn't suffer from this issue. + !support.reliableTrDimensions() && nodeName( elem, "tr" ) || + + // Fall back to offsetWidth/offsetHeight when value is "auto" + // This happens for inline elements with no explicit setting (gh-3571) + val === "auto" || + + // Support: Android <=4.1 - 4.3 only + // Also use offsetWidth/offsetHeight for misreported inline dimensions (gh-3602) + !parseFloat( val ) && jQuery.css( elem, "display", false, styles ) === "inline" ) && + + // Make sure the element is visible & connected + elem.getClientRects().length ) { + + isBorderBox = jQuery.css( elem, "boxSizing", false, styles ) === "border-box"; + + // Where available, offsetWidth/offsetHeight approximate border box dimensions. + // Where not available (e.g., SVG), assume unreliable box-sizing and interpret the + // retrieved value as a content box dimension. + valueIsBorderBox = offsetProp in elem; + if ( valueIsBorderBox ) { + val = elem[ offsetProp ]; + } + } + + // Normalize "" and auto + val = parseFloat( val ) || 0; + + // Adjust for the element's box model + return ( val + + boxModelAdjustment( + elem, + dimension, + extra || ( isBorderBox ? "border" : "content" ), + valueIsBorderBox, + styles, + + // Provide the current computed size to request scroll gutter calculation (gh-3589) + val + ) + ) + "px"; +} + +jQuery.extend( { + + // Add in style property hooks for overriding the default + // behavior of getting and setting a style property + cssHooks: { + opacity: { + get: function( elem, computed ) { + if ( computed ) { + + // We should always get a number back from opacity + var ret = curCSS( elem, "opacity" ); + return ret === "" ? "1" : ret; + } + } + } + }, + + // Don't automatically add "px" to these possibly-unitless properties + cssNumber: { + "animationIterationCount": true, + "columnCount": true, + "fillOpacity": true, + "flexGrow": true, + "flexShrink": true, + "fontWeight": true, + "gridArea": true, + "gridColumn": true, + "gridColumnEnd": true, + "gridColumnStart": true, + "gridRow": true, + "gridRowEnd": true, + "gridRowStart": true, + "lineHeight": true, + "opacity": true, + "order": true, + "orphans": true, + "widows": true, + "zIndex": true, + "zoom": true + }, + + // Add in properties whose names you wish to fix before + // setting or getting the value + cssProps: {}, + + // Get and set the style property on a DOM Node + style: function( elem, name, value, extra ) { + + // Don't set styles on text and comment nodes + if ( !elem || elem.nodeType === 3 || elem.nodeType === 8 || !elem.style ) { + return; + } + + // Make sure that we're working with the right name + var ret, type, hooks, + origName = camelCase( name ), + isCustomProp = rcustomProp.test( name ), + style = elem.style; + + // Make sure that we're working with the right name. We don't + // want to query the value if it is a CSS custom property + // since they are user-defined. + if ( !isCustomProp ) { + name = finalPropName( origName ); + } + + // Gets hook for the prefixed version, then unprefixed version + hooks = jQuery.cssHooks[ name ] || jQuery.cssHooks[ origName ]; + + // Check if we're setting a value + if ( value !== undefined ) { + type = typeof value; + + // Convert "+=" or "-=" to relative numbers (#7345) + if ( type === "string" && ( ret = rcssNum.exec( value ) ) && ret[ 1 ] ) { + value = adjustCSS( elem, name, ret ); + + // Fixes bug #9237 + type = "number"; + } + + // Make sure that null and NaN values aren't set (#7116) + if ( value == null || value !== value ) { + return; + } + + // If a number was passed in, add the unit (except for certain CSS properties) + // The isCustomProp check can be removed in jQuery 4.0 when we only auto-append + // "px" to a few hardcoded values. + if ( type === "number" && !isCustomProp ) { + value += ret && ret[ 3 ] || ( jQuery.cssNumber[ origName ] ? "" : "px" ); + } + + // background-* props affect original clone's values + if ( !support.clearCloneStyle && value === "" && name.indexOf( "background" ) === 0 ) { + style[ name ] = "inherit"; + } + + // If a hook was provided, use that value, otherwise just set the specified value + if ( !hooks || !( "set" in hooks ) || + ( value = hooks.set( elem, value, extra ) ) !== undefined ) { + + if ( isCustomProp ) { + style.setProperty( name, value ); + } else { + style[ name ] = value; + } + } + + } else { + + // If a hook was provided get the non-computed value from there + if ( hooks && "get" in hooks && + ( ret = hooks.get( elem, false, extra ) ) !== undefined ) { + + return ret; + } + + // Otherwise just get the value from the style object + return style[ name ]; + } + }, + + css: function( elem, name, extra, styles ) { + var val, num, hooks, + origName = camelCase( name ), + isCustomProp = rcustomProp.test( name ); + + // Make sure that we're working with the right name. We don't + // want to modify the value if it is a CSS custom property + // since they are user-defined. + if ( !isCustomProp ) { + name = finalPropName( origName ); + } + + // Try prefixed name followed by the unprefixed name + hooks = jQuery.cssHooks[ name ] || jQuery.cssHooks[ origName ]; + + // If a hook was provided get the computed value from there + if ( hooks && "get" in hooks ) { + val = hooks.get( elem, true, extra ); + } + + // Otherwise, if a way to get the computed value exists, use that + if ( val === undefined ) { + val = curCSS( elem, name, styles ); + } + + // Convert "normal" to computed value + if ( val === "normal" && name in cssNormalTransform ) { + val = cssNormalTransform[ name ]; + } + + // Make numeric if forced or a qualifier was provided and val looks numeric + if ( extra === "" || extra ) { + num = parseFloat( val ); + return extra === true || isFinite( num ) ? num || 0 : val; + } + + return val; + } +} ); + +jQuery.each( [ "height", "width" ], function( _i, dimension ) { + jQuery.cssHooks[ dimension ] = { + get: function( elem, computed, extra ) { + if ( computed ) { + + // Certain elements can have dimension info if we invisibly show them + // but it must have a current display style that would benefit + return rdisplayswap.test( jQuery.css( elem, "display" ) ) && + + // Support: Safari 8+ + // Table columns in Safari have non-zero offsetWidth & zero + // getBoundingClientRect().width unless display is changed. + // Support: IE <=11 only + // Running getBoundingClientRect on a disconnected node + // in IE throws an error. + ( !elem.getClientRects().length || !elem.getBoundingClientRect().width ) ? + swap( elem, cssShow, function() { + return getWidthOrHeight( elem, dimension, extra ); + } ) : + getWidthOrHeight( elem, dimension, extra ); + } + }, + + set: function( elem, value, extra ) { + var matches, + styles = getStyles( elem ), + + // Only read styles.position if the test has a chance to fail + // to avoid forcing a reflow. + scrollboxSizeBuggy = !support.scrollboxSize() && + styles.position === "absolute", + + // To avoid forcing a reflow, only fetch boxSizing if we need it (gh-3991) + boxSizingNeeded = scrollboxSizeBuggy || extra, + isBorderBox = boxSizingNeeded && + jQuery.css( elem, "boxSizing", false, styles ) === "border-box", + subtract = extra ? + boxModelAdjustment( + elem, + dimension, + extra, + isBorderBox, + styles + ) : + 0; + + // Account for unreliable border-box dimensions by comparing offset* to computed and + // faking a content-box to get border and padding (gh-3699) + if ( isBorderBox && scrollboxSizeBuggy ) { + subtract -= Math.ceil( + elem[ "offset" + dimension[ 0 ].toUpperCase() + dimension.slice( 1 ) ] - + parseFloat( styles[ dimension ] ) - + boxModelAdjustment( elem, dimension, "border", false, styles ) - + 0.5 + ); + } + + // Convert to pixels if value adjustment is needed + if ( subtract && ( matches = rcssNum.exec( value ) ) && + ( matches[ 3 ] || "px" ) !== "px" ) { + + elem.style[ dimension ] = value; + value = jQuery.css( elem, dimension ); + } + + return setPositiveNumber( elem, value, subtract ); + } + }; +} ); + +jQuery.cssHooks.marginLeft = addGetHookIf( support.reliableMarginLeft, + function( elem, computed ) { + if ( computed ) { + return ( parseFloat( curCSS( elem, "marginLeft" ) ) || + elem.getBoundingClientRect().left - + swap( elem, { marginLeft: 0 }, function() { + return elem.getBoundingClientRect().left; + } ) + ) + "px"; + } + } +); + +// These hooks are used by animate to expand properties +jQuery.each( { + margin: "", + padding: "", + border: "Width" +}, function( prefix, suffix ) { + jQuery.cssHooks[ prefix + suffix ] = { + expand: function( value ) { + var i = 0, + expanded = {}, + + // Assumes a single number if not a string + parts = typeof value === "string" ? value.split( " " ) : [ value ]; + + for ( ; i < 4; i++ ) { + expanded[ prefix + cssExpand[ i ] + suffix ] = + parts[ i ] || parts[ i - 2 ] || parts[ 0 ]; + } + + return expanded; + } + }; + + if ( prefix !== "margin" ) { + jQuery.cssHooks[ prefix + suffix ].set = setPositiveNumber; + } +} ); + +jQuery.fn.extend( { + css: function( name, value ) { + return access( this, function( elem, name, value ) { + var styles, len, + map = {}, + i = 0; + + if ( Array.isArray( name ) ) { + styles = getStyles( elem ); + len = name.length; + + for ( ; i < len; i++ ) { + map[ name[ i ] ] = jQuery.css( elem, name[ i ], false, styles ); + } + + return map; + } + + return value !== undefined ? + jQuery.style( elem, name, value ) : + jQuery.css( elem, name ); + }, name, value, arguments.length > 1 ); + } +} ); + + +function Tween( elem, options, prop, end, easing ) { + return new Tween.prototype.init( elem, options, prop, end, easing ); +} +jQuery.Tween = Tween; + +Tween.prototype = { + constructor: Tween, + init: function( elem, options, prop, end, easing, unit ) { + this.elem = elem; + this.prop = prop; + this.easing = easing || jQuery.easing._default; + this.options = options; + this.start = this.now = this.cur(); + this.end = end; + this.unit = unit || ( jQuery.cssNumber[ prop ] ? "" : "px" ); + }, + cur: function() { + var hooks = Tween.propHooks[ this.prop ]; + + return hooks && hooks.get ? + hooks.get( this ) : + Tween.propHooks._default.get( this ); + }, + run: function( percent ) { + var eased, + hooks = Tween.propHooks[ this.prop ]; + + if ( this.options.duration ) { + this.pos = eased = jQuery.easing[ this.easing ]( + percent, this.options.duration * percent, 0, 1, this.options.duration + ); + } else { + this.pos = eased = percent; + } + this.now = ( this.end - this.start ) * eased + this.start; + + if ( this.options.step ) { + this.options.step.call( this.elem, this.now, this ); + } + + if ( hooks && hooks.set ) { + hooks.set( this ); + } else { + Tween.propHooks._default.set( this ); + } + return this; + } +}; + +Tween.prototype.init.prototype = Tween.prototype; + +Tween.propHooks = { + _default: { + get: function( tween ) { + var result; + + // Use a property on the element directly when it is not a DOM element, + // or when there is no matching style property that exists. + if ( tween.elem.nodeType !== 1 || + tween.elem[ tween.prop ] != null && tween.elem.style[ tween.prop ] == null ) { + return tween.elem[ tween.prop ]; + } + + // Passing an empty string as a 3rd parameter to .css will automatically + // attempt a parseFloat and fallback to a string if the parse fails. + // Simple values such as "10px" are parsed to Float; + // complex values such as "rotate(1rad)" are returned as-is. + result = jQuery.css( tween.elem, tween.prop, "" ); + + // Empty strings, null, undefined and "auto" are converted to 0. + return !result || result === "auto" ? 0 : result; + }, + set: function( tween ) { + + // Use step hook for back compat. + // Use cssHook if its there. + // Use .style if available and use plain properties where available. + if ( jQuery.fx.step[ tween.prop ] ) { + jQuery.fx.step[ tween.prop ]( tween ); + } else if ( tween.elem.nodeType === 1 && ( + jQuery.cssHooks[ tween.prop ] || + tween.elem.style[ finalPropName( tween.prop ) ] != null ) ) { + jQuery.style( tween.elem, tween.prop, tween.now + tween.unit ); + } else { + tween.elem[ tween.prop ] = tween.now; + } + } + } +}; + +// Support: IE <=9 only +// Panic based approach to setting things on disconnected nodes +Tween.propHooks.scrollTop = Tween.propHooks.scrollLeft = { + set: function( tween ) { + if ( tween.elem.nodeType && tween.elem.parentNode ) { + tween.elem[ tween.prop ] = tween.now; + } + } +}; + +jQuery.easing = { + linear: function( p ) { + return p; + }, + swing: function( p ) { + return 0.5 - Math.cos( p * Math.PI ) / 2; + }, + _default: "swing" +}; + +jQuery.fx = Tween.prototype.init; + +// Back compat <1.8 extension point +jQuery.fx.step = {}; + + + + +var + fxNow, inProgress, + rfxtypes = /^(?:toggle|show|hide)$/, + rrun = /queueHooks$/; + +function schedule() { + if ( inProgress ) { + if ( document.hidden === false && window.requestAnimationFrame ) { + window.requestAnimationFrame( schedule ); + } else { + window.setTimeout( schedule, jQuery.fx.interval ); + } + + jQuery.fx.tick(); + } +} + +// Animations created synchronously will run synchronously +function createFxNow() { + window.setTimeout( function() { + fxNow = undefined; + } ); + return ( fxNow = Date.now() ); +} + +// Generate parameters to create a standard animation +function genFx( type, includeWidth ) { + var which, + i = 0, + attrs = { height: type }; + + // If we include width, step value is 1 to do all cssExpand values, + // otherwise step value is 2 to skip over Left and Right + includeWidth = includeWidth ? 1 : 0; + for ( ; i < 4; i += 2 - includeWidth ) { + which = cssExpand[ i ]; + attrs[ "margin" + which ] = attrs[ "padding" + which ] = type; + } + + if ( includeWidth ) { + attrs.opacity = attrs.width = type; + } + + return attrs; +} + +function createTween( value, prop, animation ) { + var tween, + collection = ( Animation.tweeners[ prop ] || [] ).concat( Animation.tweeners[ "*" ] ), + index = 0, + length = collection.length; + for ( ; index < length; index++ ) { + if ( ( tween = collection[ index ].call( animation, prop, value ) ) ) { + + // We're done with this property + return tween; + } + } +} + +function defaultPrefilter( elem, props, opts ) { + var prop, value, toggle, hooks, oldfire, propTween, restoreDisplay, display, + isBox = "width" in props || "height" in props, + anim = this, + orig = {}, + style = elem.style, + hidden = elem.nodeType && isHiddenWithinTree( elem ), + dataShow = dataPriv.get( elem, "fxshow" ); + + // Queue-skipping animations hijack the fx hooks + if ( !opts.queue ) { + hooks = jQuery._queueHooks( elem, "fx" ); + if ( hooks.unqueued == null ) { + hooks.unqueued = 0; + oldfire = hooks.empty.fire; + hooks.empty.fire = function() { + if ( !hooks.unqueued ) { + oldfire(); + } + }; + } + hooks.unqueued++; + + anim.always( function() { + + // Ensure the complete handler is called before this completes + anim.always( function() { + hooks.unqueued--; + if ( !jQuery.queue( elem, "fx" ).length ) { + hooks.empty.fire(); + } + } ); + } ); + } + + // Detect show/hide animations + for ( prop in props ) { + value = props[ prop ]; + if ( rfxtypes.test( value ) ) { + delete props[ prop ]; + toggle = toggle || value === "toggle"; + if ( value === ( hidden ? "hide" : "show" ) ) { + + // Pretend to be hidden if this is a "show" and + // there is still data from a stopped show/hide + if ( value === "show" && dataShow && dataShow[ prop ] !== undefined ) { + hidden = true; + + // Ignore all other no-op show/hide data + } else { + continue; + } + } + orig[ prop ] = dataShow && dataShow[ prop ] || jQuery.style( elem, prop ); + } + } + + // Bail out if this is a no-op like .hide().hide() + propTween = !jQuery.isEmptyObject( props ); + if ( !propTween && jQuery.isEmptyObject( orig ) ) { + return; + } + + // Restrict "overflow" and "display" styles during box animations + if ( isBox && elem.nodeType === 1 ) { + + // Support: IE <=9 - 11, Edge 12 - 15 + // Record all 3 overflow attributes because IE does not infer the shorthand + // from identically-valued overflowX and overflowY and Edge just mirrors + // the overflowX value there. + opts.overflow = [ style.overflow, style.overflowX, style.overflowY ]; + + // Identify a display type, preferring old show/hide data over the CSS cascade + restoreDisplay = dataShow && dataShow.display; + if ( restoreDisplay == null ) { + restoreDisplay = dataPriv.get( elem, "display" ); + } + display = jQuery.css( elem, "display" ); + if ( display === "none" ) { + if ( restoreDisplay ) { + display = restoreDisplay; + } else { + + // Get nonempty value(s) by temporarily forcing visibility + showHide( [ elem ], true ); + restoreDisplay = elem.style.display || restoreDisplay; + display = jQuery.css( elem, "display" ); + showHide( [ elem ] ); + } + } + + // Animate inline elements as inline-block + if ( display === "inline" || display === "inline-block" && restoreDisplay != null ) { + if ( jQuery.css( elem, "float" ) === "none" ) { + + // Restore the original display value at the end of pure show/hide animations + if ( !propTween ) { + anim.done( function() { + style.display = restoreDisplay; + } ); + if ( restoreDisplay == null ) { + display = style.display; + restoreDisplay = display === "none" ? "" : display; + } + } + style.display = "inline-block"; + } + } + } + + if ( opts.overflow ) { + style.overflow = "hidden"; + anim.always( function() { + style.overflow = opts.overflow[ 0 ]; + style.overflowX = opts.overflow[ 1 ]; + style.overflowY = opts.overflow[ 2 ]; + } ); + } + + // Implement show/hide animations + propTween = false; + for ( prop in orig ) { + + // General show/hide setup for this element animation + if ( !propTween ) { + if ( dataShow ) { + if ( "hidden" in dataShow ) { + hidden = dataShow.hidden; + } + } else { + dataShow = dataPriv.access( elem, "fxshow", { display: restoreDisplay } ); + } + + // Store hidden/visible for toggle so `.stop().toggle()` "reverses" + if ( toggle ) { + dataShow.hidden = !hidden; + } + + // Show elements before animating them + if ( hidden ) { + showHide( [ elem ], true ); + } + + /* eslint-disable no-loop-func */ + + anim.done( function() { + + /* eslint-enable no-loop-func */ + + // The final step of a "hide" animation is actually hiding the element + if ( !hidden ) { + showHide( [ elem ] ); + } + dataPriv.remove( elem, "fxshow" ); + for ( prop in orig ) { + jQuery.style( elem, prop, orig[ prop ] ); + } + } ); + } + + // Per-property setup + propTween = createTween( hidden ? dataShow[ prop ] : 0, prop, anim ); + if ( !( prop in dataShow ) ) { + dataShow[ prop ] = propTween.start; + if ( hidden ) { + propTween.end = propTween.start; + propTween.start = 0; + } + } + } +} + +function propFilter( props, specialEasing ) { + var index, name, easing, value, hooks; + + // camelCase, specialEasing and expand cssHook pass + for ( index in props ) { + name = camelCase( index ); + easing = specialEasing[ name ]; + value = props[ index ]; + if ( Array.isArray( value ) ) { + easing = value[ 1 ]; + value = props[ index ] = value[ 0 ]; + } + + if ( index !== name ) { + props[ name ] = value; + delete props[ index ]; + } + + hooks = jQuery.cssHooks[ name ]; + if ( hooks && "expand" in hooks ) { + value = hooks.expand( value ); + delete props[ name ]; + + // Not quite $.extend, this won't overwrite existing keys. + // Reusing 'index' because we have the correct "name" + for ( index in value ) { + if ( !( index in props ) ) { + props[ index ] = value[ index ]; + specialEasing[ index ] = easing; + } + } + } else { + specialEasing[ name ] = easing; + } + } +} + +function Animation( elem, properties, options ) { + var result, + stopped, + index = 0, + length = Animation.prefilters.length, + deferred = jQuery.Deferred().always( function() { + + // Don't match elem in the :animated selector + delete tick.elem; + } ), + tick = function() { + if ( stopped ) { + return false; + } + var currentTime = fxNow || createFxNow(), + remaining = Math.max( 0, animation.startTime + animation.duration - currentTime ), + + // Support: Android 2.3 only + // Archaic crash bug won't allow us to use `1 - ( 0.5 || 0 )` (#12497) + temp = remaining / animation.duration || 0, + percent = 1 - temp, + index = 0, + length = animation.tweens.length; + + for ( ; index < length; index++ ) { + animation.tweens[ index ].run( percent ); + } + + deferred.notifyWith( elem, [ animation, percent, remaining ] ); + + // If there's more to do, yield + if ( percent < 1 && length ) { + return remaining; + } + + // If this was an empty animation, synthesize a final progress notification + if ( !length ) { + deferred.notifyWith( elem, [ animation, 1, 0 ] ); + } + + // Resolve the animation and report its conclusion + deferred.resolveWith( elem, [ animation ] ); + return false; + }, + animation = deferred.promise( { + elem: elem, + props: jQuery.extend( {}, properties ), + opts: jQuery.extend( true, { + specialEasing: {}, + easing: jQuery.easing._default + }, options ), + originalProperties: properties, + originalOptions: options, + startTime: fxNow || createFxNow(), + duration: options.duration, + tweens: [], + createTween: function( prop, end ) { + var tween = jQuery.Tween( elem, animation.opts, prop, end, + animation.opts.specialEasing[ prop ] || animation.opts.easing ); + animation.tweens.push( tween ); + return tween; + }, + stop: function( gotoEnd ) { + var index = 0, + + // If we are going to the end, we want to run all the tweens + // otherwise we skip this part + length = gotoEnd ? animation.tweens.length : 0; + if ( stopped ) { + return this; + } + stopped = true; + for ( ; index < length; index++ ) { + animation.tweens[ index ].run( 1 ); + } + + // Resolve when we played the last frame; otherwise, reject + if ( gotoEnd ) { + deferred.notifyWith( elem, [ animation, 1, 0 ] ); + deferred.resolveWith( elem, [ animation, gotoEnd ] ); + } else { + deferred.rejectWith( elem, [ animation, gotoEnd ] ); + } + return this; + } + } ), + props = animation.props; + + propFilter( props, animation.opts.specialEasing ); + + for ( ; index < length; index++ ) { + result = Animation.prefilters[ index ].call( animation, elem, props, animation.opts ); + if ( result ) { + if ( isFunction( result.stop ) ) { + jQuery._queueHooks( animation.elem, animation.opts.queue ).stop = + result.stop.bind( result ); + } + return result; + } + } + + jQuery.map( props, createTween, animation ); + + if ( isFunction( animation.opts.start ) ) { + animation.opts.start.call( elem, animation ); + } + + // Attach callbacks from options + animation + .progress( animation.opts.progress ) + .done( animation.opts.done, animation.opts.complete ) + .fail( animation.opts.fail ) + .always( animation.opts.always ); + + jQuery.fx.timer( + jQuery.extend( tick, { + elem: elem, + anim: animation, + queue: animation.opts.queue + } ) + ); + + return animation; +} + +jQuery.Animation = jQuery.extend( Animation, { + + tweeners: { + "*": [ function( prop, value ) { + var tween = this.createTween( prop, value ); + adjustCSS( tween.elem, prop, rcssNum.exec( value ), tween ); + return tween; + } ] + }, + + tweener: function( props, callback ) { + if ( isFunction( props ) ) { + callback = props; + props = [ "*" ]; + } else { + props = props.match( rnothtmlwhite ); + } + + var prop, + index = 0, + length = props.length; + + for ( ; index < length; index++ ) { + prop = props[ index ]; + Animation.tweeners[ prop ] = Animation.tweeners[ prop ] || []; + Animation.tweeners[ prop ].unshift( callback ); + } + }, + + prefilters: [ defaultPrefilter ], + + prefilter: function( callback, prepend ) { + if ( prepend ) { + Animation.prefilters.unshift( callback ); + } else { + Animation.prefilters.push( callback ); + } + } +} ); + +jQuery.speed = function( speed, easing, fn ) { + var opt = speed && typeof speed === "object" ? jQuery.extend( {}, speed ) : { + complete: fn || !fn && easing || + isFunction( speed ) && speed, + duration: speed, + easing: fn && easing || easing && !isFunction( easing ) && easing + }; + + // Go to the end state if fx are off + if ( jQuery.fx.off ) { + opt.duration = 0; + + } else { + if ( typeof opt.duration !== "number" ) { + if ( opt.duration in jQuery.fx.speeds ) { + opt.duration = jQuery.fx.speeds[ opt.duration ]; + + } else { + opt.duration = jQuery.fx.speeds._default; + } + } + } + + // Normalize opt.queue - true/undefined/null -> "fx" + if ( opt.queue == null || opt.queue === true ) { + opt.queue = "fx"; + } + + // Queueing + opt.old = opt.complete; + + opt.complete = function() { + if ( isFunction( opt.old ) ) { + opt.old.call( this ); + } + + if ( opt.queue ) { + jQuery.dequeue( this, opt.queue ); + } + }; + + return opt; +}; + +jQuery.fn.extend( { + fadeTo: function( speed, to, easing, callback ) { + + // Show any hidden elements after setting opacity to 0 + return this.filter( isHiddenWithinTree ).css( "opacity", 0 ).show() + + // Animate to the value specified + .end().animate( { opacity: to }, speed, easing, callback ); + }, + animate: function( prop, speed, easing, callback ) { + var empty = jQuery.isEmptyObject( prop ), + optall = jQuery.speed( speed, easing, callback ), + doAnimation = function() { + + // Operate on a copy of prop so per-property easing won't be lost + var anim = Animation( this, jQuery.extend( {}, prop ), optall ); + + // Empty animations, or finishing resolves immediately + if ( empty || dataPriv.get( this, "finish" ) ) { + anim.stop( true ); + } + }; + + doAnimation.finish = doAnimation; + + return empty || optall.queue === false ? + this.each( doAnimation ) : + this.queue( optall.queue, doAnimation ); + }, + stop: function( type, clearQueue, gotoEnd ) { + var stopQueue = function( hooks ) { + var stop = hooks.stop; + delete hooks.stop; + stop( gotoEnd ); + }; + + if ( typeof type !== "string" ) { + gotoEnd = clearQueue; + clearQueue = type; + type = undefined; + } + if ( clearQueue ) { + this.queue( type || "fx", [] ); + } + + return this.each( function() { + var dequeue = true, + index = type != null && type + "queueHooks", + timers = jQuery.timers, + data = dataPriv.get( this ); + + if ( index ) { + if ( data[ index ] && data[ index ].stop ) { + stopQueue( data[ index ] ); + } + } else { + for ( index in data ) { + if ( data[ index ] && data[ index ].stop && rrun.test( index ) ) { + stopQueue( data[ index ] ); + } + } + } + + for ( index = timers.length; index--; ) { + if ( timers[ index ].elem === this && + ( type == null || timers[ index ].queue === type ) ) { + + timers[ index ].anim.stop( gotoEnd ); + dequeue = false; + timers.splice( index, 1 ); + } + } + + // Start the next in the queue if the last step wasn't forced. + // Timers currently will call their complete callbacks, which + // will dequeue but only if they were gotoEnd. + if ( dequeue || !gotoEnd ) { + jQuery.dequeue( this, type ); + } + } ); + }, + finish: function( type ) { + if ( type !== false ) { + type = type || "fx"; + } + return this.each( function() { + var index, + data = dataPriv.get( this ), + queue = data[ type + "queue" ], + hooks = data[ type + "queueHooks" ], + timers = jQuery.timers, + length = queue ? queue.length : 0; + + // Enable finishing flag on private data + data.finish = true; + + // Empty the queue first + jQuery.queue( this, type, [] ); + + if ( hooks && hooks.stop ) { + hooks.stop.call( this, true ); + } + + // Look for any active animations, and finish them + for ( index = timers.length; index--; ) { + if ( timers[ index ].elem === this && timers[ index ].queue === type ) { + timers[ index ].anim.stop( true ); + timers.splice( index, 1 ); + } + } + + // Look for any animations in the old queue and finish them + for ( index = 0; index < length; index++ ) { + if ( queue[ index ] && queue[ index ].finish ) { + queue[ index ].finish.call( this ); + } + } + + // Turn off finishing flag + delete data.finish; + } ); + } +} ); + +jQuery.each( [ "toggle", "show", "hide" ], function( _i, name ) { + var cssFn = jQuery.fn[ name ]; + jQuery.fn[ name ] = function( speed, easing, callback ) { + return speed == null || typeof speed === "boolean" ? + cssFn.apply( this, arguments ) : + this.animate( genFx( name, true ), speed, easing, callback ); + }; +} ); + +// Generate shortcuts for custom animations +jQuery.each( { + slideDown: genFx( "show" ), + slideUp: genFx( "hide" ), + slideToggle: genFx( "toggle" ), + fadeIn: { opacity: "show" }, + fadeOut: { opacity: "hide" }, + fadeToggle: { opacity: "toggle" } +}, function( name, props ) { + jQuery.fn[ name ] = function( speed, easing, callback ) { + return this.animate( props, speed, easing, callback ); + }; +} ); + +jQuery.timers = []; +jQuery.fx.tick = function() { + var timer, + i = 0, + timers = jQuery.timers; + + fxNow = Date.now(); + + for ( ; i < timers.length; i++ ) { + timer = timers[ i ]; + + // Run the timer and safely remove it when done (allowing for external removal) + if ( !timer() && timers[ i ] === timer ) { + timers.splice( i--, 1 ); + } + } + + if ( !timers.length ) { + jQuery.fx.stop(); + } + fxNow = undefined; +}; + +jQuery.fx.timer = function( timer ) { + jQuery.timers.push( timer ); + jQuery.fx.start(); +}; + +jQuery.fx.interval = 13; +jQuery.fx.start = function() { + if ( inProgress ) { + return; + } + + inProgress = true; + schedule(); +}; + +jQuery.fx.stop = function() { + inProgress = null; +}; + +jQuery.fx.speeds = { + slow: 600, + fast: 200, + + // Default speed + _default: 400 +}; + + +// Based off of the plugin by Clint Helfers, with permission. +// https://web.archive.org/web/20100324014747/http://blindsignals.com/index.php/2009/07/jquery-delay/ +jQuery.fn.delay = function( time, type ) { + time = jQuery.fx ? jQuery.fx.speeds[ time ] || time : time; + type = type || "fx"; + + return this.queue( type, function( next, hooks ) { + var timeout = window.setTimeout( next, time ); + hooks.stop = function() { + window.clearTimeout( timeout ); + }; + } ); +}; + + +( function() { + var input = document.createElement( "input" ), + select = document.createElement( "select" ), + opt = select.appendChild( document.createElement( "option" ) ); + + input.type = "checkbox"; + + // Support: Android <=4.3 only + // Default value for a checkbox should be "on" + support.checkOn = input.value !== ""; + + // Support: IE <=11 only + // Must access selectedIndex to make default options select + support.optSelected = opt.selected; + + // Support: IE <=11 only + // An input loses its value after becoming a radio + input = document.createElement( "input" ); + input.value = "t"; + input.type = "radio"; + support.radioValue = input.value === "t"; +} )(); + + +var boolHook, + attrHandle = jQuery.expr.attrHandle; + +jQuery.fn.extend( { + attr: function( name, value ) { + return access( this, jQuery.attr, name, value, arguments.length > 1 ); + }, + + removeAttr: function( name ) { + return this.each( function() { + jQuery.removeAttr( this, name ); + } ); + } +} ); + +jQuery.extend( { + attr: function( elem, name, value ) { + var ret, hooks, + nType = elem.nodeType; + + // Don't get/set attributes on text, comment and attribute nodes + if ( nType === 3 || nType === 8 || nType === 2 ) { + return; + } + + // Fallback to prop when attributes are not supported + if ( typeof elem.getAttribute === "undefined" ) { + return jQuery.prop( elem, name, value ); + } + + // Attribute hooks are determined by the lowercase version + // Grab necessary hook if one is defined + if ( nType !== 1 || !jQuery.isXMLDoc( elem ) ) { + hooks = jQuery.attrHooks[ name.toLowerCase() ] || + ( jQuery.expr.match.bool.test( name ) ? boolHook : undefined ); + } + + if ( value !== undefined ) { + if ( value === null ) { + jQuery.removeAttr( elem, name ); + return; + } + + if ( hooks && "set" in hooks && + ( ret = hooks.set( elem, value, name ) ) !== undefined ) { + return ret; + } + + elem.setAttribute( name, value + "" ); + return value; + } + + if ( hooks && "get" in hooks && ( ret = hooks.get( elem, name ) ) !== null ) { + return ret; + } + + ret = jQuery.find.attr( elem, name ); + + // Non-existent attributes return null, we normalize to undefined + return ret == null ? undefined : ret; + }, + + attrHooks: { + type: { + set: function( elem, value ) { + if ( !support.radioValue && value === "radio" && + nodeName( elem, "input" ) ) { + var val = elem.value; + elem.setAttribute( "type", value ); + if ( val ) { + elem.value = val; + } + return value; + } + } + } + }, + + removeAttr: function( elem, value ) { + var name, + i = 0, + + // Attribute names can contain non-HTML whitespace characters + // https://html.spec.whatwg.org/multipage/syntax.html#attributes-2 + attrNames = value && value.match( rnothtmlwhite ); + + if ( attrNames && elem.nodeType === 1 ) { + while ( ( name = attrNames[ i++ ] ) ) { + elem.removeAttribute( name ); + } + } + } +} ); + +// Hooks for boolean attributes +boolHook = { + set: function( elem, value, name ) { + if ( value === false ) { + + // Remove boolean attributes when set to false + jQuery.removeAttr( elem, name ); + } else { + elem.setAttribute( name, name ); + } + return name; + } +}; + +jQuery.each( jQuery.expr.match.bool.source.match( /\w+/g ), function( _i, name ) { + var getter = attrHandle[ name ] || jQuery.find.attr; + + attrHandle[ name ] = function( elem, name, isXML ) { + var ret, handle, + lowercaseName = name.toLowerCase(); + + if ( !isXML ) { + + // Avoid an infinite loop by temporarily removing this function from the getter + handle = attrHandle[ lowercaseName ]; + attrHandle[ lowercaseName ] = ret; + ret = getter( elem, name, isXML ) != null ? + lowercaseName : + null; + attrHandle[ lowercaseName ] = handle; + } + return ret; + }; +} ); + + + + +var rfocusable = /^(?:input|select|textarea|button)$/i, + rclickable = /^(?:a|area)$/i; + +jQuery.fn.extend( { + prop: function( name, value ) { + return access( this, jQuery.prop, name, value, arguments.length > 1 ); + }, + + removeProp: function( name ) { + return this.each( function() { + delete this[ jQuery.propFix[ name ] || name ]; + } ); + } +} ); + +jQuery.extend( { + prop: function( elem, name, value ) { + var ret, hooks, + nType = elem.nodeType; + + // Don't get/set properties on text, comment and attribute nodes + if ( nType === 3 || nType === 8 || nType === 2 ) { + return; + } + + if ( nType !== 1 || !jQuery.isXMLDoc( elem ) ) { + + // Fix name and attach hooks + name = jQuery.propFix[ name ] || name; + hooks = jQuery.propHooks[ name ]; + } + + if ( value !== undefined ) { + if ( hooks && "set" in hooks && + ( ret = hooks.set( elem, value, name ) ) !== undefined ) { + return ret; + } + + return ( elem[ name ] = value ); + } + + if ( hooks && "get" in hooks && ( ret = hooks.get( elem, name ) ) !== null ) { + return ret; + } + + return elem[ name ]; + }, + + propHooks: { + tabIndex: { + get: function( elem ) { + + // Support: IE <=9 - 11 only + // elem.tabIndex doesn't always return the + // correct value when it hasn't been explicitly set + // https://web.archive.org/web/20141116233347/http://fluidproject.org/blog/2008/01/09/getting-setting-and-removing-tabindex-values-with-javascript/ + // Use proper attribute retrieval(#12072) + var tabindex = jQuery.find.attr( elem, "tabindex" ); + + if ( tabindex ) { + return parseInt( tabindex, 10 ); + } + + if ( + rfocusable.test( elem.nodeName ) || + rclickable.test( elem.nodeName ) && + elem.href + ) { + return 0; + } + + return -1; + } + } + }, + + propFix: { + "for": "htmlFor", + "class": "className" + } +} ); + +// Support: IE <=11 only +// Accessing the selectedIndex property +// forces the browser to respect setting selected +// on the option +// The getter ensures a default option is selected +// when in an optgroup +// eslint rule "no-unused-expressions" is disabled for this code +// since it considers such accessions noop +if ( !support.optSelected ) { + jQuery.propHooks.selected = { + get: function( elem ) { + + /* eslint no-unused-expressions: "off" */ + + var parent = elem.parentNode; + if ( parent && parent.parentNode ) { + parent.parentNode.selectedIndex; + } + return null; + }, + set: function( elem ) { + + /* eslint no-unused-expressions: "off" */ + + var parent = elem.parentNode; + if ( parent ) { + parent.selectedIndex; + + if ( parent.parentNode ) { + parent.parentNode.selectedIndex; + } + } + } + }; +} + +jQuery.each( [ + "tabIndex", + "readOnly", + "maxLength", + "cellSpacing", + "cellPadding", + "rowSpan", + "colSpan", + "useMap", + "frameBorder", + "contentEditable" +], function() { + jQuery.propFix[ this.toLowerCase() ] = this; +} ); + + + + + // Strip and collapse whitespace according to HTML spec + // https://infra.spec.whatwg.org/#strip-and-collapse-ascii-whitespace + function stripAndCollapse( value ) { + var tokens = value.match( rnothtmlwhite ) || []; + return tokens.join( " " ); + } + + +function getClass( elem ) { + return elem.getAttribute && elem.getAttribute( "class" ) || ""; +} + +function classesToArray( value ) { + if ( Array.isArray( value ) ) { + return value; + } + if ( typeof value === "string" ) { + return value.match( rnothtmlwhite ) || []; + } + return []; +} + +jQuery.fn.extend( { + addClass: function( value ) { + var classes, elem, cur, curValue, clazz, j, finalValue, + i = 0; + + if ( isFunction( value ) ) { + return this.each( function( j ) { + jQuery( this ).addClass( value.call( this, j, getClass( this ) ) ); + } ); + } + + classes = classesToArray( value ); + + if ( classes.length ) { + while ( ( elem = this[ i++ ] ) ) { + curValue = getClass( elem ); + cur = elem.nodeType === 1 && ( " " + stripAndCollapse( curValue ) + " " ); + + if ( cur ) { + j = 0; + while ( ( clazz = classes[ j++ ] ) ) { + if ( cur.indexOf( " " + clazz + " " ) < 0 ) { + cur += clazz + " "; + } + } + + // Only assign if different to avoid unneeded rendering. + finalValue = stripAndCollapse( cur ); + if ( curValue !== finalValue ) { + elem.setAttribute( "class", finalValue ); + } + } + } + } + + return this; + }, + + removeClass: function( value ) { + var classes, elem, cur, curValue, clazz, j, finalValue, + i = 0; + + if ( isFunction( value ) ) { + return this.each( function( j ) { + jQuery( this ).removeClass( value.call( this, j, getClass( this ) ) ); + } ); + } + + if ( !arguments.length ) { + return this.attr( "class", "" ); + } + + classes = classesToArray( value ); + + if ( classes.length ) { + while ( ( elem = this[ i++ ] ) ) { + curValue = getClass( elem ); + + // This expression is here for better compressibility (see addClass) + cur = elem.nodeType === 1 && ( " " + stripAndCollapse( curValue ) + " " ); + + if ( cur ) { + j = 0; + while ( ( clazz = classes[ j++ ] ) ) { + + // Remove *all* instances + while ( cur.indexOf( " " + clazz + " " ) > -1 ) { + cur = cur.replace( " " + clazz + " ", " " ); + } + } + + // Only assign if different to avoid unneeded rendering. + finalValue = stripAndCollapse( cur ); + if ( curValue !== finalValue ) { + elem.setAttribute( "class", finalValue ); + } + } + } + } + + return this; + }, + + toggleClass: function( value, stateVal ) { + var type = typeof value, + isValidValue = type === "string" || Array.isArray( value ); + + if ( typeof stateVal === "boolean" && isValidValue ) { + return stateVal ? this.addClass( value ) : this.removeClass( value ); + } + + if ( isFunction( value ) ) { + return this.each( function( i ) { + jQuery( this ).toggleClass( + value.call( this, i, getClass( this ), stateVal ), + stateVal + ); + } ); + } + + return this.each( function() { + var className, i, self, classNames; + + if ( isValidValue ) { + + // Toggle individual class names + i = 0; + self = jQuery( this ); + classNames = classesToArray( value ); + + while ( ( className = classNames[ i++ ] ) ) { + + // Check each className given, space separated list + if ( self.hasClass( className ) ) { + self.removeClass( className ); + } else { + self.addClass( className ); + } + } + + // Toggle whole class name + } else if ( value === undefined || type === "boolean" ) { + className = getClass( this ); + if ( className ) { + + // Store className if set + dataPriv.set( this, "__className__", className ); + } + + // If the element has a class name or if we're passed `false`, + // then remove the whole classname (if there was one, the above saved it). + // Otherwise bring back whatever was previously saved (if anything), + // falling back to the empty string if nothing was stored. + if ( this.setAttribute ) { + this.setAttribute( "class", + className || value === false ? + "" : + dataPriv.get( this, "__className__" ) || "" + ); + } + } + } ); + }, + + hasClass: function( selector ) { + var className, elem, + i = 0; + + className = " " + selector + " "; + while ( ( elem = this[ i++ ] ) ) { + if ( elem.nodeType === 1 && + ( " " + stripAndCollapse( getClass( elem ) ) + " " ).indexOf( className ) > -1 ) { + return true; + } + } + + return false; + } +} ); + + + + +var rreturn = /\r/g; + +jQuery.fn.extend( { + val: function( value ) { + var hooks, ret, valueIsFunction, + elem = this[ 0 ]; + + if ( !arguments.length ) { + if ( elem ) { + hooks = jQuery.valHooks[ elem.type ] || + jQuery.valHooks[ elem.nodeName.toLowerCase() ]; + + if ( hooks && + "get" in hooks && + ( ret = hooks.get( elem, "value" ) ) !== undefined + ) { + return ret; + } + + ret = elem.value; + + // Handle most common string cases + if ( typeof ret === "string" ) { + return ret.replace( rreturn, "" ); + } + + // Handle cases where value is null/undef or number + return ret == null ? "" : ret; + } + + return; + } + + valueIsFunction = isFunction( value ); + + return this.each( function( i ) { + var val; + + if ( this.nodeType !== 1 ) { + return; + } + + if ( valueIsFunction ) { + val = value.call( this, i, jQuery( this ).val() ); + } else { + val = value; + } + + // Treat null/undefined as ""; convert numbers to string + if ( val == null ) { + val = ""; + + } else if ( typeof val === "number" ) { + val += ""; + + } else if ( Array.isArray( val ) ) { + val = jQuery.map( val, function( value ) { + return value == null ? "" : value + ""; + } ); + } + + hooks = jQuery.valHooks[ this.type ] || jQuery.valHooks[ this.nodeName.toLowerCase() ]; + + // If set returns undefined, fall back to normal setting + if ( !hooks || !( "set" in hooks ) || hooks.set( this, val, "value" ) === undefined ) { + this.value = val; + } + } ); + } +} ); + +jQuery.extend( { + valHooks: { + option: { + get: function( elem ) { + + var val = jQuery.find.attr( elem, "value" ); + return val != null ? + val : + + // Support: IE <=10 - 11 only + // option.text throws exceptions (#14686, #14858) + // Strip and collapse whitespace + // https://html.spec.whatwg.org/#strip-and-collapse-whitespace + stripAndCollapse( jQuery.text( elem ) ); + } + }, + select: { + get: function( elem ) { + var value, option, i, + options = elem.options, + index = elem.selectedIndex, + one = elem.type === "select-one", + values = one ? null : [], + max = one ? index + 1 : options.length; + + if ( index < 0 ) { + i = max; + + } else { + i = one ? index : 0; + } + + // Loop through all the selected options + for ( ; i < max; i++ ) { + option = options[ i ]; + + // Support: IE <=9 only + // IE8-9 doesn't update selected after form reset (#2551) + if ( ( option.selected || i === index ) && + + // Don't return options that are disabled or in a disabled optgroup + !option.disabled && + ( !option.parentNode.disabled || + !nodeName( option.parentNode, "optgroup" ) ) ) { + + // Get the specific value for the option + value = jQuery( option ).val(); + + // We don't need an array for one selects + if ( one ) { + return value; + } + + // Multi-Selects return an array + values.push( value ); + } + } + + return values; + }, + + set: function( elem, value ) { + var optionSet, option, + options = elem.options, + values = jQuery.makeArray( value ), + i = options.length; + + while ( i-- ) { + option = options[ i ]; + + /* eslint-disable no-cond-assign */ + + if ( option.selected = + jQuery.inArray( jQuery.valHooks.option.get( option ), values ) > -1 + ) { + optionSet = true; + } + + /* eslint-enable no-cond-assign */ + } + + // Force browsers to behave consistently when non-matching value is set + if ( !optionSet ) { + elem.selectedIndex = -1; + } + return values; + } + } + } +} ); + +// Radios and checkboxes getter/setter +jQuery.each( [ "radio", "checkbox" ], function() { + jQuery.valHooks[ this ] = { + set: function( elem, value ) { + if ( Array.isArray( value ) ) { + return ( elem.checked = jQuery.inArray( jQuery( elem ).val(), value ) > -1 ); + } + } + }; + if ( !support.checkOn ) { + jQuery.valHooks[ this ].get = function( elem ) { + return elem.getAttribute( "value" ) === null ? "on" : elem.value; + }; + } +} ); + + + + +// Return jQuery for attributes-only inclusion + + +support.focusin = "onfocusin" in window; + + +var rfocusMorph = /^(?:focusinfocus|focusoutblur)$/, + stopPropagationCallback = function( e ) { + e.stopPropagation(); + }; + +jQuery.extend( jQuery.event, { + + trigger: function( event, data, elem, onlyHandlers ) { + + var i, cur, tmp, bubbleType, ontype, handle, special, lastElement, + eventPath = [ elem || document ], + type = hasOwn.call( event, "type" ) ? event.type : event, + namespaces = hasOwn.call( event, "namespace" ) ? event.namespace.split( "." ) : []; + + cur = lastElement = tmp = elem = elem || document; + + // Don't do events on text and comment nodes + if ( elem.nodeType === 3 || elem.nodeType === 8 ) { + return; + } + + // focus/blur morphs to focusin/out; ensure we're not firing them right now + if ( rfocusMorph.test( type + jQuery.event.triggered ) ) { + return; + } + + if ( type.indexOf( "." ) > -1 ) { + + // Namespaced trigger; create a regexp to match event type in handle() + namespaces = type.split( "." ); + type = namespaces.shift(); + namespaces.sort(); + } + ontype = type.indexOf( ":" ) < 0 && "on" + type; + + // Caller can pass in a jQuery.Event object, Object, or just an event type string + event = event[ jQuery.expando ] ? + event : + new jQuery.Event( type, typeof event === "object" && event ); + + // Trigger bitmask: & 1 for native handlers; & 2 for jQuery (always true) + event.isTrigger = onlyHandlers ? 2 : 3; + event.namespace = namespaces.join( "." ); + event.rnamespace = event.namespace ? + new RegExp( "(^|\\.)" + namespaces.join( "\\.(?:.*\\.|)" ) + "(\\.|$)" ) : + null; + + // Clean up the event in case it is being reused + event.result = undefined; + if ( !event.target ) { + event.target = elem; + } + + // Clone any incoming data and prepend the event, creating the handler arg list + data = data == null ? + [ event ] : + jQuery.makeArray( data, [ event ] ); + + // Allow special events to draw outside the lines + special = jQuery.event.special[ type ] || {}; + if ( !onlyHandlers && special.trigger && special.trigger.apply( elem, data ) === false ) { + return; + } + + // Determine event propagation path in advance, per W3C events spec (#9951) + // Bubble up to document, then to window; watch for a global ownerDocument var (#9724) + if ( !onlyHandlers && !special.noBubble && !isWindow( elem ) ) { + + bubbleType = special.delegateType || type; + if ( !rfocusMorph.test( bubbleType + type ) ) { + cur = cur.parentNode; + } + for ( ; cur; cur = cur.parentNode ) { + eventPath.push( cur ); + tmp = cur; + } + + // Only add window if we got to document (e.g., not plain obj or detached DOM) + if ( tmp === ( elem.ownerDocument || document ) ) { + eventPath.push( tmp.defaultView || tmp.parentWindow || window ); + } + } + + // Fire handlers on the event path + i = 0; + while ( ( cur = eventPath[ i++ ] ) && !event.isPropagationStopped() ) { + lastElement = cur; + event.type = i > 1 ? + bubbleType : + special.bindType || type; + + // jQuery handler + handle = ( dataPriv.get( cur, "events" ) || Object.create( null ) )[ event.type ] && + dataPriv.get( cur, "handle" ); + if ( handle ) { + handle.apply( cur, data ); + } + + // Native handler + handle = ontype && cur[ ontype ]; + if ( handle && handle.apply && acceptData( cur ) ) { + event.result = handle.apply( cur, data ); + if ( event.result === false ) { + event.preventDefault(); + } + } + } + event.type = type; + + // If nobody prevented the default action, do it now + if ( !onlyHandlers && !event.isDefaultPrevented() ) { + + if ( ( !special._default || + special._default.apply( eventPath.pop(), data ) === false ) && + acceptData( elem ) ) { + + // Call a native DOM method on the target with the same name as the event. + // Don't do default actions on window, that's where global variables be (#6170) + if ( ontype && isFunction( elem[ type ] ) && !isWindow( elem ) ) { + + // Don't re-trigger an onFOO event when we call its FOO() method + tmp = elem[ ontype ]; + + if ( tmp ) { + elem[ ontype ] = null; + } + + // Prevent re-triggering of the same event, since we already bubbled it above + jQuery.event.triggered = type; + + if ( event.isPropagationStopped() ) { + lastElement.addEventListener( type, stopPropagationCallback ); + } + + elem[ type ](); + + if ( event.isPropagationStopped() ) { + lastElement.removeEventListener( type, stopPropagationCallback ); + } + + jQuery.event.triggered = undefined; + + if ( tmp ) { + elem[ ontype ] = tmp; + } + } + } + } + + return event.result; + }, + + // Piggyback on a donor event to simulate a different one + // Used only for `focus(in | out)` events + simulate: function( type, elem, event ) { + var e = jQuery.extend( + new jQuery.Event(), + event, + { + type: type, + isSimulated: true + } + ); + + jQuery.event.trigger( e, null, elem ); + } + +} ); + +jQuery.fn.extend( { + + trigger: function( type, data ) { + return this.each( function() { + jQuery.event.trigger( type, data, this ); + } ); + }, + triggerHandler: function( type, data ) { + var elem = this[ 0 ]; + if ( elem ) { + return jQuery.event.trigger( type, data, elem, true ); + } + } +} ); + + +// Support: Firefox <=44 +// Firefox doesn't have focus(in | out) events +// Related ticket - https://bugzilla.mozilla.org/show_bug.cgi?id=687787 +// +// Support: Chrome <=48 - 49, Safari <=9.0 - 9.1 +// focus(in | out) events fire after focus & blur events, +// which is spec violation - http://www.w3.org/TR/DOM-Level-3-Events/#events-focusevent-event-order +// Related ticket - https://bugs.chromium.org/p/chromium/issues/detail?id=449857 +if ( !support.focusin ) { + jQuery.each( { focus: "focusin", blur: "focusout" }, function( orig, fix ) { + + // Attach a single capturing handler on the document while someone wants focusin/focusout + var handler = function( event ) { + jQuery.event.simulate( fix, event.target, jQuery.event.fix( event ) ); + }; + + jQuery.event.special[ fix ] = { + setup: function() { + + // Handle: regular nodes (via `this.ownerDocument`), window + // (via `this.document`) & document (via `this`). + var doc = this.ownerDocument || this.document || this, + attaches = dataPriv.access( doc, fix ); + + if ( !attaches ) { + doc.addEventListener( orig, handler, true ); + } + dataPriv.access( doc, fix, ( attaches || 0 ) + 1 ); + }, + teardown: function() { + var doc = this.ownerDocument || this.document || this, + attaches = dataPriv.access( doc, fix ) - 1; + + if ( !attaches ) { + doc.removeEventListener( orig, handler, true ); + dataPriv.remove( doc, fix ); + + } else { + dataPriv.access( doc, fix, attaches ); + } + } + }; + } ); +} +var location = window.location; + +var nonce = { guid: Date.now() }; + +var rquery = ( /\?/ ); + + + +// Cross-browser xml parsing +jQuery.parseXML = function( data ) { + var xml, parserErrorElem; + if ( !data || typeof data !== "string" ) { + return null; + } + + // Support: IE 9 - 11 only + // IE throws on parseFromString with invalid input. + try { + xml = ( new window.DOMParser() ).parseFromString( data, "text/xml" ); + } catch ( e ) {} + + parserErrorElem = xml && xml.getElementsByTagName( "parsererror" )[ 0 ]; + if ( !xml || parserErrorElem ) { + jQuery.error( "Invalid XML: " + ( + parserErrorElem ? + jQuery.map( parserErrorElem.childNodes, function( el ) { + return el.textContent; + } ).join( "\n" ) : + data + ) ); + } + return xml; +}; + + +var + rbracket = /\[\]$/, + rCRLF = /\r?\n/g, + rsubmitterTypes = /^(?:submit|button|image|reset|file)$/i, + rsubmittable = /^(?:input|select|textarea|keygen)/i; + +function buildParams( prefix, obj, traditional, add ) { + var name; + + if ( Array.isArray( obj ) ) { + + // Serialize array item. + jQuery.each( obj, function( i, v ) { + if ( traditional || rbracket.test( prefix ) ) { + + // Treat each array item as a scalar. + add( prefix, v ); + + } else { + + // Item is non-scalar (array or object), encode its numeric index. + buildParams( + prefix + "[" + ( typeof v === "object" && v != null ? i : "" ) + "]", + v, + traditional, + add + ); + } + } ); + + } else if ( !traditional && toType( obj ) === "object" ) { + + // Serialize object item. + for ( name in obj ) { + buildParams( prefix + "[" + name + "]", obj[ name ], traditional, add ); + } + + } else { + + // Serialize scalar item. + add( prefix, obj ); + } +} + +// Serialize an array of form elements or a set of +// key/values into a query string +jQuery.param = function( a, traditional ) { + var prefix, + s = [], + add = function( key, valueOrFunction ) { + + // If value is a function, invoke it and use its return value + var value = isFunction( valueOrFunction ) ? + valueOrFunction() : + valueOrFunction; + + s[ s.length ] = encodeURIComponent( key ) + "=" + + encodeURIComponent( value == null ? "" : value ); + }; + + if ( a == null ) { + return ""; + } + + // If an array was passed in, assume that it is an array of form elements. + if ( Array.isArray( a ) || ( a.jquery && !jQuery.isPlainObject( a ) ) ) { + + // Serialize the form elements + jQuery.each( a, function() { + add( this.name, this.value ); + } ); + + } else { + + // If traditional, encode the "old" way (the way 1.3.2 or older + // did it), otherwise encode params recursively. + for ( prefix in a ) { + buildParams( prefix, a[ prefix ], traditional, add ); + } + } + + // Return the resulting serialization + return s.join( "&" ); +}; + +jQuery.fn.extend( { + serialize: function() { + return jQuery.param( this.serializeArray() ); + }, + serializeArray: function() { + return this.map( function() { + + // Can add propHook for "elements" to filter or add form elements + var elements = jQuery.prop( this, "elements" ); + return elements ? jQuery.makeArray( elements ) : this; + } ).filter( function() { + var type = this.type; + + // Use .is( ":disabled" ) so that fieldset[disabled] works + return this.name && !jQuery( this ).is( ":disabled" ) && + rsubmittable.test( this.nodeName ) && !rsubmitterTypes.test( type ) && + ( this.checked || !rcheckableType.test( type ) ); + } ).map( function( _i, elem ) { + var val = jQuery( this ).val(); + + if ( val == null ) { + return null; + } + + if ( Array.isArray( val ) ) { + return jQuery.map( val, function( val ) { + return { name: elem.name, value: val.replace( rCRLF, "\r\n" ) }; + } ); + } + + return { name: elem.name, value: val.replace( rCRLF, "\r\n" ) }; + } ).get(); + } +} ); + + +var + r20 = /%20/g, + rhash = /#.*$/, + rantiCache = /([?&])_=[^&]*/, + rheaders = /^(.*?):[ \t]*([^\r\n]*)$/mg, + + // #7653, #8125, #8152: local protocol detection + rlocalProtocol = /^(?:about|app|app-storage|.+-extension|file|res|widget):$/, + rnoContent = /^(?:GET|HEAD)$/, + rprotocol = /^\/\//, + + /* Prefilters + * 1) They are useful to introduce custom dataTypes (see ajax/jsonp.js for an example) + * 2) These are called: + * - BEFORE asking for a transport + * - AFTER param serialization (s.data is a string if s.processData is true) + * 3) key is the dataType + * 4) the catchall symbol "*" can be used + * 5) execution will start with transport dataType and THEN continue down to "*" if needed + */ + prefilters = {}, + + /* Transports bindings + * 1) key is the dataType + * 2) the catchall symbol "*" can be used + * 3) selection will start with transport dataType and THEN go to "*" if needed + */ + transports = {}, + + // Avoid comment-prolog char sequence (#10098); must appease lint and evade compression + allTypes = "*/".concat( "*" ), + + // Anchor tag for parsing the document origin + originAnchor = document.createElement( "a" ); + +originAnchor.href = location.href; + +// Base "constructor" for jQuery.ajaxPrefilter and jQuery.ajaxTransport +function addToPrefiltersOrTransports( structure ) { + + // dataTypeExpression is optional and defaults to "*" + return function( dataTypeExpression, func ) { + + if ( typeof dataTypeExpression !== "string" ) { + func = dataTypeExpression; + dataTypeExpression = "*"; + } + + var dataType, + i = 0, + dataTypes = dataTypeExpression.toLowerCase().match( rnothtmlwhite ) || []; + + if ( isFunction( func ) ) { + + // For each dataType in the dataTypeExpression + while ( ( dataType = dataTypes[ i++ ] ) ) { + + // Prepend if requested + if ( dataType[ 0 ] === "+" ) { + dataType = dataType.slice( 1 ) || "*"; + ( structure[ dataType ] = structure[ dataType ] || [] ).unshift( func ); + + // Otherwise append + } else { + ( structure[ dataType ] = structure[ dataType ] || [] ).push( func ); + } + } + } + }; +} + +// Base inspection function for prefilters and transports +function inspectPrefiltersOrTransports( structure, options, originalOptions, jqXHR ) { + + var inspected = {}, + seekingTransport = ( structure === transports ); + + function inspect( dataType ) { + var selected; + inspected[ dataType ] = true; + jQuery.each( structure[ dataType ] || [], function( _, prefilterOrFactory ) { + var dataTypeOrTransport = prefilterOrFactory( options, originalOptions, jqXHR ); + if ( typeof dataTypeOrTransport === "string" && + !seekingTransport && !inspected[ dataTypeOrTransport ] ) { + + options.dataTypes.unshift( dataTypeOrTransport ); + inspect( dataTypeOrTransport ); + return false; + } else if ( seekingTransport ) { + return !( selected = dataTypeOrTransport ); + } + } ); + return selected; + } + + return inspect( options.dataTypes[ 0 ] ) || !inspected[ "*" ] && inspect( "*" ); +} + +// A special extend for ajax options +// that takes "flat" options (not to be deep extended) +// Fixes #9887 +function ajaxExtend( target, src ) { + var key, deep, + flatOptions = jQuery.ajaxSettings.flatOptions || {}; + + for ( key in src ) { + if ( src[ key ] !== undefined ) { + ( flatOptions[ key ] ? target : ( deep || ( deep = {} ) ) )[ key ] = src[ key ]; + } + } + if ( deep ) { + jQuery.extend( true, target, deep ); + } + + return target; +} + +/* Handles responses to an ajax request: + * - finds the right dataType (mediates between content-type and expected dataType) + * - returns the corresponding response + */ +function ajaxHandleResponses( s, jqXHR, responses ) { + + var ct, type, finalDataType, firstDataType, + contents = s.contents, + dataTypes = s.dataTypes; + + // Remove auto dataType and get content-type in the process + while ( dataTypes[ 0 ] === "*" ) { + dataTypes.shift(); + if ( ct === undefined ) { + ct = s.mimeType || jqXHR.getResponseHeader( "Content-Type" ); + } + } + + // Check if we're dealing with a known content-type + if ( ct ) { + for ( type in contents ) { + if ( contents[ type ] && contents[ type ].test( ct ) ) { + dataTypes.unshift( type ); + break; + } + } + } + + // Check to see if we have a response for the expected dataType + if ( dataTypes[ 0 ] in responses ) { + finalDataType = dataTypes[ 0 ]; + } else { + + // Try convertible dataTypes + for ( type in responses ) { + if ( !dataTypes[ 0 ] || s.converters[ type + " " + dataTypes[ 0 ] ] ) { + finalDataType = type; + break; + } + if ( !firstDataType ) { + firstDataType = type; + } + } + + // Or just use first one + finalDataType = finalDataType || firstDataType; + } + + // If we found a dataType + // We add the dataType to the list if needed + // and return the corresponding response + if ( finalDataType ) { + if ( finalDataType !== dataTypes[ 0 ] ) { + dataTypes.unshift( finalDataType ); + } + return responses[ finalDataType ]; + } +} + +/* Chain conversions given the request and the original response + * Also sets the responseXXX fields on the jqXHR instance + */ +function ajaxConvert( s, response, jqXHR, isSuccess ) { + var conv2, current, conv, tmp, prev, + converters = {}, + + // Work with a copy of dataTypes in case we need to modify it for conversion + dataTypes = s.dataTypes.slice(); + + // Create converters map with lowercased keys + if ( dataTypes[ 1 ] ) { + for ( conv in s.converters ) { + converters[ conv.toLowerCase() ] = s.converters[ conv ]; + } + } + + current = dataTypes.shift(); + + // Convert to each sequential dataType + while ( current ) { + + if ( s.responseFields[ current ] ) { + jqXHR[ s.responseFields[ current ] ] = response; + } + + // Apply the dataFilter if provided + if ( !prev && isSuccess && s.dataFilter ) { + response = s.dataFilter( response, s.dataType ); + } + + prev = current; + current = dataTypes.shift(); + + if ( current ) { + + // There's only work to do if current dataType is non-auto + if ( current === "*" ) { + + current = prev; + + // Convert response if prev dataType is non-auto and differs from current + } else if ( prev !== "*" && prev !== current ) { + + // Seek a direct converter + conv = converters[ prev + " " + current ] || converters[ "* " + current ]; + + // If none found, seek a pair + if ( !conv ) { + for ( conv2 in converters ) { + + // If conv2 outputs current + tmp = conv2.split( " " ); + if ( tmp[ 1 ] === current ) { + + // If prev can be converted to accepted input + conv = converters[ prev + " " + tmp[ 0 ] ] || + converters[ "* " + tmp[ 0 ] ]; + if ( conv ) { + + // Condense equivalence converters + if ( conv === true ) { + conv = converters[ conv2 ]; + + // Otherwise, insert the intermediate dataType + } else if ( converters[ conv2 ] !== true ) { + current = tmp[ 0 ]; + dataTypes.unshift( tmp[ 1 ] ); + } + break; + } + } + } + } + + // Apply converter (if not an equivalence) + if ( conv !== true ) { + + // Unless errors are allowed to bubble, catch and return them + if ( conv && s.throws ) { + response = conv( response ); + } else { + try { + response = conv( response ); + } catch ( e ) { + return { + state: "parsererror", + error: conv ? e : "No conversion from " + prev + " to " + current + }; + } + } + } + } + } + } + + return { state: "success", data: response }; +} + +jQuery.extend( { + + // Counter for holding the number of active queries + active: 0, + + // Last-Modified header cache for next request + lastModified: {}, + etag: {}, + + ajaxSettings: { + url: location.href, + type: "GET", + isLocal: rlocalProtocol.test( location.protocol ), + global: true, + processData: true, + async: true, + contentType: "application/x-www-form-urlencoded; charset=UTF-8", + + /* + timeout: 0, + data: null, + dataType: null, + username: null, + password: null, + cache: null, + throws: false, + traditional: false, + headers: {}, + */ + + accepts: { + "*": allTypes, + text: "text/plain", + html: "text/html", + xml: "application/xml, text/xml", + json: "application/json, text/javascript" + }, + + contents: { + xml: /\bxml\b/, + html: /\bhtml/, + json: /\bjson\b/ + }, + + responseFields: { + xml: "responseXML", + text: "responseText", + json: "responseJSON" + }, + + // Data converters + // Keys separate source (or catchall "*") and destination types with a single space + converters: { + + // Convert anything to text + "* text": String, + + // Text to html (true = no transformation) + "text html": true, + + // Evaluate text as a json expression + "text json": JSON.parse, + + // Parse text as xml + "text xml": jQuery.parseXML + }, + + // For options that shouldn't be deep extended: + // you can add your own custom options here if + // and when you create one that shouldn't be + // deep extended (see ajaxExtend) + flatOptions: { + url: true, + context: true + } + }, + + // Creates a full fledged settings object into target + // with both ajaxSettings and settings fields. + // If target is omitted, writes into ajaxSettings. + ajaxSetup: function( target, settings ) { + return settings ? + + // Building a settings object + ajaxExtend( ajaxExtend( target, jQuery.ajaxSettings ), settings ) : + + // Extending ajaxSettings + ajaxExtend( jQuery.ajaxSettings, target ); + }, + + ajaxPrefilter: addToPrefiltersOrTransports( prefilters ), + ajaxTransport: addToPrefiltersOrTransports( transports ), + + // Main method + ajax: function( url, options ) { + + // If url is an object, simulate pre-1.5 signature + if ( typeof url === "object" ) { + options = url; + url = undefined; + } + + // Force options to be an object + options = options || {}; + + var transport, + + // URL without anti-cache param + cacheURL, + + // Response headers + responseHeadersString, + responseHeaders, + + // timeout handle + timeoutTimer, + + // Url cleanup var + urlAnchor, + + // Request state (becomes false upon send and true upon completion) + completed, + + // To know if global events are to be dispatched + fireGlobals, + + // Loop variable + i, + + // uncached part of the url + uncached, + + // Create the final options object + s = jQuery.ajaxSetup( {}, options ), + + // Callbacks context + callbackContext = s.context || s, + + // Context for global events is callbackContext if it is a DOM node or jQuery collection + globalEventContext = s.context && + ( callbackContext.nodeType || callbackContext.jquery ) ? + jQuery( callbackContext ) : + jQuery.event, + + // Deferreds + deferred = jQuery.Deferred(), + completeDeferred = jQuery.Callbacks( "once memory" ), + + // Status-dependent callbacks + statusCode = s.statusCode || {}, + + // Headers (they are sent all at once) + requestHeaders = {}, + requestHeadersNames = {}, + + // Default abort message + strAbort = "canceled", + + // Fake xhr + jqXHR = { + readyState: 0, + + // Builds headers hashtable if needed + getResponseHeader: function( key ) { + var match; + if ( completed ) { + if ( !responseHeaders ) { + responseHeaders = {}; + while ( ( match = rheaders.exec( responseHeadersString ) ) ) { + responseHeaders[ match[ 1 ].toLowerCase() + " " ] = + ( responseHeaders[ match[ 1 ].toLowerCase() + " " ] || [] ) + .concat( match[ 2 ] ); + } + } + match = responseHeaders[ key.toLowerCase() + " " ]; + } + return match == null ? null : match.join( ", " ); + }, + + // Raw string + getAllResponseHeaders: function() { + return completed ? responseHeadersString : null; + }, + + // Caches the header + setRequestHeader: function( name, value ) { + if ( completed == null ) { + name = requestHeadersNames[ name.toLowerCase() ] = + requestHeadersNames[ name.toLowerCase() ] || name; + requestHeaders[ name ] = value; + } + return this; + }, + + // Overrides response content-type header + overrideMimeType: function( type ) { + if ( completed == null ) { + s.mimeType = type; + } + return this; + }, + + // Status-dependent callbacks + statusCode: function( map ) { + var code; + if ( map ) { + if ( completed ) { + + // Execute the appropriate callbacks + jqXHR.always( map[ jqXHR.status ] ); + } else { + + // Lazy-add the new callbacks in a way that preserves old ones + for ( code in map ) { + statusCode[ code ] = [ statusCode[ code ], map[ code ] ]; + } + } + } + return this; + }, + + // Cancel the request + abort: function( statusText ) { + var finalText = statusText || strAbort; + if ( transport ) { + transport.abort( finalText ); + } + done( 0, finalText ); + return this; + } + }; + + // Attach deferreds + deferred.promise( jqXHR ); + + // Add protocol if not provided (prefilters might expect it) + // Handle falsy url in the settings object (#10093: consistency with old signature) + // We also use the url parameter if available + s.url = ( ( url || s.url || location.href ) + "" ) + .replace( rprotocol, location.protocol + "//" ); + + // Alias method option to type as per ticket #12004 + s.type = options.method || options.type || s.method || s.type; + + // Extract dataTypes list + s.dataTypes = ( s.dataType || "*" ).toLowerCase().match( rnothtmlwhite ) || [ "" ]; + + // A cross-domain request is in order when the origin doesn't match the current origin. + if ( s.crossDomain == null ) { + urlAnchor = document.createElement( "a" ); + + // Support: IE <=8 - 11, Edge 12 - 15 + // IE throws exception on accessing the href property if url is malformed, + // e.g. http://example.com:80x/ + try { + urlAnchor.href = s.url; + + // Support: IE <=8 - 11 only + // Anchor's host property isn't correctly set when s.url is relative + urlAnchor.href = urlAnchor.href; + s.crossDomain = originAnchor.protocol + "//" + originAnchor.host !== + urlAnchor.protocol + "//" + urlAnchor.host; + } catch ( e ) { + + // If there is an error parsing the URL, assume it is crossDomain, + // it can be rejected by the transport if it is invalid + s.crossDomain = true; + } + } + + // Convert data if not already a string + if ( s.data && s.processData && typeof s.data !== "string" ) { + s.data = jQuery.param( s.data, s.traditional ); + } + + // Apply prefilters + inspectPrefiltersOrTransports( prefilters, s, options, jqXHR ); + + // If request was aborted inside a prefilter, stop there + if ( completed ) { + return jqXHR; + } + + // We can fire global events as of now if asked to + // Don't fire events if jQuery.event is undefined in an AMD-usage scenario (#15118) + fireGlobals = jQuery.event && s.global; + + // Watch for a new set of requests + if ( fireGlobals && jQuery.active++ === 0 ) { + jQuery.event.trigger( "ajaxStart" ); + } + + // Uppercase the type + s.type = s.type.toUpperCase(); + + // Determine if request has content + s.hasContent = !rnoContent.test( s.type ); + + // Save the URL in case we're toying with the If-Modified-Since + // and/or If-None-Match header later on + // Remove hash to simplify url manipulation + cacheURL = s.url.replace( rhash, "" ); + + // More options handling for requests with no content + if ( !s.hasContent ) { + + // Remember the hash so we can put it back + uncached = s.url.slice( cacheURL.length ); + + // If data is available and should be processed, append data to url + if ( s.data && ( s.processData || typeof s.data === "string" ) ) { + cacheURL += ( rquery.test( cacheURL ) ? "&" : "?" ) + s.data; + + // #9682: remove data so that it's not used in an eventual retry + delete s.data; + } + + // Add or update anti-cache param if needed + if ( s.cache === false ) { + cacheURL = cacheURL.replace( rantiCache, "$1" ); + uncached = ( rquery.test( cacheURL ) ? "&" : "?" ) + "_=" + ( nonce.guid++ ) + + uncached; + } + + // Put hash and anti-cache on the URL that will be requested (gh-1732) + s.url = cacheURL + uncached; + + // Change '%20' to '+' if this is encoded form body content (gh-2658) + } else if ( s.data && s.processData && + ( s.contentType || "" ).indexOf( "application/x-www-form-urlencoded" ) === 0 ) { + s.data = s.data.replace( r20, "+" ); + } + + // Set the If-Modified-Since and/or If-None-Match header, if in ifModified mode. + if ( s.ifModified ) { + if ( jQuery.lastModified[ cacheURL ] ) { + jqXHR.setRequestHeader( "If-Modified-Since", jQuery.lastModified[ cacheURL ] ); + } + if ( jQuery.etag[ cacheURL ] ) { + jqXHR.setRequestHeader( "If-None-Match", jQuery.etag[ cacheURL ] ); + } + } + + // Set the correct header, if data is being sent + if ( s.data && s.hasContent && s.contentType !== false || options.contentType ) { + jqXHR.setRequestHeader( "Content-Type", s.contentType ); + } + + // Set the Accepts header for the server, depending on the dataType + jqXHR.setRequestHeader( + "Accept", + s.dataTypes[ 0 ] && s.accepts[ s.dataTypes[ 0 ] ] ? + s.accepts[ s.dataTypes[ 0 ] ] + + ( s.dataTypes[ 0 ] !== "*" ? ", " + allTypes + "; q=0.01" : "" ) : + s.accepts[ "*" ] + ); + + // Check for headers option + for ( i in s.headers ) { + jqXHR.setRequestHeader( i, s.headers[ i ] ); + } + + // Allow custom headers/mimetypes and early abort + if ( s.beforeSend && + ( s.beforeSend.call( callbackContext, jqXHR, s ) === false || completed ) ) { + + // Abort if not done already and return + return jqXHR.abort(); + } + + // Aborting is no longer a cancellation + strAbort = "abort"; + + // Install callbacks on deferreds + completeDeferred.add( s.complete ); + jqXHR.done( s.success ); + jqXHR.fail( s.error ); + + // Get transport + transport = inspectPrefiltersOrTransports( transports, s, options, jqXHR ); + + // If no transport, we auto-abort + if ( !transport ) { + done( -1, "No Transport" ); + } else { + jqXHR.readyState = 1; + + // Send global event + if ( fireGlobals ) { + globalEventContext.trigger( "ajaxSend", [ jqXHR, s ] ); + } + + // If request was aborted inside ajaxSend, stop there + if ( completed ) { + return jqXHR; + } + + // Timeout + if ( s.async && s.timeout > 0 ) { + timeoutTimer = window.setTimeout( function() { + jqXHR.abort( "timeout" ); + }, s.timeout ); + } + + try { + completed = false; + transport.send( requestHeaders, done ); + } catch ( e ) { + + // Rethrow post-completion exceptions + if ( completed ) { + throw e; + } + + // Propagate others as results + done( -1, e ); + } + } + + // Callback for when everything is done + function done( status, nativeStatusText, responses, headers ) { + var isSuccess, success, error, response, modified, + statusText = nativeStatusText; + + // Ignore repeat invocations + if ( completed ) { + return; + } + + completed = true; + + // Clear timeout if it exists + if ( timeoutTimer ) { + window.clearTimeout( timeoutTimer ); + } + + // Dereference transport for early garbage collection + // (no matter how long the jqXHR object will be used) + transport = undefined; + + // Cache response headers + responseHeadersString = headers || ""; + + // Set readyState + jqXHR.readyState = status > 0 ? 4 : 0; + + // Determine if successful + isSuccess = status >= 200 && status < 300 || status === 304; + + // Get response data + if ( responses ) { + response = ajaxHandleResponses( s, jqXHR, responses ); + } + + // Use a noop converter for missing script but not if jsonp + if ( !isSuccess && + jQuery.inArray( "script", s.dataTypes ) > -1 && + jQuery.inArray( "json", s.dataTypes ) < 0 ) { + s.converters[ "text script" ] = function() {}; + } + + // Convert no matter what (that way responseXXX fields are always set) + response = ajaxConvert( s, response, jqXHR, isSuccess ); + + // If successful, handle type chaining + if ( isSuccess ) { + + // Set the If-Modified-Since and/or If-None-Match header, if in ifModified mode. + if ( s.ifModified ) { + modified = jqXHR.getResponseHeader( "Last-Modified" ); + if ( modified ) { + jQuery.lastModified[ cacheURL ] = modified; + } + modified = jqXHR.getResponseHeader( "etag" ); + if ( modified ) { + jQuery.etag[ cacheURL ] = modified; + } + } + + // if no content + if ( status === 204 || s.type === "HEAD" ) { + statusText = "nocontent"; + + // if not modified + } else if ( status === 304 ) { + statusText = "notmodified"; + + // If we have data, let's convert it + } else { + statusText = response.state; + success = response.data; + error = response.error; + isSuccess = !error; + } + } else { + + // Extract error from statusText and normalize for non-aborts + error = statusText; + if ( status || !statusText ) { + statusText = "error"; + if ( status < 0 ) { + status = 0; + } + } + } + + // Set data for the fake xhr object + jqXHR.status = status; + jqXHR.statusText = ( nativeStatusText || statusText ) + ""; + + // Success/Error + if ( isSuccess ) { + deferred.resolveWith( callbackContext, [ success, statusText, jqXHR ] ); + } else { + deferred.rejectWith( callbackContext, [ jqXHR, statusText, error ] ); + } + + // Status-dependent callbacks + jqXHR.statusCode( statusCode ); + statusCode = undefined; + + if ( fireGlobals ) { + globalEventContext.trigger( isSuccess ? "ajaxSuccess" : "ajaxError", + [ jqXHR, s, isSuccess ? success : error ] ); + } + + // Complete + completeDeferred.fireWith( callbackContext, [ jqXHR, statusText ] ); + + if ( fireGlobals ) { + globalEventContext.trigger( "ajaxComplete", [ jqXHR, s ] ); + + // Handle the global AJAX counter + if ( !( --jQuery.active ) ) { + jQuery.event.trigger( "ajaxStop" ); + } + } + } + + return jqXHR; + }, + + getJSON: function( url, data, callback ) { + return jQuery.get( url, data, callback, "json" ); + }, + + getScript: function( url, callback ) { + return jQuery.get( url, undefined, callback, "script" ); + } +} ); + +jQuery.each( [ "get", "post" ], function( _i, method ) { + jQuery[ method ] = function( url, data, callback, type ) { + + // Shift arguments if data argument was omitted + if ( isFunction( data ) ) { + type = type || callback; + callback = data; + data = undefined; + } + + // The url can be an options object (which then must have .url) + return jQuery.ajax( jQuery.extend( { + url: url, + type: method, + dataType: type, + data: data, + success: callback + }, jQuery.isPlainObject( url ) && url ) ); + }; +} ); + +jQuery.ajaxPrefilter( function( s ) { + var i; + for ( i in s.headers ) { + if ( i.toLowerCase() === "content-type" ) { + s.contentType = s.headers[ i ] || ""; + } + } +} ); + + +jQuery._evalUrl = function( url, options, doc ) { + return jQuery.ajax( { + url: url, + + // Make this explicit, since user can override this through ajaxSetup (#11264) + type: "GET", + dataType: "script", + cache: true, + async: false, + global: false, + + // Only evaluate the response if it is successful (gh-4126) + // dataFilter is not invoked for failure responses, so using it instead + // of the default converter is kludgy but it works. + converters: { + "text script": function() {} + }, + dataFilter: function( response ) { + jQuery.globalEval( response, options, doc ); + } + } ); +}; + + +jQuery.fn.extend( { + wrapAll: function( html ) { + var wrap; + + if ( this[ 0 ] ) { + if ( isFunction( html ) ) { + html = html.call( this[ 0 ] ); + } + + // The elements to wrap the target around + wrap = jQuery( html, this[ 0 ].ownerDocument ).eq( 0 ).clone( true ); + + if ( this[ 0 ].parentNode ) { + wrap.insertBefore( this[ 0 ] ); + } + + wrap.map( function() { + var elem = this; + + while ( elem.firstElementChild ) { + elem = elem.firstElementChild; + } + + return elem; + } ).append( this ); + } + + return this; + }, + + wrapInner: function( html ) { + if ( isFunction( html ) ) { + return this.each( function( i ) { + jQuery( this ).wrapInner( html.call( this, i ) ); + } ); + } + + return this.each( function() { + var self = jQuery( this ), + contents = self.contents(); + + if ( contents.length ) { + contents.wrapAll( html ); + + } else { + self.append( html ); + } + } ); + }, + + wrap: function( html ) { + var htmlIsFunction = isFunction( html ); + + return this.each( function( i ) { + jQuery( this ).wrapAll( htmlIsFunction ? html.call( this, i ) : html ); + } ); + }, + + unwrap: function( selector ) { + this.parent( selector ).not( "body" ).each( function() { + jQuery( this ).replaceWith( this.childNodes ); + } ); + return this; + } +} ); + + +jQuery.expr.pseudos.hidden = function( elem ) { + return !jQuery.expr.pseudos.visible( elem ); +}; +jQuery.expr.pseudos.visible = function( elem ) { + return !!( elem.offsetWidth || elem.offsetHeight || elem.getClientRects().length ); +}; + + + + +jQuery.ajaxSettings.xhr = function() { + try { + return new window.XMLHttpRequest(); + } catch ( e ) {} +}; + +var xhrSuccessStatus = { + + // File protocol always yields status code 0, assume 200 + 0: 200, + + // Support: IE <=9 only + // #1450: sometimes IE returns 1223 when it should be 204 + 1223: 204 + }, + xhrSupported = jQuery.ajaxSettings.xhr(); + +support.cors = !!xhrSupported && ( "withCredentials" in xhrSupported ); +support.ajax = xhrSupported = !!xhrSupported; + +jQuery.ajaxTransport( function( options ) { + var callback, errorCallback; + + // Cross domain only allowed if supported through XMLHttpRequest + if ( support.cors || xhrSupported && !options.crossDomain ) { + return { + send: function( headers, complete ) { + var i, + xhr = options.xhr(); + + xhr.open( + options.type, + options.url, + options.async, + options.username, + options.password + ); + + // Apply custom fields if provided + if ( options.xhrFields ) { + for ( i in options.xhrFields ) { + xhr[ i ] = options.xhrFields[ i ]; + } + } + + // Override mime type if needed + if ( options.mimeType && xhr.overrideMimeType ) { + xhr.overrideMimeType( options.mimeType ); + } + + // X-Requested-With header + // For cross-domain requests, seeing as conditions for a preflight are + // akin to a jigsaw puzzle, we simply never set it to be sure. + // (it can always be set on a per-request basis or even using ajaxSetup) + // For same-domain requests, won't change header if already provided. + if ( !options.crossDomain && !headers[ "X-Requested-With" ] ) { + headers[ "X-Requested-With" ] = "XMLHttpRequest"; + } + + // Set headers + for ( i in headers ) { + xhr.setRequestHeader( i, headers[ i ] ); + } + + // Callback + callback = function( type ) { + return function() { + if ( callback ) { + callback = errorCallback = xhr.onload = + xhr.onerror = xhr.onabort = xhr.ontimeout = + xhr.onreadystatechange = null; + + if ( type === "abort" ) { + xhr.abort(); + } else if ( type === "error" ) { + + // Support: IE <=9 only + // On a manual native abort, IE9 throws + // errors on any property access that is not readyState + if ( typeof xhr.status !== "number" ) { + complete( 0, "error" ); + } else { + complete( + + // File: protocol always yields status 0; see #8605, #14207 + xhr.status, + xhr.statusText + ); + } + } else { + complete( + xhrSuccessStatus[ xhr.status ] || xhr.status, + xhr.statusText, + + // Support: IE <=9 only + // IE9 has no XHR2 but throws on binary (trac-11426) + // For XHR2 non-text, let the caller handle it (gh-2498) + ( xhr.responseType || "text" ) !== "text" || + typeof xhr.responseText !== "string" ? + { binary: xhr.response } : + { text: xhr.responseText }, + xhr.getAllResponseHeaders() + ); + } + } + }; + }; + + // Listen to events + xhr.onload = callback(); + errorCallback = xhr.onerror = xhr.ontimeout = callback( "error" ); + + // Support: IE 9 only + // Use onreadystatechange to replace onabort + // to handle uncaught aborts + if ( xhr.onabort !== undefined ) { + xhr.onabort = errorCallback; + } else { + xhr.onreadystatechange = function() { + + // Check readyState before timeout as it changes + if ( xhr.readyState === 4 ) { + + // Allow onerror to be called first, + // but that will not handle a native abort + // Also, save errorCallback to a variable + // as xhr.onerror cannot be accessed + window.setTimeout( function() { + if ( callback ) { + errorCallback(); + } + } ); + } + }; + } + + // Create the abort callback + callback = callback( "abort" ); + + try { + + // Do send the request (this may raise an exception) + xhr.send( options.hasContent && options.data || null ); + } catch ( e ) { + + // #14683: Only rethrow if this hasn't been notified as an error yet + if ( callback ) { + throw e; + } + } + }, + + abort: function() { + if ( callback ) { + callback(); + } + } + }; + } +} ); + + + + +// Prevent auto-execution of scripts when no explicit dataType was provided (See gh-2432) +jQuery.ajaxPrefilter( function( s ) { + if ( s.crossDomain ) { + s.contents.script = false; + } +} ); + +// Install script dataType +jQuery.ajaxSetup( { + accepts: { + script: "text/javascript, application/javascript, " + + "application/ecmascript, application/x-ecmascript" + }, + contents: { + script: /\b(?:java|ecma)script\b/ + }, + converters: { + "text script": function( text ) { + jQuery.globalEval( text ); + return text; + } + } +} ); + +// Handle cache's special case and crossDomain +jQuery.ajaxPrefilter( "script", function( s ) { + if ( s.cache === undefined ) { + s.cache = false; + } + if ( s.crossDomain ) { + s.type = "GET"; + } +} ); + +// Bind script tag hack transport +jQuery.ajaxTransport( "script", function( s ) { + + // This transport only deals with cross domain or forced-by-attrs requests + if ( s.crossDomain || s.scriptAttrs ) { + var script, callback; + return { + send: function( _, complete ) { + script = jQuery( " - - - + + + + + + + + + + + - - + -
    -
    -
    - - - - -
    -

    -drc

    -
    -

    -Overview

    -

    Analysis of dose-response data is made available through a suite of flexible and versatile model fitting and after-fitting functions.

    +
    +
    +
    +
    +

    CRAN version Downloads License: GPL-2.0 Last commit date Contributions welcome

    +

    +drc Logo

    +
    +
    +

    drc — Dose-Response Curve Analysis in R +

    -
    -

    -Installation

    -
    ## You can install drc from GitHub
-# install.packages("devtools")
-## first installing drcData
-devtools::install_github("DoseResponse/drcData")
-## then installing the development version of drc
-devtools::install_github("DoseResponse/drc")
    +
    +

    Note +

    +

    This repository contains a refactored development version of the drc R package first published by Christian Ritz, Florent Baty, Jens C. Streibig und Daniel Gerhard (2015). Their foundational work on dose–response modeling in R is gratefully acknowledged and inspired the present refactoring.

    +

    The goal of this project is to modernize the codebase, improve maintainability, and provide a clearer development structure while preserving the core functionality of the original package.

    +

    This repository focuses on structural refactoring and development improvements. Behavior and interfaces may change as the codebase is modernized.

    +
    +
    +

    Overview +

    +

    The drc package provides a comprehensive framework for fitting, analyzing, and visualizing dose-response curves in R. It is widely used in bioassay, toxicology, pharmacology, and agricultural research to model the relationship between an exposure (e.g., concentration of a substance) or dose and a biological response.

    +

    The package offers:

    +
      +
    • +Flexible model fitting via the central drm() function, supporting multiple data types (continuous, binomial, Poisson, negative binomial, event-time, and species sensitivity distributions).
      • +
    • +40+ built-in parametric models including log-logistic, Weibull, Gompertz, Brain-Cousens, Cedergreen, and many more, each with self-starting parameter initialization.
      • +
    • +Effective dose (ED) estimation with confidence intervals (delta method, Fieller, inverse regression) through ED().
      • +
    • +Model comparison and diagnostics: ANOVA, lack-of-fit tests, Neill’s test, Box-Cox transformations, R-squared, Cook’s distance, and hat values.
      • +
    • +Multi-curve analysis: fit and compare dose-response curves across groups, compute relative potency and selectivity indices via EDcomp().
      • +
    • +Robust inference: sandwich variance estimators for heteroscedasticity-consistent standard errors.
      • +
    • +Simulation tools: generate random dose-response data for power analysis and method comparison.
      • +
    +

    For more details visit:

    +

    📖 drc github documentation
    ⚡ drc example workflow

    +

    Feature requests or ideas?

    +

    💡 Post them here

    +
    +
    +

    Installation +

    +

    ⚠️ Important: We do not recommend installing the currently heavily outdated CRAN version of this package. Instead, we recommend installing the development (dev) or stable beta (main_beta) version from GitHub.

    +
    + +
    +# install.packages("devtools")
+
+# Install the re-factored development version 
+devtools::install_github("hreinwald/drc")
+
+# Install the re-factored stable version
+devtools::install_github("hreinwald/drc@main")
    +
    +
    +

    Local Installation from tar.gz +

    +

    If GitHub installation is failing, you can run the installation from the local tar.gz file. Download the latest release.

    +

    After downloading the file, run the following:

    +
    +# Specify the path to the directory where you saved the downloaded tar.gz file.
+targz  <- file.path("~/Downloads/drc-3.3.2.tar.gz")
+
+# Local installation with base R
+install.packages(targz, repos = NULL, type = "source")
    +
    +
    + +

    To install the outdated version from CRAN:

    + +
    +
    +
    +

    Quick Start +

    +
    +

    Fitting a basic dose-response model +

    +
    +library(drc)
+
+# Fit a four-parameter log-logistic model to the built-in 'ryegrass' dataset
+model <- drm(rootl ~ conc, data = ryegrass, fct = LL.4())
+
+# View model summary with parameter estimates and standard errors
+summary(model)
+
+# Plot the fitted dose-response curve
+plot(model, xlab = "Concentration", ylab = "Root length")
    +
    +
    +

    Estimating effective doses (ED values) +

    +
    +# Estimate the ED50 (dose producing 50% effect) with confidence intervals
+ED(model, respLev = c(10, 50, 90), interval = "delta")
    +
    +
    +

    Comparing curves across groups +

    +
    +# Fit separate curves for multiple groups
+model_multi <- drm(rootl ~ conc, curveid = herbicide,
+                   data = ryegrass, fct = LL.4())
+
+# Compare ED50 values between groups
+EDcomp(model_multi, percVec = c(50), interval = "delta")
    +
    +
    +

    Model selection +

    +
    +# Compare different dose-response model families
+mselect(model, fctList = list(W1.4(), W2.4(), LL.3()))
    +
    +
    +
    +

    Vignettes +

    +

    The package includes detailed vignettes to help you understand specific topics:

    +
    +# View available vignettes
+vignette(package = "drc")
+
+# Access the NEC models vignette
+vignette("nec-models", package = "drc")
    +
    +
    +

    Available Models +

    + ++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    FunctionDescription
    +LL.2() – LL.5() +Log-logistic models (2 to 5 parameters)
    +W1.2() – W1.4() +Weibull type 1 models
    +W2.2() – W2.4() +Weibull type 2 models
    +G.3(), G.4() +Gompertz models
    +LN.2() – LN.4() +Log-normal models
    +BC.4(), BC.5() +Brain-Cousens models (hormesis)
    +CRS.4a() – CRS.4c() +Cedergreen-Ritz-Streibig 4-parameter models (hormesis)
    +CRS.5(), CRS.5a() – CRS.5c() +Cedergreen-Ritz-Streibig 5-parameter models (hormesis)
    CRS.6()Generalised Cedergreen-Ritz-Streibig model (hormesis)
    +UCRS.4a() – UCRS.4c() +U-shaped Cedergreen-Ritz-Streibig 4-parameter models (hormesis)
    +UCRS.5a() – UCRS.5c() +U-shaped Cedergreen-Ritz-Streibig 5-parameter models (hormesis)
    +NEC.2() – NEC.4() +No-effect-concentration models
    +L.3() – L.5() +Logistic models
    baro5()Baro five-parameter model
    gammadr()Gamma dose-response model
    +
    +
    +

    Key Functions +

    + ++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    FunctionPurpose
    drm()Fit dose-response models
    ED()Estimate effective doses (ED10, ED50, …)
    maED()Model averaged estimate effective doses (ED10, ED50, …)
    EDcomp()Compare ED values between curves
    compParm()Compare model parameters between curves
    noEffect()Testing if there is a dose effect at all
    plot()Plot fitted dose-response curves
    summary()Model summary with parameter estimates
    anova()ANOVA and lack-of-fit tests
    mselect()Model selection among candidate models
    predict()Predictions with confidence/prediction intervals
    modelFit()Goodness-of-fit test
    Rsq()R-squared calculation
    rdrm()Simulate dose-response data
    +
    +
    +

    Data Types Supported +

    +

    The drm() function supports multiple response types via the type argument:

    +
      +
    • +"continuous" (default): Standard continuous dose-response data.
      • +
    • +"binomial": Quantal/binary response data (e.g., proportion of individuals affected).
      • +
    • +"Poisson": Count data following a Poisson distribution.
      • +
    • +"negbin1", "negbin2": Negative binomial count data.
      • +
    • +"event": Event-time / time-to-event data (e.g., germination time).
      • +
    • +"ssd": Species sensitivity distributions for ecotoxicology.
      • +
    +
    +
    +

    Dependencies +

    +

    drc depends on: - R (≥ 4.0.0), MASS, stats

    +

    and imports from: car, graphics, gtools, lifecycle, multcomp, plotrix, sandwich, scales, utils.

    +
    +
    +

    References +

    +
      +
    • Ritz, C., Baty, F., Streibig, J. C., and Gerhard, D. (2015). Dose-Response Analysis Using R. PLOS ONE, 10(12), e0146021.
      • +
    • Ritz, C. and Streibig, J. C. (2005). Bioassay Analysis using R. Journal of Statistical Software, 12(5), 1–22.
      • +
    +
    +
    +

    Bug Reports +

    +

    Please report issues with this re-factory version here.

    +
    +
    +

    License +

    +

    GPL-2.0

    -
    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -

    Site built with pkgdown.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    +
    - + + + diff --git a/docs/index.md b/docs/index.md new file mode 100644 index 00000000..d3242b70 --- /dev/null +++ b/docs/index.md @@ -0,0 +1,245 @@ +# drc — Dose-Response Curve Analysis in R + +[![CRAN +version](https://www.r-pkg.org/badges/version/drc)](https://cran.r-project.org/package=drc) +[![Downloads](https://cranlogs.r-pkg.org/badges/drc)](https://cranlogs.r-pkg.org/) +[![License: +GPL-2.0](https://img.shields.io/github/license/hreinwald/drc)](https://github.com/hreinwald/drc/blob/dev/LICENSE) +[![Last commit +date](https://img.shields.io/github/last-commit/hreinwald/drc)](https://github.com/hreinwald/drc/commits/dev) +[![Contributions +welcome](https://img.shields.io/badge/contributions-welcome-brightgreen.svg?style=flat)](https://github.com/hreinwald/drc/issues) + +![drc Logo](reference/figures/logo.png) + +## Note + +This repository contains a refactored development version of the +[*drc*](https://github.com/DoseResponse/drc) R package first published +by **Christian Ritz, Florent Baty, Jens C. Streibig und Daniel Gerhard** +[(2015)](https://doi.org/10.1371/journal.pone.0146021). Their +foundational work on dose–response modeling in R is gratefully +acknowledged and inspired the present refactoring. + +The goal of this project is to modernize the codebase, improve +maintainability, and provide a clearer development structure while +preserving the core functionality of the original package. + +This repository focuses on structural refactoring and development +improvements. Behavior and interfaces may change as the codebase is +modernized. + +## Overview + +The **drc** package provides a comprehensive framework for fitting, +analyzing, and visualizing dose-response curves in R. It is widely used +in bioassay, toxicology, pharmacology, and agricultural research to +model the relationship between an exposure (e.g., concentration of a +substance) or dose and a biological response. + +The package offers: + +- **Flexible model fitting** via the central + [`drm()`](https://hreinwald.github.io/drc/reference/drm.md) function, + supporting multiple data types (continuous, binomial, Poisson, + negative binomial, event-time, and species sensitivity distributions). +- **40+ built-in parametric models** including log-logistic, Weibull, + Gompertz, Brain-Cousens, Cedergreen, and many more, each with + self-starting parameter initialization. +- **Effective dose (ED) estimation** with confidence intervals (delta + method, Fieller, inverse regression) through + [`ED()`](https://hreinwald.github.io/drc/reference/ED.md). +- **Model comparison and diagnostics**: ANOVA, lack-of-fit tests, + Neill’s test, Box-Cox transformations, R-squared, Cook’s distance, and + hat values. +- **Multi-curve analysis**: fit and compare dose-response curves across + groups, compute relative potency and selectivity indices via + [`EDcomp()`](https://hreinwald.github.io/drc/reference/EDcomp.md). +- **Robust inference**: sandwich variance estimators for + heteroscedasticity-consistent standard errors. +- **Simulation tools**: generate random dose-response data for power + analysis and method comparison. + +For more details visit: + +📖 **[drc github documentation](https://hreinwald.github.io/drc/)** +⚡ **[drc example +workflow](https://hreinwald.github.io/drc/articles/dose-response-workflow.html)** + +Feature requests or ideas? + +💡 **[Post them here](https://github.com/hreinwald/drc/discussions)** + +## Installation + +**⚠️ Important:** We **do not recommend** installing the currently +heavily outdated CRAN version of this package. Instead, we recommend +installing the development (`dev`) or stable beta (`main_beta`) version +from GitHub. + +### Install from GitHub (Recommended) + +``` r +# install.packages("devtools") + +# Install the re-factored development version +devtools::install_github("hreinwald/drc") + +# Install the re-factored stable beta version +devtools::install_github("hreinwald/drc@main_beta") +``` + +### Local Installation from tar.gz + +If GitHub installation is failing, you can run the installation from the +local tar.gz file. [Download the latest +release](https://github.com/hreinwald/drc/archive/refs/tags/3.3.2.tar.gz). + +After downloading the file, run the following: + +``` r +# Specify the path to the directory where you saved the downloaded tar.gz file. +targz <- file.path("~/Downloads/drc-3.3.2.tar.gz") + +# Local installation with base R +install.packages(targz, repos = NULL, type = "source") +``` + +### Outdated CRAN Version (Not Recommended) + +To install the outdated version from CRAN: + +``` r +install.packages("drc") +``` + +## Quick Start + +### Fitting a basic dose-response model + +``` r +library(drc) + +# Fit a four-parameter log-logistic model to the built-in 'ryegrass' dataset +model <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + +# View model summary with parameter estimates and standard errors +summary(model) + +# Plot the fitted dose-response curve +plot(model, xlab = "Concentration", ylab = "Root length") +``` + +### Estimating effective doses (ED values) + +``` r +# Estimate the ED50 (dose producing 50% effect) with confidence intervals +ED(model, respLev = c(10, 50, 90), interval = "delta") +``` + +### Comparing curves across groups + +``` r +# Fit separate curves for multiple groups +model_multi <- drm(rootl ~ conc, curveid = herbicide, + data = ryegrass, fct = LL.4()) + +# Compare ED50 values between groups +EDcomp(model_multi, percVec = c(50), interval = "delta") +``` + +### Model selection + +``` r +# Compare different dose-response model families +mselect(model, fctList = list(W1.4(), W2.4(), LL.3())) +``` + +## Vignettes + +The package includes detailed vignettes to help you understand specific +topics: + +``` r +# View available vignettes +vignette(package = "drc") + +# Access the NEC models vignette +vignette("nec-models", package = "drc") +``` + +## Available Models + +| Function | Description | +|----|----| +| [`LL.2()`](https://hreinwald.github.io/drc/reference/LL.2.md) – [`LL.5()`](https://hreinwald.github.io/drc/reference/LL.5.md) | Log-logistic models (2 to 5 parameters) | +| [`W1.2()`](https://hreinwald.github.io/drc/reference/W1.2.md) – [`W1.4()`](https://hreinwald.github.io/drc/reference/W1.4.md) | Weibull type 1 models | +| [`W2.2()`](https://hreinwald.github.io/drc/reference/W2.2.md) – [`W2.4()`](https://hreinwald.github.io/drc/reference/W2.4.md) | Weibull type 2 models | +| [`G.3()`](https://hreinwald.github.io/drc/reference/G.3.md), [`G.4()`](https://hreinwald.github.io/drc/reference/G.4.md) | Gompertz models | +| [`LN.2()`](https://hreinwald.github.io/drc/reference/LN.2.md) – [`LN.4()`](https://hreinwald.github.io/drc/reference/LN.4.md) | Log-normal models | +| [`BC.4()`](https://hreinwald.github.io/drc/reference/BC.4.md), [`BC.5()`](https://hreinwald.github.io/drc/reference/BC.5.md) | Brain-Cousens models (hormesis) | +| [`CRS.4a()`](https://hreinwald.github.io/drc/reference/CRS.4a.md) – [`CRS.4c()`](https://hreinwald.github.io/drc/reference/CRS.4c.md) | Cedergreen-Ritz-Streibig 4-parameter models (hormesis) | +| [`CRS.5()`](https://hreinwald.github.io/drc/reference/CRS.5.md), [`CRS.5a()`](https://hreinwald.github.io/drc/reference/CRS.5a.md) – [`CRS.5c()`](https://hreinwald.github.io/drc/reference/CRS.5c.md) | Cedergreen-Ritz-Streibig 5-parameter models (hormesis) | +| [`CRS.6()`](https://hreinwald.github.io/drc/reference/CRS.6.md) | Generalised Cedergreen-Ritz-Streibig model (hormesis) | +| [`UCRS.4a()`](https://hreinwald.github.io/drc/reference/UCRS.4a.md) – [`UCRS.4c()`](https://hreinwald.github.io/drc/reference/UCRS.4c.md) | U-shaped Cedergreen-Ritz-Streibig 4-parameter models (hormesis) | +| [`UCRS.5a()`](https://hreinwald.github.io/drc/reference/UCRS.5a.md) – [`UCRS.5c()`](https://hreinwald.github.io/drc/reference/UCRS.5c.md) | U-shaped Cedergreen-Ritz-Streibig 5-parameter models (hormesis) | +| [`NEC.2()`](https://hreinwald.github.io/drc/reference/NEC.2.md) – [`NEC.4()`](https://hreinwald.github.io/drc/reference/NEC.4.md) | No-effect-concentration models | +| [`L.3()`](https://hreinwald.github.io/drc/reference/L.3.md) – [`L.5()`](https://hreinwald.github.io/drc/reference/L.5.md) | Logistic models | +| [`baro5()`](https://hreinwald.github.io/drc/reference/baro5.md) | Baro five-parameter model | +| [`gammadr()`](https://hreinwald.github.io/drc/reference/gammadr.md) | Gamma dose-response model | + +## Key Functions + +| Function | Purpose | +|----|----| +| [`drm()`](https://hreinwald.github.io/drc/reference/drm.md) | Fit dose-response models | +| [`ED()`](https://hreinwald.github.io/drc/reference/ED.md) | Estimate effective doses (ED10, ED50, …) | +| [`maED()`](https://hreinwald.github.io/drc/reference/maED.md) | Model averaged estimate effective doses (ED10, ED50, …) | +| [`EDcomp()`](https://hreinwald.github.io/drc/reference/EDcomp.md) | Compare ED values between curves | +| [`compParm()`](https://hreinwald.github.io/drc/reference/compParm.md) | Compare model parameters between curves | +| [`noEffect()`](https://hreinwald.github.io/drc/reference/noEffect.md) | Testing if there is a dose effect at all | +| [`plot()`](https://rdrr.io/r/graphics/plot.default.html) | Plot fitted dose-response curves | +| [`summary()`](https://rdrr.io/r/base/summary.html) | Model summary with parameter estimates | +| [`anova()`](https://rdrr.io/r/stats/anova.html) | ANOVA and lack-of-fit tests | +| [`mselect()`](https://hreinwald.github.io/drc/reference/mselect.md) | Model selection among candidate models | +| [`predict()`](https://rdrr.io/r/stats/predict.html) | Predictions with confidence/prediction intervals | +| [`modelFit()`](https://hreinwald.github.io/drc/reference/modelFit.md) | Goodness-of-fit test | +| [`Rsq()`](https://hreinwald.github.io/drc/reference/Rsq.md) | R-squared calculation | +| [`rdrm()`](https://hreinwald.github.io/drc/reference/rdrm.md) | Simulate dose-response data | + +## Data Types Supported + +The [`drm()`](https://hreinwald.github.io/drc/reference/drm.md) function +supports multiple response types via the `type` argument: + +- **`"continuous"`** (default): Standard continuous dose-response data. +- **`"binomial"`**: Quantal/binary response data (e.g., proportion of + individuals affected). +- **`"Poisson"`**: Count data following a Poisson distribution. +- **`"negbin1"`, `"negbin2"`**: Negative binomial count data. +- **`"event"`**: Event-time / time-to-event data (e.g., germination + time). +- **`"ssd"`**: Species sensitivity distributions for ecotoxicology. + +## Dependencies + +**drc** depends on: - R (≥ 4.0.0), MASS, stats + +and imports from: car, graphics, gtools, lifecycle, multcomp, plotrix, +sandwich, scales, utils. + +## References + +- Ritz, C., Baty, F., Streibig, J. C., and Gerhard, D. (2015). + Dose-Response Analysis Using R. *PLOS ONE*, 10(12), e0146021. +- Ritz, C. and Streibig, J. C. (2005). Bioassay Analysis using R. + *Journal of Statistical Software*, 12(5), 1–22. + +## Bug Reports + +Please report issues with this re-factory version +[here](https://github.com/hreinwald/drc/issues/). + +## License + +GPL-2.0 diff --git a/docs/katex-auto.js b/docs/katex-auto.js new file mode 100644 index 00000000..2adab3a9 --- /dev/null +++ b/docs/katex-auto.js @@ -0,0 +1,16 @@ +// https://github.com/jgm/pandoc/blob/29fa97ab96b8e2d62d48326e1b949a71dc41f47a/src/Text/Pandoc/Writers/HTML.hs#L332-L345 +document.addEventListener("DOMContentLoaded", function () { + var mathElements = document.getElementsByClassName("math"); + var macros = []; + for (var i = 0; i < mathElements.length; i++) { + var texText = mathElements[i].firstChild; + if (mathElements[i].tagName == "SPAN") { + katex.render(texText.data, mathElements[i], { + displayMode: mathElements[i].classList.contains("display"), + throwOnError: false, + macros: macros, + fleqn: false + }); + } + } +}); diff --git a/docs/lightswitch.js b/docs/lightswitch.js new file mode 100644 index 00000000..3808ca11 --- /dev/null +++ b/docs/lightswitch.js @@ -0,0 +1,85 @@ + +/*! + * Color mode toggler for Bootstrap's docs (https://getbootstrap.com/) + * Copyright 2011-2023 The Bootstrap Authors + * Licensed under the Creative Commons Attribution 3.0 Unported License. + * Updates for {pkgdown} by the {bslib} authors, also licensed under CC-BY-3.0. + */ + +const getStoredTheme = () => localStorage.getItem('theme') +const setStoredTheme = theme => localStorage.setItem('theme', theme) + +const getPreferredTheme = () => { + const storedTheme = getStoredTheme() + if (storedTheme) { + return storedTheme + } + + return window.matchMedia('(prefers-color-scheme: dark)').matches ? 'dark' : 'light' +} + +const setTheme = theme => { + if (theme === 'auto') { + document.documentElement.setAttribute('data-bs-theme', (window.matchMedia('(prefers-color-scheme: dark)').matches ? 'dark' : 'light')) + } else { + document.documentElement.setAttribute('data-bs-theme', theme) + } +} + +function bsSetupThemeToggle() { + 'use strict' + + const showActiveTheme = (theme, focus = false) => { + var activeLabel, activeIcon; + + document.querySelectorAll('[data-bs-theme-value]').forEach(element => { + const buttonTheme = element.getAttribute('data-bs-theme-value') + const isActive = buttonTheme == theme + + element.classList.toggle('active', isActive) + element.setAttribute('aria-pressed', isActive) + + if (isActive) { + activeLabel = element.textContent; + activeIcon = element.querySelector('span').classList.value; + } + }) + + const themeSwitcher = document.querySelector('#dropdown-lightswitch') + if (!themeSwitcher) { + return + } + + themeSwitcher.setAttribute('aria-label', activeLabel) + themeSwitcher.querySelector('span').classList.value = activeIcon; + + if (focus) { + themeSwitcher.focus() + } + } + + window.matchMedia('(prefers-color-scheme: dark)').addEventListener('change', () => { + const storedTheme = getStoredTheme() + if (storedTheme !== 'light' && storedTheme !== 'dark') { + setTheme(getPreferredTheme()) + } + }) + + window.addEventListener('DOMContentLoaded', () => { + showActiveTheme(getPreferredTheme()) + + document + .querySelectorAll('[data-bs-theme-value]') + .forEach(toggle => { + toggle.addEventListener('click', () => { + const theme = toggle.getAttribute('data-bs-theme-value') + setTheme(theme) + setStoredTheme(theme) + showActiveTheme(theme, true) + }) + }) + }) +} + +setTheme(getPreferredTheme()); +bsSetupThemeToggle(); diff --git a/docs/llms.txt b/docs/llms.txt new file mode 100644 index 00000000..8559cfb2 --- /dev/null +++ b/docs/llms.txt @@ -0,0 +1,798 @@ +# drc — Dose-Response Curve Analysis in R + +[![CRAN +version](https://www.r-pkg.org/badges/version/drc)](https://cran.r-project.org/package=drc) +[![Downloads](https://cranlogs.r-pkg.org/badges/drc)](https://cranlogs.r-pkg.org/) +[![License: +GPL-2.0](https://img.shields.io/github/license/hreinwald/drc)](https://github.com/hreinwald/drc/blob/dev/LICENSE) +[![Last commit +date](https://img.shields.io/github/last-commit/hreinwald/drc)](https://github.com/hreinwald/drc/commits/dev) +[![Contributions +welcome](https://img.shields.io/badge/contributions-welcome-brightgreen.svg?style=flat)](https://github.com/hreinwald/drc/issues) + +![drc Logo](reference/figures/logo.png) + +## Note + +This repository contains a refactored development version of the +[*drc*](https://github.com/DoseResponse/drc) R package first published +by **Christian Ritz, Florent Baty, Jens C. Streibig und Daniel Gerhard** +[(2015)](https://doi.org/10.1371/journal.pone.0146021). Their +foundational work on dose–response modeling in R is gratefully +acknowledged and inspired the present refactoring. + +The goal of this project is to modernize the codebase, improve +maintainability, and provide a clearer development structure while +preserving the core functionality of the original package. + +This repository focuses on structural refactoring and development +improvements. Behavior and interfaces may change as the codebase is +modernized. + +## Overview + +The **drc** package provides a comprehensive framework for fitting, +analyzing, and visualizing dose-response curves in R. It is widely used +in bioassay, toxicology, pharmacology, and agricultural research to +model the relationship between an exposure (e.g., concentration of a +substance) or dose and a biological response. + +The package offers: + +- **Flexible model fitting** via the central + [`drm()`](https://hreinwald.github.io/drc/reference/drm.md) function, + supporting multiple data types (continuous, binomial, Poisson, + negative binomial, event-time, and species sensitivity distributions). +- **40+ built-in parametric models** including log-logistic, Weibull, + Gompertz, Brain-Cousens, Cedergreen, and many more, each with + self-starting parameter initialization. +- **Effective dose (ED) estimation** with confidence intervals (delta + method, Fieller, inverse regression) through + [`ED()`](https://hreinwald.github.io/drc/reference/ED.md). +- **Model comparison and diagnostics**: ANOVA, lack-of-fit tests, + Neill’s test, Box-Cox transformations, R-squared, Cook’s distance, and + hat values. +- **Multi-curve analysis**: fit and compare dose-response curves across + groups, compute relative potency and selectivity indices via + [`EDcomp()`](https://hreinwald.github.io/drc/reference/EDcomp.md). +- **Robust inference**: sandwich variance estimators for + heteroscedasticity-consistent standard errors. +- **Simulation tools**: generate random dose-response data for power + analysis and method comparison. + +For more details visit: + +📖 **[drc github documentation](https://hreinwald.github.io/drc/)** +⚡ **[drc example +workflow](https://hreinwald.github.io/drc/articles/dose-response-workflow.html)** + +Feature requests or ideas? + +💡 **[Post them here](https://github.com/hreinwald/drc/discussions)** + +## Installation + +**⚠️ Important:** We **do not recommend** installing the currently +heavily outdated CRAN version of this package. Instead, we recommend +installing the development (`dev`) or stable beta (`main_beta`) version +from GitHub. + +### Install from GitHub (Recommended) + +``` r +# install.packages("devtools") + +# Install the re-factored development version +devtools::install_github("hreinwald/drc") + +# Install the re-factored stable beta version +devtools::install_github("hreinwald/drc@main_beta") +``` + +### Local Installation from tar.gz + +If GitHub installation is failing, you can run the installation from the +local tar.gz file. [Download the latest +release](https://github.com/hreinwald/drc/archive/refs/tags/3.3.2.tar.gz). + +After downloading the file, run the following: + +``` r +# Specify the path to the directory where you saved the downloaded tar.gz file. +targz <- file.path("~/Downloads/drc-3.3.2.tar.gz") + +# Local installation with base R +install.packages(targz, repos = NULL, type = "source") +``` + +### Outdated CRAN Version (Not Recommended) + +To install the outdated version from CRAN: + +``` r +install.packages("drc") +``` + +## Quick Start + +### Fitting a basic dose-response model + +``` r +library(drc) + +# Fit a four-parameter log-logistic model to the built-in 'ryegrass' dataset +model <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + +# View model summary with parameter estimates and standard errors +summary(model) + +# Plot the fitted dose-response curve +plot(model, xlab = "Concentration", ylab = "Root length") +``` + +### Estimating effective doses (ED values) + +``` r +# Estimate the ED50 (dose producing 50% effect) with confidence intervals +ED(model, respLev = c(10, 50, 90), interval = "delta") +``` + +### Comparing curves across groups + +``` r +# Fit separate curves for multiple groups +model_multi <- drm(rootl ~ conc, curveid = herbicide, + data = ryegrass, fct = LL.4()) + +# Compare ED50 values between groups +EDcomp(model_multi, percVec = c(50), interval = "delta") +``` + +### Model selection + +``` r +# Compare different dose-response model families +mselect(model, fctList = list(W1.4(), W2.4(), LL.3())) +``` + +## Vignettes + +The package includes detailed vignettes to help you understand specific +topics: + +``` r +# View available vignettes +vignette(package = "drc") + +# Access the NEC models vignette +vignette("nec-models", package = "drc") +``` + +## Available Models + +| Function | Description | +|----|----| +| [`LL.2()`](https://hreinwald.github.io/drc/reference/LL.2.md) – [`LL.5()`](https://hreinwald.github.io/drc/reference/LL.5.md) | Log-logistic models (2 to 5 parameters) | +| [`W1.2()`](https://hreinwald.github.io/drc/reference/W1.2.md) – [`W1.4()`](https://hreinwald.github.io/drc/reference/W1.4.md) | Weibull type 1 models | +| [`W2.2()`](https://hreinwald.github.io/drc/reference/W2.2.md) – [`W2.4()`](https://hreinwald.github.io/drc/reference/W2.4.md) | Weibull type 2 models | +| [`G.3()`](https://hreinwald.github.io/drc/reference/G.3.md), [`G.4()`](https://hreinwald.github.io/drc/reference/G.4.md) | Gompertz models | +| [`LN.2()`](https://hreinwald.github.io/drc/reference/LN.2.md) – [`LN.4()`](https://hreinwald.github.io/drc/reference/LN.4.md) | Log-normal models | +| [`BC.4()`](https://hreinwald.github.io/drc/reference/BC.4.md), [`BC.5()`](https://hreinwald.github.io/drc/reference/BC.5.md) | Brain-Cousens models (hormesis) | +| [`CRS.4a()`](https://hreinwald.github.io/drc/reference/CRS.4a.md) – [`CRS.4c()`](https://hreinwald.github.io/drc/reference/CRS.4c.md) | Cedergreen-Ritz-Streibig 4-parameter models (hormesis) | +| [`CRS.5()`](https://hreinwald.github.io/drc/reference/CRS.5.md), [`CRS.5a()`](https://hreinwald.github.io/drc/reference/CRS.5a.md) – [`CRS.5c()`](https://hreinwald.github.io/drc/reference/CRS.5c.md) | Cedergreen-Ritz-Streibig 5-parameter models (hormesis) | +| [`CRS.6()`](https://hreinwald.github.io/drc/reference/CRS.6.md) | Generalised Cedergreen-Ritz-Streibig model (hormesis) | +| [`UCRS.4a()`](https://hreinwald.github.io/drc/reference/UCRS.4a.md) – [`UCRS.4c()`](https://hreinwald.github.io/drc/reference/UCRS.4c.md) | U-shaped Cedergreen-Ritz-Streibig 4-parameter models (hormesis) | +| [`UCRS.5a()`](https://hreinwald.github.io/drc/reference/UCRS.5a.md) – [`UCRS.5c()`](https://hreinwald.github.io/drc/reference/UCRS.5c.md) | U-shaped Cedergreen-Ritz-Streibig 5-parameter models (hormesis) | +| [`NEC.2()`](https://hreinwald.github.io/drc/reference/NEC.2.md) – [`NEC.4()`](https://hreinwald.github.io/drc/reference/NEC.4.md) | No-effect-concentration models | +| [`L.3()`](https://hreinwald.github.io/drc/reference/L.3.md) – [`L.5()`](https://hreinwald.github.io/drc/reference/L.5.md) | Logistic models | +| [`baro5()`](https://hreinwald.github.io/drc/reference/baro5.md) | Baro five-parameter model | +| [`gammadr()`](https://hreinwald.github.io/drc/reference/gammadr.md) | Gamma dose-response model | + +## Key Functions + +| Function | Purpose | +|----|----| +| [`drm()`](https://hreinwald.github.io/drc/reference/drm.md) | Fit dose-response models | +| [`ED()`](https://hreinwald.github.io/drc/reference/ED.md) | Estimate effective doses (ED10, ED50, …) | +| [`maED()`](https://hreinwald.github.io/drc/reference/maED.md) | Model averaged estimate effective doses (ED10, ED50, …) | +| [`EDcomp()`](https://hreinwald.github.io/drc/reference/EDcomp.md) | Compare ED values between curves | +| [`compParm()`](https://hreinwald.github.io/drc/reference/compParm.md) | Compare model parameters between curves | +| [`noEffect()`](https://hreinwald.github.io/drc/reference/noEffect.md) | Testing if there is a dose effect at all | +| [`plot()`](https://rdrr.io/r/graphics/plot.default.html) | Plot fitted dose-response curves | +| [`summary()`](https://rdrr.io/r/base/summary.html) | Model summary with parameter estimates | +| [`anova()`](https://rdrr.io/r/stats/anova.html) | ANOVA and lack-of-fit tests | +| [`mselect()`](https://hreinwald.github.io/drc/reference/mselect.md) | Model selection among candidate models | +| [`predict()`](https://rdrr.io/r/stats/predict.html) | Predictions with confidence/prediction intervals | +| [`modelFit()`](https://hreinwald.github.io/drc/reference/modelFit.md) | Goodness-of-fit test | +| [`Rsq()`](https://hreinwald.github.io/drc/reference/Rsq.md) | R-squared calculation | +| [`rdrm()`](https://hreinwald.github.io/drc/reference/rdrm.md) | Simulate dose-response data | + +## Data Types Supported + +The [`drm()`](https://hreinwald.github.io/drc/reference/drm.md) function +supports multiple response types via the `type` argument: + +- **`"continuous"`** (default): Standard continuous dose-response data. +- **`"binomial"`**: Quantal/binary response data (e.g., proportion of + individuals affected). +- **`"Poisson"`**: Count data following a Poisson distribution. +- **`"negbin1"`, `"negbin2"`**: Negative binomial count data. +- **`"event"`**: Event-time / time-to-event data (e.g., germination + time). +- **`"ssd"`**: Species sensitivity distributions for ecotoxicology. + +## Dependencies + +**drc** depends on: - R (≥ 4.0.0), MASS, stats + +and imports from: car, graphics, gtools, lifecycle, multcomp, plotrix, +sandwich, scales, utils. + +## References + +- Ritz, C., Baty, F., Streibig, J. C., and Gerhard, D. (2015). + Dose-Response Analysis Using R. *PLOS ONE*, 10(12), e0146021. +- Ritz, C. and Streibig, J. C. (2005). Bioassay Analysis using R. + *Journal of Statistical Software*, 12(5), 1–22. + +## Bug Reports + +Please report issues with this re-factory version +[here](https://github.com/hreinwald/drc/issues/). + +## License + +GPL-2.0 + +# Package index + +## Core Functions + +Main functions for dose-response analysis + +- [`drm()`](https://hreinwald.github.io/drc/reference/drm.md) : Fitting + dose-response models +- [`ED()`](https://hreinwald.github.io/drc/reference/ED.md) : Estimating + effective doses +- [`EDcomp()`](https://hreinwald.github.io/drc/reference/EDcomp.md) : + Comparison of relative potencies between dose-response curves +- [`compParm()`](https://hreinwald.github.io/drc/reference/compParm.md) + : Comparison of parameters +- [`mselect()`](https://hreinwald.github.io/drc/reference/mselect.md) : + Dose-response model selection +- [`drmc()`](https://hreinwald.github.io/drc/reference/drmc.md) : Sets + control arguments + +## Model Functions + +Available dose-response model families + +- [`LL.2()`](https://hreinwald.github.io/drc/reference/LL.2.md) + [`l2()`](https://hreinwald.github.io/drc/reference/LL.2.md) : + Two-parameter log-logistic function +- [`LL.3()`](https://hreinwald.github.io/drc/reference/LL.3.md) + [`l3()`](https://hreinwald.github.io/drc/reference/LL.3.md) : + Three-parameter log-logistic function +- [`LL.3u()`](https://hreinwald.github.io/drc/reference/LL.3u.md) + [`l3u()`](https://hreinwald.github.io/drc/reference/LL.3u.md) : + Three-parameter log-logistic function with upper limit fixed +- [`LL.4()`](https://hreinwald.github.io/drc/reference/LL.4.md) + [`l4()`](https://hreinwald.github.io/drc/reference/LL.4.md) : + Four-parameter log-logistic function +- [`LL.5()`](https://hreinwald.github.io/drc/reference/LL.5.md) + [`l5()`](https://hreinwald.github.io/drc/reference/LL.5.md) : + Five-parameter log-logistic function +- [`LL2.2()`](https://hreinwald.github.io/drc/reference/LL2.2.md) : + Two-Parameter Log-Logistic Model with log(ED50) as Parameter +- [`LL2.3()`](https://hreinwald.github.io/drc/reference/LL2.3.md) : + Three-Parameter Log-Logistic Model with log(ED50) and Lower Limit at 0 +- [`LL2.3u()`](https://hreinwald.github.io/drc/reference/LL2.3u.md) : + Three-Parameter Log-Logistic Model with log(ED50) and Fixed Upper + Limit +- [`LL2.4()`](https://hreinwald.github.io/drc/reference/LL2.4.md) : + Four-Parameter Log-Logistic Model with log(ED50) as Parameter +- [`LL2.5()`](https://hreinwald.github.io/drc/reference/LL2.5.md) : + Five-Parameter Generalised Log-Logistic Model with log(ED50) as + Parameter +- [`W1.2()`](https://hreinwald.github.io/drc/reference/W1.2.md) + [`w2()`](https://hreinwald.github.io/drc/reference/W1.2.md) : + Two-parameter Weibull type 1 model +- [`W1.3()`](https://hreinwald.github.io/drc/reference/W1.3.md) + [`w3()`](https://hreinwald.github.io/drc/reference/W1.3.md) : + Three-parameter Weibull type 1 model +- [`W1.3u()`](https://hreinwald.github.io/drc/reference/W1.3u.md) : + Three-parameter Weibull type 1 model with upper limit fixed +- [`W1.4()`](https://hreinwald.github.io/drc/reference/W1.4.md) + [`w4()`](https://hreinwald.github.io/drc/reference/W1.4.md) : + Four-parameter Weibull type 1 model +- [`W2.2()`](https://hreinwald.github.io/drc/reference/W2.2.md) : + Two-parameter Weibull (type 2) model +- [`W2.3()`](https://hreinwald.github.io/drc/reference/W2.3.md) : + Three-parameter Weibull (type 2) model +- [`W2.3u()`](https://hreinwald.github.io/drc/reference/W2.3u.md) : + Three-parameter Weibull (type 2) model with upper limit fixed +- [`W2.4()`](https://hreinwald.github.io/drc/reference/W2.4.md) : + Four-parameter Weibull (type 2) model +- [`W2x.3()`](https://hreinwald.github.io/drc/reference/W2x.3.md) : + Three-parameter Weibull type 2 model with lag time +- [`W2x.4()`](https://hreinwald.github.io/drc/reference/W2x.4.md) : + Four-parameter Weibull type 2 model with lag time +- [`G.2()`](https://hreinwald.github.io/drc/reference/G.2.md) : + Two-parameter Gompertz model +- [`G.3()`](https://hreinwald.github.io/drc/reference/G.3.md) : + Three-parameter Gompertz model +- [`G.3u()`](https://hreinwald.github.io/drc/reference/G.3u.md) : + Three-parameter Gompertz model with upper limit fixed +- [`G.4()`](https://hreinwald.github.io/drc/reference/G.4.md) : + Four-parameter Gompertz model +- [`G.aparine`](https://hreinwald.github.io/drc/reference/G.aparine.md) + : Herbicide applied to Galium aparine +- [`GiantKelp`](https://hreinwald.github.io/drc/reference/GiantKelp.md) + : Measurements of germination tubes for Giant Kelp +- [`LN.2()`](https://hreinwald.github.io/drc/reference/LN.2.md) : + Two-parameter log-normal dose-response model +- [`LN.3()`](https://hreinwald.github.io/drc/reference/LN.3.md) : + Three-parameter log-normal dose-response model +- [`LN.3u()`](https://hreinwald.github.io/drc/reference/LN.3u.md) : + Three-parameter log-normal model with upper limit fixed +- [`LN.4()`](https://hreinwald.github.io/drc/reference/LN.4.md) : + Four-parameter log-normal dose-response model +- [`BC.4()`](https://hreinwald.github.io/drc/reference/BC.4.md) : + Four-parameter Brain-Cousens hormesis model +- [`BC.5()`](https://hreinwald.github.io/drc/reference/BC.5.md) : + Five-parameter Brain-Cousens hormesis model +- [`CRS.4a()`](https://hreinwald.github.io/drc/reference/CRS.4a.md) + **\[deprecated\]** : Cedergreen-Ritz-Streibig Model with Lower Limit + Fixed at 0 and Alpha = 1 (Deprecated) +- [`CRS.4b()`](https://hreinwald.github.io/drc/reference/CRS.4b.md) + **\[deprecated\]** : Cedergreen-Ritz-Streibig Model with Lower Limit + Fixed at 0 and Alpha = 0.5 (Deprecated) +- [`CRS.4c()`](https://hreinwald.github.io/drc/reference/CRS.4c.md) + **\[deprecated\]** : Cedergreen-Ritz-Streibig Model with Lower Limit + Fixed at 0 and Alpha = 0.25 (Deprecated) +- [`CRS.5()`](https://hreinwald.github.io/drc/reference/CRS.5.md) : + Wrapper for 5-parameter Cedergreen-Ritz-Streibig Model +- [`CRS.5a()`](https://hreinwald.github.io/drc/reference/CRS.5a.md) + **\[deprecated\]** : Cedergreen-Ritz-Streibig Five-Parameter Model + with Alpha = 1 (Deprecated) +- [`CRS.5b()`](https://hreinwald.github.io/drc/reference/CRS.5b.md) + **\[deprecated\]** : Cedergreen-Ritz-Streibig Five-Parameter Model + with Alpha = 0.5 (Deprecated) +- [`CRS.5c()`](https://hreinwald.github.io/drc/reference/CRS.5c.md) + **\[deprecated\]** : Cedergreen-Ritz-Streibig Five-Parameter Model + with Alpha = 0.25 (Deprecated) +- [`CRS.6()`](https://hreinwald.github.io/drc/reference/CRS.6.md) : + Generalised Cedergreen-Ritz-Streibig Model for Hormesis +- [`UCRS.4a()`](https://hreinwald.github.io/drc/reference/UCRS.4a.md) : + U-shaped CRS model with lower limit 0 (alpha=1) +- [`UCRS.4b()`](https://hreinwald.github.io/drc/reference/UCRS.4b.md) : + U-shaped CRS model with lower limit 0 (alpha=0.5) +- [`UCRS.4c()`](https://hreinwald.github.io/drc/reference/UCRS.4c.md) : + U-shaped CRS model with lower limit 0 (alpha=0.25) +- [`UCRS.5a()`](https://hreinwald.github.io/drc/reference/UCRS.5a.md) : + U-shaped CRS five-parameter model (alpha=1) +- [`UCRS.5b()`](https://hreinwald.github.io/drc/reference/UCRS.5b.md) : + U-shaped CRS five-parameter model (alpha=0.5) +- [`UCRS.5c()`](https://hreinwald.github.io/drc/reference/UCRS.5c.md) : + U-shaped CRS five-parameter model (alpha=0.25) +- [`NEC.2()`](https://hreinwald.github.io/drc/reference/NEC.2.md) : + Two-parameter NEC model +- [`NEC.3()`](https://hreinwald.github.io/drc/reference/NEC.3.md) : + Three-parameter NEC model +- [`NEC.4()`](https://hreinwald.github.io/drc/reference/NEC.4.md) : + Four-parameter NEC model +- [`L.3()`](https://hreinwald.github.io/drc/reference/L.3.md) : + Three-parameter logistic model +- [`L.4()`](https://hreinwald.github.io/drc/reference/L.4.md) : + Four-parameter logistic model +- [`L.5()`](https://hreinwald.github.io/drc/reference/L.5.md) : + Five-parameter generalized logistic model +- [`AR.2()`](https://hreinwald.github.io/drc/reference/AR.2.md) : + Two-parameter asymptotic regression model +- [`AR.3()`](https://hreinwald.github.io/drc/reference/AR.3.md) : + Three-parameter shifted asymptotic regression model +- [`EXD.2()`](https://hreinwald.github.io/drc/reference/EXD.2.md) : + Two-parameter exponential decay model +- [`EXD.3()`](https://hreinwald.github.io/drc/reference/EXD.3.md) : + Three-parameter exponential decay model +- [`MM.2()`](https://hreinwald.github.io/drc/reference/MM.2.md) : + Two-parameter Michaelis-Menten function +- [`MM.3()`](https://hreinwald.github.io/drc/reference/MM.3.md) : + Three-parameter Michaelis-Menten function +- [`FPL.4()`](https://hreinwald.github.io/drc/reference/FPL.4.md) : + Four-parameter fractional polynomial-logistic model +- [`ml3a()`](https://hreinwald.github.io/drc/reference/ml3a.md) + **\[deprecated\]** : Alias for CRS.4a (Deprecated) +- [`ml3b()`](https://hreinwald.github.io/drc/reference/ml3b.md) + **\[deprecated\]** : Alias for CRS.4b (Deprecated) +- [`ml3c()`](https://hreinwald.github.io/drc/reference/ml3c.md) + **\[deprecated\]** : Alias for CRS.4c (Deprecated) +- [`ml4a()`](https://hreinwald.github.io/drc/reference/ml4a.md) + **\[deprecated\]** : Alias for CRS.5a (Deprecated) +- [`ml4b()`](https://hreinwald.github.io/drc/reference/ml4b.md) + **\[deprecated\]** : Alias for CRS.5b (Deprecated) +- [`ml4c()`](https://hreinwald.github.io/drc/reference/ml4c.md) + **\[deprecated\]** : Alias for CRS.5c (Deprecated) +- [`uml3a()`](https://hreinwald.github.io/drc/reference/uml3a.md) : + Alias for UCRS.4a +- [`uml3b()`](https://hreinwald.github.io/drc/reference/uml3b.md) : + Alias for UCRS.4b +- [`uml3c()`](https://hreinwald.github.io/drc/reference/uml3c.md) : + Alias for UCRS.4c +- [`uml4a()`](https://hreinwald.github.io/drc/reference/uml4a.md) : + Alias for UCRS.5a +- [`uml4b()`](https://hreinwald.github.io/drc/reference/uml4b.md) : + Alias for UCRS.5b +- [`uml4c()`](https://hreinwald.github.io/drc/reference/uml4c.md) : + Alias for UCRS.5c +- [`bcl3()`](https://hreinwald.github.io/drc/reference/bcl3.md) : Alias + for BC.4 +- [`bcl4()`](https://hreinwald.github.io/drc/reference/bcl4.md) : Alias + for BC.5 +- [`baro5()`](https://hreinwald.github.io/drc/reference/baro5.md) : The + Baroreflex Five-Parameter Dose-Response Model +- [`braincousens()`](https://hreinwald.github.io/drc/reference/braincousens.md) + : The Brain-Cousens hormesis models +- [`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md) + : Cedergreen-Ritz-Streibig Model +- [`ucedergreen()`](https://hreinwald.github.io/drc/reference/ucedergreen.md) + : U-shaped Cedergreen-Ritz-Streibig model +- [`fplogistic()`](https://hreinwald.github.io/drc/reference/fplogistic.md) + : Fractional polynomial-logistic dose-response model +- [`gammadr()`](https://hreinwald.github.io/drc/reference/gammadr.md) : + Gamma Dose-Response Model +- [`gaussian()`](https://hreinwald.github.io/drc/reference/gaussian.md) + : Normal (Gaussian) biphasic dose-response model +- [`gompertz()`](https://hreinwald.github.io/drc/reference/gompertz.md) + : Gompertz dose-response or growth curve model +- [`gompertzd()`](https://hreinwald.github.io/drc/reference/gompertzd.md) + : Derivative of the Gompertz function +- [`lgaussian()`](https://hreinwald.github.io/drc/reference/lgaussian.md) + : Log-normal (log-Gaussian) biphasic dose-response model +- [`llogistic()`](https://hreinwald.github.io/drc/reference/llogistic.md) + : The log-logistic function +- [`llogistic2()`](https://hreinwald.github.io/drc/reference/llogistic2.md) + : Five-Parameter Log-Logistic Model with log(ED50) as Parameter +- [`lnormal()`](https://hreinwald.github.io/drc/reference/lnormal.md) : + Log-normal dose-response model +- [`logistic()`](https://hreinwald.github.io/drc/reference/logistic.md) + : The general asymmetric five-parameter logistic model +- [`threephase()`](https://hreinwald.github.io/drc/reference/threephase.md) + : Three-Phase Dose-Response Model +- [`twophase()`](https://hreinwald.github.io/drc/reference/twophase.md) + : Two-Phase Dose-Response Model +- [`weibull1()`](https://hreinwald.github.io/drc/reference/weibull1.md) + : The four-parameter Weibull type 1 model +- [`weibull2()`](https://hreinwald.github.io/drc/reference/weibull2.md) + : The four-parameter Weibull (type 2) model +- [`weibull2x()`](https://hreinwald.github.io/drc/reference/weibull2x.md) + : Five-parameter Weibull type 2 model with lag time +- [`yieldLoss()`](https://hreinwald.github.io/drc/reference/yieldLoss.md) + : Calculating yield loss parameters +- [`arandaordaz()`](https://hreinwald.github.io/drc/reference/arandaordaz.md) + : Asymptotic Regression Model + +## Effective Dose Estimation + +Functions for estimating effective doses and comparisons + +- [`ED(`*``*`)`](https://hreinwald.github.io/drc/reference/ED.drc.md) + : Estimating effective doses +- [`ED_robust()`](https://hreinwald.github.io/drc/reference/ED_robust.md) + : Robust Calculation of Effective Doses (ED) +- [`CIcomp()`](https://hreinwald.github.io/drc/reference/CIcomp.md) : + Classical combination index for effective doses +- [`CIcompX()`](https://hreinwald.github.io/drc/reference/CIcompX.md) : + Calculation of combination index for binary mixtures +- [`comped()`](https://hreinwald.github.io/drc/reference/comped.md) : + Comparison of effective dose values +- [`maED()`](https://hreinwald.github.io/drc/reference/maED.md) : + Estimation of ED values using model-averaging +- [`maED_robust()`](https://hreinwald.github.io/drc/reference/maED_robust.md) + : Robust Calculation of Model-Averaged Effective Doses +- [`isobole()`](https://hreinwald.github.io/drc/reference/isobole.md) : + Creating isobolograms +- [`NEC()`](https://hreinwald.github.io/drc/reference/NEC.md) : No + Effect Concentration (NEC) dose-response model +- [`MAX()`](https://hreinwald.github.io/drc/reference/MAX.md) : Maximum + mean response +- [`PR()`](https://hreinwald.github.io/drc/reference/PR.md) : Expected + or predicted response +- [`relpot()`](https://hreinwald.github.io/drc/reference/relpot.md) : + Relative potency function + +## Diagnostics and Model Selection + +Model diagnostics and helper functions + +- [`modelFit()`](https://hreinwald.github.io/drc/reference/modelFit.md) + : Assessing the model fit +- [`Rsq()`](https://hreinwald.github.io/drc/reference/Rsq.md) : + R-squared for dose-response models +- [`rss()`](https://hreinwald.github.io/drc/reference/rss.md) : Residual + sum of squares for dose-response models +- [`rdrm()`](https://hreinwald.github.io/drc/reference/rdrm.md) : + Simulating a dose-response curve +- [`anova(`*``*`)`](https://hreinwald.github.io/drc/reference/anova.drc.md) + : ANOVA Model Comparison for Dose-Response Models +- [`lin.test()`](https://hreinwald.github.io/drc/reference/lin.test.md) + : Lack-of-fit test for the mean structure based on cumulated residuals +- [`mr.test()`](https://hreinwald.github.io/drc/reference/mr.test.md) : + Mizon-Richard test for dose-response models +- [`neill.test()`](https://hreinwald.github.io/drc/reference/neill.test.md) + : Neill's lack-of-fit test for dose-response models +- [`noEffect()`](https://hreinwald.github.io/drc/reference/noEffect.md) + : Testing if there is a dose effect at all +- [`backfit()`](https://hreinwald.github.io/drc/reference/backfit.md) : + Calculation of backfit values from a fitted dose-response model +- [`boxcox(`*``*`)`](https://hreinwald.github.io/drc/reference/boxcox.drc.md) + : Transform-both-sides Box-Cox transformation +- [`searchdrc()`](https://hreinwald.github.io/drc/reference/searchdrc.md) + : Search through a range of initial parameter values to obtain + convergence +- [`simDR()`](https://hreinwald.github.io/drc/reference/simDR.md) : + Simulating ED values under various scenarios +- [`simFct()`](https://hreinwald.github.io/drc/reference/simFct.md) : + Simulation of dose-response data and ED estimation +- [`plotFACI()`](https://hreinwald.github.io/drc/reference/plotFACI.md) + : Plot combination index as a function of fraction affected +- [`getInitial()`](https://hreinwald.github.io/drc/reference/getInitial.md) + : Showing starting values used +- [`getMeanFunctions()`](https://hreinwald.github.io/drc/reference/getMeanFunctions.md) + : Display available dose-response models + +## S3 Methods + +Methods for drc model objects + +- [`coef(`*``*`)`](https://hreinwald.github.io/drc/reference/coef.drc.md) + : Extract Model Coefficients +- [`confint(`*``*`)`](https://hreinwald.github.io/drc/reference/confint.drc.md) + : Confidence Intervals for Model Parameters +- [`cooks.distance(`*``*`)`](https://hreinwald.github.io/drc/reference/cooks.distance.drc.md) + : Cook's distance for nonlinear dose-response models +- [`estfun(`*``*`)`](https://hreinwald.github.io/drc/reference/estfun.drc.md) + : Estimating function for the sandwich estimator +- [`fitted(`*``*`)`](https://hreinwald.github.io/drc/reference/fitted.drc.md) + : Extract fitted values from model +- [`hatvalues(`*``*`)`](https://hreinwald.github.io/drc/reference/hatvalues.drc.md) + : Model diagnostics for nonlinear dose-response models +- [`logLik(`*``*`)`](https://hreinwald.github.io/drc/reference/logLik.drc.md) + : Extracting the log likelihood +- [`plot(`*``*`)`](https://hreinwald.github.io/drc/reference/plot.drc.md) + : Plotting fitted dose-response curves +- [`predict(`*``*`)`](https://hreinwald.github.io/drc/reference/predict.drc.md) + : Prediction +- [`print(`*``*`)`](https://hreinwald.github.io/drc/reference/print.drc.md) + : Printing key features +- [`print(`*``*`)`](https://hreinwald.github.io/drc/reference/print.summary.drc.md) + : Printing summary of non-linear model fits +- [`residuals(`*``*`)`](https://hreinwald.github.io/drc/reference/residuals.drc.md) + : Extracting residuals from the fitted dose-response model +- [`summary(`*``*`)`](https://hreinwald.github.io/drc/reference/summary.drc.md) + : Summarising non-linear model fits +- [`update(`*``*`)`](https://hreinwald.github.io/drc/reference/update.drc.md) + : Updating and re-fitting a model +- [`vcov(`*``*`)`](https://hreinwald.github.io/drc/reference/vcov.drc.md) + : Calculating variance-covariance matrix for objects of class 'drc' +- [`bread(`*``*`)`](https://hreinwald.github.io/drc/reference/bread.drc.md) + : Bread for the sandwich estimator + +## Datasets + +Example datasets for dose-response analysis + +- [`acidiq`](https://hreinwald.github.io/drc/reference/acidiq.md) : + Acifluorfen and diquat tested on Lemna minor. + +- [`aconiazide`](https://hreinwald.github.io/drc/reference/aconiazide.md) + : Weight change in rats after exposure to a medical drug + +- [`acute.inh`](https://hreinwald.github.io/drc/reference/acute.inh.md) + : Acute inhalation + +- [`algae`](https://hreinwald.github.io/drc/reference/algae.md) : Volume + of algae as function of increasing concentrations of a herbicide + +- [`arbovirus`](https://hreinwald.github.io/drc/reference/arbovirus.md) + : arbovirus + +- [`auxins`](https://hreinwald.github.io/drc/reference/auxins.md) : + Effect of technical grade and commercially formulated auxin herbicides + +- [`barley`](https://hreinwald.github.io/drc/reference/barley.md) : + Barley + +- [`bees`](https://hreinwald.github.io/drc/reference/bees.md) : bees + +- [`blackgrass`](https://hreinwald.github.io/drc/reference/blackgrass.md) + : Seedling Emergence of Blackgrass (Alopecurus myosuroides) + +- [`broccoli`](https://hreinwald.github.io/drc/reference/broccoli.md) : + + The Effects of Drought Stress on Leaf Development in a *Brassica + oleracea* population + +- [`C.dubia`](https://hreinwald.github.io/drc/reference/C.dubia.md) : + Offsprings resulting from a toxicity test + +- [`CadmiumDaphnia`](https://hreinwald.github.io/drc/reference/CadmiumDaphnia.md) + : Cadmium Daphnia Data + +- [`carbendazim`](https://hreinwald.github.io/drc/reference/carbendazim.md) + : Damage of lymphocyte cells + +- [`chickweed`](https://hreinwald.github.io/drc/reference/chickweed.md) + : + + Germination of common chickweed (*Stellaria media*) + +- [`chlorac`](https://hreinwald.github.io/drc/reference/chlorac.md) : + chlorac + +- [`chlordan`](https://hreinwald.github.io/drc/reference/chlordan.md) : + Chlordan + +- [`ctb`](https://hreinwald.github.io/drc/reference/ctb.md) : + CellTiter-Blue Cell Viability Assay Data + +- [`Cyp17`](https://hreinwald.github.io/drc/reference/Cyp17.md) : Cyp17 + expression data + +- [`Daphnia`](https://hreinwald.github.io/drc/reference/Daphnia.md) : + Daphnia + +- [`daphnids`](https://hreinwald.github.io/drc/reference/daphnids.md) : + Daphnia test + +- [`decontaminants`](https://hreinwald.github.io/drc/reference/decontaminants.md) + : Performance of decontaminants used in the culturing of a + micro-organism + +- [`deguelin`](https://hreinwald.github.io/drc/reference/deguelin.md) : + Deguelin applied to chrysanthemum aphis + +- [`earthworms`](https://hreinwald.github.io/drc/reference/earthworms.md) + : Earthworm toxicity test + +- [`echovirus`](https://hreinwald.github.io/drc/reference/echovirus.md) + : + + Infections as response to exposure with *Echovirus 12* + +- [`Eryngium.sparganophyllum`](https://hreinwald.github.io/drc/reference/Eryngium.sparganophyllum.md) + : Germination of Eryngium sparganophyllum + +- [`etmotc`](https://hreinwald.github.io/drc/reference/etmotc.md) : + Effect of erythromycin on mixed sewage microorganisms + +- [`finney71`](https://hreinwald.github.io/drc/reference/finney71.md) : + Example from Finney (1971) + +- [`fluoranthene`](https://hreinwald.github.io/drc/reference/fluoranthene.md) + : Death of fathead minnow larvae after exposure to fluoranthene + +- [`germination`](https://hreinwald.github.io/drc/reference/germination.md) + : Germination of three crops + +- [`GiantKelp`](https://hreinwald.github.io/drc/reference/GiantKelp.md) + : Measurements of germination tubes for Giant Kelp + +- [`glymet`](https://hreinwald.github.io/drc/reference/glymet.md) : + Glyphosate and metsulfuron-methyl tested on algae. + +- [`guthion`](https://hreinwald.github.io/drc/reference/guthion.md) : + guthion + +- [`H.virescens`](https://hreinwald.github.io/drc/reference/H.virescens.md) + : Mortality of tobacco budworms + +- [`heartrate`](https://hreinwald.github.io/drc/reference/heartrate.md) + : Heart rate baroreflexes for rabbits + +- [`leaflength`](https://hreinwald.github.io/drc/reference/leaflength.md) + : Leaf length of barley + +- [`lemna`](https://hreinwald.github.io/drc/reference/lemna.md) : Lemna + +- [`lepidium`](https://hreinwald.github.io/drc/reference/lepidium.md) : + Dose-response profile of degradation of agrochemical using lepidium + +- [`lettuce`](https://hreinwald.github.io/drc/reference/lettuce.md) : + Hormesis in lettuce plants + +- [`liver.tumor`](https://hreinwald.github.io/drc/reference/liver.tumor.md) + : Liver tumor incidence + +- [`M.bahia`](https://hreinwald.github.io/drc/reference/M.bahia.md) : + Effect of an effluent on the growth of mysid shrimp + +- [`mdra`](https://hreinwald.github.io/drc/reference/mdra.md) : 3T3 + mouse fibroblasts and NRU assay + +- [`mecter`](https://hreinwald.github.io/drc/reference/mecter.md) : + Mechlorprop and terbythylazine tested on Lemna minor + +- [`metals`](https://hreinwald.github.io/drc/reference/metals.md) : Data + from heavy metal mixture experiments + +- [`methionine`](https://hreinwald.github.io/drc/reference/methionine.md) + : Weight gain for different methionine sources + +- [`mixture()`](https://hreinwald.github.io/drc/reference/mixture.md) : + Fitting binary mixture models + +- [`multi2()`](https://hreinwald.github.io/drc/reference/multi2.md) : + Multistage Dose-Response Model with Quadratic Terms + +- [`nasturtium`](https://hreinwald.github.io/drc/reference/nasturtium.md) + : Dose-response profile of degradation of agrochemical using + nasturtium + +- [`nfa`](https://hreinwald.github.io/drc/reference/nfa.md) : Network + Formation Assay Data + +- [`nicotine`](https://hreinwald.github.io/drc/reference/nicotine.md) : + nicotine + +- [`O.mykiss`](https://hreinwald.github.io/drc/reference/O.mykiss.md) : + Test data from a 21 day fish test + +- [`P.promelas`](https://hreinwald.github.io/drc/reference/P.promelas.md) + : Effect of sodium pentachlorophenate on growth of fathead minnow + +- [`RScompetition`](https://hreinwald.github.io/drc/reference/RScompetition.md) + : Competition between two biotypes + +- [`red.fescue`](https://hreinwald.github.io/drc/reference/red.fescue.md) + : Red fescue + +- [`ryegrass`](https://hreinwald.github.io/drc/reference/ryegrass.md) : + Effect of ferulic acid on growth of ryegrass + +- [`ryegrass2`](https://hreinwald.github.io/drc/reference/ryegrass2.md) + : Ryegrass + +- [`S.alba`](https://hreinwald.github.io/drc/reference/S.alba.md) : + Potency of two herbicides + +- [`S.alba.comp`](https://hreinwald.github.io/drc/reference/S.alba.comp.md) + : Potency of two herbicides + +- [`S.capricornutum`](https://hreinwald.github.io/drc/reference/S.capricornutum.md) + : Effect of cadmium on growth of green alga + +- [`secalonic`](https://hreinwald.github.io/drc/reference/secalonic.md) + : Root length measurements + +- [`selenium`](https://hreinwald.github.io/drc/reference/selenium.md) : + Data from toxicology experiments with selenium + +- [`spinach`](https://hreinwald.github.io/drc/reference/spinach.md) : + Inhibition of photosynthesis + +- [`TCDD`](https://hreinwald.github.io/drc/reference/TCDD.md) : Liver + tumor incidence + +- [`terbuthylazin`](https://hreinwald.github.io/drc/reference/terbuthylazin.md) + : The effect of terbuthylazin on growth rate + +- [`ursa()`](https://hreinwald.github.io/drc/reference/ursa.md) : + Universal Response Surface Approach (URSA) for Drug Interaction + +- [`vinclozolin`](https://hreinwald.github.io/drc/reference/vinclozolin.md) + : Vinclozolin from AR in vitro assay + +# Articles + +### Guides + +- [A Practical Workflow for Dose-Response + Analysis](https://hreinwald.github.io/drc/articles/dose-response-workflow.md): +- [Understanding NEC Models in the drc + Package](https://hreinwald.github.io/drc/articles/nec-models.md): + +### Technical Reports + +- [Comparative Analysis: hreinwald/drc vs + DoseResponse/drc](https://hreinwald.github.io/drc/articles/package-version-comparative-analysis.md): diff --git a/docs/logo.png b/docs/logo.png new file mode 100644 index 00000000..ad475ae7 Binary files /dev/null and b/docs/logo.png differ diff --git a/docs/news/index.html b/docs/news/index.html new file mode 100644 index 00000000..2cec56db --- /dev/null +++ b/docs/news/index.html @@ -0,0 +1,257 @@ + +Changelog • drc + Skip to contents + + +
    +
    +
    +

    Changelog

    + Source: NEWS.md +
    + +
    +

    drc 3.3.2

    +
    +

    New Features

    +
    • Enhanced plot.drc(): added errbar.lwd parameter for independent control of error bar line width in type = "bars" plots. When NULL (default), error bars inherit the line width from the lwd argument or fall back to par("lwd").
      • +
    +
    +

    Bug Fixes

    +
    • Fixed update.drc() to fall back to stored data (object$origData) when call$data cannot be resolved in the calling frame, enabling use of update() inside lapply(), purrr::map(), and other functional programming contexts.
      • +
    • Fixed vcDisc() to validate that the inverse Hessian has non-negative variances before returning, preventing invalid variance-covariance matrices from propagating downstream.
      • +
    +
    +

    Changes

    +
    • Tightened default relTol in drmc() from 1e-7 to 1e-10 for improved cross-platform reproducibility of optimization results.
      • +
    • Added comparative analysis vignette (comparative-analysis.Rmd) documenting differences between hreinwald/drc and the original DoseResponse/drc package.
      • +
    • Added “Articles” section to pkgdown navigation in _pkgdown.yml with categorized guides and technical reports.
      • +
    • Fixed flaky maED tests that depended on platform-specific convergence behavior.
      • +
    • Added test suites for boxcox.drc (functional programming context), update.drc (data resolution fallback), and vcDisc (singular Hessian handling).
      • +
    +
    +
    +

    drc 3.3.1

    +
    +

    New Features

    +
    • Enhanced plot.drc(): error bars in type = "bars" plots now match curve colors by default. Added errbar.col parameter to allow manual control of error bar colors. Set errbar.col = "black" to restore the previous behavior of black error bars.
      • +
    +
    +

    Bug Fixes

    +
    • Fixed summary() crash for binomial drm models when the Hessian is singular (DoseResponse/drc#36): vcDisc now uses a robust fallback chain (matching vcCont) instead of a bare solve() call. When inversion fails, a warning is emitted and standard errors are reported as NA.
      • +
    • Fixed logistic() model ED calculation with type="absolute": the edfct function now correctly handles absolute-to-relative conversion without applying the incorrect p-swap from EDhelper(). The logistic model has opposite b-sign convention from log-logistic (b < 0 means increasing, not decreasing), so EDhelper’s p-swap for b < 0 would incorrectly swap ED values. The fix uses inline absolute-to-relative conversion (p = 100·(d−respl)/(d−c)) for absolute type and p = respl directly for relative type.
      • +
    • Fixed model-level edfct derivatives for absolute ED type in braincousens(), fplogistic(), llogistic(), llogistic2(), lnormal(), weibull1(), and weibull2(): when type = "absolute", the gradient functions previously set ∂ED/∂c and ∂ED/∂d to 0, which was incorrect because the absolute-to-relative conversion makes p a function of c and d. The chain rule requires non-zero partials. Now compute ∂ED/∂c and ∂ED/∂d via central differences on a closure that captures the chain-rule contribution through the full ED computation path.
      • +
    +
    +
    +

    drc 3.3.0.03

    +
    +

    New Features

    +
    • Enhanced plot.drc(): error bars in type = "bars" plots now match curve colors by default. Added errbar.col parameter to allow manual control of error bar colors. Set errbar.col = "black" to restore the previous behavior of black error bars.
      • +
    +
    +

    Bug Fixes

    +
    • Fixed predict() “incorrect number of dimensions” error for models with many fixed parameters (e.g., EXD.3(fixed = c(lower, upper, NA))): when only one parameter is estimated, indexMat in the fitted model object is a vector rather than a matrix, causing predict.drc() to fail when computing standard errors or confidence intervals. Ensured indexMat is always coerced to a matrix before column subsetting.
      • +
    +
    +

    Changes

    +
    • Updated package version and date in DESCRIPTION and website documentation to 3.3.0.03.
      • +
    • Updated logo path in README.md to point to man/figures/logo.png for consistency with package structure.
      • +
    • Added favicon and manifest links to HTML documentation files for improved branding and browser integration.
      • +
    • Added the package website (https://hreinwald.github.io/drc) as the primary URL in the DESCRIPTION file for better discoverability.
      • +
    • Added the rss() function to the reference index in _pkgdown.yml.
      • +
    • Added logo image to the dose-response workflow vignette and updated the vignette date.
      • +
    • Simplified labeling of effective dose (ED) estimates in the workflow vignette outputs for clarity, removing the e:1: prefix.
      • +
    • Updated model comparison output in the vignette to include additional columns and more precise values.
      • +
    +
    +
    +

    drc 3.3.0.02

    +
    +

    New Features

    +
    • Added rss() function for computing the residual sum of squares of a fitted drc model. Refactored Rsq() to reuse rss() internally; both functions are now exported.
      • +
    +
    +

    Bug Fixes

    +
    • Fixed ED() for exponential decay models (EXD.2, EXD.3, AR.2, AR.3, W1.x, W2.x) with two fixed parameters: when only one parameter is estimated (1×1 variance-covariance matrix), the function previously failed with “incorrect number of dimensions” errors. Enhanced ED.drc to defensively coerce scalar/vector vcov inputs to proper matrices and to always strip names from gradients for consistent matrix algebra. This fix now allows retrieving ED values from exponential decay models with two fixed parameters, which was previously impossible.
      • +
    • Fixed gradient handling in ED() to ensure model-specific derivative functions always return unnamed numeric vectors, preventing dimension errors in delta-method standard error calculations.
      • +
    • Fixed boundary detection bugs in MAX(): used unname() so named return values from cedergreen models are compared correctly with unnamed lower/upper scalars, and added tolerance in boundary check since numerical optimizers return values near but not exactly at boundaries.
      • +
    • Fixed PR() dropping ... arguments for single-curve models.
      • +
    • Fixed all 17 issues in ucedergreen() function: missing +c term in model formula, edfct signature mismatch with the drc framework, undefined xlogx function call in deriv1, missing match.arg() validation for method, vectorized | operators in scalar if() guards, missing useFixed flag computation, maxfct signature mismatch and unsafe parameter indexing, broken self-starter ignoring alpha/method/useFixed, missing fctName/fctText parameters, deriv1 excluded from return list, and documentation issues.
      • +
    • Fixed SE calculation for absolute type ED(): the model-specific edfct gradient functions treated asymptote parameters as constants when type="absolute", missing the chain-rule contribution from the absToRel conversion and underestimating the standard error. Now uses numerical central differences with an improved adaptive step size. Added internal helpers .centralDiffGradient(), .safeConfintBasic(), and .computeSE() to make SE computation more robust: .computeSE() guards against non-positive-definite variance-covariance matrix slices (returning NA instead of erroring), and .safeConfintBasic() validates residual degrees of freedom before calling confint.basic(), falling back to a z-distribution when df.residual() returns an invalid value.
      • +
    • Fixed inverted otrace/silentVal logic in drmOpt() where otrace=TRUE incorrectly caused silent=TRUE in try(optim()), suppressing error messages instead of displaying them.
      • +
    • Fixed searchdrc() regex error and convergence failure behavior.
      • +
    • Fixed citation URL: reordered URLs in DESCRIPTION so citation('drc') returns the GitHub repository URL instead of r-project.org.
      • +
    • Fixed ED() “incorrect number of dimensions” error for models with few estimated parameters (e.g., EXD.3 with fixed c and d): ensured indexMat is always treated as a matrix before column subsetting.
      • +
    • Fixed ED() returning NaN with warning for LL.5 models with ill-conditioned parameters: added validity check to return Inf (indicating EC50 is outside valid range) instead of NaN when exp(-tempVal/parmVec[5]) - 1 is non-positive. Also fixed NaN handling in the check condition to prevent “missing value where TRUE/FALSE needed” errors in backfit() and other functions.
      • +
    • Fixed additional robustness issues in ED() / ED.drc: loop now always iterates over all curves and all response levels, filtering by clevel after computation rather than before; invMatList is grown dynamically to avoid NULL holes; curve label construction uses a single structured object with explicit match and display fields; variance-covariance matrix slices always use drop = FALSE to remain matrices.
      • +
    • Fixed mselect() missing two closing braces that caused a parse error when the function was sourced directly.
      • +
    • Fixed ED.lin.R bugs: removed a duplicate if-block (dead code that evaluated the same condition twice), removed a stray debug print() statement, and added the missing parameterNames = c("b0", "b1", "b2") argument to the deltaMethod() call for quadratic models (the omission caused incorrect parameter mapping and wrong confidence intervals).
      • +
    • Fixed CRS.4b() display text: fctText incorrectly showed "alpha=" instead of "alpha=0.5".
      • +
    • Fixed gammadr() first-derivative (deriv1) calculation: the gradient with respect to the dose parameter incorrectly used parmMat[, 1] (the rate parameter) where dose was required, producing wrong gradient values.
      • +
    • Fixed maED() model-averaging: models whose ED estimates are non-finite (Inf or NaN) are now detected and excluded from the weighted average (with a warning naming the model and the offending values); models that returned a try-error during fitting are also excluded. When all candidate models are excluded, the function returns NA for all estimates instead of 0 or NaN.
      • +
    • Added warning to noEffect() when degrees of freedom difference is ≤ 0, clarifying that the likelihood ratio test may not be meaningful when the dose-response model has no additional parameters compared to the null model (e.g., when most parameters are fixed).
      • +
    +
    +

    Changes

    +
    • Added NEWS.md version control log. Reformatted legacy news file into properly formatted NEWS.md with categorized sections.
      • +
    • Improved documentation for Weibull starting value method parameter across weibull1(), weibull2(), and all wrapper functions (W1.2, W1.3, W1.4, W2.2, W2.3, W2.4, AR.2, AR.3, EXD.2, EXD.3).
      • +
    • Enhanced roxygen2 documentation for ED and ED.drc functions with improved parameter descriptions and examples.
      • +
    • Added comprehensive test suites for anova.drclist,summary.drc, print.summary.drc, noEffect, searchdrc, backfit, getInitial, drmEMeventtime, repChar, rdrm, gompertzd, MAX(), and PR() functions.
      • +
    • Added comprehensive test suites for llogistic/LL.x models, weibull1/W1.x/EXD.x models, logistic.ssf, gammadr, EDcomp, mselect, drmOpt, modelFunction, modelFit, anova.drclist, rss, and ED.lin.
      • +
    • Large-scale dead code removal across 70+ R source files: removed commented-out function implementations, stray print() debug statements, old code paths, and if(FALSE){...} blocks. No logic changes; all roxygen2 documentation and meaningful explanatory comments were preserved.
      • +
    • Removed dead code iband.R and all associated references.
      • +
    • Removed unused inst/citation file, superseded by CITATION.cff at repository root.
      • +
    • Deleted build_pkgdown.R build script.
      • +
    • Added PLoS ONE 2015 article and CRC Press 2019 book references to CITATION.cff.
      • +
    • Updated installation instructions and README documentation.
      • +
    • Added magic to Suggests in DESCRIPTION for test dependency.
      • +
    +
    +
    +

    drc 3.3.0.01

    +
    +

    New Features

    +
    • Created comprehensive vignettes: dose-response-workflow.Rmd providing a complete tutorial on dose-response analysis, and nec-models.Rmd documenting No Effect Concentration modeling with NEC.2/NEC.3/NEC.4 function variants.
      • +
    • Set up pkgdown website infrastructure: added _pkgdown.yml with Bootstrap 5 configuration, created build_pkgdown.R script for build automation, documented pkgdown build process in README, and generated pkgdown documentation site.
      • +
    • Added computationally robust (stable) wrapper functions in new ED_robust.R module: ED_robust() for calculating ED values with proper error handling that returns NA instead of failing when an ED value is not estimable, maED_robust() for model-averaged ED estimation with the same graceful error handling, and get_ed_interval() for recommending appropriate confidence interval methods based on model type.
      • +
    • Added comprehensive test suite covering ED calculations, predictions, plotting, residuals, model selection, and utility functions.
      • +
    • Added drm_name() helper function to ED_robust.R.
      • +
    • Enhanced package startup message with citations and developer credits.
      • +
    • Added drm_legacy() as an internal reference function preserving the original drm() implementation.
      • +
    • Added testthat infrastructure with tests verifying drm() output matches drm_legacy() output across continuous, binomial, Poisson, and negative binomial data types.
      • +
    • Added comprehensive anova tests.
      • +
    +
    +

    Bug Fixes

    +
    • Fixed vignette build by removing vignettes from .Rbuildignore and correcting incorrect mselect() usage in examples.
      • +
    • Fixed Rd comment warning by escaping the %*% operator in documentation.
      • +
    • Fixed all devtools::check() errors and warnings: added roxygen2 @keywords and lifecycle deprecation notices for deprecated CRS functions, expanded dataset documentation files with examples, added missing dataset aliases, and fixed Weibull model documentation.
      • +
    • Fixed division-by-zero in Rsq() and absToRel().
      • +
    • Removed dead scaleEst() stub function.
      • +
    • Fixed inherits() bug in mselect.R.
      • +
    • Added edge case handling in modelFit.R.
      • +
    • Added input validation for comped() and compParm().
      • +
    • Fixed unsafe global state modification via options(warn), incorrect compParm od/pool handling, and residuals division by zero.
      • +
    • Fixed NaN warning in summary.drc for robust estimation methods (metric trimming, Winsorizing, Tukey’s biweight).
      • +
    • Improved predict.drc and vcov.drc to resolve 23 test failures.
      • +
    • Fixed mselect() to always compute Lack of fit p-values for all models, not only when nested=TRUE.
      • +
    • Fixed a bug in anova.drclist where negative or non-finite F statistics produced NaN p-values; negative F statistics now return p-value of 1 and non-finite F statistics return NA.
      • +
    • Fixed duplicate aliases and unstated dependencies in examples.
      • +
    • Fixed package dependency warnings: added data.table and dplyr to Imports, updated NAMESPACE with required imports.
      • +
    • Fixed S3 method consistency issues and changed confint.basic roxygen tag from @exportS3Method to @export.
      • +
    • Fixed escaped LaTeX special characters in roxygen2 documentation and Rd files.
      • +
    • Fixed escaped percent signs in roxygen docs causing Rd parse warnings.
      • +
    +
    +

    Changes

    +
    • Added vignette access information to README.
      • +
    • Completed comprehensive roxygen2 documentation audit: added missing @param tags, removed dontrun/donttest wrappers to enable automated example testing, and fixed broken examples across documentation files.
      • +
    • Enhanced dataset documentation: improved descriptions and fixed typos in dataset .Rd files, added examples sections to dataset .Rd files that were missing them.
      • +
    • Improved confint.drc robustness: added stop() fallback to switch() in confint.basic() to handle unknown intType values gracefully instead of returning silent NULL.
      • +
    • Removed @export from confint.basic() as internal helpers should not be part of the public API.
      • +
    • Enhanced roxygen2 documentation for CRS.5, convenience functions, and ED_robust with improved argument descriptions.
      • +
    • Updated DESCRIPTION: added Hannes Reinwald as maintainer and co-author, updated package version to 3.3.0.01.
      • +
    • Removed external drcData package dependency; example datasets are now bundled directly in the package data/ directory.
      • +
    • Added .Rd documentation files for all bundled datasets.
      • +
    • Renamed internal variables for clarity: ndRows to nRows in predict.drc, posIdx to validVar in summary.drc.
      • +
    • Added test coverage documentation.
      • +
    • Renamed all 33 R source files from lowercase .r to uppercase .R extensions for consistency.
      • +
    • Updated all .Rd documentation files to reference the new file names.
      • +
    • Added GNU General Public License version 2 file and updated license version from GPL-2 to GPL-2.0 in DESCRIPTION.
      • +
    • Added Hannes Reinwald as author in the DESCRIPTION file.
      • +
    • Updated README with revised installation instructions and bug report link.
      • +
    • Migrated all package documentation to roxygen2-generated Rd files.
      • +
    • Regenerated NAMESPACE via roxygen2.
      • +
    • Added @exportS3Method tags to S3 methods in confint.drc.R and mrdrm.r.
      • +
    • Updated package version format from 3.3-0 to 3.3.0.
      • +
    • Lowered the minimum R version requirement to 4.0.0.
      • +
    +
    +

    Breaking Changes

    +
    • Removed deprecated developmental cedergreen2 function.
      • +
    +
    +
    +

    drc 3.3.0

    +
    +

    New Features

    +
    • Added new CRS.5 wrapper function and CRS.6 six-parameter model where the alpha exponent is estimated rather than fixed.
      • +
    +
    +

    Bug Fixes

    +
    • Fixed a bug where the stop() call for using separate curves with control measurements was inside the if(!noMessage) block, meaning it would be silently skipped when messages were suppressed.
      • +
    • Fixed a bug in noEffect.R where the Poisson null model incorrectly referenced resp instead of using the response vector from the fitted object.
      • +
    +
    +

    Changes

    +
    • Refactored the Cedergreen-Ritz-Streibig hormesis model: extracted edfct and maxfct into standalone helper functions (cedergreen_edfct, cedergreen_maxfct), refactored the self-starter function, and improved documentation.
      • +
    • Cleaned up drm() function by removing approximately 900 lines of commented-out dead code, debug print statements, and old experimental implementations.
      • +
    • Removed unused variable isfi and redundant variable lenData (identical to numObs).
      • +
    • Removed a dead loop over pmodelsList2 that could never execute.
      • +
    • Added roxygen2 documentation headers to all R source files across the package.
      • +
    • Fixed typos in source code and manual pages: ‘insted’ to ‘instead’ in gaussian.r and lgaussian.R, duplicate parameter name ‘e1’ to ‘e2’ in ursa.r, ‘contain’ to ‘contents’ in EDcomp.R, ‘mising’ to ‘missing’ and ‘reponses’ to ‘responses’ in drm.Rd, and ‘reponse’ to ‘response’ in CRS.5a.Rd.
      • +
    • Updated DESCRIPTION file: added Encoding field (UTF-8), fixed Authors@R to use proper person() format, removed deprecated Maintainer and LazyLoad fields, added missing Imports (graphics, utils), and updated URLs from HTTP to HTTPS.
      • +
    • Comprehensive repository cleanup and code quality improvements.
      • +
    • Removed obsolete configuration files (.travis.yml, drc.Rproj, _pkgdown.yml, README.Rmd) and redundant reference files (_gitignore, _Rbuildignore).
      • +
    • Removed the /tests directory containing outdated development artifacts with no testing value.
      • +
    • Updated .gitignore and .Rbuildignore with standard R/RStudio settings.
      • +
    • Rewrote README.md with comprehensive documentation including quick-start examples, available models, key functions, and supported data types.
      • +
    • Removed debug print() statements in drmEMstandard.R and findbe.r.
      • +
    • Removed dead code block (commented-out experimental code wrapped in if (FALSE)) in drmEMstandard.R and llogistic.ssf.R.
      • +
    • Replaced unsafe eval(parse(text=...)) calls with match.fun() and do.call() in rdrm.r.
      • +
    • Improved options() handling in searchdrc.R by saving and restoring the original warn setting using on.exit(add=TRUE).
      • +
    +
    +

    Deprecated

    +
    • Deprecated old CRS function names (CRS.4a, CRS.4b, CRS.4c, CRS.5a, CRS.5b, CRS.5c) with lifecycle notices in favor of new wrappers.
      • +
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/news/index.md b/docs/news/index.md new file mode 100644 index 00000000..9aa1a8bf --- /dev/null +++ b/docs/news/index.md @@ -0,0 +1,506 @@ +# Changelog + +## drc 3.3.2 + +### New Features + +- Enhanced + [`plot.drc()`](https://hreinwald.github.io/drc/reference/plot.drc.md): + added `errbar.lwd` parameter for independent control of error bar line + width in `type = "bars"` plots. When `NULL` (default), error bars + inherit the line width from the `lwd` argument or fall back to + `par("lwd")`. + +### Bug Fixes + +- Fixed + [`update.drc()`](https://hreinwald.github.io/drc/reference/update.drc.md) + to fall back to stored data (`object$origData`) when `call$data` + cannot be resolved in the calling frame, enabling use of + [`update()`](https://rdrr.io/r/stats/update.html) inside + [`lapply()`](https://rdrr.io/r/base/lapply.html), + [`purrr::map()`](https://purrr.tidyverse.org/reference/map.html), and + other functional programming contexts. +- Fixed `vcDisc()` to validate that the inverse Hessian has non-negative + variances before returning, preventing invalid variance-covariance + matrices from propagating downstream. + +### Changes + +- Tightened default `relTol` in + [`drmc()`](https://hreinwald.github.io/drc/reference/drmc.md) from + `1e-7` to `1e-10` for improved cross-platform reproducibility of + optimization results. +- Added comparative analysis vignette (`comparative-analysis.Rmd`) + documenting differences between `hreinwald/drc` and the original + `DoseResponse/drc` package. +- Added “Articles” section to pkgdown navigation in `_pkgdown.yml` with + categorized guides and technical reports. +- Fixed flaky `maED` tests that depended on platform-specific + convergence behavior. +- Added test suites for `boxcox.drc` (functional programming context), + `update.drc` (data resolution fallback), and `vcDisc` (singular + Hessian handling). + +------------------------------------------------------------------------ + +## drc 3.3.1 + +### New Features + +- Enhanced + [`plot.drc()`](https://hreinwald.github.io/drc/reference/plot.drc.md): + error bars in `type = "bars"` plots now match curve colors by default. + Added `errbar.col` parameter to allow manual control of error bar + colors. Set `errbar.col = "black"` to restore the previous behavior of + black error bars. + +### Bug Fixes + +- Fixed [`summary()`](https://rdrr.io/r/base/summary.html) crash for + binomial `drm` models when the Hessian is singular + (DoseResponse/drc#36): `vcDisc` now uses a robust fallback chain + (matching `vcCont`) instead of a bare + [`solve()`](https://rdrr.io/r/base/solve.html) call. When inversion + fails, a warning is emitted and standard errors are reported as `NA`. +- Fixed + [`logistic()`](https://hreinwald.github.io/drc/reference/logistic.md) + model ED calculation with `type="absolute"`: the `edfct` function now + correctly handles absolute-to-relative conversion without applying the + incorrect p-swap from + [`EDhelper()`](https://hreinwald.github.io/drc/reference/EDhelper.md). + The logistic model has opposite b-sign convention from log-logistic (b + \< 0 means increasing, not decreasing), so `EDhelper`’s p-swap for b + \< 0 would incorrectly swap ED values. The fix uses inline + absolute-to-relative conversion (`p = 100·(d−respl)/(d−c)`) for + absolute type and `p = respl` directly for relative type. +- Fixed model-level `edfct` derivatives for absolute ED type in + [`braincousens()`](https://hreinwald.github.io/drc/reference/braincousens.md), + [`fplogistic()`](https://hreinwald.github.io/drc/reference/fplogistic.md), + [`llogistic()`](https://hreinwald.github.io/drc/reference/llogistic.md), + [`llogistic2()`](https://hreinwald.github.io/drc/reference/llogistic2.md), + [`lnormal()`](https://hreinwald.github.io/drc/reference/lnormal.md), + [`weibull1()`](https://hreinwald.github.io/drc/reference/weibull1.md), + and + [`weibull2()`](https://hreinwald.github.io/drc/reference/weibull2.md): + when `type = "absolute"`, the gradient functions previously set ∂ED/∂c + and ∂ED/∂d to 0, which was incorrect because the absolute-to-relative + conversion makes p a function of c and d. The chain rule requires + non-zero partials. Now compute ∂ED/∂c and ∂ED/∂d via central + differences on a closure that captures the chain-rule contribution + through the full ED computation path. + +------------------------------------------------------------------------ + +## drc 3.3.0.03 + +### New Features + +- Enhanced + [`plot.drc()`](https://hreinwald.github.io/drc/reference/plot.drc.md): + error bars in `type = "bars"` plots now match curve colors by default. + Added `errbar.col` parameter to allow manual control of error bar + colors. Set `errbar.col = "black"` to restore the previous behavior of + black error bars. + +### Bug Fixes + +- Fixed [`predict()`](https://rdrr.io/r/stats/predict.html) “incorrect + number of dimensions” error for models with many fixed parameters + (e.g., `EXD.3(fixed = c(lower, upper, NA))`): when only one parameter + is estimated, `indexMat` in the fitted model object is a vector rather + than a matrix, causing + [`predict.drc()`](https://hreinwald.github.io/drc/reference/predict.drc.md) + to fail when computing standard errors or confidence intervals. + Ensured `indexMat` is always coerced to a matrix before column + subsetting. + +### Changes + +- Updated package version and date in `DESCRIPTION` and website + documentation to `3.3.0.03`. +- Updated logo path in `README.md` to point to `man/figures/logo.png` + for consistency with package structure. +- Added favicon and manifest links to HTML documentation files for + improved branding and browser integration. +- Added the package website (`https://hreinwald.github.io/drc`) as the + primary URL in the `DESCRIPTION` file for better discoverability. +- Added the [`rss()`](https://hreinwald.github.io/drc/reference/rss.md) + function to the reference index in `_pkgdown.yml`. +- Added logo image to the dose-response workflow vignette and updated + the vignette date. +- Simplified labeling of effective dose (ED) estimates in the workflow + vignette outputs for clarity, removing the `e:1:` prefix. +- Updated model comparison output in the vignette to include additional + columns and more precise values. + +------------------------------------------------------------------------ + +## drc 3.3.0.02 + +### New Features + +- Added [`rss()`](https://hreinwald.github.io/drc/reference/rss.md) + function for computing the residual sum of squares of a fitted `drc` + model. Refactored + [`Rsq()`](https://hreinwald.github.io/drc/reference/Rsq.md) to reuse + [`rss()`](https://hreinwald.github.io/drc/reference/rss.md) + internally; both functions are now exported. + +### Bug Fixes + +- Fixed [`ED()`](https://hreinwald.github.io/drc/reference/ED.md) for + exponential decay models (EXD.2, EXD.3, AR.2, AR.3, W1.x, W2.x) with + two fixed parameters: when only one parameter is estimated (1×1 + variance-covariance matrix), the function previously failed with + “incorrect number of dimensions” errors. Enhanced `ED.drc` to + defensively coerce scalar/vector `vcov` inputs to proper matrices and + to always strip names from gradients for consistent matrix algebra. + This fix now allows retrieving ED values from exponential decay models + with two fixed parameters, which was previously impossible. +- Fixed gradient handling in + [`ED()`](https://hreinwald.github.io/drc/reference/ED.md) to ensure + model-specific derivative functions always return unnamed numeric + vectors, preventing dimension errors in delta-method standard error + calculations. +- Fixed boundary detection bugs in + [`MAX()`](https://hreinwald.github.io/drc/reference/MAX.md): used + [`unname()`](https://rdrr.io/r/base/unname.html) so named return + values from cedergreen models are compared correctly with unnamed + lower/upper scalars, and added tolerance in boundary check since + numerical optimizers return values near but not exactly at boundaries. +- Fixed [`PR()`](https://hreinwald.github.io/drc/reference/PR.md) + dropping `...` arguments for single-curve models. +- Fixed all 17 issues in + [`ucedergreen()`](https://hreinwald.github.io/drc/reference/ucedergreen.md) + function: missing `+c` term in model formula, `edfct` signature + mismatch with the drc framework, undefined `xlogx` function call in + `deriv1`, missing + [`match.arg()`](https://rdrr.io/r/base/match.arg.html) validation for + `method`, vectorized `|` operators in scalar `if()` guards, missing + `useFixed` flag computation, `maxfct` signature mismatch and unsafe + parameter indexing, broken self-starter ignoring + `alpha`/`method`/`useFixed`, missing `fctName`/`fctText` parameters, + `deriv1` excluded from return list, and documentation issues. +- Fixed SE calculation for absolute type + [`ED()`](https://hreinwald.github.io/drc/reference/ED.md): the + model-specific `edfct` gradient functions treated asymptote parameters + as constants when `type="absolute"`, missing the chain-rule + contribution from the `absToRel` conversion and underestimating the + standard error. Now uses numerical central differences with an + improved adaptive step size. Added internal helpers + `.centralDiffGradient()`, `.safeConfintBasic()`, and `.computeSE()` to + make SE computation more robust: `.computeSE()` guards against + non-positive-definite variance-covariance matrix slices (returning + `NA` instead of erroring), and `.safeConfintBasic()` validates + residual degrees of freedom before calling + [`confint.basic()`](https://hreinwald.github.io/drc/reference/confint.basic.md), + falling back to a z-distribution when + [`df.residual()`](https://rdrr.io/r/stats/df.residual.html) returns an + invalid value. +- Fixed inverted `otrace`/`silentVal` logic in + [`drmOpt()`](https://hreinwald.github.io/drc/reference/drmOpt.md) + where `otrace=TRUE` incorrectly caused `silent=TRUE` in + `try(optim())`, suppressing error messages instead of displaying them. +- Fixed + [`searchdrc()`](https://hreinwald.github.io/drc/reference/searchdrc.md) + regex error and convergence failure behavior. +- Fixed citation URL: reordered URLs in DESCRIPTION so `citation('drc')` + returns the GitHub repository URL instead of r-project.org. +- Fixed [`ED()`](https://hreinwald.github.io/drc/reference/ED.md) + “incorrect number of dimensions” error for models with few estimated + parameters (e.g., EXD.3 with fixed c and d): ensured `indexMat` is + always treated as a matrix before column subsetting. +- Fixed [`ED()`](https://hreinwald.github.io/drc/reference/ED.md) + returning NaN with warning for LL.5 models with ill-conditioned + parameters: added validity check to return `Inf` (indicating EC50 is + outside valid range) instead of NaN when + `exp(-tempVal/parmVec[5]) - 1` is non-positive. Also fixed NaN + handling in the check condition to prevent “missing value where + TRUE/FALSE needed” errors in + [`backfit()`](https://hreinwald.github.io/drc/reference/backfit.md) + and other functions. +- Fixed additional robustness issues in + [`ED()`](https://hreinwald.github.io/drc/reference/ED.md) / `ED.drc`: + loop now always iterates over all curves and all response levels, + filtering by `clevel` after computation rather than before; + `invMatList` is grown dynamically to avoid NULL holes; curve label + construction uses a single structured object with explicit `match` and + `display` fields; variance-covariance matrix slices always use + `drop = FALSE` to remain matrices. +- Fixed + [`mselect()`](https://hreinwald.github.io/drc/reference/mselect.md) + missing two closing braces that caused a parse error when the function + was sourced directly. +- Fixed `ED.lin.R` bugs: removed a duplicate `if`-block (dead code that + evaluated the same condition twice), removed a stray debug + [`print()`](https://rdrr.io/r/base/print.html) statement, and added + the missing `parameterNames = c("b0", "b1", "b2")` argument to the + `deltaMethod()` call for quadratic models (the omission caused + incorrect parameter mapping and wrong confidence intervals). +- Fixed + [`CRS.4b()`](https://hreinwald.github.io/drc/reference/CRS.4b.md) + display text: `fctText` incorrectly showed `"alpha="` instead of + `"alpha=0.5"`. +- Fixed + [`gammadr()`](https://hreinwald.github.io/drc/reference/gammadr.md) + first-derivative (`deriv1`) calculation: the gradient with respect to + the dose parameter incorrectly used `parmMat[, 1]` (the rate + parameter) where `dose` was required, producing wrong gradient values. +- Fixed [`maED()`](https://hreinwald.github.io/drc/reference/maED.md) + model-averaging: models whose ED estimates are non-finite (`Inf` or + `NaN`) are now detected and excluded from the weighted average (with a + warning naming the model and the offending values); models that + returned a `try-error` during fitting are also excluded. When all + candidate models are excluded, the function returns `NA` for all + estimates instead of `0` or `NaN`. +- Added warning to + [`noEffect()`](https://hreinwald.github.io/drc/reference/noEffect.md) + when degrees of freedom difference is ≤ 0, clarifying that the + likelihood ratio test may not be meaningful when the dose-response + model has no additional parameters compared to the null model (e.g., + when most parameters are fixed). + +### Changes + +- Added `NEWS.md` version control log. Reformatted legacy news file into + properly formatted `NEWS.md` with categorized sections. +- Improved documentation for Weibull starting value `method` parameter + across + [`weibull1()`](https://hreinwald.github.io/drc/reference/weibull1.md), + [`weibull2()`](https://hreinwald.github.io/drc/reference/weibull2.md), + and all wrapper functions (`W1.2`, `W1.3`, `W1.4`, `W2.2`, `W2.3`, + `W2.4`, `AR.2`, `AR.3`, `EXD.2`, `EXD.3`). +- Enhanced roxygen2 documentation for `ED` and `ED.drc` functions with + improved parameter descriptions and examples. +- Added comprehensive test suites for `anova.drclist`,`summary.drc`, + `print.summary.drc`, `noEffect`, `searchdrc`, `backfit`, `getInitial`, + `drmEMeventtime`, `repChar`, `rdrm`, `gompertzd`, + [`MAX()`](https://hreinwald.github.io/drc/reference/MAX.md), and + [`PR()`](https://hreinwald.github.io/drc/reference/PR.md) functions. +- Added comprehensive test suites for `llogistic`/LL.x models, + `weibull1`/W1.x/EXD.x models, `logistic.ssf`, `gammadr`, `EDcomp`, + `mselect`, `drmOpt`, `modelFunction`, `modelFit`, `anova.drclist`, + `rss`, and `ED.lin`. +- Large-scale dead code removal across 70+ R source files: removed + commented-out function implementations, stray + [`print()`](https://rdrr.io/r/base/print.html) debug statements, old + code paths, and `if(FALSE){...}` blocks. No logic changes; all + roxygen2 documentation and meaningful explanatory comments were + preserved. +- Removed dead code `iband.R` and all associated references. +- Removed unused `inst/citation` file, superseded by `CITATION.cff` at + repository root. +- Deleted `build_pkgdown.R` build script. +- Added PLoS ONE 2015 article and CRC Press 2019 book references to + `CITATION.cff`. +- Updated installation instructions and README documentation. +- Added `magic` to Suggests in DESCRIPTION for test dependency. + +------------------------------------------------------------------------ + +## drc 3.3.0.01 + +### New Features + +- Created comprehensive vignettes: `dose-response-workflow.Rmd` + providing a complete tutorial on dose-response analysis, and + `nec-models.Rmd` documenting No Effect Concentration modeling with + `NEC.2`/`NEC.3`/`NEC.4` function variants. +- Set up pkgdown website infrastructure: added `_pkgdown.yml` with + Bootstrap 5 configuration, created `build_pkgdown.R` script for build + automation, documented pkgdown build process in README, and generated + pkgdown documentation site. +- Added computationally robust (stable) wrapper functions in new + `ED_robust.R` module: + [`ED_robust()`](https://hreinwald.github.io/drc/reference/ED_robust.md) + for calculating ED values with proper error handling that returns `NA` + instead of failing when an ED value is not estimable, + [`maED_robust()`](https://hreinwald.github.io/drc/reference/maED_robust.md) + for model-averaged ED estimation with the same graceful error + handling, and + [`get_ed_interval()`](https://hreinwald.github.io/drc/reference/get_ed_interval.md) + for recommending appropriate confidence interval methods based on + model type. +- Added comprehensive test suite covering ED calculations, predictions, + plotting, residuals, model selection, and utility functions. +- Added `drm_name()` helper function to `ED_robust.R`. +- Enhanced package startup message with citations and developer credits. +- Added + [`drm_legacy()`](https://hreinwald.github.io/drc/reference/drm_legacy.md) + as an internal reference function preserving the original + [`drm()`](https://hreinwald.github.io/drc/reference/drm.md) + implementation. +- Added testthat infrastructure with tests verifying + [`drm()`](https://hreinwald.github.io/drc/reference/drm.md) output + matches + [`drm_legacy()`](https://hreinwald.github.io/drc/reference/drm_legacy.md) + output across continuous, binomial, Poisson, and negative binomial + data types. +- Added comprehensive anova tests. + +### Bug Fixes + +- Fixed vignette build by removing vignettes from `.Rbuildignore` and + correcting incorrect + [`mselect()`](https://hreinwald.github.io/drc/reference/mselect.md) + usage in examples. +- Fixed Rd comment warning by escaping the `%*%` operator in + documentation. +- Fixed all + [`devtools::check()`](https://devtools.r-lib.org/reference/check.html) + errors and warnings: added roxygen2 `@keywords` and lifecycle + deprecation notices for deprecated CRS functions, expanded dataset + documentation files with examples, added missing dataset aliases, and + fixed Weibull model documentation. +- Fixed division-by-zero in + [`Rsq()`](https://hreinwald.github.io/drc/reference/Rsq.md) and + [`absToRel()`](https://hreinwald.github.io/drc/reference/absToRel.md). +- Removed dead `scaleEst()` stub function. +- Fixed [`inherits()`](https://rdrr.io/r/base/class.html) bug in + `mselect.R`. +- Added edge case handling in `modelFit.R`. +- Added input validation for + [`comped()`](https://hreinwald.github.io/drc/reference/comped.md) and + [`compParm()`](https://hreinwald.github.io/drc/reference/compParm.md). +- Fixed unsafe global state modification via `options(warn)`, incorrect + `compParm` od/pool handling, and residuals division by zero. +- Fixed NaN warning in `summary.drc` for robust estimation methods + (metric trimming, Winsorizing, Tukey’s biweight). +- Improved `predict.drc` and `vcov.drc` to resolve 23 test failures. +- Fixed + [`mselect()`](https://hreinwald.github.io/drc/reference/mselect.md) to + always compute Lack of fit p-values for all models, not only when + `nested=TRUE`. +- Fixed a bug in `anova.drclist` where negative or non-finite F + statistics produced NaN p-values; negative F statistics now return + p-value of 1 and non-finite F statistics return NA. +- Fixed duplicate aliases and unstated dependencies in examples. +- Fixed package dependency warnings: added `data.table` and `dplyr` to + Imports, updated NAMESPACE with required imports. +- Fixed S3 method consistency issues and changed `confint.basic` roxygen + tag from `@exportS3Method` to `@export`. +- Fixed escaped LaTeX special characters in roxygen2 documentation and + Rd files. +- Fixed escaped percent signs in roxygen docs causing Rd parse warnings. + +### Changes + +- Added vignette access information to README. +- Completed comprehensive roxygen2 documentation audit: added missing + `@param` tags, removed `dontrun`/`donttest` wrappers to enable + automated example testing, and fixed broken examples across + documentation files. +- Enhanced dataset documentation: improved descriptions and fixed typos + in dataset `.Rd` files, added examples sections to dataset `.Rd` files + that were missing them. +- Improved `confint.drc` robustness: added + [`stop()`](https://rdrr.io/r/base/stop.html) fallback to + [`switch()`](https://rdrr.io/r/base/switch.html) in + [`confint.basic()`](https://hreinwald.github.io/drc/reference/confint.basic.md) + to handle unknown `intType` values gracefully instead of returning + silent NULL. +- Removed `@export` from + [`confint.basic()`](https://hreinwald.github.io/drc/reference/confint.basic.md) + as internal helpers should not be part of the public API. +- Enhanced roxygen2 documentation for `CRS.5`, convenience functions, + and `ED_robust` with improved argument descriptions. +- Updated DESCRIPTION: added Hannes Reinwald as maintainer and + co-author, updated package version to 3.3.0.01. +- Removed external `drcData` package dependency; example datasets are + now bundled directly in the package `data/` directory. +- Added `.Rd` documentation files for all bundled datasets. +- Renamed internal variables for clarity: `ndRows` to `nRows` in + `predict.drc`, `posIdx` to `validVar` in `summary.drc`. +- Added test coverage documentation. +- Renamed all 33 R source files from lowercase `.r` to uppercase `.R` + extensions for consistency. +- Updated all `.Rd` documentation files to reference the new file names. +- Added GNU General Public License version 2 file and updated license + version from GPL-2 to GPL-2.0 in DESCRIPTION. +- Added Hannes Reinwald as author in the DESCRIPTION file. +- Updated README with revised installation instructions and bug report + link. +- Migrated all package documentation to roxygen2-generated Rd files. +- Regenerated NAMESPACE via roxygen2. +- Added `@exportS3Method` tags to S3 methods in `confint.drc.R` and + `mrdrm.r`. +- Updated package version format from 3.3-0 to 3.3.0. +- Lowered the minimum R version requirement to 4.0.0. + +### Breaking Changes + +- Removed deprecated developmental `cedergreen2` function. + +------------------------------------------------------------------------ + +## drc 3.3.0 + +### New Features + +- Added new `CRS.5` wrapper function and `CRS.6` six-parameter model + where the alpha exponent is estimated rather than fixed. + +### Bug Fixes + +- Fixed a bug where the [`stop()`](https://rdrr.io/r/base/stop.html) + call for using separate curves with control measurements was inside + the `if(!noMessage)` block, meaning it would be silently skipped when + messages were suppressed. +- Fixed a bug in `noEffect.R` where the Poisson null model incorrectly + referenced `resp` instead of using the response vector from the fitted + object. + +### Changes + +- Refactored the Cedergreen-Ritz-Streibig hormesis model: extracted + `edfct` and `maxfct` into standalone helper functions + (`cedergreen_edfct`, `cedergreen_maxfct`), refactored the self-starter + function, and improved documentation. +- Cleaned up [`drm()`](https://hreinwald.github.io/drc/reference/drm.md) + function by removing approximately 900 lines of commented-out dead + code, debug print statements, and old experimental implementations. +- Removed unused variable `isfi` and redundant variable `lenData` + (identical to `numObs`). +- Removed a dead loop over `pmodelsList2` that could never execute. +- Added roxygen2 documentation headers to all R source files across the + package. +- Fixed typos in source code and manual pages: ‘insted’ to ‘instead’ in + `gaussian.r` and `lgaussian.R`, duplicate parameter name ‘e1’ to ‘e2’ + in `ursa.r`, ‘contain’ to ‘contents’ in `EDcomp.R`, ‘mising’ to + ‘missing’ and ‘reponses’ to ‘responses’ in `drm.Rd`, and ‘reponse’ to + ‘response’ in `CRS.5a.Rd`. +- Updated DESCRIPTION file: added Encoding field (UTF-8), fixed + `Authors@R` to use proper + [`person()`](https://rdrr.io/r/utils/person.html) format, removed + deprecated Maintainer and LazyLoad fields, added missing Imports + (`graphics`, `utils`), and updated URLs from HTTP to HTTPS. +- Comprehensive repository cleanup and code quality improvements. +- Removed obsolete configuration files (`.travis.yml`, `drc.Rproj`, + `_pkgdown.yml`, `README.Rmd`) and redundant reference files + (`_gitignore`, `_Rbuildignore`). +- Removed the `/tests` directory containing outdated development + artifacts with no testing value. +- Updated `.gitignore` and `.Rbuildignore` with standard R/RStudio + settings. +- Rewrote `README.md` with comprehensive documentation including + quick-start examples, available models, key functions, and supported + data types. +- Removed debug [`print()`](https://rdrr.io/r/base/print.html) + statements in `drmEMstandard.R` and `findbe.r`. +- Removed dead code block (commented-out experimental code wrapped in + `if (FALSE)`) in `drmEMstandard.R` and `llogistic.ssf.R`. +- Replaced unsafe `eval(parse(text=...))` calls with + [`match.fun()`](https://rdrr.io/r/base/match.fun.html) and + [`do.call()`](https://rdrr.io/r/base/do.call.html) in `rdrm.r`. +- Improved [`options()`](https://rdrr.io/r/base/options.html) handling + in `searchdrc.R` by saving and restoring the original warn setting + using `on.exit(add=TRUE)`. + +### Deprecated + +- Deprecated old CRS function names (`CRS.4a`, `CRS.4b`, `CRS.4c`, + `CRS.5a`, `CRS.5b`, `CRS.5c`) with lifecycle notices in favor of new + wrappers. + +------------------------------------------------------------------------ diff --git a/docs/pkgdown.css b/docs/pkgdown.css deleted file mode 100644 index 6ca2f37a..00000000 --- a/docs/pkgdown.css +++ /dev/null @@ -1,232 +0,0 @@ -/* Sticky footer */ - -/** - * Basic idea: https://philipwalton.github.io/solved-by-flexbox/demos/sticky-footer/ - * Details: https://github.com/philipwalton/solved-by-flexbox/blob/master/assets/css/components/site.css - * - * .Site -> body > .container - * .Site-content -> body > .container .row - * .footer -> footer - * - * Key idea seems to be to ensure that .container and __all its parents__ - * have height set to 100% - * - */ - -html, body { - height: 100%; -} - -body > .container { - display: flex; - height: 100%; - flex-direction: column; - - padding-top: 60px; -} - -body > .container .row { - flex: 1 0 auto; -} - -footer { - margin-top: 45px; - padding: 35px 0 36px; - border-top: 1px solid #e5e5e5; - color: #666; - display: flex; - flex-shrink: 0; -} -footer p { - margin-bottom: 0; -} -footer div { - flex: 1; -} -footer .pkgdown { - text-align: right; -} -footer p { - margin-bottom: 0; -} - -img.icon { - float: right; -} - -img { - max-width: 100%; -} - -/* Typographic tweaking ---------------------------------*/ - -.contents h1.page-header { - margin-top: calc(-60px + 1em); -} - -/* Section anchors ---------------------------------*/ - -a.anchor { - margin-left: -30px; - display:inline-block; - width: 30px; - height: 30px; - visibility: hidden; - - background-image: url(./link.svg); - background-repeat: no-repeat; - background-size: 20px 20px; - background-position: center center; -} - -.hasAnchor:hover a.anchor { - visibility: visible; -} - -@media (max-width: 767px) { - .hasAnchor:hover a.anchor { - visibility: hidden; - } -} - - -/* Fixes for fixed navbar --------------------------*/ - -.contents h1, .contents h2, .contents h3, .contents h4 { - padding-top: 60px; - margin-top: -40px; -} - -/* Static header placement on mobile devices */ -@media (max-width: 767px) { - .navbar-fixed-top { - position: absolute; - } - .navbar { - padding: 0; - } -} - - -/* Sidebar --------------------------*/ - -#sidebar { - margin-top: 30px; -} -#sidebar h2 { - font-size: 1.5em; - margin-top: 1em; -} - -#sidebar h2:first-child { - margin-top: 0; -} - -#sidebar .list-unstyled li { - margin-bottom: 0.5em; -} - -.orcid { - height: 16px; - vertical-align: middle; -} - -/* Reference index & topics ----------------------------------------------- */ - -.ref-index th {font-weight: normal;} - -.ref-index td {vertical-align: top;} -.ref-index .alias {width: 40%;} -.ref-index .title {width: 60%;} - -.ref-index .alias {width: 40%;} -.ref-index .title {width: 60%;} - -.ref-arguments th {text-align: right; padding-right: 10px;} -.ref-arguments th, .ref-arguments td {vertical-align: top;} -.ref-arguments .name {width: 20%;} -.ref-arguments .desc {width: 80%;} - -/* Nice scrolling for wide elements --------------------------------------- */ - -table { - display: block; - overflow: auto; -} - -/* Syntax highlighting ---------------------------------------------------- */ - -pre { - word-wrap: normal; - word-break: normal; - border: 1px solid #eee; -} - -pre, code { - background-color: #f8f8f8; - color: #333; -} - -pre code { - overflow: auto; - word-wrap: normal; - white-space: pre; -} - -pre .img { - margin: 5px 0; -} - -pre .img img { - background-color: #fff; - display: block; - height: auto; -} - -code a, pre a { - color: #375f84; -} - -a.sourceLine:hover { - text-decoration: none; -} - -.fl {color: #1514b5;} -.fu {color: #000000;} /* function */ -.ch,.st {color: #036a07;} /* string */ -.kw {color: #264D66;} /* keyword */ -.co {color: #888888;} /* comment */ - -.message { color: black; font-weight: bolder;} -.error { color: orange; font-weight: bolder;} -.warning { color: #6A0366; font-weight: bolder;} - -/* Clipboard --------------------------*/ - -.hasCopyButton { - position: relative; -} - -.btn-copy-ex { - position: absolute; - right: 0; - top: 0; - visibility: hidden; -} - -.hasCopyButton:hover button.btn-copy-ex { - visibility: visible; -} - -/* mark.js ----------------------------*/ - -mark { - background-color: rgba(255, 255, 51, 0.5); - border-bottom: 2px solid rgba(255, 153, 51, 0.3); - padding: 1px; -} - -/* vertical spacing after htmlwidgets */ -.html-widget { - margin-bottom: 10px; -} diff --git a/docs/pkgdown.js b/docs/pkgdown.js index de9bd724..0a5573ae 100644 --- a/docs/pkgdown.js +++ b/docs/pkgdown.js @@ -1,110 +1,162 @@ /* http://gregfranko.com/blog/jquery-best-practices/ */ -(function($) { - $(function() { - - $("#sidebar") - .stick_in_parent({offset_top: 40}) - .on('sticky_kit:bottom', function(e) { - $(this).parent().css('position', 'static'); - }) - .on('sticky_kit:unbottom', function(e) { - $(this).parent().css('position', 'relative'); - }); +(function ($) { + $(function () { + + $('nav.navbar').headroom(); - $('body').scrollspy({ - target: '#sidebar', - offset: 60 + Toc.init({ + $nav: $("#toc"), + $scope: $("main h2, main h3, main h4, main h5, main h6") }); - $('[data-toggle="tooltip"]').tooltip(); - - var cur_path = paths(location.pathname); - var links = $("#navbar ul li a"); - var max_length = -1; - var pos = -1; - for (var i = 0; i < links.length; i++) { - if (links[i].getAttribute("href") === "#") - continue; - var path = paths(links[i].pathname); - - var length = prefix_length(cur_path, path); - if (length > max_length) { - max_length = length; - pos = i; - } + if ($('#toc').length) { + $('body').scrollspy({ + target: '#toc', + offset: $("nav.navbar").outerHeight() + 1 + }); } - // Add class to parent
  • , and enclosing
  • if in dropdown - if (pos >= 0) { - var menu_anchor = $(links[pos]); - menu_anchor.parent().addClass("active"); - menu_anchor.closest("li.dropdown").addClass("active"); - } - }); + // Activate popovers + $('[data-bs-toggle="popover"]').popover({ + container: 'body', + html: true, + trigger: 'focus', + placement: "top", + sanitize: false, + }); - function paths(pathname) { - var pieces = pathname.split("/"); - pieces.shift(); // always starts with / + $('[data-bs-toggle="tooltip"]').tooltip(); - var end = pieces[pieces.length - 1]; - if (end === "index.html" || end === "") - pieces.pop(); - return(pieces); - } + /* Clipboard --------------------------*/ - function prefix_length(needle, haystack) { - if (needle.length > haystack.length) - return(0); - - // Special case for length-0 haystack, since for loop won't run - if (haystack.length === 0) { - return(needle.length === 0 ? 1 : 0); + function changeTooltipMessage(element, msg) { + var tooltipOriginalTitle = element.getAttribute('data-bs-original-title'); + element.setAttribute('data-bs-original-title', msg); + $(element).tooltip('show'); + element.setAttribute('data-bs-original-title', tooltipOriginalTitle); } - for (var i = 0; i < haystack.length; i++) { - if (needle[i] != haystack[i]) - return(i); - } + if (ClipboardJS.isSupported()) { + $(document).ready(function () { + var copyButton = ""; - return(haystack.length); - } + $("div.sourceCode").addClass("hasCopyButton"); - /* Clipboard --------------------------*/ + // Insert copy buttons: + $(copyButton).prependTo(".hasCopyButton"); - function changeTooltipMessage(element, msg) { - var tooltipOriginalTitle=element.getAttribute('data-original-title'); - element.setAttribute('data-original-title', msg); - $(element).tooltip('show'); - element.setAttribute('data-original-title', tooltipOriginalTitle); - } + // Initialize tooltips: + $('.btn-copy-ex').tooltip({ container: 'body' }); - if(Clipboard.isSupported()) { - $(document).ready(function() { - var copyButton = ""; + // Initialize clipboard: + var clipboard = new ClipboardJS('[data-clipboard-copy]', { + text: function (trigger) { + return trigger.parentNode.textContent.replace(/\n#>[^\n]*/g, ""); + } + }); - $(".examples, div.sourceCode").addClass("hasCopyButton"); + clipboard.on('success', function (e) { + changeTooltipMessage(e.trigger, 'Copied!'); + e.clearSelection(); + }); - // Insert copy buttons: - $(copyButton).prependTo(".hasCopyButton"); + clipboard.on('error', function (e) { + changeTooltipMessage(e.trigger, 'Press Ctrl+C or Command+C to copy'); + }); - // Initialize tooltips: - $('.btn-copy-ex').tooltip({container: 'body'}); + }); + } - // Initialize clipboard: - var clipboardBtnCopies = new Clipboard('[data-clipboard-copy]', { - text: function(trigger) { - return trigger.parentNode.textContent; + /* Search marking --------------------------*/ + var url = new URL(window.location.href); + var toMark = url.searchParams.get("q"); + var mark = new Mark("main#main"); + if (toMark) { + mark.mark(toMark, { + accuracy: { + value: "complementary", + limiters: [",", ".", ":", "/"], } }); + } - clipboardBtnCopies.on('success', function(e) { - changeTooltipMessage(e.trigger, 'Copied!'); - e.clearSelection(); - }); + /* Search --------------------------*/ + /* Adapted from https://github.com/rstudio/bookdown/blob/2d692ba4b61f1e466c92e78fd712b0ab08c11d31/inst/resources/bs4_book/bs4_book.js#L25 */ + // Initialise search index on focus + var fuse; + $("#search-input").focus(async function (e) { + if (fuse) { + return; + } - clipboardBtnCopies.on('error', function() { - changeTooltipMessage(e.trigger,'Press Ctrl+C or Command+C to copy'); - }); + $(e.target).addClass("loading"); + var response = await fetch($("#search-input").data("search-index")); + var data = await response.json(); + + var options = { + keys: ["what", "text", "code"], + ignoreLocation: true, + threshold: 0.1, + includeMatches: true, + includeScore: true, + }; + fuse = new Fuse(data, options); + + $(e.target).removeClass("loading"); }); - } + + // Use algolia autocomplete + var options = { + autoselect: true, + debug: true, + hint: false, + minLength: 2, + }; + var q; + async function searchFuse(query, callback) { + await fuse; + + var items; + if (!fuse) { + items = []; + } else { + q = query; + var results = fuse.search(query, { limit: 20 }); + items = results + .filter((x) => x.score <= 0.75) + .map((x) => x.item); + if (items.length === 0) { + items = [{ dir: "Sorry 😿", previous_headings: "", title: "No results found.", what: "No results found.", path: window.location.href }]; + } + } + callback(items); + } + $("#search-input").autocomplete(options, [ + { + name: "content", + source: searchFuse, + templates: { + suggestion: (s) => { + if (s.title == s.what) { + return `${s.dir} >
    ${s.title}
    `; + } else if (s.previous_headings == "") { + return `${s.dir} >
    ${s.title}
    > ${s.what}`; + } else { + return `${s.dir} >
    ${s.title}
    > ${s.previous_headings} > ${s.what}`; + } + }, + }, + }, + ]).on('autocomplete:selected', function (event, s) { + window.location.href = s.path + "?q=" + q + "#" + s.id; + }); + }); })(window.jQuery || window.$) + +document.addEventListener('keydown', function (event) { + // Check if the pressed key is '/' + if (event.key === '/') { + event.preventDefault(); // Prevent any default action associated with the '/' key + document.getElementById('search-input').focus(); // Set focus to the search input + } +}); diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml index f279cc12..8ddc736d 100644 --- a/docs/pkgdown.yml +++ b/docs/pkgdown.yml @@ -1,5 +1,11 @@ -pandoc: 1.19.2.1 -pkgdown: 1.1.0 +pandoc: 3.6.3 +pkgdown: 2.2.0 pkgdown_sha: ~ -articles: [] - +articles: + dose-response-workflow: dose-response-workflow.html + nec-models: nec-models.html + package-version-comparative-analysis: package-version-comparative-analysis.html +last_built: 2026-05-26T13:53Z +urls: + reference: https://hreinwald.github.io/drc/reference + article: https://hreinwald.github.io/drc/articles diff --git a/docs/reference/AR-1.png b/docs/reference/AR-1.png deleted file mode 100644 index c9e80b4b..00000000 Binary files a/docs/reference/AR-1.png and /dev/null differ diff --git a/docs/reference/AR.2.html b/docs/reference/AR.2.html new file mode 100644 index 00000000..d123dc0e --- /dev/null +++ b/docs/reference/AR.2.html @@ -0,0 +1,113 @@ + +Two-parameter asymptotic regression model — AR.2 • drc + Skip to contents + + +
    +
    +
    +

    Two-parameter asymptotic regression model

    + Source: R/weibull2.R +
    AR.2.Rd
    +
    + +
    +

    A two-parameter asymptotic regression model where b is fixed at 1 and +the lower limit is fixed at 0. The model is given by the equation +$$f(x) = d \cdot (1 - \exp(-x / e))$$

    +
    + +
    +

    Usage

    + 
    AR.2(fixed = c(NA, NA), names = c("d", "e"), ...)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector of length 2, specifying fixed parameters (use NA for +parameters that should be estimated).

    + + +
    names
    +

    character vector of length 2 giving the names of the parameters +(default c("d", "e")).

    + + +
    ...
    +

    additional arguments passed to weibull2, most +notably method (a character string: "1" (default), +"2", "3", or "4") which selects the self-starter +method for obtaining starting values. See weibull2 for +details.

    + +
    +
    +

    Value

    +

    A list of class "Weibull-2" as returned by weibull2.

    +
    +
    +

    See also

    +

    AR.3, weibull2, EXD.2

    +
    + +
    +

    Examples

    + 
    ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = AR.2())
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/AR.2.md b/docs/reference/AR.2.md new file mode 100644 index 00000000..98f1ffb2 --- /dev/null +++ b/docs/reference/AR.2.md @@ -0,0 +1,50 @@ +# Two-parameter asymptotic regression model + +A two-parameter asymptotic regression model where `b` is fixed at 1 and +the lower limit is fixed at 0. The model is given by the equation +\$\$f(x) = d \cdot (1 - \exp(-x / e))\$\$ + +## Usage + +``` r +AR.2(fixed = c(NA, NA), names = c("d", "e"), ...) +``` + +## Arguments + +- fixed: + + numeric vector of length 2, specifying fixed parameters (use `NA` for + parameters that should be estimated). + +- names: + + character vector of length 2 giving the names of the parameters + (default `c("d", "e")`). + +- ...: + + additional arguments passed to + [`weibull2`](https://hreinwald.github.io/drc/reference/weibull2.md), + most notably `method` (a character string: `"1"` (default), `"2"`, + `"3"`, or `"4"`) which selects the self-starter method for obtaining + starting values. See + [`weibull2`](https://hreinwald.github.io/drc/reference/weibull2.md) + for details. + +## Value + +A list of class `"Weibull-2"` as returned by +[`weibull2`](https://hreinwald.github.io/drc/reference/weibull2.md). + +## See also + +[`AR.3`](https://hreinwald.github.io/drc/reference/AR.3.md), +[`weibull2`](https://hreinwald.github.io/drc/reference/weibull2.md), +[`EXD.2`](https://hreinwald.github.io/drc/reference/EXD.2.md) + +## Examples + +``` r +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = AR.2()) +``` diff --git a/docs/reference/AR.3.html b/docs/reference/AR.3.html new file mode 100644 index 00000000..98b68959 --- /dev/null +++ b/docs/reference/AR.3.html @@ -0,0 +1,113 @@ + +Three-parameter shifted asymptotic regression model — AR.3 • drc + Skip to contents + + +
    +
    +
    +

    Three-parameter shifted asymptotic regression model

    + Source: R/weibull2.R +
    AR.3.Rd
    +
    + +
    +

    A three-parameter asymptotic regression model where b is fixed at 1. +The model is given by the equation +$$f(x) = c + (d - c)(1 - \exp(-x / e))$$

    +
    + +
    +

    Usage

    + 
    AR.3(fixed = c(NA, NA, NA), names = c("c", "d", "e"), ...)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector of length 3, specifying fixed parameters (use NA for +parameters that should be estimated).

    + + +
    names
    +

    character vector of length 3 giving the names of the parameters +(default c("c", "d", "e")).

    + + +
    ...
    +

    additional arguments passed to weibull2, most +notably method (a character string: "1" (default), +"2", "3", or "4") which selects the self-starter +method for obtaining starting values. See weibull2 for +details.

    + +
    +
    +

    Value

    +

    A list of class "Weibull-2" as returned by weibull2.

    +
    +
    +

    See also

    +

    AR.2, weibull2, EXD.3

    +
    + +
    +

    Examples

    + 
    ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = AR.3())
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/AR.3.md b/docs/reference/AR.3.md new file mode 100644 index 00000000..bef4ed08 --- /dev/null +++ b/docs/reference/AR.3.md @@ -0,0 +1,50 @@ +# Three-parameter shifted asymptotic regression model + +A three-parameter asymptotic regression model where `b` is fixed at 1. +The model is given by the equation \$\$f(x) = c + (d - c)(1 - \exp(-x / +e))\$\$ + +## Usage + +``` r +AR.3(fixed = c(NA, NA, NA), names = c("c", "d", "e"), ...) +``` + +## Arguments + +- fixed: + + numeric vector of length 3, specifying fixed parameters (use `NA` for + parameters that should be estimated). + +- names: + + character vector of length 3 giving the names of the parameters + (default `c("c", "d", "e")`). + +- ...: + + additional arguments passed to + [`weibull2`](https://hreinwald.github.io/drc/reference/weibull2.md), + most notably `method` (a character string: `"1"` (default), `"2"`, + `"3"`, or `"4"`) which selects the self-starter method for obtaining + starting values. See + [`weibull2`](https://hreinwald.github.io/drc/reference/weibull2.md) + for details. + +## Value + +A list of class `"Weibull-2"` as returned by +[`weibull2`](https://hreinwald.github.io/drc/reference/weibull2.md). + +## See also + +[`AR.2`](https://hreinwald.github.io/drc/reference/AR.2.md), +[`weibull2`](https://hreinwald.github.io/drc/reference/weibull2.md), +[`EXD.3`](https://hreinwald.github.io/drc/reference/EXD.3.md) + +## Examples + +``` r +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = AR.3()) +``` diff --git a/docs/reference/AR.html b/docs/reference/AR.html deleted file mode 100644 index 731d8cdf..00000000 --- a/docs/reference/AR.html +++ /dev/null @@ -1,246 +0,0 @@ - - - - - - - - -Asymptotic regression model — AR • drc - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    -
    - - - -
    - -
    -
    -
    -

    Asymptotic regression model

    - - -
    - -
    - -

    Providing the mean function and the corresponding self starter function for the asymptotic regression model.

    - -
    - - 
    AR.2(fixed = c(NA, NA), names = c("d", "e"), ...)
-
-  AR.3(fixed = c(NA, NA, NA), names = c("c", "d", "e"), ...)
    - -

    Arguments

    - - - - - - - - - - - - - - -
    fixed

    numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.

    names

    vector of character strings giving the names of the parameters (should not contain ":").

    ...

    additional arguments to be passed from the convenience functions.

    - -

    Details

    - -

    The asymptotic regression model is a three-parameter model with mean function:

    -

    $$ f(x) = c + (d-c)(1-\exp(-x/e))$$

    -

    The parameter \(c\) is the lower limit (at \(x=0\)), the parameter \(d\) is the upper limit - and the parameter \(e>0\) is determining the steepness of the increase as \(x\).

    - -

    Value

    - -

    A list of class drcMean, containing the mean function, the self starter function, - the parameter names and other components such as derivatives and a function for calculating ED values.

    - -

    Note

    - -

    The functions are for use with the function drm.

    - -

    See also

    - -

    A very similar, but monotonously decreasing model is the exponential decay model: - EXD.2 and EXD.3.

    - - -

    Examples

    - 
    
-## First model
-met.as.m1<-drm(gain ~ dose, product, data = methionine, fct = AR.3(),
-pmodels = list(~1, ~factor(product), ~factor(product)))
    #> Control measurements detected for level: control
    plot(met.as.m1, log = "", ylim = c(1450, 1800))
    summary(met.as.m1)
    #> 
-#> Model fitted: Shifted asymptotic regression (3 parms)
-#> 
-#> Parameter estimates:
-#> 
-#>                 Estimate Std. Error  t-value   p-value    
-#> c:(Intercept) 1.4536e+03 1.0764e+01 135.0395 1.804e-08 ***
-#> d:DLM         1.6892e+03 9.8280e+00 171.8804 6.873e-09 ***
-#> d:MHA         1.7541e+03 2.1369e+01  82.0855 1.320e-07 ***
-#> e:DLM         4.5386e-02 7.4128e-03   6.1226  0.003605 ** 
-#> e:MHA         9.2668e-02 1.6516e-02   5.6109  0.004957 ** 
-#> ---
-#> Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
-#> 
-#> Residual standard error:
-#> 
-#>  11.20328 (4 degrees of freedom)
    
-## Calculating bioefficacy: approach 1
-coef(met.as.m1)[5] / coef(met.as.m1)[4] * 100
    #>    e:MHA 
-#> 204.1797 
    
-## Calculating bioefficacy: approach 2
-EDcomp(met.as.m1, c(50,50))
    #> 
-#> Estimated ratios of effect doses
-#> 
-#>                 Estimate Std. Error    t-value    p-value
-#> DLM/MHA:50/50  0.4897647  0.1091974 -4.6725956  0.0094999
    
-## Simplified models
-met.as.m2<-drm(gain ~ dose, product, data = methionine, fct = AR.3(),
-pmodels = list(~1, ~1, ~factor(product)))
    #> Control measurements detected for level: control
    anova(met.as.m2, met.as.m1)  # simplification not possible
    #> 
-#> 1st model
-#>  fct:     AR.3()
-#>  pmodels: ~1, ~1, ~factor(product)
-#> 2nd model
-#>  fct:     AR.3()
-#>  pmodels: ~1, ~factor(product), ~factor(product)
-#> 
    #> ANOVA table
-#> 
-#>           ModelDf     RSS Df F value p value
-#> 1st model       5 1861.77                   
-#> 2nd model       4  502.05  1 10.8332  0.0302
    
-met.as.m3 <- drm(gain ~ dose, product, data = methionine, fct = AR.3(),
-pmodels = list(~1, ~factor(product), ~1))
    #> Control measurements detected for level: control
    anova(met.as.m3, met.as.m1)  # simplification not possible
    #> 
-#> 1st model
-#>  fct:     AR.3()
-#>  pmodels: ~1, ~factor(product), ~1
-#> 2nd model
-#>  fct:     AR.3()
-#>  pmodels: ~1, ~factor(product), ~factor(product)
-#> 
    #> ANOVA table
-#> 
-#>           ModelDf     RSS Df F value p value
-#> 1st model       5 1878.73                   
-#> 2nd model       4  502.05  1 10.9683  0.0296
    
-
    -
    - -
    - -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    -
    - -
    -

    Site built with pkgdown.

    -
    - -
    -
    - - - - - - diff --git a/docs/reference/BC-1.png b/docs/reference/BC-1.png deleted file mode 100644 index e0d60e8d..00000000 Binary files a/docs/reference/BC-1.png and /dev/null differ diff --git a/docs/reference/BC.4.html b/docs/reference/BC.4.html new file mode 100644 index 00000000..b31a81f2 --- /dev/null +++ b/docs/reference/BC.4.html @@ -0,0 +1,134 @@ + +Four-parameter Brain-Cousens hormesis model — BC.4 • drc + Skip to contents + + +
    +
    +
    +

    Four-parameter Brain-Cousens hormesis model

    + Source: R/braincousens.R +
    BC.4.Rd
    +
    + +
    +

    BC.4 provides the Brain-Cousens modified log-logistic model with the lower limit fixed at 0.

    +
    + +
    +

    Usage

    + 
    BC.4(fixed = c(NA, NA, NA, NA), names = c("b", "d", "e", "f"), ...)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector of length 4 specifying fixed parameters (NAs for free parameters).

    + + +
    names
    +

    a vector of character strings giving the names of the parameters.

    + + +
    ...
    +

    additional arguments passed to braincousens.

    + +
    +
    +

    Value

    +

    A list (see braincousens).

    +
    +
    +

    References

    +

    van Ewijk, P. H. and Hoekstra, J. A. (1993) +Calculation of the EC50 and its Confidence Interval When Subtoxic Stimulus Is Present, +Ecotoxicology and Environmental Safety, 25, 25–32.

    +
    +
    +

    See also

    +

    braincousens, BC.5

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    + +
    +

    Examples

    + 
    lettuce.bcm2 <- drm(weight ~ conc, data = lettuce, fct = BC.4())
+summary(lettuce.bcm2)
+#> 
+#> Model fitted: Brain-Cousens (hormesis) with lower limit fixed at 0 (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept) 1.282812   0.049346 25.9964 1.632e-10 ***
+#> d:(Intercept) 0.967302   0.077123 12.5423 1.926e-07 ***
+#> e:(Intercept) 0.847633   0.436093  1.9437   0.08059 .  
+#> f:(Intercept) 1.620703   0.979711  1.6543   0.12908    
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.1117922 (10 degrees of freedom)
+ED(lettuce.bcm2, c(50))
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error
+#> e:50   35.023     15.427
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/BC.4.md b/docs/reference/BC.4.md new file mode 100644 index 00000000..72daac50 --- /dev/null +++ b/docs/reference/BC.4.md @@ -0,0 +1,75 @@ +# Four-parameter Brain-Cousens hormesis model + +`BC.4` provides the Brain-Cousens modified log-logistic model with the +lower limit fixed at 0. + +## Usage + +``` r +BC.4(fixed = c(NA, NA, NA, NA), names = c("b", "d", "e", "f"), ...) +``` + +## Arguments + +- fixed: + + numeric vector of length 4 specifying fixed parameters (NAs for free + parameters). + +- names: + + a vector of character strings giving the names of the parameters. + +- ...: + + additional arguments passed to + [`braincousens`](https://hreinwald.github.io/drc/reference/braincousens.md). + +## Value + +A list (see +[`braincousens`](https://hreinwald.github.io/drc/reference/braincousens.md)). + +## References + +van Ewijk, P. H. and Hoekstra, J. A. (1993) Calculation of the EC50 and +its Confidence Interval When Subtoxic Stimulus Is Present, +*Ecotoxicology and Environmental Safety*, **25**, 25–32. + +## See also + +[`braincousens`](https://hreinwald.github.io/drc/reference/braincousens.md), +[`BC.5`](https://hreinwald.github.io/drc/reference/BC.5.md) + +## Author + +Christian Ritz + +## Examples + +``` r +lettuce.bcm2 <- drm(weight ~ conc, data = lettuce, fct = BC.4()) +summary(lettuce.bcm2) +#> +#> Model fitted: Brain-Cousens (hormesis) with lower limit fixed at 0 (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 1.282812 0.049346 25.9964 1.632e-10 *** +#> d:(Intercept) 0.967302 0.077123 12.5423 1.926e-07 *** +#> e:(Intercept) 0.847633 0.436093 1.9437 0.08059 . +#> f:(Intercept) 1.620703 0.979711 1.6543 0.12908 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.1117922 (10 degrees of freedom) +ED(lettuce.bcm2, c(50)) +#> +#> Estimated effective doses +#> +#> Estimate Std. Error +#> e:50 35.023 15.427 +``` diff --git a/docs/reference/BC.5-1.png b/docs/reference/BC.5-1.png new file mode 100644 index 00000000..1fbcc12c Binary files /dev/null and b/docs/reference/BC.5-1.png differ diff --git a/docs/reference/BC.5.html b/docs/reference/BC.5.html new file mode 100644 index 00000000..45c54ad4 --- /dev/null +++ b/docs/reference/BC.5.html @@ -0,0 +1,116 @@ + +Five-parameter Brain-Cousens hormesis model — BC.5 • drc + Skip to contents + + +
    +
    +
    +

    Five-parameter Brain-Cousens hormesis model

    + Source: R/braincousens.R +
    BC.5.Rd
    +
    + +
    +

    BC.5 provides the full five-parameter Brain-Cousens modified log-logistic model +for describing hormesis.

    +
    + +
    +

    Usage

    + 
    BC.5(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector of length 5 specifying fixed parameters (NAs for free parameters).

    + + +
    names
    +

    a vector of character strings giving the names of the parameters.

    + + +
    ...
    +

    additional arguments passed to braincousens.

    + +
    +
    +

    Value

    +

    A list (see braincousens).

    +
    +
    +

    See also

    +

    braincousens, BC.4

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    + +
    +

    Examples

    + 
    lettuce.bcm1 <- drm(weight ~ conc, data = lettuce, fct = BC.5())
+modelFit(lettuce.bcm1)
+#> Lack-of-fit test
+#> 
+#>           ModelDf      RSS Df F value p value
+#> ANOVA           7 0.088237                   
+#> DRC model       9 0.118842  2  1.2140  0.3527
+plot(lettuce.bcm1)
+
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/BC.5.md b/docs/reference/BC.5.md new file mode 100644 index 00000000..b9fcb031 --- /dev/null +++ b/docs/reference/BC.5.md @@ -0,0 +1,54 @@ +# Five-parameter Brain-Cousens hormesis model + +`BC.5` provides the full five-parameter Brain-Cousens modified +log-logistic model for describing hormesis. + +## Usage + +``` r +BC.5(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...) +``` + +## Arguments + +- fixed: + + numeric vector of length 5 specifying fixed parameters (NAs for free + parameters). + +- names: + + a vector of character strings giving the names of the parameters. + +- ...: + + additional arguments passed to + [`braincousens`](https://hreinwald.github.io/drc/reference/braincousens.md). + +## Value + +A list (see +[`braincousens`](https://hreinwald.github.io/drc/reference/braincousens.md)). + +## See also + +[`braincousens`](https://hreinwald.github.io/drc/reference/braincousens.md), +[`BC.4`](https://hreinwald.github.io/drc/reference/BC.4.md) + +## Author + +Christian Ritz + +## Examples + +``` r +lettuce.bcm1 <- drm(weight ~ conc, data = lettuce, fct = BC.5()) +modelFit(lettuce.bcm1) +#> Lack-of-fit test +#> +#> ModelDf RSS Df F value p value +#> ANOVA 7 0.088237 +#> DRC model 9 0.118842 2 1.2140 0.3527 +plot(lettuce.bcm1) + +``` diff --git a/docs/reference/BC.html b/docs/reference/BC.html deleted file mode 100644 index 1b8d0496..00000000 --- a/docs/reference/BC.html +++ /dev/null @@ -1,288 +0,0 @@ - - - - - - - - -The Brain-Cousens hormesis models — BC.5 • drc - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    -
    - - - -
    - -
    -
    -
    -

    The Brain-Cousens hormesis models

    - - -
    - -
    - -

    'BC.4' and 'BC.5' provide the Brain-Cousens modified log-logistic models for describing u-shaped hormesis.

    - -
    - - 
    BC.5(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...)
-
-  BC.4(fixed = c(NA, NA, NA, NA), names = c("b", "d", "e", "f"), ...)
    - -

    Arguments

    - - - - - - - - - - - - - - -
    fixed

    numeric vector specifying which parameters are fixed and at which values they are fixed. - NAs designate parameters that are not fixed.

    names

    a vector of character strings giving the names of the parameters.

    ...

    additional arguments to be passed from the convenience functions.

    - -

    Details

    - -

    The model function for the Brain-Cousens model (Brain and Cousens, 1989) is

    -

    $$ f(x, b,c,d,e,f) = c + \frac{d-c+fx}{1+\exp(b(\log(x)-\log(e)))}$$,

    -

    and it is a five-parameter model, obtained by extending the four-parameter log-logistic model (LL.4 - to take into account inverse u-shaped hormesis effects.

    -

    The parameters have the following interpretations

      -

    • \(b\): Not direct interpretation

      • -

    • \(c\): Lower horizontal asymptote

      • -

    • \(d\): Upper horizontal asymptote

      • -

    • \(e\): Not direct interpretation

      • -

    • \(f\): Size of the hormesis effect: the larger the value the larger is the hormesis effect. \(f=0\) - corresponds to no hormesis effect and the resulting model is the four-parameter log-logistic model. - This parameter should be positive in order for the model to make sense.

      • -
    -

    Fixing the lower limit at 0 yields the four-parameter model

    -

    $$ f(x) = 0 + \frac{d-0+fx}{1+\exp(b(\log(x)-\log(e)))}$$

    -

    used by van Ewijk and Hoekstra (1993).

    - -

    Value

    - -

    See braincousens.

    - -

    References

    - -

    Brain, P. and Cousens, R. (1989) An equation to describe dose responses - where there is stimulation of growth at low doses, - Weed Research, 29, 93--96.

    -

    van Ewijk, P. H. and Hoekstra, J. A. (1993) - Calculation of the EC50 and its Confidence Interval When Subtoxic Stimulus Is Present, - Ecotoxicology and Environmental Safety, 25, 25--32.

    - -

    Note

    - -

    This function is for use with the function drm.

    - -

    See also

    - -

    More details are found for the general model function braincousens.

    - - -

    Examples

    - 
    
-## Fitting the data in van Ewijk and Hoekstra (1993)
-lettuce.bcm1 <- drm(weight ~ conc, data = lettuce, fct=BC.5())
-modelFit(lettuce.bcm1)
    #> Lack-of-fit test
-#> 
-#>           ModelDf      RSS Df F value p value
-#> ANOVA           7 0.088237                   
-#> DRC model       9 0.118842  2  1.2140  0.3527
    plot(lettuce.bcm1)
    
-lettuce.bcm2 <- drm(weight ~conc, data = lettuce, fct=BC.4())
-summary(lettuce.bcm2)
    #> 
-#> Model fitted: Brain-Cousens (hormesis) with lower limit fixed at 0 (4 parms)
-#> 
-#> Parameter estimates:
-#> 
-#>               Estimate Std. Error t-value   p-value    
-#> b:(Intercept) 1.282812   0.049346 25.9964 1.632e-10 ***
-#> d:(Intercept) 0.967302   0.077123 12.5423 1.926e-07 ***
-#> e:(Intercept) 0.847633   0.436093  1.9437   0.08059 .  
-#> f:(Intercept) 1.620703   0.979711  1.6543   0.12908    
-#> ---
-#> Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
-#> 
-#> Residual standard error:
-#> 
-#>  0.1117922 (10 degrees of freedom)
    ED(lettuce.bcm2, c(50))
    #> 
-#> Estimated effective doses
-#> 
-#>        Estimate Std. Error
-#> e:1:50   35.023     15.427
    # compare the parameter estimate and 
-# its estimated standard error 
-# to the values in the paper by 
-# van Ewijk and Hoekstra (1993)
-
-
-## Brain-Cousens model with the constraint b>3
-ryegrass.bcm1 <- drm(rootl ~conc, data = ryegrass, fct = BC.5(),
-lower = c(3, -Inf, -Inf, -Inf, -Inf), control = drmc(constr=TRUE))
-
-summary(ryegrass.bcm1)
    #> 
-#> Model fitted: Brain-Cousens (hormesis) (5 parms)
-#> 
-#> Parameter estimates:
-#> 
-#>               Estimate Std. Error t-value   p-value    
-#> b:(Intercept)  3.00000    0.72020  4.1655  0.000525 ***
-#> c:(Intercept)  0.48364    0.25420  1.9026  0.072357 .  
-#> d:(Intercept)  7.74462    0.21500 36.0210 < 2.2e-16 ***
-#> e:(Intercept)  2.92416    0.56297  5.1942 5.162e-05 ***
-#> f:(Intercept)  0.15886    0.67583  0.2351  0.816675    
-#> ---
-#> Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
-#> 
-#> Residual standard error:
-#> 
-#>  0.5311668 (19 degrees of freedom)
    
-## Brain-Cousens model with the constraint f>0 
-## (no effect as the estimate of f is positive anyway)
-ryegrass.bcm2 <- drm(rootl ~conc, data = ryegrass, fct = BC.5(),
-lower = c(-Inf, -Inf, -Inf, -Inf, 0), control = drmc(constr=TRUE))
-
-summary(ryegrass.bcm2)
    #> 
-#> Model fitted: Brain-Cousens (hormesis) (5 parms)
-#> 
-#> Parameter estimates:
-#> 
-#>               Estimate Std. Error t-value   p-value    
-#> b:(Intercept)  2.75688    0.52461  5.2551 4.511e-05 ***
-#> c:(Intercept)  0.41515    0.26309  1.5780    0.1311    
-#> d:(Intercept)  7.74173    0.21415 36.1510 < 2.2e-16 ***
-#> e:(Intercept)  2.77687    0.50938  5.4514 2.930e-05 ***
-#> f:(Intercept)  0.35672    0.68827  0.5183    0.6102    
-#> ---
-#> Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
-#> 
-#> Residual standard error:
-#> 
-#>  0.528689 (19 degrees of freedom)
    
-
    -
    - -
    - -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    -
    - -
    -

    Site built with pkgdown.

    -
    - -
    -
    - - - - - - diff --git a/docs/reference/C.dubia-1.png b/docs/reference/C.dubia-1.png new file mode 100644 index 00000000..23138c8c Binary files /dev/null and b/docs/reference/C.dubia-1.png differ diff --git a/docs/reference/C.dubia.html b/docs/reference/C.dubia.html new file mode 100644 index 00000000..a9368d3b --- /dev/null +++ b/docs/reference/C.dubia.html @@ -0,0 +1,124 @@ + +Offsprings resulting from a toxicity test — C.dubia • drc + Skip to contents + + +
    +
    +
    +

    Offsprings resulting from a toxicity test

    + +
    C.dubia.Rd
    +
    + +
    +

    Results from a chronic reproduction toxicity test with seven different concentrations of waste water. The response was the number of offspring produced by the water flea Ceriodaphnia dubia.

    +
    + +
    +

    Usage

    + 
    data(C.dubia)
    +
    + +
    +

    Format

    +

    A data frame with 50 observations of the following 2 variables.

    conc
    +

    a numeric vector giving waste water in percentage

    + +
    number
    +

    a numeric vector

    + + +
    +
    +

    Source

    +

    A. J. Bailer and J. T. Oris (1997). Estimating inhibition concentrations for different response scales +using generalized linear models. Environmental Toxicology and Chemistry, 16:1554–1559.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Displaying the data
+head(C.dubia)
+#>   conc number
+#> 1    0     27
+#> 2    0     30
+#> 3    0     29
+#> 4    0     31
+#> 5    0     16
+#> 6    0     15
+
+## Fitting a three-parameter log-logistic model
+C.dubia.m1 <- drm(number ~ conc, data = C.dubia, fct = LL.3())
+summary(C.dubia.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept)  16.1372    61.8281  0.2610    0.7952    
+#> d:(Intercept)  28.7500     1.1123 25.8464 < 2.2e-16 ***
+#> e:(Intercept)  11.9536     2.0608  5.8004  5.39e-07 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  7.03479 (47 degrees of freedom)
+
+## Plotting fitted curve together with the original data
+plot(C.dubia.m1, xlab = "Concentration (%)", ylab = "Number of offspring")
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/C.dubia.md b/docs/reference/C.dubia.md new file mode 100644 index 00000000..ab4321e0 --- /dev/null +++ b/docs/reference/C.dubia.md @@ -0,0 +1,67 @@ +# Offsprings resulting from a toxicity test + +Results from a chronic reproduction toxicity test with seven different +concentrations of waste water. The response was the number of offspring +produced by the water flea *Ceriodaphnia dubia*. + +## Usage + +``` r +data(C.dubia) +``` + +## Format + +A data frame with 50 observations of the following 2 variables. + +- `conc`: + + a numeric vector giving waste water in percentage + +- `number`: + + a numeric vector + +## Source + +A. J. Bailer and J. T. Oris (1997). Estimating inhibition concentrations +for different response scales using generalized linear models. +Environmental Toxicology and Chemistry, **16**:1554–1559. + +## Examples + +``` r +library(drc) + +## Displaying the data +head(C.dubia) +#> conc number +#> 1 0 27 +#> 2 0 30 +#> 3 0 29 +#> 4 0 31 +#> 5 0 16 +#> 6 0 15 + +## Fitting a three-parameter log-logistic model +C.dubia.m1 <- drm(number ~ conc, data = C.dubia, fct = LL.3()) +summary(C.dubia.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 16.1372 61.8281 0.2610 0.7952 +#> d:(Intercept) 28.7500 1.1123 25.8464 < 2.2e-16 *** +#> e:(Intercept) 11.9536 2.0608 5.8004 5.39e-07 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 7.03479 (47 degrees of freedom) + +## Plotting fitted curve together with the original data +plot(C.dubia.m1, xlab = "Concentration (%)", ylab = "Number of offspring") +``` diff --git a/docs/reference/CIcomp.html b/docs/reference/CIcomp.html new file mode 100644 index 00000000..c481d005 --- /dev/null +++ b/docs/reference/CIcomp.html @@ -0,0 +1,131 @@ + +Classical combination index for effective doses — CIcomp • drc + Skip to contents + + +
    +
    +
    +

    Classical combination index for effective doses

    + Source: R/CIcompX.R +
    CIcomp.Rd
    +
    + +
    +

    Calculates the classical combination index for effective doses in binary mixture experiments.

    +
    + +
    +

    Usage

    + 
    CIcomp(mixProp, modelList, EDvec)
    +
    + +
    +

    Arguments

    + + +
    mixProp
    +

    a numeric value between 0 and 1 specifying the mixture proportion/ratio.

    + + +
    modelList
    +

    a list containing 3 model fits using drm: the mixture model fit +first, followed by the 2 pure substance model fits.

    + + +
    EDvec
    +

    a numeric vector of effect levels (percentages between 0 and 100).

    + +
    +
    +

    Value

    +

    A matrix with one row per ED value. Columns contain estimated combination indices, +their standard errors and 95% confidence intervals, p-value for testing CI=1, estimated +ED values for the mixture data and assuming concentration addition (CA) with corresponding +standard errors.

    +
    +
    +

    References

    +

    Martin-Betancor, K. and Ritz, C. and Fernandez-Pinas, F. and Leganes, F. and +Rodea-Palomares, I. (2015) Defining an additivity framework for mixture research in +inducible whole-cell biosensors, Scientific Reports 17200.

    +
    +
    +

    See also

    +

    CIcompX, plotFACI, mixture

    +
    +
    +

    Author

    +

    Christian Ritz and Ismael Rodea-Palomares

    +
    + +
    +

    Examples

    + 
    ## Fitting marginal models for the 2 pure substances
+acidiq.0 <- drm(rgr ~ dose, data = subset(acidiq, pct == 999 | pct == 0), fct = LL.4())
+acidiq.100 <- drm(rgr ~ dose, data = subset(acidiq, pct == 999 | pct == 100), fct = LL.4())
+
+## Fitting model for single mixture with ratio 17:83
+acidiq.17 <- drm(rgr ~ dose, data = subset(acidiq, pct == 17 | pct == 0), fct = LL.4())
+
+## Calculation of combination indices based on ED10, ED20, ED50
+CIcomp(0.17, list(acidiq.17, acidiq.0, acidiq.100), c(10, 20, 50))
+#>      combInd         SE     lowCI   highCI    CAdiffp     ED.CA    SE.CA
+#> 10 1.7180152 0.31407144 1.1024352 2.333595 0.02224534  76.91373 11.85583
+#> 20 1.3421604 0.16702874 1.0147841 1.669537 0.04050985 140.38385 14.47436
+#> 50 0.9035949 0.08440138 0.7381682 1.069022 0.25336168 382.44378 32.11935
+#>      ED.mix   SE.mix
+#> 10 132.1390 12.98677
+#> 20 188.4176 13.13050
+#> 50 345.5742 14.12771
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/CIcomp.md b/docs/reference/CIcomp.md new file mode 100644 index 00000000..6ad6d7ae --- /dev/null +++ b/docs/reference/CIcomp.md @@ -0,0 +1,73 @@ +# Classical combination index for effective doses + +Calculates the classical combination index for effective doses in binary +mixture experiments. + +## Usage + +``` r +CIcomp(mixProp, modelList, EDvec) +``` + +## Arguments + +- mixProp: + + a numeric value between 0 and 1 specifying the mixture + proportion/ratio. + +- modelList: + + a list containing 3 model fits using + [`drm`](https://hreinwald.github.io/drc/reference/drm.md): the mixture + model fit first, followed by the 2 pure substance model fits. + +- EDvec: + + a numeric vector of effect levels (percentages between 0 and 100). + +## Value + +A matrix with one row per ED value. Columns contain estimated +combination indices, their standard errors and 95% confidence intervals, +p-value for testing CI=1, estimated ED values for the mixture data and +assuming concentration addition (CA) with corresponding standard errors. + +## References + +Martin-Betancor, K. and Ritz, C. and Fernandez-Pinas, F. and Leganes, F. +and Rodea-Palomares, I. (2015) Defining an additivity framework for +mixture research in inducible whole-cell biosensors, *Scientific +Reports* **17200**. + +## See also + +[`CIcompX`](https://hreinwald.github.io/drc/reference/CIcompX.md), +[`plotFACI`](https://hreinwald.github.io/drc/reference/plotFACI.md), +[`mixture`](https://hreinwald.github.io/drc/reference/mixture.md) + +## Author + +Christian Ritz and Ismael Rodea-Palomares + +## Examples + +``` r +## Fitting marginal models for the 2 pure substances +acidiq.0 <- drm(rgr ~ dose, data = subset(acidiq, pct == 999 | pct == 0), fct = LL.4()) +acidiq.100 <- drm(rgr ~ dose, data = subset(acidiq, pct == 999 | pct == 100), fct = LL.4()) + +## Fitting model for single mixture with ratio 17:83 +acidiq.17 <- drm(rgr ~ dose, data = subset(acidiq, pct == 17 | pct == 0), fct = LL.4()) + +## Calculation of combination indices based on ED10, ED20, ED50 +CIcomp(0.17, list(acidiq.17, acidiq.0, acidiq.100), c(10, 20, 50)) +#> combInd SE lowCI highCI CAdiffp ED.CA SE.CA +#> 10 1.7180152 0.31407144 1.1024352 2.333595 0.02224534 76.91373 11.85583 +#> 20 1.3421604 0.16702874 1.0147841 1.669537 0.04050985 140.38385 14.47436 +#> 50 0.9035949 0.08440138 0.7381682 1.069022 0.25336168 382.44378 32.11935 +#> ED.mix SE.mix +#> 10 132.1390 12.98677 +#> 20 188.4176 13.13050 +#> 50 345.5742 14.12771 +``` diff --git a/docs/reference/CIcompX.html b/docs/reference/CIcompX.html index 6eccd01c..e743c08d 100644 --- a/docs/reference/CIcompX.html +++ b/docs/reference/CIcompX.html @@ -1,256 +1,114 @@ - - - - - - +Calculation of combination index for binary mixtures — CIcompX • drc + Skip to contents -Calculation of combination index for binary mixtures — CIcompX • drc - - - +
    +
    +
    +

    Calculation of combination index for binary mixtures

    + Source: R/CIcompX.R +
    CIcompX.Rd
    +
    - +
    +

    For single mixture data, combination indices for effective doses as well as effects +may be calculated. This is an extended version of CIcomp.

    +
    - - +
    +

    Usage

    + 
    CIcompX(mixProp, modelList, EDvec, EDonly = FALSE)
    +
    +
    +

    Arguments

    - - +
    mixProp
    +

    a numeric value between 0 and 1 specifying the mixture proportion/ratio.

    - +
    modelList
    +

    a list containing 3 model fits using drm: the mixture model fit +first, followed by the 2 pure substance model fits.

    - - -
    -
    - - - -
    -
    -
    -
    -

    Calculation of combination index for binary mixtures

    - - -
    +
    EDonly
    +

    logical. If TRUE, only combination indices for effective doses are calculated.

    -
    - -

    For single mixture data combination indices for effective doses as well as effects may be calculated and visualized.

    - +
    +
    +

    Value

    +

    A list with components Effx, Effy (unless EDonly = TRUE), +CAx, CAy (unless EDonly = TRUE), and EDvec.

    +
    +
    +

    References

    +

    Martin-Betancor, K. and Ritz, C. and Fernandez-Pinas, F. and Leganes, F. and +Rodea-Palomares, I. (2015) Defining an additivity framework for mixture research in +inducible whole-cell biosensors, Scientific Reports 17200.

    +
    +
    +

    See also

    +

    CIcomp, plotFACI, mixture

    +
    +
    +

    Author

    +

    Christian Ritz and Ismael Rodea-Palomares

    - 
    CIcomp(mixProp, modelList, EDvec)
-
-CIcompX(mixProp, modelList, EDvec, EDonly = FALSE)
-
-plotFACI(effList, indAxis = c("ED", "EF"), caRef = TRUE,
-showPoints = FALSE, add = FALSE, ylim, ...)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    mixProp

    a numeric value between 0 and 1 specifying the mixture proportion/ratio for - the single mixture considered.

    modelList

    a list contained 3 models fits using drm with the model fit - for single mixture ratio being the first element, followed by the 2 model fits of the pure - substances.

    EDvec

    a vector of numeric values between 0 and 100 (percentages) coresponding to the - effect levels of interest.

    EDonly

    a logical value indicating whether or not only combination indices for - effective doses should be calculated.

    effList

    a list returned by CIcompX.

    indAxis

    a character indicating whether effective doses ("ED") or effects - ("EF") should be plotted.

    caRef

    a logical value indicating whether or not a reference line for concentration - addition should be drawn.

    showPoints

    A logical value indicating whether or not estimated combination indices - should be plotted.

    add

    a logical value specifying if the plot should be added to the existing plot.

    ylim

    a numeric vector of length 2 giving the range for the y axis.

    ...

    additional graphical arguments.

    - -

    Details

    - -

    CIcomp calculates the classical combination index for effective doses whereas CIcompX calculates the combination index also for effects as proposed by -Martin-Betancor et al. (2015); for details and examples using "drc" see the supplementary material of this paper. The function plotFACI may be used to visualize the -calculated combination index as a function of the fraction affected.

    - -

    Value

    - -

    CIcomp returns a matrix which one row per ED value. Columns contain -estimated combination indices, their standard errors and 95% confidence intervals, -p-value for testing CI=1, estimated ED values for the mixture data and assuming -concentration addition (CA) with corresponding standard errors.

    -

    CIcompX returns similar output both for effective doses and effects (as a -list of matrices).

    - -

    References

    - -

    Martin-Betancor, K. and Ritz, C. and Fernandez-Pinas, F. and Leganes, F. and Rodea-Palomares, I. (2015) -Defining an additivity framework for mixture research in inducible whole-cell biosensors, -Scientific Reports -17200.

    - -

    See also

    - -

    See mixture for simultaneous modelling of several mixture ratios, but only at the ED50 level.

    - - -

    Examples

    - 
    ## Fitting marginal models for the 2 pure substances
-acidiq.0 <- drm(rgr ~ dose, data = subset(acidiq, pct == 999 | pct == 0), fct = LL.4())
-acidiq.100 <- drm(rgr ~ dose, data = subset(acidiq, pct == 999 | pct == 100), fct = LL.4())
-
-## Fitting model for single mixture with ratio 17:83
-acidiq.17 <- drm(rgr ~ dose, data = subset(acidiq, pct == 17 | pct == 0), fct = LL.4())
-
-## Calculation of combination indices based on ED10, ED20, ED50
-CIcomp(0.17, list(acidiq.17, acidiq.0, acidiq.100), c(10, 20, 50))
    #>      combInd         SE     lowCI   highCI    CAdiffp     ED.CA    SE.CA
-#> 10 1.7180152 0.31407144 1.1024352 2.333595 0.02224534  76.91373 11.85583
-#> 20 1.3421604 0.16702874 1.0147841 1.669537 0.04050985 140.38385 14.47436
-#> 50 0.9035949 0.08440138 0.7381682 1.069022 0.25336168 382.44378 32.11935
-#>      ED.mix   SE.mix
-#> 10 132.1390 12.98677
-#> 20 188.4176 13.13050
-#> 50 345.5742 14.12771
    ## CI>1 significantly for ED10 and ED20, but not so for ED50
-
-
    -
    - -

    Author

    - -Christian Ritz and Ismael Rodea-Palomares -
    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    • + + - -
    - - - + diff --git a/docs/reference/CIcompX.md b/docs/reference/CIcompX.md new file mode 100644 index 00000000..2835a1da --- /dev/null +++ b/docs/reference/CIcompX.md @@ -0,0 +1,55 @@ +# Calculation of combination index for binary mixtures + +For single mixture data, combination indices for effective doses as well +as effects may be calculated. This is an extended version of +[`CIcomp`](https://hreinwald.github.io/drc/reference/CIcomp.md). + +## Usage + +``` r +CIcompX(mixProp, modelList, EDvec, EDonly = FALSE) +``` + +## Arguments + +- mixProp: + + a numeric value between 0 and 1 specifying the mixture + proportion/ratio. + +- modelList: + + a list containing 3 model fits using + [`drm`](https://hreinwald.github.io/drc/reference/drm.md): the mixture + model fit first, followed by the 2 pure substance model fits. + +- EDvec: + + a numeric vector of effect levels (percentages between 0 and 100). + +- EDonly: + + logical. If TRUE, only combination indices for effective doses are + calculated. + +## Value + +A list with components `Effx`, `Effy` (unless `EDonly = TRUE`), `CAx`, +`CAy` (unless `EDonly = TRUE`), and `EDvec`. + +## References + +Martin-Betancor, K. and Ritz, C. and Fernandez-Pinas, F. and Leganes, F. +and Rodea-Palomares, I. (2015) Defining an additivity framework for +mixture research in inducible whole-cell biosensors, *Scientific +Reports* **17200**. + +## See also + +[`CIcomp`](https://hreinwald.github.io/drc/reference/CIcomp.md), +[`plotFACI`](https://hreinwald.github.io/drc/reference/plotFACI.md), +[`mixture`](https://hreinwald.github.io/drc/reference/mixture.md) + +## Author + +Christian Ritz and Ismael Rodea-Palomares diff --git a/docs/reference/CRS.4a.html b/docs/reference/CRS.4a.html index 9e53b676..c35f8c46 100644 --- a/docs/reference/CRS.4a.html +++ b/docs/reference/CRS.4a.html @@ -1,274 +1,206 @@ - - - - - - +Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 1 (Deprecated) — CRS.4a • drc + Skip to contents + + +
    +
    +
    +

    Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 1 (Deprecated)

    + Source: R/cedergreen.R +
    CRS.4a.Rd
    +
    - - +
    +

    [Deprecated]

    +

    This function is deprecated as of version 3.3.0. Please use CRS.5() instead, +which provides a more general and flexible interface.

    +

    A four-parameter Cedergreen-Ritz-Streibig (CRS) hormesis model where the lower +asymptote (c) is fixed at 0 and the alpha parameter controlling the steepness +of the hormetic component is fixed at 1. The four free parameters are b, d, +e, and f.

    +
    - - +
    +

    Usage

    + 
    CRS.4a(names = c("b", "c", "d", "e", "f"), fixed = c(NA, 0, NA, NA, NA), ...)
    +
    - - +
    +

    Arguments

    - - - - - +
    names
    +

    A character vector of length 5 specifying the names of the model +parameters in the following order:

    b
    +

    Hill slope (steepness of the dose-response curve).

    +
    c
    +

    Lower asymptote (fixed at 0 via the fixed argument).

    +
    d
    +

    Upper asymptote.

    - +
    e
    +

    Effective dose producing a response midway between c and d +(ED50).

    - - +
    f
    +

    Hormesis parameter controlling the magnitude of the stimulatory +effect at low doses.

    +

    Defaults to c("b", "c", "d", "e", "f").

    - - - +
    fixed
    +

    A numeric vector of length 5 specifying fixed (non-estimated) +parameter values. Use NA for parameters that should be estimated freely. +Defaults to c(NA, 0, NA, NA, NA), which fixes the lower asymptote c +at 0.

    - +
    ...
    +

    Additional arguments passed to cedergreen().

    - -
    -
    -
    +
    +

    Value

    +

    A list of class "drcMean" as returned by cedergreen(), containing +the model definition including the mean function, its gradient, parameter +names, and fixed values. This object is intended for use as the fct +argument in drm().

    - - -
    -
    - - - - -
    -
    -
    -

    The Cedergreen-Ritz-Streibig model

    - - +
    +

    See also

    +
    +

    • CRS.5() — the recommended replacement for this deprecated function.

      • +

    • cedergreen() — the underlying model constructor.

      • +

    • CRS.5a() — the five-parameter CRS model with alpha = 1.

      • +

    • UCRS.4a() — the unconstrained four-parameter CRS model with alpha = 1.

      • +
    - -
    - -

    'CRS.4a', 'CRS.4b' and 'CRS.4c' provide the Cedergreen-Ritz-Streibig modified log-logistic model - for describing hormesis with the lower limit equal to 0.

    -

    'UCRS.4a', 'UCRS.4b' and 'UCRS.4c' provide the Cedergreen-Ritz-Streibig modified log-logistic model - for describing u-shaped hormesis with the lower limit equal to 0.

    - +
    +

    Author

    +

    Christian Ritz, Hannes Reinwald

    - 
    CRS.4a(names = c("b", "d", "e", "f"), ...)
-
-  UCRS.4a(names = c("b", "d", "e", "f"), ...)
    - -

    Arguments

    - - - - - - - - - - -
    names

    a vector of character strings giving the names of the parameters. - The default is reasonable (see above).

    ...

    additional arguments to be passed from the convenience functions.

    - -

    Details

    - -

    The model is given by the expression - $$ f(x) = 0 + \frac{d-0+f \exp(-1/x)}{1+\exp(b(\log(x)-\log(e)))}$$ - which is a five-parameter model.

    -

    It is a modification of the four-parameter logistic curve to take hormesis into account.

    -

    The u-shaped model is given by the expression - $$ f(x) = 0 + d - \frac{d-0+f \exp(-1/x^{\alpha})}{1+\exp(b(\log(x)-\log(e)))}$$

    -

    The a,b,c models are obtained by setting alpha equal to 1, 0.5 and 0.25, respectively.

    - -

    Value

    - -

    See cedergreen.

    - -

    References

    - -

    See the reference under cedergreen.

    - -

    Note

    - -

    This function is for use with the function drm.

    - -

    See also

    - -

    Similar functions are CRS.5a and UCRS.5a, - but with an extra parameter for the lower limit.

    - - -

    Examples

    - 
    
-## Fitting modified logistic models
-lettuce.crsm1 <- drm(lettuce[,c(2,1)], fct=CRS.4a())
-summary(lettuce.crsm1)
    #> 
-#> Model fitted: Cedergreen-Ritz-Streibig with lower limit 0 (alpha=1) (4 parms)
-#> 
-#> Parameter estimates:
-#> 
-#>                Estimate Std. Error t-value   p-value    
-#> b:(Intercept)  0.774519   0.248592  3.1156   0.01096 *  
-#> d:(Intercept)  1.108705   0.078481 14.1270 6.212e-08 ***
-#> e:(Intercept) 27.620019  30.307666  0.9113   0.38357    
-#> f:(Intercept)  0.013090   0.417215  0.0314   0.97559    
-#> ---
-#> Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
-#> 
-#> Residual standard error:
-#> 
-#>  0.1556406 (10 degrees of freedom)
    ED(lettuce.crsm1, c(50))
    #> 
-#> Estimated effective doses
-#> 
-#>        Estimate Std. Error
-#> e:1:50   28.436     11.618
    
-## Need to explicitly specify that the upper limit
-## is the reference in order to get ED10 and ED90 right
-ED(lettuce.crsm1, c(10, 50, 90), reference = "upper")
    #> 
-#> Estimated effective doses
-#> 
-#>        Estimate Std. Error
-#> e:1:10   1.7599     2.3788
-#> e:1:50  28.4357    11.6181
-#> e:1:90 479.2496   386.2069
    
-lettuce.crsm2 <- drm(lettuce[,c(2,1)], fct=CRS.4b())
-summary(lettuce.crsm2)
    #> 
-#> Model fitted: Cedergreen-Ritz-Streibig with lower limit 0 (alpha=.5) (4 parms)
-#> 
-#> Parameter estimates:
-#> 
-#>               Estimate Std. Error t-value   p-value    
-#> b:(Intercept) 0.574252   0.074482  7.7099 1.625e-05 ***
-#> d:(Intercept) 1.012219   0.094866 10.6700 8.746e-07 ***
-#> e:(Intercept) 0.837301   1.961165  0.4269    0.6785    
-#> f:(Intercept) 3.835591   5.005943  0.7662    0.4613    
-#> ---
-#> Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
-#> 
-#> Residual standard error:
-#> 
-#>  0.1349385 (10 degrees of freedom)
    ED(lettuce.crsm2, c(50))
    #> 
-#> Estimated effective doses
-#> 
-#>        Estimate Std. Error
-#> e:1:50  26.2751     8.7107
    
-lettuce.crsm3 <- drm(lettuce[,c(2,1)], fct=CRS.4c())
-summary(lettuce.crsm3)
    #> 
-#> Model fitted: Cedergreen-Ritz-Streibig with lower limit 0 (alpha=.25) (4 parms)
-#> 
-#> Parameter estimates:
-#> 
-#>               Estimate Std. Error t-value   p-value    
-#> b:(Intercept) 0.493082   0.136746  3.6058  0.004801 ** 
-#> d:(Intercept) 0.974199   0.086921 11.2078 5.538e-07 ***
-#> e:(Intercept) 1.454518   3.902350  0.3727  0.717129    
-#> f:(Intercept) 2.866269   3.438795  0.8335  0.424019    
-#> ---
-#> Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
-#> 
-#> Residual standard error:
-#> 
-#>  0.1235996 (10 degrees of freedom)
    ED(lettuce.crsm3, c(50))
    #> 
-#> Estimated effective doses
-#> 
-#>        Estimate Std. Error
-#> e:1:50   36.836     15.265
    
-
    -
    - -
  • See also
    • - -
  • Examples
    • - -

    Author

    - Christian Ritz -
    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + - -
    - - - + diff --git a/docs/reference/CRS.4a.md b/docs/reference/CRS.4a.md new file mode 100644 index 00000000..0689900b --- /dev/null +++ b/docs/reference/CRS.4a.md @@ -0,0 +1,147 @@ +# Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 1 (Deprecated) + +**\[deprecated\]** + +This function is deprecated as of version 3.3.0. Please use +[`CRS.5()`](https://hreinwald.github.io/drc/reference/CRS.5.md) instead, +which provides a more general and flexible interface. + +A four-parameter Cedergreen-Ritz-Streibig (CRS) hormesis model where the +lower asymptote (`c`) is fixed at 0 and the alpha parameter controlling +the steepness of the hormetic component is fixed at 1. The four free +parameters are `b`, `d`, `e`, and `f`. + +## Usage + +``` r +CRS.4a(names = c("b", "c", "d", "e", "f"), fixed = c(NA, 0, NA, NA, NA), ...) +``` + +## Arguments + +- names: + + A character vector of length 5 specifying the names of the model + parameters in the following order: + + `b` + + : Hill slope (steepness of the dose-response curve). + + `c` + + : Lower asymptote (fixed at 0 via the `fixed` argument). + + `d` + + : Upper asymptote. + + `e` + + : Effective dose producing a response midway between `c` and `d` + (ED50). + + `f` + + : Hormesis parameter controlling the magnitude of the stimulatory + effect at low doses. + + Defaults to `c("b", "c", "d", "e", "f")`. + +- fixed: + + A numeric vector of length 5 specifying fixed (non-estimated) + parameter values. Use `NA` for parameters that should be estimated + freely. Defaults to `c(NA, 0, NA, NA, NA)`, which fixes the lower + asymptote `c` at 0. + +- ...: + + Additional arguments passed to + [`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md). + +## Value + +A list of class `"drcMean"` as returned by +[`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md), +containing the model definition including the mean function, its +gradient, parameter names, and fixed values. This object is intended for +use as the `fct` argument in +[`drm()`](https://hreinwald.github.io/drc/reference/drm.md). + +## See also + +- [`CRS.5()`](https://hreinwald.github.io/drc/reference/CRS.5.md) — the + recommended replacement for this deprecated function. + +- [`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md) + — the underlying model constructor. + +- [`CRS.5a()`](https://hreinwald.github.io/drc/reference/CRS.5a.md) — + the five-parameter CRS model with alpha = 1. + +- [`UCRS.4a()`](https://hreinwald.github.io/drc/reference/UCRS.4a.md) — + the unconstrained four-parameter CRS model with alpha = 1. + +## Author + +Christian Ritz, Hannes Reinwald + +## Examples + +``` r +# NOTE: CRS.4a() is deprecated. Use CRS.5() instead. +# The example below is retained for backward compatibility illustration only. + +lettuce.crsm1 <- drm( lettuce[, c(2, 1)], fct = CRS.4a() ) +summary(lettuce.crsm1) +#> +#> Model fitted: Cedergreen-Ritz-Streibig with lower limit 0 (alpha=1) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 7.7892e-01 2.5343e-01 3.0735 0.01177 * +#> d:(Intercept) 1.1091e+00 7.8336e-02 14.1586 6.081e-08 *** +#> e:(Intercept) 2.8572e+01 3.1328e+01 0.9120 0.38322 +#> f:(Intercept) 5.5833e-04 4.1209e-01 0.0014 0.99895 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.155635 (10 degrees of freedom) +ED(lettuce.crsm1, c(50)) +#> +#> Estimated effective doses +#> +#> Estimate Std. Error +#> e:50 28.608 11.751 + +# Recommended replacement: +fct_spec <- CRS.5(alpha_type = "a", fixed = c(NA, 0, NA, NA, NA)) +lettuce.crs5 <- drm(lettuce[, c(2, 1)], fct = fct_spec) +summary(lettuce.crs5) +#> +#> Model fitted: Cedergreen-Ritz-Streibig (alpha=1) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 7.7892e-01 2.5343e-01 3.0735 0.01177 * +#> d:(Intercept) 1.1091e+00 7.8336e-02 14.1586 6.081e-08 *** +#> e:(Intercept) 2.8572e+01 3.1328e+01 0.9120 0.38322 +#> f:(Intercept) 5.5833e-04 4.1209e-01 0.0014 0.99895 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.155635 (10 degrees of freedom) +ED(lettuce.crs5, c(50)) +#> +#> Estimated effective doses +#> +#> Estimate Std. Error +#> e:50 28.608 11.751 +``` diff --git a/docs/reference/CRS.4b.html b/docs/reference/CRS.4b.html new file mode 100644 index 00000000..e90a12e5 --- /dev/null +++ b/docs/reference/CRS.4b.html @@ -0,0 +1,206 @@ + +Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 0.5 (Deprecated) — CRS.4b • drc + Skip to contents + + +
    +
    +
    +

    Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 0.5 (Deprecated)

    + Source: R/cedergreen.R +
    CRS.4b.Rd
    +
    + +
    +

    [Deprecated]

    +

    This function is deprecated as of version 3.3.0. Please use CRS.5() instead, +which provides a more general and flexible interface.

    +

    A four-parameter Cedergreen-Ritz-Streibig (CRS) hormesis model where the lower +asymptote (c) is fixed at 0 and the alpha parameter controlling the steepness +of the hormetic component is fixed at 0.5. The four free parameters are b, d, +e, and f.

    +
    + +
    +

    Usage

    + 
    CRS.4b(names = c("b", "c", "d", "e", "f"), fixed = c(NA, 0, NA, NA, NA), ...)
    +
    + +
    +

    Arguments

    + + +
    names
    +

    A character vector of length 5 specifying the names of the model +parameters in the following order:

    b
    +

    Hill slope (steepness of the dose-response curve).

    + +
    c
    +

    Lower asymptote (fixed at 0 via the fixed argument).

    + +
    d
    +

    Upper asymptote.

    + +
    e
    +

    Effective dose producing a response midway between c and d +(ED50).

    + +
    f
    +

    Hormesis parameter controlling the magnitude of the stimulatory +effect at low doses.

    + + +

    Defaults to c("b", "c", "d", "e", "f").

    + + +
    fixed
    +

    A numeric vector of length 5 specifying fixed (non-estimated) +parameter values. Use NA for parameters that should be estimated freely. +Defaults to c(NA, 0, NA, NA, NA), which fixes the lower asymptote c +at 0.

    + + +
    ...
    +

    Additional arguments passed to cedergreen().

    + +
    +
    +

    Value

    +

    A list of class "drcMean" as returned by cedergreen(), containing +the model definition including the mean function, its gradient, parameter +names, and fixed values. This object is intended for use as the fct +argument in drm().

    +
    +
    +

    See also

    +
    +

    • CRS.5() — the recommended replacement for this deprecated function.

      • +

    • cedergreen() — the underlying model constructor.

      • +

    • CRS.4a() — the four-parameter CRS model with lower limit fixed at 0 and alpha = 1.

      • +

    • CRS.5b() — the five-parameter CRS model with alpha = 0.5.

      • +
    +
    +
    +

    Author

    +

    Christian Ritz, Hannes Reinwald

    +
    + +
    +

    Examples

    + 
    # NOTE: CRS.4b() is deprecated. Use CRS.5() instead.
+# The example below is retained for backward compatibility illustration only.
+
+lettuce.crsm2 <- drm( lettuce[, c(2, 1)], fct = CRS.4b() )
+summary(lettuce.crsm2)
+#> 
+#> Model fitted: Cedergreen-Ritz-Streibig with lower limit 0 (alpha=0.5) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept) 0.569426   0.068538  8.3081 8.444e-06 ***
+#> d:(Intercept) 1.008915   0.094919 10.6292 9.061e-07 ***
+#> e:(Intercept) 0.642290   1.533937  0.4187    0.6843    
+#> f:(Intercept) 4.446933   5.821389  0.7639    0.4626    
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.1345066 (10 degrees of freedom)
+ED(lettuce.crsm2, c(50))
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error
+#> e:50  26.1252     8.6286
+
+# Recommended replacement:
+fct_spec <- CRS.5(alpha_type = "b", fixed = c(NA, 0, NA, NA, NA))
+lettuce.crs5 <- drm(lettuce[, c(2, 1)], fct = fct_spec)
+summary(lettuce.crs5)
+#> 
+#> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.5) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept) 0.569426   0.068538  8.3081 8.444e-06 ***
+#> d:(Intercept) 1.008915   0.094919 10.6292 9.061e-07 ***
+#> e:(Intercept) 0.642290   1.533937  0.4187    0.6843    
+#> f:(Intercept) 4.446933   5.821389  0.7639    0.4626    
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.1345066 (10 degrees of freedom)
+ED(lettuce.crs5, c(50))
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error
+#> e:50  26.1252     8.6286
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/CRS.4b.md b/docs/reference/CRS.4b.md new file mode 100644 index 00000000..d442f204 --- /dev/null +++ b/docs/reference/CRS.4b.md @@ -0,0 +1,148 @@ +# Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 0.5 (Deprecated) + +**\[deprecated\]** + +This function is deprecated as of version 3.3.0. Please use +[`CRS.5()`](https://hreinwald.github.io/drc/reference/CRS.5.md) instead, +which provides a more general and flexible interface. + +A four-parameter Cedergreen-Ritz-Streibig (CRS) hormesis model where the +lower asymptote (`c`) is fixed at 0 and the alpha parameter controlling +the steepness of the hormetic component is fixed at 0.5. The four free +parameters are `b`, `d`, `e`, and `f`. + +## Usage + +``` r +CRS.4b(names = c("b", "c", "d", "e", "f"), fixed = c(NA, 0, NA, NA, NA), ...) +``` + +## Arguments + +- names: + + A character vector of length 5 specifying the names of the model + parameters in the following order: + + `b` + + : Hill slope (steepness of the dose-response curve). + + `c` + + : Lower asymptote (fixed at 0 via the `fixed` argument). + + `d` + + : Upper asymptote. + + `e` + + : Effective dose producing a response midway between `c` and `d` + (ED50). + + `f` + + : Hormesis parameter controlling the magnitude of the stimulatory + effect at low doses. + + Defaults to `c("b", "c", "d", "e", "f")`. + +- fixed: + + A numeric vector of length 5 specifying fixed (non-estimated) + parameter values. Use `NA` for parameters that should be estimated + freely. Defaults to `c(NA, 0, NA, NA, NA)`, which fixes the lower + asymptote `c` at 0. + +- ...: + + Additional arguments passed to + [`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md). + +## Value + +A list of class `"drcMean"` as returned by +[`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md), +containing the model definition including the mean function, its +gradient, parameter names, and fixed values. This object is intended for +use as the `fct` argument in +[`drm()`](https://hreinwald.github.io/drc/reference/drm.md). + +## See also + +- [`CRS.5()`](https://hreinwald.github.io/drc/reference/CRS.5.md) — the + recommended replacement for this deprecated function. + +- [`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md) + — the underlying model constructor. + +- [`CRS.4a()`](https://hreinwald.github.io/drc/reference/CRS.4a.md) — + the four-parameter CRS model with lower limit fixed at 0 and alpha = + 1. + +- [`CRS.5b()`](https://hreinwald.github.io/drc/reference/CRS.5b.md) — + the five-parameter CRS model with alpha = 0.5. + +## Author + +Christian Ritz, Hannes Reinwald + +## Examples + +``` r +# NOTE: CRS.4b() is deprecated. Use CRS.5() instead. +# The example below is retained for backward compatibility illustration only. + +lettuce.crsm2 <- drm( lettuce[, c(2, 1)], fct = CRS.4b() ) +summary(lettuce.crsm2) +#> +#> Model fitted: Cedergreen-Ritz-Streibig with lower limit 0 (alpha=0.5) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 0.569426 0.068538 8.3081 8.444e-06 *** +#> d:(Intercept) 1.008915 0.094919 10.6292 9.061e-07 *** +#> e:(Intercept) 0.642290 1.533937 0.4187 0.6843 +#> f:(Intercept) 4.446933 5.821389 0.7639 0.4626 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.1345066 (10 degrees of freedom) +ED(lettuce.crsm2, c(50)) +#> +#> Estimated effective doses +#> +#> Estimate Std. Error +#> e:50 26.1252 8.6286 + +# Recommended replacement: +fct_spec <- CRS.5(alpha_type = "b", fixed = c(NA, 0, NA, NA, NA)) +lettuce.crs5 <- drm(lettuce[, c(2, 1)], fct = fct_spec) +summary(lettuce.crs5) +#> +#> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.5) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 0.569426 0.068538 8.3081 8.444e-06 *** +#> d:(Intercept) 1.008915 0.094919 10.6292 9.061e-07 *** +#> e:(Intercept) 0.642290 1.533937 0.4187 0.6843 +#> f:(Intercept) 4.446933 5.821389 0.7639 0.4626 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.1345066 (10 degrees of freedom) +ED(lettuce.crs5, c(50)) +#> +#> Estimated effective doses +#> +#> Estimate Std. Error +#> e:50 26.1252 8.6286 +``` diff --git a/docs/reference/CRS.4c.html b/docs/reference/CRS.4c.html new file mode 100644 index 00000000..5e69f600 --- /dev/null +++ b/docs/reference/CRS.4c.html @@ -0,0 +1,206 @@ + +Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 0.25 (Deprecated) — CRS.4c • drc + Skip to contents + + +
    +
    +
    +

    Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 0.25 (Deprecated)

    + Source: R/cedergreen.R +
    CRS.4c.Rd
    +
    + +
    +

    [Deprecated]

    +

    This function is deprecated as of version 3.3.0. Please use CRS.5() instead, +which provides a more general and flexible interface.

    +

    A four-parameter Cedergreen-Ritz-Streibig (CRS) hormesis model where the lower +asymptote (c) is fixed at 0 and the alpha parameter controlling the steepness +of the hormetic component is fixed at 0.25. The four free parameters are b, d, +e, and f.

    +
    + +
    +

    Usage

    + 
    CRS.4c(names = c("b", "c", "d", "e", "f"), fixed = c(NA, 0, NA, NA, NA), ...)
    +
    + +
    +

    Arguments

    + + +
    names
    +

    A character vector of length 5 specifying the names of the model +parameters in the following order:

    b
    +

    Hill slope (steepness of the dose-response curve).

    + +
    c
    +

    Lower asymptote (fixed at 0 via the fixed argument).

    + +
    d
    +

    Upper asymptote.

    + +
    e
    +

    Effective dose producing a response midway between c and d +(ED50).

    + +
    f
    +

    Hormesis parameter controlling the magnitude of the stimulatory +effect at low doses.

    + + +

    Defaults to c("b", "c", "d", "e", "f").

    + + +
    fixed
    +

    A numeric vector of length 5 specifying fixed (non-estimated) +parameter values. Use NA for parameters that should be estimated freely. +Defaults to c(NA, 0, NA, NA, NA), which fixes the lower asymptote c +at 0.

    + + +
    ...
    +

    Additional arguments passed to cedergreen().

    + +
    +
    +

    Value

    +

    A list of class "drcMean" as returned by cedergreen(), containing +the model definition including the mean function, its gradient, parameter +names, and fixed values. This object is intended for use as the fct +argument in drm().

    +
    +
    +

    See also

    +
    +

    • CRS.5() — the recommended replacement for this deprecated function.

      • +

    • cedergreen() — the underlying model constructor.

      • +

    • CRS.4a() — the four-parameter CRS model with lower limit fixed at 0 and alpha = 1.

      • +

    • CRS.5c() — the five-parameter CRS model with alpha = 0.25.

      • +
    +
    +
    +

    Author

    +

    Christian Ritz, Hannes Reinwald

    +
    + +
    +

    Examples

    + 
    # NOTE: CRS.4c() is deprecated. Use CRS.5() instead.
+# The example below is retained for backward compatibility illustration only.
+
+lettuce.crsm3 <- drm( lettuce[, c(2, 1)], fct = CRS.4c() )
+summary(lettuce.crsm3)
+#> 
+#> Model fitted: Cedergreen-Ritz-Streibig with lower limit 0 (alpha=0.25) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept) 0.488440   0.133643  3.6548  0.004427 ** 
+#> d:(Intercept) 0.973666   0.086883 11.2066 5.544e-07 ***
+#> e:(Intercept) 1.314657   3.614266  0.3637  0.723624    
+#> f:(Intercept) 2.998547   3.626210  0.8269  0.427579    
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.123575 (10 degrees of freedom)
+ED(lettuce.crsm3, c(50))
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error
+#> e:50   37.033     15.437
+
+# Recommended replacement:
+fct_spec <- CRS.5(alpha_type = "c", fixed = c(NA, 0, NA, NA, NA))
+lettuce.crs5 <- drm(lettuce[, c(2, 1)], fct = fct_spec)
+summary(lettuce.crs5)
+#> 
+#> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.25) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept) 0.488440   0.133643  3.6548  0.004427 ** 
+#> d:(Intercept) 0.973666   0.086883 11.2066 5.544e-07 ***
+#> e:(Intercept) 1.314657   3.614266  0.3637  0.723624    
+#> f:(Intercept) 2.998547   3.626210  0.8269  0.427579    
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.123575 (10 degrees of freedom)
+ED(lettuce.crs5, c(50))
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error
+#> e:50   37.033     15.437
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/CRS.4c.md b/docs/reference/CRS.4c.md new file mode 100644 index 00000000..1b332ae0 --- /dev/null +++ b/docs/reference/CRS.4c.md @@ -0,0 +1,148 @@ +# Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 0.25 (Deprecated) + +**\[deprecated\]** + +This function is deprecated as of version 3.3.0. Please use +[`CRS.5()`](https://hreinwald.github.io/drc/reference/CRS.5.md) instead, +which provides a more general and flexible interface. + +A four-parameter Cedergreen-Ritz-Streibig (CRS) hormesis model where the +lower asymptote (`c`) is fixed at 0 and the alpha parameter controlling +the steepness of the hormetic component is fixed at 0.25. The four free +parameters are `b`, `d`, `e`, and `f`. + +## Usage + +``` r +CRS.4c(names = c("b", "c", "d", "e", "f"), fixed = c(NA, 0, NA, NA, NA), ...) +``` + +## Arguments + +- names: + + A character vector of length 5 specifying the names of the model + parameters in the following order: + + `b` + + : Hill slope (steepness of the dose-response curve). + + `c` + + : Lower asymptote (fixed at 0 via the `fixed` argument). + + `d` + + : Upper asymptote. + + `e` + + : Effective dose producing a response midway between `c` and `d` + (ED50). + + `f` + + : Hormesis parameter controlling the magnitude of the stimulatory + effect at low doses. + + Defaults to `c("b", "c", "d", "e", "f")`. + +- fixed: + + A numeric vector of length 5 specifying fixed (non-estimated) + parameter values. Use `NA` for parameters that should be estimated + freely. Defaults to `c(NA, 0, NA, NA, NA)`, which fixes the lower + asymptote `c` at 0. + +- ...: + + Additional arguments passed to + [`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md). + +## Value + +A list of class `"drcMean"` as returned by +[`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md), +containing the model definition including the mean function, its +gradient, parameter names, and fixed values. This object is intended for +use as the `fct` argument in +[`drm()`](https://hreinwald.github.io/drc/reference/drm.md). + +## See also + +- [`CRS.5()`](https://hreinwald.github.io/drc/reference/CRS.5.md) — the + recommended replacement for this deprecated function. + +- [`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md) + — the underlying model constructor. + +- [`CRS.4a()`](https://hreinwald.github.io/drc/reference/CRS.4a.md) — + the four-parameter CRS model with lower limit fixed at 0 and alpha = + 1. + +- [`CRS.5c()`](https://hreinwald.github.io/drc/reference/CRS.5c.md) — + the five-parameter CRS model with alpha = 0.25. + +## Author + +Christian Ritz, Hannes Reinwald + +## Examples + +``` r +# NOTE: CRS.4c() is deprecated. Use CRS.5() instead. +# The example below is retained for backward compatibility illustration only. + +lettuce.crsm3 <- drm( lettuce[, c(2, 1)], fct = CRS.4c() ) +summary(lettuce.crsm3) +#> +#> Model fitted: Cedergreen-Ritz-Streibig with lower limit 0 (alpha=0.25) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 0.488440 0.133643 3.6548 0.004427 ** +#> d:(Intercept) 0.973666 0.086883 11.2066 5.544e-07 *** +#> e:(Intercept) 1.314657 3.614266 0.3637 0.723624 +#> f:(Intercept) 2.998547 3.626210 0.8269 0.427579 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.123575 (10 degrees of freedom) +ED(lettuce.crsm3, c(50)) +#> +#> Estimated effective doses +#> +#> Estimate Std. Error +#> e:50 37.033 15.437 + +# Recommended replacement: +fct_spec <- CRS.5(alpha_type = "c", fixed = c(NA, 0, NA, NA, NA)) +lettuce.crs5 <- drm(lettuce[, c(2, 1)], fct = fct_spec) +summary(lettuce.crs5) +#> +#> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.25) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 0.488440 0.133643 3.6548 0.004427 ** +#> d:(Intercept) 0.973666 0.086883 11.2066 5.544e-07 *** +#> e:(Intercept) 1.314657 3.614266 0.3637 0.723624 +#> f:(Intercept) 2.998547 3.626210 0.8269 0.427579 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.123575 (10 degrees of freedom) +ED(lettuce.crs5, c(50)) +#> +#> Estimated effective doses +#> +#> Estimate Std. Error +#> e:50 37.033 15.437 +``` diff --git a/docs/reference/CRS.5.html b/docs/reference/CRS.5.html new file mode 100644 index 00000000..a12c83bd --- /dev/null +++ b/docs/reference/CRS.5.html @@ -0,0 +1,152 @@ + +Wrapper for 5-parameter Cedergreen-Ritz-Streibig Model — CRS.5 • drc + Skip to contents + + +
    +
    +
    +

    Wrapper for 5-parameter Cedergreen-Ritz-Streibig Model

    + Source: R/cedergreen.R +
    CRS.5.Rd
    +
    + +
    +

    A convenience wrapper for the drc::cedergreen function, preset for a +5-parameter model. It provides flexible handling for the alpha parameter.

    +
    + +
    +

    Usage

    + 
    CRS.5(
+  names = c("b", "c", "d", "e", "f"),
+  fixed = c(NA, NA, NA, NA, NA),
+  alpha_type = "a",
+  fctName = NULL,
+  fctText = NULL,
+  ...
+)
    +
    + +
    +

    Arguments

    + + +
    names
    +

    A character vector of length 5 specifying the names of the model +parameters. Default is c("b", "c", "d", "e", "f").

    + + +
    fixed
    +

    A numeric vector of length 5. Use NA for parameters to be +estimated and a numeric value for parameters to be fixed. Default is all +NA.

    + + +
    alpha_type
    +

    A character or a numeric value. Can be one of 'a' (alpha=1), +'b' (alpha=0.5), 'c' (alpha=0.25), or a specific numeric value for alpha.

    + + +
    fctName
    +

    An optional character string to name the model function. If +NULL (the default), a name is generated automatically.

    + + +
    fctText
    +

    An optional character string describing the model. If +NULL (the default), a description is generated automatically.

    + + +
    ...
    +

    Additional arguments to be passed to drc::cedergreen, such +as data.

    + +
    +
    +

    Value

    +

    A drc model object of class cedergreen. If the underlying +drc::cedergreen call fails, it issues a warning and returns NULL.

    +
    +
    +

    Details

    +

    This function simplifies the creation of a 5-parameter Cedergreen-Ritz-Streibig +model by setting sensible defaults for the parameter names. It allows the +alpha parameter to be specified either by a predefined character shortcut +('a', 'b', 'c') or by a direct numeric value.

    +

    By default the function runs with alpha=1, which corresponds to the CRS.4a model. +Setting alpha=0.5 corresponds to the CRS.4b model, and alpha=0.25 corresponds to the CRS.4c model.

    +

    By default, all parameters are set to be estimated (i.e., fixed is all NA), +but users can specify any parameters to be held constant during estimation. +The self-starter function is automatically generated based on the specified method and +fixed parameters, ensuring that initial values are appropriately calculated for the model fitting process.

    +

    The function automatically generates a model name (fctName) and description +(fctText) unless they are explicitly provided by the user.

    +
    +
    +

    Author

    +

    Hannes Reinwald

    +
    + +
    +

    Examples

    + 
    # Create a CRS.5 model specification
+crs_model_a <- CRS.5()
+
+# Fix the lower limit to 0 and use a custom numeric alpha
+crs_model_custom <- CRS.5(
+  fixed = c(NA, 0, NA, NA, NA), alpha_type = 0.75
+)
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/CRS.5.md b/docs/reference/CRS.5.md new file mode 100644 index 00000000..31b94e15 --- /dev/null +++ b/docs/reference/CRS.5.md @@ -0,0 +1,95 @@ +# Wrapper for 5-parameter Cedergreen-Ritz-Streibig Model + +A convenience wrapper for the +[`drc::cedergreen`](https://hreinwald.github.io/drc/reference/cedergreen.md) +function, preset for a 5-parameter model. It provides flexible handling +for the alpha parameter. + +## Usage + +``` r +CRS.5( + names = c("b", "c", "d", "e", "f"), + fixed = c(NA, NA, NA, NA, NA), + alpha_type = "a", + fctName = NULL, + fctText = NULL, + ... +) +``` + +## Arguments + +- names: + + A character vector of length 5 specifying the names of the model + parameters. Default is `c("b", "c", "d", "e", "f")`. + +- fixed: + + A numeric vector of length 5. Use `NA` for parameters to be estimated + and a numeric value for parameters to be fixed. Default is all `NA`. + +- alpha_type: + + A character or a numeric value. Can be one of 'a' (alpha=1), 'b' + (alpha=0.5), 'c' (alpha=0.25), or a specific numeric value for alpha. + +- fctName: + + An optional character string to name the model function. If `NULL` + (the default), a name is generated automatically. + +- fctText: + + An optional character string describing the model. If `NULL` (the + default), a description is generated automatically. + +- ...: + + Additional arguments to be passed to + [`drc::cedergreen`](https://hreinwald.github.io/drc/reference/cedergreen.md), + such as `data`. + +## Value + +A `drc` model object of class `cedergreen`. If the underlying +[`drc::cedergreen`](https://hreinwald.github.io/drc/reference/cedergreen.md) +call fails, it issues a warning and returns `NULL`. + +## Details + +This function simplifies the creation of a 5-parameter +Cedergreen-Ritz-Streibig model by setting sensible defaults for the +parameter names. It allows the alpha parameter to be specified either by +a predefined character shortcut ('a', 'b', 'c') or by a direct numeric +value. + +By default the function runs with `alpha=1`, which corresponds to the +`CRS.4a` model. Setting `alpha=0.5` corresponds to the `CRS.4b` model, +and `alpha=0.25` corresponds to the `CRS.4c` model. + +By default, all parameters are set to be estimated (i.e., `fixed` is all +`NA`), but users can specify any parameters to be held constant during +estimation. The self-starter function is automatically generated based +on the specified method and fixed parameters, ensuring that initial +values are appropriately calculated for the model fitting process. + +The function automatically generates a model name (`fctName`) and +description (`fctText`) unless they are explicitly provided by the user. + +## Author + +Hannes Reinwald + +## Examples + +``` r +# Create a CRS.5 model specification +crs_model_a <- CRS.5() + +# Fix the lower limit to 0 and use a custom numeric alpha +crs_model_custom <- CRS.5( + fixed = c(NA, 0, NA, NA, NA), alpha_type = 0.75 +) +``` diff --git a/docs/reference/CRS.5a.html b/docs/reference/CRS.5a.html index 4bd9eefd..57d34d31 100644 --- a/docs/reference/CRS.5a.html +++ b/docs/reference/CRS.5a.html @@ -1,278 +1,204 @@ - - - - - - +Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 1 (Deprecated) — CRS.5a • drc + Skip to contents + + +
    +
    +
    +

    Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 1 (Deprecated)

    + Source: R/cedergreen.R +
    CRS.5a.Rd
    +
    - - +
    +

    [Deprecated]

    +

    This function is deprecated as of version 3.3.0. Please use CRS.5() instead, +which provides a more general and flexible interface.

    +

    A five-parameter Cedergreen-Ritz-Streibig (CRS) hormesis model where the alpha +parameter controlling the steepness of the hormetic component is fixed at 1. +All five parameters b, c, d, e, and f are freely estimated.

    +
    - - +
    +

    Usage

    + 
    CRS.5a(names = c("b", "c", "d", "e", "f"), fixed = c(NA, NA, NA, NA, NA), ...)
    +
    - - +
    +

    Arguments

    - - - - - +
    names
    +

    A character vector of length 5 specifying the names of the model +parameters in the following order:

    b
    +

    Hill slope (steepness of the dose-response curve).

    +
    c
    +

    Lower asymptote (freely estimated).

    +
    d
    +

    Upper asymptote.

    - +
    e
    +

    Effective dose producing a response midway between c and d +(ED50).

    - - +
    f
    +

    Hormesis parameter controlling the magnitude of the stimulatory +effect at low doses.

    +

    Defaults to c("b", "c", "d", "e", "f").

    - - - +
    fixed
    +

    A numeric vector of length 5 specifying fixed (non-estimated) +parameter values. Use NA for parameters that should be estimated freely. +Defaults to c(NA, NA, NA, NA, NA), meaning all five parameters are +freely estimated.

    - +
    ...
    +

    Additional arguments passed to cedergreen().

    - -
    -
    -
    +
    +

    Value

    +

    A list of class "drcMean" as returned by cedergreen(), containing +the model definition including the mean function, its gradient, parameter +names, and fixed values. This object is intended for use as the fct +argument in drm().

    - - -
    -
    - - - - -
    -
    -
    -

    Cedergreen-Ritz-Streibig dose-reponse model for describing hormesis

    - - +
    +

    See also

    +
    +

    • CRS.5() — the recommended replacement for this deprecated function.

      • +

    • cedergreen() — the underlying model constructor.

      • +

    • CRS.4a() — the four-parameter CRS model with lower limit fixed at 0 and alpha = 1.

      • +

    • UCRS.5a() — the unconstrained five-parameter CRS model with alpha = 1.

      • +
    - -
    - -

    'CRS.5a', 'CRS.5b' and 'CRS.5c' provide the Cedergreen-Ritz-Streibig modified log-logistic model for describing - (inverse u-shaped or j-shaped) hormesis.

    -

    'UCRS.5a', 'UCRS.5b' and 'UCRS.5c' provide the Cedergreen-Ritz-Streibig modified log-logistic model for - describing u-shaped hormesis.

    - +
    +

    Author

    +

    Christian Ritz, Hannes Reinwald

    - 
    CRS.5a(names = c("b", "c", "d", "e", "f"), ...)
-
-  UCRS.5a(names = c("b", "c", "d", "e", "f"), ...)
    - -

    Arguments

    - - - - - - - - - - -
    names

    a vector of character strings giving the names of the parameters.

    ...

    additional arguments to be passed from the convenience functions.

    - -

    Details

    - -

    The model function for inverse u-shaped hormetic patterns is

    -

    $$ f(x) = c + \frac{d-c+f \exp(-1/x^{\alpha})}{1+\exp(b(\log(x)-\log(e)))}$$,

    -

    which is a five-parameter model. It is a modification of the four-parameter log-logistic curve - to take hormesis into account.

    -

    The parameters have the following interpretations

      -

    • \(b\): Not direct interpretation

      • -

    • \(c\): Lower horizontal asymptote

      • -

    • \(d\): Upper horizontal asymptote

      • -

    • \(e\): Not direct interpretation

      • -

    • \(f\): Size of the hormesis effect: the larger the value the larger is the hormesis effect. \(f=0\) - corresponds to no hormesis effect and the resulting model is the four-parameter log-logistic model. - This parameter should be positive in order for the model to make sense.

      • -
    -

    The model function for u-shaped hormetic patterns is - $$ f(x) = c + d - \frac{d-c+f \exp(-1/x^{\alpha})}{1+\exp(b(\log(x)-\log(e)))}$$

    -

    This model also simplifies to the four-parameter log-logistic model in case \(f=0\) (in a slightly - different parameterization as compared to the one used in LL.4).

    -

    The models denoted a,b,c are obtained by fixing the alpha parameter at 1, 0.5 and 0.25, respectively.

    - -

    Value

    - -

    See cedergreen.

    - -

    References

    - -

    See the reference under cedergreen.

    - -

    Note

    - -

    This function is for use with the function drm.

    - -

    See also

    - -

    Similar functions are CRS.4a and UCRS.4a, but with the - lower limit (the parameter \(c\)) fixed at 0 (one parameter less to be estimated).

    - - -

    Examples

    - 
    
-## Modified logistic model
-lettuce.m1 <- drm(lettuce[,c(2,1)], fct=CRS.5a())
-summary(lettuce.m1)
    #> 
-#> Model fitted: Cedergreen-Ritz-Streibig (alpha=1) (5 parms)
-#> 
-#> Parameter estimates:
-#> 
-#>               Estimate Std. Error t-value   p-value    
-#> b:(Intercept) 1.333664   0.357704  3.7284 0.0047091 ** 
-#> c:(Intercept) 0.448009   0.080642  5.5555 0.0003539 ***
-#> d:(Intercept) 1.035610   0.077348 13.3890 3.014e-07 ***
-#> e:(Intercept) 1.331868   1.181015  1.1277 0.2885991    
-#> f:(Intercept) 2.003672   2.028685  0.9877 0.3491213    
-#> ---
-#> Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
-#> 
-#> Residual standard error:
-#> 
-#>  0.1305032 (9 degrees of freedom)
    ED(lettuce.m1, c(50))
    #> 
-#> Estimated effective doses
-#> 
-#>        Estimate Std. Error
-#> e:1:50   5.5406     1.9453
    
-lettuce.m2 <- drm(lettuce[,c(2,1)], fct=CRS.5b())
-summary(lettuce.m2)
    #> 
-#> Model fitted: Cedergreen-Ritz-Streibig (alpha=.5) (5 parms)
-#> 
-#> Parameter estimates:
-#> 
-#>               Estimate Std. Error t-value   p-value    
-#> b:(Intercept)  0.82455    0.35455  2.3256   0.04507 *  
-#> c:(Intercept)  0.32220    0.15014  2.1460   0.06043 .  
-#> d:(Intercept)  0.97180    0.08161 11.9079 8.222e-07 ***
-#> e:(Intercept)  0.92084    1.78266  0.5166   0.61792    
-#> f:(Intercept)  3.01375    4.11800  0.7318   0.48288    
-#> ---
-#> Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
-#> 
-#> Residual standard error:
-#> 
-#>  0.1169752 (9 degrees of freedom)
    ED(lettuce.m2, c(50))
    #> 
-#> Estimated effective doses
-#> 
-#>        Estimate Std. Error
-#> e:1:50  11.2735     6.5352
    
-lettuce.m3 <- drm(lettuce[,c(2,1)], fct=CRS.5c())
-summary(lettuce.m3)
    #> 
-#> Model fitted: Cedergreen-Ritz-Streibig (alpha=.25) (5 parms)
-#> 
-#> Parameter estimates:
-#> 
-#>               Estimate Std. Error t-value   p-value    
-#> b:(Intercept) 0.981945   0.559334  1.7556   0.11305    
-#> c:(Intercept) 0.336670   0.182883  1.8409   0.09877 .  
-#> d:(Intercept) 0.969845   0.088261 10.9883 1.624e-06 ***
-#> e:(Intercept) 3.883893   2.462313  1.5773   0.14917    
-#> f:(Intercept) 1.027934   0.766823  1.3405   0.21293    
-#> ---
-#> Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
-#> 
-#> Residual standard error:
-#> 
-#>  0.1256841 (9 degrees of freedom)
    ED(lettuce.m3, c(50))
    #> 
-#> Estimated effective doses
-#> 
-#>        Estimate Std. Error
-#> e:1:50  11.4243     8.7214
    
-
    -
    - -
  • See also
    • - -
  • Examples
    • - -

    Author

    - Christian Ritz -
    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + - -
    - - - + diff --git a/docs/reference/CRS.5a.md b/docs/reference/CRS.5a.md new file mode 100644 index 00000000..c36b649c --- /dev/null +++ b/docs/reference/CRS.5a.md @@ -0,0 +1,149 @@ +# Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 1 (Deprecated) + +**\[deprecated\]** + +This function is deprecated as of version 3.3.0. Please use +[`CRS.5()`](https://hreinwald.github.io/drc/reference/CRS.5.md) instead, +which provides a more general and flexible interface. + +A five-parameter Cedergreen-Ritz-Streibig (CRS) hormesis model where the +alpha parameter controlling the steepness of the hormetic component is +fixed at 1. All five parameters `b`, `c`, `d`, `e`, and `f` are freely +estimated. + +## Usage + +``` r +CRS.5a(names = c("b", "c", "d", "e", "f"), fixed = c(NA, NA, NA, NA, NA), ...) +``` + +## Arguments + +- names: + + A character vector of length 5 specifying the names of the model + parameters in the following order: + + `b` + + : Hill slope (steepness of the dose-response curve). + + `c` + + : Lower asymptote (freely estimated). + + `d` + + : Upper asymptote. + + `e` + + : Effective dose producing a response midway between `c` and `d` + (ED50). + + `f` + + : Hormesis parameter controlling the magnitude of the stimulatory + effect at low doses. + + Defaults to `c("b", "c", "d", "e", "f")`. + +- fixed: + + A numeric vector of length 5 specifying fixed (non-estimated) + parameter values. Use `NA` for parameters that should be estimated + freely. Defaults to `c(NA, NA, NA, NA, NA)`, meaning all five + parameters are freely estimated. + +- ...: + + Additional arguments passed to + [`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md). + +## Value + +A list of class `"drcMean"` as returned by +[`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md), +containing the model definition including the mean function, its +gradient, parameter names, and fixed values. This object is intended for +use as the `fct` argument in +[`drm()`](https://hreinwald.github.io/drc/reference/drm.md). + +## See also + +- [`CRS.5()`](https://hreinwald.github.io/drc/reference/CRS.5.md) — the + recommended replacement for this deprecated function. + +- [`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md) + — the underlying model constructor. + +- [`CRS.4a()`](https://hreinwald.github.io/drc/reference/CRS.4a.md) — + the four-parameter CRS model with lower limit fixed at 0 and alpha = + 1. + +- [`UCRS.5a()`](https://hreinwald.github.io/drc/reference/UCRS.5a.md) — + the unconstrained five-parameter CRS model with alpha = 1. + +## Author + +Christian Ritz, Hannes Reinwald + +## Examples + +``` r +# NOTE: CRS.5a() is deprecated. Use CRS.5() instead. +# The example below is retained for backward compatibility illustration only. + +lettuce.m1 <- drm( lettuce[, c(2, 1)], fct = CRS.5a() ) +summary(lettuce.m1) +#> +#> Model fitted: Cedergreen-Ritz-Streibig (alpha=1) (5 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 1.334173 0.358675 3.7197 0.004773 ** +#> c:(Intercept) 0.447962 0.080700 5.5510 0.000356 *** +#> d:(Intercept) 1.035658 0.077323 13.3940 3.004e-07 *** +#> e:(Intercept) 1.337869 1.185153 1.1289 0.288148 +#> f:(Intercept) 1.993259 2.017541 0.9880 0.348985 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.1305067 (9 degrees of freedom) +ED(lettuce.m1, c(50)) +#> +#> Estimated effective doses +#> +#> Estimate Std. Error +#> e:50 5.5439 1.9480 + +# Recommended replacement: +lettuce.crs5 <- drm( lettuce[, c(2, 1)], fct = CRS.5(alpha_type = "a") ) +summary(lettuce.crs5) +#> +#> Model fitted: Cedergreen-Ritz-Streibig (alpha=1) (5 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 1.334173 0.358675 3.7197 0.004773 ** +#> c:(Intercept) 0.447962 0.080700 5.5510 0.000356 *** +#> d:(Intercept) 1.035658 0.077323 13.3940 3.004e-07 *** +#> e:(Intercept) 1.337869 1.185153 1.1289 0.288148 +#> f:(Intercept) 1.993259 2.017541 0.9880 0.348985 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.1305067 (9 degrees of freedom) +ED(lettuce.crs5, c(50)) +#> +#> Estimated effective doses +#> +#> Estimate Std. Error +#> e:50 5.5439 1.9480 +``` diff --git a/docs/reference/CRS.5b.html b/docs/reference/CRS.5b.html new file mode 100644 index 00000000..c6f66697 --- /dev/null +++ b/docs/reference/CRS.5b.html @@ -0,0 +1,204 @@ + +Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 0.5 (Deprecated) — CRS.5b • drc + Skip to contents + + +
    +
    +
    +

    Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 0.5 (Deprecated)

    + Source: R/cedergreen.R +
    CRS.5b.Rd
    +
    + +
    +

    [Deprecated]

    +

    This function is deprecated as of version 3.3.0. Please use CRS.5() instead, +which provides a more general and flexible interface.

    +

    A five-parameter Cedergreen-Ritz-Streibig (CRS) hormesis model where the alpha +parameter controlling the steepness of the hormetic component is fixed at 0.5. +All five parameters b, c, d, e, and f are freely estimated.

    +
    + +
    +

    Usage

    + 
    CRS.5b(names = c("b", "c", "d", "e", "f"), fixed = c(NA, NA, NA, NA, NA), ...)
    +
    + +
    +

    Arguments

    + + +
    names
    +

    A character vector of length 5 specifying the names of the model +parameters in the following order:

    b
    +

    Hill slope (steepness of the dose-response curve).

    + +
    c
    +

    Lower asymptote (freely estimated).

    + +
    d
    +

    Upper asymptote.

    + +
    e
    +

    Effective dose producing a response midway between c and d +(ED50).

    + +
    f
    +

    Hormesis parameter controlling the magnitude of the stimulatory +effect at low doses.

    + + +

    Defaults to c("b", "c", "d", "e", "f").

    + + +
    fixed
    +

    A numeric vector of length 5 specifying fixed (non-estimated) +parameter values. Use NA for parameters that should be estimated freely. +Defaults to c(NA, NA, NA, NA, NA), meaning all five parameters are +freely estimated.

    + + +
    ...
    +

    Additional arguments passed to cedergreen().

    + +
    +
    +

    Value

    +

    A list of class "drcMean" as returned by cedergreen(), containing +the model definition including the mean function, its gradient, parameter +names, and fixed values. This object is intended for use as the fct +argument in drm().

    +
    +
    +

    See also

    +
    +

    • CRS.5() — the recommended replacement for this deprecated function.

      • +

    • cedergreen() — the underlying model constructor.

      • +

    • CRS.4b() — the four-parameter CRS model with lower limit fixed at 0 and alpha = 0.5.

      • +

    • CRS.5a() — the five-parameter CRS model with alpha = 1.

      • +
    +
    +
    +

    Author

    +

    Christian Ritz, Hannes Reinwald

    +
    + +
    +

    Examples

    + 
    # NOTE: CRS.5b() is deprecated. Use CRS.5() instead.
+# The example below is retained for backward compatibility illustration only.
+
+lettuce.m2 <- drm( lettuce[, c(2, 1)], fct = CRS.5b() )
+summary(lettuce.m2)
+#> 
+#> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.5) (5 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept) 0.806096   0.537800  1.4989    0.1681    
+#> c:(Intercept) 0.316586   0.199024  1.5907    0.1461    
+#> d:(Intercept) 0.971581   0.081936 11.8577 8.523e-07 ***
+#> e:(Intercept) 0.814111   2.969068  0.2742    0.7901    
+#> f:(Intercept) 3.288976   8.216399  0.4003    0.6983    
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.1167711 (9 degrees of freedom)
+ED(lettuce.m2, c(50))
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error
+#> e:50   11.550      8.603
+
+# Recommended replacement:
+lettuce.crs5 <- drm( lettuce[, c(2, 1)], fct = CRS.5(alpha_type = "b") )
+summary(lettuce.crs5)
+#> 
+#> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.5) (5 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept) 0.806096   0.537800  1.4989    0.1681    
+#> c:(Intercept) 0.316586   0.199024  1.5907    0.1461    
+#> d:(Intercept) 0.971581   0.081936 11.8577 8.523e-07 ***
+#> e:(Intercept) 0.814111   2.969068  0.2742    0.7901    
+#> f:(Intercept) 3.288976   8.216399  0.4003    0.6983    
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.1167711 (9 degrees of freedom)
+ED(lettuce.crs5, c(50))
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error
+#> e:50   11.550      8.603
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/CRS.5b.md b/docs/reference/CRS.5b.md new file mode 100644 index 00000000..c3df0440 --- /dev/null +++ b/docs/reference/CRS.5b.md @@ -0,0 +1,149 @@ +# Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 0.5 (Deprecated) + +**\[deprecated\]** + +This function is deprecated as of version 3.3.0. Please use +[`CRS.5()`](https://hreinwald.github.io/drc/reference/CRS.5.md) instead, +which provides a more general and flexible interface. + +A five-parameter Cedergreen-Ritz-Streibig (CRS) hormesis model where the +alpha parameter controlling the steepness of the hormetic component is +fixed at 0.5. All five parameters `b`, `c`, `d`, `e`, and `f` are freely +estimated. + +## Usage + +``` r +CRS.5b(names = c("b", "c", "d", "e", "f"), fixed = c(NA, NA, NA, NA, NA), ...) +``` + +## Arguments + +- names: + + A character vector of length 5 specifying the names of the model + parameters in the following order: + + `b` + + : Hill slope (steepness of the dose-response curve). + + `c` + + : Lower asymptote (freely estimated). + + `d` + + : Upper asymptote. + + `e` + + : Effective dose producing a response midway between `c` and `d` + (ED50). + + `f` + + : Hormesis parameter controlling the magnitude of the stimulatory + effect at low doses. + + Defaults to `c("b", "c", "d", "e", "f")`. + +- fixed: + + A numeric vector of length 5 specifying fixed (non-estimated) + parameter values. Use `NA` for parameters that should be estimated + freely. Defaults to `c(NA, NA, NA, NA, NA)`, meaning all five + parameters are freely estimated. + +- ...: + + Additional arguments passed to + [`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md). + +## Value + +A list of class `"drcMean"` as returned by +[`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md), +containing the model definition including the mean function, its +gradient, parameter names, and fixed values. This object is intended for +use as the `fct` argument in +[`drm()`](https://hreinwald.github.io/drc/reference/drm.md). + +## See also + +- [`CRS.5()`](https://hreinwald.github.io/drc/reference/CRS.5.md) — the + recommended replacement for this deprecated function. + +- [`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md) + — the underlying model constructor. + +- [`CRS.4b()`](https://hreinwald.github.io/drc/reference/CRS.4b.md) — + the four-parameter CRS model with lower limit fixed at 0 and alpha = + 0.5. + +- [`CRS.5a()`](https://hreinwald.github.io/drc/reference/CRS.5a.md) — + the five-parameter CRS model with alpha = 1. + +## Author + +Christian Ritz, Hannes Reinwald + +## Examples + +``` r +# NOTE: CRS.5b() is deprecated. Use CRS.5() instead. +# The example below is retained for backward compatibility illustration only. + +lettuce.m2 <- drm( lettuce[, c(2, 1)], fct = CRS.5b() ) +summary(lettuce.m2) +#> +#> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.5) (5 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 0.806096 0.537800 1.4989 0.1681 +#> c:(Intercept) 0.316586 0.199024 1.5907 0.1461 +#> d:(Intercept) 0.971581 0.081936 11.8577 8.523e-07 *** +#> e:(Intercept) 0.814111 2.969068 0.2742 0.7901 +#> f:(Intercept) 3.288976 8.216399 0.4003 0.6983 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.1167711 (9 degrees of freedom) +ED(lettuce.m2, c(50)) +#> +#> Estimated effective doses +#> +#> Estimate Std. Error +#> e:50 11.550 8.603 + +# Recommended replacement: +lettuce.crs5 <- drm( lettuce[, c(2, 1)], fct = CRS.5(alpha_type = "b") ) +summary(lettuce.crs5) +#> +#> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.5) (5 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 0.806096 0.537800 1.4989 0.1681 +#> c:(Intercept) 0.316586 0.199024 1.5907 0.1461 +#> d:(Intercept) 0.971581 0.081936 11.8577 8.523e-07 *** +#> e:(Intercept) 0.814111 2.969068 0.2742 0.7901 +#> f:(Intercept) 3.288976 8.216399 0.4003 0.6983 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.1167711 (9 degrees of freedom) +ED(lettuce.crs5, c(50)) +#> +#> Estimated effective doses +#> +#> Estimate Std. Error +#> e:50 11.550 8.603 +``` diff --git a/docs/reference/CRS.5c.html b/docs/reference/CRS.5c.html new file mode 100644 index 00000000..5a8ec7c5 --- /dev/null +++ b/docs/reference/CRS.5c.html @@ -0,0 +1,204 @@ + +Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 0.25 (Deprecated) — CRS.5c • drc + Skip to contents + + +
    +
    +
    +

    Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 0.25 (Deprecated)

    + Source: R/cedergreen.R +
    CRS.5c.Rd
    +
    + +
    +

    [Deprecated]

    +

    This function is deprecated as of version 3.3.0. Please use CRS.5() instead, +which provides a more general and flexible interface.

    +

    A five-parameter Cedergreen-Ritz-Streibig (CRS) hormesis model where the alpha +parameter controlling the steepness of the hormetic component is fixed at 0.25. +All five parameters b, c, d, e, and f are freely estimated.

    +
    + +
    +

    Usage

    + 
    CRS.5c(names = c("b", "c", "d", "e", "f"), fixed = c(NA, NA, NA, NA, NA), ...)
    +
    + +
    +

    Arguments

    + + +
    names
    +

    A character vector of length 5 specifying the names of the model +parameters in the following order:

    b
    +

    Hill slope (steepness of the dose-response curve).

    + +
    c
    +

    Lower asymptote (freely estimated).

    + +
    d
    +

    Upper asymptote.

    + +
    e
    +

    Effective dose producing a response midway between c and d +(ED50).

    + +
    f
    +

    Hormesis parameter controlling the magnitude of the stimulatory +effect at low doses.

    + + +

    Defaults to c("b", "c", "d", "e", "f").

    + + +
    fixed
    +

    A numeric vector of length 5 specifying fixed (non-estimated) +parameter values. Use NA for parameters that should be estimated freely. +Defaults to c(NA, NA, NA, NA, NA), meaning all five parameters are +freely estimated.

    + + +
    ...
    +

    Additional arguments passed to cedergreen().

    + +
    +
    +

    Value

    +

    A list of class "drcMean" as returned by cedergreen(), containing +the model definition including the mean function, its gradient, parameter +names, and fixed values. This object is intended for use as the fct +argument in drm().

    +
    +
    +

    See also

    +
    +

    • CRS.5() — the recommended replacement for this deprecated function.

      • +

    • cedergreen() — the underlying model constructor.

      • +

    • CRS.4c() — the four-parameter CRS model with lower limit fixed at 0 and alpha = 0.25.

      • +

    • CRS.5b() — the five-parameter CRS model with alpha = 0.5.

      • +
    +
    +
    +

    Author

    +

    Christian Ritz, Hannes Reinwald

    +
    + +
    +

    Examples

    + 
    # NOTE: CRS.5c() is deprecated. Use CRS.5() instead.
+# The example below is retained for backward compatibility illustration only.
+
+lettuce.m3 <- drm( lettuce[, c(2, 1)], fct = CRS.5c() )
+summary(lettuce.m3)
+#> 
+#> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.25) (5 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept) 0.981945   0.559334  1.7556   0.11305    
+#> c:(Intercept) 0.336670   0.182883  1.8409   0.09877 .  
+#> d:(Intercept) 0.969845   0.088261 10.9883 1.624e-06 ***
+#> e:(Intercept) 3.883893   2.462313  1.5773   0.14917    
+#> f:(Intercept) 1.027934   0.766823  1.3405   0.21293    
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.1256841 (9 degrees of freedom)
+ED(lettuce.m3, c(50))
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error
+#> e:50  11.4243     8.7214
+
+# Recommended replacement:
+lettuce.crs5 <- drm( lettuce[, c(2, 1)], fct = CRS.5(alpha_type = "c") )
+summary(lettuce.crs5)
+#> 
+#> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.25) (5 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept) 0.981945   0.559334  1.7556   0.11305    
+#> c:(Intercept) 0.336670   0.182883  1.8409   0.09877 .  
+#> d:(Intercept) 0.969845   0.088261 10.9883 1.624e-06 ***
+#> e:(Intercept) 3.883893   2.462313  1.5773   0.14917    
+#> f:(Intercept) 1.027934   0.766823  1.3405   0.21293    
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.1256841 (9 degrees of freedom)
+ED(lettuce.crs5, c(50))
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error
+#> e:50  11.4243     8.7214
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/CRS.5c.md b/docs/reference/CRS.5c.md new file mode 100644 index 00000000..2c9a8966 --- /dev/null +++ b/docs/reference/CRS.5c.md @@ -0,0 +1,149 @@ +# Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 0.25 (Deprecated) + +**\[deprecated\]** + +This function is deprecated as of version 3.3.0. Please use +[`CRS.5()`](https://hreinwald.github.io/drc/reference/CRS.5.md) instead, +which provides a more general and flexible interface. + +A five-parameter Cedergreen-Ritz-Streibig (CRS) hormesis model where the +alpha parameter controlling the steepness of the hormetic component is +fixed at 0.25. All five parameters `b`, `c`, `d`, `e`, and `f` are +freely estimated. + +## Usage + +``` r +CRS.5c(names = c("b", "c", "d", "e", "f"), fixed = c(NA, NA, NA, NA, NA), ...) +``` + +## Arguments + +- names: + + A character vector of length 5 specifying the names of the model + parameters in the following order: + + `b` + + : Hill slope (steepness of the dose-response curve). + + `c` + + : Lower asymptote (freely estimated). + + `d` + + : Upper asymptote. + + `e` + + : Effective dose producing a response midway between `c` and `d` + (ED50). + + `f` + + : Hormesis parameter controlling the magnitude of the stimulatory + effect at low doses. + + Defaults to `c("b", "c", "d", "e", "f")`. + +- fixed: + + A numeric vector of length 5 specifying fixed (non-estimated) + parameter values. Use `NA` for parameters that should be estimated + freely. Defaults to `c(NA, NA, NA, NA, NA)`, meaning all five + parameters are freely estimated. + +- ...: + + Additional arguments passed to + [`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md). + +## Value + +A list of class `"drcMean"` as returned by +[`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md), +containing the model definition including the mean function, its +gradient, parameter names, and fixed values. This object is intended for +use as the `fct` argument in +[`drm()`](https://hreinwald.github.io/drc/reference/drm.md). + +## See also + +- [`CRS.5()`](https://hreinwald.github.io/drc/reference/CRS.5.md) — the + recommended replacement for this deprecated function. + +- [`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md) + — the underlying model constructor. + +- [`CRS.4c()`](https://hreinwald.github.io/drc/reference/CRS.4c.md) — + the four-parameter CRS model with lower limit fixed at 0 and alpha = + 0.25. + +- [`CRS.5b()`](https://hreinwald.github.io/drc/reference/CRS.5b.md) — + the five-parameter CRS model with alpha = 0.5. + +## Author + +Christian Ritz, Hannes Reinwald + +## Examples + +``` r +# NOTE: CRS.5c() is deprecated. Use CRS.5() instead. +# The example below is retained for backward compatibility illustration only. + +lettuce.m3 <- drm( lettuce[, c(2, 1)], fct = CRS.5c() ) +summary(lettuce.m3) +#> +#> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.25) (5 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 0.981945 0.559334 1.7556 0.11305 +#> c:(Intercept) 0.336670 0.182883 1.8409 0.09877 . +#> d:(Intercept) 0.969845 0.088261 10.9883 1.624e-06 *** +#> e:(Intercept) 3.883893 2.462313 1.5773 0.14917 +#> f:(Intercept) 1.027934 0.766823 1.3405 0.21293 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.1256841 (9 degrees of freedom) +ED(lettuce.m3, c(50)) +#> +#> Estimated effective doses +#> +#> Estimate Std. Error +#> e:50 11.4243 8.7214 + +# Recommended replacement: +lettuce.crs5 <- drm( lettuce[, c(2, 1)], fct = CRS.5(alpha_type = "c") ) +summary(lettuce.crs5) +#> +#> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.25) (5 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 0.981945 0.559334 1.7556 0.11305 +#> c:(Intercept) 0.336670 0.182883 1.8409 0.09877 . +#> d:(Intercept) 0.969845 0.088261 10.9883 1.624e-06 *** +#> e:(Intercept) 3.883893 2.462313 1.5773 0.14917 +#> f:(Intercept) 1.027934 0.766823 1.3405 0.21293 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.1256841 (9 degrees of freedom) +ED(lettuce.crs5, c(50)) +#> +#> Estimated effective doses +#> +#> Estimate Std. Error +#> e:50 11.4243 8.7214 +``` diff --git a/docs/reference/CRS.6.html b/docs/reference/CRS.6.html new file mode 100644 index 00000000..aed5dbe8 --- /dev/null +++ b/docs/reference/CRS.6.html @@ -0,0 +1,125 @@ + +Generalised Cedergreen-Ritz-Streibig Model for Hormesis — CRS.6 • drc + Skip to contents + + +
    +
    +
    +

    Generalised Cedergreen-Ritz-Streibig Model for Hormesis

    + Source: R/CRS.6.R +
    CRS.6.Rd
    +
    + +
    +

    A six-parameter extension of the Cedergreen-Ritz-Streibig model for +describing hormesis, where the alpha parameter is estimated rather than fixed.

    +
    + +
    +

    Usage

    + 
    CRS.6(
+  fixed = c(NA, NA, NA, NA, NA, NA),
+  names = c("b", "c", "d", "e", "f", "g"),
+  method = c("1", "2", "3", "4"),
+  ssfct = NULL
+)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector. Specifies which parameters are fixed and at what value +they are fixed. NAs for parameters that are not fixed.

    + + +
    names
    +

    a vector of character strings giving the names of the parameters +(should not contain ":").

    + + +
    method
    +

    character string indicating the self starter function to use.

    + + +
    ssfct
    +

    a self starter function to be used (optional).

    + +
    +
    +

    Value

    +

    A list containing the nonlinear model function, the self starter function, +and the parameter names.

    +
    +
    +

    Details

    +

    The model function is:

    +

    $$f(x) = c + \frac{d-c+f \exp(-1/x^g)}{1+\exp(b(\log(x)-\log(e)))}$$

    +

    This generalises the five-parameter CRS.5a model by estimating +the alpha exponent (parameter \(g\)) instead of fixing it.

    +
    +
    +

    Note

    +

    This function is for use with drm.

    +
    +
    +

    See also

    +

    CRS.5a, cedergreen

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/CRS.6.md b/docs/reference/CRS.6.md new file mode 100644 index 00000000..361680a7 --- /dev/null +++ b/docs/reference/CRS.6.md @@ -0,0 +1,65 @@ +# Generalised Cedergreen-Ritz-Streibig Model for Hormesis + +A six-parameter extension of the Cedergreen-Ritz-Streibig model for +describing hormesis, where the alpha parameter is estimated rather than +fixed. + +## Usage + +``` r +CRS.6( + fixed = c(NA, NA, NA, NA, NA, NA), + names = c("b", "c", "d", "e", "f", "g"), + method = c("1", "2", "3", "4"), + ssfct = NULL +) +``` + +## Arguments + +- fixed: + + numeric vector. Specifies which parameters are fixed and at what value + they are fixed. NAs for parameters that are not fixed. + +- names: + + a vector of character strings giving the names of the parameters + (should not contain ":"). + +- method: + + character string indicating the self starter function to use. + +- ssfct: + + a self starter function to be used (optional). + +## Value + +A list containing the nonlinear model function, the self starter +function, and the parameter names. + +## Details + +The model function is: + +\$\$f(x) = c + \frac{d-c+f \exp(-1/x^g)}{1+\exp(b(\log(x)-\log(e)))}\$\$ + +This generalises the five-parameter +[`CRS.5a`](https://hreinwald.github.io/drc/reference/CRS.5a.md) model by +estimating the alpha exponent (parameter \\g\\) instead of fixing it. + +## Note + +This function is for use with +[`drm`](https://hreinwald.github.io/drc/reference/drm.md). + +## See also + +[`CRS.5a`](https://hreinwald.github.io/drc/reference/CRS.5a.md), +[`cedergreen`](https://hreinwald.github.io/drc/reference/cedergreen.md) + +## Author + +Christian Ritz diff --git a/docs/reference/CadmiumDaphnia-1.png b/docs/reference/CadmiumDaphnia-1.png new file mode 100644 index 00000000..44650eb6 Binary files /dev/null and b/docs/reference/CadmiumDaphnia-1.png differ diff --git a/docs/reference/CadmiumDaphnia.html b/docs/reference/CadmiumDaphnia.html new file mode 100644 index 00000000..cab6230e --- /dev/null +++ b/docs/reference/CadmiumDaphnia.html @@ -0,0 +1,128 @@ + +Cadmium Daphnia Data — CadmiumDaphnia • drc + Skip to contents + + +
    +
    +
    +

    Cadmium Daphnia Data

    + +
    CadmiumDaphnia.Rd
    +
    + +
    +

    Data from an acute toxicity test exposing Daphnia to cadmium over time. The endpoint measured was mortality (number of dead organisms) at each dose and time point.

    +
    + +
    +

    Usage

    + 
    data(CadmiumDaphnia)
    +
    + +
    +

    Format

    +

    A data frame with 58 observations on the following 6 variables.

    Dose
    +

    a numeric vector of dose values

    + +
    Time
    +

    a numeric vector

    + +
    Total
    +

    a numeric vector

    + +
    Start
    +

    a numeric vector

    + +
    End
    +

    a numeric vector

    + +
    Dead
    +

    a numeric vector

    + + +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Displaying the data
+head(CadmiumDaphnia)
+#>   Dose Time Total Start End Dead
+#> 1  0.0    2    50     0   2    0
+#> 2  0.0    4    50     2   4    0
+#> 3  0.0    7    50     4   7    0
+#> 4  0.0    9    50     7   9    0
+#> 5  0.0   11    50     9  11    0
+#> 6  0.0   14    50    11  14    0
+
+## Fitting a two-parameter log-logistic model for binomial response at a single time point
+CadmiumDaphnia.sub <- CadmiumDaphnia[CadmiumDaphnia$Time == 7, ]
+CadmiumDaphnia.m1 <- drm(Dead/Total ~ as.numeric(as.character(Dose)), weights = Total,
+data = CadmiumDaphnia.sub, fct = LL.2(), type = "binomial")
+summary(CadmiumDaphnia.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                Estimate Std. Error t-value   p-value    
+#> b:(Intercept)  -1.00362    0.21675 -4.6303 3.651e-06 ***
+#> e:(Intercept) 132.42840   51.34644  2.5791  0.009905 ** 
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+## Plotting the fitted curve
+plot(CadmiumDaphnia.m1, xlab = "Cadmium dose", ylab = "Proportion dead")
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/CadmiumDaphnia.md b/docs/reference/CadmiumDaphnia.md new file mode 100644 index 00000000..d6df0761 --- /dev/null +++ b/docs/reference/CadmiumDaphnia.md @@ -0,0 +1,74 @@ +# Cadmium Daphnia Data + +Data from an acute toxicity test exposing *Daphnia* to cadmium over +time. The endpoint measured was mortality (number of dead organisms) at +each dose and time point. + +## Usage + +``` r +data(CadmiumDaphnia) +``` + +## Format + +A data frame with 58 observations on the following 6 variables. + +- `Dose`: + + a numeric vector of dose values + +- `Time`: + + a numeric vector + +- `Total`: + + a numeric vector + +- `Start`: + + a numeric vector + +- `End`: + + a numeric vector + +- `Dead`: + + a numeric vector + +## Examples + +``` r +library(drc) + +## Displaying the data +head(CadmiumDaphnia) +#> Dose Time Total Start End Dead +#> 1 0.0 2 50 0 2 0 +#> 2 0.0 4 50 2 4 0 +#> 3 0.0 7 50 4 7 0 +#> 4 0.0 9 50 7 9 0 +#> 5 0.0 11 50 9 11 0 +#> 6 0.0 14 50 11 14 0 + +## Fitting a two-parameter log-logistic model for binomial response at a single time point +CadmiumDaphnia.sub <- CadmiumDaphnia[CadmiumDaphnia$Time == 7, ] +CadmiumDaphnia.m1 <- drm(Dead/Total ~ as.numeric(as.character(Dose)), weights = Total, +data = CadmiumDaphnia.sub, fct = LL.2(), type = "binomial") +summary(CadmiumDaphnia.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) -1.00362 0.21675 -4.6303 3.651e-06 *** +#> e:(Intercept) 132.42840 51.34644 2.5791 0.009905 ** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 + +## Plotting the fitted curve +plot(CadmiumDaphnia.m1, xlab = "Cadmium dose", ylab = "Proportion dead") +``` diff --git a/docs/reference/Cyp17-1.png b/docs/reference/Cyp17-1.png new file mode 100644 index 00000000..3205a564 Binary files /dev/null and b/docs/reference/Cyp17-1.png differ diff --git a/docs/reference/Cyp17.html b/docs/reference/Cyp17.html new file mode 100644 index 00000000..3c675a15 --- /dev/null +++ b/docs/reference/Cyp17.html @@ -0,0 +1,124 @@ + +Cyp17 expression data — Cyp17 • drc + Skip to contents + + +
    +
    +
    +

    Cyp17 expression data

    + +
    Cyp17.Rd
    +
    + +
    +

    Observed Cyp17 gene expression measured at several dose levels across multiple experimental runs. CYP17 is a key enzyme in steroid hormone biosynthesis, and changes in its expression can indicate endocrine-disrupting effects.

    +
    + +
    +

    Usage

    + 
    data(Cyp17)
    +
    + +
    +

    Format

    +

    A data frame with 63 observations on the following 3 variables.

    run
    +

    ID of 3 different runs

    + +
    dose
    +

    5 dose levels (0, 0.1, 10, 100, 500)

    + +
    expression
    +

    observed expression

    + + +
    + +
    +

    Examples

    + 
    data(Cyp17)
+
+## Display the structure of the data
+head(Cyp17)
+#>   run dose expression
+#> 1   1  500 0.04934222
+#> 2   1  500 0.05863851
+#> 3   1  500 0.07518652
+#> 4   1  100 0.05492933
+#> 5   1  100 0.03329362
+#> 6   1  100 0.01662889
+
+## Log-transform the expression values
+Cyp17$logexpression <- log(Cyp17$expression) + 5
+
+## Fit a four-parameter log-logistic model (ignoring run effects)
+Cyp17.m1 <- drm(logexpression ~ dose, data = Cyp17, fct = LL.4())
+summary(Cyp17.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                 Estimate Std. Error t-value   p-value    
+#> b:(Intercept)   -0.57006    0.50017 -1.1397   0.25901    
+#> c:(Intercept)    1.07498    0.10396 10.3403 7.168e-15 ***
+#> d:(Intercept)    2.30249    1.35392  1.7006   0.09428 .  
+#> e:(Intercept)  332.97197 1269.60417  0.2623   0.79403    
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.5299562 (59 degrees of freedom)
+plot(Cyp17.m1, main = "Cyp17 dose-response")
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/Cyp17.md b/docs/reference/Cyp17.md new file mode 100644 index 00000000..d080c608 --- /dev/null +++ b/docs/reference/Cyp17.md @@ -0,0 +1,68 @@ +# Cyp17 expression data + +Observed Cyp17 gene expression measured at several dose levels across +multiple experimental runs. CYP17 is a key enzyme in steroid hormone +biosynthesis, and changes in its expression can indicate +endocrine-disrupting effects. + +## Usage + +``` r +data(Cyp17) +``` + +## Format + +A data frame with 63 observations on the following 3 variables. + +- `run`: + + ID of 3 different runs + +- `dose`: + + 5 dose levels (0, 0.1, 10, 100, 500) + +- `expression`: + + observed expression + +## Examples + +``` r +data(Cyp17) + +## Display the structure of the data +head(Cyp17) +#> run dose expression +#> 1 1 500 0.04934222 +#> 2 1 500 0.05863851 +#> 3 1 500 0.07518652 +#> 4 1 100 0.05492933 +#> 5 1 100 0.03329362 +#> 6 1 100 0.01662889 + +## Log-transform the expression values +Cyp17$logexpression <- log(Cyp17$expression) + 5 + +## Fit a four-parameter log-logistic model (ignoring run effects) +Cyp17.m1 <- drm(logexpression ~ dose, data = Cyp17, fct = LL.4()) +summary(Cyp17.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) -0.57006 0.50017 -1.1397 0.25901 +#> c:(Intercept) 1.07498 0.10396 10.3403 7.168e-15 *** +#> d:(Intercept) 2.30249 1.35392 1.7006 0.09428 . +#> e:(Intercept) 332.97197 1269.60417 0.2623 0.79403 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.5299562 (59 degrees of freedom) +plot(Cyp17.m1, main = "Cyp17 dose-response") +``` diff --git a/docs/reference/Daphnia-1.png b/docs/reference/Daphnia-1.png new file mode 100644 index 00000000..08f1d365 Binary files /dev/null and b/docs/reference/Daphnia-1.png differ diff --git a/docs/reference/Daphnia.html b/docs/reference/Daphnia.html new file mode 100644 index 00000000..22a17c4d --- /dev/null +++ b/docs/reference/Daphnia.html @@ -0,0 +1,149 @@ + +Daphnia — Daphnia • drc + Skip to contents + + +
    +
    +
    +

    Daphnia

    + +
    Daphnia.Rd
    +
    + +
    +

    Data are from a binary mixture experiment that was based on a fixed-ratio design involving 5 rays: the 2 rays for the pesticides prochloraz and alpha-cypermethrin and 3 mixture rays corresponding to virtual mixture proportions of 25:75, 50:50, and 75:25.

    +
    + +
    +

    Usage

    + 
    data(Daphnia)
    +
    + +
    +

    Format

    +

    A data frame with 140 observations on the following 6 variables.

    dose.a
    +

    Dose of alpha-cypermethrin (mu g/L)

    + +
    dose.p
    +

    Dose of prochloraz (mu g/L)

    + +
    dose
    +

    Total dose in the mixture (mu g/L)

    + +
    mix.frac
    +

    Mixture fraction

    + +
    total
    +

    Total number of Daphnia

    + +
    immob48
    +

    Number of immobile Daphnia after 48 hours

    + + +
    +
    +

    Details

    +

    Synergistic and antagonistic effects of binary mixtures between a number of fungicides and the pyrethroid insecticide alpha-cypermethrin were investigated using a standard test system. Only data for the specific binary mixture of prochloraz and alpha-cypermethrin are provided. Data were obtained from a Daphnia acute immobilisation test where the test organisms were divided into groups of five, placed in containers, exposed to a dose (either a mixture dose or a dose from one of the two pesticides), and followed for 48h.

    +
    +
    +

    Source

    +

    Data were kindly provided by N. Cedergreen.

    +
    +
    +

    References

    +

    Noergaard KB and Cedergreen N, Pesticide cocktails can interact synergistically on aquatic crustaceans. Environ Sci Pollut Res 17: 957-967 (2010). https://doi.org/10.1007/s11356-009-0284-4

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Displaying the data
+head(Daphnia)
+#>   dose.a dose.p dose mix.frac total immob48
+#> 1   1.50      0 1.50        0     5       5
+#> 2   1.50      0 1.50        0     5       5
+#> 3   1.50      0 1.50        0     5       4
+#> 4   1.50      0 1.50        0     5       5
+#> 5   0.75      0 0.75        0     5       5
+#> 6   0.75      0 0.75        0     5       5
+
+## Fitting a two-parameter log-logistic model for binomial response
+## using mix.frac to model each mixture ray individually
+Daphnia.m1 <- drm(immob48/total ~ dose, mix.frac, weights = total,
+data = Daphnia, fct = LL.2(), type = "binomial")
+summary(Daphnia.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>          Estimate Std. Error t-value   p-value    
+#> b:0      -2.08226    0.35213 -5.9134 3.351e-09 ***
+#> b:0.75   -7.47956    1.79255 -4.1726 3.012e-05 ***
+#> b:0.5    -3.22760    0.60334 -5.3495 8.818e-08 ***
+#> b:0.25   -3.00588    0.57382 -5.2384 1.620e-07 ***
+#> b:1      -3.61417    0.72249 -5.0024 5.662e-07 ***
+#> e:0       0.29705    0.03489  8.5139 < 2.2e-16 ***
+#> e:0.75   98.81146    8.13182 12.1512 < 2.2e-16 ***
+#> e:0.5   123.96886   12.82359  9.6672 < 2.2e-16 ***
+#> e:0.25  280.08032   30.42243  9.2064 < 2.2e-16 ***
+#> e:1    4941.86142  477.42984 10.3510 < 2.2e-16 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+## Plotting the fitted curves for each mixture fraction
+plot(Daphnia.m1, xlab = "Total dose (mu g/L)", ylab = "Proportion immobile",
+ylim = c(0, 1), legendPos = c(3, 0.9))
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/Daphnia.md b/docs/reference/Daphnia.md new file mode 100644 index 00000000..603676f1 --- /dev/null +++ b/docs/reference/Daphnia.md @@ -0,0 +1,105 @@ +# Daphnia + +Data are from a binary mixture experiment that was based on a +fixed-ratio design involving 5 rays: the 2 rays for the pesticides +prochloraz and alpha-cypermethrin and 3 mixture rays corresponding to +virtual mixture proportions of 25:75, 50:50, and 75:25. + +## Usage + +``` r +data(Daphnia) +``` + +## Format + +A data frame with 140 observations on the following 6 variables. + +- `dose.a`: + + Dose of alpha-cypermethrin (mu g/L) + +- `dose.p`: + + Dose of prochloraz (mu g/L) + +- `dose`: + + Total dose in the mixture (mu g/L) + +- `mix.frac`: + + Mixture fraction + +- `total`: + + Total number of Daphnia + +- `immob48`: + + Number of immobile Daphnia after 48 hours + +## Details + +Synergistic and antagonistic effects of binary mixtures between a number +of fungicides and the pyrethroid insecticide alpha-cypermethrin were +investigated using a standard test system. Only data for the specific +binary mixture of prochloraz and alpha-cypermethrin are provided. Data +were obtained from a Daphnia acute immobilisation test where the test +organisms were divided into groups of five, placed in containers, +exposed to a dose (either a mixture dose or a dose from one of the two +pesticides), and followed for 48h. + +## Source + +Data were kindly provided by N. Cedergreen. + +## References + +Noergaard KB and Cedergreen N, Pesticide cocktails can interact +synergistically on aquatic crustaceans. Environ Sci Pollut Res 17: +957-967 (2010). https://doi.org/10.1007/s11356-009-0284-4 + +## Examples + +``` r +library(drc) + +## Displaying the data +head(Daphnia) +#> dose.a dose.p dose mix.frac total immob48 +#> 1 1.50 0 1.50 0 5 5 +#> 2 1.50 0 1.50 0 5 5 +#> 3 1.50 0 1.50 0 5 4 +#> 4 1.50 0 1.50 0 5 5 +#> 5 0.75 0 0.75 0 5 5 +#> 6 0.75 0 0.75 0 5 5 + +## Fitting a two-parameter log-logistic model for binomial response +## using mix.frac to model each mixture ray individually +Daphnia.m1 <- drm(immob48/total ~ dose, mix.frac, weights = total, +data = Daphnia, fct = LL.2(), type = "binomial") +summary(Daphnia.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:0 -2.08226 0.35213 -5.9134 3.351e-09 *** +#> b:0.75 -7.47956 1.79255 -4.1726 3.012e-05 *** +#> b:0.5 -3.22760 0.60334 -5.3495 8.818e-08 *** +#> b:0.25 -3.00588 0.57382 -5.2384 1.620e-07 *** +#> b:1 -3.61417 0.72249 -5.0024 5.662e-07 *** +#> e:0 0.29705 0.03489 8.5139 < 2.2e-16 *** +#> e:0.75 98.81146 8.13182 12.1512 < 2.2e-16 *** +#> e:0.5 123.96886 12.82359 9.6672 < 2.2e-16 *** +#> e:0.25 280.08032 30.42243 9.2064 < 2.2e-16 *** +#> e:1 4941.86142 477.42984 10.3510 < 2.2e-16 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 + +## Plotting the fitted curves for each mixture fraction +plot(Daphnia.m1, xlab = "Total dose (mu g/L)", ylab = "Proportion immobile", +ylim = c(0, 1), legendPos = c(3, 0.9)) +``` diff --git a/docs/reference/ED.drc.html b/docs/reference/ED.drc.html index 93f052f2..0f24ddf5 100644 --- a/docs/reference/ED.drc.html +++ b/docs/reference/ED.drc.html @@ -1,331 +1,328 @@ - - - - - - +Estimating effective doses — ED.drc • drc + Skip to contents + + +
    +
    +
    +

    Estimating effective doses

    + Source: R/ED.drc.R +
    ED.drc.Rd
    +
    - - +
    +

    Default method for class drc. ED.drc estimates effective +concentrations (EC) or effective doses (ED) for one or more specified +response levels. Response levels may be given as relative percentages of +the response range (e.g. ED50 = 50\ +values. The function computes point estimates, delta-method standard +errors, and optional confidence intervals for each combination of curve and +response level in the fitted model.

    +
    - - +
    +

    Usage

    + 
    # S3 method for class 'drc'
+ED(
+  object,
+  respLev = c(10, 20, 50),
+  interval = c("none", "delta", "fls", "tfls", "inv"),
+  clevel = NULL,
+  level = 0.95,
+  reference = c("control", "upper"),
+  type = c("relative", "absolute"),
+  lref,
+  uref,
+  bound = TRUE,
+  vcov. = vcov,
+  display = TRUE,
+  logBase = NULL,
+  multcomp = FALSE,
+  intType = "confidence",
+  ...
+)
    +
    - - +
    +

    Arguments

    - - - - - +
    object
    +

    an object of class drc.

    +
    respLev
    +

    a numeric vector containing the response levels.

    - - +
    interval
    +

    character string specifying the type of confidence intervals +to be supplied. The default is "none". See Details below for more +explanation.

    - - +
    clevel
    +

    character string specifying the curve id in case estimates for +a specific curve or compound are requested. By default estimates are shown +for all curves.

    - - +
    level
    +

    numeric. The level for the confidence intervals. Must be a +single value strictly between 0 and 1. The default is 0.95.

    - +
    reference
    +

    character string. Is the upper limit or the control level +the reference?

    - - -
    -
    - - - -
    -
    -
    -
    -

    Estimating effective doses

    - - -
    +
    lref
    +

    numeric value specifying the lower limit to serve as reference.

    + + +
    uref
    +

    numeric value specifying the upper limit to serve as reference +(e.g., 100%).

    + + +
    bound
    +

    logical. Default is TRUE, in which case only ED values +between 0 and 100% are allowed. Set to FALSE for hormesis models.

    + + +
    vcov.
    +

    function providing the variance-covariance matrix, or a +variance-covariance matrix directly. vcov is the default, +but sandwich is also an option for obtaining robust standard errors.

    + + +
    display
    +

    logical. If TRUE results are displayed. Otherwise they +are not (useful in simulations).

    + -
    - - +
    logBase
    +

    numeric. The base of the logarithm in case logarithm +transformed dose values are used.

    -

    ED estimates effective concentration or doses for one or more specified absolute or relative response levels.

    - + +
    multcomp
    +

    logical to switch on output for use with the package +multcomp (which needs to be activated first). Default is +FALSE.

    + + +
    intType
    +

    string specifying the type of interval to use with the +predict method in case the type of confidence interval chosen is inverse +regression.

    + + +
    ...
    +

    additional arguments passed to the ED function in the model.

    + +
    +
    +

    Value

    +

    An invisible matrix containing the estimates and the corresponding +estimated standard errors and possibly lower and upper confidence limits. +Or, alternatively, a list with elements that may be plugged directly into +parm in the package multcomp (when multcomp = TRUE).

    +
    +
    +

    Details

    +

    The function carries out the following computational steps:

    +

    1. Input validation. +Arguments are checked for correct types and ranges (e.g. respLev +must be numeric, level must be in (0, 1), and relative response +levels must lie strictly inside the interval (0, 100) when +bound = TRUE).

      2. +

    2. Model component extraction. +The model-specific ED function (edfct), parameter matrix +(parmMat), and index matrix (indexMat) are retrieved from +the fitted drc object. The variance-covariance matrix is +obtained from vcov., which may be a function (e.g. +vcov or sandwich::vcovHC) or a pre-computed matrix.

      3. +

    3. Curve ordering. +When multiple curves are present, they are sorted alphabetically by +name, unless the names are purely numeric, in which case the original +order is preserved.

      4. +

    4. ED estimation and delta-method standard errors. +For each curve and each requested response level, the model-specific +edfct is called to obtain the ED point estimate and its +analytical gradient with respect to the model parameters. Standard +errors are then computed via the delta method: +\(SE = \sqrt{g' V g}\), where \(g\) is the +gradient vector and \(V\) is the relevant sub-matrix of the +variance-covariance matrix.

      5. +

    5. Numerical gradient for absolute responses. +When type = "absolute", the analytical gradient returned by the +model may miss the chain-rule contribution from the asymptote parameters +involved in converting absolute to relative response levels. In that +case a numerical central-difference gradient is computed to ensure +correct standard errors.

      6. +

    6. Log-base back-transformation. +If logBase is specified (indicating that dose values were +log-transformed prior to model fitting), the ED estimates and their +derivatives are back-transformed via \(ED^* = b^{ED}\) +(where \(b\) is the log base) so that results are reported on the +original dose scale.

      7. +

    7. Confidence interval construction. +Depending on interval:

      "delta"
      +

      Asymptotic Wald-type intervals using the delta +method, based on the normal or t-distribution (depending on the +response type).

      + +
      "fls"
      +

      Intervals obtained by back-transforming from the +log scale. Only meaningful when the model parameterises the ED on +the log scale (e.g. llogistic2).

      + +
      "tfls"
      +

      Experimental: intervals obtained by transforming +to the log scale, computing Wald intervals there, then +back-transforming.

      + +
      "inv"
      +

      Intervals derived from inverse regression via +EDinvreg, where confidence limits on the +predicted response are inverted to the dose axis.

      + + +
      8. +

    8. Output. +Results are returned as an invisible matrix with columns for the +estimate, standard error, and (optionally) lower and upper confidence +limits. When multcomp = TRUE, a list compatible with +parm is returned instead, enabling +multiple-comparison procedures.

      9. +

    For hormesis models (braincousens and +cedergreen), the additional arguments lower and +upper may be supplied. These arguments specify the lower and upper +limits of the bisection method used to find the ED values.

    +
    +
    +

    See also

    +

    EDcomp for estimating differences and ratios of ED +values, compParm for comparing other model parameters, and +backfit.

    +
    +
    +

    Author

    +

    Christian Ritz

    - 
    # S3 method for drc
-ED(object, respLev, interval = c("none", "delta", "fls", "tfls", "inv"),
-  clevel = NULL, level = ifelse(!(interval == "none"), 0.95, NULL),
-  reference = c("control", "upper"), type = c("relative", "absolute"), lref, uref,
-  bound = TRUE, od = FALSE, vcov. = vcov, display = TRUE, pool = TRUE, logBase = NULL,
-  multcomp = FALSE, intType = "confidence", ...)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    object

    an object of class 'drc'.

    respLev

    a numeric vector containing the response levels.

    interval

    character string specifying the type of confidence intervals to be supplied. The default is "none". - See Details below for more explanation.

    clevel

    character string specifying the curve id in case on estimates for a specific curve or compound is requested. By default estimates - are shown for all curves.

    level

    numeric. The level for the confidence intervals. The default is 0.95.

    reference

    character string. Is the upper limit or the control level the reference?

    type

    character string. Whether the specified response levels are absolute or relative (default).

    lref

    numeric value specifying the lower limit to serve as reference.

    uref

    numeric value specifying the upper limit to serve as reference (e.g., 100%).

    bound

    logical. If TRUE only ED values between 0 and 100% are allowed. FALSE is useful for hormesis models.

    od

    logical. If TRUE adjustment for over-dispersion is used.

    vcov.

    function providing the variance-covariance matrix. vcov is the default, - but sandwich is also an option (for obtaining robust standard errors).

    display

    logical. If TRUE results are displayed. Otherwise they are not (useful in simulations).

    pool

    logical. If TRUE curves are pooled. Otherwise they are not. This argument only works for models with independently fitted curves as specified in drm.

    logBase

    numeric. The base of the logarithm in case logarithm transformed dose values are used.

    multcomp

    logical to switch on output for use with the package multcomp (which needs to be activated first). Default is FALSE (corresponding to the original output).

    intType

    string specifying the type of interval to use with the predict method in case the type of confidence - interval chosen with the argument "type" is "inverse regression."

    ...

    see the details section below.

    - -

    Details

    - -

    There are several options for calculating confidence intervals through the argument interval. The option "delta" results in asymptotical Wald-type confidence intervals (using the delta method and the normal or t-distribution depending on the type of response). The option "fls" produces (possibly skewed) confidence intervals through back-transformation from the logarithm scale (only meaningful in case the parameter in the model is log(ED50) as for the llogistic2) models. The option "tfls" is for transforming back and forth from log scale (experimental). The option "inv" results in confidence intervals obtained through inverse regression.

    -

    For hormesis models (braincousens and cedergreen), the additional - arguments lower and upper may be supplied. These arguments specify the lower and upper limits - of the bisection method used to find the ED values. The lower and upper limits need to be smaller/larger - than the EDx level to be calculated. The default limits are 0.001 and 1000 for braincousens and - 0.0001 and 10000 for cedergreen and ucedergreen, but this may need to be modified - (for cedergreen the upper limit may need to be increased and for ucedergreen - the lower limit may need to be increased). Note that the lower limit should not be set to 0 (use instead - something like 1e-3, 1e-6, ...).

    - -

    Value

    - -

    An invisible matrix containing the shown matrix with two or more columns, containing the estimates - and the corresponding estimated standard errors and possibly lower and upper confidence limits. - Or, alternatively, a list with elements that may be plugged directly into parm - in the package multcomp (in case the argument multcomp is TRUE).

    - -

    See also

    - -

    backfit, isobole, and maED use ED for specific calculations involving estimated ED values.

    -

    The related function EDcomp may be used for estimating differences and ratios of ED values, - whereas compParm may be used to compare other model parameters.

    - - -

    Examples

    - 
    
-## Fitting 4-parameter log-logistic model
-ryegrass.m1 <- drm(ryegrass, fct = LL.4())
-
-## Calculating EC/ED values
-ED(ryegrass.m1, c(10, 50, 90))
    #> 
-#> Estimated effective doses
-#> 
-#>        Estimate Std. Error
-#> e:1:10  1.46371    0.18677
-#> e:1:50  3.05795    0.18573
-#> e:1:90  6.38864    0.84510
    ## first column: the estimates of ED10, ED50 and ED90
-## second column: the corresponding estimated standard errors 
-
-### How to use the argument 'ci'
-
-## Also displaying 95% confidence intervals
-ED(ryegrass.m1, c(10, 50, 90), interval = "delta")
    #> 
-#> Estimated effective doses
-#> 
-#>        Estimate Std. Error   Lower   Upper
-#> e:1:10  1.46371    0.18677 1.07411 1.85330
-#> e:1:50  3.05795    0.18573 2.67053 3.44538
-#> e:1:90  6.38864    0.84510 4.62580 8.15148
    
-## Comparing delta method and back-transformed 
-##  confidence intervals for ED values
-
-## Fitting 4-parameter log-logistic 
-##  in different parameterisation (using LL2.4)
-ryegrass.m2 <- drm(ryegrass, fct = LL2.4())
-
-ED(ryegrass.m1, c(10, 50, 90), interval = "fls")
    #> 
-#> Estimated effective doses
-#> 
-#>         Estimate     Lower     Upper
-#> e:1:10    4.3219    2.9274    6.3809
-#> e:1:50   21.2840   14.4476   31.3553
-#> e:1:90  595.0468  102.0842 3468.5164
    ED(ryegrass.m2, c(10, 50, 90), interval = "delta")
    #> 
-#> Estimated effective doses
-#> 
-#>        Estimate Std. Error    Lower    Upper
-#> e:1:10 0.380975   0.127602 0.114802 0.647147
-#> e:1:50 1.117746   0.060737 0.991051 1.244442
-#> e:1:90 1.854518   0.132282 1.578584 2.130453
    
-
-### How to use the argument 'bound'
-
-## Fitting the Brain-Cousens model
-lettuce.m1 <- drm(weight ~ conc,
-data = lettuce, fct = BC.4())
-
-### Calculating ED[-10]
-
-# This does not work
-#ED(lettuce.m1, -10)  
-
-## Now it does work
-ED(lettuce.m1, -10, bound = FALSE)  # works
    #> 
-#> Estimated effective doses
-#> 
-#>         Estimate Std. Error
-#> e:1:-10   1.8646     1.0163
    ED(lettuce.m1, -20, bound = FALSE)  # works
    #> 
-#> Estimated effective doses
-#> 
-#>         Estimate Std. Error
-#> e:1:-20  0.96333    1.23014
    
-## The following does not work for another reason: ED[-30] does not exist 
-#ED(lettuce.m1, -30, bound = FALSE)  
-
-
    -
    - -
    +
    +

    Examples

    + 
    ## Fitting a 4-parameter log-logistic model
+ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4())
+
+## Calculating EC/ED values
+ED(ryegrass.m1, c(10, 50, 90))
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error
+#> e:10  1.46371    0.18677
+#> e:50  3.05795    0.18573
+#> e:90  6.38864    0.84510
+
+## Displaying 95% confidence intervals using the delta method
+ED(ryegrass.m1, c(10, 50, 90), interval = "delta")
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error   Lower   Upper
+#> e:10  1.46371    0.18677 1.07411 1.85330
+#> e:50  3.05795    0.18573 2.67053 3.44538
+#> e:90  6.38864    0.84510 4.62580 8.15148
+
+## Displaying 95% confidence intervals using back-transformation
+ED(ryegrass.m1, c(10, 50, 90), interval = "fls")
+#> 
+#> Estimated effective doses
+#> 
+#>        Estimate Std. Error      Lower      Upper
+#> e:10    4.32195    0.18677    2.92738    6.38085
+#> e:50   21.28399    0.18573   14.44757   31.35531
+#> e:90  595.04680    0.84510  102.08419 3468.51638
+
+## Displaying 95% confidence intervals using inverse regression
+ED(ryegrass.m1, c(10, 50, 90), interval = "inv")
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error   Lower   Upper
+#> e:10  1.46371    0.18677 1.14225 1.82253
+#> e:50  3.05795    0.18573 2.74905 3.40172
+#> e:90  6.38864    0.84510 5.15138 8.19648
+
+
    +
    +
    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -

    Site built with pkgdown.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -
    +
    + + + - - - + diff --git a/docs/reference/ED.drc.md b/docs/reference/ED.drc.md new file mode 100644 index 00000000..b638e033 --- /dev/null +++ b/docs/reference/ED.drc.md @@ -0,0 +1,263 @@ +# Estimating effective doses + +Default method for class `drc`. `ED.drc` estimates effective +concentrations (EC) or effective doses (ED) for one or more specified +response levels. Response levels may be given as relative percentages of +the response range (e.g. ED50 = 50\\ values. The function computes point +estimates, delta-method standard errors, and optional confidence +intervals for each combination of curve and response level in the fitted +model. + +## Usage + +``` r +# S3 method for class 'drc' +ED( + object, + respLev = c(10, 20, 50), + interval = c("none", "delta", "fls", "tfls", "inv"), + clevel = NULL, + level = 0.95, + reference = c("control", "upper"), + type = c("relative", "absolute"), + lref, + uref, + bound = TRUE, + vcov. = vcov, + display = TRUE, + logBase = NULL, + multcomp = FALSE, + intType = "confidence", + ... +) +``` + +## Arguments + +- object: + + an object of class `drc`. + +- respLev: + + a numeric vector containing the response levels. + +- interval: + + character string specifying the type of confidence intervals to be + supplied. The default is `"none"`. See Details below for more + explanation. + +- clevel: + + character string specifying the curve id in case estimates for a + specific curve or compound are requested. By default estimates are + shown for all curves. + +- level: + + numeric. The level for the confidence intervals. Must be a single + value strictly between 0 and 1. The default is `0.95`. + +- reference: + + character string. Is the upper limit or the control level the + reference? + +- type: + + character string. Whether the specified response levels are absolute + or relative (default). + +- lref: + + numeric value specifying the lower limit to serve as reference. + +- uref: + + numeric value specifying the upper limit to serve as reference (e.g., + 100%). + +- bound: + + logical. Default is `TRUE`, in which case only ED values between 0 and + 100% are allowed. Set to `FALSE` for hormesis models. + +- vcov.: + + function providing the variance-covariance matrix, or a + variance-covariance matrix directly. + [`vcov`](https://rdrr.io/r/stats/vcov.html) is the default, but + `sandwich` is also an option for obtaining robust standard errors. + +- display: + + logical. If `TRUE` results are displayed. Otherwise they are not + (useful in simulations). + +- logBase: + + numeric. The base of the logarithm in case logarithm transformed dose + values are used. + +- multcomp: + + logical to switch on output for use with the package multcomp (which + needs to be activated first). Default is `FALSE`. + +- intType: + + string specifying the type of interval to use with the predict method + in case the type of confidence interval chosen is inverse regression. + +- ...: + + additional arguments passed to the ED function in the model. + +## Value + +An invisible matrix containing the estimates and the corresponding +estimated standard errors and possibly lower and upper confidence +limits. Or, alternatively, a list with elements that may be plugged +directly into `parm` in the package multcomp (when `multcomp = TRUE`). + +## Details + +The function carries out the following computational steps: + +1. **Input validation.** Arguments are checked for correct types and + ranges (e.g. `respLev` must be numeric, `level` must be in (0, 1), + and relative response levels must lie strictly inside the interval + (0, 100) when `bound = TRUE`). + +2. **Model component extraction.** The model-specific ED function + (`edfct`), parameter matrix (`parmMat`), and index matrix + (`indexMat`) are retrieved from the fitted `drc` object. The + variance-covariance matrix is obtained from `vcov.`, which may be a + function (e.g. [`vcov`](https://rdrr.io/r/stats/vcov.html) or + [`sandwich::vcovHC`](https://sandwich.R-Forge.R-project.org/reference/vcovHC.html)) + or a pre-computed matrix. + +3. **Curve ordering.** When multiple curves are present, they are + sorted alphabetically by name, unless the names are purely numeric, + in which case the original order is preserved. + +4. **ED estimation and delta-method standard errors.** For each curve + and each requested response level, the model-specific `edfct` is + called to obtain the ED point estimate and its analytical gradient + with respect to the model parameters. Standard errors are then + computed via the delta method: \\SE = \sqrt{g' V g}\\, where \\g\\ + is the gradient vector and \\V\\ is the relevant sub-matrix of the + variance-covariance matrix. + +5. **Numerical gradient for absolute responses.** When + `type = "absolute"`, the analytical gradient returned by the model + may miss the chain-rule contribution from the asymptote parameters + involved in converting absolute to relative response levels. In that + case a numerical central-difference gradient is computed to ensure + correct standard errors. + +6. **Log-base back-transformation.** If `logBase` is specified + (indicating that dose values were log-transformed prior to model + fitting), the ED estimates and their derivatives are + back-transformed via \\ED^\* = b^{ED}\\ (where \\b\\ is the log + base) so that results are reported on the original dose scale. + +7. **Confidence interval construction.** Depending on `interval`: + + - `"delta"`: + + Asymptotic Wald-type intervals using the delta method, based on + the normal or t-distribution (depending on the response type). + + - `"fls"`: + + Intervals obtained by back-transforming from the log scale. Only + meaningful when the model parameterises the ED on the log scale + (e.g. + [`llogistic2`](https://hreinwald.github.io/drc/reference/llogistic2.md)). + + - `"tfls"`: + + Experimental: intervals obtained by transforming to the log scale, + computing Wald intervals there, then back-transforming. + + - `"inv"`: + + Intervals derived from inverse regression via + [`EDinvreg`](https://hreinwald.github.io/drc/reference/EDinvreg.md), + where confidence limits on the predicted response are inverted to + the dose axis. + +8. **Output.** Results are returned as an invisible matrix with columns + for the estimate, standard error, and (optionally) lower and upper + confidence limits. When `multcomp = TRUE`, a list compatible with + [`parm`](https://rdrr.io/pkg/multcomp/man/parm.html) is returned + instead, enabling multiple-comparison procedures. + +For hormesis models +([`braincousens`](https://hreinwald.github.io/drc/reference/braincousens.md) +and +[`cedergreen`](https://hreinwald.github.io/drc/reference/cedergreen.md)), +the additional arguments `lower` and `upper` may be supplied. These +arguments specify the lower and upper limits of the bisection method +used to find the ED values. + +## See also + +[`EDcomp`](https://hreinwald.github.io/drc/reference/EDcomp.md) for +estimating differences and ratios of ED values, +[`compParm`](https://hreinwald.github.io/drc/reference/compParm.md) for +comparing other model parameters, and +[`backfit`](https://hreinwald.github.io/drc/reference/backfit.md). + +## Author + +Christian Ritz + +## Examples + +``` r +## Fitting a 4-parameter log-logistic model +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + +## Calculating EC/ED values +ED(ryegrass.m1, c(10, 50, 90)) +#> +#> Estimated effective doses +#> +#> Estimate Std. Error +#> e:10 1.46371 0.18677 +#> e:50 3.05795 0.18573 +#> e:90 6.38864 0.84510 + +## Displaying 95% confidence intervals using the delta method +ED(ryegrass.m1, c(10, 50, 90), interval = "delta") +#> +#> Estimated effective doses +#> +#> Estimate Std. Error Lower Upper +#> e:10 1.46371 0.18677 1.07411 1.85330 +#> e:50 3.05795 0.18573 2.67053 3.44538 +#> e:90 6.38864 0.84510 4.62580 8.15148 + +## Displaying 95% confidence intervals using back-transformation +ED(ryegrass.m1, c(10, 50, 90), interval = "fls") +#> +#> Estimated effective doses +#> +#> Estimate Std. Error Lower Upper +#> e:10 4.32195 0.18677 2.92738 6.38085 +#> e:50 21.28399 0.18573 14.44757 31.35531 +#> e:90 595.04680 0.84510 102.08419 3468.51638 + +## Displaying 95% confidence intervals using inverse regression +ED(ryegrass.m1, c(10, 50, 90), interval = "inv") +#> +#> Estimated effective doses +#> +#> Estimate Std. Error Lower Upper +#> e:10 1.46371 0.18677 1.14225 1.82253 +#> e:50 3.05795 0.18573 2.74905 3.40172 +#> e:90 6.38864 0.84510 5.15138 8.19648 +``` diff --git a/docs/reference/ED.html b/docs/reference/ED.html new file mode 100644 index 00000000..bdfe61dc --- /dev/null +++ b/docs/reference/ED.html @@ -0,0 +1,104 @@ + +Estimating effective doses — ED • drc + Skip to contents + + +
    +
    +
    +

    Estimating effective doses

    + Source: R/ED.drc.R +
    ED.Rd
    +
    + +
    +

    S3 generic function that dispatches to the appropriate method for estimating +effective concentrations (EC) or effective doses (ED) at specified response +levels. For objects of class drc, the default method +ED.drc is called.

    +
    + +
    +

    Usage

    + 
    ED(object, ...)
    +
    + +
    +

    Arguments

    + + +
    object
    +

    an object of class drc.

    + + +
    ...
    +

    additional arguments passed to the method.

    + +
    +
    +

    Value

    +

    See ED.drc for details on the return value.

    +
    +
    +

    See also

    +

    ED.drc for the default method, EDcomp for estimating differences and ratios of ED

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/ED.lin.html b/docs/reference/ED.lin.html new file mode 100644 index 00000000..91e8b8b9 --- /dev/null +++ b/docs/reference/ED.lin.html @@ -0,0 +1,71 @@ + +ED calculation for linear models — ED.lin • drc + Skip to contents + + +
    +
    +
    +

    ED calculation for linear models

    + Source: R/ED.lin.R +
    ED.lin.Rd
    +
    + +
    +

    ED calculation for linear models

    +
    + +
    +

    Usage

    + 
    # S3 method for class 'lin'
+ED(object, respLev, ...)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/ED.lin.md b/docs/reference/ED.lin.md new file mode 100644 index 00000000..128c15ec --- /dev/null +++ b/docs/reference/ED.lin.md @@ -0,0 +1,10 @@ +# ED calculation for linear models + +ED calculation for linear models + +## Usage + +``` r +# S3 method for class 'lin' +ED(object, respLev, ...) +``` diff --git a/docs/reference/ED.md b/docs/reference/ED.md new file mode 100644 index 00000000..5f34a01e --- /dev/null +++ b/docs/reference/ED.md @@ -0,0 +1,39 @@ +# Estimating effective doses + +S3 generic function that dispatches to the appropriate method for +estimating effective concentrations (EC) or effective doses (ED) at +specified response levels. For objects of class `drc`, the default +method [`ED.drc`](https://hreinwald.github.io/drc/reference/ED.drc.md) +is called. + +## Usage + +``` r +ED(object, ...) +``` + +## Arguments + +- object: + + an object of class `drc`. + +- ...: + + additional arguments passed to the method. + +## Value + +See [`ED.drc`](https://hreinwald.github.io/drc/reference/ED.drc.md) for +details on the return value. + +## See also + +[`ED.drc`](https://hreinwald.github.io/drc/reference/ED.drc.md) for the +default method, +[`EDcomp`](https://hreinwald.github.io/drc/reference/EDcomp.md) for +estimating differences and ratios of ED + +## Author + +Christian Ritz diff --git a/docs/reference/ED_robust.html b/docs/reference/ED_robust.html new file mode 100644 index 00000000..adc2c485 --- /dev/null +++ b/docs/reference/ED_robust.html @@ -0,0 +1,157 @@ + +Robust Calculation of Effective Doses (ED) — ED_robust • drc + Skip to contents + + +
    +
    +
    +

    Robust Calculation of Effective Doses (ED)

    + Source: R/ED_robust.R +
    ED_robust.Rd
    +
    + +
    +

    This function serves as a robust wrapper for drc::ED. It calculates +effective doses (EDs) for multiple specified response levels. Its primary +feature is the ability to gracefully handle cases where an ED value is not +mathematically estimable from the model (e.g., the requested response is +outside the model's asymptotes). Instead of throwing an error, it returns a +row of NA values for that specific response level, ensuring the overall +analysis can proceed.

    +
    + +
    +

    Usage

    + 
    ED_robust(
+  mod,
+  respLev = c(10, 20, 50),
+  interval = get_ed_interval(mod$fct$name, small_n = TRUE),
+  CI_level = 0.95,
+  verbose = FALSE,
+  ...
+)
    +
    + +
    +

    Arguments

    + + +
    mod
    +

    An object of class 'drc', representing the fitted dose-response model.

    + + +
    respLev
    +

    A numeric vector specifying the response levels for which to +calculate ED values (e.g., c(10, 50) for ED10 and ED50).

    + + +
    interval
    +

    A character string specifying the method for calculating +confidence intervals. Defaults to the output of get_ed_interval(). +Common options include "delta", "tfls", or "buckland".

    + + +
    CI_level
    +

    A numeric value between 0 and 1 indicating the confidence +level for the intervals (e.g., 0.95 for a 95% CI).

    + + +
    verbose
    +

    A logical value. If TRUE, the function will print status +messages about the calculation progress and any errors encountered for each +response level. Default is FALSE.

    + + +
    ...
    +

    Additional arguments to be passed directly to drc::ED.

    + +
    +
    +

    Value

    +

    A data.table where each row corresponds to a requested response level. +The table includes the ED estimate, standard error, confidence interval +(Lower, Upper), and metadata about the calculation (confidence level, method, +model name, and EC level). Rows for non-estimable EDs are populated with NA.

    +
    +
    +

    Author

    +

    Hannes Reinwald

    +
    + +
    +

    Examples

    + 
    data(lettuce)
+m <- drm(weight ~ conc, data = lettuce, fct = BC.4())
+ED_robust(m, respLev = c(10, 50), CI_level = 0.95)
+#>     Estimate    stderr     Lower    Upper confint_level confint_method
+#>        <num>     <num>     <num>    <num>         <num>         <char>
+#> 1:  4.457785  1.674585  1.930237 10.29503          0.95           tfls
+#> 2: 35.022556 15.426732 13.125303 93.45151          0.95           tfls
+#>           model    EC
+#>          <char> <num>
+#> 1: BC.4:b-d-e-f    10
+#> 2: BC.4:b-d-e-f    50
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/ED_robust.md b/docs/reference/ED_robust.md new file mode 100644 index 00000000..18b0f567 --- /dev/null +++ b/docs/reference/ED_robust.md @@ -0,0 +1,85 @@ +# Robust Calculation of Effective Doses (ED) + +This function serves as a robust wrapper for +[`drc::ED`](https://hreinwald.github.io/drc/reference/ED.md). It +calculates effective doses (EDs) for multiple specified response levels. +Its primary feature is the ability to gracefully handle cases where an +ED value is not mathematically estimable from the model (e.g., the +requested response is outside the model's asymptotes). Instead of +throwing an error, it returns a row of `NA` values for that specific +response level, ensuring the overall analysis can proceed. + +## Usage + +``` r +ED_robust( + mod, + respLev = c(10, 20, 50), + interval = get_ed_interval(mod$fct$name, small_n = TRUE), + CI_level = 0.95, + verbose = FALSE, + ... +) +``` + +## Arguments + +- mod: + + An object of class 'drc', representing the fitted dose-response model. + +- respLev: + + A numeric vector specifying the response levels for which to calculate + ED values (e.g., `c(10, 50)` for ED10 and ED50). + +- interval: + + A character string specifying the method for calculating confidence + intervals. Defaults to the output of + [`get_ed_interval()`](https://hreinwald.github.io/drc/reference/get_ed_interval.md). + Common options include "delta", "tfls", or "buckland". + +- CI_level: + + A numeric value between 0 and 1 indicating the confidence level for + the intervals (e.g., 0.95 for a 95% CI). + +- verbose: + + A logical value. If `TRUE`, the function will print status messages + about the calculation progress and any errors encountered for each + response level. Default is `FALSE`. + +- ...: + + Additional arguments to be passed directly to + [`drc::ED`](https://hreinwald.github.io/drc/reference/ED.md). + +## Value + +A `data.table` where each row corresponds to a requested response level. +The table includes the ED estimate, standard error, confidence interval +(Lower, Upper), and metadata about the calculation (confidence level, +method, model name, and EC level). Rows for non-estimable EDs are +populated with `NA`. + +## Author + +Hannes Reinwald + +## Examples + +``` r +data(lettuce) +m <- drm(weight ~ conc, data = lettuce, fct = BC.4()) +ED_robust(m, respLev = c(10, 50), CI_level = 0.95) +#> Estimate stderr Lower Upper confint_level confint_method +#> +#> 1: 4.457785 1.674585 1.930237 10.29503 0.95 tfls +#> 2: 35.022556 15.426732 13.125303 93.45151 0.95 tfls +#> model EC +#> +#> 1: BC.4:b-d-e-f 10 +#> 2: BC.4:b-d-e-f 50 +``` diff --git a/docs/reference/EDcomp.html b/docs/reference/EDcomp.html index ce0a1721..29924209 100644 --- a/docs/reference/EDcomp.html +++ b/docs/reference/EDcomp.html @@ -1,390 +1,241 @@ - - - - - - +Comparison of relative potencies between dose-response curves — EDcomp • drc + Skip to contents -Comparison of relative potencies between dose-response curves — EDcomp • drc - - - +
    +
    +
    +

    Comparison of relative potencies between dose-response curves

    + Source: R/EDcomp.R +
    EDcomp.Rd
    +
    - +
    +

    Relative potencies (also called selectivity indices) for arbitrary doses are compared between +fitted dose-response curves.

    +
    - - +
    +

    Usage

    + 
    EDcomp(
+  object,
+  percVec,
+  percMat = NULL,
+  compMatch = NULL,
+  od = FALSE,
+  vcov. = vcov,
+  reverse = FALSE,
+  interval = c("none", "delta", "fieller", "fls"),
+  level = ifelse(!(interval == "none"), 0.95, NULL),
+  reference = c("control", "upper"),
+  type = c("relative", "absolute"),
+  display = TRUE,
+  pool = TRUE,
+  logBase = NULL,
+  multcomp = FALSE,
+  ...
+)
    +
    +
    +

    Arguments

    - - +
    object
    +

    an object of class 'drc'.

    - +
    percVec
    +

    a numeric vector of dosage values.

    - - -
    -
    - - - -
    -
    -
    -
    -

    Comparison of relative potencies between dose-response curves

    - - -
    +
    compMatch
    +

    an optional character vector of names of assays to be compared. If not specified +all comparisons are supplied.

    -
    - -

    Relative potencies (also called selectivity indices) for arbitrary doses are compared between - fitted dose-response curves.

    - -
    - 
    EDcomp(object, percVec, percMat = NULL, compMatch = NULL, od = FALSE, vcov. = vcov,
-  reverse = FALSE,
-  interval = c("none", "delta", "fieller", "fls"),
-  level = ifelse(!(interval == "none"), 0.95, NULL),
-  reference = c("control", "upper"),
-  type = c("relative", "absolute"),
-  display = TRUE, pool = TRUE, logBase = NULL,
-  multcomp = FALSE, ...)
-
-  relpot(object, plotit = TRUE, compMatch = NULL, percVec = NULL, interval = "none",
-  type = c("relative", "absolute"),
-  scale = c("original", "percent", "unconstrained"), ...)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    object

    an object of class 'drc'.

    percVec

    a numeric vector of dosage values.

    percMat

    a matrix with 2 columns providing the pairs of indices percVec to be compared. - By default all pairs are compared.

    compMatch

    an optional character vector of names of assays to be compared. If not specified all comparisons are supplied.

    od

    logical. If TRUE adjustment for over-dispersion is used. This argument only makes a difference for - binomial data.

    vcov.

    function providing the variance-covariance matrix. vcov is the default, - but sandwich is also an option (for obtaining robust standard errors).

    reverse

    logical. If TRUE the order of comparison of two curves is reversed.

    interval

    character string specifying the type of confidence intervals to be supplied. The default is "none". - Use "delta" for asymptotics-based confidence intervals (using the delta method and the t-distribution). - Use "fieller" for confidence intervals based on Fieller's theorem (with help from the delta method). - Use "fls" for confidence interval back-transformed from logarithm scale (in case the parameter in the model fit is - log(ED50) as is the case for the logistic or llogistic2 models); currently - the argument logBase then also needs to be specified.

    level

    numeric. The level for the confidence intervals. Default is 0.95.

    reference

    character string. Is the upper limit or the control level the reference?

    type

    character string specifying whether absolute or relative response levels are supplied.

    logBase

    numeric. The base of the logarithm in case logarithm transformed dose values are used.

    display

    logical. If TRUE results are displayed. Otherwise they are not (useful in simulations).

    pool

    logical. If TRUE curves are pooled. Otherwise they are not. This argument only works for models with - independently fitted curves as specified in drm.

    multcomp

    logical to switch on output for use with the package multcomp (which needs to be activated first). Default is FALSE (corresponding to the original output).

    ...

    In SI: additional arguments to the function doing the calculations. - For instance the upper limit for the bisection method - needs to be larger than the ED values used in the required relative pontency. - In relpot: additional graphical parameters.

    plotit

    logical. If TRUE the relative potencies are plotted as a function of the response level.

    scale

    character string indicating the scale to be used on the x axis: original or percent response level - (only having an effect for type="relative").

    - -

    Details

    - -

    The function relpot is a convenience function, which is useful for assessing how the relative potency - changes as a function of the response level (e.g., for plotting as outlined by Ritz et al (2006)).

    -

    Fieller's theorem is incorporated using the formulas provided by Kotz and Johnson (1983) and Finney (1978).

    -

    For objects of class 'braincousens' or 'mlogistic' the additional argument may be the 'upper' argument - or the 'interval' argument. The 'upper' argument specifies the upper limit of the bisection method. - The upper limits needs to be larger than the EDx level to be calculated. The default limit is 1000. - The 'interval' argument should specify a rough interval in which the dose - yielding the maximum hormetical response lies. The default interval is 'c(0.001, 1000)'. - Notice that the lower limit should not be set to 0 (use something like 1e-3, 1e-6, ...).

    - -

    Value

    - -

    An invisible matrix containing the shown matrix with two or more columns, containing the estimates - and the corresponding estimated standard errors and possibly lower and upper confidence limits. - Or, alternatively, a list with elements that may be plugged directly into parm - in the package multcomp (in case the argument multcomp is TRUE).

    - -

    References

    - -

    Finney, D. J. (1978) Statistical method in Biological Assay, London: Charles Griffin House, - 3rd edition (pp. 80--82).

    -

    Kotz, S. and Johnson, N. L. (1983) Encyclopedia of Statistical Sciences Volume 3, - New York: Wiley \& Sons (pp. 86--87).

    -

    Ritz, C. and Cedergreen, N. and Jensen, J. E. and Streibig, J. C. (2006) - Relative potency in nonsimilar dose-response curves, Weed Science, 54, 407--412.

    - -

    Note

    - -

    This function only works for the following built-in functions available in the package drc: - braincousens, cedergreen, ucedergreen, llogistic, - and weibull1.

    - -

    See also

    - -

    A related function is ED.drc (used for calculating effective doses).

    - - -

    Examples

    - 
    
-spinach.LL.4 <- drm(SLOPE~DOSE, CURVE, data = spinach, fct = LL.4())
-
-EDcomp(spinach.LL.4, c(50,50))
    #> 
-#> Estimated ratios of effect doses
-#> 
-#>             Estimate Std. Error    t-value    p-value
-#> 1/2:50/50  1.8983586  0.7118489  1.2620074  0.2103980
-#> 1/3:50/50  1.3073016  0.5541592  0.5545367  0.5806678
-#> 1/4:50/50  9.0963785  2.4686586  3.2796671  0.0015076
-#> 1/5:50/50  8.5152294  2.3364483  3.2165187  0.0018362
-#> 2/3:50/50  0.6886484  0.2908078 -1.0706439  0.2873603
-#> 2/4:50/50  4.7917071  1.2883525  2.9430664  0.0041886
-#> 2/5:50/50  4.4855747  1.2196032  2.8579579  0.0053607
-#> 3/4:50/50  6.9581332  2.3220591  2.5658835  0.0120448
-#> 3/5:50/50  6.5135923  2.1896041  2.5180773  0.0136744
-#> 4/5:50/50  0.9361120  0.0781402 -0.8176069  0.4158677
    EDcomp(spinach.LL.4, c(10,50))
    #> 
-#> Estimated ratios of effect doses
-#> 
-#>              Estimate  Std. Error     t-value     p-value
-#> 1/2:10/50  2.7644e-02  1.5249e-02 -6.3765e+01  7.3799e-74
-#> 1/3:10/50  1.9037e-02  1.1155e-02 -8.7939e+01  1.5155e-85
-#> 1/4:10/50  1.3246e-01  6.4530e-02 -1.3444e+01  4.7570e-23
-#> 1/5:10/50  1.2400e-01  6.0615e-02 -1.4452e+01  6.4822e-25
-#> 2/3:10/50  4.4298e-02  3.7850e-02 -2.5250e+01  1.4449e-41
-#> 2/4:10/50  3.0823e-01  2.4349e-01 -2.8411e+00  5.6264e-03
-#> 2/5:10/50  2.8854e-01  2.2823e-01 -3.1173e+00  2.4906e-03
-#> 3/4:10/50  2.7742e-01  1.5001e-01 -4.8170e+00  6.2889e-06
-#> 3/5:10/50  2.5969e-01  1.4081e-01 -5.2573e+00  1.0722e-06
-#> 4/5:10/50  2.8449e-01  3.7366e-02 -1.9148e+01  7.0761e-33
    EDcomp(spinach.LL.4, c(10,50), reverse = TRUE)
    #> 
-#> Estimated ratios of effect doses
-#> 
-#>             Estimate Std. Error    t-value    p-value
-#> 2/1:50/10 3.6174e+01 1.9955e+01 1.7627e+00 8.1542e-02
-#> 3/1:50/10 5.2530e+01 3.0781e+01 1.6741e+00 9.7792e-02
-#> 4/1:50/10 7.5494e+00 3.6778e+00 1.7808e+00 7.8519e-02
-#> 5/1:50/10 8.0646e+00 3.9423e+00 1.7920e+00 7.6691e-02
-#> 3/2:50/10 2.2575e+01 1.9289e+01 1.1185e+00 2.6650e-01
-#> 4/2:50/10 3.2443e+00 2.5629e+00 8.7570e-01 3.8366e-01
-#> 5/2:50/10 3.4658e+00 2.7414e+00 8.9945e-01 3.7095e-01
-#> 4/3:50/10 3.6047e+00 1.9491e+00 1.3363e+00 1.8501e-01
-#> 5/3:50/10 3.8507e+00 2.0880e+00 1.3653e+00 1.7576e-01
-#> 5/4:50/10 3.5150e+00 4.6168e-01 5.4476e+00 4.8856e-07
    
-## Using the package multcomp
-#sires <- SI(spinach.LL.4, c(25, 50, 75))
-#library(multcomp)
-#summary(glht(parm(sires[[2]][[1]], sires[[2]][[2]]), rhs = 1))
-
-## Comparing specific ratios: 25/25, 50/50, 75/75
-#sires2 <- SI(spinach.LL.4, c(25, 50, 75), matrix(c(1, 1, 2, 2, 3, 3), 3, 2, byrow = TRUE))
-#library(multcomp)
-#summary(glht(parm(sires2[[2]][[1]], sires2[[2]][[2]]), rhs = 1))
-
-
-## Relative potency of two herbicides
-m2 <- drm(DryMatter~Dose, Herbicide,
-data = S.alba, fct = LL.3())
-
-EDcomp(m2, c(50, 50))
    #> 
-#> Estimated ratios of effect doses
-#> 
-#>                               Estimate  Std. Error     t-value     p-value
-#> Bentazone/Glyphosate:50/50  3.9269e-01  6.6243e-02 -9.1679e+00  3.8347e-13
    EDcomp(m2, c(50, 50), interval = "delta")
    #> 
-#> Estimated ratios of effect doses
-#> 
-#>                            Estimate   Lower   Upper
-#> Bentazone/Glyphosate:50/50  0.39269 0.26028 0.52511
    EDcomp(m2, c(50, 50), interval = "fieller")
    #> 
-#> Estimated ratios of effect doses
-#> 
-#>                            Estimate   Lower   Upper
-#> Bentazone/Glyphosate:50/50  0.39269 0.28175 0.56261
    
-## Comparison based on an absolute
-##  response level
-
-m3 <- drm(SLOPE~DOSE, CURVE,
-data = spinach, fct = LL.4())
-
-EDcomp(m3, c(0.5,0.5), compMatch = c(2,4), type = "absolute", interval = "fieller")
    #> 
-#> Estimated ratios of effect doses
-#> 
-#>             Estimate  Lower  Upper
-#> 2/4:0.5/0.5   2.9057 1.2729 4.7264
    
-EDcomp(m3, c(55,80), compMatch = c(2,4))
    #> 
-#> Estimated ratios of effect doses
-#> 
-#>           Estimate Std. Error  t-value  p-value
-#> 2/4:55/80 2.903797   0.855889 2.224350 0.028775
    # same comparison using a relative response level
-
-
-## Relative potency transformed from log scale
-m4 <- drm(drymatter~log(dose), treatment, data=G.aparine[-c(1:40), ],
-pmodels = data.frame(treatment,treatment,1,treatment), fct = LL2.4())
-
-EDcomp(m4, c(50,50), interval = "fls", logBase = exp(1))
    #> 
-#> Estimated ratios of effect doses
-#> 
-#>           Estimate   Lower   Upper
-#> 1/2:50/50  0.85676 0.77468 0.94755
    
-
    -
    - -
    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    interval
    +

    character string specifying the type of confidence intervals to be supplied. +The default is "none". Use "delta" for asymptotics-based confidence intervals, +"fieller" for confidence intervals based on Fieller's theorem, or "fls" for +confidence intervals back-transformed from logarithm scale.

    + + +
    level
    +

    numeric. The level for the confidence intervals. Default is 0.95.

    + + +
    reference
    +

    character string. Is the upper limit or the control level the reference?

    + + +
    type
    +

    character string specifying whether absolute or relative response levels are supplied.

    + + +
    display
    +

    logical. If TRUE results are displayed. Otherwise they are not (useful in simulations).

    + + +
    pool
    +

    logical. If TRUE curves are pooled. Otherwise they are not. This argument only works +for models with independently fitted curves as specified in drm.

    + + +
    logBase
    +

    numeric. The base of the logarithm in case logarithm transformed dose values are used.

    + + +
    multcomp
    +

    logical to switch on output for use with the package multcomp. Default is FALSE.

    + + +
    ...
    +

    additional arguments passed to the function doing the calculations.

    + +
    +
    +

    Value

    +

    An invisible matrix containing the estimates and the corresponding estimated standard +errors and possibly lower and upper confidence limits. Or, alternatively, a list with elements +that may be plugged directly into parm in the package multcomp (when multcomp +is TRUE).

    +
    +
    +

    Details

    +

    Fieller's theorem is incorporated using the formulas provided by Kotz and Johnson (1983) and +Finney (1978).

    +

    For objects of class 'braincousens' or 'mlogistic' the additional argument may be the 'upper' +argument or the 'interval' argument specifying limits for the bisection method.

    +
    +
    +

    See also

    +

    ED.drc for calculating effective doses.

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    + +
    +

    Examples

    + 
    spinach.LL.4 <- drm(SLOPE~DOSE, CURVE, data = spinach, fct = LL.4())
+
+EDcomp(spinach.LL.4, c(50, 50))
+#> 
+#> Estimated ratios of effect doses
+#> 
+#>             Estimate Std. Error    t-value    p-value
+#> 1/2:50/50  1.8983586  0.7118489  1.2620074  0.2103980
+#> 1/3:50/50  1.3073016  0.5541592  0.5545367  0.5806678
+#> 1/4:50/50  9.0963785  2.4686586  3.2796671  0.0015076
+#> 1/5:50/50  8.5152294  2.3364483  3.2165186  0.0018362
+#> 2/3:50/50  0.6886484  0.2908078 -1.0706439  0.2873603
+#> 2/4:50/50  4.7917071  1.2883525  2.9430664  0.0041886
+#> 2/5:50/50  4.4855747  1.2196032  2.8579579  0.0053607
+#> 3/4:50/50  6.9581332  2.3220591  2.5658835  0.0120448
+#> 3/5:50/50  6.5135923  2.1896041  2.5180773  0.0136744
+#> 4/5:50/50  0.9361120  0.0781402 -0.8176069  0.4158677
+EDcomp(spinach.LL.4, c(10, 50))
+#> 
+#> Estimated ratios of effect doses
+#> 
+#>              Estimate  Std. Error     t-value     p-value
+#> 1/2:10/50  2.7644e-02  1.5249e-02 -6.3765e+01  7.3799e-74
+#> 1/3:10/50  1.9037e-02  1.1155e-02 -8.7939e+01  1.5155e-85
+#> 1/4:10/50  1.3246e-01  6.4530e-02 -1.3444e+01  4.7570e-23
+#> 1/5:10/50  1.2400e-01  6.0615e-02 -1.4452e+01  6.4822e-25
+#> 2/3:10/50  4.4298e-02  3.7850e-02 -2.5250e+01  1.4449e-41
+#> 2/4:10/50  3.0823e-01  2.4349e-01 -2.8411e+00  5.6264e-03
+#> 2/5:10/50  2.8854e-01  2.2823e-01 -3.1173e+00  2.4906e-03
+#> 3/4:10/50  2.7742e-01  1.5001e-01 -4.8170e+00  6.2889e-06
+#> 3/5:10/50  2.5969e-01  1.4081e-01 -5.2573e+00  1.0722e-06
+#> 4/5:10/50  2.8449e-01  3.7366e-02 -1.9148e+01  7.0761e-33
+EDcomp(spinach.LL.4, c(10, 50), reverse = TRUE)
+#> 
+#> Estimated ratios of effect doses
+#> 
+#>             Estimate Std. Error    t-value    p-value
+#> 2/1:50/10 3.6174e+01 1.9955e+01 1.7627e+00 8.1542e-02
+#> 3/1:50/10 5.2530e+01 3.0781e+01 1.6741e+00 9.7792e-02
+#> 4/1:50/10 7.5494e+00 3.6778e+00 1.7808e+00 7.8519e-02
+#> 5/1:50/10 8.0646e+00 3.9423e+00 1.7920e+00 7.6691e-02
+#> 3/2:50/10 2.2575e+01 1.9289e+01 1.1185e+00 2.6650e-01
+#> 4/2:50/10 3.2443e+00 2.5629e+00 8.7570e-01 3.8366e-01
+#> 5/2:50/10 3.4658e+00 2.7414e+00 8.9945e-01 3.7095e-01
+#> 4/3:50/10 3.6047e+00 1.9491e+00 1.3363e+00 1.8501e-01
+#> 5/3:50/10 3.8507e+00 2.0880e+00 1.3653e+00 1.7576e-01
+#> 5/4:50/10 3.5150e+00 4.6168e-01 5.4476e+00 4.8856e-07
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -

    Site built with pkgdown.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -
    + + + + - - - + diff --git a/docs/reference/EDcomp.md b/docs/reference/EDcomp.md new file mode 100644 index 00000000..292d4692 --- /dev/null +++ b/docs/reference/EDcomp.md @@ -0,0 +1,187 @@ +# Comparison of relative potencies between dose-response curves + +Relative potencies (also called selectivity indices) for arbitrary doses +are compared between fitted dose-response curves. + +## Usage + +``` r +EDcomp( + object, + percVec, + percMat = NULL, + compMatch = NULL, + od = FALSE, + vcov. = vcov, + reverse = FALSE, + interval = c("none", "delta", "fieller", "fls"), + level = ifelse(!(interval == "none"), 0.95, NULL), + reference = c("control", "upper"), + type = c("relative", "absolute"), + display = TRUE, + pool = TRUE, + logBase = NULL, + multcomp = FALSE, + ... +) +``` + +## Arguments + +- object: + + an object of class 'drc'. + +- percVec: + + a numeric vector of dosage values. + +- percMat: + + a matrix with 2 columns providing the pairs of indices of `percVec` to + be compared. By default all pairs are compared. + +- compMatch: + + an optional character vector of names of assays to be compared. If not + specified all comparisons are supplied. + +- od: + + logical. If TRUE adjustment for over-dispersion is used. This argument + only makes a difference for binomial data. + +- vcov.: + + function providing the variance-covariance matrix. + [`vcov`](https://rdrr.io/r/stats/vcov.html) is the default, but + `sandwich` is also an option (for obtaining robust standard errors). + +- reverse: + + logical. If TRUE the order of comparison of two curves is reversed. + +- interval: + + character string specifying the type of confidence intervals to be + supplied. The default is `"none"`. Use `"delta"` for asymptotics-based + confidence intervals, `"fieller"` for confidence intervals based on + Fieller's theorem, or `"fls"` for confidence intervals + back-transformed from logarithm scale. + +- level: + + numeric. The level for the confidence intervals. Default is 0.95. + +- reference: + + character string. Is the upper limit or the control level the + reference? + +- type: + + character string specifying whether absolute or relative response + levels are supplied. + +- display: + + logical. If TRUE results are displayed. Otherwise they are not (useful + in simulations). + +- pool: + + logical. If TRUE curves are pooled. Otherwise they are not. This + argument only works for models with independently fitted curves as + specified in + [`drm`](https://hreinwald.github.io/drc/reference/drm.md). + +- logBase: + + numeric. The base of the logarithm in case logarithm transformed dose + values are used. + +- multcomp: + + logical to switch on output for use with the package multcomp. Default + is FALSE. + +- ...: + + additional arguments passed to the function doing the calculations. + +## Value + +An invisible matrix containing the estimates and the corresponding +estimated standard errors and possibly lower and upper confidence +limits. Or, alternatively, a list with elements that may be plugged +directly into `parm` in the package multcomp (when `multcomp` is TRUE). + +## Details + +Fieller's theorem is incorporated using the formulas provided by Kotz +and Johnson (1983) and Finney (1978). + +For objects of class 'braincousens' or 'mlogistic' the additional +argument may be the 'upper' argument or the 'interval' argument +specifying limits for the bisection method. + +## See also + +[`ED.drc`](https://hreinwald.github.io/drc/reference/ED.drc.md) for +calculating effective doses. + +## Author + +Christian Ritz + +## Examples + +``` r +spinach.LL.4 <- drm(SLOPE~DOSE, CURVE, data = spinach, fct = LL.4()) + +EDcomp(spinach.LL.4, c(50, 50)) +#> +#> Estimated ratios of effect doses +#> +#> Estimate Std. Error t-value p-value +#> 1/2:50/50 1.8983586 0.7118489 1.2620074 0.2103980 +#> 1/3:50/50 1.3073016 0.5541592 0.5545367 0.5806678 +#> 1/4:50/50 9.0963785 2.4686586 3.2796671 0.0015076 +#> 1/5:50/50 8.5152294 2.3364483 3.2165186 0.0018362 +#> 2/3:50/50 0.6886484 0.2908078 -1.0706439 0.2873603 +#> 2/4:50/50 4.7917071 1.2883525 2.9430664 0.0041886 +#> 2/5:50/50 4.4855747 1.2196032 2.8579579 0.0053607 +#> 3/4:50/50 6.9581332 2.3220591 2.5658835 0.0120448 +#> 3/5:50/50 6.5135923 2.1896041 2.5180773 0.0136744 +#> 4/5:50/50 0.9361120 0.0781402 -0.8176069 0.4158677 +EDcomp(spinach.LL.4, c(10, 50)) +#> +#> Estimated ratios of effect doses +#> +#> Estimate Std. Error t-value p-value +#> 1/2:10/50 2.7644e-02 1.5249e-02 -6.3765e+01 7.3799e-74 +#> 1/3:10/50 1.9037e-02 1.1155e-02 -8.7939e+01 1.5155e-85 +#> 1/4:10/50 1.3246e-01 6.4530e-02 -1.3444e+01 4.7570e-23 +#> 1/5:10/50 1.2400e-01 6.0615e-02 -1.4452e+01 6.4822e-25 +#> 2/3:10/50 4.4298e-02 3.7850e-02 -2.5250e+01 1.4449e-41 +#> 2/4:10/50 3.0823e-01 2.4349e-01 -2.8411e+00 5.6264e-03 +#> 2/5:10/50 2.8854e-01 2.2823e-01 -3.1173e+00 2.4906e-03 +#> 3/4:10/50 2.7742e-01 1.5001e-01 -4.8170e+00 6.2889e-06 +#> 3/5:10/50 2.5969e-01 1.4081e-01 -5.2573e+00 1.0722e-06 +#> 4/5:10/50 2.8449e-01 3.7366e-02 -1.9148e+01 7.0761e-33 +EDcomp(spinach.LL.4, c(10, 50), reverse = TRUE) +#> +#> Estimated ratios of effect doses +#> +#> Estimate Std. Error t-value p-value +#> 2/1:50/10 3.6174e+01 1.9955e+01 1.7627e+00 8.1542e-02 +#> 3/1:50/10 5.2530e+01 3.0781e+01 1.6741e+00 9.7792e-02 +#> 4/1:50/10 7.5494e+00 3.6778e+00 1.7808e+00 7.8519e-02 +#> 5/1:50/10 8.0646e+00 3.9423e+00 1.7920e+00 7.6691e-02 +#> 3/2:50/10 2.2575e+01 1.9289e+01 1.1185e+00 2.6650e-01 +#> 4/2:50/10 3.2443e+00 2.5629e+00 8.7570e-01 3.8366e-01 +#> 5/2:50/10 3.4658e+00 2.7414e+00 8.9945e-01 3.7095e-01 +#> 4/3:50/10 3.6047e+00 1.9491e+00 1.3363e+00 1.8501e-01 +#> 5/3:50/10 3.8507e+00 2.0880e+00 1.3653e+00 1.7576e-01 +#> 5/4:50/10 3.5150e+00 4.6168e-01 5.4476e+00 4.8856e-07 +``` diff --git a/docs/reference/EDhelper.html b/docs/reference/EDhelper.html new file mode 100644 index 00000000..9ad5dbd6 --- /dev/null +++ b/docs/reference/EDhelper.html @@ -0,0 +1,70 @@ + +Helper function for ED calculations — EDhelper • drc + Skip to contents + + +
    +
    +
    +

    Helper function for ED calculations

    + Source: R/EDhelper.R +
    EDhelper.Rd
    +
    + +
    +

    Helper function for ED calculations

    +
    + +
    +

    Usage

    + 
    EDhelper(parmVec, respl, reference, typeCalc, cond = TRUE)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/EDhelper.md b/docs/reference/EDhelper.md new file mode 100644 index 00000000..757145ad --- /dev/null +++ b/docs/reference/EDhelper.md @@ -0,0 +1,9 @@ +# Helper function for ED calculations + +Helper function for ED calculations + +## Usage + +``` r +EDhelper(parmVec, respl, reference, typeCalc, cond = TRUE) +``` diff --git a/docs/reference/EDinvreg.html b/docs/reference/EDinvreg.html new file mode 100644 index 00000000..abb62aff --- /dev/null +++ b/docs/reference/EDinvreg.html @@ -0,0 +1,78 @@ + +Inverse regression for ED estimation — EDinvreg • drc + Skip to contents + + +
    +
    +
    +

    Inverse regression for ED estimation

    + Source: R/EDinvreg.R +
    EDinvreg.Rd
    +
    + +
    +

    Inverse regression for ED estimation

    +
    + +
    +

    Usage

    + 
    EDinvreg(
+  object,
+  respLev,
+  catLev = NA,
+  intType = "confidence",
+  level,
+  type,
+  extFactor = 10
+)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/EDinvreg.md b/docs/reference/EDinvreg.md new file mode 100644 index 00000000..65358d8f --- /dev/null +++ b/docs/reference/EDinvreg.md @@ -0,0 +1,17 @@ +# Inverse regression for ED estimation + +Inverse regression for ED estimation + +## Usage + +``` r +EDinvreg( + object, + respLev, + catLev = NA, + intType = "confidence", + level, + type, + extFactor = 10 +) +``` diff --git a/docs/reference/EXD-1.png b/docs/reference/EXD-1.png deleted file mode 100644 index 265a8105..00000000 Binary files a/docs/reference/EXD-1.png and /dev/null differ diff --git a/docs/reference/EXD.2.html b/docs/reference/EXD.2.html new file mode 100644 index 00000000..bbd76ccd --- /dev/null +++ b/docs/reference/EXD.2.html @@ -0,0 +1,125 @@ + +Two-parameter exponential decay model — EXD.2 • drc + Skip to contents + + +
    +
    +
    +

    Two-parameter exponential decay model

    + Source: R/weibull1.R +
    EXD.2.Rd
    +
    + +
    +

    A two-parameter exponential decay model with the slope parameter b +fixed at 1 and the lower limit fixed at 0.

    +
    + +
    +

    Usage

    + 
    EXD.2(fixed = c(NA, NA), names = c("d", "e"), ...)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector of length 2. Specifies which parameters are +fixed and at what value. Use NA for parameters that are not fixed.

    + + +
    names
    +

    character vector of length 2 giving the names of the +parameters. The default is c("d", "e").

    + + +
    ...
    +

    additional arguments passed to weibull1, most +notably method (a character string: "1" (default), +"2", "3", or "4") which selects the self-starter +method for obtaining starting values. See weibull1 for +details.

    + +
    +
    +

    Value

    +

    A list of class Weibull-1 containing the nonlinear function, +self starter function, and parameter names.

    +
    +
    +

    Details

    +

    The model is given by the expression +$$f(x) = d \exp(-x/e)$$

    +

    This is a special case of the Weibull type 1 model +(weibull1) with the slope fixed at 1 and the lower limit +fixed at 0.

    +
    +
    +

    References

    +

    Seber, G. A. F. and Wild, C. J. (1989) +Nonlinear Regression, New York: Wiley & Sons (pp. 338–339).

    +
    +
    +

    See also

    +

    EXD.3, AR.2, AR.3, +weibull1

    +
    + +
    +

    Examples

    + 
    ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = EXD.2())
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/EXD.2.md b/docs/reference/EXD.2.md new file mode 100644 index 00000000..8cb3c552 --- /dev/null +++ b/docs/reference/EXD.2.md @@ -0,0 +1,63 @@ +# Two-parameter exponential decay model + +A two-parameter exponential decay model with the slope parameter `b` +fixed at 1 and the lower limit fixed at 0. + +## Usage + +``` r +EXD.2(fixed = c(NA, NA), names = c("d", "e"), ...) +``` + +## Arguments + +- fixed: + + numeric vector of length 2. Specifies which parameters are fixed and + at what value. Use `NA` for parameters that are not fixed. + +- names: + + character vector of length 2 giving the names of the parameters. The + default is `c("d", "e")`. + +- ...: + + additional arguments passed to + [`weibull1`](https://hreinwald.github.io/drc/reference/weibull1.md), + most notably `method` (a character string: `"1"` (default), `"2"`, + `"3"`, or `"4"`) which selects the self-starter method for obtaining + starting values. See + [`weibull1`](https://hreinwald.github.io/drc/reference/weibull1.md) + for details. + +## Value + +A list of class `Weibull-1` containing the nonlinear function, self +starter function, and parameter names. + +## Details + +The model is given by the expression \$\$f(x) = d \exp(-x/e)\$\$ + +This is a special case of the Weibull type 1 model +([`weibull1`](https://hreinwald.github.io/drc/reference/weibull1.md)) +with the slope fixed at 1 and the lower limit fixed at 0. + +## References + +Seber, G. A. F. and Wild, C. J. (1989) *Nonlinear Regression*, New York: +Wiley & Sons (pp. 338–339). + +## See also + +[`EXD.3`](https://hreinwald.github.io/drc/reference/EXD.3.md), +[`AR.2`](https://hreinwald.github.io/drc/reference/AR.2.md), +[`AR.3`](https://hreinwald.github.io/drc/reference/AR.3.md), +[`weibull1`](https://hreinwald.github.io/drc/reference/weibull1.md) + +## Examples + +``` r +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = EXD.2()) +``` diff --git a/docs/reference/EXD.3.html b/docs/reference/EXD.3.html new file mode 100644 index 00000000..c8778671 --- /dev/null +++ b/docs/reference/EXD.3.html @@ -0,0 +1,124 @@ + +Three-parameter exponential decay model — EXD.3 • drc + Skip to contents + + +
    +
    +
    +

    Three-parameter exponential decay model

    + Source: R/weibull1.R +
    EXD.3.Rd
    +
    + +
    +

    A three-parameter exponential decay model with the slope parameter b +fixed at 1.

    +
    + +
    +

    Usage

    + 
    EXD.3(fixed = c(NA, NA, NA), names = c("c", "d", "e"), ...)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector of length 3. Specifies which parameters are +fixed and at what value. Use NA for parameters that are not fixed.

    + + +
    names
    +

    character vector of length 3 giving the names of the +parameters. The default is c("c", "d", "e").

    + + +
    ...
    +

    additional arguments passed to weibull1, most +notably method (a character string: "1" (default), +"2", "3", or "4") which selects the self-starter +method for obtaining starting values. See weibull1 for +details.

    + +
    +
    +

    Value

    +

    A list of class Weibull-1 containing the nonlinear function, +self starter function, and parameter names.

    +
    +
    +

    Details

    +

    The model is given by the expression +$$f(x) = c + (d - c) \exp(-x/e)$$

    +

    This is a special case of the Weibull type 1 model +(weibull1) with the slope fixed at 1.

    +
    +
    +

    References

    +

    Seber, G. A. F. and Wild, C. J. (1989) +Nonlinear Regression, New York: Wiley & Sons (pp. 338–339).

    +
    +
    +

    See also

    +

    EXD.2, AR.2, AR.3, +weibull1

    +
    + +
    +

    Examples

    + 
    ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = EXD.3())
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/EXD.3.md b/docs/reference/EXD.3.md new file mode 100644 index 00000000..be299e3f --- /dev/null +++ b/docs/reference/EXD.3.md @@ -0,0 +1,64 @@ +# Three-parameter exponential decay model + +A three-parameter exponential decay model with the slope parameter `b` +fixed at 1. + +## Usage + +``` r +EXD.3(fixed = c(NA, NA, NA), names = c("c", "d", "e"), ...) +``` + +## Arguments + +- fixed: + + numeric vector of length 3. Specifies which parameters are fixed and + at what value. Use `NA` for parameters that are not fixed. + +- names: + + character vector of length 3 giving the names of the parameters. The + default is `c("c", "d", "e")`. + +- ...: + + additional arguments passed to + [`weibull1`](https://hreinwald.github.io/drc/reference/weibull1.md), + most notably `method` (a character string: `"1"` (default), `"2"`, + `"3"`, or `"4"`) which selects the self-starter method for obtaining + starting values. See + [`weibull1`](https://hreinwald.github.io/drc/reference/weibull1.md) + for details. + +## Value + +A list of class `Weibull-1` containing the nonlinear function, self +starter function, and parameter names. + +## Details + +The model is given by the expression \$\$f(x) = c + (d - c) +\exp(-x/e)\$\$ + +This is a special case of the Weibull type 1 model +([`weibull1`](https://hreinwald.github.io/drc/reference/weibull1.md)) +with the slope fixed at 1. + +## References + +Seber, G. A. F. and Wild, C. J. (1989) *Nonlinear Regression*, New York: +Wiley & Sons (pp. 338–339). + +## See also + +[`EXD.2`](https://hreinwald.github.io/drc/reference/EXD.2.md), +[`AR.2`](https://hreinwald.github.io/drc/reference/AR.2.md), +[`AR.3`](https://hreinwald.github.io/drc/reference/AR.3.md), +[`weibull1`](https://hreinwald.github.io/drc/reference/weibull1.md) + +## Examples + +``` r +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = EXD.3()) +``` diff --git a/docs/reference/EXD.html b/docs/reference/EXD.html deleted file mode 100644 index b10a474d..00000000 --- a/docs/reference/EXD.html +++ /dev/null @@ -1,213 +0,0 @@ - - - - - - - - -Exponential decay model — EXD • drc - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    -
    - - - -
    - -
    -
    -
    -

    Exponential decay model

    - - -
    - -
    - -

    Exponential decay model with or without a nonzero lower limit.

    - -
    - - 
    EXD.2(fixed = c(NA, NA), names = c("d", "e"), ...)
-
-  EXD.3(fixed = c(NA, NA, NA), names = c("c", "d", "e"), ...)
    - -

    Arguments

    - - - - - - - - - - - - - - -
    fixed

    numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.

    names

    vector of character strings giving the names of the parameters (should not contain ":"). - The default parameter names are: init, plateau, k.

    ...

    additional arguments to be passed from the convenience functions.

    - -

    Details

    - -

    The exponential decay model is a three-parameter model with mean function:

    -

    $$f(x) = c + (d-c)(\exp(-x/e))$$

    -

    The parameter init is the upper limit (attained at \(x=0\)), the parameter plateau is the lower limit - reached for x going to infinity and the parameter \(e>0\) is determining the steepness of the - decay. The curve is monotonously decreasing in \(x\).

    - -

    Value

    - -

    A list of class drcMean, containing the mean function, the self starter function, - the parameter names and other components such as derivatives and a function for calculating ED values.

    - -

    References

    - -

    Organisation for Economic Co-operation and Development (OECD) (2006) - Current approaches in the statistical analysis of ecotoxicity data: A guidance to application - annexes, - Paris: OECD (p. 80).

    - -

    See also

    - -

    Similar models giving exponential increasing curves are AR.2 and AR.3.

    - - -

    Examples

    - 
    
-## Fitting an exponential decay model
-ryegrass.m1<-drm(rootl~conc, data=ryegrass, fct=EXD.3())
-
-plot(ryegrass.m1)
    
-summary(ryegrass.m1)
    #> 
-#> Model fitted: Shifted exponential decay (3 parms)
-#> 
-#> Parameter estimates:
-#> 
-#>               Estimate Std. Error t-value   p-value    
-#> c:(Intercept)  0.12945    0.36866  0.3511     0.729    
-#> d:(Intercept)  8.23936    0.30335 27.1613 < 2.2e-16 ***
-#> e:(Intercept)  4.53797    0.63886  7.1032 5.243e-07 ***
-#> ---
-#> Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
-#> 
-#> Residual standard error:
-#> 
-#>  0.8384585 (21 degrees of freedom)
    
-
    -
    - -
    - -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    -
    - -
    -

    Site built with pkgdown.

    -
    - -
    -
    - - - - - - diff --git a/docs/reference/Eryngium.sparganophyllum-1.png b/docs/reference/Eryngium.sparganophyllum-1.png new file mode 100644 index 00000000..b8eb5ade Binary files /dev/null and b/docs/reference/Eryngium.sparganophyllum-1.png differ diff --git a/docs/reference/Eryngium.sparganophyllum.html b/docs/reference/Eryngium.sparganophyllum.html new file mode 100644 index 00000000..6ed20fb8 --- /dev/null +++ b/docs/reference/Eryngium.sparganophyllum.html @@ -0,0 +1,143 @@ + +Germination of Eryngium sparganophyllum — Eryngium.sparganophyllum • drc + Skip to contents + + +
    +
    +
    +

    Germination of Eryngium sparganophyllum

    + +
    Eryngium.sparganophyllum.Rd
    +
    + +
    +

    Germination data from an experiments investigating the effect of different concentration of gibberellic acid on germination of Eryngium sparganophyllum seeds. Two datasets are provided: one resembling how data are entered in the first place ("Eryngium.sparganophyllum0") and one formatted and ready-to-use for the statistical analysis ("Eryngium.sparganophyllum")

    +
    + +
    +

    Usage

    + 
    Eryngium.sparganophyllum
    +
    + +
    +

    Format

    +

    A data frame with 583 observations on the following variables.

    Treat
    +

    a factor with 15 levels denoting the concentration of gibberellic acid (in ppm)

    + +
    Type
    +

    a factor with two levels denoting the type of treatment (gibberellic acid or temperature)

    + +
    Day
    +

    a numeric vector recording time (in days) since the beginning of the experiment

    + +
    Germ
    +

    a numeric vector of counts of germinated seeds

    + +
    Start
    +

    a numeric vector of starting time points of monitoring intervals

    + +
    End
    +

    a numeric vector of ending time points of monitoring intervals

    + +
    Germinated
    +

    a numeric vector of counts of germinated seeds in a given interval

    + +
    Rep
    +

    a numeric vector corresponding to the replicated sub-experiments; it is only a unique enumeration for the dataset "Eryngium.sparganophyllum"

    + + +
    +
    +

    References

    +

    Wolkis, D., Blackwell, S., Kaninaualiʻi Villanueva, S. (2020). Conservation seed physiology of the ciénega endemic, Eryngium sparganophyllum (Apiaceae). Conservation Physiology, 8, coaa017. https://doi.org/10.1093/conphys/coaa017

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Displaying the data
+head(Eryngium.sparganophyllum)
+#>   Day Treat Type         Rep Start End Germinated
+#> 1   2 GA3.0  GA3 GA3.GA3-0.1     0   2          0
+#> 2   2 GA3.0  GA3 GA3.GA3-0.1     2   4          0
+#> 3   4 GA3.0  GA3 GA3.GA3-0.1     4   7          0
+#> 4   7 GA3.0  GA3 GA3.GA3-0.1     7   9          1
+#> 5   9 GA3.0  GA3 GA3.GA3-0.1     9  11          1
+#> 6  11 GA3.0  GA3 GA3.GA3-0.1    11  14          0
+
+## Fitting an event-time model for germination
+Eryngium.m1 <- drm(Germinated ~ Start + End, data = Eryngium.sparganophyllum,
+fct = LL.3(), type = "event")
+#> Warning: longer object length is not a multiple of shorter object length
+#> Warning: longer object length is not a multiple of shorter object length
+#> Warning: data length [1166] is not a sub-multiple or multiple of the number of rows [14]
+#> Warning: longer object length is not a multiple of shorter object length
+#> Warning: longer object length is not a multiple of shorter object length
+summary(Eryngium.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                Estimate Std. Error t-value   p-value    
+#> b:(Intercept) -2.715614   0.126975 -21.387 < 2.2e-16 ***
+#> d:(Intercept)  0.663221   0.018812  35.254 < 2.2e-16 ***
+#> e:(Intercept)  6.698683   0.215910  31.025 < 2.2e-16 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+## Plotting the fitted germination curve
+plot(Eryngium.m1, xlab = "Time (days)", ylab = "Proportion germinated", log = "")
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/Eryngium.sparganophyllum.md b/docs/reference/Eryngium.sparganophyllum.md new file mode 100644 index 00000000..9d9e9059 --- /dev/null +++ b/docs/reference/Eryngium.sparganophyllum.md @@ -0,0 +1,102 @@ +# Germination of Eryngium sparganophyllum + +Germination data from an experiments investigating the effect of +different concentration of gibberellic acid on germination of Eryngium +sparganophyllum seeds. Two datasets are provided: one resembling how +data are entered in the first place ("Eryngium.sparganophyllum0") and +one formatted and ready-to-use for the statistical analysis +("Eryngium.sparganophyllum") + +## Usage + +``` r +Eryngium.sparganophyllum +``` + +## Format + +A data frame with 583 observations on the following variables. + +- `Treat`: + + a factor with 15 levels denoting the concentration of gibberellic acid + (in ppm) + +- `Type`: + + a factor with two levels denoting the type of treatment (gibberellic + acid or temperature) + +- `Day`: + + a numeric vector recording time (in days) since the beginning of the + experiment + +- `Germ`: + + a numeric vector of counts of germinated seeds + +- `Start`: + + a numeric vector of starting time points of monitoring intervals + +- `End`: + + a numeric vector of ending time points of monitoring intervals + +- `Germinated`: + + a numeric vector of counts of germinated seeds in a given interval + +- `Rep`: + + a numeric vector corresponding to the replicated sub-experiments; it + is only a unique enumeration for the dataset + "Eryngium.sparganophyllum" + +## References + +Wolkis, D., Blackwell, S., Kaninaualiʻi Villanueva, S. (2020). +Conservation seed physiology of the ciénega endemic, Eryngium +sparganophyllum (Apiaceae). Conservation Physiology, 8, coaa017. +https://doi.org/10.1093/conphys/coaa017 + +## Examples + +``` r +library(drc) + +## Displaying the data +head(Eryngium.sparganophyllum) +#> Day Treat Type Rep Start End Germinated +#> 1 2 GA3.0 GA3 GA3.GA3-0.1 0 2 0 +#> 2 2 GA3.0 GA3 GA3.GA3-0.1 2 4 0 +#> 3 4 GA3.0 GA3 GA3.GA3-0.1 4 7 0 +#> 4 7 GA3.0 GA3 GA3.GA3-0.1 7 9 1 +#> 5 9 GA3.0 GA3 GA3.GA3-0.1 9 11 1 +#> 6 11 GA3.0 GA3 GA3.GA3-0.1 11 14 0 + +## Fitting an event-time model for germination +Eryngium.m1 <- drm(Germinated ~ Start + End, data = Eryngium.sparganophyllum, +fct = LL.3(), type = "event") +#> Warning: longer object length is not a multiple of shorter object length +#> Warning: longer object length is not a multiple of shorter object length +#> Warning: data length [1166] is not a sub-multiple or multiple of the number of rows [14] +#> Warning: longer object length is not a multiple of shorter object length +#> Warning: longer object length is not a multiple of shorter object length +summary(Eryngium.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) -2.715614 0.126975 -21.387 < 2.2e-16 *** +#> d:(Intercept) 0.663221 0.018812 35.254 < 2.2e-16 *** +#> e:(Intercept) 6.698683 0.215910 31.025 < 2.2e-16 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 + +## Plotting the fitted germination curve +plot(Eryngium.m1, xlab = "Time (days)", ylab = "Proportion germinated", log = "") +``` diff --git a/docs/reference/Eryngium.sparganophyllum0.html b/docs/reference/Eryngium.sparganophyllum0.html new file mode 100644 index 00000000..4e5a62f4 --- /dev/null +++ b/docs/reference/Eryngium.sparganophyllum0.html @@ -0,0 +1,8 @@ + + + + + + + + diff --git a/docs/reference/FPL.4.html b/docs/reference/FPL.4.html new file mode 100644 index 00000000..6c09a3fc --- /dev/null +++ b/docs/reference/FPL.4.html @@ -0,0 +1,103 @@ + +Four-parameter fractional polynomial-logistic model — FPL.4 • drc + Skip to contents + + +
    +
    +
    +

    Four-parameter fractional polynomial-logistic model

    + Source: R/fplogistic.R +
    FPL.4.Rd
    +
    + +
    +

    Convenience function for the four-parameter fractional polynomial-logistic model.

    +
    + +
    +

    Usage

    + 
    FPL.4(p1, p2, fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...)
    +
    + +
    +

    Arguments

    + + +
    p1
    +

    numeric denoting the negative power of log(dose+1) in the fractional polynomial.

    + + +
    p2
    +

    numeric denoting the positive power of log(dose+1) in the fractional polynomial.

    + + +
    fixed
    +

    numeric vector of length 4 specifying fixed parameters (NAs for free parameters).

    + + +
    names
    +

    character vector of parameter names.

    + + +
    ...
    +

    additional arguments passed to fplogistic.

    + +
    +
    +

    Value

    +

    A list (see fplogistic).

    +
    +
    +

    See also

    +

    fplogistic, maED

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/FPL.4.md b/docs/reference/FPL.4.md new file mode 100644 index 00000000..371e7c89 --- /dev/null +++ b/docs/reference/FPL.4.md @@ -0,0 +1,46 @@ +# Four-parameter fractional polynomial-logistic model + +Convenience function for the four-parameter fractional +polynomial-logistic model. + +## Usage + +``` r +FPL.4(p1, p2, fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) +``` + +## Arguments + +- p1: + + numeric denoting the negative power of log(dose+1) in the fractional + polynomial. + +- p2: + + numeric denoting the positive power of log(dose+1) in the fractional + polynomial. + +- fixed: + + numeric vector of length 4 specifying fixed parameters (NAs for free + parameters). + +- names: + + character vector of parameter names. + +- ...: + + additional arguments passed to + [`fplogistic`](https://hreinwald.github.io/drc/reference/fplogistic.md). + +## Value + +A list (see +[`fplogistic`](https://hreinwald.github.io/drc/reference/fplogistic.md)). + +## See also + +[`fplogistic`](https://hreinwald.github.io/drc/reference/fplogistic.md), +[`maED`](https://hreinwald.github.io/drc/reference/maED.md) diff --git a/docs/reference/G.2.html b/docs/reference/G.2.html new file mode 100644 index 00000000..248c3a50 --- /dev/null +++ b/docs/reference/G.2.html @@ -0,0 +1,99 @@ + +Two-parameter Gompertz model — G.2 • drc + Skip to contents + + +
    +
    +
    +

    Two-parameter Gompertz model

    + Source: R/gompertz.R +
    G.2.Rd
    +
    + +
    +

    Convenience function for the Gompertz model with lower limit fixed at 0 and upper limit fixed.

    +
    + +
    +

    Usage

    + 
    G.2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...)
    +
    + +
    +

    Arguments

    + + +
    upper
    +

    numeric specifying the fixed upper horizontal asymptote. Default is 1.

    + + +
    fixed
    +

    numeric vector of length 2 specifying fixed parameters (NAs for free parameters).

    + + +
    names
    +

    character vector of parameter names.

    + + +
    ...
    +

    additional arguments passed to gompertz.

    + +
    +
    +

    Value

    +

    A list (see gompertz).

    +
    +
    +

    See also

    +

    gompertz, G.3, G.4

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/G.2.md b/docs/reference/G.2.md new file mode 100644 index 00000000..a293e4e9 --- /dev/null +++ b/docs/reference/G.2.md @@ -0,0 +1,41 @@ +# Two-parameter Gompertz model + +Convenience function for the Gompertz model with lower limit fixed at 0 +and upper limit fixed. + +## Usage + +``` r +G.2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) +``` + +## Arguments + +- upper: + + numeric specifying the fixed upper horizontal asymptote. Default is 1. + +- fixed: + + numeric vector of length 2 specifying fixed parameters (NAs for free + parameters). + +- names: + + character vector of parameter names. + +- ...: + + additional arguments passed to + [`gompertz`](https://hreinwald.github.io/drc/reference/gompertz.md). + +## Value + +A list (see +[`gompertz`](https://hreinwald.github.io/drc/reference/gompertz.md)). + +## See also + +[`gompertz`](https://hreinwald.github.io/drc/reference/gompertz.md), +[`G.3`](https://hreinwald.github.io/drc/reference/G.3.md), +[`G.4`](https://hreinwald.github.io/drc/reference/G.4.md) diff --git a/docs/reference/G.3.html b/docs/reference/G.3.html new file mode 100644 index 00000000..1e6ea184 --- /dev/null +++ b/docs/reference/G.3.html @@ -0,0 +1,95 @@ + +Three-parameter Gompertz model — G.3 • drc + Skip to contents + + +
    +
    +
    +

    Three-parameter Gompertz model

    + Source: R/gompertz.R +
    G.3.Rd
    +
    + +
    +

    Convenience function for the Gompertz model with the lower limit fixed at 0.

    +
    + +
    +

    Usage

    + 
    G.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector of length 3 specifying fixed parameters (NAs for free parameters).

    + + +
    names
    +

    character vector of parameter names.

    + + +
    ...
    +

    additional arguments passed to gompertz.

    + +
    +
    +

    Value

    +

    A list (see gompertz).

    +
    +
    +

    See also

    +

    gompertz, G.2, G.4

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/G.3.md b/docs/reference/G.3.md new file mode 100644 index 00000000..b293837a --- /dev/null +++ b/docs/reference/G.3.md @@ -0,0 +1,37 @@ +# Three-parameter Gompertz model + +Convenience function for the Gompertz model with the lower limit fixed +at 0. + +## Usage + +``` r +G.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) +``` + +## Arguments + +- fixed: + + numeric vector of length 3 specifying fixed parameters (NAs for free + parameters). + +- names: + + character vector of parameter names. + +- ...: + + additional arguments passed to + [`gompertz`](https://hreinwald.github.io/drc/reference/gompertz.md). + +## Value + +A list (see +[`gompertz`](https://hreinwald.github.io/drc/reference/gompertz.md)). + +## See also + +[`gompertz`](https://hreinwald.github.io/drc/reference/gompertz.md), +[`G.2`](https://hreinwald.github.io/drc/reference/G.2.md), +[`G.4`](https://hreinwald.github.io/drc/reference/G.4.md) diff --git a/docs/reference/G.3u.html b/docs/reference/G.3u.html new file mode 100644 index 00000000..2fefcd25 --- /dev/null +++ b/docs/reference/G.3u.html @@ -0,0 +1,99 @@ + +Three-parameter Gompertz model with upper limit fixed — G.3u • drc + Skip to contents + + +
    +
    +
    +

    Three-parameter Gompertz model with upper limit fixed

    + Source: R/gompertz.R +
    G.3u.Rd
    +
    + +
    +

    Convenience function for the Gompertz model with the upper limit fixed.

    +
    + +
    +

    Usage

    + 
    G.3u(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...)
    +
    + +
    +

    Arguments

    + + +
    upper
    +

    numeric specifying the fixed upper horizontal asymptote. Default is 1.

    + + +
    fixed
    +

    numeric vector of length 3 specifying fixed parameters (NAs for free parameters).

    + + +
    names
    +

    character vector of parameter names.

    + + +
    ...
    +

    additional arguments passed to gompertz.

    + +
    +
    +

    Value

    +

    A list (see gompertz).

    +
    +
    +

    See also

    +

    gompertz, G.2, G.3, G.4

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/G.3u.md b/docs/reference/G.3u.md new file mode 100644 index 00000000..3e39ec21 --- /dev/null +++ b/docs/reference/G.3u.md @@ -0,0 +1,41 @@ +# Three-parameter Gompertz model with upper limit fixed + +Convenience function for the Gompertz model with the upper limit fixed. + +## Usage + +``` r +G.3u(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...) +``` + +## Arguments + +- upper: + + numeric specifying the fixed upper horizontal asymptote. Default is 1. + +- fixed: + + numeric vector of length 3 specifying fixed parameters (NAs for free + parameters). + +- names: + + character vector of parameter names. + +- ...: + + additional arguments passed to + [`gompertz`](https://hreinwald.github.io/drc/reference/gompertz.md). + +## Value + +A list (see +[`gompertz`](https://hreinwald.github.io/drc/reference/gompertz.md)). + +## See also + +[`gompertz`](https://hreinwald.github.io/drc/reference/gompertz.md), +[`G.2`](https://hreinwald.github.io/drc/reference/G.2.md), +[`G.3`](https://hreinwald.github.io/drc/reference/G.3.md), +[`G.4`](https://hreinwald.github.io/drc/reference/G.4.md) diff --git a/docs/reference/G.4.html b/docs/reference/G.4.html new file mode 100644 index 00000000..ae25d304 --- /dev/null +++ b/docs/reference/G.4.html @@ -0,0 +1,95 @@ + +Four-parameter Gompertz model — G.4 • drc + Skip to contents + + +
    +
    +
    +

    Four-parameter Gompertz model

    + Source: R/gompertz.R +
    G.4.Rd
    +
    + +
    +

    Convenience function for the full four-parameter Gompertz model.

    +
    + +
    +

    Usage

    + 
    G.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector of length 4 specifying fixed parameters (NAs for free parameters).

    + + +
    names
    +

    character vector of parameter names.

    + + +
    ...
    +

    additional arguments passed to gompertz.

    + +
    +
    +

    Value

    +

    A list (see gompertz).

    +
    +
    +

    See also

    +

    gompertz, G.2, G.3

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/G.4.md b/docs/reference/G.4.md new file mode 100644 index 00000000..7f079bc7 --- /dev/null +++ b/docs/reference/G.4.md @@ -0,0 +1,36 @@ +# Four-parameter Gompertz model + +Convenience function for the full four-parameter Gompertz model. + +## Usage + +``` r +G.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) +``` + +## Arguments + +- fixed: + + numeric vector of length 4 specifying fixed parameters (NAs for free + parameters). + +- names: + + character vector of parameter names. + +- ...: + + additional arguments passed to + [`gompertz`](https://hreinwald.github.io/drc/reference/gompertz.md). + +## Value + +A list (see +[`gompertz`](https://hreinwald.github.io/drc/reference/gompertz.md)). + +## See also + +[`gompertz`](https://hreinwald.github.io/drc/reference/gompertz.md), +[`G.2`](https://hreinwald.github.io/drc/reference/G.2.md), +[`G.3`](https://hreinwald.github.io/drc/reference/G.3.md) diff --git a/docs/reference/G.aparine-1.png b/docs/reference/G.aparine-1.png new file mode 100644 index 00000000..ad3eb623 Binary files /dev/null and b/docs/reference/G.aparine-1.png differ diff --git a/docs/reference/G.aparine-2.png b/docs/reference/G.aparine-2.png new file mode 100644 index 00000000..7f6dda26 Binary files /dev/null and b/docs/reference/G.aparine-2.png differ diff --git a/docs/reference/G.aparine-3.png b/docs/reference/G.aparine-3.png new file mode 100644 index 00000000..9033cec6 Binary files /dev/null and b/docs/reference/G.aparine-3.png differ diff --git a/docs/reference/G.aparine-4.png b/docs/reference/G.aparine-4.png new file mode 100644 index 00000000..613b4e8f Binary files /dev/null and b/docs/reference/G.aparine-4.png differ diff --git a/docs/reference/G.aparine-5.png b/docs/reference/G.aparine-5.png new file mode 100644 index 00000000..8076494e Binary files /dev/null and b/docs/reference/G.aparine-5.png differ diff --git a/docs/reference/G.aparine.html b/docs/reference/G.aparine.html new file mode 100644 index 00000000..9b6df690 --- /dev/null +++ b/docs/reference/G.aparine.html @@ -0,0 +1,200 @@ + +Herbicide applied to Galium aparine — G.aparine • drc + Skip to contents + + +
    +
    +
    +

    Herbicide applied to Galium aparine

    + +
    G.aparine.Rd
    +
    + +
    +

    Small plants of Galium aparine, growing in pots in a green house, were sprayed with the technical + grade phenmidipham herbicide either alone or in mixture with an ester of oleic acid. + The plants were allowed to grow in the green house for 14 days after herbicide treatment. + Then the dry matter was measured per pot.

    +
    + +
    +

    Usage

    + 
    data(G.aparine)
    +
    + +
    +

    Format

    +

    A data frame with 240 observations on the following 3 variables.

    dose
    +

    a numeric vector of dose value (g/ha)

    + +
    drymatter
    +

    a numeric vector of dry matter weights (mg/pot)

    + +
    treatment
    +

    a numeric vector giving the grouping: 0: control, 1,2: herbicide formulations

    + + +
    +
    +

    Source

    +

    Cabanne, F., Gaudry, J. C. and Streibig, J. C. (1999) Influence of alkyl oleates on efficacy + of phenmedipham applied as an acetone:water solution on Galium aparine, + Weed Research, 39, 57–67.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Fitting a model with a common control (so a single upper limit: "1")
+G.aparine.m1 <- drm(drymatter ~ dose, treatment, data = G.aparine, 
+pmodels = data.frame(treatment, treatment, 1, treatment), fct = LL.4())
+
+## Visual inspection of fit
+plot(G.aparine.m1, broken = TRUE)
+
+
+## Lack of fit test
+modelFit(G.aparine.m1)
+#> Lack-of-fit test
+#> 
+#>           ModelDf     RSS Df F value p value
+#> ANOVA         219 2601788                   
+#> DRC model     233 2891677 14  1.7429  0.0490
+
+## Summary output
+summary(G.aparine.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                Estimate Std. Error t-value   p-value    
+#> b:1             1.61291    0.33330  4.8392 2.372e-06 ***
+#> b:2             1.75100    0.20392  8.5869 1.311e-15 ***
+#> c:1           509.50367   23.25885 21.9058 < 2.2e-16 ***
+#> c:2           151.91840   26.00899  5.8410 1.734e-08 ***
+#> d:(Intercept) 984.88779   12.63335 77.9594 < 2.2e-16 ***
+#> e:1            50.80009    7.87851  6.4479 6.467e-10 ***
+#> e:2            93.44626    8.11091 11.5211 < 2.2e-16 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  111.403 (233 degrees of freedom)
+
+## Predicted values with se and confidence intervals
+#predict(G.aparine.m1, interval = "confidence")
+# long output
+
+## Calculating the relative potency
+EDcomp(G.aparine.m1, c(50,50))
+#> 
+#> Estimated ratios of effect doses
+#> 
+#>              Estimate  Std. Error     t-value     p-value
+#> 1/2:50/50  5.4363e-01  9.3972e-02 -4.8565e+00  2.1923e-06
+
+## Showing the relative potency as a
+## function of the response level
+relpot(G.aparine.m1)
+
+relpot(G.aparine.m1, interval = "delta")
+
+# appears constant!
+
+## Response level in percent
+relpot(G.aparine.m1, scale = "percent")
+
+
+## Fitting a reduced model (with a common slope parameter)
+G.aparine.m2 <- drm(drymatter ~ dose, treatment, data = G.aparine, 
+pmodels = data.frame(1, treatment, 1, treatment), fct = LL.4())
+
+anova(G.aparine.m2, G.aparine.m1)
+#> 
+#> 1st model
+#>  fct:     LL.4()
+#>  pmodels: 1, treatment, 1, treatment
+#> 2nd model
+#>  fct:     LL.4()
+#>  pmodels: treatment, treatment, 1, treatment
+#> 
+#> ANOVA table
+#> 
+#>           ModelDf     RSS Df F value p value
+#> 1st model     234 2893283                   
+#> 2nd model     233 2891677  1  0.1294  0.7193
+
+## Showing the relative potency 
+relpot(G.aparine.m2)
+
+
+## Fitting the same model in a different parameterisation
+G.aparine.m3 <- drm(drymatter ~ dose, treatment, data = G.aparine, 
+pmodels = data.frame(treatment, treatment, 1, treatment), fct = LL2.4())
+
+EDcomp(G.aparine.m3, c(50, 50), logBase = exp(1))
+#> 
+#> Estimated ratios of effect doses
+#> 
+#>              Estimate  Std. Error     t-value     p-value
+#> 1/2:50/50  5.4362e-01  9.3970e-02 -4.8567e+00  2.1904e-06
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/G.aparine.md b/docs/reference/G.aparine.md new file mode 100644 index 00000000..b8c271f4 --- /dev/null +++ b/docs/reference/G.aparine.md @@ -0,0 +1,138 @@ +# Herbicide applied to Galium aparine + +Small plants of *Galium aparine*, growing in pots in a green house, were +sprayed with the technical grade phenmidipham herbicide either alone or +in mixture with an ester of oleic acid. The plants were allowed to grow +in the green house for 14 days after herbicide treatment. Then the dry +matter was measured per pot. + +## Usage + +``` r +data(G.aparine) +``` + +## Format + +A data frame with 240 observations on the following 3 variables. + +- `dose`: + + a numeric vector of dose value (g/ha) + +- `drymatter`: + + a numeric vector of dry matter weights (mg/pot) + +- `treatment`: + + a numeric vector giving the grouping: 0: control, 1,2: herbicide + formulations + +## Source + +Cabanne, F., Gaudry, J. C. and Streibig, J. C. (1999) Influence of alkyl +oleates on efficacy of phenmedipham applied as an acetone:water solution +on Galium aparine, *Weed Research*, **39**, 57–67. + +## Examples + +``` r +library(drc) + +## Fitting a model with a common control (so a single upper limit: "1") +G.aparine.m1 <- drm(drymatter ~ dose, treatment, data = G.aparine, +pmodels = data.frame(treatment, treatment, 1, treatment), fct = LL.4()) + +## Visual inspection of fit +plot(G.aparine.m1, broken = TRUE) + + +## Lack of fit test +modelFit(G.aparine.m1) +#> Lack-of-fit test +#> +#> ModelDf RSS Df F value p value +#> ANOVA 219 2601788 +#> DRC model 233 2891677 14 1.7429 0.0490 + +## Summary output +summary(G.aparine.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:1 1.61291 0.33330 4.8392 2.372e-06 *** +#> b:2 1.75100 0.20392 8.5869 1.311e-15 *** +#> c:1 509.50367 23.25885 21.9058 < 2.2e-16 *** +#> c:2 151.91840 26.00899 5.8410 1.734e-08 *** +#> d:(Intercept) 984.88779 12.63335 77.9594 < 2.2e-16 *** +#> e:1 50.80009 7.87851 6.4479 6.467e-10 *** +#> e:2 93.44626 8.11091 11.5211 < 2.2e-16 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 111.403 (233 degrees of freedom) + +## Predicted values with se and confidence intervals +#predict(G.aparine.m1, interval = "confidence") +# long output + +## Calculating the relative potency +EDcomp(G.aparine.m1, c(50,50)) +#> +#> Estimated ratios of effect doses +#> +#> Estimate Std. Error t-value p-value +#> 1/2:50/50 5.4363e-01 9.3972e-02 -4.8565e+00 2.1923e-06 + +## Showing the relative potency as a +## function of the response level +relpot(G.aparine.m1) + +relpot(G.aparine.m1, interval = "delta") + +# appears constant! + +## Response level in percent +relpot(G.aparine.m1, scale = "percent") + + +## Fitting a reduced model (with a common slope parameter) +G.aparine.m2 <- drm(drymatter ~ dose, treatment, data = G.aparine, +pmodels = data.frame(1, treatment, 1, treatment), fct = LL.4()) + +anova(G.aparine.m2, G.aparine.m1) +#> +#> 1st model +#> fct: LL.4() +#> pmodels: 1, treatment, 1, treatment +#> 2nd model +#> fct: LL.4() +#> pmodels: treatment, treatment, 1, treatment +#> +#> ANOVA table +#> +#> ModelDf RSS Df F value p value +#> 1st model 234 2893283 +#> 2nd model 233 2891677 1 0.1294 0.7193 + +## Showing the relative potency +relpot(G.aparine.m2) + + +## Fitting the same model in a different parameterisation +G.aparine.m3 <- drm(drymatter ~ dose, treatment, data = G.aparine, +pmodels = data.frame(treatment, treatment, 1, treatment), fct = LL2.4()) + +EDcomp(G.aparine.m3, c(50, 50), logBase = exp(1)) +#> +#> Estimated ratios of effect doses +#> +#> Estimate Std. Error t-value p-value +#> 1/2:50/50 5.4362e-01 9.3970e-02 -4.8567e+00 2.1904e-06 +``` diff --git a/docs/reference/GiantKelp-1.png b/docs/reference/GiantKelp-1.png new file mode 100644 index 00000000..28ebd836 Binary files /dev/null and b/docs/reference/GiantKelp-1.png differ diff --git a/docs/reference/GiantKelp.html b/docs/reference/GiantKelp.html new file mode 100644 index 00000000..5d279b04 --- /dev/null +++ b/docs/reference/GiantKelp.html @@ -0,0 +1,126 @@ + +Measurements of germination tubes for Giant Kelp — GiantKelp • drc + Skip to contents + + +
    +
    +
    +

    Measurements of germination tubes for Giant Kelp

    + +
    GiantKelp.Rd
    +
    + +
    +

    Giant kelp, Macrocystis pyrifera, was exposed to 8 different concentrations of copper and the response measured was the length of the germination tube.

    +
    + +
    +

    Usage

    + 
    data(GiantKelp)
    +
    + +
    +

    Format

    +

    A data frame with 39 observations of the following 2 variables.

    dose
    +

    a numeric vector

    + +
    tubeLength
    +

    a numeric vector giving the length of the germination tube (mm)

    + + +
    +
    +

    Source

    +

    G. A. Chapman, D. L. Denton, and J. M. Lazorchak (1995). Short-term methods for estimating +the chronic toxicity of effluents and receiving waters to west coast marine and estuarine +organisms.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Displaying the data
+head(GiantKelp)
+#>   tubeLength dose
+#> 1      19.58  0.0
+#> 2      18.75  0.0
+#> 3      19.14  0.0
+#> 4      16.50  0.0
+#> 5      17.93  0.0
+#> 6      18.26  5.6
+
+## Fitting a four-parameter log-logistic model
+GiantKelp.m1 <- drm(tubeLength ~ dose, data = GiantKelp, fct = LL.4())
+summary(GiantKelp.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value p-value    
+#> b:(Intercept)  1.19476    0.45955  2.5999 0.01357 *  
+#> c:(Intercept)  4.46327    3.46849  1.2868 0.20661    
+#> d:(Intercept) 18.08505    0.77922 23.2090 < 2e-16 ***
+#> e:(Intercept) 53.86481   25.46202  2.1155 0.04158 *  
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  1.688897 (35 degrees of freedom)
+
+## Plotting the fitted curve
+plot(GiantKelp.m1, xlab = "Copper concentration", ylab = "Tube length (mm)")
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/GiantKelp.md b/docs/reference/GiantKelp.md new file mode 100644 index 00000000..2ed26873 --- /dev/null +++ b/docs/reference/GiantKelp.md @@ -0,0 +1,68 @@ +# Measurements of germination tubes for Giant Kelp + +Giant kelp, *Macrocystis pyrifera*, was exposed to 8 different +concentrations of copper and the response measured was the length of the +germination tube. + +## Usage + +``` r +data(GiantKelp) +``` + +## Format + +A data frame with 39 observations of the following 2 variables. + +- `dose`: + + a numeric vector + +- `tubeLength`: + + a numeric vector giving the length of the germination tube (mm) + +## Source + +G. A. Chapman, D. L. Denton, and J. M. Lazorchak (1995). Short-term +methods for estimating the chronic toxicity of effluents and receiving +waters to west coast marine and estuarine organisms. + +## Examples + +``` r +library(drc) + +## Displaying the data +head(GiantKelp) +#> tubeLength dose +#> 1 19.58 0.0 +#> 2 18.75 0.0 +#> 3 19.14 0.0 +#> 4 16.50 0.0 +#> 5 17.93 0.0 +#> 6 18.26 5.6 + +## Fitting a four-parameter log-logistic model +GiantKelp.m1 <- drm(tubeLength ~ dose, data = GiantKelp, fct = LL.4()) +summary(GiantKelp.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 1.19476 0.45955 2.5999 0.01357 * +#> c:(Intercept) 4.46327 3.46849 1.2868 0.20661 +#> d:(Intercept) 18.08505 0.77922 23.2090 < 2e-16 *** +#> e:(Intercept) 53.86481 25.46202 2.1155 0.04158 * +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 1.688897 (35 degrees of freedom) + +## Plotting the fitted curve +plot(GiantKelp.m1, xlab = "Copper concentration", ylab = "Tube length (mm)") +``` diff --git a/docs/reference/H.virescens.html b/docs/reference/H.virescens.html new file mode 100644 index 00000000..168ffb08 --- /dev/null +++ b/docs/reference/H.virescens.html @@ -0,0 +1,144 @@ + +Mortality of tobacco budworms — H.virescens • drc + Skip to contents + + +
    +
    +
    +

    Mortality of tobacco budworms

    + +
    H.virescens.Rd
    +
    + +
    +

    For three days, moths of the tobacco budworm (Heliothis virescens) were exposed + to doses of the pyrethroid trans-cypermethrin.

    +
    + +
    +

    Usage

    + 
    data(H.virescens)
    +
    + +
    +

    Format

    +

    A data frame with 12 observations on the following 4 variables.

    dose
    +

    a numeric vector of dose values (\(\mu g\))

    + +
    numdead
    +

    a numeric vector of dead or knocked-down moths

    + +
    total
    +

    a numeric vector of total number of moths

    + +
    sex
    +

    a factor with levels F M denoting a grouping according to sex

    + + +
    +
    +

    Details

    +

    In Venables and Ripley (2002), these data are analysed using a logistic regression with base-2 logarithm of dose + as explanatory variable.

    +
    +
    +

    Source

    +

    Venables, W. N. and Ripley, B. D (2002) Modern Applied Statistics with S, New York: Springer (fourth edition).

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Fitting dose-response model (log-logistic with common slope)
+Hv.m1 <- drm(numdead/total~dose, sex, weights = total, data = H.virescens, fct = LL.2(), 
+pmodels = list(~ 1, ~ sex - 1), type = "binomial")
+summary(Hv.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept) -1.53537    0.18911 -8.1189 4.573e-16 ***
+#> e:sexF         9.60556    1.52990  6.2786 3.417e-10 ***
+#> e:sexM         4.69001    0.73465  6.3840 1.725e-10 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+## Fitting the same model as in Venables and Riply (2002)
+Hv.m2 <- glm(cbind(numdead, total-numdead) ~ sex + I(log2(dose)) - 1, data = H.virescens, 
+family = binomial)
+
+## Comparing the fits
+logLik(Hv.m1)
+#> 'log Lik.' -18.43373 (df=3)
+logLik(Hv.m2)
+#> 'log Lik.' -18.43373 (df=3)
+
+## Estimated ED values (matching those given in MASS)
+ED(Hv.m1, c(25, 50, 75))
+#> 
+#> Estimated effective doses
+#> 
+#>        Estimate Std. Error
+#> e:F:25  4.69645    0.81353
+#> e:F:50  9.60556    1.52990
+#> e:F:75 19.64607    3.74120
+#> e:M:25  2.29309    0.41882
+#> e:M:50  4.69001    0.73465
+#> e:M:75  9.59239    1.69565
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/H.virescens.md b/docs/reference/H.virescens.md new file mode 100644 index 00000000..6195d812 --- /dev/null +++ b/docs/reference/H.virescens.md @@ -0,0 +1,85 @@ +# Mortality of tobacco budworms + +For three days, moths of the tobacco budworm (*Heliothis virescens*) +were exposed to doses of the pyrethroid trans-cypermethrin. + +## Usage + +``` r +data(H.virescens) +``` + +## Format + +A data frame with 12 observations on the following 4 variables. + +- `dose`: + + a numeric vector of dose values (\\\mu g\\) + +- `numdead`: + + a numeric vector of dead or knocked-down moths + +- `total`: + + a numeric vector of total number of moths + +- `sex`: + + a factor with levels `F` `M` denoting a grouping according to sex + +## Details + +In Venables and Ripley (2002), these data are analysed using a logistic +regression with base-2 logarithm of dose as explanatory variable. + +## Source + +Venables, W. N. and Ripley, B. D (2002) *Modern Applied Statistics with +S*, New York: Springer (fourth edition). + +## Examples + +``` r +library(drc) + +## Fitting dose-response model (log-logistic with common slope) +Hv.m1 <- drm(numdead/total~dose, sex, weights = total, data = H.virescens, fct = LL.2(), +pmodels = list(~ 1, ~ sex - 1), type = "binomial") +summary(Hv.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) -1.53537 0.18911 -8.1189 4.573e-16 *** +#> e:sexF 9.60556 1.52990 6.2786 3.417e-10 *** +#> e:sexM 4.69001 0.73465 6.3840 1.725e-10 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 + +## Fitting the same model as in Venables and Riply (2002) +Hv.m2 <- glm(cbind(numdead, total-numdead) ~ sex + I(log2(dose)) - 1, data = H.virescens, +family = binomial) + +## Comparing the fits +logLik(Hv.m1) +#> 'log Lik.' -18.43373 (df=3) +logLik(Hv.m2) +#> 'log Lik.' -18.43373 (df=3) + +## Estimated ED values (matching those given in MASS) +ED(Hv.m1, c(25, 50, 75)) +#> +#> Estimated effective doses +#> +#> Estimate Std. Error +#> e:F:25 4.69645 0.81353 +#> e:F:50 9.60556 1.52990 +#> e:F:75 19.64607 3.74120 +#> e:M:25 2.29309 0.41882 +#> e:M:50 4.69001 0.73465 +#> e:M:75 9.59239 1.69565 +``` diff --git a/docs/reference/L.3.html b/docs/reference/L.3.html new file mode 100644 index 00000000..8b42e601 --- /dev/null +++ b/docs/reference/L.3.html @@ -0,0 +1,107 @@ + +Three-parameter logistic model — L.3 • drc + Skip to contents + + +
    +
    +
    +

    Three-parameter logistic model

    + Source: R/logistic.R +
    L.3.Rd
    +
    + +
    +

    A three-parameter logistic model with the lower limit fixed at 0, given by +$$f(x) = \frac{d}{1 + \exp(b(x - e))}$$

    +
    + +
    +

    Usage

    + 
    L.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector of length 3. Specifies which parameters are fixed +and at what value they are fixed. NA indicates that the corresponding +parameter is not fixed.

    + + +
    names
    +

    character vector of length 3 giving the names of the parameters +(b, d, e). Default is c("b", "d", "e").

    + + +
    ...
    +

    additional arguments passed to logistic.

    + +
    +
    +

    Value

    +

    A list of class "Boltzmann" containing the nonlinear function, +self starter function, and parameter names.

    +
    +
    +

    See also

    +

    logistic, L.4, L.5

    +
    + +
    +

    Examples

    + 
    ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = L.3())
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/L.3.md b/docs/reference/L.3.md new file mode 100644 index 00000000..3c5a4202 --- /dev/null +++ b/docs/reference/L.3.md @@ -0,0 +1,45 @@ +# Three-parameter logistic model + +A three-parameter logistic model with the lower limit fixed at 0, given +by \$\$f(x) = \frac{d}{1 + \exp(b(x - e))}\$\$ + +## Usage + +``` r +L.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) +``` + +## Arguments + +- fixed: + + numeric vector of length 3. Specifies which parameters are fixed and + at what value they are fixed. `NA` indicates that the corresponding + parameter is not fixed. + +- names: + + character vector of length 3 giving the names of the parameters + `(b, d, e)`. Default is `c("b", "d", "e")`. + +- ...: + + additional arguments passed to + [`logistic`](https://hreinwald.github.io/drc/reference/logistic.md). + +## Value + +A list of class `"Boltzmann"` containing the nonlinear function, self +starter function, and parameter names. + +## See also + +[`logistic`](https://hreinwald.github.io/drc/reference/logistic.md), +[`L.4`](https://hreinwald.github.io/drc/reference/L.4.md), +[`L.5`](https://hreinwald.github.io/drc/reference/L.5.md) + +## Examples + +``` r +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = L.3()) +``` diff --git a/docs/reference/L.4.html b/docs/reference/L.4.html new file mode 100644 index 00000000..b8e1048d --- /dev/null +++ b/docs/reference/L.4.html @@ -0,0 +1,107 @@ + +Four-parameter logistic model — L.4 • drc + Skip to contents + + +
    +
    +
    +

    Four-parameter logistic model

    + Source: R/logistic.R +
    L.4.Rd
    +
    + +
    +

    A four-parameter logistic model (symmetric, with f = 1), given by +$$f(x) = c + \frac{d - c}{1 + \exp(b(x - e))}$$

    +
    + +
    +

    Usage

    + 
    L.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector of length 4. Specifies which parameters are fixed +and at what value they are fixed. NA indicates that the corresponding +parameter is not fixed.

    + + +
    names
    +

    character vector of length 4 giving the names of the parameters +(b, c, d, e). Default is c("b", "c", "d", "e").

    + + +
    ...
    +

    additional arguments passed to logistic.

    + +
    +
    +

    Value

    +

    A list of class "Boltzmann" containing the nonlinear function, +self starter function, and parameter names.

    +
    +
    +

    See also

    +

    logistic, L.3, L.5

    +
    + +
    +

    Examples

    + 
    ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = L.4())
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/L.4.md b/docs/reference/L.4.md new file mode 100644 index 00000000..c74ab366 --- /dev/null +++ b/docs/reference/L.4.md @@ -0,0 +1,45 @@ +# Four-parameter logistic model + +A four-parameter logistic model (symmetric, with `f = 1`), given by +\$\$f(x) = c + \frac{d - c}{1 + \exp(b(x - e))}\$\$ + +## Usage + +``` r +L.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) +``` + +## Arguments + +- fixed: + + numeric vector of length 4. Specifies which parameters are fixed and + at what value they are fixed. `NA` indicates that the corresponding + parameter is not fixed. + +- names: + + character vector of length 4 giving the names of the parameters + `(b, c, d, e)`. Default is `c("b", "c", "d", "e")`. + +- ...: + + additional arguments passed to + [`logistic`](https://hreinwald.github.io/drc/reference/logistic.md). + +## Value + +A list of class `"Boltzmann"` containing the nonlinear function, self +starter function, and parameter names. + +## See also + +[`logistic`](https://hreinwald.github.io/drc/reference/logistic.md), +[`L.3`](https://hreinwald.github.io/drc/reference/L.3.md), +[`L.5`](https://hreinwald.github.io/drc/reference/L.5.md) + +## Examples + +``` r +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = L.4()) +``` diff --git a/docs/reference/L.5.html b/docs/reference/L.5.html new file mode 100644 index 00000000..155d7e5f --- /dev/null +++ b/docs/reference/L.5.html @@ -0,0 +1,110 @@ + +Five-parameter generalized logistic model — L.5 • drc + Skip to contents + + +
    +
    +
    +

    Five-parameter generalized logistic model

    + Source: R/logistic.R +
    L.5.Rd
    +
    + +
    +

    A five-parameter generalized logistic model (asymmetric when f != 1), +given by +$$f(x) = c + \frac{d - c}{(1 + \exp(b(x - e)))^f}$$

    +
    + +
    +

    Usage

    + 
    L.5(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector of length 5. Specifies which parameters are fixed +and at what value they are fixed. NA indicates that the corresponding +parameter is not fixed.

    + + +
    names
    +

    character vector of length 5 giving the names of the parameters +(b, c, d, e, f). Default is c("b", "c", "d", "e", "f").

    + + +
    ...
    +

    additional arguments passed to logistic.

    + +
    +
    +

    Value

    +

    A list of class "Boltzmann" containing the nonlinear function, +self starter function, and parameter names.

    +
    +
    +

    See also

    +

    logistic, L.3, L.4

    +
    + +
    +

    Examples

    + 
    ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = L.5())
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/L.5.md b/docs/reference/L.5.md new file mode 100644 index 00000000..c80b0721 --- /dev/null +++ b/docs/reference/L.5.md @@ -0,0 +1,45 @@ +# Five-parameter generalized logistic model + +A five-parameter generalized logistic model (asymmetric when `f != 1`), +given by \$\$f(x) = c + \frac{d - c}{(1 + \exp(b(x - e)))^f}\$\$ + +## Usage + +``` r +L.5(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...) +``` + +## Arguments + +- fixed: + + numeric vector of length 5. Specifies which parameters are fixed and + at what value they are fixed. `NA` indicates that the corresponding + parameter is not fixed. + +- names: + + character vector of length 5 giving the names of the parameters + `(b, c, d, e, f)`. Default is `c("b", "c", "d", "e", "f")`. + +- ...: + + additional arguments passed to + [`logistic`](https://hreinwald.github.io/drc/reference/logistic.md). + +## Value + +A list of class `"Boltzmann"` containing the nonlinear function, self +starter function, and parameter names. + +## See also + +[`logistic`](https://hreinwald.github.io/drc/reference/logistic.md), +[`L.3`](https://hreinwald.github.io/drc/reference/L.3.md), +[`L.4`](https://hreinwald.github.io/drc/reference/L.4.md) + +## Examples + +``` r +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = L.5()) +``` diff --git a/docs/reference/LL.2-1.png b/docs/reference/LL.2-1.png deleted file mode 100644 index b6c773a4..00000000 Binary files a/docs/reference/LL.2-1.png and /dev/null differ diff --git a/docs/reference/LL.2.html b/docs/reference/LL.2.html index 954949b0..ee921942 100644 --- a/docs/reference/LL.2.html +++ b/docs/reference/LL.2.html @@ -1,204 +1,126 @@ - - - - - - +Two-parameter log-logistic function — LL.2 • drc + Skip to contents -The two-parameter log-logistic function — LL.2 • drc - - - +
    +
    +
    +

    Two-parameter log-logistic function

    + Source: R/llogistic.R +
    LL.2.Rd
    +
    - +
    +

    A two-parameter log-logistic function with lower limit fixed at 0 and +upper limit fixed (default 1), primarily for use with binomial/quantal +dose-response data.

    +
    - - +
    +

    Usage

    + 
    LL.2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...)
+
+l2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...)
    +
    +
    +

    Arguments

    - - +
    upper
    +

    numeric value, the fixed upper limit (default 1).

    - +
    fixed
    +

    numeric vector of length 2, specifying fixed parameters +(use NA for non-fixed parameters).

    - - -
    -
    - - - -
    -
    -
    -
    -

    The two-parameter log-logistic function

    - - -
    +
    ...
    +

    additional arguments to llogistic.

    -
    - -

    'LL.2' and 'LL2.2' provide the two-parameter log-logistic function where the lower limit is fixed at 0 and the upper limit - is fixed at 1, mostly suitable for binomial/quantal responses.

    - +
    +
    +

    Value

    +

    See llogistic.

    - - 
    LL.2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...)
-
-  l2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...)
-
-  LL2.2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - -
    upper

    numeric value. The fixed, upper limit in the model. Default is 1.

    fixed

    numeric vector. Specifies which parameters are fixed and at what value they are fixed. NAs for parameter that are not fixed.

    names

    a vector of character strings giving the names of the parameters. The default is reasonable.

    ...

    Additional arguments (see llogistic).

    - -

    Details

    - +
    +

    Details

    The two-parameter log-logistic function is given by the expression - $$ f(x) = \frac{1}{1+\exp(b(\log(x)-\log(e)))}$$

    -

    or in another parameterisation - $$ f(x) = \frac{1}{1+\exp(b(\log(x)-e))}$$

    -

    The model function is symmetric about the inflection point (\(e\)).

    - -

    Value

    - -

    See llogistic.

    - -

    Note

    - -

    This function is for use with the function drm.

    - -

    See also

    - -

    Related functions are LL.3, LL.4, LL.5 and the more general - llogistic.

    - - -

    Examples

    - 
    
-## Fitting a two-parameter logistic model 
-##  to binomial responses (a logit model)
-earthworms.m1 <- drm(number/total~dose, weights=total,
-data = earthworms, fct = LL.2(), type = "binomial")
-
-plot(earthworms.m1)  # not fitting at the upper limit!
    
-
    -
    - +
    +

    See also

    +

    LL.3, LL.4, LL.5, +llogistic

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    -
  • Note
    • +
    +

    Examples

    + 
    earthworms.m1 <- drm(number/total~dose, weights=total,
+  data = earthworms, fct = LL.2(), type = "binomial")
+
+
    +
    +
    -
  • See also
    • - -
  • Examples
    • - -

    Author

    - Christian Ritz -
    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + -
    - - - - + diff --git a/docs/reference/LL.2.md b/docs/reference/LL.2.md new file mode 100644 index 00000000..55ad75ea --- /dev/null +++ b/docs/reference/LL.2.md @@ -0,0 +1,62 @@ +# Two-parameter log-logistic function + +A two-parameter log-logistic function with lower limit fixed at 0 and +upper limit fixed (default 1), primarily for use with binomial/quantal +dose-response data. + +## Usage + +``` r +LL.2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) + +l2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) +``` + +## Arguments + +- upper: + + numeric value, the fixed upper limit (default 1). + +- fixed: + + numeric vector of length 2, specifying fixed parameters (use NA for + non-fixed parameters). + +- names: + + character vector of length 2, specifying the names of the parameters + (default: b, e). + +- ...: + + additional arguments to + [`llogistic`](https://hreinwald.github.io/drc/reference/llogistic.md). + +## Value + +See +[`llogistic`](https://hreinwald.github.io/drc/reference/llogistic.md). + +## Details + +The two-parameter log-logistic function is given by the expression +\$\$f(x) = \frac{upper}{1+\exp(b(\log(x)-\log(e)))}\$\$ + +## See also + +[`LL.3`](https://hreinwald.github.io/drc/reference/LL.3.md), +[`LL.4`](https://hreinwald.github.io/drc/reference/LL.4.md), +[`LL.5`](https://hreinwald.github.io/drc/reference/LL.5.md), +[`llogistic`](https://hreinwald.github.io/drc/reference/llogistic.md) + +## Author + +Christian Ritz + +## Examples + +``` r +earthworms.m1 <- drm(number/total~dose, weights=total, + data = earthworms, fct = LL.2(), type = "binomial") +``` diff --git a/docs/reference/LL.3-1.png b/docs/reference/LL.3-1.png deleted file mode 100644 index 4c04d355..00000000 Binary files a/docs/reference/LL.3-1.png and /dev/null differ diff --git a/docs/reference/LL.3.html b/docs/reference/LL.3.html index 47aca2ae..88c3c58c 100644 --- a/docs/reference/LL.3.html +++ b/docs/reference/LL.3.html @@ -1,267 +1,115 @@ - - - - - - +Three-parameter log-logistic function — LL.3 • drc + Skip to contents -The three-parameter log-logistic function — LL.3 • drc - - - +
    -
    -
    -

    The three-parameter log-logistic function

    - - +
    +

    Three-parameter log-logistic function

    + Source: R/llogistic.R +
    LL.3.Rd
    -
    - -

    'LL.3' and 'LL2.3' provide the three-parameter log-logistic function where the lower limit is equal to 0.

    -

    'LL.3u' and 'LL2.3u' provide three-parameter logistic function where the upper limit is equal to 1, mainly - for use with binomial/quantal response.

    - +
    +

    A three-parameter log-logistic function with lower limit fixed at 0.

    - 
    LL.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...)
-
-  LL.3u(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...)
-
-  l3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...)
-
-  l3u(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...)
-
-  LL2.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...)
-
-  LL2.3u(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - -
    upper

    numeric value. The fixed, upper limit in the model. Default is 1.

    fixed

    numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.

    names

    a vector of character strings giving the names of the parameters. The default is reasonable.

    ...

    Additional arguments (see llogistic).

    - -

    Details

    - -

    The three-parameter log-logistic function with lower limit 0 is - $$ f(x) = 0 + \frac{d-0}{1+\exp(b(\log(x)-\log(e)))}$$

    -

    or in another parameterisation - $$ f(x) = 0 + \frac{d-0}{1+\exp(b(\log(x)-e))}$$

    -

    The three-parameter log-logistic function with upper limit 1 is - $$ f(x) = c + \frac{1-c}{1+\exp(b(\log(x)-\log(e)))}$$

    -

    or in another parameterisation - $$ f(x) = c + \frac{1-c}{1+\exp(b(\log(x)-e))}$$

    -

    Both functions are symmetric about the inflection point (\(e\)).

    - -

    Value

    - -

    See llogistic.

    - -

    References

    +
    +

    Usage

    + 
    LL.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...)
+
+l3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...)
    +
    -

    Finney, D. J. (1971) Probit Analysis, Cambridge: Cambridge University Press.

    - -

    Note

    +
    +

    Arguments

    -

    This function is for use with the function drm.

    - -

    See also

    -

    Related functions are LL.2, LL.4, LL.5 and the more general - llogistic.

    - +
    fixed
    +

    numeric vector of length 3, specifying fixed parameters +(use NA for non-fixed parameters).

    -

    Examples

    - 
    
-## Fitting model with lower limit equal 0
-ryegrass.model1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.3())
-summary(ryegrass.model1)
    #> 
-#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms)
-#> 
-#> Parameter estimates:
-#> 
-#>               Estimate Std. Error t-value   p-value    
-#> b:(Intercept)  2.47033    0.34168  7.2299 4.011e-07 ***
-#> d:(Intercept)  7.85543    0.20438 38.4352 < 2.2e-16 ***
-#> e:(Intercept)  3.26336    0.19641 16.6154 1.474e-13 ***
-#> ---
-#> Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
-#> 
-#> Residual standard error:
-#> 
-#>  0.5615802 (21 degrees of freedom)
    
-## Fitting binomial response
-##  with non-zero control response
 
-## Example dataset from Finney (1971) - example 19
-logdose <- c(2.17, 2,1.68,1.08,-Inf,1.79,1.66,1.49,1.17,0.57)
-n <- c(142,127,128,126,129,125,117,127,51,132)
-r <- c(142,126,115,58,21,125,115,114,40,37)
-treatment <- factor(c("w213","w213","w213","w213",
-"w214","w214","w214","w214","w214","w214"))
-# Note that the control is included in one of the two treatment groups
-finney.ex19 <- data.frame(logdose, n, r, treatment)
+
    names
    
+
    character vector of length 3, specifying the names of the
+parameters (default: b, d, e).
    
 
-## Fitting model where the lower limit is estimated
-fe19.model1 <- drm(r/n~logdose, treatment, weights = n, data = finney.ex19,
-logDose = 10, fct = LL.3u(), type="binomial",
-pmodels = data.frame(treatment, 1, treatment))
    #> Warning: NaNs produced
    
-summary(fe19.model1)
    #> 
-#> Model fitted: Log-logistic (ED50 as parameter) with upper limit at 1 (3 parms)
-#> 
-#> Parameter estimates:
-#> 
-#>                Estimate Std. Error t-value   p-value    
-#> b:w213        -2.183042   0.232540 -9.3878 < 2.2e-16 ***
-#> b:w214        -2.117258   0.257816 -8.2123 < 2.2e-16 ***
-#> c:(Intercept)  0.171725   0.033821  5.0775 3.824e-07 ***
-#> e:w213        16.599749   1.754358  9.4620 < 2.2e-16 ***
-#> e:w214         9.553766   1.412122  6.7655 1.328e-11 ***
-#> ---
-#> Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
    modelFit(fe19.model1)
    #> Goodness-of-fit test
-#> 
-#>             Df Chisq value p value
-#>                                   
-#> DRC model    5      8.9976  0.1092
    plot(fe19.model1, ylim = c(0, 1.1), bp = -1, broken = TRUE, legendPos = c(0, 1))
    abline(h = 1, lty = 2)
    
-
    -
    - +
    +

    Value

    +

    See llogistic.

    +
    +
    +

    Details

    +

    The three-parameter log-logistic function is given by the expression +$$f(x) = \frac{d}{1+\exp(b(\log(x)-\log(e)))}$$

    +
    +
    +

    See also

    +

    LL.2, LL.4, LL.5, +llogistic

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    -
  • Note
    • +
    +

    Examples

    + 
    ryegrass.model1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.3())
+
+
    +
    +
    -
  • See also
    • - -
  • Examples
    • - -

    Author

    - Christian Ritz -
    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + - -
    - - - + diff --git a/docs/reference/LL.3.md b/docs/reference/LL.3.md new file mode 100644 index 00000000..0111779e --- /dev/null +++ b/docs/reference/LL.3.md @@ -0,0 +1,55 @@ +# Three-parameter log-logistic function + +A three-parameter log-logistic function with lower limit fixed at 0. + +## Usage + +``` r +LL.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) + +l3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) +``` + +## Arguments + +- fixed: + + numeric vector of length 3, specifying fixed parameters (use NA for + non-fixed parameters). + +- names: + + character vector of length 3, specifying the names of the parameters + (default: b, d, e). + +- ...: + + additional arguments to + [`llogistic`](https://hreinwald.github.io/drc/reference/llogistic.md). + +## Value + +See +[`llogistic`](https://hreinwald.github.io/drc/reference/llogistic.md). + +## Details + +The three-parameter log-logistic function is given by the expression +\$\$f(x) = \frac{d}{1+\exp(b(\log(x)-\log(e)))}\$\$ + +## See also + +[`LL.2`](https://hreinwald.github.io/drc/reference/LL.2.md), +[`LL.4`](https://hreinwald.github.io/drc/reference/LL.4.md), +[`LL.5`](https://hreinwald.github.io/drc/reference/LL.5.md), +[`llogistic`](https://hreinwald.github.io/drc/reference/llogistic.md) + +## Author + +Christian Ritz + +## Examples + +``` r +ryegrass.model1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.3()) +``` diff --git a/docs/reference/LL.3u.html b/docs/reference/LL.3u.html new file mode 100644 index 00000000..3c55620c --- /dev/null +++ b/docs/reference/LL.3u.html @@ -0,0 +1,116 @@ + +Three-parameter log-logistic function with upper limit fixed — LL.3u • drc + Skip to contents + + +
    +
    +
    +

    Three-parameter log-logistic function with upper limit fixed

    + Source: R/llogistic.R +
    LL.3u.Rd
    +
    + +
    +

    A three-parameter log-logistic function with upper limit fixed (default 1), +primarily for use with binomial/quantal dose-response data.

    +
    + +
    +

    Usage

    + 
    LL.3u(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...)
+
+l3u(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...)
    +
    + +
    +

    Arguments

    + + +
    upper
    +

    numeric value, the fixed upper limit (default 1).

    + + +
    fixed
    +

    numeric vector of length 3, specifying fixed parameters +(use NA for non-fixed parameters).

    + + +
    names
    +

    character vector of length 3, specifying the names of the +parameters (default: b, c, e).

    + + +
    ...
    +

    additional arguments to llogistic.

    + +
    +
    +

    Value

    +

    See llogistic.

    +
    +
    +

    Details

    +

    The three-parameter log-logistic function with upper limit fixed is given by +$$f(x) = c + \frac{upper-c}{1+\exp(b(\log(x)-\log(e)))}$$

    +
    +
    +

    See also

    +

    LL.2, LL.3, LL.4, +llogistic

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/LL.3u.md b/docs/reference/LL.3u.md new file mode 100644 index 00000000..9a451691 --- /dev/null +++ b/docs/reference/LL.3u.md @@ -0,0 +1,54 @@ +# Three-parameter log-logistic function with upper limit fixed + +A three-parameter log-logistic function with upper limit fixed (default +1), primarily for use with binomial/quantal dose-response data. + +## Usage + +``` r +LL.3u(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...) + +l3u(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...) +``` + +## Arguments + +- upper: + + numeric value, the fixed upper limit (default 1). + +- fixed: + + numeric vector of length 3, specifying fixed parameters (use NA for + non-fixed parameters). + +- names: + + character vector of length 3, specifying the names of the parameters + (default: b, c, e). + +- ...: + + additional arguments to + [`llogistic`](https://hreinwald.github.io/drc/reference/llogistic.md). + +## Value + +See +[`llogistic`](https://hreinwald.github.io/drc/reference/llogistic.md). + +## Details + +The three-parameter log-logistic function with upper limit fixed is +given by \$\$f(x) = c + \frac{upper-c}{1+\exp(b(\log(x)-\log(e)))}\$\$ + +## See also + +[`LL.2`](https://hreinwald.github.io/drc/reference/LL.2.md), +[`LL.3`](https://hreinwald.github.io/drc/reference/LL.3.md), +[`LL.4`](https://hreinwald.github.io/drc/reference/LL.4.md), +[`llogistic`](https://hreinwald.github.io/drc/reference/llogistic.md) + +## Author + +Christian Ritz diff --git a/docs/reference/LL.4.html b/docs/reference/LL.4.html index 15bc2702..550e0a1b 100644 --- a/docs/reference/LL.4.html +++ b/docs/reference/LL.4.html @@ -1,215 +1,114 @@ - - - - - - +Four-parameter log-logistic function — LL.4 • drc + Skip to contents -The four-parameter log-logistic function — LL.4 • drc - - - +
    +
    +
    +

    Four-parameter log-logistic function

    + Source: R/llogistic.R +
    LL.4.Rd
    +
    - - - - - +
    +

    A four-parameter log-logistic function.

    +
    +
    +

    Usage

    + 
    LL.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...)
+
+l4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...)
    +
    - - +
    +

    Arguments

    - +
    fixed
    +

    numeric vector of length 4, specifying fixed parameters +(use NA for non-fixed parameters).

    - - -
    -
    - - - -
    -
    -
    -
    -

    The four-parameter log-logistic function

    - - -
    +
    ...
    +

    additional arguments to llogistic.

    -
    - -

    'LL.4' and 'LL2.4' provide the four-parameter log-logistic function, self starter function, names of the parameters and, optionally, - first and second derivatives for a faster estimation.

    - +
    +
    +

    Value

    +

    See llogistic.

    - - 
    LL.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...)
-
-  l4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...)
-
-  LL2.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...)
    - -

    Arguments

    - - - - - - - - - - - - - - -
    fixed

    numeric vector. Specifies which parameters are fixed and at what value they are fixed. NAs for parameter that are not fixed.

    names

    a vector of character strings giving the names of the parameters. The default is reasonable.

    ...

    Additional arguments (see llogistic).

    - -

    Details

    - +
    +

    Details

    The four-parameter log-logistic function is given by the expression - $$ f(x) = c + \frac{d-c}{1+\exp(b(\log(x)-\log(e)))}$$

    -

    or in another parameterisation (converting the term \(\log(e)\) into a parameter) - $$ f(x) = c + \frac{d-c}{1+\exp(b(\log(x)-\tilde{e}))}$$

    -

    The function is symmetric about the inflection point (\(e\)).

    - -

    Value

    - -

    See llogistic.

    - -

    References

    - -

    Seber, G. A. F. and Wild, C. J (1989) Nonlinear Regression, New York: Wiley \& Sons (p. 330).

    - -

    Note

    - -

    This function is for use with the function drm.

    - -

    See also

    - -

    Setting \(c=0\) yields LL.3. See also LL.5.

    - - -

    Examples

    - 
    
-spinach.m1 <- drm(SLOPE~DOSE, CURVE, data = spinach, fct = LL.4())
-spinach.m1
    #> 
-#> A 'drc' model.
-#> 
-#> Call:
-#> drm(formula = SLOPE ~ DOSE, curveid = CURVE, data = spinach,     fct = LL.4())
-#> 
-#> Coefficients:
-#>       b:1        b:2        b:3        b:4        b:5        c:1        c:2  
-#>  0.519519   0.800796   0.681913   1.844809   1.650758  -0.016595   0.132589  
-#>       c:3        c:4        c:5        d:1        d:2        d:3        d:4  
-#>  0.146406   0.079552  -0.009066   1.879553   0.946000   1.090321   2.153578  
-#>       d:5        e:1        e:2        e:3        e:4        e:5  
-#>  1.806283   1.794955   0.945530   1.373023   0.197326   0.210793  
-#> 
    
-
-
    -
    - +
    +

    See also

    +

    LL.3, LL.5, llogistic

    +
    +
    +

    Author

    +

    Christian Ritz and Jens C. Streibig

    +
    -
  • Note
    • +
    +

    Examples

    + 
    spinach.m1 <- drm(SLOPE~DOSE, CURVE, data = spinach, fct = LL.4())
+
+
    +
    +
    -
  • See also
    • - -
  • Examples
    • - -

    Author

    - Christian Ritz and Jens C. Streibig -
    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + -
    - - - - + diff --git a/docs/reference/LL.4.md b/docs/reference/LL.4.md new file mode 100644 index 00000000..8853219b --- /dev/null +++ b/docs/reference/LL.4.md @@ -0,0 +1,54 @@ +# Four-parameter log-logistic function + +A four-parameter log-logistic function. + +## Usage + +``` r +LL.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) + +l4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) +``` + +## Arguments + +- fixed: + + numeric vector of length 4, specifying fixed parameters (use NA for + non-fixed parameters). + +- names: + + character vector of length 4, specifying the names of the parameters + (default: b, c, d, e). + +- ...: + + additional arguments to + [`llogistic`](https://hreinwald.github.io/drc/reference/llogistic.md). + +## Value + +See +[`llogistic`](https://hreinwald.github.io/drc/reference/llogistic.md). + +## Details + +The four-parameter log-logistic function is given by the expression +\$\$f(x) = c + \frac{d-c}{1+\exp(b(\log(x)-\log(e)))}\$\$ + +## See also + +[`LL.3`](https://hreinwald.github.io/drc/reference/LL.3.md), +[`LL.5`](https://hreinwald.github.io/drc/reference/LL.5.md), +[`llogistic`](https://hreinwald.github.io/drc/reference/llogistic.md) + +## Author + +Christian Ritz and Jens C. Streibig + +## Examples + +``` r +spinach.m1 <- drm(SLOPE~DOSE, CURVE, data = spinach, fct = LL.4()) +``` diff --git a/docs/reference/LL.5.html b/docs/reference/LL.5.html index ba031901..2d3cbfc6 100644 --- a/docs/reference/LL.5.html +++ b/docs/reference/LL.5.html @@ -1,216 +1,117 @@ - - - - - - +Five-parameter log-logistic function — LL.5 • drc + Skip to contents -The five-parameter log-logistic function — LL.5 • drc - - - +
    +
    +
    +

    Five-parameter log-logistic function

    + Source: R/llogistic.R +
    LL.5.Rd
    +
    - - - - +
    +

    A five-parameter (generalized) log-logistic function. The function is +asymmetric when f differs from 1.

    +
    +
    +

    Usage

    + 
    LL.5(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...)
+
+l5(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...)
    +
    +
    +

    Arguments

    - - - +
    fixed
    +

    numeric vector of length 5, specifying fixed parameters +(use NA for non-fixed parameters).

    - +
    names
    +

    character vector of length 5, specifying the names of the +parameters (default: b, c, d, e, f).

    - -
    -
    - - - -
    +
    ...
    +

    additional arguments to llogistic.

    -
    -
    -
    -

    The five-parameter log-logistic function

    - - +
    +
    +

    Value

    +

    See llogistic.

    - -
    - -

    'LL.5' and 'LL2.5' provide the five-parameter log-logistic function, self starter function and names of the parameters.

    - +
    +

    Details

    +

    The five-parameter log-logistic function is given by the expression +$$f(x) = c + \frac{d-c}{(1+\exp(b(\log(x)-\log(e))))^f}$$

    +
    +
    +

    See also

    +

    LL.3, LL.4, llogistic

    +
    +
    +

    Author

    +

    Christian Ritz

    - 
    LL.5(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...)
-
-  l5(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...)
-
-  LL2.5(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...)
    - -

    Arguments

    - - - - - - - - - - - - - - -
    fixed

    numeric vector. Specifies which parameters are fixed and at what value they are fixed. NAs for parameter that are not fixed.

    names

    a vector of character strings giving the names of the parameters. The default is reasonable.

    ...

    Additional arguments (see llogistic).

    - -

    Details

    - -

    The five-parameter logistic function is given by the expression - $$ f(x) = c + \frac{d-c}{(1+\exp(b(\log(x)-\log(e))))^f}$$

    -

    or in another parameterisation - $$ f(x) = c + \frac{d-c}{(1+\exp(b(\log(x)-e)))^f}$$

    -

    The function is asymmetric for \(f\) different from 1.

    - -

    Value

    - -

    See llogistic.

    - -

    References

    - -

    Finney, D. J. (1979) Bioassay and the Practise of Statistical Inference, - Int. Statist. Rev., 47, 1--12.

    - -

    Note

    - -

    This function is for use with the function drm.

    - -

    See also

    - -

    Related functions are LL.4 and LL.3.

    - - -

    Examples

    - 
    
-ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.5())
-summary(ryegrass.m1)
    #> 
-#> Model fitted: Generalized log-logistic (ED50 as parameter) (5 parms)
-#> 
-#> Parameter estimates:
-#> 
-#>               Estimate Std. Error t-value p-value    
-#> b:(Intercept)  3.92870    2.18882  1.7949 0.08860 .  
-#> c:(Intercept)  0.32165    0.37943  0.8477 0.40715    
-#> d:(Intercept)  7.76054    0.19319 40.1706 < 2e-16 ***
-#> e:(Intercept)  2.21539    0.91883  2.4111 0.02619 *  
-#> f:(Intercept)  0.46831    0.53020  0.8833 0.38813    
-#> ---
-#> Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
-#> 
-#> Residual standard error:
-#> 
-#>  0.5270098 (19 degrees of freedom)
    
-
    -
    -
    -
  • See also
    • - -
  • Examples
    • - -

    Author

    - Christian Ritz -
    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + -
    - - - - + diff --git a/docs/reference/LL.5.md b/docs/reference/LL.5.md new file mode 100644 index 00000000..e422f7df --- /dev/null +++ b/docs/reference/LL.5.md @@ -0,0 +1,55 @@ +# Five-parameter log-logistic function + +A five-parameter (generalized) log-logistic function. The function is +asymmetric when f differs from 1. + +## Usage + +``` r +LL.5(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...) + +l5(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...) +``` + +## Arguments + +- fixed: + + numeric vector of length 5, specifying fixed parameters (use NA for + non-fixed parameters). + +- names: + + character vector of length 5, specifying the names of the parameters + (default: b, c, d, e, f). + +- ...: + + additional arguments to + [`llogistic`](https://hreinwald.github.io/drc/reference/llogistic.md). + +## Value + +See +[`llogistic`](https://hreinwald.github.io/drc/reference/llogistic.md). + +## Details + +The five-parameter log-logistic function is given by the expression +\$\$f(x) = c + \frac{d-c}{(1+\exp(b(\log(x)-\log(e))))^f}\$\$ + +## See also + +[`LL.3`](https://hreinwald.github.io/drc/reference/LL.3.md), +[`LL.4`](https://hreinwald.github.io/drc/reference/LL.4.md), +[`llogistic`](https://hreinwald.github.io/drc/reference/llogistic.md) + +## Author + +Christian Ritz + +## Examples + +``` r +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.5()) +``` diff --git a/docs/reference/LL2.2.html b/docs/reference/LL2.2.html new file mode 100644 index 00000000..c6046215 --- /dev/null +++ b/docs/reference/LL2.2.html @@ -0,0 +1,117 @@ + +Two-Parameter Log-Logistic Model with log(ED50) as Parameter — LL2.2 • drc + Skip to contents + + +
    +
    +
    +

    Two-Parameter Log-Logistic Model with log(ED50) as Parameter

    + Source: R/llogistic2.R +
    LL2.2.Rd
    +
    + +
    +

    A two-parameter log-logistic model where the lower limit is fixed at 0 and +the upper limit is fixed at a specified value (default 1). The estimated +parameters are the slope b and the log(ED50) e.

    +
    + +
    +

    Usage

    + 
    LL2.2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...)
    +
    + +
    +

    Arguments

    + + +
    upper
    +

    numeric value giving the fixed upper limit. Defaults to 1.

    + + +
    fixed
    +

    numeric vector of length 2. Specifies which parameters are +fixed and at what value. Use NA for parameters that should be +estimated.

    + + +
    names
    +

    character vector of length 2 giving the names of the +parameters b and e.

    + + +
    ...
    +

    additional arguments passed to llogistic2.

    + +
    +
    +

    Value

    +

    A list of class "llogistic" with the nonlinear function, +self-starter, and related components.

    +
    +
    +

    See also

    +

    llogistic2, LL2.3, LL2.4, +LL2.5

    +
    + +
    +

    Examples

    + 
    earthworms.m1 <- drm(number/total ~ dose, weights = total,
+  data = earthworms, fct = LL2.2(), type = "binomial")
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/LL2.2.md b/docs/reference/LL2.2.md new file mode 100644 index 00000000..37508027 --- /dev/null +++ b/docs/reference/LL2.2.md @@ -0,0 +1,51 @@ +# Two-Parameter Log-Logistic Model with log(ED50) as Parameter + +A two-parameter log-logistic model where the lower limit is fixed at 0 +and the upper limit is fixed at a specified value (default 1). The +estimated parameters are the slope `b` and the log(ED50) `e`. + +## Usage + +``` r +LL2.2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) +``` + +## Arguments + +- upper: + + numeric value giving the fixed upper limit. Defaults to 1. + +- fixed: + + numeric vector of length 2. Specifies which parameters are fixed and + at what value. Use `NA` for parameters that should be estimated. + +- names: + + character vector of length 2 giving the names of the parameters `b` + and `e`. + +- ...: + + additional arguments passed to + [`llogistic2`](https://hreinwald.github.io/drc/reference/llogistic2.md). + +## Value + +A list of class `"llogistic"` with the nonlinear function, self-starter, +and related components. + +## See also + +[`llogistic2`](https://hreinwald.github.io/drc/reference/llogistic2.md), +[`LL2.3`](https://hreinwald.github.io/drc/reference/LL2.3.md), +[`LL2.4`](https://hreinwald.github.io/drc/reference/LL2.4.md), +[`LL2.5`](https://hreinwald.github.io/drc/reference/LL2.5.md) + +## Examples + +``` r +earthworms.m1 <- drm(number/total ~ dose, weights = total, + data = earthworms, fct = LL2.2(), type = "binomial") +``` diff --git a/docs/reference/LL2.3.html b/docs/reference/LL2.3.html new file mode 100644 index 00000000..022ea9f6 --- /dev/null +++ b/docs/reference/LL2.3.html @@ -0,0 +1,111 @@ + +Three-Parameter Log-Logistic Model with log(ED50) and Lower Limit at 0 — LL2.3 • drc + Skip to contents + + +
    +
    +
    +

    Three-Parameter Log-Logistic Model with log(ED50) and Lower Limit at 0

    + Source: R/llogistic2.R +
    LL2.3.Rd
    +
    + +
    +

    A three-parameter log-logistic model where the lower limit is fixed at 0. +The estimated parameters are the slope b, the upper limit d, +and the log(ED50) e.

    +
    + +
    +

    Usage

    + 
    LL2.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector of length 3. Specifies which parameters are +fixed and at what value. Use NA for parameters that should be +estimated.

    + + +
    names
    +

    character vector of length 3 giving the names of the +parameters b, d, and e.

    + + +
    ...
    +

    additional arguments passed to llogistic2.

    + +
    +
    +

    Value

    +

    A list of class "llogistic" with the nonlinear function, +self-starter, and related components.

    +
    +
    +

    See also

    +

    llogistic2, LL2.2, LL2.4

    +
    + +
    +

    Examples

    + 
    ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL2.3())
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/LL2.3.md b/docs/reference/LL2.3.md new file mode 100644 index 00000000..db61df3d --- /dev/null +++ b/docs/reference/LL2.3.md @@ -0,0 +1,45 @@ +# Three-Parameter Log-Logistic Model with log(ED50) and Lower Limit at 0 + +A three-parameter log-logistic model where the lower limit is fixed at +0. The estimated parameters are the slope `b`, the upper limit `d`, and +the log(ED50) `e`. + +## Usage + +``` r +LL2.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) +``` + +## Arguments + +- fixed: + + numeric vector of length 3. Specifies which parameters are fixed and + at what value. Use `NA` for parameters that should be estimated. + +- names: + + character vector of length 3 giving the names of the parameters `b`, + `d`, and `e`. + +- ...: + + additional arguments passed to + [`llogistic2`](https://hreinwald.github.io/drc/reference/llogistic2.md). + +## Value + +A list of class `"llogistic"` with the nonlinear function, self-starter, +and related components. + +## See also + +[`llogistic2`](https://hreinwald.github.io/drc/reference/llogistic2.md), +[`LL2.2`](https://hreinwald.github.io/drc/reference/LL2.2.md), +[`LL2.4`](https://hreinwald.github.io/drc/reference/LL2.4.md) + +## Examples + +``` r +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL2.3()) +``` diff --git a/docs/reference/LL2.3u.html b/docs/reference/LL2.3u.html new file mode 100644 index 00000000..bf19af35 --- /dev/null +++ b/docs/reference/LL2.3u.html @@ -0,0 +1,109 @@ + +Three-Parameter Log-Logistic Model with log(ED50) and Fixed Upper Limit — LL2.3u • drc + Skip to contents + + +
    +
    +
    +

    Three-Parameter Log-Logistic Model with log(ED50) and Fixed Upper Limit

    + Source: R/llogistic2.R +
    LL2.3u.Rd
    +
    + +
    +

    A three-parameter log-logistic model where the upper limit is fixed at a +specified value (default 1). The estimated parameters are the slope b, +the lower limit c, and the log(ED50) e.

    +
    + +
    +

    Usage

    + 
    LL2.3u(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...)
    +
    + +
    +

    Arguments

    + + +
    upper
    +

    numeric value giving the fixed upper limit. Defaults to 1.

    + + +
    fixed
    +

    numeric vector of length 3. Specifies which parameters are +fixed and at what value. Use NA for parameters that should be +estimated.

    + + +
    names
    +

    character vector of length 3 giving the names of the +parameters b, c, and e.

    + + +
    ...
    +

    additional arguments passed to llogistic2.

    + +
    +
    +

    Value

    +

    A list of class "llogistic" with the nonlinear function, +self-starter, and related components.

    +
    +
    +

    See also

    +

    llogistic2, LL2.2, LL2.3

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/LL2.3u.md b/docs/reference/LL2.3u.md new file mode 100644 index 00000000..a67c199b --- /dev/null +++ b/docs/reference/LL2.3u.md @@ -0,0 +1,43 @@ +# Three-Parameter Log-Logistic Model with log(ED50) and Fixed Upper Limit + +A three-parameter log-logistic model where the upper limit is fixed at a +specified value (default 1). The estimated parameters are the slope `b`, +the lower limit `c`, and the log(ED50) `e`. + +## Usage + +``` r +LL2.3u(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...) +``` + +## Arguments + +- upper: + + numeric value giving the fixed upper limit. Defaults to 1. + +- fixed: + + numeric vector of length 3. Specifies which parameters are fixed and + at what value. Use `NA` for parameters that should be estimated. + +- names: + + character vector of length 3 giving the names of the parameters `b`, + `c`, and `e`. + +- ...: + + additional arguments passed to + [`llogistic2`](https://hreinwald.github.io/drc/reference/llogistic2.md). + +## Value + +A list of class `"llogistic"` with the nonlinear function, self-starter, +and related components. + +## See also + +[`llogistic2`](https://hreinwald.github.io/drc/reference/llogistic2.md), +[`LL2.2`](https://hreinwald.github.io/drc/reference/LL2.2.md), +[`LL2.3`](https://hreinwald.github.io/drc/reference/LL2.3.md) diff --git a/docs/reference/LL2.4.html b/docs/reference/LL2.4.html new file mode 100644 index 00000000..efddddd6 --- /dev/null +++ b/docs/reference/LL2.4.html @@ -0,0 +1,114 @@ + +Four-Parameter Log-Logistic Model with log(ED50) as Parameter — LL2.4 • drc + Skip to contents + + +
    +
    +
    +

    Four-Parameter Log-Logistic Model with log(ED50) as Parameter

    + Source: R/llogistic2.R +
    LL2.4.Rd
    +
    + +
    +

    A four-parameter log-logistic model where the ED50 is parameterised on the +log scale. The asymmetry parameter f is fixed at 1. The estimated +parameters are the slope b, the lower limit c, the upper +limit d, and the log(ED50) e.

    +
    + +
    +

    Usage

    + 
    LL2.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector of length 4. Specifies which parameters are +fixed and at what value. Use NA for parameters that should be +estimated.

    + + +
    names
    +

    character vector of length 4 giving the names of the +parameters b, c, d, and e.

    + + +
    ...
    +

    additional arguments passed to llogistic2.

    + +
    +
    +

    Value

    +

    A list of class "llogistic" with the nonlinear function, +self-starter, and related components.

    +
    +
    +

    See also

    +

    llogistic2, LL2.3, LL2.5

    +
    + +
    +

    Examples

    + 
    spinach.m1 <- drm(SLOPE ~ DOSE, CURVE, data = spinach, fct = LL2.4())
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/LL2.4.md b/docs/reference/LL2.4.md new file mode 100644 index 00000000..2b772f68 --- /dev/null +++ b/docs/reference/LL2.4.md @@ -0,0 +1,46 @@ +# Four-Parameter Log-Logistic Model with log(ED50) as Parameter + +A four-parameter log-logistic model where the ED50 is parameterised on +the log scale. The asymmetry parameter `f` is fixed at 1. The estimated +parameters are the slope `b`, the lower limit `c`, the upper limit `d`, +and the log(ED50) `e`. + +## Usage + +``` r +LL2.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) +``` + +## Arguments + +- fixed: + + numeric vector of length 4. Specifies which parameters are fixed and + at what value. Use `NA` for parameters that should be estimated. + +- names: + + character vector of length 4 giving the names of the parameters `b`, + `c`, `d`, and `e`. + +- ...: + + additional arguments passed to + [`llogistic2`](https://hreinwald.github.io/drc/reference/llogistic2.md). + +## Value + +A list of class `"llogistic"` with the nonlinear function, self-starter, +and related components. + +## See also + +[`llogistic2`](https://hreinwald.github.io/drc/reference/llogistic2.md), +[`LL2.3`](https://hreinwald.github.io/drc/reference/LL2.3.md), +[`LL2.5`](https://hreinwald.github.io/drc/reference/LL2.5.md) + +## Examples + +``` r +spinach.m1 <- drm(SLOPE ~ DOSE, CURVE, data = spinach, fct = LL2.4()) +``` diff --git a/docs/reference/LL2.5.html b/docs/reference/LL2.5.html new file mode 100644 index 00000000..83d010ad --- /dev/null +++ b/docs/reference/LL2.5.html @@ -0,0 +1,111 @@ + +Five-Parameter Generalised Log-Logistic Model with log(ED50) as Parameter — LL2.5 • drc + Skip to contents + + +
    +
    +
    +

    Five-Parameter Generalised Log-Logistic Model with log(ED50) as Parameter

    + Source: R/llogistic2.R +
    LL2.5.Rd
    +
    + +
    +

    A five-parameter generalised log-logistic model where the ED50 is +parameterised on the log scale. All five parameters (b, c, +d, e, f) are estimated.

    +
    + +
    +

    Usage

    + 
    LL2.5(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector of length 5. Specifies which parameters are +fixed and at what value. Use NA for parameters that should be +estimated.

    + + +
    names
    +

    character vector of length 5 giving the names of the +parameters b, c, d, e, and f.

    + + +
    ...
    +

    additional arguments passed to llogistic2.

    + +
    +
    +

    Value

    +

    A list of class "llogistic" with the nonlinear function, +self-starter, and related components.

    +
    +
    +

    See also

    +

    llogistic2, LL2.3, LL2.4

    +
    + +
    +

    Examples

    + 
    ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL2.5())
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/LL2.5.md b/docs/reference/LL2.5.md new file mode 100644 index 00000000..bdb9fe7f --- /dev/null +++ b/docs/reference/LL2.5.md @@ -0,0 +1,45 @@ +# Five-Parameter Generalised Log-Logistic Model with log(ED50) as Parameter + +A five-parameter generalised log-logistic model where the ED50 is +parameterised on the log scale. All five parameters (`b`, `c`, `d`, `e`, +`f`) are estimated. + +## Usage + +``` r +LL2.5(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...) +``` + +## Arguments + +- fixed: + + numeric vector of length 5. Specifies which parameters are fixed and + at what value. Use `NA` for parameters that should be estimated. + +- names: + + character vector of length 5 giving the names of the parameters `b`, + `c`, `d`, `e`, and `f`. + +- ...: + + additional arguments passed to + [`llogistic2`](https://hreinwald.github.io/drc/reference/llogistic2.md). + +## Value + +A list of class `"llogistic"` with the nonlinear function, self-starter, +and related components. + +## See also + +[`llogistic2`](https://hreinwald.github.io/drc/reference/llogistic2.md), +[`LL2.3`](https://hreinwald.github.io/drc/reference/LL2.3.md), +[`LL2.4`](https://hreinwald.github.io/drc/reference/LL2.4.md) + +## Examples + +``` r +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL2.5()) +``` diff --git a/docs/reference/LN.2.html b/docs/reference/LN.2.html new file mode 100644 index 00000000..09e52d42 --- /dev/null +++ b/docs/reference/LN.2.html @@ -0,0 +1,102 @@ + +Two-parameter log-normal dose-response model — LN.2 • drc + Skip to contents + + +
    +
    +
    +

    Two-parameter log-normal dose-response model

    + Source: R/lnormal.R +
    LN.2.Rd
    +
    + +
    +

    LN.2 is a convenience function for the log-normal model with lower limit fixed at 0 +and upper limit fixed (default 1), corresponding to the classic probit model.

    +
    + +
    +

    Usage

    + 
    LN.2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...)
    +
    + +
    +

    Arguments

    + + +
    upper
    +

    numeric specifying the fixed upper horizontal asymptote. Default is 1.

    + + +
    fixed
    +

    numeric vector of length 2 specifying fixed parameters (NAs for free parameters).

    + + +
    names
    +

    character vector of parameter names.

    + + +
    ...
    +

    additional arguments passed to lnormal.

    + +
    +
    +

    Value

    +

    A list (see lnormal).

    +
    +
    +

    See also

    +

    lnormal, LN.3, LN.4

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/LN.2.md b/docs/reference/LN.2.md new file mode 100644 index 00000000..27aa9c55 --- /dev/null +++ b/docs/reference/LN.2.md @@ -0,0 +1,42 @@ +# Two-parameter log-normal dose-response model + +`LN.2` is a convenience function for the log-normal model with lower +limit fixed at 0 and upper limit fixed (default 1), corresponding to the +classic probit model. + +## Usage + +``` r +LN.2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) +``` + +## Arguments + +- upper: + + numeric specifying the fixed upper horizontal asymptote. Default is 1. + +- fixed: + + numeric vector of length 2 specifying fixed parameters (NAs for free + parameters). + +- names: + + character vector of parameter names. + +- ...: + + additional arguments passed to + [`lnormal`](https://hreinwald.github.io/drc/reference/lnormal.md). + +## Value + +A list (see +[`lnormal`](https://hreinwald.github.io/drc/reference/lnormal.md)). + +## See also + +[`lnormal`](https://hreinwald.github.io/drc/reference/lnormal.md), +[`LN.3`](https://hreinwald.github.io/drc/reference/LN.3.md), +[`LN.4`](https://hreinwald.github.io/drc/reference/LN.4.md) diff --git a/docs/reference/LN.3.html b/docs/reference/LN.3.html new file mode 100644 index 00000000..956bec50 --- /dev/null +++ b/docs/reference/LN.3.html @@ -0,0 +1,95 @@ + +Three-parameter log-normal dose-response model — LN.3 • drc + Skip to contents + + +
    +
    +
    +

    Three-parameter log-normal dose-response model

    + Source: R/lnormal.R +
    LN.3.Rd
    +
    + +
    +

    LN.3 is a convenience function for the log-normal model with the lower limit fixed at 0.

    +
    + +
    +

    Usage

    + 
    LN.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector of length 3 specifying fixed parameters (NAs for free parameters).

    + + +
    names
    +

    character vector of parameter names.

    + + +
    ...
    +

    additional arguments passed to lnormal.

    + +
    +
    +

    Value

    +

    A list (see lnormal).

    +
    +
    +

    See also

    +

    lnormal, LN.2, LN.4

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/LN.3.md b/docs/reference/LN.3.md new file mode 100644 index 00000000..2748ffdb --- /dev/null +++ b/docs/reference/LN.3.md @@ -0,0 +1,37 @@ +# Three-parameter log-normal dose-response model + +`LN.3` is a convenience function for the log-normal model with the lower +limit fixed at 0. + +## Usage + +``` r +LN.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) +``` + +## Arguments + +- fixed: + + numeric vector of length 3 specifying fixed parameters (NAs for free + parameters). + +- names: + + character vector of parameter names. + +- ...: + + additional arguments passed to + [`lnormal`](https://hreinwald.github.io/drc/reference/lnormal.md). + +## Value + +A list (see +[`lnormal`](https://hreinwald.github.io/drc/reference/lnormal.md)). + +## See also + +[`lnormal`](https://hreinwald.github.io/drc/reference/lnormal.md), +[`LN.2`](https://hreinwald.github.io/drc/reference/LN.2.md), +[`LN.4`](https://hreinwald.github.io/drc/reference/LN.4.md) diff --git a/docs/reference/LN.3u.html b/docs/reference/LN.3u.html new file mode 100644 index 00000000..9e71717e --- /dev/null +++ b/docs/reference/LN.3u.html @@ -0,0 +1,99 @@ + +Three-parameter log-normal model with upper limit fixed — LN.3u • drc + Skip to contents + + +
    +
    +
    +

    Three-parameter log-normal model with upper limit fixed

    + Source: R/lnormal.R +
    LN.3u.Rd
    +
    + +
    +

    LN.3u is a convenience function for the log-normal model with the upper limit fixed (default 1).

    +
    + +
    +

    Usage

    + 
    LN.3u(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...)
    +
    + +
    +

    Arguments

    + + +
    upper
    +

    numeric specifying the fixed upper horizontal asymptote. Default is 1.

    + + +
    fixed
    +

    numeric vector of length 3 specifying fixed parameters (NAs for free parameters).

    + + +
    names
    +

    character vector of parameter names.

    + + +
    ...
    +

    additional arguments passed to lnormal.

    + +
    +
    +

    Value

    +

    A list (see lnormal).

    +
    +
    +

    See also

    +

    lnormal, LN.2, LN.3, LN.4

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/LN.3u.md b/docs/reference/LN.3u.md new file mode 100644 index 00000000..1d7d5537 --- /dev/null +++ b/docs/reference/LN.3u.md @@ -0,0 +1,42 @@ +# Three-parameter log-normal model with upper limit fixed + +`LN.3u` is a convenience function for the log-normal model with the +upper limit fixed (default 1). + +## Usage + +``` r +LN.3u(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...) +``` + +## Arguments + +- upper: + + numeric specifying the fixed upper horizontal asymptote. Default is 1. + +- fixed: + + numeric vector of length 3 specifying fixed parameters (NAs for free + parameters). + +- names: + + character vector of parameter names. + +- ...: + + additional arguments passed to + [`lnormal`](https://hreinwald.github.io/drc/reference/lnormal.md). + +## Value + +A list (see +[`lnormal`](https://hreinwald.github.io/drc/reference/lnormal.md)). + +## See also + +[`lnormal`](https://hreinwald.github.io/drc/reference/lnormal.md), +[`LN.2`](https://hreinwald.github.io/drc/reference/LN.2.md), +[`LN.3`](https://hreinwald.github.io/drc/reference/LN.3.md), +[`LN.4`](https://hreinwald.github.io/drc/reference/LN.4.md) diff --git a/docs/reference/LN.4.html b/docs/reference/LN.4.html new file mode 100644 index 00000000..50189556 --- /dev/null +++ b/docs/reference/LN.4.html @@ -0,0 +1,95 @@ + +Four-parameter log-normal dose-response model — LN.4 • drc + Skip to contents + + +
    +
    +
    +

    Four-parameter log-normal dose-response model

    + Source: R/lnormal.R +
    LN.4.Rd
    +
    + +
    +

    LN.4 is a convenience function for the full four-parameter log-normal model.

    +
    + +
    +

    Usage

    + 
    LN.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector of length 4 specifying fixed parameters (NAs for free parameters).

    + + +
    names
    +

    character vector of parameter names.

    + + +
    ...
    +

    additional arguments passed to lnormal.

    + +
    +
    +

    Value

    +

    A list (see lnormal).

    +
    +
    +

    See also

    +

    lnormal, LN.2, LN.3

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/LN.4.md b/docs/reference/LN.4.md new file mode 100644 index 00000000..d37cf0da --- /dev/null +++ b/docs/reference/LN.4.md @@ -0,0 +1,37 @@ +# Four-parameter log-normal dose-response model + +`LN.4` is a convenience function for the full four-parameter log-normal +model. + +## Usage + +``` r +LN.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) +``` + +## Arguments + +- fixed: + + numeric vector of length 4 specifying fixed parameters (NAs for free + parameters). + +- names: + + character vector of parameter names. + +- ...: + + additional arguments passed to + [`lnormal`](https://hreinwald.github.io/drc/reference/lnormal.md). + +## Value + +A list (see +[`lnormal`](https://hreinwald.github.io/drc/reference/lnormal.md)). + +## See also + +[`lnormal`](https://hreinwald.github.io/drc/reference/lnormal.md), +[`LN.2`](https://hreinwald.github.io/drc/reference/LN.2.md), +[`LN.3`](https://hreinwald.github.io/drc/reference/LN.3.md) diff --git a/docs/reference/M.bahia-1.png b/docs/reference/M.bahia-1.png new file mode 100644 index 00000000..a42b2cf1 Binary files /dev/null and b/docs/reference/M.bahia-1.png differ diff --git a/docs/reference/M.bahia-2.png b/docs/reference/M.bahia-2.png new file mode 100644 index 00000000..7d048114 Binary files /dev/null and b/docs/reference/M.bahia-2.png differ diff --git a/docs/reference/M.bahia-3.png b/docs/reference/M.bahia-3.png new file mode 100644 index 00000000..4c068aaf Binary files /dev/null and b/docs/reference/M.bahia-3.png differ diff --git a/docs/reference/M.bahia-4.png b/docs/reference/M.bahia-4.png new file mode 100644 index 00000000..ea1ce951 Binary files /dev/null and b/docs/reference/M.bahia-4.png differ diff --git a/docs/reference/M.bahia-5.png b/docs/reference/M.bahia-5.png new file mode 100644 index 00000000..3918d32e Binary files /dev/null and b/docs/reference/M.bahia-5.png differ diff --git a/docs/reference/M.bahia.html b/docs/reference/M.bahia.html new file mode 100644 index 00000000..519f3b93 --- /dev/null +++ b/docs/reference/M.bahia.html @@ -0,0 +1,168 @@ + +Effect of an effluent on the growth of mysid shrimp — M.bahia • drc + Skip to contents + + +
    +
    +
    +

    Effect of an effluent on the growth of mysid shrimp

    + +
    M.bahia.Rd
    +
    + +
    +

    Juvenile mysid shrimp (Mysidopsis bahia) were exposed to up to 32% effluent + in a 7-day survival and growth test. The average weight per treatment replicate of + surviving organisms was measured.

    +
    + +
    +

    Usage

    + 
    data(M.bahia)
    +
    + +
    +

    Format

    +

    A data frame with 40 observations on the following 2 variables.

    conc
    +

    a numeric vector of effluent concentrations (%)

    + +
    dryweight
    +

    a numeric vector of average dry weights (mg)

    + + +
    +
    +

    Details

    +

    The data are analysed in Bruce and Versteeg (1992) using a log-normal + dose-response model (using the logarithm with base 10).

    +

    At 32% there was complete mortality, and this justifies using a model where a lower asymptote + of 0 is assumed.

    +
    +
    +

    Source

    +

    Bruce, R. D. and Versteeg, D. J. (1992) A statistical procedure for modeling continuous toxicity data, + Environ. Toxicol. Chem., 11, 1485–1494.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+M.bahia.m1 <- drm(dryweight~conc, data=M.bahia, fct=LN.3())
+
+## Variation increasing
+plot(fitted(M.bahia.m1), residuals(M.bahia.m1))
+
+
+## Using transform-both-sides approach
+M.bahia.m2 <- boxcox(M.bahia.m1, method = "anova")
+
+summary(M.bahia.m2)  # logarithm transformation
+#> 
+#> Model fitted: Log-normal with lower limit at 0 (3 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                Estimate Std. Error t-value   p-value    
+#> b:(Intercept) -0.444809   0.056065 -7.9338 1.679e-09 ***
+#> d:(Intercept)  0.671979   0.043185 15.5603 < 2.2e-16 ***
+#> e:(Intercept)  3.905716   0.883294  4.4218 8.278e-05 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.2271316 (37 degrees of freedom)
+#> 
+#> Non-normality/heterogeneity adjustment through Box-Cox transformation
+#> 
+#> Estimated lambda: -0.182 
+#> Confidence interval for lambda: [-0.697, 0.371] 
+#> 
+
+## Variation roughly constant, but still not a great fit
+plot(fitted(M.bahia.m2), residuals(M.bahia.m2))
+
+
+## Visual comparison of fits
+plot(M.bahia.m1, type="all", broken=TRUE)
+plot(M.bahia.m2, add=TRUE, type="none", broken=TRUE, lty=2)
+
+
+ED(M.bahia.m2, c(10,20,50), ci="fls")
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error
+#> e:10  0.21900    0.11667
+#> e:20  0.58881    0.24576
+#> e:50  3.90572    0.88329
+
+## A better fit
+M.bahia.m3 <- boxcox(update(M.bahia.m1, fct = LN.4()), method = "anova")
+#plot(fitted(M.bahia.m3), residuals(M.bahia.m3))
+plot(M.bahia.m3, add=TRUE, type="none", broken=TRUE, lty=3, col=2)
+
+ED(M.bahia.m3, c(10,20,50), ci="fls")
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error
+#> e:10  0.95677    0.18697
+#> e:20  1.17193    0.19303
+#> e:50  1.72756    0.19818
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/M.bahia.md b/docs/reference/M.bahia.md new file mode 100644 index 00000000..65aef077 --- /dev/null +++ b/docs/reference/M.bahia.md @@ -0,0 +1,107 @@ +# Effect of an effluent on the growth of mysid shrimp + +Juvenile mysid shrimp (*Mysidopsis bahia*) were exposed to up to 32% +effluent in a 7-day survival and growth test. The average weight per +treatment replicate of surviving organisms was measured. + +## Usage + +``` r +data(M.bahia) +``` + +## Format + +A data frame with 40 observations on the following 2 variables. + +- `conc`: + + a numeric vector of effluent concentrations (%) + +- `dryweight`: + + a numeric vector of average dry weights (mg) + +## Details + +The data are analysed in Bruce and Versteeg (1992) using a log-normal +dose-response model (using the logarithm with base 10). + +At 32% there was complete mortality, and this justifies using a model +where a lower asymptote of 0 is assumed. + +## Source + +Bruce, R. D. and Versteeg, D. J. (1992) A statistical procedure for +modeling continuous toxicity data, *Environ. Toxicol. Chem.*, **11**, +1485–1494. + +## Examples + +``` r +library(drc) + +M.bahia.m1 <- drm(dryweight~conc, data=M.bahia, fct=LN.3()) + +## Variation increasing +plot(fitted(M.bahia.m1), residuals(M.bahia.m1)) + + +## Using transform-both-sides approach +M.bahia.m2 <- boxcox(M.bahia.m1, method = "anova") + +summary(M.bahia.m2) # logarithm transformation +#> +#> Model fitted: Log-normal with lower limit at 0 (3 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) -0.444809 0.056065 -7.9338 1.679e-09 *** +#> d:(Intercept) 0.671979 0.043185 15.5603 < 2.2e-16 *** +#> e:(Intercept) 3.905716 0.883294 4.4218 8.278e-05 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.2271316 (37 degrees of freedom) +#> +#> Non-normality/heterogeneity adjustment through Box-Cox transformation +#> +#> Estimated lambda: -0.182 +#> Confidence interval for lambda: [-0.697, 0.371] +#> + +## Variation roughly constant, but still not a great fit +plot(fitted(M.bahia.m2), residuals(M.bahia.m2)) + + +## Visual comparison of fits +plot(M.bahia.m1, type="all", broken=TRUE) +plot(M.bahia.m2, add=TRUE, type="none", broken=TRUE, lty=2) + + +ED(M.bahia.m2, c(10,20,50), ci="fls") +#> +#> Estimated effective doses +#> +#> Estimate Std. Error +#> e:10 0.21900 0.11667 +#> e:20 0.58881 0.24576 +#> e:50 3.90572 0.88329 + +## A better fit +M.bahia.m3 <- boxcox(update(M.bahia.m1, fct = LN.4()), method = "anova") +#plot(fitted(M.bahia.m3), residuals(M.bahia.m3)) +plot(M.bahia.m3, add=TRUE, type="none", broken=TRUE, lty=3, col=2) + +ED(M.bahia.m3, c(10,20,50), ci="fls") +#> +#> Estimated effective doses +#> +#> Estimate Std. Error +#> e:10 0.95677 0.18697 +#> e:20 1.17193 0.19303 +#> e:50 1.72756 0.19818 +``` diff --git a/docs/reference/MAX.html b/docs/reference/MAX.html index 2fa3f69c..ad3523ba 100644 --- a/docs/reference/MAX.html +++ b/docs/reference/MAX.html @@ -1,193 +1,180 @@ - - - - - - +Maximum mean response — MAX • drc + Skip to contents + + +
    +
    +
    +

    Maximum mean response

    + Source: R/max.R +
    MAX.Rd
    +
    - - +
    +

    Estimates the maximum mean response and the dose at which it occurs, using a +bisection method to locate the peak of the fitted dose-response curve. This +function is only implemented for the built-in model functions of class +braincousens and cedergreen, which are capable of +exhibiting hormesis (i.e., a non-monotone response with a stimulatory effect +at low doses).

    +
    - - +
    +

    Usage

    + 
    MAX(object, lower = 0.001, upper = 1000, pool = TRUE)
    +
    - - +
    +

    Arguments

    - - - +
    object
    +

    an object of class drc, fitted using drm +with a hormesis model such as CRS.4c or BC.4.

    - +
    lower
    +

    numeric. Lower bound of the interval used by the bisection +method to search for the dose at maximum response. Must be strictly smaller +than upper and should be set below the expected dose at maximum +response. Defaults to 1e-3.

    - - +
    upper
    +

    numeric. Upper bound of the interval used by the bisection +method to search for the dose at maximum response. Must be strictly larger +than lower and should be set above the expected dose at maximum +response. Defaults to 1000.

    - - +
    pool
    +

    logical. If TRUE (default), curves are pooled when +computing the variance-covariance matrix. Otherwise they are not. This +argument only works for models with independently fitted curves as +specified in drm. Note: currently the variance-covariance +matrix is retrieved for internal consistency but standard errors are not +yet reported in the output.

    - +
    +
    +

    Value

    +

    Invisibly returns a numeric matrix with one row per curve in the +data set and two columns:

    Dose
    +

    The dose at which the maximum mean response occurs, found +via bisection within [lower, upper].

    +
    Response
    +

    The estimated maximum mean response at that dose.

    - - -
    -
    -

    Row names correspond to curve identifiers. If the computation fails for a +given curve, the corresponding row will contain NA values and a +warning is issued. The matrix is also printed to the console via +printCoefmat.

    - - -
    -
    - - - - -
    -
    -
    -

    Maximum mean response

    - - +
    +

    Details

    +

    The function numerically locates the dose \(d^*\) that maximises the fitted +dose-response curve over the search interval [lower, upper]: +$$d^* = \arg\max_{d} f(d, \hat{\theta})$$ +where \(f\) is the fitted dose-response function and \(\hat{\theta}\) is +the vector of estimated parameters. The search is performed using a bisection +approach defined internally by the model's maxfct component.

    +

    It is the user's responsibility to ensure that the true maximum lies within +[lower, upper]. If the maximum falls outside this interval, the +function will silently return a boundary value and a warning is issued.

    +
    +
    +

    References

    +

    Cedergreen, N., Ritz, C., and Streibig, J. C. (2005) Improved empirical +models describing hormesis, Environmental Toxicology and Chemistry +24, 3166–3172.

    +
    +
    +

    Author

    +

    Christian Ritz. Issues fixed and documentation enhanced by Hannes Reinwald.

    -
    - -

    MAX estimates the maximum mean response and the dose at which it occurs.

    - +
    +

    Examples

    + 
    ## Fitting a Cedergreen-Ritz-Streibig model
+lettuce.m1 <- drm(weight ~ conc, data = lettuce, fct = CRS.4c())
+
+## Finding the maximum mean response and the corresponding dose
+MAX(lettuce.m1)
+#>     Dose Response
+#> 1 0.2546   1.1787
+
+## Custom search interval
+MAX(lettuce.m1, lower = 1e-5, upper = 500)
+#>      Dose Response
+#> 1 0.25461   1.1787
+
+## Capture the result matrix
+result <- MAX(lettuce.m1)
+#>     Dose Response
+#> 1 0.2546   1.1787
+result["Dose"]
+#> [1] NA
+
+
    +
    - 
    MAX(object, lower = 1e-3, upper = 1000, pool = TRUE)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - -
    object

    an object of class 'drc'.

    lower

    numeric. Lower limit for bisection method. Need to be smaller than EDx level to be calculated.

    upper

    numeric. Upper limit for bisection method. Need to be larger than EDx level to be calculated.

    pool

    logical. If TRUE curves are pooled. Otherwise they are not. This argument only works for models with - independently fitted curves as specified in drm.

    - -

    Details

    - -

    This function is only implemented for the built-in functions of class braincousens and - cedergreen.

    -

    This function was used for obtaining the results on hormesis effect size reported in Cedergreen et al. (2005).

    - -

    Value

    - -

    A matrix with one row per curve in the data set and two columns: - one containing the dose at which the maximum occurs - and one containing the corresponding maximum response.

    - -

    References

    - -

    Cedergreen, N. and Ritz, C. and Streibig, J. C. (2005) Improved empirical models describing hormesis, - Environmental Toxicology and Chemistry 24, 3166--3172.

    - - -

    Examples

    - 
    
-## Fitting a Cedergreen-Ritz-Streibig model
-lettuce.m1 <- drm(weight~conc, data = lettuce, fct = CRS.4c())
-
-## Finding maximum average response and the corrresponding dose
-MAX(lettuce.m1)
    #>      Dose Response
-#> 1 0.25741   1.1771
    
-
    -
    - -
    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -

    Site built with pkgdown.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -
    +
    + + + - - - + diff --git a/docs/reference/MAX.md b/docs/reference/MAX.md new file mode 100644 index 00000000..7771968a --- /dev/null +++ b/docs/reference/MAX.md @@ -0,0 +1,117 @@ +# Maximum mean response + +Estimates the maximum mean response and the dose at which it occurs, +using a bisection method to locate the peak of the fitted dose-response +curve. This function is only implemented for the built-in model +functions of class +[`braincousens`](https://hreinwald.github.io/drc/reference/braincousens.md) +and +[`cedergreen`](https://hreinwald.github.io/drc/reference/cedergreen.md), +which are capable of exhibiting hormesis (i.e., a non-monotone response +with a stimulatory effect at low doses). + +## Usage + +``` r +MAX(object, lower = 0.001, upper = 1000, pool = TRUE) +``` + +## Arguments + +- object: + + an object of class `drc`, fitted using + [`drm`](https://hreinwald.github.io/drc/reference/drm.md) with a + hormesis model such as + [`CRS.4c`](https://hreinwald.github.io/drc/reference/CRS.4c.md) or + [`BC.4`](https://hreinwald.github.io/drc/reference/BC.4.md). + +- lower: + + numeric. Lower bound of the interval used by the bisection method to + search for the dose at maximum response. Must be strictly smaller than + `upper` and should be set below the expected dose at maximum response. + Defaults to `1e-3`. + +- upper: + + numeric. Upper bound of the interval used by the bisection method to + search for the dose at maximum response. Must be strictly larger than + `lower` and should be set above the expected dose at maximum response. + Defaults to `1000`. + +- pool: + + logical. If `TRUE` (default), curves are pooled when computing the + variance-covariance matrix. Otherwise they are not. This argument only + works for models with independently fitted curves as specified in + [`drm`](https://hreinwald.github.io/drc/reference/drm.md). Note: + currently the variance-covariance matrix is retrieved for internal + consistency but standard errors are not yet reported in the output. + +## Value + +Invisibly returns a numeric matrix with one row per curve in the data +set and two columns: + +- Dose: + + The dose at which the maximum mean response occurs, found via + bisection within `[lower, upper]`. + +- Response: + + The estimated maximum mean response at that dose. + +Row names correspond to curve identifiers. If the computation fails for +a given curve, the corresponding row will contain `NA` values and a +warning is issued. The matrix is also printed to the console via +[`printCoefmat`](https://rdrr.io/r/stats/printCoefmat.html). + +## Details + +The function numerically locates the dose \\d^\*\\ that maximises the +fitted dose-response curve over the search interval `[lower, upper]`: +\$\$d^\* = \arg\max\_{d} f(d, \hat{\theta})\$\$ where \\f\\ is the +fitted dose-response function and \\\hat{\theta}\\ is the vector of +estimated parameters. The search is performed using a bisection approach +defined internally by the model's `maxfct` component. + +It is the user's responsibility to ensure that the true maximum lies +within `[lower, upper]`. If the maximum falls outside this interval, the +function will silently return a boundary value and a warning is issued. + +## References + +Cedergreen, N., Ritz, C., and Streibig, J. C. (2005) Improved empirical +models describing hormesis, *Environmental Toxicology and Chemistry* +**24**, 3166–3172. + +## Author + +Christian Ritz. Issues fixed and documentation enhanced by Hannes +Reinwald. + +## Examples + +``` r +## Fitting a Cedergreen-Ritz-Streibig model +lettuce.m1 <- drm(weight ~ conc, data = lettuce, fct = CRS.4c()) + +## Finding the maximum mean response and the corresponding dose +MAX(lettuce.m1) +#> Dose Response +#> 1 0.2546 1.1787 + +## Custom search interval +MAX(lettuce.m1, lower = 1e-5, upper = 500) +#> Dose Response +#> 1 0.25461 1.1787 + +## Capture the result matrix +result <- MAX(lettuce.m1) +#> Dose Response +#> 1 0.2546 1.1787 +result["Dose"] +#> [1] NA +``` diff --git a/docs/reference/MM-1.png b/docs/reference/MM-1.png deleted file mode 100644 index b29f6ce2..00000000 Binary files a/docs/reference/MM-1.png and /dev/null differ diff --git a/docs/reference/MM.2.html b/docs/reference/MM.2.html new file mode 100644 index 00000000..71db4c95 --- /dev/null +++ b/docs/reference/MM.2.html @@ -0,0 +1,117 @@ + +Two-parameter Michaelis-Menten function — MM.2 • drc + Skip to contents + + +
    +
    +
    +

    Two-parameter Michaelis-Menten function

    + Source: R/llogistic.R +
    MM.2.Rd
    +
    + +
    +

    A two-parameter Michaelis-Menten function where b is fixed at -1, c at 0, +and f at 1. Commonly used for enzyme kinetics and weed density studies.

    +
    + +
    +

    Usage

    + 
    MM.2(fixed = c(NA, NA), names = c("d", "e"), ...)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector of length 2, specifying fixed parameters +(use NA for non-fixed parameters).

    + + +
    names
    +

    character vector of length 2, specifying the names of the +parameters (default: d, e).

    + + +
    ...
    +

    additional arguments to llogistic.

    + +
    +
    +

    Value

    +

    See llogistic.

    +
    +
    +

    Details

    +

    The two-parameter Michaelis-Menten function is +$$f(x) = \frac{d \cdot x}{e + x}$$ +which is equivalent to \(d/(1+(e/x))\).

    +
    +
    +

    See also

    +

    MM.3, AR.2, AR.3

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    + +
    +

    Examples

    + 
    met.mm.m1 <- drm(gain~dose, product, data = methionine, fct = MM.2())
+#> Control measurements detected for level: control
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/MM.2.md b/docs/reference/MM.2.md new file mode 100644 index 00000000..3bab354f --- /dev/null +++ b/docs/reference/MM.2.md @@ -0,0 +1,55 @@ +# Two-parameter Michaelis-Menten function + +A two-parameter Michaelis-Menten function where b is fixed at -1, c at +0, and f at 1. Commonly used for enzyme kinetics and weed density +studies. + +## Usage + +``` r +MM.2(fixed = c(NA, NA), names = c("d", "e"), ...) +``` + +## Arguments + +- fixed: + + numeric vector of length 2, specifying fixed parameters (use NA for + non-fixed parameters). + +- names: + + character vector of length 2, specifying the names of the parameters + (default: d, e). + +- ...: + + additional arguments to + [`llogistic`](https://hreinwald.github.io/drc/reference/llogistic.md). + +## Value + +See +[`llogistic`](https://hreinwald.github.io/drc/reference/llogistic.md). + +## Details + +The two-parameter Michaelis-Menten function is \$\$f(x) = \frac{d \cdot +x}{e + x}\$\$ which is equivalent to \\d/(1+(e/x))\\. + +## See also + +[`MM.3`](https://hreinwald.github.io/drc/reference/MM.3.md), +[`AR.2`](https://hreinwald.github.io/drc/reference/AR.2.md), +[`AR.3`](https://hreinwald.github.io/drc/reference/AR.3.md) + +## Author + +Christian Ritz + +## Examples + +``` r +met.mm.m1 <- drm(gain~dose, product, data = methionine, fct = MM.2()) +#> Control measurements detected for level: control +``` diff --git a/docs/reference/MM.3.html b/docs/reference/MM.3.html new file mode 100644 index 00000000..4ca25fb0 --- /dev/null +++ b/docs/reference/MM.3.html @@ -0,0 +1,116 @@ + +Three-parameter Michaelis-Menten function — MM.3 • drc + Skip to contents + + +
    +
    +
    +

    Three-parameter Michaelis-Menten function

    + Source: R/llogistic.R +
    MM.3.Rd
    +
    + +
    +

    A three-parameter (shifted) Michaelis-Menten function where b is fixed +at -1 and f at 1.

    +
    + +
    +

    Usage

    + 
    MM.3(fixed = c(NA, NA, NA), names = c("c", "d", "e"), ...)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector of length 3, specifying fixed parameters +(use NA for non-fixed parameters).

    + + +
    names
    +

    character vector of length 3, specifying the names of the +parameters (default: c, d, e).

    + + +
    ...
    +

    additional arguments to llogistic.

    + +
    +
    +

    Value

    +

    See llogistic.

    +
    +
    +

    Details

    +

    The three-parameter Michaelis-Menten function is +$$f(x) = c + \frac{d-c}{1+(e/x)}$$

    +
    +
    +

    See also

    +

    MM.2, AR.2, AR.3

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    + +
    +

    Examples

    + 
    met.mm.m1 <- drm(gain~dose, product, data = methionine, fct = MM.3())
+#> Control measurements detected for level: control
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/MM.3.md b/docs/reference/MM.3.md new file mode 100644 index 00000000..972f50ca --- /dev/null +++ b/docs/reference/MM.3.md @@ -0,0 +1,54 @@ +# Three-parameter Michaelis-Menten function + +A three-parameter (shifted) Michaelis-Menten function where b is fixed +at -1 and f at 1. + +## Usage + +``` r +MM.3(fixed = c(NA, NA, NA), names = c("c", "d", "e"), ...) +``` + +## Arguments + +- fixed: + + numeric vector of length 3, specifying fixed parameters (use NA for + non-fixed parameters). + +- names: + + character vector of length 3, specifying the names of the parameters + (default: c, d, e). + +- ...: + + additional arguments to + [`llogistic`](https://hreinwald.github.io/drc/reference/llogistic.md). + +## Value + +See +[`llogistic`](https://hreinwald.github.io/drc/reference/llogistic.md). + +## Details + +The three-parameter Michaelis-Menten function is \$\$f(x) = c + +\frac{d-c}{1+(e/x)}\$\$ + +## See also + +[`MM.2`](https://hreinwald.github.io/drc/reference/MM.2.md), +[`AR.2`](https://hreinwald.github.io/drc/reference/AR.2.md), +[`AR.3`](https://hreinwald.github.io/drc/reference/AR.3.md) + +## Author + +Christian Ritz + +## Examples + +``` r +met.mm.m1 <- drm(gain~dose, product, data = methionine, fct = MM.3()) +#> Control measurements detected for level: control +``` diff --git a/docs/reference/MM.html b/docs/reference/MM.html deleted file mode 100644 index 6f34dfa7..00000000 --- a/docs/reference/MM.html +++ /dev/null @@ -1,257 +0,0 @@ - - - - - - - - -Michaelis-Menten model — MM • drc - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    -
    - - - -
    - -
    -
    -
    -

    Michaelis-Menten model

    - - -
    - -
    - -

    The functions can be used to fit (shifted) Michaelis-Menten models that are used - for modeling enzyme kinetics, weed densities etc.

    - -
    - - 
    MM.2(fixed = c(NA, NA), names = c("d", "e"), ...)
-
-  MM.3(fixed = c(NA, NA, NA), names = c("c", "d", "e"), ...)
    - -

    Arguments

    - - - - - - - - - - - - - - -
    fixed

    numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.

    names

    a vector of character strings giving the names of the parameters (should not contain ":").

    ...

    additional arguments from convenience functions to llogistic.

    - -

    Details

    - -

    The model is defined by the three-parameter model function

    -

    $$f(x, (c, d, e)) = c + \frac{d-c}{1+(e/x)}$$

    -

    It is an increasing as a function of the dose \(x\), attaining the lower limit \(c\) at dose 0 (\(x=0\)) - and the upper limit \(d\) for infinitely large doses. The parameter \(e\) corresponds to the dose yielding a response - halfway between \(c\) and \(d\).

    -

    The common two-parameter Michaelis-Menten model (MM.2) is obtained by - setting \(c\) equal to 0.

    - -

    Value

    - -

    A list of class drcMean, containing the mean function, the self starter function, - the parameter names and other components such as derivatives and a function for calculating ED values.

    - -

    Note

    - -

    At the moment the implementation cannot deal with infinite concentrations.

    - -

    See also

    - -

    Related models are the asymptotic regression models AR.2 and AR.3.

    - - -

    Examples

    - 
    
-## Fitting Michaelis-Menten model
-met.mm.m1 <- drm(gain~dose, product, data=methionine, fct=MM.3(),
-pmodels = list(~1, ~factor(product), ~factor(product)))
    #> Control measurements detected for level: control
    plot(met.mm.m1, log = "", ylim=c(1450, 1800))
    summary(met.mm.m1)
    #> 
-#> Model fitted: Shifted Michaelis-Menten (3 parms)
-#> 
-#> Parameter estimates:
-#> 
-#>                 Estimate Std. Error  t-value   p-value    
-#> c:(Intercept) 1.4520e+03 1.0886e+01 133.3830 1.895e-08 ***
-#> d:DLM         1.7361e+03 1.8922e+01  91.7543 8.459e-08 ***
-#> d:MHA         1.8685e+03 4.3930e+01  42.5337 1.826e-06 ***
-#> e:DLM         3.8946e-02 1.0184e-02   3.8241   0.01871 *  
-#> e:MHA         1.1104e-01 2.8484e-02   3.8984   0.01757 *  
-#> ---
-#> Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
-#> 
-#> Residual standard error:
-#> 
-#>  11.14285 (4 degrees of freedom)
    ED(met.mm.m1, c(10, 50))
    #> 
-#> Estimated effective doses
-#> 
-#>           Estimate Std. Error
-#> e:DLM:10 0.0043274  0.0011316
-#> e:DLM:50 0.0389462  0.0101843
-#> e:MHA:10 0.0123379  0.0031649
-#> e:MHA:50 0.1110410  0.0284837
    
-## Calculating bioefficacy: approach 1
-coef(met.mm.m1)[4] / coef(met.mm.m1)[5] * 100
    #>    e:DLM 
-#> 35.07368 
    
-## Calculating bioefficacy: approach 2
-EDcomp(met.mm.m1, c(50,50))
    #> 
-#> Estimated ratios of effect doses
-#> 
-#>                 Estimate Std. Error    t-value    p-value
-#> DLM/MHA:50/50  0.3507368  0.1181319 -5.4960893  0.0053418
    
-## Simplified models
-met.mm.m2a <- drm(gain~dose, product, data=methionine, fct=MM.3(),
-pmodels = list(~1, ~factor(product), ~1))
    #> Control measurements detected for level: control
    anova(met.mm.m2a, met.mm.m1)  # model reduction not possible
    #> 
-#> 1st model
-#>  fct:     MM.3()
-#>  pmodels: ~1, ~factor(product), ~1
-#> 2nd model
-#>  fct:     MM.3()
-#>  pmodels: ~1, ~factor(product), ~factor(product)
-#> 
    #> ANOVA table
-#> 
-#>           ModelDf     RSS Df F value p value
-#> 1st model       5 1794.73                   
-#> 2nd model       4  496.65  1 10.4546  0.0319
    
-met.mm.m2b <- drm(gain~dose, product, data=methionine, fct=MM.3(),
-pmodels = list(~1, ~1, ~factor(product)))
    #> Control measurements detected for level: control
    anova(met.mm.m2b, met.mm.m1)  # model reduction not possible
    #> 
-#> 1st model
-#>  fct:     MM.3()
-#>  pmodels: ~1, ~1, ~factor(product)
-#> 2nd model
-#>  fct:     MM.3()
-#>  pmodels: ~1, ~factor(product), ~factor(product)
-#> 
    #> ANOVA table
-#> 
-#>           ModelDf     RSS Df F value p value
-#> 1st model       5 1885.43                   
-#> 2nd model       4  496.65  1 11.1851  0.0287
    
-
    -
    - -
    - -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    -
    - -
    -

    Site built with pkgdown.

    -
    - -
    -
    - - - - - - diff --git a/docs/reference/NEC-1.png b/docs/reference/NEC-1.png index f414dfde..b225740b 100644 Binary files a/docs/reference/NEC-1.png and b/docs/reference/NEC-1.png differ diff --git a/docs/reference/NEC.2.html b/docs/reference/NEC.2.html new file mode 100644 index 00000000..53eecab6 --- /dev/null +++ b/docs/reference/NEC.2.html @@ -0,0 +1,99 @@ + +Two-parameter NEC model — NEC.2 • drc + Skip to contents + + +
    +
    +
    +

    Two-parameter NEC model

    + Source: R/nec.R +
    NEC.2.Rd
    +
    + +
    +

    Convenience function for the NEC model with lower limit fixed at 0 and upper limit fixed.

    +
    + +
    +

    Usage

    + 
    NEC.2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...)
    +
    + +
    +

    Arguments

    + + +
    upper
    +

    numeric value. The fixed upper limit in the model. Default is 1.

    + + +
    fixed
    +

    numeric vector of length 2 specifying fixed parameters (NAs for free parameters).

    + + +
    names
    +

    character vector of parameter names.

    + + +
    ...
    +

    additional arguments passed to NEC.

    + +
    +
    +

    Value

    +

    A list (see NEC).

    +
    +
    +

    See also

    +

    NEC, NEC.3, NEC.4

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/NEC.2.md b/docs/reference/NEC.2.md new file mode 100644 index 00000000..75b2036c --- /dev/null +++ b/docs/reference/NEC.2.md @@ -0,0 +1,40 @@ +# Two-parameter NEC model + +Convenience function for the NEC model with lower limit fixed at 0 and +upper limit fixed. + +## Usage + +``` r +NEC.2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) +``` + +## Arguments + +- upper: + + numeric value. The fixed upper limit in the model. Default is 1. + +- fixed: + + numeric vector of length 2 specifying fixed parameters (NAs for free + parameters). + +- names: + + character vector of parameter names. + +- ...: + + additional arguments passed to + [`NEC`](https://hreinwald.github.io/drc/reference/NEC.md). + +## Value + +A list (see [`NEC`](https://hreinwald.github.io/drc/reference/NEC.md)). + +## See also + +[`NEC`](https://hreinwald.github.io/drc/reference/NEC.md), +[`NEC.3`](https://hreinwald.github.io/drc/reference/NEC.3.md), +[`NEC.4`](https://hreinwald.github.io/drc/reference/NEC.4.md) diff --git a/docs/reference/NEC.3.html b/docs/reference/NEC.3.html new file mode 100644 index 00000000..b72ecc23 --- /dev/null +++ b/docs/reference/NEC.3.html @@ -0,0 +1,95 @@ + +Three-parameter NEC model — NEC.3 • drc + Skip to contents + + +
    +
    +
    +

    Three-parameter NEC model

    + Source: R/nec.R +
    NEC.3.Rd
    +
    + +
    +

    Convenience function for the NEC model with the lower limit fixed at 0.

    +
    + +
    +

    Usage

    + 
    NEC.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector of length 3 specifying fixed parameters (NAs for free parameters).

    + + +
    names
    +

    character vector of parameter names.

    + + +
    ...
    +

    additional arguments passed to NEC.

    + +
    +
    +

    Value

    +

    A list (see NEC).

    +
    +
    +

    See also

    +

    NEC, NEC.2, NEC.4

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/NEC.3.md b/docs/reference/NEC.3.md new file mode 100644 index 00000000..5385deb8 --- /dev/null +++ b/docs/reference/NEC.3.md @@ -0,0 +1,35 @@ +# Three-parameter NEC model + +Convenience function for the NEC model with the lower limit fixed at 0. + +## Usage + +``` r +NEC.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) +``` + +## Arguments + +- fixed: + + numeric vector of length 3 specifying fixed parameters (NAs for free + parameters). + +- names: + + character vector of parameter names. + +- ...: + + additional arguments passed to + [`NEC`](https://hreinwald.github.io/drc/reference/NEC.md). + +## Value + +A list (see [`NEC`](https://hreinwald.github.io/drc/reference/NEC.md)). + +## See also + +[`NEC`](https://hreinwald.github.io/drc/reference/NEC.md), +[`NEC.2`](https://hreinwald.github.io/drc/reference/NEC.2.md), +[`NEC.4`](https://hreinwald.github.io/drc/reference/NEC.4.md) diff --git a/docs/reference/NEC.4.html b/docs/reference/NEC.4.html new file mode 100644 index 00000000..d9044cd5 --- /dev/null +++ b/docs/reference/NEC.4.html @@ -0,0 +1,95 @@ + +Four-parameter NEC model — NEC.4 • drc + Skip to contents + + +
    +
    +
    +

    Four-parameter NEC model

    + Source: R/nec.R +
    NEC.4.Rd
    +
    + +
    +

    Convenience function for the full four-parameter NEC model.

    +
    + +
    +

    Usage

    + 
    NEC.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector of length 4 specifying fixed parameters (NAs for free parameters).

    + + +
    names
    +

    character vector of parameter names.

    + + +
    ...
    +

    additional arguments passed to NEC.

    + +
    +
    +

    Value

    +

    A list (see NEC).

    +
    +
    +

    See also

    +

    NEC, NEC.2, NEC.3

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/NEC.4.md b/docs/reference/NEC.4.md new file mode 100644 index 00000000..297c00c4 --- /dev/null +++ b/docs/reference/NEC.4.md @@ -0,0 +1,35 @@ +# Four-parameter NEC model + +Convenience function for the full four-parameter NEC model. + +## Usage + +``` r +NEC.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) +``` + +## Arguments + +- fixed: + + numeric vector of length 4 specifying fixed parameters (NAs for free + parameters). + +- names: + + character vector of parameter names. + +- ...: + + additional arguments passed to + [`NEC`](https://hreinwald.github.io/drc/reference/NEC.md). + +## Value + +A list (see [`NEC`](https://hreinwald.github.io/drc/reference/NEC.md)). + +## See also + +[`NEC`](https://hreinwald.github.io/drc/reference/NEC.md), +[`NEC.2`](https://hreinwald.github.io/drc/reference/NEC.2.md), +[`NEC.3`](https://hreinwald.github.io/drc/reference/NEC.3.md) diff --git a/docs/reference/NEC.html b/docs/reference/NEC.html index 25d4c96b..85cf4a38 100644 --- a/docs/reference/NEC.html +++ b/docs/reference/NEC.html @@ -1,233 +1,149 @@ - - - - - - +No Effect Concentration (NEC) dose-response model — NEC • drc + Skip to contents -Dose-response model for estimation of no effect concentration (NEC). — NEC • drc - - - +
    +
    +
    +

    No Effect Concentration (NEC) dose-response model

    + Source: R/nec.R +
    NEC.Rd
    +
    + +
    +

    The NEC model is a dose-response model with a threshold below which the response is assumed +constant and equal to the control response. It has been proposed as an alternative to both the +classical NOEC and the regression-based EC/ED approach.

    +
    - +
    +

    Usage

    + 
    NEC(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), fctName, fctText)
    +
    - - +
    +

    Arguments

    +
    fixed
    +

    numeric vector specifying which parameters are fixed and at what value they are fixed. +NAs are used for parameters that are not fixed.

    - - - +
    names
    +

    a vector of character strings giving the names of the parameters (should not contain ":"). +The default is reasonable (see under 'Usage').

    - +
    fctName
    +

    optional character string used internally by convenience functions.

    - -
    -
    - - - -
    +
    fctText
    +

    optional character string used internally by convenience functions.

    -
    -
    -
    -

    Dose-response model for estimation of no effect concentration (NEC).

    - - +
    +
    +

    Value

    +

    A list containing the nonlinear function, the self starter function +and the parameter names.

    - -
    - -

    The no effect concentration has been proposed as an alternative to both the classical no observed effect concentration - (NOEC) and the regression-based EC/ED approach. The NEC model is a dose-response model with a threshold below - which the response is assumed constant and equal to the control response.

    - +
    +

    Details

    +

    The NEC model function proposed by Pires et al (2002) is: +$$f(x) = c + (d-c)\exp(-b(x-e)I(x-e))$$ +where \(I(x-e)\) is the indicator function equal to 0 for \(x<=e\) and 1 for \(x>e\).

    - - 
    NEC(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), fctName, fctText)
-
-  NEC.2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...)
-
-  NEC.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...)
-
-  NEC.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - - - - - - - - - -
    fixed

    numeric vector specifying which parameters are fixed and at what value they are fixed. - NAs are used for parameters that are not fixed.

    names

    a vector of character strings giving the names of the parameters (should not contain ":"). - The default is reasonable (see under 'Usage').

    fctName

    optional character string used internally by convenience functions.

    fctText

    optional character string used internally by convenience functions.

    upper

    numeric value. The fixed, upper limit in the model. Default is 1.

    ...

    additional arguments in NEC

    - -

    Details

    - -

    The NEC model function proposed by Pires et al (2002) is defined as follows

    -

    $$ f(x) = c + (d-c)\exp(-b(x-e)I(x-e)) + \frac{d2}{1+\exp(b2(\log(x)-\log(e2)))}$$

    -

    where \(I(x-e)\) is the indicator function. It is equal to 0 for \(x<=e\) and equal 1 for \(x>e\).

    -

    In other words: The parameter e in NEC in "drc" corresponds to the parameter c' in Pires et al (2002), - the parameter b in NEC in "drc" corresponds to the parameter m' in Pires et al (2002), the parameter d - in NEC in "drc" corresponds to the parameter l' in Pires et al (2002), and finally the parameter c in - NEC in "drc" (the lower horizontal limit) is (implictly) fixed at 0 in Pires et al (2002)

    - -

    Value

    - -

    The value returned is a list containing the nonlinear function, the self starter function - and the parameter names.

    - -

    References

    - - +
    +

    References

    Pires, A. M., Branco, J. A., Picado, A., Mendonca, E. (2002) - Models for the estimation of a 'no effect concentration', - Environmetrics, 13, 15--27.

    - - -

    Examples

    - 
    
-nec.m1 <- drm(rootl~conc, data=ryegrass, fct=NEC.4())
-
-summary(nec.m1)
    #> 
-#> Model fitted: NEC (4 parms)
-#> 
-#> Parameter estimates:
-#> 
-#>                Estimate Std. Error t-value   p-value    
-#> b:(Intercept)   3.16938  393.27256  0.0081  0.993650    
-#> c:(Intercept)   0.67201    0.23463  2.8641  0.009592 ** 
-#> d:(Intercept)   7.39666    0.20260 36.5091 < 2.2e-16 ***
-#> e:(Intercept)   3.41729   41.27705  0.0828  0.934842    
-#> ---
-#> Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
-#> 
-#> Residual standard error:
-#> 
-#>  0.7017905 (20 degrees of freedom)
    
-plot(nec.m1)
    
-abline(v=coef(nec.m1)[4], lty=2)  # showing the estimated threshold 
    
-
    -
    - +
    +

    See also

    +

    NEC.2, NEC.3, NEC.4, drm

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    -
  • References
    • - -
  • Examples
    • - +
    +

    Examples

    + 
    nec.m1 <- drm(rootl ~ conc, data = ryegrass, fct = NEC.4())
+summary(nec.m1)
+#> 
+#> Model fitted: NEC (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                Estimate Std. Error t-value   p-value    
+#> b:(Intercept)   3.16938  393.27265  0.0081  0.993650    
+#> c:(Intercept)   0.67201    0.23463  2.8641  0.009592 ** 
+#> d:(Intercept)   7.39666    0.20260 36.5091 < 2.2e-16 ***
+#> e:(Intercept)   3.41729   41.27705  0.0828  0.934842    
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.7017905 (20 degrees of freedom)
+plot(nec.m1)
+
+
+
    +
    +
    -

    Author

    - - Christian Ritz -
    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + -
    - - - - + diff --git a/docs/reference/NEC.md b/docs/reference/NEC.md new file mode 100644 index 00000000..3e901617 --- /dev/null +++ b/docs/reference/NEC.md @@ -0,0 +1,86 @@ +# No Effect Concentration (NEC) dose-response model + +The NEC model is a dose-response model with a threshold below which the +response is assumed constant and equal to the control response. It has +been proposed as an alternative to both the classical NOEC and the +regression-based EC/ED approach. + +## Usage + +``` r +NEC(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), fctName, fctText) +``` + +## Arguments + +- fixed: + + numeric vector specifying which parameters are fixed and at what value + they are fixed. NAs are used for parameters that are not fixed. + +- names: + + a vector of character strings giving the names of the parameters + (should not contain ":"). The default is reasonable (see under + 'Usage'). + +- fctName: + + optional character string used internally by convenience functions. + +- fctText: + + optional character string used internally by convenience functions. + +## Value + +A list containing the nonlinear function, the self starter function and +the parameter names. + +## Details + +The NEC model function proposed by Pires et al (2002) is: \$\$f(x) = c + +(d-c)\exp(-b(x-e)I(x-e))\$\$ where \\I(x-e)\\ is the indicator function +equal to 0 for \\x\<=e\\ and 1 for \\x\>e\\. + +## References + +Pires, A. M., Branco, J. A., Picado, A., Mendonca, E. (2002) Models for +the estimation of a 'no effect concentration', *Environmetrics*, **13**, +15–27. + +## See also + +[`NEC.2`](https://hreinwald.github.io/drc/reference/NEC.2.md), +[`NEC.3`](https://hreinwald.github.io/drc/reference/NEC.3.md), +[`NEC.4`](https://hreinwald.github.io/drc/reference/NEC.4.md), +[`drm`](https://hreinwald.github.io/drc/reference/drm.md) + +## Author + +Christian Ritz + +## Examples + +``` r +nec.m1 <- drm(rootl ~ conc, data = ryegrass, fct = NEC.4()) +summary(nec.m1) +#> +#> Model fitted: NEC (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 3.16938 393.27265 0.0081 0.993650 +#> c:(Intercept) 0.67201 0.23463 2.8641 0.009592 ** +#> d:(Intercept) 7.39666 0.20260 36.5091 < 2.2e-16 *** +#> e:(Intercept) 3.41729 41.27705 0.0828 0.934842 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.7017905 (20 degrees of freedom) +plot(nec.m1) + +``` diff --git a/docs/reference/O.mykiss-1.png b/docs/reference/O.mykiss-1.png new file mode 100644 index 00000000..c70329f8 Binary files /dev/null and b/docs/reference/O.mykiss-1.png differ diff --git a/docs/reference/O.mykiss-2.png b/docs/reference/O.mykiss-2.png new file mode 100644 index 00000000..7b0ff2b2 Binary files /dev/null and b/docs/reference/O.mykiss-2.png differ diff --git a/docs/reference/O.mykiss.html b/docs/reference/O.mykiss.html new file mode 100644 index 00000000..c0744b41 --- /dev/null +++ b/docs/reference/O.mykiss.html @@ -0,0 +1,169 @@ + +Test data from a 21 day fish test — O.mykiss • drc + Skip to contents + + +
    +
    +
    +

    Test data from a 21 day fish test

    + +
    O.mykiss.Rd
    +
    + +
    +

    Test data from a 21 day fish test following the guidelines OECD GL204, + using the test organism Rainbow trout Oncorhynchus mykiss.

    +
    + +
    +

    Usage

    + 
    data(O.mykiss)
    +
    + +
    +

    Format

    +

    A data frame with 70 observations on the following 2 variables.

    conc
    +

    a numeric vector of concentrations (mg/l)

    + +
    weight
    +

    a numeric vector of wet weights (g)

    + + +
    +
    +

    Details

    +

    Weights are measured after 28 days.

    +
    +
    +

    Source

    +

    Organisation for Economic Co-operation and Development (OECD) (2006) + CURRENT APPROACHES IN THE STATISTICAL ANALYSIS OF ECOTOXICITY DATA: A GUIDANCE TO APPLICATION - ANNEXES, + Paris (p. 65).

    +
    +
    +

    References

    +

    Organisation for Economic Co-operation and Development (OECD) (2006) + CURRENT APPROACHES IN THE STATISTICAL ANALYSIS OF ECOTOXICITY DATA: A GUIDANCE TO APPLICATION - ANNEXES, + Paris (pp. 80–85).

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+head(O.mykiss)
+#>   conc weight
+#> 1    0    2.8
+#> 2    0    3.0
+#> 3    0    2.7
+#> 4    0    3.9
+#> 5    0    3.1
+#> 6    0    1.8
+
+## Fitting exponential model
+O.mykiss.m1 <- drm(weight ~ conc, data = O.mykiss, fct = EXD.2(), na.action = na.omit)
+modelFit(O.mykiss.m1)
+#> Lack-of-fit test
+#> 
+#>           ModelDf    RSS Df F value p value
+#> ANOVA          54 17.620                   
+#> DRC model      59 18.492  5  0.5351  0.7488
+summary(O.mykiss.m1)
+#> 
+#> Model fitted: Exponential decay with lower limit at 0 (2 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                 Estimate Std. Error t-value   p-value    
+#> d:(Intercept)   2.846794   0.092526 30.7674 < 2.2e-16 ***
+#> e:(Intercept) 111.738614  33.196876  3.3659  0.001347 ** 
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.5598508 (59 degrees of freedom)
+
+## Fitting same model with transform-both-sides approach
+O.mykiss.m2 <- boxcox(O.mykiss.m1 , method = "anova")
+
+summary(O.mykiss.m2)
+#> 
+#> Model fitted: Exponential decay with lower limit at 0 (2 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                 Estimate Std. Error t-value   p-value    
+#> d:(Intercept)   2.841793   0.094431 30.0937 < 2.2e-16 ***
+#> e:(Intercept) 104.115039  28.024151  3.7152  0.000453 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.4246342 (59 degrees of freedom)
+#> 
+#> Non-normality/heterogeneity adjustment through Box-Cox transformation
+#> 
+#> Estimated lambda: 0.707 
+#> Confidence interval for lambda: [-0.0109, 1.5368] 
+#> 
+# no need for a transformation
+
+## Plotting the fit
+plot(O.mykiss.m1, type = "all", xlim = c(0, 500), ylim = c(0,4),
+xlab = "Concentration (mg/l)", ylab = "Weight (g)", broken = TRUE)
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/O.mykiss.md b/docs/reference/O.mykiss.md new file mode 100644 index 00000000..2f3d160f --- /dev/null +++ b/docs/reference/O.mykiss.md @@ -0,0 +1,107 @@ +# Test data from a 21 day fish test + +Test data from a 21 day fish test following the guidelines OECD GL204, +using the test organism Rainbow trout *Oncorhynchus mykiss*. + +## Usage + +``` r +data(O.mykiss) +``` + +## Format + +A data frame with 70 observations on the following 2 variables. + +- `conc`: + + a numeric vector of concentrations (mg/l) + +- `weight`: + + a numeric vector of wet weights (g) + +## Details + +Weights are measured after 28 days. + +## Source + +Organisation for Economic Co-operation and Development (OECD) (2006) +*CURRENT APPROACHES IN THE STATISTICAL ANALYSIS OF ECOTOXICITY DATA: A +GUIDANCE TO APPLICATION - ANNEXES*, Paris (p. 65). + +## References + +Organisation for Economic Co-operation and Development (OECD) (2006) +*CURRENT APPROACHES IN THE STATISTICAL ANALYSIS OF ECOTOXICITY DATA: A +GUIDANCE TO APPLICATION - ANNEXES*, Paris (pp. 80–85). + +## Examples + +``` r +library(drc) + +head(O.mykiss) +#> conc weight +#> 1 0 2.8 +#> 2 0 3.0 +#> 3 0 2.7 +#> 4 0 3.9 +#> 5 0 3.1 +#> 6 0 1.8 + +## Fitting exponential model +O.mykiss.m1 <- drm(weight ~ conc, data = O.mykiss, fct = EXD.2(), na.action = na.omit) +modelFit(O.mykiss.m1) +#> Lack-of-fit test +#> +#> ModelDf RSS Df F value p value +#> ANOVA 54 17.620 +#> DRC model 59 18.492 5 0.5351 0.7488 +summary(O.mykiss.m1) +#> +#> Model fitted: Exponential decay with lower limit at 0 (2 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> d:(Intercept) 2.846794 0.092526 30.7674 < 2.2e-16 *** +#> e:(Intercept) 111.738614 33.196876 3.3659 0.001347 ** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.5598508 (59 degrees of freedom) + +## Fitting same model with transform-both-sides approach +O.mykiss.m2 <- boxcox(O.mykiss.m1 , method = "anova") + +summary(O.mykiss.m2) +#> +#> Model fitted: Exponential decay with lower limit at 0 (2 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> d:(Intercept) 2.841793 0.094431 30.0937 < 2.2e-16 *** +#> e:(Intercept) 104.115039 28.024151 3.7152 0.000453 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.4246342 (59 degrees of freedom) +#> +#> Non-normality/heterogeneity adjustment through Box-Cox transformation +#> +#> Estimated lambda: 0.707 +#> Confidence interval for lambda: [-0.0109, 1.5368] +#> +# no need for a transformation + +## Plotting the fit +plot(O.mykiss.m1, type = "all", xlim = c(0, 500), ylim = c(0,4), +xlab = "Concentration (mg/l)", ylab = "Weight (g)", broken = TRUE) +``` diff --git a/docs/reference/P.promelas-1.png b/docs/reference/P.promelas-1.png new file mode 100644 index 00000000..8e207fbf Binary files /dev/null and b/docs/reference/P.promelas-1.png differ diff --git a/docs/reference/P.promelas-2.png b/docs/reference/P.promelas-2.png new file mode 100644 index 00000000..72be6fe5 Binary files /dev/null and b/docs/reference/P.promelas-2.png differ diff --git a/docs/reference/P.promelas.html b/docs/reference/P.promelas.html new file mode 100644 index 00000000..ca82ee68 --- /dev/null +++ b/docs/reference/P.promelas.html @@ -0,0 +1,162 @@ + +Effect of sodium pentachlorophenate on growth of fathead minnow — P.promelas • drc + Skip to contents + + +
    +
    +
    +

    Effect of sodium pentachlorophenate on growth of fathead minnow

    + +
    P.promelas.Rd
    +
    + +
    +

    Fathead minnows (Pimephales promelas) were exposed to sodium pentachlorophenate + concentrations ranging from 32 to 512 micro g/L in a 7-day larval survival and growth test. + The average dry weight was measured.

    +
    + +
    +

    Usage

    + 
    data(P.promelas)
    +
    + +
    +

    Format

    +

    A data frame with 24 observations on the following 2 variables.

    conc
    +

    a numeric vector of sodium pentachlorophenate concentrations (micro g/L).

    + +
    dryweight
    +

    a numeric vector dry weights (mg)

    + + +
    +
    +

    Details

    +

    The data are analysed in Bruce and Versteeg (1992) using a log-normal + dose-response model (using the logarithm with base 10).

    +
    +
    +

    Source

    +

    Bruce, R. D. and Versteeg, D. J. (1992) A statistical procedure for modeling continuous toxicity data, + Environ. Toxicol. Chem., 11, 1485–1494.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Model with ED50 on log scale as parameter
+p.prom.m1<-drm(dryweight~conc, data=P.promelas, fct=LN.3())
+
+plot(fitted(p.prom.m1), residuals(p.prom.m1))
+
+
+plot(p.prom.m1, type="all", broken=TRUE, xlim=c(0,1000))
+
+summary(p.prom.m1)
+#> 
+#> Model fitted: Log-normal with lower limit at 0 (3 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                  Estimate  Std. Error t-value   p-value    
+#> b:(Intercept)   -0.571777    0.187101 -3.0560  0.006001 ** 
+#> d:(Intercept)    0.704855    0.025553 27.5845 < 2.2e-16 ***
+#> e:(Intercept) 1145.654281  392.624568  2.9179  0.008223 ** 
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.05467719 (21 degrees of freedom)
+ED(p.prom.m1, c(10,20,50), interval="delta")
+#> 
+#> Estimated effective doses
+#> 
+#>       Estimate Std. Error     Lower     Upper
+#> e:10  121.8002    59.4612   -1.8561  245.4565
+#> e:20  262.9046    72.2694  112.6121  413.1970
+#> e:50 1145.6543   392.6246  329.1468 1962.1618
+
+## Model with ED50 as parameter
+p.prom.m2<-drm(dryweight~conc, data=P.promelas, fct=LN.3(loge=TRUE))
+summary(p.prom.m2)
+#> 
+#> Model fitted: Log-normal with lower limit at 0 (3 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                Estimate Std. Error t-value   p-value    
+#> b:(Intercept) -0.571671   0.187187  -3.054  0.006028 ** 
+#> d:(Intercept)  0.704852   0.025555  27.581 < 2.2e-16 ***
+#> e:(Intercept)  7.044103   0.343117  20.530 2.221e-15 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.05467719 (21 degrees of freedom)
+ED(p.prom.m2, c(10,20,50), interval="fls")
+#> 
+#> Estimated effective doses
+#> 
+#>        Estimate Std. Error      Lower      Upper
+#> e:10  121.79469    0.48838   44.11055  336.29021
+#> e:20  262.93031    0.27492  148.43715  465.73480
+#> e:50 1146.08015    0.34312  561.46613 2339.41042
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/P.promelas.md b/docs/reference/P.promelas.md new file mode 100644 index 00000000..1f6cab24 --- /dev/null +++ b/docs/reference/P.promelas.md @@ -0,0 +1,102 @@ +# Effect of sodium pentachlorophenate on growth of fathead minnow + +Fathead minnows (*Pimephales promelas*) were exposed to sodium +pentachlorophenate concentrations ranging from 32 to 512 micro g/L in a +7-day larval survival and growth test. The average dry weight was +measured. + +## Usage + +``` r +data(P.promelas) +``` + +## Format + +A data frame with 24 observations on the following 2 variables. + +- `conc`: + + a numeric vector of sodium pentachlorophenate concentrations (micro + g/L). + +- `dryweight`: + + a numeric vector dry weights (mg) + +## Details + +The data are analysed in Bruce and Versteeg (1992) using a log-normal +dose-response model (using the logarithm with base 10). + +## Source + +Bruce, R. D. and Versteeg, D. J. (1992) A statistical procedure for +modeling continuous toxicity data, *Environ. Toxicol. Chem.*, **11**, +1485–1494. + +## Examples + +``` r +library(drc) + +## Model with ED50 on log scale as parameter +p.prom.m1<-drm(dryweight~conc, data=P.promelas, fct=LN.3()) + +plot(fitted(p.prom.m1), residuals(p.prom.m1)) + + +plot(p.prom.m1, type="all", broken=TRUE, xlim=c(0,1000)) + +summary(p.prom.m1) +#> +#> Model fitted: Log-normal with lower limit at 0 (3 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) -0.571777 0.187101 -3.0560 0.006001 ** +#> d:(Intercept) 0.704855 0.025553 27.5845 < 2.2e-16 *** +#> e:(Intercept) 1145.654281 392.624568 2.9179 0.008223 ** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.05467719 (21 degrees of freedom) +ED(p.prom.m1, c(10,20,50), interval="delta") +#> +#> Estimated effective doses +#> +#> Estimate Std. Error Lower Upper +#> e:10 121.8002 59.4612 -1.8561 245.4565 +#> e:20 262.9046 72.2694 112.6121 413.1970 +#> e:50 1145.6543 392.6246 329.1468 1962.1618 + +## Model with ED50 as parameter +p.prom.m2<-drm(dryweight~conc, data=P.promelas, fct=LN.3(loge=TRUE)) +summary(p.prom.m2) +#> +#> Model fitted: Log-normal with lower limit at 0 (3 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) -0.571671 0.187187 -3.054 0.006028 ** +#> d:(Intercept) 0.704852 0.025555 27.581 < 2.2e-16 *** +#> e:(Intercept) 7.044103 0.343117 20.530 2.221e-15 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.05467719 (21 degrees of freedom) +ED(p.prom.m2, c(10,20,50), interval="fls") +#> +#> Estimated effective doses +#> +#> Estimate Std. Error Lower Upper +#> e:10 121.79469 0.48838 44.11055 336.29021 +#> e:20 262.93031 0.27492 148.43715 465.73480 +#> e:50 1146.08015 0.34312 561.46613 2339.41042 +``` diff --git a/docs/reference/PR.html b/docs/reference/PR.html index 283cf7b6..271cffb7 100644 --- a/docs/reference/PR.html +++ b/docs/reference/PR.html @@ -1,197 +1,112 @@ - - - - - - +Expected or predicted response — PR • drc + Skip to contents -Expected or predicted response — PR • drc - - - +
    +
    +
    +

    Expected or predicted response

    + Source: R/pr.R +
    PR.Rd
    +
    - - - - +
    +

    Returns the expected or predicted response for specified dose values. This is a +convenience function for easy access to predicted values.

    +
    +
    +

    Usage

    + 
    PR(object, xVec, ...)
    +
    +
    +

    Arguments

    - - - +
    object
    +

    object of class drc obtained from fitting a dose-response model.

    - +
    xVec
    +

    numeric vector of dose values.

    - -
    -
    - - - -
    +
    ...
    +

    additional arguments passed to predict.drc.

    -
    -
    -
    -

    Expected or predicted response

    - - +
    +
    +

    Value

    +

    A numeric vector of predicted values or possibly a matrix of predicted values +and corresponding standard errors.

    - -
    - -

    The function returns the expected or predicted response for specified dose values.

    - +
    +

    See also

    +

    predict.drc

    +
    +
    +

    Author

    +

    Christian Ritz after a suggestion from Andrew Kniss.

    - 
    PR(object, xVec, ...)
    - -

    Arguments

    - - - - - - - - - - - - - - -
    object

    object of class drc obtaining fitting a dose-response model.

    xVec

    numeric vector of dose values.

    …

    additional arguments to be supplied to predict.drc. No effect at the moment.

    - -

    Details

    - -

    This function is a convenience function for easy access to predicted values.

    - -

    Value

    - -

    A numeric vector of predicted values or possibly a matrix of predicted values and corresponding standard errors.

    - -

    See also

    - -

    Predictions can also be obtained using predict.drc.

    - - -

    Examples

    - 
    
-ryegrass.m1 <- drm(ryegrass, fct = LL.4())
-PR(ryegrass.m1, c(5, 10))
    #>         5        10 
-#> 1.8523337 0.6888809 
    
-ryegrass.m2 <- drm(ryegrass, fct = LL2.4())
-PR(ryegrass.m2, c(5, 10))
    #>         5        10 
-#> 1.8523257 0.6888757 
    
-spinach.m1 <- drm(SLOPE~DOSE, CURVE, data=spinach, fct = LL.4())
-PR(spinach.m1, c(5, 10))
    #>      Prediction         SE
-#> 1:5   0.6849759 0.02733629
-#> 1:10  0.5344815 0.02815873
-#> 2:5   0.6849759 0.02733629
-#> 2:10  0.5344815 0.02815873
-#> 3:5   0.6849759 0.02733629
-#> 3:10  0.5344815 0.02815873
-#> 4:5   0.6849759 0.02733629
-#> 4:10  0.5344815 0.02815873
-#> 5:5   0.6849759 0.02733629
-#> 5:10  0.5344815 0.02815873
    
-
    -
    -
    -

    Author

    - - Christian Ritz after a suggestion from Andrew Kniss. -
    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + -
    - - - - + diff --git a/docs/reference/PR.md b/docs/reference/PR.md new file mode 100644 index 00000000..1d1ce890 --- /dev/null +++ b/docs/reference/PR.md @@ -0,0 +1,47 @@ +# Expected or predicted response + +Returns the expected or predicted response for specified dose values. +This is a convenience function for easy access to predicted values. + +## Usage + +``` r +PR(object, xVec, ...) +``` + +## Arguments + +- object: + + object of class `drc` obtained from fitting a dose-response model. + +- xVec: + + numeric vector of dose values. + +- ...: + + additional arguments passed to + [`predict.drc`](https://hreinwald.github.io/drc/reference/predict.drc.md). + +## Value + +A numeric vector of predicted values or possibly a matrix of predicted +values and corresponding standard errors. + +## See also + +[`predict.drc`](https://hreinwald.github.io/drc/reference/predict.drc.md) + +## Author + +Christian Ritz after a suggestion from Andrew Kniss. + +## Examples + +``` r +ryegrass.m1 <- drm(ryegrass, fct = LL.4()) +PR(ryegrass.m1, c(5, 10)) +#> 5 10 +#> 1.8523337 0.6888809 +``` diff --git a/docs/reference/RScompetition-1.png b/docs/reference/RScompetition-1.png new file mode 100644 index 00000000..3483cf23 Binary files /dev/null and b/docs/reference/RScompetition-1.png differ diff --git a/docs/reference/RScompetition.html b/docs/reference/RScompetition.html new file mode 100644 index 00000000..7179caf6 --- /dev/null +++ b/docs/reference/RScompetition.html @@ -0,0 +1,127 @@ + +Competition between two biotypes — RScompetition • drc + Skip to contents + + +
    +
    +
    +

    Competition between two biotypes

    + +
    RScompetition.Rd
    +
    + +
    +

    To assess the competitive ability between two biotypes of Lolium rigidum, one resistant to glyphosate + and the other a sensitive wild type, the density of resistant and sensitive biotypes was counted after + germination.

    +
    + +
    +

    Usage

    + 
    data(RScompetition)
    +
    + +
    +

    Format

    +

    A data frame with 49 observations on the following 3 variables.

    z
    +

    a numeric vector with densities of the resistant biotype (plants/m2)

    + +
    x
    +

    a numeric vector with densities of the sensitive biotype (plants/m2)

    + +
    biomass
    +

    a numeric vector of biomass weight (g/plant)

    + + +
    +
    +

    Details

    +

    A hyperbolic model (Jensen, 1993) is describing the data reasonably well.

    +
    +
    +

    Source

    +

    The dataset is from Pedersen et al (2007).

    +
    +
    +

    References

    +

    Jensen, J. E. (1993) Fitness of herbicide-resistant weed biotypes described by competition models, + Proceedings of the 8th EWRS Symposium, 14-16 June, Braunschweig, Germany, + 1, 25–32.

    +

    Pedersen, B. P. and Neve, P. and Andreasen, C. and Powles, S. (2007) Ecological fitness of a glyphosate + resistant Lolium rigidum population: Growth and seed production along a competition gradient, + Basic and Applied Ecology, 8, 258–268.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Displaying the data
+head(RScompetition)
+#>    z  x biomass
+#> 1  8  8 7.72500
+#> 2  8 16 3.47500
+#> 3  7 32 3.86875
+#> 4  8 61 1.94918
+#> 5 16  8 3.10000
+#> 6 16 16 2.91250
+
+## Plotting biomass as a function of sensitive biotype density
+plot(biomass ~ x, data = RScompetition, xlab = "Density of sensitive biotype",
+ylab = "Biomass (g/plant)")
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/RScompetition.md b/docs/reference/RScompetition.md new file mode 100644 index 00000000..e3960972 --- /dev/null +++ b/docs/reference/RScompetition.md @@ -0,0 +1,68 @@ +# Competition between two biotypes + +To assess the competitive ability between two biotypes of *Lolium +rigidum*, one resistant to glyphosate and the other a sensitive wild +type, the density of resistant and sensitive biotypes was counted after +germination. + +## Usage + +``` r +data(RScompetition) +``` + +## Format + +A data frame with 49 observations on the following 3 variables. + +- `z`: + + a numeric vector with densities of the resistant biotype (plants/m2) + +- `x`: + + a numeric vector with densities of the sensitive biotype (plants/m2) + +- `biomass`: + + a numeric vector of biomass weight (g/plant) + +## Details + +A hyperbolic model (Jensen, 1993) is describing the data reasonably +well. + +## Source + +The dataset is from Pedersen et al (2007). + +## References + +Jensen, J. E. (1993) Fitness of herbicide-resistant weed biotypes +described by competition models, *Proceedings of the 8th EWRS Symposium, +14-16 June, Braunschweig, Germany*, **1**, 25–32. + +Pedersen, B. P. and Neve, P. and Andreasen, C. and Powles, S. (2007) +Ecological fitness of a glyphosate resistant *Lolium rigidum* +population: Growth and seed production along a competition gradient, +*Basic and Applied Ecology*, **8**, 258–268. + +## Examples + +``` r +library(drc) + +## Displaying the data +head(RScompetition) +#> z x biomass +#> 1 8 8 7.72500 +#> 2 8 16 3.47500 +#> 3 7 32 3.86875 +#> 4 8 61 1.94918 +#> 5 16 8 3.10000 +#> 6 16 16 2.91250 + +## Plotting biomass as a function of sensitive biotype density +plot(biomass ~ x, data = RScompetition, xlab = "Density of sensitive biotype", +ylab = "Biomass (g/plant)") +``` diff --git a/docs/reference/Rsq.html b/docs/reference/Rsq.html new file mode 100644 index 00000000..bcc22bcd --- /dev/null +++ b/docs/reference/Rsq.html @@ -0,0 +1,100 @@ + +R-squared for dose-response models — Rsq • drc + Skip to contents + + +
    +
    +
    +

    R-squared for dose-response models

    + Source: R/Rsq.R +
    Rsq.Rd
    +
    + +
    +

    Calculates and displays R-squared values for a fitted dose-response model. For models +with multiple curves, per-curve and total R-squared values are returned.

    +
    + +
    +

    Usage

    + 
    Rsq(object)
    +
    + +
    +

    Arguments

    + + +
    object
    +

    an object of class 'drc'.

    + +
    +
    +

    Value

    +

    Invisibly returns a matrix of R-squared values. For single-curve models, a 1x1 matrix. +For multi-curve models, includes per-curve values and a total R-squared.

    +
    +
    +

    Details

    +

    R-squared is computed as \(1 - RSS / TSS\) where RSS is the residual sum of squares +(obtained via rss()) and TSS is the total sum of squares.

    +
    +
    +

    See also

    +

    rss() for the underlying residual sum of squares.

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/Rsq.md b/docs/reference/Rsq.md new file mode 100644 index 00000000..f82f126c --- /dev/null +++ b/docs/reference/Rsq.md @@ -0,0 +1,39 @@ +# R-squared for dose-response models + +Calculates and displays R-squared values for a fitted dose-response +model. For models with multiple curves, per-curve and total R-squared +values are returned. + +## Usage + +``` r +Rsq(object) +``` + +## Arguments + +- object: + + an object of class 'drc'. + +## Value + +Invisibly returns a matrix of R-squared values. For single-curve models, +a 1x1 matrix. For multi-curve models, includes per-curve values and a +total R-squared. + +## Details + +R-squared is computed as \\1 - RSS / TSS\\ where RSS is the residual sum +of squares (obtained via +[`rss()`](https://hreinwald.github.io/drc/reference/rss.md)) and TSS is +the total sum of squares. + +## See also + +[`rss()`](https://hreinwald.github.io/drc/reference/rss.md) for the +underlying residual sum of squares. + +## Author + +Christian Ritz diff --git a/docs/reference/S.alba-1.png b/docs/reference/S.alba-1.png new file mode 100644 index 00000000..279c4ead Binary files /dev/null and b/docs/reference/S.alba-1.png differ diff --git a/docs/reference/S.alba-2.png b/docs/reference/S.alba-2.png new file mode 100644 index 00000000..8b61b757 Binary files /dev/null and b/docs/reference/S.alba-2.png differ diff --git a/docs/reference/S.alba.comp-1.png b/docs/reference/S.alba.comp-1.png new file mode 100644 index 00000000..7876a3d3 Binary files /dev/null and b/docs/reference/S.alba.comp-1.png differ diff --git a/docs/reference/S.alba.comp.html b/docs/reference/S.alba.comp.html new file mode 100644 index 00000000..dd2b0297 --- /dev/null +++ b/docs/reference/S.alba.comp.html @@ -0,0 +1,155 @@ + +Potency of two herbicides — S.alba.comp • drc + Skip to contents + + +
    +
    +
    +

    Potency of two herbicides

    + +
    S.alba.comp.Rd
    +
    + +
    +

    Data are from an experiment, comparing the potency of the two herbicides glyphosate and bentazone in + white mustard Sinapis alba.

    +
    + +
    +

    Usage

    + 
    data(S.alba.comp)
    +
    + +
    +

    Format

    +

    A data frame with 141 observations on the following 8 variables.

    exp
    +

    a factor with levels ben1, ben2, gly1, gly2 indicating which experiment each observation belongs to.

    + +
    herbicide
    +

    a factor with levels Bentazone Glyphosate (the two herbicides applied).

    + +
    dose
    +

    a numeric vector containing the dose in g/ha.

    + +
    drymatter
    +

    a numeric vector containing the response (dry matter in g/pot).

    + +
    Tf
    +

    a numeric vector .

    + +
    area
    +

    a numeric vector .

    + +
    Fo
    +

    a numeric vector .

    + +
    Fm
    +

    a numeric vector .

    + + +
    +
    +

    Details

    +

    The lower and upper limits for the two herbicides can be assumed identical, whereas slopes and ED50 values + are different (in the log-logistic model).

    +
    +
    +

    Source

    +

    Christensen, M. G. and Teicher, H. B., and Streibig, J. C. (2003) Linking fluorescence + induction curve and biomass in herbicide screening, Pest Management Science, + 59, 1303–1310.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Displaying the data
+head(S.alba.comp)
+#>    exp herbicide dose drymatter  Tf  area  Fo   Fm
+#> 1 ben1 bentazone    0       4.1 200 31200 278 1662
+#> 2 ben1 bentazone    0       3.4 230 30600 278 1670
+#> 3 ben1 bentazone    0       2.6 210 27400 299 1646
+#> 4 ben1 bentazone    0       3.5 260 34600 288 1715
+#> 5 ben1 bentazone    0       4.3 200 31000 272 1651
+#> 6 ben1 bentazone    0       4.2 240 31400 286 1681
+
+## Fitting a four-parameter log-logistic model with common upper and lower limits
+S.alba.comp.m1 <- drm(drymatter ~ dose, herbicide, data = S.alba.comp, fct = LL.4(),
+pmodels = list(~herbicide, ~1, ~1, ~herbicide))
+summary(S.alba.comp.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                        Estimate Std. Error t-value   p-value    
+#> b:(Intercept)          5.036275   2.100683  2.3974   0.01788 *  
+#> b:herbicideglyphosate -3.682298   2.062582 -1.7853   0.07646 .  
+#> c:(Intercept)          0.734059   0.081999  8.9520 2.432e-15 ***
+#> d:(Intercept)          3.962500   0.079820 49.6428 < 2.2e-16 ***
+#> e:(Intercept)         21.060041   1.286127 16.3748 < 2.2e-16 ***
+#> e:herbicideglyphosate 27.165817   5.568005  4.8789 2.958e-06 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.495335 (135 degrees of freedom)
+
+## Plotting the fitted curves
+plot(S.alba.comp.m1, xlab = "Dose (g/ha)", ylab = "Dry matter (g/pot)")
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/S.alba.comp.md b/docs/reference/S.alba.comp.md new file mode 100644 index 00000000..cca248ee --- /dev/null +++ b/docs/reference/S.alba.comp.md @@ -0,0 +1,102 @@ +# Potency of two herbicides + +Data are from an experiment, comparing the potency of the two herbicides +glyphosate and bentazone in white mustard *Sinapis alba*. + +## Usage + +``` r +data(S.alba.comp) +``` + +## Format + +A data frame with 141 observations on the following 8 variables. + +- `exp`: + + a factor with levels ben1, ben2, gly1, gly2 indicating which + experiment each observation belongs to. + +- `herbicide`: + + a factor with levels `Bentazone` `Glyphosate` (the two herbicides + applied). + +- `dose`: + + a numeric vector containing the dose in g/ha. + +- `drymatter`: + + a numeric vector containing the response (dry matter in g/pot). + +- `Tf`: + + a numeric vector . + +- `area`: + + a numeric vector . + +- `Fo`: + + a numeric vector . + +- `Fm`: + + a numeric vector . + +## Details + +The lower and upper limits for the two herbicides can be assumed +identical, whereas slopes and ED50 values are different (in the +log-logistic model). + +## Source + +Christensen, M. G. and Teicher, H. B., and Streibig, J. C. (2003) +Linking fluorescence induction curve and biomass in herbicide screening, +*Pest Management Science*, **59**, 1303–1310. + +## Examples + +``` r +library(drc) + +## Displaying the data +head(S.alba.comp) +#> exp herbicide dose drymatter Tf area Fo Fm +#> 1 ben1 bentazone 0 4.1 200 31200 278 1662 +#> 2 ben1 bentazone 0 3.4 230 30600 278 1670 +#> 3 ben1 bentazone 0 2.6 210 27400 299 1646 +#> 4 ben1 bentazone 0 3.5 260 34600 288 1715 +#> 5 ben1 bentazone 0 4.3 200 31000 272 1651 +#> 6 ben1 bentazone 0 4.2 240 31400 286 1681 + +## Fitting a four-parameter log-logistic model with common upper and lower limits +S.alba.comp.m1 <- drm(drymatter ~ dose, herbicide, data = S.alba.comp, fct = LL.4(), +pmodels = list(~herbicide, ~1, ~1, ~herbicide)) +summary(S.alba.comp.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 5.036275 2.100683 2.3974 0.01788 * +#> b:herbicideglyphosate -3.682298 2.062582 -1.7853 0.07646 . +#> c:(Intercept) 0.734059 0.081999 8.9520 2.432e-15 *** +#> d:(Intercept) 3.962500 0.079820 49.6428 < 2.2e-16 *** +#> e:(Intercept) 21.060041 1.286127 16.3748 < 2.2e-16 *** +#> e:herbicideglyphosate 27.165817 5.568005 4.8789 2.958e-06 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.495335 (135 degrees of freedom) + +## Plotting the fitted curves +plot(S.alba.comp.m1, xlab = "Dose (g/ha)", ylab = "Dry matter (g/pot)") +``` diff --git a/docs/reference/S.alba.html b/docs/reference/S.alba.html new file mode 100644 index 00000000..550b451e --- /dev/null +++ b/docs/reference/S.alba.html @@ -0,0 +1,161 @@ + +Potency of two herbicides — S.alba • drc + Skip to contents + + +
    +
    +
    +

    Potency of two herbicides

    + +
    S.alba.Rd
    +
    + +
    +

    Data are from an experiment, comparing the potency of the two herbicides glyphosate and bentazone in + white mustard Sinapis alba.

    +
    + +
    +

    Usage

    + 
    data(S.alba)
    +
    + +
    +

    Format

    +

    A data frame with 68 observations on the following 3 variables.

    Dose
    +

    a numeric vector containing the dose in g/ha.

    + +
    Herbicide
    +

    a factor with levels Bentazone Glyphosate (the two herbicides applied).

    + +
    DryMatter
    +

    a numeric vector containing the response (dry matter in g/pot).

    + + +
    +
    +

    Details

    +

    The lower and upper limits for the two herbicides can be assumed identical, whereas slopes and ED50 values + are different (in the log-logistic model).

    +
    +
    +

    Source

    +

    Christensen, M. G. and Teicher, H. B., and Streibig, J. C. (2003) Linking fluorescence + induction curve and biomass in herbicide screening, Pest Management Science, + 59, 1303–1310.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Fitting a log-logistic model with
+##  common lower and upper limits
+S.alba.LL.4.1 <- drm(DryMatter~Dose, Herbicide, data=S.alba, fct = LL.4(),
+pmodels=data.frame(Herbicide,1,1,Herbicide)) 
+summary(S.alba.LL.4.1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                Estimate Std. Error t-value   p-value    
+#> b:Bentazone    5.046141   1.040135  4.8514 8.616e-06 ***
+#> b:Glyphosate   2.390218   0.495959  4.8194 9.684e-06 ***
+#> c:(Intercept)  0.716559   0.089245  8.0291 3.523e-11 ***
+#> d:(Intercept)  3.854861   0.076255 50.5519 < 2.2e-16 ***
+#> e:Bentazone   28.632355   2.038098 14.0486 < 2.2e-16 ***
+#> e:Glyphosate  66.890545   5.968819 11.2067 < 2.2e-16 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.3705151 (62 degrees of freedom)
+
+## Applying the optimal transform-both-sides Box-Cox transformation
+## (using the initial model fit)  
+S.alba.LL.4.2 <- boxcox(S.alba.LL.4.1, method = "anova") 
+
+summary(S.alba.LL.4.2)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                Estimate Std. Error t-value   p-value    
+#> b:Bentazone    4.838636   0.927240  5.2183 2.216e-06 ***
+#> b:Glyphosate   1.944311   0.236471  8.2222 1.630e-11 ***
+#> c:(Intercept)  0.682591   0.028768 23.7270 < 2.2e-16 ***
+#> d:(Intercept)  3.862611   0.106186 36.3760 < 2.2e-16 ***
+#> e:Bentazone   28.396147   1.874598 15.1479 < 2.2e-16 ***
+#> e:Glyphosate  65.573335   5.618945 11.6700 < 2.2e-16 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.1558947 (62 degrees of freedom)
+#> 
+#> Non-normality/heterogeneity adjustment through Box-Cox transformation
+#> 
+#> Estimated lambda: 0.101 
+#> Confidence interval for lambda: [-0.126, 0.331] 
+#> 
+
+## Plotting fitted regression curves together with the data
+plot(S.alba.LL.4.2)
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/S.alba.md b/docs/reference/S.alba.md new file mode 100644 index 00000000..fff9f272 --- /dev/null +++ b/docs/reference/S.alba.md @@ -0,0 +1,102 @@ +# Potency of two herbicides + +Data are from an experiment, comparing the potency of the two herbicides +glyphosate and bentazone in white mustard *Sinapis alba*. + +## Usage + +``` r +data(S.alba) +``` + +## Format + +A data frame with 68 observations on the following 3 variables. + +- `Dose`: + + a numeric vector containing the dose in g/ha. + +- `Herbicide`: + + a factor with levels `Bentazone` `Glyphosate` (the two herbicides + applied). + +- `DryMatter`: + + a numeric vector containing the response (dry matter in g/pot). + +## Details + +The lower and upper limits for the two herbicides can be assumed +identical, whereas slopes and ED50 values are different (in the +log-logistic model). + +## Source + +Christensen, M. G. and Teicher, H. B., and Streibig, J. C. (2003) +Linking fluorescence induction curve and biomass in herbicide screening, +*Pest Management Science*, **59**, 1303–1310. + +## Examples + +``` r +library(drc) + +## Fitting a log-logistic model with +## common lower and upper limits +S.alba.LL.4.1 <- drm(DryMatter~Dose, Herbicide, data=S.alba, fct = LL.4(), +pmodels=data.frame(Herbicide,1,1,Herbicide)) +summary(S.alba.LL.4.1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:Bentazone 5.046141 1.040135 4.8514 8.616e-06 *** +#> b:Glyphosate 2.390218 0.495959 4.8194 9.684e-06 *** +#> c:(Intercept) 0.716559 0.089245 8.0291 3.523e-11 *** +#> d:(Intercept) 3.854861 0.076255 50.5519 < 2.2e-16 *** +#> e:Bentazone 28.632355 2.038098 14.0486 < 2.2e-16 *** +#> e:Glyphosate 66.890545 5.968819 11.2067 < 2.2e-16 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.3705151 (62 degrees of freedom) + +## Applying the optimal transform-both-sides Box-Cox transformation +## (using the initial model fit) +S.alba.LL.4.2 <- boxcox(S.alba.LL.4.1, method = "anova") + +summary(S.alba.LL.4.2) +#> +#> Model fitted: Log-logistic (ED50 as parameter) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:Bentazone 4.838636 0.927240 5.2183 2.216e-06 *** +#> b:Glyphosate 1.944311 0.236471 8.2222 1.630e-11 *** +#> c:(Intercept) 0.682591 0.028768 23.7270 < 2.2e-16 *** +#> d:(Intercept) 3.862611 0.106186 36.3760 < 2.2e-16 *** +#> e:Bentazone 28.396147 1.874598 15.1479 < 2.2e-16 *** +#> e:Glyphosate 65.573335 5.618945 11.6700 < 2.2e-16 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.1558947 (62 degrees of freedom) +#> +#> Non-normality/heterogeneity adjustment through Box-Cox transformation +#> +#> Estimated lambda: 0.101 +#> Confidence interval for lambda: [-0.126, 0.331] +#> + +## Plotting fitted regression curves together with the data +plot(S.alba.LL.4.2) +``` diff --git a/docs/reference/S.capricornutum-1.png b/docs/reference/S.capricornutum-1.png new file mode 100644 index 00000000..c4f8cce3 Binary files /dev/null and b/docs/reference/S.capricornutum-1.png differ diff --git a/docs/reference/S.capricornutum-2.png b/docs/reference/S.capricornutum-2.png new file mode 100644 index 00000000..7338919a Binary files /dev/null and b/docs/reference/S.capricornutum-2.png differ diff --git a/docs/reference/S.capricornutum-3.png b/docs/reference/S.capricornutum-3.png new file mode 100644 index 00000000..f5219da6 Binary files /dev/null and b/docs/reference/S.capricornutum-3.png differ diff --git a/docs/reference/S.capricornutum-4.png b/docs/reference/S.capricornutum-4.png new file mode 100644 index 00000000..7338919a Binary files /dev/null and b/docs/reference/S.capricornutum-4.png differ diff --git a/docs/reference/S.capricornutum.html b/docs/reference/S.capricornutum.html new file mode 100644 index 00000000..8c7a9588 --- /dev/null +++ b/docs/reference/S.capricornutum.html @@ -0,0 +1,182 @@ + +Effect of cadmium on growth of green alga — S.capricornutum • drc + Skip to contents + + +
    +
    +
    +

    Effect of cadmium on growth of green alga

    + +
    S.capricornutum.Rd
    +
    + +
    +

    Green alga (Selenastrum capricornutum) was exposed to cadmium chloride concentrations + ranging from 5 to 80 micro g/L in geometric progression in 4-day population growth test.

    +
    + +
    +

    Usage

    + 
    data(S.capricornutum)
    +
    + +
    +

    Format

    +

    A data frame with 18 observations on the following 2 variables.

    conc
    +

    a numeric vector of cadmium chloride concentrations (micro g/L)

    + +
    count
    +

    a numeric vector of algal counts (10000 x cells /ml)

    + + +
    +
    +

    Details

    +

    The data are analysed in Bruce and Versteeg (1992) using a log-normal + dose-response model (using the logarithm with base 10).

    +
    +
    +

    Source

    +

    Bruce, R. D. and Versteeg, D. J. (1992) A statistical procedure for modeling continuous toxicity data, + Environ. Toxicol. Chem., 11, 1485–1494.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Fitting 3-parameter log-normal model
+s.cap.m1 <- drm(count ~ conc, data = S.capricornutum, fct = LN.3())
+
+## Residual plot
+plot(fitted(s.cap.m1), residuals(s.cap.m1))
+
+
+## Fitting model with transform-both-sides approach
+s.cap.m2 <- boxcox(s.cap.m1, method = "anova")
+
+summary(s.cap.m2)
+#> 
+#> Model fitted: Log-normal with lower limit at 0 (3 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                 Estimate Std. Error t-value   p-value    
+#> b:(Intercept)  -1.000982   0.044845 -22.321 6.394e-13 ***
+#> d:(Intercept) 132.079098   7.554011  17.485 2.191e-11 ***
+#> e:(Intercept)  12.428164   1.100916  11.289 9.915e-09 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.1551479 (15 degrees of freedom)
+#> 
+#> Non-normality/heterogeneity adjustment through Box-Cox transformation
+#> 
+#> Estimated lambda: 0.0606 
+#> Confidence interval for lambda: [-0.220, 0.414] 
+#> 
+
+## Residual plot after transformation (looks better)
+plot(fitted(s.cap.m2), residuals(s.cap.m2))
+
+
+## Calculating ED values on log scale
+ED(s.cap.m2, c(10, 20, 50), interval="delta")
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error    Lower    Upper
+#> e:10  3.45448    0.49164  2.40656  4.50239
+#> e:20  5.36110    0.66213  3.94980  6.77241
+#> e:50 12.42816    1.10092 10.08162 14.77471
+
+## Fitting model with ED50 as parameter
+## (for comparison)
+s.cap.m3 <- drm(count ~ conc, data = S.capricornutum, fct = LN.3(loge=TRUE))
+s.cap.m4 <- boxcox(s.cap.m3, method = "anova")
+
+summary(s.cap.m4)
+#> 
+#> Model fitted: Log-normal with lower limit at 0 (3 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                 Estimate Std. Error t-value   p-value    
+#> b:(Intercept)  -1.000991   0.044846 -22.320 6.395e-13 ***
+#> d:(Intercept) 132.078306   7.553934  17.485 2.191e-11 ***
+#> e:(Intercept)   2.519975   0.088583  28.448 1.821e-14 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.1551479 (15 degrees of freedom)
+#> 
+#> Non-normality/heterogeneity adjustment through Box-Cox transformation
+#> 
+#> Estimated lambda: 0.0606 
+#> Confidence interval for lambda: [-0.220, 0.414] 
+#> 
+ED(s.cap.m4, c(10, 20, 50), interval = "fls")
+#> 
+#> Estimated effective doses
+#> 
+#>       Estimate Std. Error     Lower     Upper
+#> e:10  3.454549   0.142322  2.550630  4.678808
+#> e:20  5.361195   0.123508  4.120343  6.975731
+#> e:50 12.428289   0.088583 10.289930 15.011022
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/S.capricornutum.md b/docs/reference/S.capricornutum.md new file mode 100644 index 00000000..f0f108cf --- /dev/null +++ b/docs/reference/S.capricornutum.md @@ -0,0 +1,123 @@ +# Effect of cadmium on growth of green alga + +Green alga (*Selenastrum capricornutum*) was exposed to cadmium chloride +concentrations ranging from 5 to 80 micro g/L in geometric progression +in 4-day population growth test. + +## Usage + +``` r +data(S.capricornutum) +``` + +## Format + +A data frame with 18 observations on the following 2 variables. + +- `conc`: + + a numeric vector of cadmium chloride concentrations (micro g/L) + +- `count`: + + a numeric vector of algal counts (10000 x cells /ml) + +## Details + +The data are analysed in Bruce and Versteeg (1992) using a log-normal +dose-response model (using the logarithm with base 10). + +## Source + +Bruce, R. D. and Versteeg, D. J. (1992) A statistical procedure for +modeling continuous toxicity data, *Environ. Toxicol. Chem.*, **11**, +1485–1494. + +## Examples + +``` r +library(drc) + +## Fitting 3-parameter log-normal model +s.cap.m1 <- drm(count ~ conc, data = S.capricornutum, fct = LN.3()) + +## Residual plot +plot(fitted(s.cap.m1), residuals(s.cap.m1)) + + +## Fitting model with transform-both-sides approach +s.cap.m2 <- boxcox(s.cap.m1, method = "anova") + +summary(s.cap.m2) +#> +#> Model fitted: Log-normal with lower limit at 0 (3 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) -1.000982 0.044845 -22.321 6.394e-13 *** +#> d:(Intercept) 132.079098 7.554011 17.485 2.191e-11 *** +#> e:(Intercept) 12.428164 1.100916 11.289 9.915e-09 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.1551479 (15 degrees of freedom) +#> +#> Non-normality/heterogeneity adjustment through Box-Cox transformation +#> +#> Estimated lambda: 0.0606 +#> Confidence interval for lambda: [-0.220, 0.414] +#> + +## Residual plot after transformation (looks better) +plot(fitted(s.cap.m2), residuals(s.cap.m2)) + + +## Calculating ED values on log scale +ED(s.cap.m2, c(10, 20, 50), interval="delta") +#> +#> Estimated effective doses +#> +#> Estimate Std. Error Lower Upper +#> e:10 3.45448 0.49164 2.40656 4.50239 +#> e:20 5.36110 0.66213 3.94980 6.77241 +#> e:50 12.42816 1.10092 10.08162 14.77471 + +## Fitting model with ED50 as parameter +## (for comparison) +s.cap.m3 <- drm(count ~ conc, data = S.capricornutum, fct = LN.3(loge=TRUE)) +s.cap.m4 <- boxcox(s.cap.m3, method = "anova") + +summary(s.cap.m4) +#> +#> Model fitted: Log-normal with lower limit at 0 (3 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) -1.000991 0.044846 -22.320 6.395e-13 *** +#> d:(Intercept) 132.078306 7.553934 17.485 2.191e-11 *** +#> e:(Intercept) 2.519975 0.088583 28.448 1.821e-14 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.1551479 (15 degrees of freedom) +#> +#> Non-normality/heterogeneity adjustment through Box-Cox transformation +#> +#> Estimated lambda: 0.0606 +#> Confidence interval for lambda: [-0.220, 0.414] +#> +ED(s.cap.m4, c(10, 20, 50), interval = "fls") +#> +#> Estimated effective doses +#> +#> Estimate Std. Error Lower Upper +#> e:10 3.454549 0.142322 2.550630 4.678808 +#> e:20 5.361195 0.123508 4.120343 6.975731 +#> e:50 12.428289 0.088583 10.289930 15.011022 +``` diff --git a/docs/reference/TCDD-1.png b/docs/reference/TCDD-1.png new file mode 100644 index 00000000..c7340258 Binary files /dev/null and b/docs/reference/TCDD-1.png differ diff --git a/docs/reference/TCDD.html b/docs/reference/TCDD.html new file mode 100644 index 00000000..845eb4ee --- /dev/null +++ b/docs/reference/TCDD.html @@ -0,0 +1,126 @@ + +Liver tumor incidence — TCDD • drc + Skip to contents + + +
    +
    +
    +

    Liver tumor incidence

    + +
    TCDD.Rd
    +
    + +
    +

    Liver tumor incidence in Sprague-Dawley rats exposed to the chemical like 2,3,7,8-tetrachlorodibenzo-pdioxin +(TCDD).

    +
    + +
    +

    Usage

    + 
    data(TCDD)
    +
    + +
    +

    Format

    +

    A data frame with 6 observations on the following 3 variables.

    conc
    +

    a numeric vector reporting the concentration of TCDD (ng/kg)

    + +
    total
    +

    a numeric vector

    + +
    incidence
    +

    a numeric vector

    + + +
    +
    +

    Source

    +

    R. Kociba, D. Keyes, J. Beyer, R. Carreon, C. Wade, D. Dittenber, R. Kalnins, L. Frauson, +C. Park, S. Barnard, R. Hummel, and C. Humiston (1978). Results of a two-year chronic toxicity +and oncogenicity study of 2,3,7,8-tetrachlorodibenzo-p-dioxin in rats. Toxicology and +Applied Pharmacology, 46(2):279–303.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Displaying the data
+head(TCDD)
+#>    conc total incidence
+#> 1  0.00    86         2
+#> 2  1.55    50         1
+#> 3  7.15    50         9
+#> 4 38.56    45        14
+
+## Fitting a two-parameter log-logistic model for binomial response
+TCDD.m1 <- drm(incidence/total ~ conc, weights = total,
+data = TCDD, fct = LL.2(), type = "binomial")
+summary(TCDD.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept) -0.73196    0.20589 -3.5551 0.0003778 ***
+#> e:(Intercept) 96.49945   58.87278  1.6391 0.1011886    
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+## Plotting the fitted curve
+plot(TCDD.m1, xlab = "Concentration of TCDD (ng/kg)", ylab = "Tumor incidence")
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/TCDD.md b/docs/reference/TCDD.md new file mode 100644 index 00000000..87e68ee8 --- /dev/null +++ b/docs/reference/TCDD.md @@ -0,0 +1,66 @@ +# Liver tumor incidence + +Liver tumor incidence in Sprague-Dawley rats exposed to the chemical +like 2,3,7,8-tetrachlorodibenzo-pdioxin (TCDD). + +## Usage + +``` r +data(TCDD) +``` + +## Format + +A data frame with 6 observations on the following 3 variables. + +- `conc`: + + a numeric vector reporting the concentration of TCDD (ng/kg) + +- `total`: + + a numeric vector + +- `incidence`: + + a numeric vector + +## Source + +R. Kociba, D. Keyes, J. Beyer, R. Carreon, C. Wade, D. Dittenber, R. +Kalnins, L. Frauson, C. Park, S. Barnard, R. Hummel, and C. Humiston +(1978). Results of a two-year chronic toxicity and oncogenicity study of +2,3,7,8-tetrachlorodibenzo-p-dioxin in rats. Toxicology and Applied +Pharmacology, **46(2)**:279–303. + +## Examples + +``` r +library(drc) + +## Displaying the data +head(TCDD) +#> conc total incidence +#> 1 0.00 86 2 +#> 2 1.55 50 1 +#> 3 7.15 50 9 +#> 4 38.56 45 14 + +## Fitting a two-parameter log-logistic model for binomial response +TCDD.m1 <- drm(incidence/total ~ conc, weights = total, +data = TCDD, fct = LL.2(), type = "binomial") +summary(TCDD.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) -0.73196 0.20589 -3.5551 0.0003778 *** +#> e:(Intercept) 96.49945 58.87278 1.6391 0.1011886 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 + +## Plotting the fitted curve +plot(TCDD.m1, xlab = "Concentration of TCDD (ng/kg)", ylab = "Tumor incidence") +``` diff --git a/docs/reference/UCRS.4a.html b/docs/reference/UCRS.4a.html new file mode 100644 index 00000000..f77ab36d --- /dev/null +++ b/docs/reference/UCRS.4a.html @@ -0,0 +1,91 @@ + +U-shaped CRS model with lower limit 0 (alpha=1) — UCRS.4a • drc + Skip to contents + + +
    +
    +
    +

    U-shaped CRS model with lower limit 0 (alpha=1)

    + Source: R/ucedergreen.R +
    UCRS.4a.Rd
    +
    + +
    +

    Four-parameter u-shaped CRS hormesis model with lower limit fixed at 0 and alpha=1.

    +
    + +
    +

    Usage

    + 
    UCRS.4a(names = c("b", "d", "e", "f"), ...)
    +
    + +
    +

    Arguments

    + + +
    names
    +

    a vector of character strings giving the names of the parameters.

    + + +
    ...
    +

    additional arguments passed to ucedergreen.

    + +
    +
    +

    Value

    +

    A list (see ucedergreen).

    +
    +
    +

    See also

    +

    ucedergreen, UCRS.5a, CRS.4a

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/UCRS.4a.md b/docs/reference/UCRS.4a.md new file mode 100644 index 00000000..18a8f601 --- /dev/null +++ b/docs/reference/UCRS.4a.md @@ -0,0 +1,32 @@ +# U-shaped CRS model with lower limit 0 (alpha=1) + +Four-parameter u-shaped CRS hormesis model with lower limit fixed at 0 +and alpha=1. + +## Usage + +``` r +UCRS.4a(names = c("b", "d", "e", "f"), ...) +``` + +## Arguments + +- names: + + a vector of character strings giving the names of the parameters. + +- ...: + + additional arguments passed to + [`ucedergreen`](https://hreinwald.github.io/drc/reference/ucedergreen.md). + +## Value + +A list (see +[`ucedergreen`](https://hreinwald.github.io/drc/reference/ucedergreen.md)). + +## See also + +[`ucedergreen`](https://hreinwald.github.io/drc/reference/ucedergreen.md), +[`UCRS.5a`](https://hreinwald.github.io/drc/reference/UCRS.5a.md), +[`CRS.4a`](https://hreinwald.github.io/drc/reference/CRS.4a.md) diff --git a/docs/reference/UCRS.4b.html b/docs/reference/UCRS.4b.html new file mode 100644 index 00000000..50d1b315 --- /dev/null +++ b/docs/reference/UCRS.4b.html @@ -0,0 +1,91 @@ + +U-shaped CRS model with lower limit 0 (alpha=0.5) — UCRS.4b • drc + Skip to contents + + +
    +
    +
    +

    U-shaped CRS model with lower limit 0 (alpha=0.5)

    + Source: R/ucedergreen.R +
    UCRS.4b.Rd
    +
    + +
    +

    Four-parameter u-shaped CRS hormesis model with lower limit fixed at 0 and alpha=0.5.

    +
    + +
    +

    Usage

    + 
    UCRS.4b(names = c("b", "d", "e", "f"), ...)
    +
    + +
    +

    Arguments

    + + +
    names
    +

    a vector of character strings giving the names of the parameters.

    + + +
    ...
    +

    additional arguments passed to ucedergreen.

    + +
    +
    +

    Value

    +

    A list (see ucedergreen).

    +
    +
    +

    See also

    +

    ucedergreen, UCRS.4a, CRS.4b

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/UCRS.4b.md b/docs/reference/UCRS.4b.md new file mode 100644 index 00000000..40538afa --- /dev/null +++ b/docs/reference/UCRS.4b.md @@ -0,0 +1,32 @@ +# U-shaped CRS model with lower limit 0 (alpha=0.5) + +Four-parameter u-shaped CRS hormesis model with lower limit fixed at 0 +and alpha=0.5. + +## Usage + +``` r +UCRS.4b(names = c("b", "d", "e", "f"), ...) +``` + +## Arguments + +- names: + + a vector of character strings giving the names of the parameters. + +- ...: + + additional arguments passed to + [`ucedergreen`](https://hreinwald.github.io/drc/reference/ucedergreen.md). + +## Value + +A list (see +[`ucedergreen`](https://hreinwald.github.io/drc/reference/ucedergreen.md)). + +## See also + +[`ucedergreen`](https://hreinwald.github.io/drc/reference/ucedergreen.md), +[`UCRS.4a`](https://hreinwald.github.io/drc/reference/UCRS.4a.md), +[`CRS.4b`](https://hreinwald.github.io/drc/reference/CRS.4b.md) diff --git a/docs/reference/UCRS.4c.html b/docs/reference/UCRS.4c.html new file mode 100644 index 00000000..8a72b2ce --- /dev/null +++ b/docs/reference/UCRS.4c.html @@ -0,0 +1,91 @@ + +U-shaped CRS model with lower limit 0 (alpha=0.25) — UCRS.4c • drc + Skip to contents + + +
    +
    +
    +

    U-shaped CRS model with lower limit 0 (alpha=0.25)

    + Source: R/ucedergreen.R +
    UCRS.4c.Rd
    +
    + +
    +

    Four-parameter u-shaped CRS hormesis model with lower limit fixed at 0 and alpha=0.25.

    +
    + +
    +

    Usage

    + 
    UCRS.4c(names = c("b", "d", "e", "f"), ...)
    +
    + +
    +

    Arguments

    + + +
    names
    +

    a vector of character strings giving the names of the parameters.

    + + +
    ...
    +

    additional arguments passed to ucedergreen.

    + +
    +
    +

    Value

    +

    A list (see ucedergreen).

    +
    +
    +

    See also

    +

    ucedergreen, UCRS.4a, CRS.4c

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/UCRS.4c.md b/docs/reference/UCRS.4c.md new file mode 100644 index 00000000..b7f7da13 --- /dev/null +++ b/docs/reference/UCRS.4c.md @@ -0,0 +1,32 @@ +# U-shaped CRS model with lower limit 0 (alpha=0.25) + +Four-parameter u-shaped CRS hormesis model with lower limit fixed at 0 +and alpha=0.25. + +## Usage + +``` r +UCRS.4c(names = c("b", "d", "e", "f"), ...) +``` + +## Arguments + +- names: + + a vector of character strings giving the names of the parameters. + +- ...: + + additional arguments passed to + [`ucedergreen`](https://hreinwald.github.io/drc/reference/ucedergreen.md). + +## Value + +A list (see +[`ucedergreen`](https://hreinwald.github.io/drc/reference/ucedergreen.md)). + +## See also + +[`ucedergreen`](https://hreinwald.github.io/drc/reference/ucedergreen.md), +[`UCRS.4a`](https://hreinwald.github.io/drc/reference/UCRS.4a.md), +[`CRS.4c`](https://hreinwald.github.io/drc/reference/CRS.4c.md) diff --git a/docs/reference/UCRS.5a.html b/docs/reference/UCRS.5a.html new file mode 100644 index 00000000..c190330e --- /dev/null +++ b/docs/reference/UCRS.5a.html @@ -0,0 +1,91 @@ + +U-shaped CRS five-parameter model (alpha=1) — UCRS.5a • drc + Skip to contents + + +
    +
    +
    +

    U-shaped CRS five-parameter model (alpha=1)

    + Source: R/ucedergreen.R +
    UCRS.5a.Rd
    +
    + +
    +

    Five-parameter u-shaped CRS hormesis model with alpha=1.

    +
    + +
    +

    Usage

    + 
    UCRS.5a(names = c("b", "c", "d", "e", "f"), ...)
    +
    + +
    +

    Arguments

    + + +
    names
    +

    a vector of character strings giving the names of the parameters.

    + + +
    ...
    +

    additional arguments passed to ucedergreen.

    + +
    +
    +

    Value

    +

    A list (see ucedergreen).

    +
    +
    +

    See also

    +

    ucedergreen, UCRS.4a, CRS.5a

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/UCRS.5a.md b/docs/reference/UCRS.5a.md new file mode 100644 index 00000000..a8647792 --- /dev/null +++ b/docs/reference/UCRS.5a.md @@ -0,0 +1,31 @@ +# U-shaped CRS five-parameter model (alpha=1) + +Five-parameter u-shaped CRS hormesis model with alpha=1. + +## Usage + +``` r +UCRS.5a(names = c("b", "c", "d", "e", "f"), ...) +``` + +## Arguments + +- names: + + a vector of character strings giving the names of the parameters. + +- ...: + + additional arguments passed to + [`ucedergreen`](https://hreinwald.github.io/drc/reference/ucedergreen.md). + +## Value + +A list (see +[`ucedergreen`](https://hreinwald.github.io/drc/reference/ucedergreen.md)). + +## See also + +[`ucedergreen`](https://hreinwald.github.io/drc/reference/ucedergreen.md), +[`UCRS.4a`](https://hreinwald.github.io/drc/reference/UCRS.4a.md), +[`CRS.5a`](https://hreinwald.github.io/drc/reference/CRS.5a.md) diff --git a/docs/reference/UCRS.5b.html b/docs/reference/UCRS.5b.html new file mode 100644 index 00000000..cf09996b --- /dev/null +++ b/docs/reference/UCRS.5b.html @@ -0,0 +1,91 @@ + +U-shaped CRS five-parameter model (alpha=0.5) — UCRS.5b • drc + Skip to contents + + +
    +
    +
    +

    U-shaped CRS five-parameter model (alpha=0.5)

    + Source: R/ucedergreen.R +
    UCRS.5b.Rd
    +
    + +
    +

    Five-parameter u-shaped CRS hormesis model with alpha=0.5.

    +
    + +
    +

    Usage

    + 
    UCRS.5b(names = c("b", "c", "d", "e", "f"), ...)
    +
    + +
    +

    Arguments

    + + +
    names
    +

    a vector of character strings giving the names of the parameters.

    + + +
    ...
    +

    additional arguments passed to ucedergreen.

    + +
    +
    +

    Value

    +

    A list (see ucedergreen).

    +
    +
    +

    See also

    +

    ucedergreen, UCRS.5a, CRS.5b

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/UCRS.5b.md b/docs/reference/UCRS.5b.md new file mode 100644 index 00000000..cfc87a6d --- /dev/null +++ b/docs/reference/UCRS.5b.md @@ -0,0 +1,31 @@ +# U-shaped CRS five-parameter model (alpha=0.5) + +Five-parameter u-shaped CRS hormesis model with alpha=0.5. + +## Usage + +``` r +UCRS.5b(names = c("b", "c", "d", "e", "f"), ...) +``` + +## Arguments + +- names: + + a vector of character strings giving the names of the parameters. + +- ...: + + additional arguments passed to + [`ucedergreen`](https://hreinwald.github.io/drc/reference/ucedergreen.md). + +## Value + +A list (see +[`ucedergreen`](https://hreinwald.github.io/drc/reference/ucedergreen.md)). + +## See also + +[`ucedergreen`](https://hreinwald.github.io/drc/reference/ucedergreen.md), +[`UCRS.5a`](https://hreinwald.github.io/drc/reference/UCRS.5a.md), +[`CRS.5b`](https://hreinwald.github.io/drc/reference/CRS.5b.md) diff --git a/docs/reference/UCRS.5c.html b/docs/reference/UCRS.5c.html new file mode 100644 index 00000000..ae8867c5 --- /dev/null +++ b/docs/reference/UCRS.5c.html @@ -0,0 +1,91 @@ + +U-shaped CRS five-parameter model (alpha=0.25) — UCRS.5c • drc + Skip to contents + + +
    +
    +
    +

    U-shaped CRS five-parameter model (alpha=0.25)

    + Source: R/ucedergreen.R +
    UCRS.5c.Rd
    +
    + +
    +

    Five-parameter u-shaped CRS hormesis model with alpha=0.25.

    +
    + +
    +

    Usage

    + 
    UCRS.5c(names = c("b", "c", "d", "e", "f"), ...)
    +
    + +
    +

    Arguments

    + + +
    names
    +

    a vector of character strings giving the names of the parameters.

    + + +
    ...
    +

    additional arguments passed to ucedergreen.

    + +
    +
    +

    Value

    +

    A list (see ucedergreen).

    +
    +
    +

    See also

    +

    ucedergreen, UCRS.5a, CRS.5c

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/UCRS.5c.md b/docs/reference/UCRS.5c.md new file mode 100644 index 00000000..425f1502 --- /dev/null +++ b/docs/reference/UCRS.5c.md @@ -0,0 +1,31 @@ +# U-shaped CRS five-parameter model (alpha=0.25) + +Five-parameter u-shaped CRS hormesis model with alpha=0.25. + +## Usage + +``` r +UCRS.5c(names = c("b", "c", "d", "e", "f"), ...) +``` + +## Arguments + +- names: + + a vector of character strings giving the names of the parameters. + +- ...: + + additional arguments passed to + [`ucedergreen`](https://hreinwald.github.io/drc/reference/ucedergreen.md). + +## Value + +A list (see +[`ucedergreen`](https://hreinwald.github.io/drc/reference/ucedergreen.md)). + +## See also + +[`ucedergreen`](https://hreinwald.github.io/drc/reference/ucedergreen.md), +[`UCRS.5a`](https://hreinwald.github.io/drc/reference/UCRS.5a.md), +[`CRS.5c`](https://hreinwald.github.io/drc/reference/CRS.5c.md) diff --git a/docs/reference/W1.2.html b/docs/reference/W1.2.html new file mode 100644 index 00000000..d06c9610 --- /dev/null +++ b/docs/reference/W1.2.html @@ -0,0 +1,124 @@ + +Two-parameter Weibull type 1 model — W1.2 • drc + Skip to contents + + +
    +
    +
    +

    Two-parameter Weibull type 1 model

    + Source: R/weibull1.R +
    W1.2.Rd
    +
    + +
    +

    A two-parameter Weibull type 1 model with the lower limit fixed at 0 +and the upper limit fixed at a specified value (default 1).

    +
    + +
    +

    Usage

    + 
    W1.2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...)
+
+w2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...)
    +
    + +
    +

    Arguments

    + + +
    upper
    +

    numeric value giving the fixed upper limit. The default is 1.

    + + +
    fixed
    +

    numeric vector of length 2. Specifies which parameters are +fixed and at what value. Use NA for parameters that are not fixed.

    + + +
    names
    +

    character vector of length 2 giving the names of the +parameters. The default is c("b", "e").

    + + +
    ...
    +

    additional arguments passed to weibull1, most +notably method (a character string: "1" (default), +"2", "3", or "4") which selects the self-starter +method for obtaining starting values. See weibull1 for +details.

    + +
    +
    +

    Value

    +

    A list of class Weibull-1 containing the nonlinear function, +self starter function, and parameter names.

    +
    +
    +

    Details

    +

    The model is given by the expression +$$f(x) = upper \exp(-\exp(b(\log(x) - \log(e))))$$

    +

    This is mostly used for binomial/quantal responses.

    +
    +
    +

    See also

    +

    weibull1, W1.3, W1.4

    +
    + +
    +

    Examples

    + 
    earthworms.m1 <- drm(number/total ~ dose, weights = total,
+  data = earthworms, fct = W1.2(), type = "binomial")
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/W1.2.md b/docs/reference/W1.2.md new file mode 100644 index 00000000..0c5da814 --- /dev/null +++ b/docs/reference/W1.2.md @@ -0,0 +1,63 @@ +# Two-parameter Weibull type 1 model + +A two-parameter Weibull type 1 model with the lower limit fixed at 0 and +the upper limit fixed at a specified value (default 1). + +## Usage + +``` r +W1.2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) + +w2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) +``` + +## Arguments + +- upper: + + numeric value giving the fixed upper limit. The default is 1. + +- fixed: + + numeric vector of length 2. Specifies which parameters are fixed and + at what value. Use `NA` for parameters that are not fixed. + +- names: + + character vector of length 2 giving the names of the parameters. The + default is `c("b", "e")`. + +- ...: + + additional arguments passed to + [`weibull1`](https://hreinwald.github.io/drc/reference/weibull1.md), + most notably `method` (a character string: `"1"` (default), `"2"`, + `"3"`, or `"4"`) which selects the self-starter method for obtaining + starting values. See + [`weibull1`](https://hreinwald.github.io/drc/reference/weibull1.md) + for details. + +## Value + +A list of class `Weibull-1` containing the nonlinear function, self +starter function, and parameter names. + +## Details + +The model is given by the expression \$\$f(x) = upper +\exp(-\exp(b(\log(x) - \log(e))))\$\$ + +This is mostly used for binomial/quantal responses. + +## See also + +[`weibull1`](https://hreinwald.github.io/drc/reference/weibull1.md), +[`W1.3`](https://hreinwald.github.io/drc/reference/W1.3.md), +[`W1.4`](https://hreinwald.github.io/drc/reference/W1.4.md) + +## Examples + +``` r +earthworms.m1 <- drm(number/total ~ dose, weights = total, + data = earthworms, fct = W1.2(), type = "binomial") +``` diff --git a/docs/reference/W1.3.html b/docs/reference/W1.3.html new file mode 100644 index 00000000..bc45e9ac --- /dev/null +++ b/docs/reference/W1.3.html @@ -0,0 +1,117 @@ + +Three-parameter Weibull type 1 model — W1.3 • drc + Skip to contents + + +
    +
    +
    +

    Three-parameter Weibull type 1 model

    + Source: R/weibull1.R +
    W1.3.Rd
    +
    + +
    +

    A three-parameter Weibull type 1 model with the lower limit fixed at 0.

    +
    + +
    +

    Usage

    + 
    W1.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...)
+
+w3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector of length 3. Specifies which parameters are +fixed and at what value. Use NA for parameters that are not fixed.

    + + +
    names
    +

    character vector of length 3 giving the names of the +parameters. The default is c("b", "d", "e").

    + + +
    ...
    +

    additional arguments passed to weibull1, most +notably method (a character string: "1" (default), +"2", "3", or "4") which selects the self-starter +method for obtaining starting values. See weibull1 for +details.

    + +
    +
    +

    Value

    +

    A list of class Weibull-1 containing the nonlinear function, +self starter function, and parameter names.

    +
    +
    +

    Details

    +

    The model is given by the expression +$$f(x) = d \exp(-\exp(b(\log(x) - \log(e))))$$

    +

    This is a special case of the four-parameter Weibull type 1 model +where the lower limit is fixed at 0.

    +
    +
    +

    See also

    +

    weibull1, W1.2, W1.4

    +
    + +
    +

    Examples

    + 
    ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.3())
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/W1.3.md b/docs/reference/W1.3.md new file mode 100644 index 00000000..e8e21a85 --- /dev/null +++ b/docs/reference/W1.3.md @@ -0,0 +1,58 @@ +# Three-parameter Weibull type 1 model + +A three-parameter Weibull type 1 model with the lower limit fixed at 0. + +## Usage + +``` r +W1.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) + +w3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) +``` + +## Arguments + +- fixed: + + numeric vector of length 3. Specifies which parameters are fixed and + at what value. Use `NA` for parameters that are not fixed. + +- names: + + character vector of length 3 giving the names of the parameters. The + default is `c("b", "d", "e")`. + +- ...: + + additional arguments passed to + [`weibull1`](https://hreinwald.github.io/drc/reference/weibull1.md), + most notably `method` (a character string: `"1"` (default), `"2"`, + `"3"`, or `"4"`) which selects the self-starter method for obtaining + starting values. See + [`weibull1`](https://hreinwald.github.io/drc/reference/weibull1.md) + for details. + +## Value + +A list of class `Weibull-1` containing the nonlinear function, self +starter function, and parameter names. + +## Details + +The model is given by the expression \$\$f(x) = d \exp(-\exp(b(\log(x) - +\log(e))))\$\$ + +This is a special case of the four-parameter Weibull type 1 model where +the lower limit is fixed at 0. + +## See also + +[`weibull1`](https://hreinwald.github.io/drc/reference/weibull1.md), +[`W1.2`](https://hreinwald.github.io/drc/reference/W1.2.md), +[`W1.4`](https://hreinwald.github.io/drc/reference/W1.4.md) + +## Examples + +``` r +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.3()) +``` diff --git a/docs/reference/W1.3u.html b/docs/reference/W1.3u.html new file mode 100644 index 00000000..993f715e --- /dev/null +++ b/docs/reference/W1.3u.html @@ -0,0 +1,116 @@ + +Three-parameter Weibull type 1 model with upper limit fixed — W1.3u • drc + Skip to contents + + +
    +
    +
    +

    Three-parameter Weibull type 1 model with upper limit fixed

    + Source: R/weibull1.R +
    W1.3u.Rd
    +
    + +
    +

    A three-parameter Weibull type 1 model with the upper limit fixed +(default 1).

    +
    + +
    +

    Usage

    + 
    W1.3u(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...)
    +
    + +
    +

    Arguments

    + + +
    upper
    +

    numeric value giving the fixed upper limit. The default is 1.

    + + +
    fixed
    +

    numeric vector of length 3. Specifies which parameters are +fixed and at what value. Use NA for parameters that are not fixed.

    + + +
    names
    +

    character vector of length 3 giving the names of the +parameters. The default is c("b", "c", "e").

    + + +
    ...
    +

    additional arguments passed to weibull1, most +notably method (a character string: "1" (default), +"2", "3", or "4") which selects the self-starter +method for obtaining starting values. See weibull1 for +details.

    + +
    +
    +

    Value

    +

    A list of class Weibull-1 containing the nonlinear function, +self starter function, and parameter names.

    +
    +
    +

    Details

    +

    The model is given by the expression +$$f(x) = c + (upper - c) \exp(-\exp(b(\log(x) - \log(e))))$$

    +

    This is a special case of the four-parameter Weibull type 1 model +where the upper limit is fixed at a specified value.

    +
    +
    +

    See also

    +

    weibull1, W1.3, W1.4

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/W1.3u.md b/docs/reference/W1.3u.md new file mode 100644 index 00000000..9f4f0aa7 --- /dev/null +++ b/docs/reference/W1.3u.md @@ -0,0 +1,55 @@ +# Three-parameter Weibull type 1 model with upper limit fixed + +A three-parameter Weibull type 1 model with the upper limit fixed +(default 1). + +## Usage + +``` r +W1.3u(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...) +``` + +## Arguments + +- upper: + + numeric value giving the fixed upper limit. The default is 1. + +- fixed: + + numeric vector of length 3. Specifies which parameters are fixed and + at what value. Use `NA` for parameters that are not fixed. + +- names: + + character vector of length 3 giving the names of the parameters. The + default is `c("b", "c", "e")`. + +- ...: + + additional arguments passed to + [`weibull1`](https://hreinwald.github.io/drc/reference/weibull1.md), + most notably `method` (a character string: `"1"` (default), `"2"`, + `"3"`, or `"4"`) which selects the self-starter method for obtaining + starting values. See + [`weibull1`](https://hreinwald.github.io/drc/reference/weibull1.md) + for details. + +## Value + +A list of class `Weibull-1` containing the nonlinear function, self +starter function, and parameter names. + +## Details + +The model is given by the expression \$\$f(x) = c + (upper - c) +\exp(-\exp(b(\log(x) - \log(e))))\$\$ + +This is a special case of the four-parameter Weibull type 1 model where +the upper limit is fixed at a specified value. + +## See also + +[`weibull1`](https://hreinwald.github.io/drc/reference/weibull1.md), +[`W1.3`](https://hreinwald.github.io/drc/reference/W1.3.md), +[`W1.4`](https://hreinwald.github.io/drc/reference/W1.4.md) diff --git a/docs/reference/W1.4.html b/docs/reference/W1.4.html new file mode 100644 index 00000000..91b8fe77 --- /dev/null +++ b/docs/reference/W1.4.html @@ -0,0 +1,123 @@ + +Four-parameter Weibull type 1 model — W1.4 • drc + Skip to contents + + +
    +
    +
    +

    Four-parameter Weibull type 1 model

    + Source: R/weibull1.R +
    W1.4.Rd
    +
    + +
    +

    A four-parameter Weibull type 1 model.

    +
    + +
    +

    Usage

    + 
    W1.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...)
+
+w4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector of length 4. Specifies which parameters are +fixed and at what value. Use NA for parameters that are not fixed.

    + + +
    names
    +

    character vector of length 4 giving the names of the +parameters. The default is c("b", "c", "d", "e").

    + + +
    ...
    +

    additional arguments passed to weibull1, most +notably method (a character string: "1" (default), +"2", "3", or "4") which selects the self-starter +method for obtaining starting values. See weibull1 for +details.

    + +
    +
    +

    Value

    +

    A list of class Weibull-1 containing the nonlinear function, +self starter function, and parameter names.

    +
    +
    +

    Details

    +

    The model is given by the expression +$$f(x) = c + (d - c) \exp(-\exp(b(\log(x) - \log(e))))$$

    +
    +
    +

    References

    +

    Seber, G. A. F. and Wild, C. J. (1989) +Nonlinear Regression, New York: Wiley & Sons (pp. 338–339).

    +

    Ritz, C. (2009) +Towards a unified approach to dose-response modeling in ecotoxicology. +Environ Toxicol Chem, 29, 220–229.

    +
    +
    +

    See also

    +

    weibull1, W1.2, W1.3

    +
    + +
    +

    Examples

    + 
    terbuthylazin.m1 <- drm(rgr ~ dose, data = terbuthylazin, fct = W1.4())
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/W1.4.md b/docs/reference/W1.4.md new file mode 100644 index 00000000..90d7d0ef --- /dev/null +++ b/docs/reference/W1.4.md @@ -0,0 +1,63 @@ +# Four-parameter Weibull type 1 model + +A four-parameter Weibull type 1 model. + +## Usage + +``` r +W1.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) + +w4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) +``` + +## Arguments + +- fixed: + + numeric vector of length 4. Specifies which parameters are fixed and + at what value. Use `NA` for parameters that are not fixed. + +- names: + + character vector of length 4 giving the names of the parameters. The + default is `c("b", "c", "d", "e")`. + +- ...: + + additional arguments passed to + [`weibull1`](https://hreinwald.github.io/drc/reference/weibull1.md), + most notably `method` (a character string: `"1"` (default), `"2"`, + `"3"`, or `"4"`) which selects the self-starter method for obtaining + starting values. See + [`weibull1`](https://hreinwald.github.io/drc/reference/weibull1.md) + for details. + +## Value + +A list of class `Weibull-1` containing the nonlinear function, self +starter function, and parameter names. + +## Details + +The model is given by the expression \$\$f(x) = c + (d - c) +\exp(-\exp(b(\log(x) - \log(e))))\$\$ + +## References + +Seber, G. A. F. and Wild, C. J. (1989) *Nonlinear Regression*, New York: +Wiley & Sons (pp. 338–339). + +Ritz, C. (2009) Towards a unified approach to dose-response modeling in +ecotoxicology. *Environ Toxicol Chem*, **29**, 220–229. + +## See also + +[`weibull1`](https://hreinwald.github.io/drc/reference/weibull1.md), +[`W1.2`](https://hreinwald.github.io/drc/reference/W1.2.md), +[`W1.3`](https://hreinwald.github.io/drc/reference/W1.3.md) + +## Examples + +``` r +terbuthylazin.m1 <- drm(rgr ~ dose, data = terbuthylazin, fct = W1.4()) +``` diff --git a/docs/reference/W2.2.html b/docs/reference/W2.2.html new file mode 100644 index 00000000..7961f521 --- /dev/null +++ b/docs/reference/W2.2.html @@ -0,0 +1,122 @@ + +Two-parameter Weibull (type 2) model — W2.2 • drc + Skip to contents + + +
    +
    +
    +

    Two-parameter Weibull (type 2) model

    + Source: R/weibull2.R +
    W2.2.Rd
    +
    + +
    +

    A two-parameter Weibull type 2 model with the lower limit fixed at 0 and the +upper limit fixed at a specified value. The model is given by the equation +$$f(x) = \mathrm{upper} \cdot (1 - \exp(-\exp(b(\log(x) - \log(e)))))$$ +This model is primarily intended for binomial/quantal responses.

    +
    + +
    +

    Usage

    + 
    W2.2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...)
    +
    + +
    +

    Arguments

    + + +
    upper
    +

    numeric value giving the fixed upper limit (default 1).

    + + +
    fixed
    +

    numeric vector of length 2, specifying fixed parameters (use NA for +parameters that should be estimated).

    + + +
    names
    +

    character vector of length 2 giving the names of the parameters +(default c("b", "e")).

    + + +
    ...
    +

    additional arguments passed to weibull2, most +notably method (a character string: "1" (default), +"2", "3", or "4") which selects the self-starter +method for obtaining starting values. See weibull2 for +details.

    + +
    +
    +

    Value

    +

    A list of class "Weibull-2" as returned by weibull2.

    +
    +
    +

    See also

    +

    weibull2, W2.3, W2.4, +W1.2

    +
    + +
    +

    Examples

    + 
    earthworms.m1 <- drm(number/total ~ dose, weights = total,
+  data = earthworms, fct = W2.2(), type = "binomial")
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/W2.2.md b/docs/reference/W2.2.md new file mode 100644 index 00000000..5ee975ef --- /dev/null +++ b/docs/reference/W2.2.md @@ -0,0 +1,58 @@ +# Two-parameter Weibull (type 2) model + +A two-parameter Weibull type 2 model with the lower limit fixed at 0 and +the upper limit fixed at a specified value. The model is given by the +equation \$\$f(x) = \mathrm{upper} \cdot (1 - \exp(-\exp(b(\log(x) - +\log(e)))))\$\$ This model is primarily intended for binomial/quantal +responses. + +## Usage + +``` r +W2.2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) +``` + +## Arguments + +- upper: + + numeric value giving the fixed upper limit (default 1). + +- fixed: + + numeric vector of length 2, specifying fixed parameters (use `NA` for + parameters that should be estimated). + +- names: + + character vector of length 2 giving the names of the parameters + (default `c("b", "e")`). + +- ...: + + additional arguments passed to + [`weibull2`](https://hreinwald.github.io/drc/reference/weibull2.md), + most notably `method` (a character string: `"1"` (default), `"2"`, + `"3"`, or `"4"`) which selects the self-starter method for obtaining + starting values. See + [`weibull2`](https://hreinwald.github.io/drc/reference/weibull2.md) + for details. + +## Value + +A list of class `"Weibull-2"` as returned by +[`weibull2`](https://hreinwald.github.io/drc/reference/weibull2.md). + +## See also + +[`weibull2`](https://hreinwald.github.io/drc/reference/weibull2.md), +[`W2.3`](https://hreinwald.github.io/drc/reference/W2.3.md), +[`W2.4`](https://hreinwald.github.io/drc/reference/W2.4.md), +[`W1.2`](https://hreinwald.github.io/drc/reference/W1.2.md) + +## Examples + +``` r +earthworms.m1 <- drm(number/total ~ dose, weights = total, + data = earthworms, fct = W2.2(), type = "binomial") +``` diff --git a/docs/reference/W2.3.html b/docs/reference/W2.3.html new file mode 100644 index 00000000..82b66107 --- /dev/null +++ b/docs/reference/W2.3.html @@ -0,0 +1,113 @@ + +Three-parameter Weibull (type 2) model — W2.3 • drc + Skip to contents + + +
    +
    +
    +

    Three-parameter Weibull (type 2) model

    + Source: R/weibull2.R +
    W2.3.Rd
    +
    + +
    +

    A three-parameter Weibull type 2 model with the lower limit fixed at 0. +The model is given by the equation +$$f(x) = d \cdot (1 - \exp(-\exp(b(\log(x) - \log(e)))))$$

    +
    + +
    +

    Usage

    + 
    W2.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector of length 3, specifying fixed parameters (use NA for +parameters that should be estimated).

    + + +
    names
    +

    character vector of length 3 giving the names of the parameters +(default c("b", "d", "e")).

    + + +
    ...
    +

    additional arguments passed to weibull2, most +notably method (a character string: "1" (default), +"2", "3", or "4") which selects the self-starter +method for obtaining starting values. See weibull2 for +details.

    + +
    +
    +

    Value

    +

    A list of class "Weibull-2" as returned by weibull2.

    +
    +
    +

    See also

    +

    weibull2, W2.2, W2.4

    +
    + +
    +

    Examples

    + 
    ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W2.3())
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/W2.3.md b/docs/reference/W2.3.md new file mode 100644 index 00000000..5f732aea --- /dev/null +++ b/docs/reference/W2.3.md @@ -0,0 +1,50 @@ +# Three-parameter Weibull (type 2) model + +A three-parameter Weibull type 2 model with the lower limit fixed at 0. +The model is given by the equation \$\$f(x) = d \cdot (1 - +\exp(-\exp(b(\log(x) - \log(e)))))\$\$ + +## Usage + +``` r +W2.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) +``` + +## Arguments + +- fixed: + + numeric vector of length 3, specifying fixed parameters (use `NA` for + parameters that should be estimated). + +- names: + + character vector of length 3 giving the names of the parameters + (default `c("b", "d", "e")`). + +- ...: + + additional arguments passed to + [`weibull2`](https://hreinwald.github.io/drc/reference/weibull2.md), + most notably `method` (a character string: `"1"` (default), `"2"`, + `"3"`, or `"4"`) which selects the self-starter method for obtaining + starting values. See + [`weibull2`](https://hreinwald.github.io/drc/reference/weibull2.md) + for details. + +## Value + +A list of class `"Weibull-2"` as returned by +[`weibull2`](https://hreinwald.github.io/drc/reference/weibull2.md). + +## See also + +[`weibull2`](https://hreinwald.github.io/drc/reference/weibull2.md), +[`W2.2`](https://hreinwald.github.io/drc/reference/W2.2.md), +[`W2.4`](https://hreinwald.github.io/drc/reference/W2.4.md) + +## Examples + +``` r +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W2.3()) +``` diff --git a/docs/reference/W2.3u.html b/docs/reference/W2.3u.html new file mode 100644 index 00000000..4e5cd1a1 --- /dev/null +++ b/docs/reference/W2.3u.html @@ -0,0 +1,111 @@ + +Three-parameter Weibull (type 2) model with upper limit fixed — W2.3u • drc + Skip to contents + + +
    +
    +
    +

    Three-parameter Weibull (type 2) model with upper limit fixed

    + Source: R/weibull2.R +
    W2.3u.Rd
    +
    + +
    +

    A three-parameter Weibull type 2 model with the upper limit fixed at a +specified value. The model is given by the equation +$$f(x) = c + (\mathrm{upper} - c)(1 - \exp(-\exp(b(\log(x) - \log(e)))))$$

    +
    + +
    +

    Usage

    + 
    W2.3u(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...)
    +
    + +
    +

    Arguments

    + + +
    upper
    +

    numeric value giving the fixed upper limit (default 1).

    + + +
    fixed
    +

    numeric vector of length 3, specifying fixed parameters (use NA for +parameters that should be estimated).

    + + +
    names
    +

    character vector of length 3 giving the names of the parameters +(default c("b", "c", "e")).

    + + +
    ...
    +

    additional arguments passed to weibull2, most +notably method (a character string: "1" (default), +"2", "3", or "4") which selects the self-starter +method for obtaining starting values. See weibull2 for +details.

    + +
    +
    +

    Value

    +

    A list of class "Weibull-2" as returned by weibull2.

    +
    +
    +

    See also

    +

    weibull2, W2.3, W2.4

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/W2.3u.md b/docs/reference/W2.3u.md new file mode 100644 index 00000000..40e9dbac --- /dev/null +++ b/docs/reference/W2.3u.md @@ -0,0 +1,48 @@ +# Three-parameter Weibull (type 2) model with upper limit fixed + +A three-parameter Weibull type 2 model with the upper limit fixed at a +specified value. The model is given by the equation \$\$f(x) = c + +(\mathrm{upper} - c)(1 - \exp(-\exp(b(\log(x) - \log(e)))))\$\$ + +## Usage + +``` r +W2.3u(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...) +``` + +## Arguments + +- upper: + + numeric value giving the fixed upper limit (default 1). + +- fixed: + + numeric vector of length 3, specifying fixed parameters (use `NA` for + parameters that should be estimated). + +- names: + + character vector of length 3 giving the names of the parameters + (default `c("b", "c", "e")`). + +- ...: + + additional arguments passed to + [`weibull2`](https://hreinwald.github.io/drc/reference/weibull2.md), + most notably `method` (a character string: `"1"` (default), `"2"`, + `"3"`, or `"4"`) which selects the self-starter method for obtaining + starting values. See + [`weibull2`](https://hreinwald.github.io/drc/reference/weibull2.md) + for details. + +## Value + +A list of class `"Weibull-2"` as returned by +[`weibull2`](https://hreinwald.github.io/drc/reference/weibull2.md). + +## See also + +[`weibull2`](https://hreinwald.github.io/drc/reference/weibull2.md), +[`W2.3`](https://hreinwald.github.io/drc/reference/W2.3.md), +[`W2.4`](https://hreinwald.github.io/drc/reference/W2.4.md) diff --git a/docs/reference/W2.4.html b/docs/reference/W2.4.html new file mode 100644 index 00000000..218988ef --- /dev/null +++ b/docs/reference/W2.4.html @@ -0,0 +1,110 @@ + +Four-parameter Weibull (type 2) model — W2.4 • drc + Skip to contents + + +
    +
    +
    +

    Four-parameter Weibull (type 2) model

    + Source: R/weibull2.R +
    W2.4.Rd
    +
    + +
    +

    A four-parameter Weibull type 2 model. The model is given by the equation +$$f(x) = c + (d - c)(1 - \exp(-\exp(b(\log(x) - \log(e)))))$$

    +
    + +
    +

    Usage

    + 
    W2.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector of length 4, specifying fixed parameters (use NA for +parameters that should be estimated).

    + + +
    names
    +

    character vector of length 4 giving the names of the parameters +(default c("b", "c", "d", "e")).

    + + +
    ...
    +

    additional arguments passed to weibull2, most +notably method (a character string: "1" (default), +"2", "3", or "4") which selects the self-starter +method for obtaining starting values. See weibull2 for +details.

    + +
    +
    +

    Value

    +

    A list of class "Weibull-2" as returned by weibull2.

    +
    +
    +

    See also

    +

    weibull2, W2.2, W2.3

    +
    + +
    +

    Examples

    + 
    terbuthylazin.m1 <- drm(rgr ~ dose, data = terbuthylazin, fct = W2.4())
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/W2.4.md b/docs/reference/W2.4.md new file mode 100644 index 00000000..8f1e6df0 --- /dev/null +++ b/docs/reference/W2.4.md @@ -0,0 +1,50 @@ +# Four-parameter Weibull (type 2) model + +A four-parameter Weibull type 2 model. The model is given by the +equation \$\$f(x) = c + (d - c)(1 - \exp(-\exp(b(\log(x) - +\log(e)))))\$\$ + +## Usage + +``` r +W2.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) +``` + +## Arguments + +- fixed: + + numeric vector of length 4, specifying fixed parameters (use `NA` for + parameters that should be estimated). + +- names: + + character vector of length 4 giving the names of the parameters + (default `c("b", "c", "d", "e")`). + +- ...: + + additional arguments passed to + [`weibull2`](https://hreinwald.github.io/drc/reference/weibull2.md), + most notably `method` (a character string: `"1"` (default), `"2"`, + `"3"`, or `"4"`) which selects the self-starter method for obtaining + starting values. See + [`weibull2`](https://hreinwald.github.io/drc/reference/weibull2.md) + for details. + +## Value + +A list of class `"Weibull-2"` as returned by +[`weibull2`](https://hreinwald.github.io/drc/reference/weibull2.md). + +## See also + +[`weibull2`](https://hreinwald.github.io/drc/reference/weibull2.md), +[`W2.2`](https://hreinwald.github.io/drc/reference/W2.2.md), +[`W2.3`](https://hreinwald.github.io/drc/reference/W2.3.md) + +## Examples + +``` r +terbuthylazin.m1 <- drm(rgr ~ dose, data = terbuthylazin, fct = W2.4()) +``` diff --git a/docs/reference/W2.html b/docs/reference/W2.html deleted file mode 100644 index 9de11a7a..00000000 --- a/docs/reference/W2.html +++ /dev/null @@ -1,208 +0,0 @@ - - - - - - - - -The two-parameter Weibull functions — W1.2 • drc - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    -
    - - - -
    - -
    -
    -
    -

    The two-parameter Weibull functions

    - - -
    - -
    - -

    'W1.2' is the two-parameter Weibull function where the lower limit is fixed at 0 and the upper limit - is fixed at 1, mostly suitable for binomial/quantal responses.

    - -
    - - 
    W1.2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...)
-
-  W2.2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - -
    upper

    numeric value. The fixed, upper limit in the model. Default is 1.

    fixed

    numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.

    names

    a vector of character strings giving the names of the parameters. The default is reasonable.

    ...

    additional arguments to be passed from the convenience functions.

    - -

    Details

    - -

    The two-parameter Weibull type 1 model is given by the expression - $$ f(x) = \exp(-\exp(b(\log(x)-\log(e)))).$$

    -

    The function is asymmetric about the inflection point, that is the parameter \(\exp(e)\).

    - -

    Value

    - -

    See weibull1.

    - -

    Note

    - -

    This function is for use with the function drm.

    - -

    See also

    - -

    Related functions are W1.3, W1.4, weibull1 and weibull2.

    - - -

    Examples

    - 
    
-## Fitting a two-parameter Weibull model
-earthworms.m1 <- drm(number/total~dose, weights = total,
-data = earthworms, fct = W1.2(), type = "binomial")
-
-summary(earthworms.m1)
    #> 
-#> Model fitted: Weibull (type 1) with lower limit at 0 and upper limit at 1 (2 parms)
-#> 
-#> Parameter estimates:
-#> 
-#>               Estimate Std. Error t-value  p-value    
-#> b:(Intercept) 0.475853   0.085228  5.5833 2.36e-08 ***
-#> e:(Intercept) 0.179730   0.055978  3.2107 0.001324 ** 
-#> ---
-#> Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
    
-
    -
    - -
    - -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    -
    - -
    -

    Site built with pkgdown.

    -
    - -
    -
    - - - - - - diff --git a/docs/reference/W2x.3.html b/docs/reference/W2x.3.html new file mode 100644 index 00000000..8734816a --- /dev/null +++ b/docs/reference/W2x.3.html @@ -0,0 +1,127 @@ + +Three-parameter Weibull type 2 model with lag time — W2x.3 • drc + Skip to contents + + +
    +
    +
    +

    Three-parameter Weibull type 2 model with lag time

    + Source: R/weibull2x.R +
    W2x.3.Rd
    +
    + +
    +

    A three-parameter Weibull type 2 model with lag time, where b is +fixed at 1 and c is fixed at 0. This is a convenience wrapper +around weibull2x.

    +
    + +
    +

    Usage

    + 
    W2x.3(fixed = c(NA, NA, NA), names = c("d", "e", "t0"), ...)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector of length 3. Specifies which parameters are +fixed and at what value. Use NA for parameters that should be +estimated (default is c(NA, NA, NA)).

    + + +
    names
    +

    character vector of length 3 giving the names of the +parameters (default is c("d", "e", "t0")).

    + + +
    ...
    +

    additional arguments passed to weibull2x.

    + +
    +
    +

    Value

    +

    A list of class "Weibull-2" containing the nonlinear +function, self starter function, and parameter names.

    +
    +
    +

    See also

    +

    weibull2x, W2x.4, W2.3

    +
    + +
    +

    Examples

    + 
    spinach.m1 <- drm(SLOPE ~ DOSE, data = spinach, fct = W2x.3())
+summary(spinach.m1)
+#> 
+#> Model fitted: Weibull (type 2) with lower limit at 0 (3 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                 Estimate Std. Error t-value   p-value    
+#> d:(Intercept)   0.827617   0.067677  12.229 < 2.2e-16 ***
+#> e:(Intercept)   0.008972        NaN     NaN       NaN    
+#> t0:(Intercept) -0.135527        NaN     NaN       NaN    
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.6934874 (102 degrees of freedom)
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/W2x.3.md b/docs/reference/W2x.3.md new file mode 100644 index 00000000..725f38fb --- /dev/null +++ b/docs/reference/W2x.3.md @@ -0,0 +1,62 @@ +# Three-parameter Weibull type 2 model with lag time + +A three-parameter Weibull type 2 model with lag time, where `b` is fixed +at 1 and `c` is fixed at 0. This is a convenience wrapper around +[`weibull2x`](https://hreinwald.github.io/drc/reference/weibull2x.md). + +## Usage + +``` r +W2x.3(fixed = c(NA, NA, NA), names = c("d", "e", "t0"), ...) +``` + +## Arguments + +- fixed: + + numeric vector of length 3. Specifies which parameters are fixed and + at what value. Use `NA` for parameters that should be estimated + (default is `c(NA, NA, NA)`). + +- names: + + character vector of length 3 giving the names of the parameters + (default is `c("d", "e", "t0")`). + +- ...: + + additional arguments passed to + [`weibull2x`](https://hreinwald.github.io/drc/reference/weibull2x.md). + +## Value + +A list of class `"Weibull-2"` containing the nonlinear function, self +starter function, and parameter names. + +## See also + +[`weibull2x`](https://hreinwald.github.io/drc/reference/weibull2x.md), +[`W2x.4`](https://hreinwald.github.io/drc/reference/W2x.4.md), +[`W2.3`](https://hreinwald.github.io/drc/reference/W2.3.md) + +## Examples + +``` r +spinach.m1 <- drm(SLOPE ~ DOSE, data = spinach, fct = W2x.3()) +summary(spinach.m1) +#> +#> Model fitted: Weibull (type 2) with lower limit at 0 (3 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> d:(Intercept) 0.827617 0.067677 12.229 < 2.2e-16 *** +#> e:(Intercept) 0.008972 NaN NaN NaN +#> t0:(Intercept) -0.135527 NaN NaN NaN +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.6934874 (102 degrees of freedom) +``` diff --git a/docs/reference/W2x.4.html b/docs/reference/W2x.4.html new file mode 100644 index 00000000..a559e877 --- /dev/null +++ b/docs/reference/W2x.4.html @@ -0,0 +1,110 @@ + +Four-parameter Weibull type 2 model with lag time — W2x.4 • drc + Skip to contents + + +
    +
    +
    +

    Four-parameter Weibull type 2 model with lag time

    + Source: R/weibull2x.R +
    W2x.4.Rd
    +
    + +
    +

    A four-parameter Weibull type 2 model with lag time, where b is +fixed at 1. This is a convenience wrapper around weibull2x.

    +
    + +
    +

    Usage

    + 
    W2x.4(fixed = c(NA, NA, NA, NA), names = c("c", "d", "e", "t0"), ...)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector of length 4. Specifies which parameters are +fixed and at what value. Use NA for parameters that should be +estimated (default is c(NA, NA, NA, NA)).

    + + +
    names
    +

    character vector of length 4 giving the names of the +parameters (default is c("c", "d", "e", "t0")).

    + + +
    ...
    +

    additional arguments passed to weibull2x.

    + +
    +
    +

    Value

    +

    A list of class "Weibull-2" containing the nonlinear +function, self starter function, and parameter names.

    +
    +
    +

    See also

    +

    weibull2x, W2x.3, W2.4

    +
    + +
    +

    Examples

    + 
    ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W2x.4())
+#> Warning: NaNs produced
+#> Warning: NaNs produced
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/W2x.4.md b/docs/reference/W2x.4.md new file mode 100644 index 00000000..b4ec3594 --- /dev/null +++ b/docs/reference/W2x.4.md @@ -0,0 +1,48 @@ +# Four-parameter Weibull type 2 model with lag time + +A four-parameter Weibull type 2 model with lag time, where `b` is fixed +at 1. This is a convenience wrapper around +[`weibull2x`](https://hreinwald.github.io/drc/reference/weibull2x.md). + +## Usage + +``` r +W2x.4(fixed = c(NA, NA, NA, NA), names = c("c", "d", "e", "t0"), ...) +``` + +## Arguments + +- fixed: + + numeric vector of length 4. Specifies which parameters are fixed and + at what value. Use `NA` for parameters that should be estimated + (default is `c(NA, NA, NA, NA)`). + +- names: + + character vector of length 4 giving the names of the parameters + (default is `c("c", "d", "e", "t0")`). + +- ...: + + additional arguments passed to + [`weibull2x`](https://hreinwald.github.io/drc/reference/weibull2x.md). + +## Value + +A list of class `"Weibull-2"` containing the nonlinear function, self +starter function, and parameter names. + +## See also + +[`weibull2x`](https://hreinwald.github.io/drc/reference/weibull2x.md), +[`W2x.3`](https://hreinwald.github.io/drc/reference/W2x.3.md), +[`W2.4`](https://hreinwald.github.io/drc/reference/W2.4.md) + +## Examples + +``` r +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W2x.4()) +#> Warning: NaNs produced +#> Warning: NaNs produced +``` diff --git a/docs/reference/W3.html b/docs/reference/W3.html deleted file mode 100644 index 3db1e0fc..00000000 --- a/docs/reference/W3.html +++ /dev/null @@ -1,216 +0,0 @@ - - - - - - - - -The three-parameter Weibull functions — W1.3 • drc - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    -
    - - - -
    - -
    -
    -
    -

    The three-parameter Weibull functions

    - - -
    - -
    - -

    'W1.3' and W2.3 provide the three-parameter Weibull function, self starter function and names of the parameters.

    -

    'W1.3u' and 'W2.3u' provide three-parameter Weibull function where the upper limit is equal to 1, mainly - for use with binomial/quantal response.

    - -
    - - 
    W1.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...)
-
-  W2.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...)
-
-  W2x.3(fixed = c(NA, NA, NA), names = c("d", "e", "t0"), ...)
-
-  W1.3u(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...)
-
-  W2.3u(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - -
    upper

    numeric value. The fixed, upper limit in the model. Default is 1.

    fixed

    numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.

    names

    a vector of character strings giving the names of the parameters. The default is reasonable.

    ...

    additional arguments to be passed from the convenience functions.

    - -

    Details

    - -

    The three-parameter Weibull type 1 model is given by the expression - $$ f(x) = 0 + (d-0)\exp(-\exp(b(\log(x)-\log(e)))).$$

    -

    The model function is asymmetric about the inflection point, which is the parameter \(\exp(e)\).

    -

    The three-parameter Weibull type 1 model with upper limit 1 is given by the expression - $$ f(x) = 0 + (1-0)\exp(-\exp(b(\log(x)-\log(e)))).$$

    - -

    Value

    - -

    See weibull1.

    - -

    Note

    - -

    This function is for use with the function drm.

    - -

    See also

    - -

    Related functions are W1.4 and weibull1.

    - - -

    Examples

    - 
    
-## Fitting a three-parameter Weibull model
-ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.3())
-ryegrass.m1
    #> 
-#> A 'drc' model.
-#> 
-#> Call:
-#> drm(formula = rootl ~ conc, data = ryegrass, fct = W1.3())
-#> 
-#> Coefficients:
-#> b:(Intercept)  d:(Intercept)  e:(Intercept)  
-#>         1.731          7.916          4.191  
-#> 
    
-
    -
    - -
    - -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    -
    - -
    -

    Site built with pkgdown.

    -
    - -
    -
    - - - - - - diff --git a/docs/reference/W4-1.png b/docs/reference/W4-1.png deleted file mode 100644 index e0344d0f..00000000 Binary files a/docs/reference/W4-1.png and /dev/null differ diff --git a/docs/reference/W4.html b/docs/reference/W4.html deleted file mode 100644 index 6dbbdb6d..00000000 --- a/docs/reference/W4.html +++ /dev/null @@ -1,282 +0,0 @@ - - - - - - - - -The four-parameter Weibull functions — W1.4 • drc - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    -
    - - - -
    - -
    -
    -
    -

    The four-parameter Weibull functions

    - - -
    - -
    - -

    'W1.4' and 'W2.4' provide the four-parameter Weibull functions, self starter function and - names of the parameters.

    - -
    - - 
    W1.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...)
-
-  W2.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...)
    - -

    Arguments

    - - - - - - - - - - - - - - -
    fixed

    numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.

    names

    a vector of character strings giving the names of the parameters. The default is reasonable.

    ...

    additional arguments to be passed from the convenience functions.

    - -

    Details

    - -

    The equations for the mean functions are given at weibull1.

    - -

    Value

    - -

    See weibull1.

    - -

    References

    - -

    Seber, G. A. F. and Wild, C. J (1989) Nonlinear Regression, New York: Wiley \& Sons (pp. 330--331).

    -

    Ritz, C (2009) - Towards a unified approach to dose-response modeling in ecotoxicology - To appear in Environ Toxicol Chem.

    - -

    Note

    - -

    This function is for use with the model fitting function drm.

    - -

    See also

    - -

    Setting \(c=0\) yields W1.3. A more flexible function, allowing -fixing or constraining parameters, is available through weibull1.

    - - -

    Examples

    - 
    
-## Fitting a four-parameter Weibull (type 1) model
-terbuthylazin.m1 <- drm(rgr~dose, data = terbuthylazin, fct = W1.4())
-summary(terbuthylazin.m1)
    #> 
-#> Model fitted: Weibull (type 1) (4 parms)
-#> 
-#> Parameter estimates:
-#> 
-#>                 Estimate Std. Error t-value   p-value    
-#> b:(Intercept) 9.7401e-01 1.4451e-01  6.7401 3.753e-07 ***
-#> c:(Intercept) 2.4632e-02 1.4782e-02  1.6663    0.1076    
-#> d:(Intercept) 3.0889e-01 9.5904e-03 32.2080 < 2.2e-16 ***
-#> e:(Intercept) 2.5485e+02 4.0604e+01  6.2766 1.211e-06 ***
-#> ---
-#> Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
-#> 
-#> Residual standard error:
-#> 
-#>  0.02694557 (26 degrees of freedom)
    
-## Fitting a first-order multistage model
-## to data from BMDS by EPA
-## (Figure 3 in Ritz (2009))
-bmds.ex1 <- data.frame(ad.dose=c(0,50,100), dose=c(0, 2.83, 5.67),
-num=c(6,10,19), total=c(50,49,50))
-
-bmds.ex1.m1<-drm(num/total~dose, weights=total, data=bmds.ex1,
-fct=W2.4(fixed=c(1,NA,1,NA)), type="binomial")
-
-modelFit(bmds.ex1.m1)  # same as in BMDS
    #> Goodness-of-fit test
-#> 
-#>             Df Chisq value p value
-#>                                   
-#> DRC model    1     0.57224  0.4494
    
-summary(bmds.ex1.m1)  # same background estimate as in BMDS
    #> 
-#> Model fitted: Weibull (type 2) (2 parms)
-#> 
-#> Parameter estimates:
-#> 
-#>                Estimate Std. Error t-value  p-value   
-#> c:(Intercept)  0.111475   0.041719  2.6721 0.007539 **
-#> e:(Intercept) 17.860515   5.919727  3.0171 0.002552 **
-#> ---
-#> Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
    
-logLik(bmds.ex1.m1)
    #> 'log Lik.' -6.179627 (df=2)
    
-## BMD estimate identical to BMDS result
-## BMDL estimate differs from BMDS result (different method)
-ED(bmds.ex1.m1, 10, ci="delta")
    #> 
-#> Estimated effective doses
-#> 
-#>        Estimate Std. Error
-#> e:1:10  1.88179    0.62371
    
-## Better fit
-
-bmds.ex1.m2<-drm(num/total~dose, weights=total, data=bmds.ex1,
-fct=W1.4(fixed=c(-1,NA,1,NA)), type="binomial")
-modelFit(bmds.ex1.m2)
    #> Goodness-of-fit test
-#> 
-#>             Df Chisq value p value
-#>                                   
-#> DRC model    1    0.010589   0.918
    summary(bmds.ex1.m2)
    #> 
-#> Model fitted: Weibull (type 1) (2 parms)
-#> 
-#> Parameter estimates:
-#> 
-#>               Estimate Std. Error t-value   p-value    
-#> c:(Intercept) 0.121468   0.044268  2.7439  0.006071 ** 
-#> e:(Intercept) 6.850273   1.540986  4.4454 8.774e-06 ***
-#> ---
-#> Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
    
-ED(bmds.ex1.m2, 50, ci = "delta")
    #> 
-#> Estimated effective doses
-#> 
-#>        Estimate Std. Error
-#> e:1:50   9.8829     2.2232
    
-## Creating Figure 3 in Ritz (2009)
-bmds.ex1.m3 <- drm(num/total~dose, weights=total, data=bmds.ex1,
-fct=LL.4(fixed=c(-1,NA,1,NA)), type="binomial")
-
-plot(bmds.ex1.m1, ylim = c(0.05, 0.4), log = "", lty = 3, lwd = 2,
-xlab = "Dose (mg/kg/day)", ylab = "",
-cex=1.2, cex.axis=1.2, cex.lab=1.2)
    
-mtext("Tumor incidence", 2, line=4, cex=1.2)  # tailored y axis label
    
-plot(bmds.ex1.m2, ylim = c(0.05, 0.4), log = "", add = TRUE, lty = 2, lwd = 2)
    
-plot(bmds.ex1.m3, ylim = c(0.05, 0.4), log = "", add = TRUE, lty = 1, lwd = 2)
    
-arrows(2.6 , 0.14, 2, 0.14, 0.15, lwd=2)
    text(2.5, 0.14, "Weibull-1", pos=4, cex=1.2)
    
-
    -
    - -
    - -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    -
    - -
    -

    Site built with pkgdown.

    -
    - -
    -
    - - - - - - diff --git a/docs/reference/absToRel.html b/docs/reference/absToRel.html new file mode 100644 index 00000000..fd3f7303 --- /dev/null +++ b/docs/reference/absToRel.html @@ -0,0 +1,96 @@ + +Convert absolute to relative response levels — absToRel • drc + Skip to contents + + +
    +
    +
    +

    Convert absolute to relative response levels

    + Source: R/absToRel.R +
    absToRel.Rd
    +
    + +
    +

    Internal helper that converts an absolute response level to a relative (percentage) scale +based on the upper and lower asymptotes of a dose-response curve.

    +
    + +
    +

    Usage

    + 
    absToRel(parmVec, respl, typeCalc)
    +
    + +
    +

    Arguments

    + + +
    parmVec
    +

    numeric vector of model parameters where the third element is the upper +asymptote and the second element is the lower asymptote.

    + + +
    respl
    +

    numeric response level to convert.

    + + +
    typeCalc
    +

    character string. If "absolute", the conversion is performed; +otherwise the input respl is returned unchanged.

    + +
    +
    +

    Value

    +

    A numeric value representing the (possibly converted) response level as a percentage.

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/absToRel.md b/docs/reference/absToRel.md new file mode 100644 index 00000000..526d6de8 --- /dev/null +++ b/docs/reference/absToRel.md @@ -0,0 +1,32 @@ +# Convert absolute to relative response levels + +Internal helper that converts an absolute response level to a relative +(percentage) scale based on the upper and lower asymptotes of a +dose-response curve. + +## Usage + +``` r +absToRel(parmVec, respl, typeCalc) +``` + +## Arguments + +- parmVec: + + numeric vector of model parameters where the third element is the + upper asymptote and the second element is the lower asymptote. + +- respl: + + numeric response level to convert. + +- typeCalc: + + character string. If "absolute", the conversion is performed; + otherwise the input `respl` is returned unchanged. + +## Value + +A numeric value representing the (possibly converted) response level as +a percentage. diff --git a/docs/reference/acidiq-1.png b/docs/reference/acidiq-1.png new file mode 100644 index 00000000..b1971a9c Binary files /dev/null and b/docs/reference/acidiq-1.png differ diff --git a/docs/reference/acidiq-2.png b/docs/reference/acidiq-2.png new file mode 100644 index 00000000..e463c3db Binary files /dev/null and b/docs/reference/acidiq-2.png differ diff --git a/docs/reference/acidiq-3.png b/docs/reference/acidiq-3.png new file mode 100644 index 00000000..82e7d23d Binary files /dev/null and b/docs/reference/acidiq-3.png differ diff --git a/docs/reference/acidiq.html b/docs/reference/acidiq.html new file mode 100644 index 00000000..7744fe91 --- /dev/null +++ b/docs/reference/acidiq.html @@ -0,0 +1,231 @@ + +Acifluorfen and diquat tested on Lemna minor. — acidiq • drc + Skip to contents + + +
    +
    +
    +

    Acifluorfen and diquat tested on Lemna minor.

    + +
    acidiq.Rd
    +
    + +
    +

    Data from an experiment where the chemicals acifluorfen and diquat tested on Lemna minor. The dataset has 7 mixtures used in + 8 dilutions with three replicates and 12 common controls, in total 180 observations.

    +
    + +
    +

    Usage

    + 
    data(acidiq)
    +
    + +
    +

    Format

    +

    A data frame with 180 observations on the following 3 variables.

    dose
    +

    a numeric vector of dose values

    + +
    pct
    +

    a numeric vector denoting the grouping according to the mixtures percentages

    + +
    rgr
    +

    a numeric vector of response values (relative growth rates)

    + + +
    +
    +

    Details

    +

    The dataset is analysed in Soerensen et al (2007). + Hewlett's symmetric model seems appropriate for this dataset.

    +
    +
    +

    Source

    +

    The dataset is kindly provided by Nina Cedergreen, Department of Agricultural Sciences, + Royal Veterinary and Agricultural University, Denmark.

    +
    +
    +

    References

    +

    Soerensen, H. and Cedergreen, N. and Skovgaard, I. M. and Streibig, J. C. (2007) + An isobole-based statistical model and test for synergism/antagonism in binary mixture toxicity experiments, + Environmental and Ecological Statistics, 14, 383–397.

    +
    + +
    +

    Examples

    + 
    library(drc)
+## Fitting the model with freely varying ED50 values
+## Ooops: Box-Cox transformation is needed
+acidiq.free <- drm(rgr ~ dose, pct, data = acidiq, fct = LL.4(),
+pmodels = list(~factor(pct), ~1, ~1, ~factor(pct) - 1))
+#> Control measurements detected for level: 999
+
+## Lack-of-fit test
+modelFit(acidiq.free)
+#> Lack-of-fit test
+#> 
+#>           ModelDf      RSS Df F value p value
+#> ANOVA         123 0.023854                   
+#> DRC model     164 0.046386 41  2.8337  0.0000
+summary(acidiq.free)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                 Estimate Std. Error  t-value   p-value    
+#> b:100         1.3589e+00 1.1035e-01  12.3150 < 2.2e-16 ***
+#> b:83          1.7675e+00 1.5803e-01  11.1846 < 2.2e-16 ***
+#> b:67          2.1577e+00 2.0216e-01  10.6732 < 2.2e-16 ***
+#> b:50          2.2777e+00 2.2913e-01   9.9407 < 2.2e-16 ***
+#> b:33          2.2302e+00 2.5416e-01   8.7746 2.177e-15 ***
+#> b:17          2.5058e+00 2.6607e-01   9.4176 < 2.2e-16 ***
+#> b:0           2.3076e+00 2.5911e-01   8.9060 9.250e-16 ***
+#> c:(Intercept) 2.9700e-02 3.0952e-03   9.5953 < 2.2e-16 ***
+#> d:(Intercept) 3.0209e-01 2.5854e-03 116.8429 < 2.2e-16 ***
+#> e:100         3.0844e+02 2.1265e+01  14.5043 < 2.2e-16 ***
+#> e:83          3.7660e+02 2.2280e+01  16.9033 < 2.2e-16 ***
+#> e:67          4.8746e+02 2.6072e+01  18.6970 < 2.2e-16 ***
+#> e:50          5.1669e+02 2.6541e+01  19.4678 < 2.2e-16 ***
+#> e:33          5.2288e+02 2.8379e+01  18.4247 < 2.2e-16 ***
+#> e:17          3.7891e+02 1.8619e+01  20.3515 < 2.2e-16 ***
+#> e:0           3.4766e+02 1.7712e+01  19.6282 < 2.2e-16 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.01681793 (164 degrees of freedom)
+
+## Plotting isobole structure
+isobole(acidiq.free, xlim = c(0, 400), ylim = c(0, 450))
+
+
+## Fitting the concentration addition model
+acidiq.ca <- mixture(acidiq.free, model = "CA")
+#> Warning: Using formula(x) is deprecated when x is a character vector of length > 1.
+#>   Consider formula(paste(x, collapse = " ")) instead.
+#> Control measurements detected for level: 999
+
+## Comparing to model with freely varying e parameter
+anova(acidiq.ca, acidiq.free)  # rejected
+#> 
+#> 1st model
+#>  fct:     CA model
+#>  pmodels: ~~~factor(pct), ~1, ~1, ~I(1/(pct/100)) - 1, ~I(1/(1 - pct/100)) - 1
+#> 2nd model
+#>  fct:     LL.4()
+#>  pmodels: ~factor(pct), ~1, ~1, ~factor(pct) - 1
+#> 
+#> ANOVA table
+#> 
+#>           ModelDf      RSS Df F value p value
+#> 1st model     169 0.073150                   
+#> 2nd model     164 0.046386  5  18.925   0.000
+
+## Plotting isobole based on concentration addition -- poor fit
+isobole(acidiq.free, acidiq.ca, xlim = c(0, 420), ylim = c(0, 450))  # poor fit
+
+
+## Fitting the Hewlett model
+acidiq.hew <- mixture(acidiq.free, model = "Hewlett")
+#> Warning: Using formula(x) is deprecated when x is a character vector of length > 1.
+#>   Consider formula(paste(x, collapse = " ")) instead.
+#> Control measurements detected for level: 999
+
+## Comparing to model with freely varying e parameter
+anova(acidiq.free, acidiq.hew)  # accepted
+#> 
+#> 1st model
+#>  fct:     Hewlett model
+#>  pmodels: ~~~factor(pct), ~1, ~1, ~I(1/(pct/100)) - 1, ~I(1/(1 - pct/100)) - 1, ~1
+#> 2nd model
+#>  fct:     LL.4()
+#>  pmodels: ~factor(pct), ~1, ~1, ~factor(pct) - 1
+#> 
+#> ANOVA table
+#> 
+#>           ModelDf      RSS Df F value p value
+#> 2nd model     168 0.048100                   
+#> 1st model     164 0.046386  4  1.5151  0.2001
+summary(acidiq.hew)
+#> 
+#> Model fitted: Hewlett mixture (6 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                        Estimate Std. Error  t-value   p-value    
+#> b:100                1.3704e+00 1.1184e-01  12.2531 < 2.2e-16 ***
+#> b:83                 1.7757e+00 1.5964e-01  11.1227 < 2.2e-16 ***
+#> b:67                 2.1808e+00 2.0685e-01  10.5430 < 2.2e-16 ***
+#> b:50                 2.2925e+00 2.3345e-01   9.8198 < 2.2e-16 ***
+#> b:33                 2.3154e+00 2.6237e-01   8.8252 1.352e-15 ***
+#> b:17                 2.4666e+00 2.5919e-01   9.5167 < 2.2e-16 ***
+#> b:0                  2.3347e+00 2.6714e-01   8.7397 2.266e-15 ***
+#> c:(Intercept)        3.0042e-02 3.0711e-03   9.7820 < 2.2e-16 ***
+#> d:(Intercept)        3.0176e-01 2.5825e-03 116.8512 < 2.2e-16 ***
+#> e:I(1/(pct/100))     3.1683e+02 1.3191e+01  24.0197 < 2.2e-16 ***
+#> f:I(1/(1 - pct/100)) 3.3710e+02 1.1814e+01  28.5339 < 2.2e-16 ***
+#> g:(Intercept)        2.8063e-01 6.9489e-02   4.0385 8.164e-05 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.01692075 (168 degrees of freedom)
+
+## Plotting isobole based on the Hewlett model
+isobole(acidiq.free, acidiq.hew, xlim = c(0, 400), ylim = c(0, 450))  # good fit
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/acidiq.md b/docs/reference/acidiq.md new file mode 100644 index 00000000..05bbd0da --- /dev/null +++ b/docs/reference/acidiq.md @@ -0,0 +1,174 @@ +# Acifluorfen and diquat tested on Lemna minor. + +Data from an experiment where the chemicals acifluorfen and diquat +tested on Lemna minor. The dataset has 7 mixtures used in 8 dilutions +with three replicates and 12 common controls, in total 180 observations. + +## Usage + +``` r +data(acidiq) +``` + +## Format + +A data frame with 180 observations on the following 3 variables. + +- `dose`: + + a numeric vector of dose values + +- `pct`: + + a numeric vector denoting the grouping according to the mixtures + percentages + +- `rgr`: + + a numeric vector of response values (relative growth rates) + +## Details + +The dataset is analysed in Soerensen et al (2007). Hewlett's symmetric +model seems appropriate for this dataset. + +## Source + +The dataset is kindly provided by Nina Cedergreen, Department of +Agricultural Sciences, Royal Veterinary and Agricultural University, +Denmark. + +## References + +Soerensen, H. and Cedergreen, N. and Skovgaard, I. M. and Streibig, J. +C. (2007) An isobole-based statistical model and test for +synergism/antagonism in binary mixture toxicity experiments, +*Environmental and Ecological Statistics*, **14**, 383–397. + +## Examples + +``` r +library(drc) +## Fitting the model with freely varying ED50 values +## Ooops: Box-Cox transformation is needed +acidiq.free <- drm(rgr ~ dose, pct, data = acidiq, fct = LL.4(), +pmodels = list(~factor(pct), ~1, ~1, ~factor(pct) - 1)) +#> Control measurements detected for level: 999 + +## Lack-of-fit test +modelFit(acidiq.free) +#> Lack-of-fit test +#> +#> ModelDf RSS Df F value p value +#> ANOVA 123 0.023854 +#> DRC model 164 0.046386 41 2.8337 0.0000 +summary(acidiq.free) +#> +#> Model fitted: Log-logistic (ED50 as parameter) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:100 1.3589e+00 1.1035e-01 12.3150 < 2.2e-16 *** +#> b:83 1.7675e+00 1.5803e-01 11.1846 < 2.2e-16 *** +#> b:67 2.1577e+00 2.0216e-01 10.6732 < 2.2e-16 *** +#> b:50 2.2777e+00 2.2913e-01 9.9407 < 2.2e-16 *** +#> b:33 2.2302e+00 2.5416e-01 8.7746 2.177e-15 *** +#> b:17 2.5058e+00 2.6607e-01 9.4176 < 2.2e-16 *** +#> b:0 2.3076e+00 2.5911e-01 8.9060 9.250e-16 *** +#> c:(Intercept) 2.9700e-02 3.0952e-03 9.5953 < 2.2e-16 *** +#> d:(Intercept) 3.0209e-01 2.5854e-03 116.8429 < 2.2e-16 *** +#> e:100 3.0844e+02 2.1265e+01 14.5043 < 2.2e-16 *** +#> e:83 3.7660e+02 2.2280e+01 16.9033 < 2.2e-16 *** +#> e:67 4.8746e+02 2.6072e+01 18.6970 < 2.2e-16 *** +#> e:50 5.1669e+02 2.6541e+01 19.4678 < 2.2e-16 *** +#> e:33 5.2288e+02 2.8379e+01 18.4247 < 2.2e-16 *** +#> e:17 3.7891e+02 1.8619e+01 20.3515 < 2.2e-16 *** +#> e:0 3.4766e+02 1.7712e+01 19.6282 < 2.2e-16 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.01681793 (164 degrees of freedom) + +## Plotting isobole structure +isobole(acidiq.free, xlim = c(0, 400), ylim = c(0, 450)) + + +## Fitting the concentration addition model +acidiq.ca <- mixture(acidiq.free, model = "CA") +#> Warning: Using formula(x) is deprecated when x is a character vector of length > 1. +#> Consider formula(paste(x, collapse = " ")) instead. +#> Control measurements detected for level: 999 + +## Comparing to model with freely varying e parameter +anova(acidiq.ca, acidiq.free) # rejected +#> +#> 1st model +#> fct: CA model +#> pmodels: ~~~factor(pct), ~1, ~1, ~I(1/(pct/100)) - 1, ~I(1/(1 - pct/100)) - 1 +#> 2nd model +#> fct: LL.4() +#> pmodels: ~factor(pct), ~1, ~1, ~factor(pct) - 1 +#> +#> ANOVA table +#> +#> ModelDf RSS Df F value p value +#> 1st model 169 0.073150 +#> 2nd model 164 0.046386 5 18.925 0.000 + +## Plotting isobole based on concentration addition -- poor fit +isobole(acidiq.free, acidiq.ca, xlim = c(0, 420), ylim = c(0, 450)) # poor fit + + +## Fitting the Hewlett model +acidiq.hew <- mixture(acidiq.free, model = "Hewlett") +#> Warning: Using formula(x) is deprecated when x is a character vector of length > 1. +#> Consider formula(paste(x, collapse = " ")) instead. +#> Control measurements detected for level: 999 + +## Comparing to model with freely varying e parameter +anova(acidiq.free, acidiq.hew) # accepted +#> +#> 1st model +#> fct: Hewlett model +#> pmodels: ~~~factor(pct), ~1, ~1, ~I(1/(pct/100)) - 1, ~I(1/(1 - pct/100)) - 1, ~1 +#> 2nd model +#> fct: LL.4() +#> pmodels: ~factor(pct), ~1, ~1, ~factor(pct) - 1 +#> +#> ANOVA table +#> +#> ModelDf RSS Df F value p value +#> 2nd model 168 0.048100 +#> 1st model 164 0.046386 4 1.5151 0.2001 +summary(acidiq.hew) +#> +#> Model fitted: Hewlett mixture (6 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:100 1.3704e+00 1.1184e-01 12.2531 < 2.2e-16 *** +#> b:83 1.7757e+00 1.5964e-01 11.1227 < 2.2e-16 *** +#> b:67 2.1808e+00 2.0685e-01 10.5430 < 2.2e-16 *** +#> b:50 2.2925e+00 2.3345e-01 9.8198 < 2.2e-16 *** +#> b:33 2.3154e+00 2.6237e-01 8.8252 1.352e-15 *** +#> b:17 2.4666e+00 2.5919e-01 9.5167 < 2.2e-16 *** +#> b:0 2.3347e+00 2.6714e-01 8.7397 2.266e-15 *** +#> c:(Intercept) 3.0042e-02 3.0711e-03 9.7820 < 2.2e-16 *** +#> d:(Intercept) 3.0176e-01 2.5825e-03 116.8512 < 2.2e-16 *** +#> e:I(1/(pct/100)) 3.1683e+02 1.3191e+01 24.0197 < 2.2e-16 *** +#> f:I(1/(1 - pct/100)) 3.3710e+02 1.1814e+01 28.5339 < 2.2e-16 *** +#> g:(Intercept) 2.8063e-01 6.9489e-02 4.0385 8.164e-05 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.01692075 (168 degrees of freedom) + +## Plotting isobole based on the Hewlett model +isobole(acidiq.free, acidiq.hew, xlim = c(0, 400), ylim = c(0, 450)) # good fit +``` diff --git a/docs/reference/aconiazide-1.png b/docs/reference/aconiazide-1.png new file mode 100644 index 00000000..dd2809f1 Binary files /dev/null and b/docs/reference/aconiazide-1.png differ diff --git a/docs/reference/aconiazide.html b/docs/reference/aconiazide.html new file mode 100644 index 00000000..f7840b0c --- /dev/null +++ b/docs/reference/aconiazide.html @@ -0,0 +1,124 @@ + +Weight change in rats after exposure to a medical drug — aconiazide • drc + Skip to contents + + +
    +
    +
    +

    Weight change in rats after exposure to a medical drug

    + +
    aconiazide.Rd
    +
    + +
    +

    For each of 4 dose levels the weight change over 6 monts is reported for 14 rats exposed to an antituberculosis drug, aconiazide.

    +
    + +
    +

    Usage

    + 
    data(aconiazide)
    +
    + +
    +

    Format

    +

    A data frame with 55 observations of the following 2 variables.

    dose
    +

    a numeric vector

    + +
    weightChange
    +

    a numeric vector giving weight change (g) after 6 months of exposure

    + + +
    +
    +

    Source

    +

    Beland, F. A. and Dooley, K. L. and Hansen, E. B. and Sheldon, W. G. (1995). Six-month toxicity comparison of the antituberculosis drugs aconiazide and isoniazid in fischer 344 rats. Journal of the American College of Toxicology, 14(4):328–342.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Displaying the data
+head(aconiazide)
+#>   weightChange dose
+#> 1        366.0    0
+#> 2        326.6    0
+#> 3        355.0    0
+#> 4        353.8    0
+#> 5        354.4    0
+#> 6        349.8    0
+
+## Fitting a four-parameter log-logistic model
+aconiazide.m1 <- drm(weightChange ~ dose, data = aconiazide, fct = LL.4())
+summary(aconiazide.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                 Estimate Std. Error t-value p-value    
+#> b:(Intercept)    1.11216    0.45229  2.4589 0.01737 *  
+#> c:(Intercept)  -46.62703  821.99546 -0.0567 0.95499    
+#> d:(Intercept)  360.39895    4.96987 72.5168 < 2e-16 ***
+#> e:(Intercept) 1106.80577 3076.84642  0.3597 0.72054    
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  18.72333 (51 degrees of freedom)
+
+## Plotting the fitted curve
+plot(aconiazide.m1, xlab = "Dose", ylab = "Weight change (g)")
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/aconiazide.md b/docs/reference/aconiazide.md new file mode 100644 index 00000000..4df10b53 --- /dev/null +++ b/docs/reference/aconiazide.md @@ -0,0 +1,68 @@ +# Weight change in rats after exposure to a medical drug + +For each of 4 dose levels the weight change over 6 monts is reported for +14 rats exposed to an antituberculosis drug, aconiazide. + +## Usage + +``` r +data(aconiazide) +``` + +## Format + +A data frame with 55 observations of the following 2 variables. + +- `dose`: + + a numeric vector + +- `weightChange`: + + a numeric vector giving weight change (g) after 6 months of exposure + +## Source + +Beland, F. A. and Dooley, K. L. and Hansen, E. B. and Sheldon, W. G. +(1995). Six-month toxicity comparison of the antituberculosis drugs +aconiazide and isoniazid in fischer 344 rats. Journal of the American +College of Toxicology, **14(4)**:328–342. + +## Examples + +``` r +library(drc) + +## Displaying the data +head(aconiazide) +#> weightChange dose +#> 1 366.0 0 +#> 2 326.6 0 +#> 3 355.0 0 +#> 4 353.8 0 +#> 5 354.4 0 +#> 6 349.8 0 + +## Fitting a four-parameter log-logistic model +aconiazide.m1 <- drm(weightChange ~ dose, data = aconiazide, fct = LL.4()) +summary(aconiazide.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 1.11216 0.45229 2.4589 0.01737 * +#> c:(Intercept) -46.62703 821.99546 -0.0567 0.95499 +#> d:(Intercept) 360.39895 4.96987 72.5168 < 2e-16 *** +#> e:(Intercept) 1106.80577 3076.84642 0.3597 0.72054 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 18.72333 (51 degrees of freedom) + +## Plotting the fitted curve +plot(aconiazide.m1, xlab = "Dose", ylab = "Weight change (g)") +``` diff --git a/docs/reference/acute.inh-1.png b/docs/reference/acute.inh-1.png new file mode 100644 index 00000000..fd5d2df7 Binary files /dev/null and b/docs/reference/acute.inh-1.png differ diff --git a/docs/reference/acute.inh.html b/docs/reference/acute.inh.html new file mode 100644 index 00000000..ccc73fea --- /dev/null +++ b/docs/reference/acute.inh.html @@ -0,0 +1,116 @@ + +Acute inhalation — acute.inh • drc + Skip to contents + + +
    +
    +
    +

    Acute inhalation

    + +
    acute.inh.Rd
    +
    + +
    +

    Data from an acute inhalation toxicity test. For each of several dose levels, the total number of subjects and the number of dead subjects were recorded.

    +
    + +
    +

    Usage

    + 
    data(acute.inh)
    +
    + +
    +

    Format

    +

    A data frame with 6 observations on the following 3 variables.

    dose
    +

    a numeric vector

    + +
    total
    +

    a numeric vector

    + +
    num.dead
    +

    a numeric vector

    + + +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Displaying the data
+head(acute.inh)
+#>   dose total num.dead
+#> 1  422     5        0
+#> 2  744     5        1
+#> 3  948     5        3
+#> 4 2069     5        5
+
+## Fitting a two-parameter log-logistic model for binomial response
+acute.inh.m1 <- drm(num.dead/total ~ dose, weights = total,
+data = acute.inh, fct = LL.2(), type = "binomial")
+summary(acute.inh.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value p-value    
+#> b:(Intercept)  -7.9301     5.0812 -1.5607  0.1186    
+#> e:(Intercept) 895.2982    83.5547 10.7151  <2e-16 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+## Plotting the fitted curve
+plot(acute.inh.m1, xlab = "Dose", ylab = "Proportion dead")
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/acute.inh.md b/docs/reference/acute.inh.md new file mode 100644 index 00000000..7b5ff66d --- /dev/null +++ b/docs/reference/acute.inh.md @@ -0,0 +1,59 @@ +# Acute inhalation + +Data from an acute inhalation toxicity test. For each of several dose +levels, the total number of subjects and the number of dead subjects +were recorded. + +## Usage + +``` r +data(acute.inh) +``` + +## Format + +A data frame with 6 observations on the following 3 variables. + +- `dose`: + + a numeric vector + +- `total`: + + a numeric vector + +- `num.dead`: + + a numeric vector + +## Examples + +``` r +library(drc) + +## Displaying the data +head(acute.inh) +#> dose total num.dead +#> 1 422 5 0 +#> 2 744 5 1 +#> 3 948 5 3 +#> 4 2069 5 5 + +## Fitting a two-parameter log-logistic model for binomial response +acute.inh.m1 <- drm(num.dead/total ~ dose, weights = total, +data = acute.inh, fct = LL.2(), type = "binomial") +summary(acute.inh.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) -7.9301 5.0812 -1.5607 0.1186 +#> e:(Intercept) 895.2982 83.5547 10.7151 <2e-16 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 + +## Plotting the fitted curve +plot(acute.inh.m1, xlab = "Dose", ylab = "Proportion dead") +``` diff --git a/docs/reference/algae-1.png b/docs/reference/algae-1.png new file mode 100644 index 00000000..035c2cc4 Binary files /dev/null and b/docs/reference/algae-1.png differ diff --git a/docs/reference/algae.html b/docs/reference/algae.html new file mode 100644 index 00000000..075935b3 --- /dev/null +++ b/docs/reference/algae.html @@ -0,0 +1,142 @@ + +Volume of algae as function of increasing concentrations of a herbicide — algae • drc + Skip to contents + + +
    +
    +
    +

    Volume of algae as function of increasing concentrations of a herbicide

    + +
    algae.Rd
    +
    + +
    +

    Dataset from an experiment exploring the effect of increasing concentrations of a herbicide on + the volume of the treated algae.

    +
    + +
    +

    Usage

    + 
    data(algae)
    +
    + +
    +

    Format

    +

    A data frame with 14 observations on the following 2 variables.

    conc
    +

    a numeric vector of concentrations.

    + +
    vol
    +

    a numeric vector of response values, that is relative change in volume.

    + + +
    +
    +

    Details

    +

    This datasets requires a cubic root transformation in order to stabilise the variance.

    +
    +
    +

    Source

    +

    Meister, R. and van den Brink, P. (2000) + The Analysis of Laboratory Toxicity Experiments, + Chapter 4 in Statistics in Ecotoxicology, Editor: T. Sparks, + New York: John Wiley & Sons, (pp. 114–116).

    +
    + +
    +

    Examples

    + 
    library(drc)
+algae.m1 <- drm(vol~conc, data=algae, fct=LL.3())
+summary(algae.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                Estimate Std. Error t-value   p-value    
+#> b:(Intercept)   1.36244    0.16352  8.3321 4.428e-06 ***
+#> d:(Intercept) 104.85893    2.57750 40.6825 2.403e-13 ***
+#> e:(Intercept)   6.04062    0.69519  8.6892 2.952e-06 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  3.911178 (11 degrees of freedom)
+
+algae.m2 <- boxcox(algae.m1)
+
+summary(algae.m2)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                Estimate Std. Error t-value   p-value    
+#> b:(Intercept)   1.51428    0.10648 14.2207 1.996e-08 ***
+#> d:(Intercept) 103.65175    3.96547 26.1386 2.977e-11 ***
+#> e:(Intercept)   6.41710    0.73892  8.6845 2.968e-06 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.7137765 (11 degrees of freedom)
+#> 
+#> Non-normality/heterogeneity adjustment through Box-Cox transformation
+#> 
+#> Estimated lambda: 0.5 
+#> Confidence interval for lambda: [0.294,0.676] 
+#> 
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/algae.md b/docs/reference/algae.md new file mode 100644 index 00000000..b92ebf60 --- /dev/null +++ b/docs/reference/algae.md @@ -0,0 +1,82 @@ +# Volume of algae as function of increasing concentrations of a herbicide + +Dataset from an experiment exploring the effect of increasing +concentrations of a herbicide on the volume of the treated algae. + +## Usage + +``` r +data(algae) +``` + +## Format + +A data frame with 14 observations on the following 2 variables. + +- `conc`: + + a numeric vector of concentrations. + +- `vol`: + + a numeric vector of response values, that is relative change in + volume. + +## Details + +This datasets requires a cubic root transformation in order to stabilise +the variance. + +## Source + +Meister, R. and van den Brink, P. (2000) *The Analysis of Laboratory +Toxicity Experiments*, Chapter 4 in *Statistics in Ecotoxicology*, +Editor: T. Sparks, New York: John Wiley & Sons, (pp. 114–116). + +## Examples + +``` r +library(drc) +algae.m1 <- drm(vol~conc, data=algae, fct=LL.3()) +summary(algae.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 1.36244 0.16352 8.3321 4.428e-06 *** +#> d:(Intercept) 104.85893 2.57750 40.6825 2.403e-13 *** +#> e:(Intercept) 6.04062 0.69519 8.6892 2.952e-06 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 3.911178 (11 degrees of freedom) + +algae.m2 <- boxcox(algae.m1) + +summary(algae.m2) +#> +#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 1.51428 0.10648 14.2207 1.996e-08 *** +#> d:(Intercept) 103.65175 3.96547 26.1386 2.977e-11 *** +#> e:(Intercept) 6.41710 0.73892 8.6845 2.968e-06 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.7137765 (11 degrees of freedom) +#> +#> Non-normality/heterogeneity adjustment through Box-Cox transformation +#> +#> Estimated lambda: 0.5 +#> Confidence interval for lambda: [0.294,0.676] +#> +``` diff --git a/docs/reference/anova.drc.html b/docs/reference/anova.drc.html index ea3c26d6..fca13fc2 100644 --- a/docs/reference/anova.drc.html +++ b/docs/reference/anova.drc.html @@ -1,214 +1,174 @@ - - - - - - +ANOVA Model Comparison for Dose-Response Models — anova.drc • drc + Skip to contents -ANOVA for dose-response model fits — anova.drc • drc - - - +
    +
    +
    +

    ANOVA Model Comparison for Dose-Response Models

    + Source: R/anova.drc.R +
    anova.drc.Rd
    +
    - +
    +

    Compares two nested dose-response model fits using a likelihood-ratio test +(for binomial data) or an F-test (for continuous data). Two drc +objects must be provided. For a lack-of-fit test of a single model, use +modelFit instead.

    +
    - - +
    +

    Usage

    + 
    # S3 method for class 'drc'
+anova(object, ..., details = TRUE, test = NULL)
    +
    +
    +

    Arguments

    - - +
    object
    +

    an object of class ‘drc’.

    - +
    ...
    +

    a second object of class ‘drc’ to compare against +object. Exactly two models must be supplied; passing a single +model will result in an error directing the user to +modelFit.

    - - -
    -
    - - - -
    -
    -
    -
    -

    ANOVA for dose-response model fits

    - - -
    +
    test
    +

    a character string specifying the test statistic to be applied. +For continuous data the default is "F" (F-test); for binomial data +the default is "Chisq" (likelihood-ratio test). Use "Chisq" +to force a likelihood-ratio test for continuous data.

    -
    - -

    'anova' produces an analysis of variance table for one or two non-linear model fits.

    - +
    +
    +

    Value

    +

    An object of class ‘anova’ (inheriting from +data.frame) with columns for model degrees of freedom, residual +sum of squares (or log-likelihood), the difference in degrees of freedom, +the test statistic, and the p-value.

    +
    +
    +

    Details

    +

    Two drc objects must be specified. The function performs a test for +reduction from the larger to the smaller model. This only makes statistical +sense if the models are nested, that is: one model is a submodel of the +other model.

    +

    For continuous data an F-test is used by default. For binomial data a +likelihood-ratio (chi-square) test is used by default.

    +

    If a single model is passed, the function raises an error. To assess the +fit of a single dose-response model (lack-of-fit test comparing the model +to a more general ANOVA model), use modelFit instead.

    +
    +
    +

    See also

    +

    modelFit for lack-of-fit testing of a single model, +drm for fitting dose-response models, +logLik.drc for log-likelihood extraction, +summary.drc for model summaries.

    +
    +
    +

    Author

    +

    Christian Ritz, Hannes Reinwald

    - 
    # S3 method for drc
-anova(object, ..., details = TRUE, test = NULL)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - -
    object

    an object of class 'drc'.

    ...

    additional arguments.

    details

    logical indicating whether or not details on the models compared should be displayed. - Default is TRUE (details are displayed).

    test

    a character string specifying the test statistic to be applied. - Use "od" to assess overdispersion for binomial data.

    - -

    Details

    - -

    Specifying only a single object gives a test for lack-of-fit, comparing the non-linear regression - model to a more general one-way or two-way ANOVA model.

    -

    If two objects are specified a test for reduction from the larger to the smaller model is given. (This only makes statistical - sense if the models are nested, that is: one model is a submodel of the other model.)

    - -

    Value

    - -

    An object of class 'anova'.

    - -

    References

    - -

    Bates, D. M. and Watts, D. G. (1988) - Nonlinear Regression Analysis and Its Applications, - New York: Wiley \& Sons (pp. 103--104)

    - -

    See also

    - -

    For comparison of nested or non-nested model the function mselectcan also be used.

    -

    The function anova.lm for linear models.

    - - -

    Examples

    - 
    
-## Comparing a Gompertz three- and four-parameter models using an F test
-ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4())
-ryegrass.m2 <- drm(rootl ~ conc, data = ryegrass, fct = W1.3())
-anova(ryegrass.m2, ryegrass.m1)  # reduction to 'W1.3' not possible (highly significant)   
    #> 
-#> 1st model
-#>  fct:      W1.3()
-#> 2nd model
-#>  fct:      W1.4()
-#> 
    #> ANOVA table
-#> 
-#>           ModelDf    RSS Df F value p value
-#> 1st model      21 8.9520                   
-#> 2nd model      20 6.0242  1  9.7205  0.0054
    
-anova(ryegrass.m2, ryegrass.m1, details = FALSE)  # without details
    #> ANOVA table
-#> 
-#>           ModelDf    RSS Df F value p value
-#> 1st model      21 8.9520                   
-#> 2nd model      20 6.0242  1  9.7205  0.0054
    
-
    -
    - -
  • See also
    • - -
  • Examples
    • - -

    Author

    - Christian Ritz -
    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + -
    - - - - + diff --git a/docs/reference/anova.drc.md b/docs/reference/anova.drc.md new file mode 100644 index 00000000..93279a38 --- /dev/null +++ b/docs/reference/anova.drc.md @@ -0,0 +1,112 @@ +# ANOVA Model Comparison for Dose-Response Models + +Compares two nested dose-response model fits using a likelihood-ratio +test (for binomial data) or an F-test (for continuous data). Two `drc` +objects must be provided. For a lack-of-fit test of a single model, use +[`modelFit`](https://hreinwald.github.io/drc/reference/modelFit.md) +instead. + +## Usage + +``` r +# S3 method for class 'drc' +anova(object, ..., details = TRUE, test = NULL) +``` + +## Arguments + +- object: + + an object of class ‘drc’. + +- ...: + + a second object of class ‘drc’ to compare against `object`. Exactly + two models must be supplied; passing a single model will result in an + error directing the user to + [`modelFit`](https://hreinwald.github.io/drc/reference/modelFit.md). + +- details: + + logical indicating whether or not details on the models compared + should be displayed. Default is `TRUE` (details are displayed). + +- test: + + a character string specifying the test statistic to be applied. For + continuous data the default is `"F"` (F-test); for binomial data the + default is `"Chisq"` (likelihood-ratio test). Use `"Chisq"` to force a + likelihood-ratio test for continuous data. + +## Value + +An object of class ‘anova’ (inheriting from `data.frame`) with columns +for model degrees of freedom, residual sum of squares (or +log-likelihood), the difference in degrees of freedom, the test +statistic, and the p-value. + +## Details + +Two `drc` objects must be specified. The function performs a test for +reduction from the larger to the smaller model. This only makes +statistical sense if the models are nested, that is: one model is a +submodel of the other model. + +For continuous data an F-test is used by default. For binomial data a +likelihood-ratio (chi-square) test is used by default. + +If a single model is passed, the function raises an error. To assess the +fit of a single dose-response model (lack-of-fit test comparing the +model to a more general ANOVA model), use +[`modelFit`](https://hreinwald.github.io/drc/reference/modelFit.md) +instead. + +## See also + +[`modelFit`](https://hreinwald.github.io/drc/reference/modelFit.md) for +lack-of-fit testing of a single model, +[`drm`](https://hreinwald.github.io/drc/reference/drm.md) for fitting +dose-response models, +[`logLik.drc`](https://hreinwald.github.io/drc/reference/logLik.drc.md) +for log-likelihood extraction, +[`summary.drc`](https://hreinwald.github.io/drc/reference/summary.drc.md) +for model summaries. + +## Author + +Christian Ritz, Hannes Reinwald + +## Examples + +``` r +## Comparing two nested models (two-model comparison) +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) +ryegrass.m2 <- drm(rootl ~ conc, data = ryegrass, fct = W1.3()) +anova(ryegrass.m2, ryegrass.m1) +#> +#> 1st model +#> fct: W1.3() +#> 2nd model +#> fct: W1.4() +#> +#> ANOVA table +#> +#> ModelDf RSS Df F value p value +#> 1st model 21 8.9520 +#> 2nd model 20 6.0242 1 9.7205 0.0054 + +anova(ryegrass.m2, ryegrass.m1, details = FALSE) # without details +#> ANOVA table +#> +#> ModelDf RSS Df F value p value +#> 1st model 21 8.9520 +#> 2nd model 20 6.0242 1 9.7205 0.0054 + +## For a lack-of-fit test on a single model, use modelFit(): +modelFit(ryegrass.m1) +#> Lack-of-fit test +#> +#> ModelDf RSS Df F value p value +#> ANOVA 17 5.1799 +#> DRC model 20 6.0242 3 0.9236 0.4506 +``` diff --git a/docs/reference/anova.drclist.html b/docs/reference/anova.drclist.html new file mode 100644 index 00000000..a2678f90 --- /dev/null +++ b/docs/reference/anova.drclist.html @@ -0,0 +1,71 @@ + +ANOVA for list of drc objects — anova.drclist • drc + Skip to contents + + +
    +
    +
    +

    ANOVA for list of drc objects

    + Source: R/anova.drclist.R +
    anova.drclist.Rd
    +
    + +
    +

    ANOVA for list of drc objects

    +
    + +
    +

    Usage

    + 
    # S3 method for class 'drclist'
+anova(object, ..., details = TRUE, test = NULL)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/anova.drclist.md b/docs/reference/anova.drclist.md new file mode 100644 index 00000000..e006e61f --- /dev/null +++ b/docs/reference/anova.drclist.md @@ -0,0 +1,10 @@ +# ANOVA for list of drc objects + +ANOVA for list of drc objects + +## Usage + +``` r +# S3 method for class 'drclist' +anova(object, ..., details = TRUE, test = NULL) +``` diff --git a/docs/reference/arandaordaz.html b/docs/reference/arandaordaz.html new file mode 100644 index 00000000..ecea3f91 --- /dev/null +++ b/docs/reference/arandaordaz.html @@ -0,0 +1,156 @@ + +Asymptotic Regression Model — arandaordaz • drc + Skip to contents + + +
    +
    +
    +

    Asymptotic Regression Model

    + Source: R/arandaordaz.R +
    arandaordaz.Rd
    +
    + +
    +

    The base function for the asymptotic regression model, providing the mean +function and self starter for a three-parameter model.

    +
    + +
    +

    Usage

    + 
    arandaordaz(fixed = c(NA, NA, NA), names = c("a", "b", "c"), fctName, fctText)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector. Specifies which parameters are fixed and at what +value they are fixed. Use NA for parameters that are not fixed. +Must be of length 3.

    + + +
    names
    +

    character vector of length 3 giving the names of the parameters +(should not contain ":").

    + + +
    fctName
    +

    optional character string used internally by convenience +functions. Defaults to "arandaordaz" if not provided.

    + + +
    fctText
    +

    optional character string used internally by convenience +functions. Defaults to "Asymptotic regression" if not provided.

    + +
    +
    +

    Value

    +

    A list of class drcMean with the following components:

    fct
    +

    The mean function taking arguments dose and parm.

    + +
    ssfct
    +

    Self-starter function for generating initial parameter +estimates from data.

    + +
    names
    +

    Character vector of non-fixed parameter names.

    + +
    deriv1
    +

    Reserved first derivative slot (currently NULL).

    + +
    deriv2
    +

    Reserved second derivative slot (currently NULL).

    + +
    derivx
    +

    Reserved derivative-with-respect-to-x slot (currently +NULL).

    + +
    edfct
    +

    Function for calculating effective dose (ED) values and +their derivatives.

    + +
    inversion
    +

    Inverse mean function for back-calculating dose from +response.

    + +
    name
    +

    Character string identifying the model function name.

    + +
    text
    +

    Character string with a human-readable model description.

    + +
    noParm
    +

    Integer giving the number of non-fixed parameters.

    + + +
    +
    +

    Details

    +

    The asymptotic regression model is a three-parameter model with mean function:

    +

    $$f(x) = c + (d-c)(1-\exp(-x/e))$$

    +

    The parameter \(c\) is the lower limit (at \(x=0\)), \(d\) is the upper limit, +and \(e>0\) determines the steepness of the increase.

    +
    +
    +

    See also

    +

    AR.2, AR.3, EXD.2, +EXD.3

    +
    +
    +

    Author

    +

    Christian Ritz, Hannes Reinwald

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/arandaordaz.md b/docs/reference/arandaordaz.md new file mode 100644 index 00000000..c3aea6b6 --- /dev/null +++ b/docs/reference/arandaordaz.md @@ -0,0 +1,104 @@ +# Asymptotic Regression Model + +The base function for the asymptotic regression model, providing the +mean function and self starter for a three-parameter model. + +## Usage + +``` r +arandaordaz(fixed = c(NA, NA, NA), names = c("a", "b", "c"), fctName, fctText) +``` + +## Arguments + +- fixed: + + numeric vector. Specifies which parameters are fixed and at what value + they are fixed. Use `NA` for parameters that are not fixed. Must be of + length 3. + +- names: + + character vector of length 3 giving the names of the parameters + (should not contain ":"). + +- fctName: + + optional character string used internally by convenience functions. + Defaults to `"arandaordaz"` if not provided. + +- fctText: + + optional character string used internally by convenience functions. + Defaults to `"Asymptotic regression"` if not provided. + +## Value + +A list of class `drcMean` with the following components: + +- fct: + + The mean function taking arguments `dose` and `parm`. + +- ssfct: + + Self-starter function for generating initial parameter estimates from + data. + +- names: + + Character vector of non-fixed parameter names. + +- deriv1: + + Reserved first derivative slot (currently `NULL`). + +- deriv2: + + Reserved second derivative slot (currently `NULL`). + +- derivx: + + Reserved derivative-with-respect-to-x slot (currently `NULL`). + +- edfct: + + Function for calculating effective dose (ED) values and their + derivatives. + +- inversion: + + Inverse mean function for back-calculating dose from response. + +- name: + + Character string identifying the model function name. + +- text: + + Character string with a human-readable model description. + +- noParm: + + Integer giving the number of non-fixed parameters. + +## Details + +The asymptotic regression model is a three-parameter model with mean +function: + +\$\$f(x) = c + (d-c)(1-\exp(-x/e))\$\$ + +The parameter \\c\\ is the lower limit (at \\x=0\\), \\d\\ is the upper +limit, and \\e\>0\\ determines the steepness of the increase. + +## See also + +[`AR.2`](https://hreinwald.github.io/drc/reference/AR.2.md), +[`AR.3`](https://hreinwald.github.io/drc/reference/AR.3.md), +[`EXD.2`](https://hreinwald.github.io/drc/reference/EXD.2.md), +[`EXD.3`](https://hreinwald.github.io/drc/reference/EXD.3.md) + +## Author + +Christian Ritz, Hannes Reinwald diff --git a/docs/reference/arbovirus-1.png b/docs/reference/arbovirus-1.png new file mode 100644 index 00000000..1e18f41e Binary files /dev/null and b/docs/reference/arbovirus-1.png differ diff --git a/docs/reference/arbovirus.html b/docs/reference/arbovirus.html new file mode 100644 index 00000000..05e459cb --- /dev/null +++ b/docs/reference/arbovirus.html @@ -0,0 +1,126 @@ + +arbovirus — arbovirus • drc + Skip to contents + + +
    +
    +
    +

    arbovirus

    + +
    arbovirus.Rd
    +
    + +
    +

    Data from a dose-response experiment with an arbovirus involving two treatment groups (FP and SP). For each dose level, the total number of subjects and the numbers of dead and defective subjects were recorded.

    +
    + +
    +

    Usage

    + 
    data(arbovirus)
    +
    + +
    +

    Format

    +

    A data frame with 9 observations on the following 5 variables.

    dose
    +

    a numeric vector

    + +
    total
    +

    a numeric vector

    + +
    dead
    +

    a numeric vector

    + +
    def
    +

    a numeric vector

    + +
    trt
    +

    a categorical vector

    + + +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Displaying the data
+head(arbovirus)
+#>   dose total dead def trt
+#> 1    3    17    3   1  FP
+#> 2   18    19    4   1  FP
+#> 3   30    19    8   2  FP
+#> 4   90    20   17   1  FP
+#> 5    3    19    1   0   T
+#> 6   20    19    2   0   T
+
+## Fitting a two-parameter log-logistic model for binomial response
+arbovirus.m1 <- drm(dead/total ~ dose, trt, weights = total,
+data = arbovirus, fct = LL.2(), type = "binomial")
+summary(arbovirus.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>         Estimate  Std. Error t-value   p-value    
+#> b:FP -1.0219e+00  2.8425e-01 -3.5949 0.0003245 ***
+#> b:T  -2.8993e-01  7.1182e-02 -4.0731 4.638e-05 ***
+#> e:FP  3.2617e+01  8.6014e+00  3.7921 0.0001494 ***
+#> e:T   4.1896e+04  3.6484e+04  1.1483 0.2508315    
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+## Plotting the fitted curves
+plot(arbovirus.m1, xlab = "Dose", ylab = "Proportion dead")
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/arbovirus.md b/docs/reference/arbovirus.md new file mode 100644 index 00000000..e2bc70a5 --- /dev/null +++ b/docs/reference/arbovirus.md @@ -0,0 +1,71 @@ +# arbovirus + +Data from a dose-response experiment with an arbovirus involving two +treatment groups (FP and SP). For each dose level, the total number of +subjects and the numbers of dead and defective subjects were recorded. + +## Usage + +``` r +data(arbovirus) +``` + +## Format + +A data frame with 9 observations on the following 5 variables. + +- `dose`: + + a numeric vector + +- `total`: + + a numeric vector + +- `dead`: + + a numeric vector + +- `def`: + + a numeric vector + +- `trt`: + + a categorical vector + +## Examples + +``` r +library(drc) + +## Displaying the data +head(arbovirus) +#> dose total dead def trt +#> 1 3 17 3 1 FP +#> 2 18 19 4 1 FP +#> 3 30 19 8 2 FP +#> 4 90 20 17 1 FP +#> 5 3 19 1 0 T +#> 6 20 19 2 0 T + +## Fitting a two-parameter log-logistic model for binomial response +arbovirus.m1 <- drm(dead/total ~ dose, trt, weights = total, +data = arbovirus, fct = LL.2(), type = "binomial") +summary(arbovirus.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:FP -1.0219e+00 2.8425e-01 -3.5949 0.0003245 *** +#> b:T -2.8993e-01 7.1182e-02 -4.0731 4.638e-05 *** +#> e:FP 3.2617e+01 8.6014e+00 3.7921 0.0001494 *** +#> e:T 4.1896e+04 3.6484e+04 1.1483 0.2508315 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 + +## Plotting the fitted curves +plot(arbovirus.m1, xlab = "Dose", ylab = "Proportion dead") +``` diff --git a/docs/reference/auxins-1.png b/docs/reference/auxins-1.png new file mode 100644 index 00000000..512459c3 Binary files /dev/null and b/docs/reference/auxins-1.png differ diff --git a/docs/reference/auxins.html b/docs/reference/auxins.html new file mode 100644 index 00000000..6060378f --- /dev/null +++ b/docs/reference/auxins.html @@ -0,0 +1,177 @@ + +Effect of technical grade and commercially formulated auxin herbicides — auxins • drc + Skip to contents + + +
    +
    +
    +

    Effect of technical grade and commercially formulated auxin herbicides

    + +
    auxins.Rd
    +
    + +
    +

    MCPA, 2,4-D, mecorprop and dichorlprop were applied either as technical grades + materials or as commercial formulations. + Each experimental unit consisted of five 1-week old seedlings grown together + in a pot of nutrient solution during 14 days.

    +
    + +
    +

    Usage

    + 
    data(auxins)
    +
    + +
    +

    Format

    +

    A data frame with 150 observations on the following 5 variables.

    dryweight
    +

    a numeric vector

    + +
    dose
    +

    a numeric vector

    + +
    replicate
    +

    a factor with 3 levels

    + +
    herbicide
    +

    a factor with 5 levels

    + +
    formulation
    +

    a factor with 2 levels

    + + +
    +
    +

    Details

    +

    Data are parts of a larger joint action experiment with various herbicides.

    +

    The eight herbicide preparations are naturally grouped into four pairs (herbicide:formulation) + control, and each pair of herbicides should have the same active ingredients but different formulation + constituents, which were assumed to be biologically inert. The data consist + of the 150 observations of dry weights, each observation being the weight + of five plants grown in the same pot. All the eight herbicide preparations have + essentially the same mode of action in the plant; they all act like the plant + auxins, which are plant regulators that affect cell enlongation an other + essential metabolic pathways. One of the objects of the experiment was to test + if the response functions were identical except for a multiplicative factor in + the dose. This is a necessary, but not a sufficient, condition for a similar + mode of action for the herbicides.

    +
    +
    +

    Source

    +

    Streibig, J. C. (1987). Joint action of root-absorbed mixtures of auxin + herbicides in Sinapis alba L. and barley (Hordeum vulgare L.) + Weed Research, 27, 337–347.

    +
    +
    +

    References

    +

    Rudemo, M., Ruppert, D., and Streibig, J. C. (1989). Random-Effect Models + in Nonlinear Regression with Applications to Bioassay. + Biometrics, 45, 349–362.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Displaying the data
+head(auxins)
+#>   dryweight  dose replicate herbicide formulation
+#> 1      1.51 0.000         1   control     control
+#> 2      1.43 0.000         1   control     control
+#> 3      0.05 1.000         1      MCPA        tech
+#> 4      0.06 0.500         1      MCPA        tech
+#> 5      0.15 0.250         1      MCPA        tech
+#> 6      0.40 0.125         1      MCPA        tech
+
+## Fitting a four-parameter log-logistic model with different curves per herbicide
+auxins.m1 <- drm(dryweight ~ dose, herbicide, data = auxins, fct = LL.4())
+#> Control measurements detected for level: control
+summary(auxins.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                 Estimate Std. Error t-value   p-value    
+#> b:MCPA         2.0706241  0.3893031  5.3188 4.260e-07 ***
+#> b:24-D         2.5445569  0.7248661  3.5104  0.000610 ***
+#> b:mecorprop    2.1805520  0.6672103  3.2682  0.001375 ** 
+#> b:dichorlprop  1.3931656  0.6406655  2.1746  0.031419 *  
+#> c:MCPA         0.0476642  0.0481999  0.9889  0.324501    
+#> c:24-D         0.0267124  0.0545256  0.4899  0.625002    
+#> c:mecorprop    0.0714663  0.0669183  1.0680  0.287458    
+#> c:dichorlprop -0.0207450  0.3280620 -0.0632  0.949674    
+#> d:MCPA         1.2724266  0.0599127 21.2380 < 2.2e-16 ***
+#> d:24-D         1.1472951  0.0877739 13.0710 < 2.2e-16 ***
+#> d:mecorprop    1.2462095  0.1058526 11.7731 < 2.2e-16 ***
+#> d:dichorlprop  1.2117312  0.1012559 11.9670 < 2.2e-16 ***
+#> e:MCPA         0.0710631  0.0076089  9.3394 3.620e-16 ***
+#> e:24-D         0.1275807  0.0147148  8.6702 1.246e-14 ***
+#> e:mecorprop    0.1218997  0.0156858  7.7714 1.815e-12 ***
+#> e:dichorlprop  0.3391236  0.1391753  2.4367  0.016136 *  
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.1535001 (134 degrees of freedom)
+
+## Plotting the fitted curves
+plot(auxins.m1, xlab = "Dose", ylab = "Dry weight")
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/auxins.md b/docs/reference/auxins.md new file mode 100644 index 00000000..4d4d8be0 --- /dev/null +++ b/docs/reference/auxins.md @@ -0,0 +1,118 @@ +# Effect of technical grade and commercially formulated auxin herbicides + +MCPA, 2,4-D, mecorprop and dichorlprop were applied either as technical +grades materials or as commercial formulations. Each experimental unit +consisted of five 1-week old seedlings grown together in a pot of +nutrient solution during 14 days. + +## Usage + +``` r +data(auxins) +``` + +## Format + +A data frame with 150 observations on the following 5 variables. + +- `dryweight`: + + a numeric vector + +- `dose`: + + a numeric vector + +- `replicate`: + + a factor with 3 levels + +- `herbicide`: + + a factor with 5 levels + +- `formulation`: + + a factor with 2 levels + +## Details + +Data are parts of a larger joint action experiment with various +herbicides. + +The eight herbicide preparations are naturally grouped into four pairs +(herbicide:formulation) + control, and each pair of herbicides should +have the same active ingredients but different formulation constituents, +which were assumed to be biologically inert. The data consist of the 150 +observations of dry weights, each observation being the weight of five +plants grown in the same pot. All the eight herbicide preparations have +essentially the same mode of action in the plant; they all act like the +plant auxins, which are plant regulators that affect cell enlongation an +other essential metabolic pathways. One of the objects of the experiment +was to test if the response functions were identical except for a +multiplicative factor in the dose. This is a necessary, but not a +sufficient, condition for a similar mode of action for the herbicides. + +## Source + +Streibig, J. C. (1987). Joint action of root-absorbed mixtures of auxin +herbicides in Sinapis alba L. and barley (Hordeum vulgare L.) *Weed +Research*, **27**, 337–347. + +## References + +Rudemo, M., Ruppert, D., and Streibig, J. C. (1989). Random-Effect +Models in Nonlinear Regression with Applications to Bioassay. +*Biometrics*, **45**, 349–362. + +## Examples + +``` r +library(drc) + +## Displaying the data +head(auxins) +#> dryweight dose replicate herbicide formulation +#> 1 1.51 0.000 1 control control +#> 2 1.43 0.000 1 control control +#> 3 0.05 1.000 1 MCPA tech +#> 4 0.06 0.500 1 MCPA tech +#> 5 0.15 0.250 1 MCPA tech +#> 6 0.40 0.125 1 MCPA tech + +## Fitting a four-parameter log-logistic model with different curves per herbicide +auxins.m1 <- drm(dryweight ~ dose, herbicide, data = auxins, fct = LL.4()) +#> Control measurements detected for level: control +summary(auxins.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:MCPA 2.0706241 0.3893031 5.3188 4.260e-07 *** +#> b:24-D 2.5445569 0.7248661 3.5104 0.000610 *** +#> b:mecorprop 2.1805520 0.6672103 3.2682 0.001375 ** +#> b:dichorlprop 1.3931656 0.6406655 2.1746 0.031419 * +#> c:MCPA 0.0476642 0.0481999 0.9889 0.324501 +#> c:24-D 0.0267124 0.0545256 0.4899 0.625002 +#> c:mecorprop 0.0714663 0.0669183 1.0680 0.287458 +#> c:dichorlprop -0.0207450 0.3280620 -0.0632 0.949674 +#> d:MCPA 1.2724266 0.0599127 21.2380 < 2.2e-16 *** +#> d:24-D 1.1472951 0.0877739 13.0710 < 2.2e-16 *** +#> d:mecorprop 1.2462095 0.1058526 11.7731 < 2.2e-16 *** +#> d:dichorlprop 1.2117312 0.1012559 11.9670 < 2.2e-16 *** +#> e:MCPA 0.0710631 0.0076089 9.3394 3.620e-16 *** +#> e:24-D 0.1275807 0.0147148 8.6702 1.246e-14 *** +#> e:mecorprop 0.1218997 0.0156858 7.7714 1.815e-12 *** +#> e:dichorlprop 0.3391236 0.1391753 2.4367 0.016136 * +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.1535001 (134 degrees of freedom) + +## Plotting the fitted curves +plot(auxins.m1, xlab = "Dose", ylab = "Dry weight") +``` diff --git a/docs/reference/backfit.html b/docs/reference/backfit.html index f9c280f0..44f94916 100644 --- a/docs/reference/backfit.html +++ b/docs/reference/backfit.html @@ -1,182 +1,112 @@ - - - - - - +Calculation of backfit values from a fitted dose-response model — backfit • drc + Skip to contents -Calculation of backfit values from a fitted dose-response model — backfit • drc - - - +
    +
    +
    +

    Calculation of backfit values from a fitted dose-response model

    + Source: R/backfit.R +
    backfit.Rd
    +
    - - - - - - +
    +

    By inverse regression backfitted dose values are calculated for the mean response per dose.

    +
    - - +
    +

    Usage

    + 
    backfit(drcObject)
    +
    - +
    +

    Arguments

    - +
    drcObject
    +

    an object of class 'drc'.

    - -
    -
    -
    +
    +

    Value

    +

    Two columns with the original dose values and the corresponding backfitted values +using the fitted dose-response model. For extreme dose values (e.g., high dose) the +backfitted values may not be well-defined.

    - - -
    -
    - - - - -
    -
    -
    -

    Calculation of backfit values from a fitted dose-response model

    - - +
    +

    See also

    +

    A related function is ED.drc.

    - -
    - -

    By inverse regression backfitted dose values are calculated for the mean response per dose.

    - +
    +

    Author

    +

    Christian Ritz after a suggestion from Keld Sorensen.

    - 
    backfit(drcObject)
    - -

    Arguments

    - - - - - - -
    drcObject

    an object of class 'drc'.

    - -

    Value

    - -

    Two columns with the original dose values and the corresponding backfitted values using the fitted dose-response model. - For extreme dose values (e.g., high dose ) the backfitted values may not be well-defined (see the example below).

    - -

    References

    - -

    ??

    - -

    See also

    - -

    A related function is ED.drc.

    - - -

    Examples

    - 
    
-ryegrass.LL.4 <- drm(rootl~conc, data=ryegrass, fct=LL.4())
-
-backfit(ryegrass.LL.4)
    #> Warning: NaNs produced
    #>       dose   Estimate
-#> [1,]  0.00  0.5500692
-#> [2,]  0.94  0.7743783
-#> [3,]  1.88  1.8744292
-#> [4,]  3.75  3.7830500
-#> [5,]  7.50  7.0811832
-#> [6,] 15.00 10.1667582
-#> [7,] 30.00        NaN
    
-
    -
    - -

    Author

    - - Christian Ritz after a suggestion from Keld Sorensen. -
    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + - -
    - - - + diff --git a/docs/reference/backfit.md b/docs/reference/backfit.md new file mode 100644 index 00000000..8b9de1be --- /dev/null +++ b/docs/reference/backfit.md @@ -0,0 +1,50 @@ +# Calculation of backfit values from a fitted dose-response model + +By inverse regression backfitted dose values are calculated for the mean +response per dose. + +## Usage + +``` r +backfit(drcObject) +``` + +## Arguments + +- drcObject: + + an object of class 'drc'. + +## Value + +Two columns with the original dose values and the corresponding +backfitted values using the fitted dose-response model. For extreme dose +values (e.g., high dose) the backfitted values may not be well-defined. + +## See also + +A related function is +[`ED.drc`](https://hreinwald.github.io/drc/reference/ED.drc.md). + +## Author + +Christian Ritz after a suggestion from Keld Sorensen. + +## Examples + +``` r +ryegrass.LL.4 <- drm(rootl~conc, data=ryegrass, fct=LL.4()) + +backfit(ryegrass.LL.4) +#> Warning: NaNs produced +#> Warning: Non-positive variance estimate; SE set to NA. +#> Warning: Non-positive variance estimate; SE set to NA. +#> dose Estimate +#> [1,] 0.00 0.5500692 +#> [2,] 0.94 0.7743783 +#> [3,] 1.88 1.8744292 +#> [4,] 3.75 3.7830500 +#> [5,] 7.50 7.0811832 +#> [6,] 15.00 10.1667582 +#> [7,] 30.00 Inf +``` diff --git a/docs/reference/barley-1.png b/docs/reference/barley-1.png new file mode 100644 index 00000000..9474a6c8 Binary files /dev/null and b/docs/reference/barley-1.png differ diff --git a/docs/reference/barley.html b/docs/reference/barley.html new file mode 100644 index 00000000..51aa804b --- /dev/null +++ b/docs/reference/barley.html @@ -0,0 +1,120 @@ + +Barley — barley • drc + Skip to contents + + +
    +
    +
    +

    Barley

    + +
    barley.Rd
    +
    + +
    +

    Data from a dose-response experiment measuring the weight of barley (Hordeum vulgare) at different dose levels of a substance.

    +
    + +
    +

    Usage

    + 
    data(barley)
    +
    + +
    +

    Format

    +

    A data frame with 18 observations of the following 2 variables.

    Dose
    +

    a numeric vector

    + +
    weight
    +

    a numeric vector

    + + +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Displaying the data
+head(barley)
+#>       Dose weight
+#> 1  0.00000   57.2
+#> 2  0.00000   49.8
+#> 3 21.09375   62.2
+#> 4 21.09375   30.6
+#> 5 42.18750   40.9
+#> 6 42.18750   70.9
+
+## Fitting a four-parameter log-logistic model
+barley.m1 <- drm(weight ~ Dose, data = barley, fct = LL.4())
+summary(barley.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept)   9.7084    42.9166  0.2262   0.82430    
+#> c:(Intercept)  11.1275     3.7803  2.9435   0.01068 *  
+#> d:(Intercept)  52.0478     3.2487 16.0212 2.123e-10 ***
+#> e:(Intercept) 286.2600   209.6374  1.3655   0.19364    
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  9.241941 (14 degrees of freedom)
+
+## Plotting the fitted curve
+plot(barley.m1, xlab = "Dose", ylab = "Weight")
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/barley.md b/docs/reference/barley.md new file mode 100644 index 00000000..4ed874f5 --- /dev/null +++ b/docs/reference/barley.md @@ -0,0 +1,61 @@ +# Barley + +Data from a dose-response experiment measuring the weight of barley +(*Hordeum vulgare*) at different dose levels of a substance. + +## Usage + +``` r +data(barley) +``` + +## Format + +A data frame with 18 observations of the following 2 variables. + +- `Dose`: + + a numeric vector + +- `weight`: + + a numeric vector + +## Examples + +``` r +library(drc) + +## Displaying the data +head(barley) +#> Dose weight +#> 1 0.00000 57.2 +#> 2 0.00000 49.8 +#> 3 21.09375 62.2 +#> 4 21.09375 30.6 +#> 5 42.18750 40.9 +#> 6 42.18750 70.9 + +## Fitting a four-parameter log-logistic model +barley.m1 <- drm(weight ~ Dose, data = barley, fct = LL.4()) +summary(barley.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 9.7084 42.9166 0.2262 0.82430 +#> c:(Intercept) 11.1275 3.7803 2.9435 0.01068 * +#> d:(Intercept) 52.0478 3.2487 16.0212 2.123e-10 *** +#> e:(Intercept) 286.2600 209.6374 1.3655 0.19364 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 9.241941 (14 degrees of freedom) + +## Plotting the fitted curve +plot(barley.m1, xlab = "Dose", ylab = "Weight") +``` diff --git a/docs/reference/baro5.html b/docs/reference/baro5.html index 1c190bfe..f877e1ad 100644 --- a/docs/reference/baro5.html +++ b/docs/reference/baro5.html @@ -1,187 +1,127 @@ - - - - - - +The Baroreflex Five-Parameter Dose-Response Model — baro5 • drc + Skip to contents -The modified baro5 function — baro5 • drc - - - +
    +
    +
    +

    The Baroreflex Five-Parameter Dose-Response Model

    + Source: R/baro5.R +
    baro5.Rd
    +
    - +
    +

    baro5 provides the five-parameter baroreflex model function, allowing +specification under various parameter constraints. The model accommodates +asymmetric dose-response curves.

    +
    - - +
    +

    Usage

    + 
    baro5(
+  fixed = c(NA, NA, NA, NA, NA),
+  names = c("b1", "b2", "c", "d", "e"),
+  method = c("1", "2", "3", "4"),
+  ssfct = NULL
+)
    +
    +
    +

    Arguments

    - - +
    fixed
    +

    numeric vector. Specifies which parameters are fixed and at what value +they are fixed. NAs for parameters that are not fixed.

    - +
    names
    +

    a vector of character strings giving the names of the parameters +(should not contain ":"). The order is: b1, b2, c, d, e.

    - - -
    -
    - - - -
    -
    -
    -
    -

    The modified baro5 function

    - - -
    +
    ssfct
    +

    a self starter function to be used.

    -
    - -

    'baro5' allows specification of the baroreflex 5-parameter dose response function, - under various constraints on the parameters.

    - +
    +
    +

    Value

    +

    A list containing the nonlinear model function, the self starter function, +and the parameter names.

    +
    +
    +

    Details

    +

    The five-parameter function is given by:

    +

    $$y = c + \frac{d-c}{1+f\exp(b1(\log(x)-\log(e))) + (1-f)\exp(b2(\log(x)-\log(e)))}$$

    +

    $$f = 1/(1 + \exp((2b1 b2/|b1+b2|)(\log(x)-\log(e))))$$

    +

    If the difference between b1 and b2 is nonzero, the function is asymmetric.

    +
    +
    +

    References

    +

    Ricketts, J. H. and Head, G. A. (1999) +A five-parameter logistic equation for investigating asymmetry of curvature +in baroreflex studies. +Am. J. Physiol. (Regulatory Integrative Comp. Physiol. 46), 277, 441–454.

    +
    +
    +

    Author

    +

    Christian Ritz

    - 
    baro5(fixed = c(NA, NA, NA, NA, NA), names = c("b1", "b2", "c", "d", "e"),
-  method = c("1", "2", "3", "4"), ssfct = NULL)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - -
    fixed

    numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.

    names

    a vector of character strings giving the names of the parameters (should not contain ":"). - The order of the parameters is: b1, b2, c, d, e (see under 'Details').

    method

    character string indicating the self starter function to use.

    ssfct

    a self starter function to be used.

    - -

    Details

    - -

    The five-parameter function given by the expression

    -

    $$ y = c + \frac{d-c}{1+f\exp(b1(\log(x)-\log(e))) + (1-f)\exp(b2(\log(x)-\log(e)))}$$

    -

    $$ f = 1/( 1 + \exp((2b1b2/|b1+b2|)(\log(x)-\log(e))))$$

    -

    If the difference between the parameters b1 and b2 is different from 0 then the function is asymmetric.

    - -

    Value

    - -

    The value returned is a list containing the nonlinear model function, the self starter function - and the parameter names.

    - -

    References

    - -

    Ricketts, J. H. and Head, G. A. (1999) - A five-parameter logistic equation for investigating asymmetry of curvature in baroreflex studies. - Am. J. Physiol. (Regulatory Integrative Comp. Physiol. 46), 277, 441--454.

    - - -
    - -
  • References
    • - -

    Author

    - Christian Ritz -
    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + -
    - - - - + diff --git a/docs/reference/baro5.md b/docs/reference/baro5.md new file mode 100644 index 00000000..8fa4d271 --- /dev/null +++ b/docs/reference/baro5.md @@ -0,0 +1,64 @@ +# The Baroreflex Five-Parameter Dose-Response Model + +`baro5` provides the five-parameter baroreflex model function, allowing +specification under various parameter constraints. The model +accommodates asymmetric dose-response curves. + +## Usage + +``` r +baro5( + fixed = c(NA, NA, NA, NA, NA), + names = c("b1", "b2", "c", "d", "e"), + method = c("1", "2", "3", "4"), + ssfct = NULL +) +``` + +## Arguments + +- fixed: + + numeric vector. Specifies which parameters are fixed and at what value + they are fixed. NAs for parameters that are not fixed. + +- names: + + a vector of character strings giving the names of the parameters + (should not contain ":"). The order is: b1, b2, c, d, e. + +- method: + + character string indicating the self starter function to use. + +- ssfct: + + a self starter function to be used. + +## Value + +A list containing the nonlinear model function, the self starter +function, and the parameter names. + +## Details + +The five-parameter function is given by: + +\$\$y = c + \frac{d-c}{1+f\exp(b1(\log(x)-\log(e))) + +(1-f)\exp(b2(\log(x)-\log(e)))}\$\$ + +\$\$f = 1/(1 + \exp((2b1 b2/\|b1+b2\|)(\log(x)-\log(e))))\$\$ + +If the difference between b1 and b2 is nonzero, the function is +asymmetric. + +## References + +Ricketts, J. H. and Head, G. A. (1999) A five-parameter logistic +equation for investigating asymmetry of curvature in baroreflex studies. +*Am. J. Physiol. (Regulatory Integrative Comp. Physiol. 46)*, **277**, +441–454. + +## Author + +Christian Ritz diff --git a/docs/reference/bcl3.html b/docs/reference/bcl3.html new file mode 100644 index 00000000..97f6eefe --- /dev/null +++ b/docs/reference/bcl3.html @@ -0,0 +1,91 @@ + +Alias for BC.4 — bcl3 • drc + Skip to contents + + +
    +
    +
    +

    Alias for BC.4

    + Source: R/braincousens.R +
    bcl3.Rd
    +
    + +
    +

    bcl3 is an alias for BC.4.

    +
    + +
    +

    Usage

    + 
    bcl3(fixed = c(NA, NA, NA, NA), names = c("b", "d", "e", "f"), ...)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector of length 4 specifying fixed parameters (NAs for free parameters).

    + + +
    names
    +

    a vector of character strings giving the names of the parameters.

    + + +
    ...
    +

    additional arguments passed to braincousens.

    + +
    +
    +

    See also

    +

    BC.4

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/bcl3.md b/docs/reference/bcl3.md new file mode 100644 index 00000000..f6e10580 --- /dev/null +++ b/docs/reference/bcl3.md @@ -0,0 +1,30 @@ +# Alias for BC.4 + +`bcl3` is an alias for +[`BC.4`](https://hreinwald.github.io/drc/reference/BC.4.md). + +## Usage + +``` r +bcl3(fixed = c(NA, NA, NA, NA), names = c("b", "d", "e", "f"), ...) +``` + +## Arguments + +- fixed: + + numeric vector of length 4 specifying fixed parameters (NAs for free + parameters). + +- names: + + a vector of character strings giving the names of the parameters. + +- ...: + + additional arguments passed to + [`braincousens`](https://hreinwald.github.io/drc/reference/braincousens.md). + +## See also + +[`BC.4`](https://hreinwald.github.io/drc/reference/BC.4.md) diff --git a/docs/reference/bcl4.html b/docs/reference/bcl4.html new file mode 100644 index 00000000..55b5fa74 --- /dev/null +++ b/docs/reference/bcl4.html @@ -0,0 +1,91 @@ + +Alias for BC.5 — bcl4 • drc + Skip to contents + + +
    +
    +
    +

    Alias for BC.5

    + Source: R/braincousens.R +
    bcl4.Rd
    +
    + +
    +

    bcl4 is an alias for BC.5.

    +
    + +
    +

    Usage

    + 
    bcl4(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector of length 5 specifying fixed parameters (NAs for free parameters).

    + + +
    names
    +

    a vector of character strings giving the names of the parameters.

    + + +
    ...
    +

    additional arguments passed to braincousens.

    + +
    +
    +

    See also

    +

    BC.5

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/bcl4.md b/docs/reference/bcl4.md new file mode 100644 index 00000000..fa8e5298 --- /dev/null +++ b/docs/reference/bcl4.md @@ -0,0 +1,30 @@ +# Alias for BC.5 + +`bcl4` is an alias for +[`BC.5`](https://hreinwald.github.io/drc/reference/BC.5.md). + +## Usage + +``` r +bcl4(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...) +``` + +## Arguments + +- fixed: + + numeric vector of length 5 specifying fixed parameters (NAs for free + parameters). + +- names: + + a vector of character strings giving the names of the parameters. + +- ...: + + additional arguments passed to + [`braincousens`](https://hreinwald.github.io/drc/reference/braincousens.md). + +## See also + +[`BC.5`](https://hreinwald.github.io/drc/reference/BC.5.md) diff --git a/docs/reference/bees.html b/docs/reference/bees.html new file mode 100644 index 00000000..968f37c9 --- /dev/null +++ b/docs/reference/bees.html @@ -0,0 +1,143 @@ + +bees — bees • drc + Skip to contents + + +
    +
    +
    +

    bees

    + +
    bees.Rd
    +
    + +
    +

    Data are from a binary mixture experiment that involves multiple single-dose factorial designs where the insecticide imidacloprid is combined with each of 7 pesticides in turn.

    +
    + +
    +

    Usage

    + 
    data(bees)
    +
    + +
    +

    Format

    +

    A data frame with 66 observations on the following 5 variables.

    mixture
    +

    Indicator of single-dose experiment (or control)

    + +
    treat
    +

    Treatment or combination of treatments

    + +
    rep
    +

    Replication number (there were 3 replicates per group)

    + +
    dead0h
    +

    Number of dead bees initially

    + +
    dead48h
    +

    Number of dead bees after 48 hours

    + + +
    +
    +

    Details

    +

    Imidacloprid is a widely used insecticide. In a recent study potential synergistic effects on mortality of honey bees exposed to the insectide in binary mixtures with seven pesticides from different classes: acephate, λ-cyhalothrin, oxamyl, tetraconazole, sulfoxaflor, glyphosate, and clothianidin were investigated. Bees were reared in cages (25 insects per cage), with three cages per treatment group, and exposed to the mixture treatments for 48h. Mortality after 48h was the response.

    +
    +
    +

    Source

    +

    Data were retrieved from PLoS ONE repository.

    +
    +
    +

    References

    +

    Zhu YC, Yao J, Adamczyk J and Luttrell R, Synergistic toxicity and physiological impact of imidacloprid alone and binary mixtures with seven representative pesticides on honey bee (Apis mellifera). PLoS ONE 12: e0176837 (2017). https://doi.org/10.1371/journal.pone.0176837

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Displaying the data
+head(bees)
+#>   mixture    treat rep dead0h dead48h
+#> 1    CK-1      H2O   1      0       0
+#> 2    CK-2      H2O   2      2       2
+#> 3    CK-3      H2O   3      5       5
+#> 4  AdvBra Advi274B   1      2       5
+#> 5  AdvBra Advi274B   2      0       6
+#> 6  AdvBra Advi274B   3      0       3
+
+## Summarizing mortality by treatment
+aggregate(dead48h ~ treat, data = bees, FUN = mean)
+#>        treat   dead48h
+#> 1   Adv274BL  4.666667
+#> 2   Advi274B  4.666667
+#> 3   Advi274D  4.666667
+#> 4   Advi274K  4.666667
+#> 5   Advi274R  4.666667
+#> 6   Advi274T  4.666667
+#> 7   Advi274V  4.666667
+#> 8   AdviBela  8.000000
+#> 9  AdviBrack 15.000000
+#> 10  AdviDoma 10.666667
+#> 11  AdviKara  5.666667
+#> 12  AdviRoun  4.666667
+#> 13  AdviTran  9.333333
+#> 14  AdviVyda 15.000000
+#> 15   Belay40  4.333333
+#> 16   Brack91  9.333333
+#> 17  Doma2500  2.666667
+#> 18       H2O  2.333333
+#> 19  Karat273  1.000000
+#> 20  Roun2500  0.000000
+#> 21  Trans117  2.000000
+#> 22  Vydat162  6.666667
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/bees.md b/docs/reference/bees.md new file mode 100644 index 00000000..91530228 --- /dev/null +++ b/docs/reference/bees.md @@ -0,0 +1,98 @@ +# bees + +Data are from a binary mixture experiment that involves multiple +single-dose factorial designs where the insecticide imidacloprid is +combined with each of 7 pesticides in turn. + +## Usage + +``` r +data(bees) +``` + +## Format + +A data frame with 66 observations on the following 5 variables. + +- `mixture`: + + Indicator of single-dose experiment (or control) + +- `treat`: + + Treatment or combination of treatments + +- `rep`: + + Replication number (there were 3 replicates per group) + +- `dead0h`: + + Number of dead bees initially + +- `dead48h`: + + Number of dead bees after 48 hours + +## Details + +Imidacloprid is a widely used insecticide. In a recent study potential +synergistic effects on mortality of honey bees exposed to the insectide +in binary mixtures with seven pesticides from different classes: +acephate, λ-cyhalothrin, oxamyl, tetraconazole, sulfoxaflor, glyphosate, +and clothianidin were investigated. Bees were reared in cages (25 +insects per cage), with three cages per treatment group, and exposed to +the mixture treatments for 48h. Mortality after 48h was the response. + +## Source + +Data were retrieved from PLoS ONE repository. + +## References + +Zhu YC, Yao J, Adamczyk J and Luttrell R, Synergistic toxicity and +physiological impact of imidacloprid alone and binary mixtures with +seven representative pesticides on honey bee (Apis mellifera). PLoS ONE +12: e0176837 (2017). https://doi.org/10.1371/journal.pone.0176837 + +## Examples + +``` r +library(drc) + +## Displaying the data +head(bees) +#> mixture treat rep dead0h dead48h +#> 1 CK-1 H2O 1 0 0 +#> 2 CK-2 H2O 2 2 2 +#> 3 CK-3 H2O 3 5 5 +#> 4 AdvBra Advi274B 1 2 5 +#> 5 AdvBra Advi274B 2 0 6 +#> 6 AdvBra Advi274B 3 0 3 + +## Summarizing mortality by treatment +aggregate(dead48h ~ treat, data = bees, FUN = mean) +#> treat dead48h +#> 1 Adv274BL 4.666667 +#> 2 Advi274B 4.666667 +#> 3 Advi274D 4.666667 +#> 4 Advi274K 4.666667 +#> 5 Advi274R 4.666667 +#> 6 Advi274T 4.666667 +#> 7 Advi274V 4.666667 +#> 8 AdviBela 8.000000 +#> 9 AdviBrack 15.000000 +#> 10 AdviDoma 10.666667 +#> 11 AdviKara 5.666667 +#> 12 AdviRoun 4.666667 +#> 13 AdviTran 9.333333 +#> 14 AdviVyda 15.000000 +#> 15 Belay40 4.333333 +#> 16 Brack91 9.333333 +#> 17 Doma2500 2.666667 +#> 18 H2O 2.333333 +#> 19 Karat273 1.000000 +#> 20 Roun2500 0.000000 +#> 21 Trans117 2.000000 +#> 22 Vydat162 6.666667 +``` diff --git a/docs/reference/blackgrass.html b/docs/reference/blackgrass.html new file mode 100644 index 00000000..8b683867 --- /dev/null +++ b/docs/reference/blackgrass.html @@ -0,0 +1,139 @@ + +Seedling Emergence of Blackgrass (Alopecurus myosuroides) — blackgrass • drc + Skip to contents + + +
    +
    +
    +

    Seedling Emergence of Blackgrass (Alopecurus myosuroides)

    + +
    blackgrass.Rd
    +
    + +
    +

    Seedling emergence of herbicide susceptible (S) and resistant (R) Alopecurus myosuroides in reponse to sowing depth and suboptimal temperature regimes (10/5C) and optimal temperature regimes (17/10C).

    +
    + +
    +

    Usage

    + 
    data("blackgrass")
    +
    + +
    +

    Format

    +

    A data frame with 2752 observations on the following 12 variables.

    Exp
    +

    a numeric vector

    + +
    Temp
    +

    a numeric vector

    + +
    Popu
    +

    a numeric vector

    + +
    Bio
    +

    a factor with two levels

    + +
    Depth
    +

    a numeric vector

    + +
    Rep
    +

    a numeric vector

    + +
    Start.Day
    +

    a numeric vector

    + +
    End.Day
    +

    a numeric vector

    + +
    Ger
    +

    a numeric vector

    + +
    Accum.Ger
    +

    a numeric vector

    + +
    TotalSeed
    +

    a numeric vector

    + +
    Pot
    +

    a numeric vector

    + + +
    +
    +

    References

    +

    Keshtkar, E., Mathiassen, S. K., Beffa, R., Kudsk, P. (2017). Seed Germination and Seedling Emergence of Blackgrass (Alopecurus myosuroides) as Affected by Non-Target-Site Herbicide Resistance. Weed Science, 65, 732-742. https://doi.org/10.1017/wsc.2017.44 +

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Displaying the data
+head(blackgrass)
+#>   Exp Temp Popu Bio Depth Rep Start.Day End.Day Ger Accum.Ger TotalSeed Pot
+#> 1   1   10  914   S     0   1         0     360   0         0        36   3
+#> 2   1   10  914   S     0   1       360     376   0         0        36   3
+#> 3   1   10  914   S     0   1       376     384   0         0        36   3
+#> 4   1   10  914   S     0   1       384     400   0         0        36   3
+#> 5   1   10  914   S     0   1       400     408   0         0        36   3
+#> 6   1   10  914   S     0   1       408     424   0         0        36   3
+
+## Summarizing seedling emergence across treatments
+aggregate(Accum.Ger ~ Temp + Bio, data = blackgrass, FUN = max)
+#>   Temp Bio Accum.Ger
+#> 1   10   R        33
+#> 2   17   R        29
+#> 3   10   S        36
+#> 4   17   S        30
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/blackgrass.md b/docs/reference/blackgrass.md new file mode 100644 index 00000000..985e4aff --- /dev/null +++ b/docs/reference/blackgrass.md @@ -0,0 +1,94 @@ +# Seedling Emergence of Blackgrass (Alopecurus myosuroides) + +Seedling emergence of herbicide susceptible (S) and resistant (R) +Alopecurus myosuroides in reponse to sowing depth and suboptimal +temperature regimes (10/5C) and optimal temperature regimes (17/10C). + +## Usage + +``` r +data("blackgrass") +``` + +## Format + +A data frame with 2752 observations on the following 12 variables. + +- `Exp`: + + a numeric vector + +- `Temp`: + + a numeric vector + +- `Popu`: + + a numeric vector + +- `Bio`: + + a factor with two levels + +- `Depth`: + + a numeric vector + +- `Rep`: + + a numeric vector + +- `Start.Day`: + + a numeric vector + +- `End.Day`: + + a numeric vector + +- `Ger`: + + a numeric vector + +- `Accum.Ger`: + + a numeric vector + +- `TotalSeed`: + + a numeric vector + +- `Pot`: + + a numeric vector + +## References + +Keshtkar, E., Mathiassen, S. K., Beffa, R., Kudsk, P. (2017). Seed +Germination and Seedling Emergence of Blackgrass (Alopecurus +myosuroides) as Affected by Non-Target-Site Herbicide Resistance. Weed +Science, 65, 732-742. https://doi.org/10.1017/wsc.2017.44 + +## Examples + +``` r +library(drc) + +## Displaying the data +head(blackgrass) +#> Exp Temp Popu Bio Depth Rep Start.Day End.Day Ger Accum.Ger TotalSeed Pot +#> 1 1 10 914 S 0 1 0 360 0 0 36 3 +#> 2 1 10 914 S 0 1 360 376 0 0 36 3 +#> 3 1 10 914 S 0 1 376 384 0 0 36 3 +#> 4 1 10 914 S 0 1 384 400 0 0 36 3 +#> 5 1 10 914 S 0 1 400 408 0 0 36 3 +#> 6 1 10 914 S 0 1 408 424 0 0 36 3 + +## Summarizing seedling emergence across treatments +aggregate(Accum.Ger ~ Temp + Bio, data = blackgrass, FUN = max) +#> Temp Bio Accum.Ger +#> 1 10 R 33 +#> 2 17 R 29 +#> 3 10 S 36 +#> 4 17 S 30 +``` diff --git a/docs/reference/boxcox.drc-1.png b/docs/reference/boxcox.drc-1.png index ae2c54ca..7d8d02a9 100644 Binary files a/docs/reference/boxcox.drc-1.png and b/docs/reference/boxcox.drc-1.png differ diff --git a/docs/reference/boxcox.drc.html b/docs/reference/boxcox.drc.html index d835b569..58b4c74f 100644 --- a/docs/reference/boxcox.drc.html +++ b/docs/reference/boxcox.drc.html @@ -1,262 +1,206 @@ - - - - - - +Transform-both-sides Box-Cox transformation — boxcox.drc • drc + Skip to contents -Transform-both-sides Box-Cox transformation — boxcox.drc • drc - - - +
    +
    +
    +

    Transform-both-sides Box-Cox transformation

    + Source: R/boxcox.drc.R +
    boxcox.drc.Rd
    +
    - +
    +

    Finds the optimal Box-Cox transformation for non-linear regression.

    +
    - - +
    +

    Usage

    + 
    # S3 method for class 'drc'
+boxcox(
+  object,
+  lambda = seq(-2, 2, by = 0.25),
+  plotit = TRUE,
+  bcAdd = 0,
+  method = c("ml", "anova"),
+  level = 0.95,
+  eps = 1/50,
+  xlab = expression(lambda),
+  ylab = "log-Likelihood",
+  ...
+)
    +
    +
    +

    Arguments

    - - +
    object
    +

    object of class drc.

    - +
    lambda
    +

    numeric vector of lambda values; the default is (-2, 2) in steps of 0.25.

    - - -
    -
    - - - -
    -
    -
    -
    -

    Transform-both-sides Box-Cox transformation

    - - -
    +
    bcAdd
    +

    numeric value specifying the constant to be added on both sides prior to +Box-Cox transformation. The default is 0.

    -
    - -

    Finds the optimal Box-Cox transformation for non-linear regression.

    - -
    - 
    # S3 method for drc
-boxcox(object, lambda = seq(-2, 2, by = 0.25), plotit = TRUE, bcAdd = 0,
-method = c("ml", "anova"),  level = 0.95, eps = 1/50,
-xlab = expression(lambda), ylab = "log-Likelihood", ...)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    object

    object of class drc.

    lambda

    numeric vector of lambda values; the default is (-2, 2) in steps of 0.25.

    plotit

    logical which controls whether the result should be plotted.

    bcAdd

    numeric value specifying the constant to be added on both sides prior to Box-Cox transformation. - The default is 0.

    method

    character string specifying the estimation method for lambda: maximum likelihood or ANOVA-based - (optimal lambda inherited from more general ANOVA model fit.

    eps

    numeric value: the tolerance for lambda = 0; defaults to 0.02.

    level

    numeric value: the confidence level required.

    xlab

    character string: the label on the x axis, defaults to "lambda".

    ylab

    character string: the label on the y axis, defaults to "log-likelihood".

    …

    additional graphical parameters.

    - -

    Details

    - -

    The optimal lambda value is determined using a profile likelihood approach: - For each lambda value the dose-response regression model is fitted and the lambda value (and corresponding model fit) resulting in the largest - value of the log likelihood function is chosen.

    - -

    Value

    - -

    An object of class "drc" (returned invisibly). - If plotit = TRUE a plot of loglik vs lambda is shown indicating a confidence interval (by default 95 - the optimal lambda value.

    - -

    References

    - -

    Carroll, R. J. and Ruppert, D. (1988) Transformation and Weighting in Regression, - New York: Chapman and Hall (Chapter 4).

    - -

    See also

    - -

    For linear regression the analogue is boxcox.

    - - -

    Examples

    - 
    
-## Fitting log-logistic model without transformation
-ryegrass.m1 <- drm(ryegrass, fct = LL.4())
-summary(ryegrass.m1)
    #> 
-#> Model fitted: Log-logistic (ED50 as parameter) (4 parms)
-#> 
-#> Parameter estimates:
-#> 
-#>               Estimate Std. Error t-value   p-value    
-#> b:(Intercept)  2.98222    0.46506  6.4125 2.960e-06 ***
-#> c:(Intercept)  0.48141    0.21219  2.2688   0.03451 *  
-#> d:(Intercept)  7.79296    0.18857 41.3272 < 2.2e-16 ***
-#> e:(Intercept)  3.05795    0.18573 16.4644 4.268e-13 ***
-#> ---
-#> Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
-#> 
-#> Residual standard error:
-#> 
-#>  0.5196256 (20 degrees of freedom)
    
-## Fitting the same model with the optimal Box-Cox transformation
-ryegrass.m2 <- boxcox(ryegrass.m1)
    #> Warning: NaNs produced
    #> Warning: NaNs produced
    #> Warning: NaNs produced
    #> Warning: NaNs produced
    summary(ryegrass.m2)
    #> 
-#> Model fitted: Log-logistic (ED50 as parameter) (4 parms)
-#> 
-#> Parameter estimates:
-#> 
-#>               Estimate Std. Error t-value   p-value    
-#> b:(Intercept)  2.61839    0.39151  6.6880 1.649e-06 ***
-#> c:(Intercept)  0.39083    0.10429  3.7474  0.001269 ** 
-#> d:(Intercept)  7.86633    0.29558 26.6136 < 2.2e-16 ***
-#> e:(Intercept)  3.01662    0.21005 14.3612 5.354e-12 ***
-#> ---
-#> Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
-#> 
-#> Residual standard error:
-#> 
-#>  0.2962958 (20 degrees of freedom)
-#> 
-#> Non-normality/heterogeneity adjustment through Box-Cox transformation
-#> 
-#> Estimated lambda: 0.5 
-#> Confidence interval for lambda: [0.269,0.949] 
-#> 
    
-
    -
    - -
    +
    eps
    +

    numeric value: the tolerance for lambda = 0; defaults to 0.02.

    + + +
    xlab
    +

    character string: the label on the x axis, defaults to "lambda".

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    + +
    ylab
    +

    character string: the label on the y axis, defaults to "log-likelihood".

    + + +
    ...
    +

    additional graphical parameters.

    + +
    +
    +

    Value

    +

    An object of class "drc" (returned invisibly). If plotit = TRUE a plot of +loglik vs lambda is shown indicating a confidence interval (by default 95%) about +the optimal lambda value.

    +
    +
    +

    Details

    +

    The optimal lambda value is determined using a profile likelihood approach: +For each lambda value the dose-response regression model is fitted and the lambda value +(and corresponding model fit) resulting in the largest value of the log likelihood function +is chosen.

    +
    +
    +

    References

    +

    Carroll, R. J. and Ruppert, D. (1988) Transformation and Weighting in Regression, +New York: Chapman and Hall (Chapter 4).

    +
    +
    +

    See also

    +

    For linear regression the analogue is boxcox.

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    + +
    +

    Examples

    + 
    ## Fitting log-logistic model without transformation
+ryegrass.m1 <- drm(ryegrass, fct = LL.4())
+summary(ryegrass.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept)  2.98222    0.46506  6.4125 2.960e-06 ***
+#> c:(Intercept)  0.48141    0.21219  2.2688   0.03451 *  
+#> d:(Intercept)  7.79296    0.18857 41.3272 < 2.2e-16 ***
+#> e:(Intercept)  3.05795    0.18573 16.4644 4.268e-13 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.5196256 (20 degrees of freedom)
+
+## Fitting the same model with the optimal Box-Cox transformation
+ryegrass.m2 <- boxcox(ryegrass.m1)
+
+summary(ryegrass.m2)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept)  2.61839    0.39151  6.6880 1.649e-06 ***
+#> c:(Intercept)  0.39083    0.10429  3.7474  0.001269 ** 
+#> d:(Intercept)  7.86633    0.29558 26.6136 < 2.2e-16 ***
+#> e:(Intercept)  3.01662    0.21005 14.3612 5.354e-12 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.2962958 (20 degrees of freedom)
+#> 
+#> Non-normality/heterogeneity adjustment through Box-Cox transformation
+#> 
+#> Estimated lambda: 0.5 
+#> Confidence interval for lambda: [0.269,0.949] 
+#> 
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -

    Site built with pkgdown.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -
    + + + + - - - + diff --git a/docs/reference/boxcox.drc.md b/docs/reference/boxcox.drc.md new file mode 100644 index 00000000..a56ad77f --- /dev/null +++ b/docs/reference/boxcox.drc.md @@ -0,0 +1,146 @@ +# Transform-both-sides Box-Cox transformation + +Finds the optimal Box-Cox transformation for non-linear regression. + +## Usage + +``` r +# S3 method for class 'drc' +boxcox( + object, + lambda = seq(-2, 2, by = 0.25), + plotit = TRUE, + bcAdd = 0, + method = c("ml", "anova"), + level = 0.95, + eps = 1/50, + xlab = expression(lambda), + ylab = "log-Likelihood", + ... +) +``` + +## Arguments + +- object: + + object of class `drc`. + +- lambda: + + numeric vector of lambda values; the default is (-2, 2) in steps of + 0.25. + +- plotit: + + logical which controls whether the result should be plotted. + +- bcAdd: + + numeric value specifying the constant to be added on both sides prior + to Box-Cox transformation. The default is 0. + +- method: + + character string specifying the estimation method for lambda: maximum + likelihood or ANOVA-based (optimal lambda inherited from more general + ANOVA model fit). + +- level: + + numeric value: the confidence level required. + +- eps: + + numeric value: the tolerance for lambda = 0; defaults to 0.02. + +- xlab: + + character string: the label on the x axis, defaults to "lambda". + +- ylab: + + character string: the label on the y axis, defaults to + "log-likelihood". + +- ...: + + additional graphical parameters. + +## Value + +An object of class "drc" (returned invisibly). If plotit = TRUE a plot +of loglik vs lambda is shown indicating a confidence interval (by +default 95%) about the optimal lambda value. + +## Details + +The optimal lambda value is determined using a profile likelihood +approach: For each lambda value the dose-response regression model is +fitted and the lambda value (and corresponding model fit) resulting in +the largest value of the log likelihood function is chosen. + +## References + +Carroll, R. J. and Ruppert, D. (1988) *Transformation and Weighting in +Regression*, New York: Chapman and Hall (Chapter 4). + +## See also + +For linear regression the analogue is +[`boxcox`](https://rdrr.io/pkg/MASS/man/boxcox.html). + +## Author + +Christian Ritz + +## Examples + +``` r +## Fitting log-logistic model without transformation +ryegrass.m1 <- drm(ryegrass, fct = LL.4()) +summary(ryegrass.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 2.98222 0.46506 6.4125 2.960e-06 *** +#> c:(Intercept) 0.48141 0.21219 2.2688 0.03451 * +#> d:(Intercept) 7.79296 0.18857 41.3272 < 2.2e-16 *** +#> e:(Intercept) 3.05795 0.18573 16.4644 4.268e-13 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.5196256 (20 degrees of freedom) + +## Fitting the same model with the optimal Box-Cox transformation +ryegrass.m2 <- boxcox(ryegrass.m1) + +summary(ryegrass.m2) +#> +#> Model fitted: Log-logistic (ED50 as parameter) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 2.61839 0.39151 6.6880 1.649e-06 *** +#> c:(Intercept) 0.39083 0.10429 3.7474 0.001269 ** +#> d:(Intercept) 7.86633 0.29558 26.6136 < 2.2e-16 *** +#> e:(Intercept) 3.01662 0.21005 14.3612 5.354e-12 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.2962958 (20 degrees of freedom) +#> +#> Non-normality/heterogeneity adjustment through Box-Cox transformation +#> +#> Estimated lambda: 0.5 +#> Confidence interval for lambda: [0.269,0.949] +#> +``` diff --git a/docs/reference/braincousens.html b/docs/reference/braincousens.html index 54484f1b..55c74caa 100644 --- a/docs/reference/braincousens.html +++ b/docs/reference/braincousens.html @@ -1,206 +1,136 @@ - - - - - - +The Brain-Cousens hormesis models — braincousens • drc + Skip to contents -The Brain-Cousens hormesis models — braincousens • drc - - - +
    +
    +
    +

    The Brain-Cousens hormesis models

    + Source: R/braincousens.R +
    braincousens.Rd
    +
    - +
    +

    braincousens provides a very general way of specifying Brain-Cousens' +modified log-logistic model for describing hormesis, under various constraints on the parameters.

    +
    - - +
    +

    Usage

    + 
    braincousens(
+  fixed = c(NA, NA, NA, NA, NA),
+  names = c("b", "c", "d", "e", "f"),
+  method = c("1", "2", "3", "4"),
+  ssfct = NULL,
+  fctName,
+  fctText
+)
    +
    +
    +

    Arguments

    - - +
    fixed
    +

    numeric vector. Specifies which parameters are fixed and at what value they are fixed. +NAs for parameters that are not fixed.

    - +
    names
    +

    a vector of character strings giving the names of the parameters (should not contain ":"). +The order of the parameters is: b, c, d, e, f.

    - - -
    -
    - - - -
    -
    -
    -
    -

    The Brain-Cousens hormesis models

    - - -
    +
    ssfct
    +

    a self starter function to be used.

    -
    - -

    'braincousens' provides a very general way of specifying Brain-Cousens' - modified log- logistic model for describing hormesis, under various constraints on the parameters.

    - -
    - 
    braincousens(fixed = c(NA, NA, NA, NA, NA),
-  names = c("b", "c", "d", "e", "f"),
-  method = c("1", "2", "3", "4"), ssfct = NULL,
-  fctName, fctText)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - - - - - - - - - -
    fixed

    numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.

    names

    a vector of character strings giving the names of the parameters (should not contain ":"). - The default is reasonable (see under 'Usage'). The order of the parameters is: b, c, d, e, f (see under 'Details').

    method

    character string indicating the self starter function to use.

    ssfct

    a self starter function to be used.

    fctName

    optional character string used internally by convenience functions.

    fctText

    optional character string used internally by convenience functions.

    - -

    Details

    +
    fctName
    +

    optional character string used internally by convenience functions.

    -

    The Brain-Cousens model is given by the expression - $$ f(x) = c + \frac{d-c+fx}{1+\exp(b(\log(x)-\log(e)))}$$ - which is a five-parameter model.

    -

    It is a modification of the four-parameter logistic curve to take hormesis into account proposed - by Brain and Cousens (1989).

    - -

    Value

    - -

    The value returned is a list containing the non-linear function, the self starter function, - the parameter names and additional model specific objects.

    - -

    References

    - -

    Brain, P. and Cousens, R. (1989) An equation to describe dose responses - where there is stimulation of growth at low doses, - Weed Research, 29, 93--96.

    - -

    Note

    - -

    This function is for use with the function drm.

    -

    The convenience functions of braincousens are BC.4 and BC.5. These functions - should be used rather than braincousens directly.

    - -
    -
    +
    +

    Value

    +

    A list containing the non-linear function, the self starter function, +the parameter names and additional model specific objects.

    +
    +
    +

    Details

    +

    The Brain-Cousens model is given by the expression +$$f(x) = c + \frac{d-c+fx}{1+\exp(b(\log(x)-\log(e)))}$$ +which is a five-parameter model.

    +
    +
    +

    References

    +

    Brain, P. and Cousens, R. (1989) An equation to describe dose responses +where there is stimulation of growth at low doses, +Weed Research, 29, 93–96.

    +
    +
    +

    See also

    +

    BC.4, BC.5, drm

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    -
  • References
    • +
    -
  • Note
    • - -

    Author

    - Christian Ritz -
    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + -
    - - - - + diff --git a/docs/reference/braincousens.md b/docs/reference/braincousens.md new file mode 100644 index 00000000..ca1330cb --- /dev/null +++ b/docs/reference/braincousens.md @@ -0,0 +1,74 @@ +# The Brain-Cousens hormesis models + +`braincousens` provides a very general way of specifying Brain-Cousens' +modified log-logistic model for describing hormesis, under various +constraints on the parameters. + +## Usage + +``` r +braincousens( + fixed = c(NA, NA, NA, NA, NA), + names = c("b", "c", "d", "e", "f"), + method = c("1", "2", "3", "4"), + ssfct = NULL, + fctName, + fctText +) +``` + +## Arguments + +- fixed: + + numeric vector. Specifies which parameters are fixed and at what value + they are fixed. NAs for parameters that are not fixed. + +- names: + + a vector of character strings giving the names of the parameters + (should not contain ":"). The order of the parameters is: b, c, d, e, + f. + +- method: + + character string indicating the self starter function to use. + +- ssfct: + + a self starter function to be used. + +- fctName: + + optional character string used internally by convenience functions. + +- fctText: + + optional character string used internally by convenience functions. + +## Value + +A list containing the non-linear function, the self starter function, +the parameter names and additional model specific objects. + +## Details + +The Brain-Cousens model is given by the expression \$\$f(x) = c + +\frac{d-c+fx}{1+\exp(b(\log(x)-\log(e)))}\$\$ which is a five-parameter +model. + +## References + +Brain, P. and Cousens, R. (1989) An equation to describe dose responses +where there is stimulation of growth at low doses, *Weed Research*, +**29**, 93–96. + +## See also + +[`BC.4`](https://hreinwald.github.io/drc/reference/BC.4.md), +[`BC.5`](https://hreinwald.github.io/drc/reference/BC.5.md), +[`drm`](https://hreinwald.github.io/drc/reference/drm.md) + +## Author + +Christian Ritz diff --git a/docs/reference/braincousens.ssf.html b/docs/reference/braincousens.ssf.html new file mode 100644 index 00000000..713ca303 --- /dev/null +++ b/docs/reference/braincousens.ssf.html @@ -0,0 +1,70 @@ + +Self-starter for Brain-Cousens model — braincousens.ssf • drc + Skip to contents + + +
    +
    +
    +

    Self-starter for Brain-Cousens model

    + Source: R/braincousens.ssf.R +
    braincousens.ssf.Rd
    +
    + +
    +

    Self-starter for Brain-Cousens model

    +
    + +
    +

    Usage

    + 
    braincousens.ssf(method = c("1", "2", "3", "4"), fixed, useFixed = FALSE)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/braincousens.ssf.md b/docs/reference/braincousens.ssf.md new file mode 100644 index 00000000..84569f3b --- /dev/null +++ b/docs/reference/braincousens.ssf.md @@ -0,0 +1,9 @@ +# Self-starter for Brain-Cousens model + +Self-starter for Brain-Cousens model + +## Usage + +``` r +braincousens.ssf(method = c("1", "2", "3", "4"), fixed, useFixed = FALSE) +``` diff --git a/docs/reference/bread.drc.html b/docs/reference/bread.drc.html index 89982fd7..5d8ca496 100644 --- a/docs/reference/bread.drc.html +++ b/docs/reference/bread.drc.html @@ -1,193 +1,104 @@ - - - - - - +Bread for the sandwich estimator — bread.drc • drc + Skip to contents -Bread and meat for the sandwich — bread.drc • drc - - - +
    +
    +
    +

    Bread for the sandwich estimator

    + Source: R/sandwich.R +
    bread.drc.Rd
    - -
    -
    - - - - -
    -
    -
    -

    Bread and meat for the sandwich

    - - +
    +

    Computes the "bread" (unscaled hessian) for the sandwich estimator of the +variance-covariance matrix for objects of class 'drc'.

    -
    - -

    Bread and meat for the sandwich estimator of the variance-covariance.

    - +
    +

    Usage

    + 
    # S3 method for class 'drc'
+bread(x, ...)
    - 
    bread.drc(x, ...)
-
-  estfun.drc(x, ...)
    - -

    Arguments

    - - - - - - - - - - -
    x

    object of class drc

    …

    additional arguments. At the moment none are supported

    - -

    Details

    +
    +

    Arguments

    -

    The details are provided by Zeileis (2006).

    - -

    Value

    -

    The unscaled hessian is returned by bread.drc, whereas estfun.drc - returns the estimating function evaluated at the data and the parameter estimates.

    -

    By default no clustering is assumed, corresponding to robust standard errors under independence. - If a cluster variable is provided the log likelihood contributions provided by estfun - are summed up for each cluster.

    - -

    References

    +
    x
    +

    object of class drc.

    -

    Zeileis, A. (2006) Object-oriented Computation of Sandwich Estimators, - J. Statist. Software, 16, Issue 9.

    - -

    Examples

    - 
    
-## The lines below requires that the packages
-## 'lmtest' and 'sandwich' are installed
-# library(lmtest)
-# library(sandwich)
+
    ...
    
+
    additional arguments. At the moment none are supported.
    
 
-# ryegrass.m1<-drm(rootl ~ conc, data = ryegrass, fct = LL.4())
+
    +
    +

    Value

    +

    The unscaled hessian matrix.

    +
    +
    +

    Details

    +

    The details are provided by Zeileis (2006).

    +
    +
    +

    References

    +

    Zeileis, A. (2006) Object-oriented Computation of Sandwich Estimators, +J. Statist. Software, 16, Issue 9.

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    -# Standard summary output -# coeftest(ryegrass.m1) +
    -# Output with robust standard errors -# coeftest(ryegrass.m1, vcov = sandwich) -
    -
    - +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + - - - - - + diff --git a/docs/reference/bread.drc.md b/docs/reference/bread.drc.md new file mode 100644 index 00000000..0c4820d1 --- /dev/null +++ b/docs/reference/bread.drc.md @@ -0,0 +1,38 @@ +# Bread for the sandwich estimator + +Computes the "bread" (unscaled hessian) for the sandwich estimator of +the variance-covariance matrix for objects of class 'drc'. + +## Usage + +``` r +# S3 method for class 'drc' +bread(x, ...) +``` + +## Arguments + +- x: + + object of class `drc`. + +- ...: + + additional arguments. At the moment none are supported. + +## Value + +The unscaled hessian matrix. + +## Details + +The details are provided by Zeileis (2006). + +## References + +Zeileis, A. (2006) Object-oriented Computation of Sandwich Estimators, +*J. Statist. Software*, **16**, Issue 9. + +## Author + +Christian Ritz diff --git a/docs/reference/broccoli-1.png b/docs/reference/broccoli-1.png new file mode 100644 index 00000000..69042662 Binary files /dev/null and b/docs/reference/broccoli-1.png differ diff --git a/docs/reference/broccoli.html b/docs/reference/broccoli.html new file mode 100644 index 00000000..287b6e1d --- /dev/null +++ b/docs/reference/broccoli.html @@ -0,0 +1,138 @@ + +The Effects of Drought Stress on Leaf Development in a Brassica oleracea population — broccoli • drc + Skip to contents + + +
    +
    +
    +

    The Effects of Drought Stress on Leaf Development in a Brassica oleracea population

    + +
    broccoli.Rd
    +
    + +
    +

    The effect of drought stress on Brassica oleracea should be investigated, selecting drought stress resistant out of a population of different DH genotypes. The study was carried out on 48 DH lines developed from F1 plants of a cross between the rapid cycling chinese kale (Brassica oleracea var. alboglabra (L.H. Bailey) Musil) and broccoli (Brassica oleracea var. italica Plenck). 2 stress treatments (not watered and a watered control) are randomly assigned to 4 plants per genotype (2 per treatment) resulting in 192 plants in total. For the genotypes 5, 17, 31, 48, additional 12 plants (6 per treatment) are included into the completely randomized design, which results in a total of 240 plants. For each plant the length of the youngest leaf at the beginning of the experiment is measured daily for a period of 16 days. For the additional 12 plants of the 4 genotypes the leaf water potential was measured as a secondary endpoint (omitted here); due to these destructive measurements some dropouts occur.

    +
    + +
    +

    Usage

    + 
    data(broccoli)
    +
    + +
    +

    Format

    +

    A data frame with 3689 observations on the following 5 variables.

    LeafLength
    +

    Length of the youngest leaf [cm]

    + +
    ID
    +

    Plant identifier for 240 plants

    + +
    Stress
    +

    Drought stress treatment with 2 levels (control/drought)

    + +
    Genotype
    +

    Genotype ID with 48 levels

    + +
    Day
    +

    Day of repeated measurement (1,2,...,16)

    + + +
    +
    +

    References

    +

    Uptmoor, R.; Osei-Kwarteng, M.; Guertler, S. & Stuetzel, H. Modeling the Effects of Drought Stress on Leaf Development in a Brassica oleracea Doubled Haploid Population Using Two-phase Linear Functions. Journal of the American Society for Horticultural Science, 2009, 134, 543-552.

    +
    + +
    +

    Examples

    + 
    data(broccoli)
+
+## Display the structure of the data
+head(broccoli)
+#>   LeafLength  ID  Stress Genotype Day
+#> 1        1.4  38 control       17   1
+#> 2        1.2  62 control       17   1
+#> 3        2.5  35 control       17   1
+#> 4        1.8  91 control       17   1
+#> 5        1.7  76 control       17   1
+#> 6        1.4 108 control       17   1
+
+## Fit a five-parameter log-logistic model per stress treatment
+broccoli.m1 <- drm(LeafLength ~ Day, curveid = Stress,
+                   data = broccoli, fct = LL.5())
+summary(broccoli.m1)
+#> 
+#> Model fitted: Generalized log-logistic (ED50 as parameter) (5 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>           Estimate Std. Error t-value   p-value    
+#> b:control -3.52214    0.70944 -4.9647 7.195e-07 ***
+#> b:drought -4.55117    0.93359 -4.8749 1.134e-06 ***
+#> c:control  1.95443    0.28161  6.9402 4.608e-12 ***
+#> c:drought  2.05815    0.35835  5.7435 1.003e-08 ***
+#> d:control 14.72586    0.40596 36.2743 < 2.2e-16 ***
+#> d:drought 10.88808    0.14244 76.4397 < 2.2e-16 ***
+#> e:control  9.30461    0.87822 10.5949 < 2.2e-16 ***
+#> e:drought  7.91145    0.68137 11.6112 < 2.2e-16 ***
+#> f:control  0.43850    0.15151  2.8942  0.003824 ** 
+#> f:drought  0.29038    0.10546  2.7534  0.005926 ** 
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  1.693158 (3679 degrees of freedom)
+plot(broccoli.m1, main = "Broccoli leaf growth by stress treatment")
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/broccoli.md b/docs/reference/broccoli.md new file mode 100644 index 00000000..d417184c --- /dev/null +++ b/docs/reference/broccoli.md @@ -0,0 +1,98 @@ +# The Effects of Drought Stress on Leaf Development in a *Brassica oleracea* population + +The effect of drought stress on *Brassica oleracea* should be +investigated, selecting drought stress resistant out of a population of +different DH genotypes. The study was carried out on 48 DH lines +developed from F1 plants of a cross between the rapid cycling chinese +kale (*Brassica oleracea* var. *alboglabra* (L.H. Bailey) Musil) and +broccoli (*Brassica oleracea* var. *italica* Plenck). 2 stress +treatments (not watered and a watered control) are randomly assigned to +4 plants per genotype (2 per treatment) resulting in 192 plants in +total. For the genotypes 5, 17, 31, 48, additional 12 plants (6 per +treatment) are included into the completely randomized design, which +results in a total of 240 plants. For each plant the length of the +youngest leaf at the beginning of the experiment is measured daily for a +period of 16 days. For the additional 12 plants of the 4 genotypes the +leaf water potential was measured as a secondary endpoint (omitted +here); due to these destructive measurements some dropouts occur. + +## Usage + +``` r +data(broccoli) +``` + +## Format + +A data frame with 3689 observations on the following 5 variables. + +- `LeafLength`: + + Length of the youngest leaf \[cm\] + +- `ID`: + + Plant identifier for 240 plants + +- `Stress`: + + Drought stress treatment with 2 levels (control/drought) + +- `Genotype`: + + Genotype ID with 48 levels + +- `Day`: + + Day of repeated measurement (1,2,...,16) + +## References + +Uptmoor, R.; Osei-Kwarteng, M.; Guertler, S. & Stuetzel, H. Modeling the +Effects of Drought Stress on Leaf Development in a Brassica oleracea +Doubled Haploid Population Using Two-phase Linear Functions. Journal of +the American Society for Horticultural Science, 2009, 134, 543-552. + +## Examples + +``` r +data(broccoli) + +## Display the structure of the data +head(broccoli) +#> LeafLength ID Stress Genotype Day +#> 1 1.4 38 control 17 1 +#> 2 1.2 62 control 17 1 +#> 3 2.5 35 control 17 1 +#> 4 1.8 91 control 17 1 +#> 5 1.7 76 control 17 1 +#> 6 1.4 108 control 17 1 + +## Fit a five-parameter log-logistic model per stress treatment +broccoli.m1 <- drm(LeafLength ~ Day, curveid = Stress, + data = broccoli, fct = LL.5()) +summary(broccoli.m1) +#> +#> Model fitted: Generalized log-logistic (ED50 as parameter) (5 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:control -3.52214 0.70944 -4.9647 7.195e-07 *** +#> b:drought -4.55117 0.93359 -4.8749 1.134e-06 *** +#> c:control 1.95443 0.28161 6.9402 4.608e-12 *** +#> c:drought 2.05815 0.35835 5.7435 1.003e-08 *** +#> d:control 14.72586 0.40596 36.2743 < 2.2e-16 *** +#> d:drought 10.88808 0.14244 76.4397 < 2.2e-16 *** +#> e:control 9.30461 0.87822 10.5949 < 2.2e-16 *** +#> e:drought 7.91145 0.68137 11.6112 < 2.2e-16 *** +#> f:control 0.43850 0.15151 2.8942 0.003824 ** +#> f:drought 0.29038 0.10546 2.7534 0.005926 ** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 1.693158 (3679 degrees of freedom) +plot(broccoli.m1, main = "Broccoli leaf growth by stress treatment") +``` diff --git a/docs/reference/carbendazim-1.png b/docs/reference/carbendazim-1.png new file mode 100644 index 00000000..1ef72e46 Binary files /dev/null and b/docs/reference/carbendazim-1.png differ diff --git a/docs/reference/carbendazim.html b/docs/reference/carbendazim.html new file mode 100644 index 00000000..f5149452 --- /dev/null +++ b/docs/reference/carbendazim.html @@ -0,0 +1,122 @@ + +Damage of lymphocyte cells — carbendazim • drc + Skip to contents + + +
    +
    +
    +

    Damage of lymphocyte cells

    + +
    carbendazim.Rd
    +
    + +
    +

    For each of 13 dose levels the number of damaged lymphocyte cells were reported. Each dose level consisted of a total of 2000 cells.

    +
    + +
    +

    Usage

    + 
    data(carbendazim)
    +
    + +
    +

    Format

    +

    A data frame with 13 observations of the following 3 variables.

    dose
    +

    a numeric vector

    + +
    total
    +

    a numeric vector

    + +
    damage
    +

    a numeric vector

    + + +
    +
    +

    Source

    +

    Bentley, K. S. and Kirkland, D. and Murphy, M. and Marshall, R. (2000). Evaluation of thresholds for benomyl- and carbendazim-induced aneuploidy in cultured human lymphocytes using fluorescence in situ hybridization, Mutation Research/Genetic Toxicology and Environmental Mutagenesis, 464, 41–51.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Displaying the data
+head(carbendazim)
+#>   dose total damage
+#> 1    0  2000     16
+#> 2  300  2000     20
+#> 3  400  2000     24
+#> 4  500  2000      9
+#> 5  600  2000     19
+#> 6  700  2000     34
+
+## Fitting a two-parameter log-logistic model for binomial response
+carbendazim.m1 <- drm(damage/total ~ dose, weights = total,
+data = carbendazim, fct = LL.2(), type = "binomial")
+summary(carbendazim.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                 Estimate Std. Error  t-value   p-value    
+#> b:(Intercept)    -1.4379     0.1072 -13.4127 < 2.2e-16 ***
+#> e:(Intercept) 10994.2466  1982.6612   5.5452 2.936e-08 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+## Plotting the fitted curve
+plot(carbendazim.m1, xlab = "Dose", ylab = "Proportion damaged")
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/carbendazim.md b/docs/reference/carbendazim.md new file mode 100644 index 00000000..2afd2709 --- /dev/null +++ b/docs/reference/carbendazim.md @@ -0,0 +1,68 @@ +# Damage of lymphocyte cells + +For each of 13 dose levels the number of damaged lymphocyte cells were +reported. Each dose level consisted of a total of 2000 cells. + +## Usage + +``` r +data(carbendazim) +``` + +## Format + +A data frame with 13 observations of the following 3 variables. + +- `dose`: + + a numeric vector + +- `total`: + + a numeric vector + +- `damage`: + + a numeric vector + +## Source + +Bentley, K. S. and Kirkland, D. and Murphy, M. and Marshall, R. (2000). +Evaluation of thresholds for benomyl- and carbendazim-induced aneuploidy +in cultured human lymphocytes using fluorescence in situ hybridization, +*Mutation Research/Genetic Toxicology and Environmental Mutagenesis*, +**464**, 41–51. + +## Examples + +``` r +library(drc) + +## Displaying the data +head(carbendazim) +#> dose total damage +#> 1 0 2000 16 +#> 2 300 2000 20 +#> 3 400 2000 24 +#> 4 500 2000 9 +#> 5 600 2000 19 +#> 6 700 2000 34 + +## Fitting a two-parameter log-logistic model for binomial response +carbendazim.m1 <- drm(damage/total ~ dose, weights = total, +data = carbendazim, fct = LL.2(), type = "binomial") +summary(carbendazim.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) -1.4379 0.1072 -13.4127 < 2.2e-16 *** +#> e:(Intercept) 10994.2466 1982.6612 5.5452 2.936e-08 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 + +## Plotting the fitted curve +plot(carbendazim.m1, xlab = "Dose", ylab = "Proportion damaged") +``` diff --git a/docs/reference/cedergreen-1.png b/docs/reference/cedergreen-1.png deleted file mode 100644 index 4e5f809d..00000000 Binary files a/docs/reference/cedergreen-1.png and /dev/null differ diff --git a/docs/reference/cedergreen.html b/docs/reference/cedergreen.html index 0ba429f6..8617a564 100644 --- a/docs/reference/cedergreen.html +++ b/docs/reference/cedergreen.html @@ -1,263 +1,179 @@ - - - - - - +Cedergreen-Ritz-Streibig Model — cedergreen • drc + Skip to contents -The Cedergreen-Ritz-Streibig model — cedergreen • drc - - - +
    +
    +
    +

    Cedergreen-Ritz-Streibig Model

    + Source: R/cedergreen.R +
    cedergreen.Rd
    +
    - +
    +

    Provides the Cedergreen-Ritz-Streibig function, a five-parameter model +for describing dose-response curves that exhibit hormesis (a stimulatory or +beneficial effect at low doses). This function generates a model object suitable +for use with non-linear regression functions like drm.

    +
    - - +
    +

    Usage

    + 
    cedergreen(
+  fixed = c(NA, NA, NA, NA, NA),
+  names = c("b", "c", "d", "e", "f"),
+  method = c("loglinear", "anke", "method3", "normolle"),
+  ssfct = NULL,
+  alpha,
+  fctName,
+  fctText
+)
    +
    +
    +

    Arguments

    - - +
    fixed
    +

    A numeric vector of length 5 specifying any parameters to be held fixed +during the estimation. The order is c(b, c, d, e, f). Use NA for +parameters that should be estimated. The default is to estimate all parameters.

    - +
    names
    +

    A character vector of length 5 providing names for the parameters. +The default is c("b", "c", "d", "e", "f").

    - - -
    -
    - - - -
    -
    -
    -
    -

    The Cedergreen-Ritz-Streibig model

    - - -
    +
    ssfct
    +

    A custom self-starter function. If NULL (the default), a +self-starter is automatically generated by calling cedergreen.ssf +with the specified method, fixed, and alpha arguments.

    -
    - -

    'cedergreen' provides a very general way of specifying then Cedergreen-Ritz-Streibig - modified log-logistic model for describing hormesis, under various constraints on the parameters.

    -

    CRS.6 is the extension of link{cedergreen} with freely varying alpha parameter.

    -

    For u-shaped hormesis data 'ucedergreen' provides a very general way of specifying the - Cedergreen-Ritz-Streibig modified log-logistic model, under various constraints on the parameters.

    - -
    - 
    cedergreen(fixed = c(NA, NA, NA, NA, NA),
-  names = c("b", "c", "d", "e", "f"),
-  method = c("1", "2", "3", "4"), ssfct = NULL,
-  alpha, fctName, fctText)
-
-  CRS.6(fixed = c(NA, NA, NA, NA, NA, NA),
-  names = c("b","c","d","e","f","g"),
-  method = c("1", "2", "3", "4"), ssfct = NULL)
-
-  ucedergreen(fixed = c(NA, NA, NA, NA, NA),
-  names = c("b", "c", "d", "e", "f"),
-  method = c("1", "2", "3", "4"), ssfct = NULL,
-  alpha)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    fixed

    numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.

    names

    a vector of character strings giving the names of the parameters (should not contain ":"). - The order of the parameters is: b, c, d, e, f (see under 'Details').

    method

    character string indicating the self starter function to use.

    ssfct

    a self starter function to be used.

    alpha

    numeric value between 0 and 1, reflecting the steepness of the hormesis peak. - This argument needs to be specified.

    fctName

    optional character string used internally by convenience functions.

    fctText

    optional character string used internally by convenience functions.

    - -

    Details

    - -

    The model is given by the expression

    -

    $$ f(x) = c + \frac{d-c+f exp(-1/(x^{\alpha}))}{1+exp(b(log(x)-log(e)))}$$

    -

    which is a five-parameter model (alpha is fixed or freely varying). Not all features (eg EC/ED calculation) -are available for the model with freely varying alpha.

    -

    It is a modification of the four-parameter logistic curve to take hormesis into account.

    -

    The u-shaped model is given by the expression

    -

    $$ f(x) = cd - \frac{d-c+f \exp(-1/x^{\alpha})}{1+\exp(b(\log(x)-\log(e)))}$$

    - -

    Value

    - -

    The value returned is a list containing the non-linear function, the self starter function - and the parameter names.

    - -

    References

    - -

    Cedergreen, N. and Ritz, C. and Streibig, J. C. (2005) - Improved empirical models describing hormesis, - Environmental Toxicology and Chemistry - 24, 3166--3172.

    - -

    Note

    - -

    The functions are for use with the functions drm.

    - -

    See also

    - -

    For fixed alpha, several special cases are handled by the following convenience functions - CRS.4a, CRS.4b, - CRS.4c, CRS.5a, CRS.5b, CRS.5c, - UCRS.4a, UCRS.4b, UCRS.4c, UCRS.5a, - UCRS.5b, UCRS.5c where a, b and c correspond to - the pre-specified alpha values 1, 0.5 and 0.25, respectively.

    - - -

    Examples

    - 
    
-## Estimating CRS model with alpha unknown
-lettuce.crsm1 <- drm(weight~conc, data = lettuce, fct = CRS.6())
-summary(lettuce.crsm1)
    #> 
-#> Model fitted: Generalised Cedergreen-Ritz-Streibig (hormesis) (6 parms)
-#> 
-#> Parameter estimates:
-#> 
-#>               Estimate Std. Error t-value p-value  
-#> b:(Intercept)  0.81093    0.34482  2.3518 0.04655 *
-#> c:(Intercept)  0.38074    0.12504  3.0450 0.01594 *
-#> d:(Intercept)  4.44821    7.36988  0.6036 0.56285  
-#> e:(Intercept)  0.34664    1.09141  0.3176 0.75891  
-#> f:(Intercept) -3.46826    7.37262 -0.4704 0.65061  
-#> g:(Intercept) -1.15917    0.49533 -2.3402 0.04740 *
-#> ---
-#> Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
-#> 
-#> Residual standard error:
-#> 
-#>  0.1243802 (8 degrees of freedom)
    plot(lettuce.crsm1)  # oops: not increasing until hormesis peak
    
-
    -
    - -
    +
    +
    +

    Value

    +

    A list of class mllogistic, containing the model function (fct), +the self-starter function (ssfct), parameter names (names), and other +components required for use with modeling functions like drm.

    +
    +
    +

    Details

    +

    The Cedergreen-Ritz-Streibig model is defined by the following equation: +$$f(x) = c + \frac{d - c + f \exp(-1/x^{\alpha})}{1 + \exp(b(\log(x) - \log(e)))}$$ +The parameter \(f\) determines the size of the hormetic effect (stimulation). +If \(f=0\), the model simplifies to the standard four-parameter log-logistic model. +The parameter \(\alpha\) is a shape parameter that must be specified by the user.

    +
    +
    +

    See also

    +

    drm for model fitting, and cedergreen.ssf for the +underlying self-starter function.

    +
    +
    +

    Author

    +

    Christian Ritz, Hannes Reinwald

    +
    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Examples

    + 
    dose <- c(0, 0.1, 0.5, 1, 5, 10, 20)
+response <- c(100, 102, 95, 80, 40, 25, 20)
+my_data <- data.frame(dose = dose, response = response)
+model_fit <- drm(response ~ dose, data = my_data,
+                 fct = cedergreen(alpha = 0.5))
+summary(model_fit)
+#> 
+#> Model fitted: Cedergreen-Ritz-Streibig (5 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept)   1.1619     0.2153  5.3965 0.0326651 *  
+#> c:(Intercept)  13.5774     4.5892  2.9585 0.0977776 .  
+#> d:(Intercept) 101.4210     2.0399 49.7190 0.0004043 ***
+#> e:(Intercept)   1.3820     1.1363  1.2162 0.3479717    
+#> f:(Intercept)  72.5388   126.6937  0.5726 0.6247324    
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  2.513311 (2 degrees of freedom)
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -

    Site built with pkgdown.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -
    + + + + - - - + diff --git a/docs/reference/cedergreen.md b/docs/reference/cedergreen.md new file mode 100644 index 00000000..63236ce0 --- /dev/null +++ b/docs/reference/cedergreen.md @@ -0,0 +1,118 @@ +# Cedergreen-Ritz-Streibig Model + +Provides the Cedergreen-Ritz-Streibig function, a five-parameter model +for describing dose-response curves that exhibit hormesis (a stimulatory +or beneficial effect at low doses). This function generates a model +object suitable for use with non-linear regression functions like +[`drm`](https://hreinwald.github.io/drc/reference/drm.md). + +## Usage + +``` r +cedergreen( + fixed = c(NA, NA, NA, NA, NA), + names = c("b", "c", "d", "e", "f"), + method = c("loglinear", "anke", "method3", "normolle"), + ssfct = NULL, + alpha, + fctName, + fctText +) +``` + +## Arguments + +- fixed: + + A numeric vector of length 5 specifying any parameters to be held + fixed during the estimation. The order is `c(b, c, d, e, f)`. Use `NA` + for parameters that should be estimated. The default is to estimate + all parameters. + +- names: + + A character vector of length 5 providing names for the parameters. The + default is `c("b", "c", "d", "e", "f")`. + +- method: + + A character string specifying the method for the self-starter function + to use for finding initial parameter values. Options are + `"loglinear"`, `"anke"`, `"method3"`, and `"normolle"`. This is only + used if `ssfct` is `NULL`. + +- ssfct: + + A custom self-starter function. If `NULL` (the default), a + self-starter is automatically generated by calling + [`cedergreen.ssf`](https://hreinwald.github.io/drc/reference/cedergreen.ssf.md) + with the specified `method`, `fixed`, and `alpha` arguments. + +- alpha: + + A mandatory numeric value specifying the fixed shape parameter + \\\alpha\\. The function will stop if this is not provided. + +- fctName: + + An optional character string to name the function object. + +- fctText: + + An optional character string providing a descriptive text for the + model. + +## Value + +A list of class `mllogistic`, containing the model function (`fct`), the +self-starter function (`ssfct`), parameter names (`names`), and other +components required for use with modeling functions like +[`drm`](https://hreinwald.github.io/drc/reference/drm.md). + +## Details + +The Cedergreen-Ritz-Streibig model is defined by the following equation: +\$\$f(x) = c + \frac{d - c + f \exp(-1/x^{\alpha})}{1 + \exp(b(\log(x) - +\log(e)))}\$\$ The parameter \\f\\ determines the size of the hormetic +effect (stimulation). If \\f=0\\, the model simplifies to the standard +four-parameter log-logistic model. The parameter \\\alpha\\ is a shape +parameter that must be specified by the user. + +## See also + +[`drm`](https://hreinwald.github.io/drc/reference/drm.md) for model +fitting, and +[`cedergreen.ssf`](https://hreinwald.github.io/drc/reference/cedergreen.ssf.md) +for the underlying self-starter function. + +## Author + +Christian Ritz, Hannes Reinwald + +## Examples + +``` r +dose <- c(0, 0.1, 0.5, 1, 5, 10, 20) +response <- c(100, 102, 95, 80, 40, 25, 20) +my_data <- data.frame(dose = dose, response = response) +model_fit <- drm(response ~ dose, data = my_data, + fct = cedergreen(alpha = 0.5)) +summary(model_fit) +#> +#> Model fitted: Cedergreen-Ritz-Streibig (5 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 1.1619 0.2153 5.3965 0.0326651 * +#> c:(Intercept) 13.5774 4.5892 2.9585 0.0977776 . +#> d:(Intercept) 101.4210 2.0399 49.7190 0.0004043 *** +#> e:(Intercept) 1.3820 1.1363 1.2162 0.3479717 +#> f:(Intercept) 72.5388 126.6937 0.5726 0.6247324 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 2.513311 (2 degrees of freedom) +``` diff --git a/docs/reference/cedergreen.ssf.html b/docs/reference/cedergreen.ssf.html new file mode 100644 index 00000000..31523e95 --- /dev/null +++ b/docs/reference/cedergreen.ssf.html @@ -0,0 +1,116 @@ + +Self-starter for the Cedergreen-Ritz-Streibig Dose-Response Model — cedergreen.ssf • drc + Skip to contents + + +
    +
    +
    +

    Self-starter for the Cedergreen-Ritz-Streibig Dose-Response Model

    + Source: R/cedergreen.ssf.R +
    cedergreen.ssf.Rd
    +
    + +
    +

    A self-starting function for the Cedergreen-Ritz-Streibig model, +used to find initial parameter estimates for non-linear regression (e.g., with nls or drc).

    +
    + +
    +

    Usage

    + 
    cedergreen.ssf(
+  method = c("loglinear", "anke", "method3", "normolle"),
+  fixed,
+  alpha,
+  useFixed = FALSE
+)
    +
    + +
    +

    Arguments

    + + +
    method
    +

    A character string specifying the method for estimating initial +'b' and 'e' parameters. Using descriptive names is preferred.

    + + +
    fixed
    +

    A numeric vector of fixed parameter values, with NA for +parameters that need to be estimated. The required order is c(b, c, d, e, f).

    + + +
    alpha
    +

    A numeric value for the alpha parameter, which is treated as a known +constant during the estimation of the other initial parameters.

    + + +
    useFixed
    +

    A logical value. If TRUE, the function will use the non-NA +values provided in the fixed argument as fixed parameters and only estimate the others.

    + +
    +
    +

    Value

    +

    A numeric vector of initial parameter estimates for the model parameters +that were not specified as fixed.

    +
    +
    +

    Details

    +

    This function is a closure that returns another function. The returned +function takes a data frame and calculates initial values for the model parameters +(b, c, d, e, f). This self-starter relies on several helper functions +(e.g., findcd, findbe1, findbe2, findbe3) which must be available in the +calling environment.

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/cedergreen.ssf.md b/docs/reference/cedergreen.ssf.md new file mode 100644 index 00000000..2608221a --- /dev/null +++ b/docs/reference/cedergreen.ssf.md @@ -0,0 +1,52 @@ +# Self-starter for the Cedergreen-Ritz-Streibig Dose-Response Model + +A self-starting function for the Cedergreen-Ritz-Streibig model, used to +find initial parameter estimates for non-linear regression (e.g., with +`nls` or `drc`). + +## Usage + +``` r +cedergreen.ssf( + method = c("loglinear", "anke", "method3", "normolle"), + fixed, + alpha, + useFixed = FALSE +) +``` + +## Arguments + +- method: + + A character string specifying the method for estimating initial 'b' + and 'e' parameters. Using descriptive names is preferred. + +- fixed: + + A numeric vector of fixed parameter values, with `NA` for parameters + that need to be estimated. The required order is `c(b, c, d, e, f)`. + +- alpha: + + A numeric value for the alpha parameter, which is treated as a known + constant during the estimation of the other initial parameters. + +- useFixed: + + A logical value. If `TRUE`, the function will use the non-NA values + provided in the `fixed` argument as fixed parameters and only estimate + the others. + +## Value + +A numeric vector of initial parameter estimates for the model parameters +that were not specified as `fixed`. + +## Details + +This function is a closure that returns another function. The returned +function takes a data frame and calculates initial values for the model +parameters (b, c, d, e, f). This self-starter relies on several helper +functions (e.g., `findcd`, `findbe1`, `findbe2`, `findbe3`) which must +be available in the calling environment. diff --git a/docs/reference/cedergreen_edfct.html b/docs/reference/cedergreen_edfct.html new file mode 100644 index 00000000..f377238f --- /dev/null +++ b/docs/reference/cedergreen_edfct.html @@ -0,0 +1,136 @@ + +Calculate Effective Dose for the Cedergreen-Ritz Hormesis Model — cedergreen_edfct • drc + Skip to contents + + +
    +
    +
    +

    Calculate Effective Dose for the Cedergreen-Ritz Hormesis Model

    + Source: R/cedergreen.R +
    cedergreen_edfct.Rd
    +
    + +
    +

    An internal helper function to calculate the effective dose (ED) and its +derivatives for the Cedergreen-Ritz five-parameter hormesis model. It uses +uniroot to find the dose for a given response level.

    +
    + +
    +

    Usage

    + 
    cedergreen_edfct(
+  parm,
+  all_params,
+  not_fixed,
+  alpha,
+  respl,
+  reference,
+  type,
+  lower = 1e-04,
+  upper = 10000
+)
    +
    + +
    +

    Arguments

    + + +
    parm
    +

    A numeric vector of the non-fixed model parameters.

    + + +
    all_params
    +

    A numeric vector template for all model parameters (b,c,d,e,f).

    + + +
    not_fixed
    +

    A logical or integer vector indicating the non-fixed parameters.

    + + +
    alpha
    +

    A numeric value for the hormesis model's alpha shape parameter.

    + + +
    respl
    +

    The response level to calculate the dose for (e.g., 50 for ED50).

    + + +
    reference
    +

    A character string ("control" or "absolute") for calculating the response.

    + + +
    type
    +

    A character string specifying the type of ED calculation.

    + + +
    lower
    +

    The lower bound of the dose interval for the root-finding search.

    + + +
    upper
    +

    The upper bound of the dose interval for the root-finding search.

    + +
    +
    +

    Value

    +

    A list containing the calculated effective dose and a vector of its +partial derivatives with respect to the non-fixed parameters.

    +
    +
    +

    Author

    +

    Hannes Reinwald

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/cedergreen_edfct.md b/docs/reference/cedergreen_edfct.md new file mode 100644 index 00000000..d1b6ddf1 --- /dev/null +++ b/docs/reference/cedergreen_edfct.md @@ -0,0 +1,69 @@ +# Calculate Effective Dose for the Cedergreen-Ritz Hormesis Model + +An internal helper function to calculate the effective dose (ED) and its +derivatives for the Cedergreen-Ritz five-parameter hormesis model. It +uses `uniroot` to find the dose for a given response level. + +## Usage + +``` r +cedergreen_edfct( + parm, + all_params, + not_fixed, + alpha, + respl, + reference, + type, + lower = 1e-04, + upper = 10000 +) +``` + +## Arguments + +- parm: + + A numeric vector of the non-fixed model parameters. + +- all_params: + + A numeric vector template for all model parameters (b,c,d,e,f). + +- not_fixed: + + A logical or integer vector indicating the non-fixed parameters. + +- alpha: + + A numeric value for the hormesis model's alpha shape parameter. + +- respl: + + The response level to calculate the dose for (e.g., 50 for ED50). + +- reference: + + A character string ("control" or "absolute") for calculating the + response. + +- type: + + A character string specifying the type of ED calculation. + +- lower: + + The lower bound of the dose interval for the root-finding search. + +- upper: + + The upper bound of the dose interval for the root-finding search. + +## Value + +A list containing the calculated effective dose and a vector of its +partial derivatives with respect to the non-fixed parameters. + +## Author + +Hannes Reinwald diff --git a/docs/reference/cedergreen_maxfct.html b/docs/reference/cedergreen_maxfct.html new file mode 100644 index 00000000..28b6c8da --- /dev/null +++ b/docs/reference/cedergreen_maxfct.html @@ -0,0 +1,109 @@ + +Find the Dose and Response at Maximum Hormesis — cedergreen_maxfct • drc + Skip to contents + + +
    +
    +
    +

    Find the Dose and Response at Maximum Hormesis

    + Source: R/cedergreen.R +
    cedergreen_maxfct.Rd
    +
    + +
    +

    This function finds the dose that elicits the maximum hormetic (stimulatory) +response for the Cedergreen-Ritz model and the response value at that dose.

    +
    + +
    +

    Usage

    + 
    cedergreen_maxfct(
+  all_params,
+  alpha,
+  lower = 1e-06,
+  upper = 1000,
+  .optimize_fn = stats::optimize
+)
    +
    + +
    +

    Arguments

    + + +
    all_params
    +

    A named list of all model parameters (b, c, d, e, f).

    + + +
    alpha
    +

    The hormesis alpha shape parameter.

    + + +
    lower
    +

    The lower bound of the dose interval to search for the maximum.

    + + +
    upper
    +

    The upper bound of the dose interval to search for the maximum.

    + +
    +
    +

    Value

    +

    A numeric vector containing two values: the dose at the maximum +response, and the maximum response value itself. Returns c(NA, NA) on failure.

    +
    +
    +

    Author

    +

    Hannes Reinwald

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/cedergreen_maxfct.md b/docs/reference/cedergreen_maxfct.md new file mode 100644 index 00000000..32a21542 --- /dev/null +++ b/docs/reference/cedergreen_maxfct.md @@ -0,0 +1,45 @@ +# Find the Dose and Response at Maximum Hormesis + +This function finds the dose that elicits the maximum hormetic +(stimulatory) response for the Cedergreen-Ritz model and the response +value at that dose. + +## Usage + +``` r +cedergreen_maxfct( + all_params, + alpha, + lower = 1e-06, + upper = 1000, + .optimize_fn = stats::optimize +) +``` + +## Arguments + +- all_params: + + A named list of all model parameters (b, c, d, e, f). + +- alpha: + + The hormesis alpha shape parameter. + +- lower: + + The lower bound of the dose interval to search for the maximum. + +- upper: + + The upper bound of the dose interval to search for the maximum. + +## Value + +A numeric vector containing two values: the dose at the maximum +response, and the maximum response value itself. Returns `c(NA, NA)` on +failure. + +## Author + +Hannes Reinwald diff --git a/docs/reference/chickweed-1.png b/docs/reference/chickweed-1.png new file mode 100644 index 00000000..5ac47155 Binary files /dev/null and b/docs/reference/chickweed-1.png differ diff --git a/docs/reference/chickweed.html b/docs/reference/chickweed.html new file mode 100644 index 00000000..15619169 --- /dev/null +++ b/docs/reference/chickweed.html @@ -0,0 +1,234 @@ + +Germination of common chickweed (Stellaria media) — chickweed • drc + Skip to contents + + +
    +
    +
    +

    Germination of common chickweed (Stellaria media)

    + +
    chickweed.Rd
    +
    + +
    +

    Germination data from tests of chickweed seeds from chlorsulfuron resistant and sensitive biotypes

    +
    + +
    +

    Usage

    + 
    data(chickweed)
    +
    + +
    +

    Format

    +

    A data frame with 35 observations on the following 3 variables.

    start
    +

    a numeric vector of left endpoints of the monitoring intervals

    + +
    end
    +

    a numeric vector of right endpoints of the monitoring intervals

    + +
    count
    +

    a numeric vector of the number of seeds germinated in the interval between start and end

    + +
    time
    +

    a numeric vector of the non-zero left endpoints of the monitoring intervals (often used for recording in practice)

    + + +
    +
    +

    Details

    +

    The germination tests of chickweed seeds from chlorsulfuron resistant and sensitive biotypes in central Zealand were + done in petri dishes (diameter: 9.0cm) in a dark growth cabinet at a temperature of 5 degrees Celsius. The seeds were incubated for + 24 hours in a 0.3% solution of potassium nitrate in order to imbibe seeds prior to the test. A total of 200 seeds were placed on filter plate. + After initialization of the tests, the number of germinated seeds was recorded and removed at 34 consecutive inspection times. + Definition of a germinated seed was the breakthrough of the seed testa by the radicle.

    +

    Chickweed is known to have dormant seeds and therefore we would not expect 100% germination. It means that the upper limit + of the proportion germinated has to be incorporated as a parameter into a model, which adequately reflects the experimental design + as well as any expectations about the resulting outcome.

    +
    +
    +

    Source

    +

    Data are kindly provided by Lisa Borggaard (formerly at the Faculty of Life Sciences, University of Copenhagen).

    +
    +
    +

    References

    +

    Ritz, C., Pipper, C. B. and Streibig, J. C. (2013) Analysis of germination data from agricultural experiments, Europ. J. Agronomy, 45, 1–6.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Incorrect analysis using a logistic regression model
+## (treating event times as binomial data)
+## The argument "type" specifies that binomial data are supplied 
+chickweed.m0a <- drm(count/200 ~ time, weights = rep(200, 34), 
+data = chickweed0, fct = LL.3(), type = "binomial")
+summary(chickweed.m0a) # showing a summmary of the model fit (including parameter estimates)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                 Estimate Std. Error t-value   p-value    
+#> b:(Intercept) -15.715465   1.954346 -8.0413 8.886e-16 ***
+#> d:(Intercept)   0.207812   0.011541 18.0070 < 2.2e-16 ***
+#> e:(Intercept) 198.161626   2.965343 66.8259 < 2.2e-16 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+## Incorrect analysis based on nonlinear regression
+## LL.3() refers to the three-parameter log-logistic model
+## As the argument "type" is not specified it is assumed that the data type
+##  is continuous and nonlinear regression based on least squares estimation is carried out
+chickweed.m0b <- drm(count/200 ~ time, data = chickweed0, fct = LL.3())
+summary(chickweed.m0b)  # showing a summmary of the model fit (including parameter estimates)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                  Estimate  Std. Error t-value   p-value    
+#> b:(Intercept) -27.1427205   1.1960927 -22.693 < 2.2e-16 ***
+#> d:(Intercept)   0.1972877   0.0012527 157.490 < 2.2e-16 ***
+#> e:(Intercept) 195.8040859   0.3479695 562.705 < 2.2e-16 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.003417113 (31 degrees of freedom)
+
+## How to re-arrange the data for fitting the event-time model
+## (only for illustration of the steps needed for converting a dataset, 
+##  but in this case not needed as both datasets are already provided in "drc")
+#chickweed <- data.frame(start = c(0, chickweed0$time), end = c(chickweed0$time, Inf)) 
+#chickweed$count <- c(0, diff(chickweed0$count), 200 - tail(chickweed0$count, 1))
+#head(chickweed)  # showing top 6 lines of the dataset
+#tail(chickweed)  # showing bottom 6 lines
+
+## Fitting the event-time model (by specifying the argument type explicitly)
+chickweed.m1 <- drm(count~start+end, data = chickweed, fct = LL.3(), type = "event")
+summary(chickweed.m1)  # showing a summmary of the model fit (including parameter estimates)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                Estimate Std. Error t-value   p-value    
+#> b:(Intercept) -20.76747    2.94423 -7.0536 1.743e-12 ***
+#> d:(Intercept)   0.20011    0.02830  7.0711 1.537e-12 ***
+#> e:(Intercept) 196.05308    2.50570 78.2427 < 2.2e-16 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+## Summary output with robust standard errors
+## library(lmtest)
+## library(sandwich)
+## coeftest(chickweed.m1, vcov = sandwich)
+
+## Calculating t10, t50, t90 for the distribution of viable seeds
+ED(chickweed.m1, c(10, 50, 90))
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error
+#> e:10 176.3700     3.4930
+#> e:50 196.0531     2.5057
+#> e:90 217.9328     4.2730
+
+## Plotting data and fitted regression curve
+plot(chickweed.m1, xlab = "Time (hours)", ylab = "Proportion germinated", 
+xlim=c(0, 340), ylim=c(0, 0.25), log="", lwd=2, cex=1.2)  
+## Adding the fitted curve obtained using nonlinear regression
+plot(chickweed.m0b, add = TRUE, lty = 2, xlim=c(0, 340), 
+ylim=c(0, 0.25), log="", lwd=2, cex=1.2)
+# Note: the event-time model has slightly better fit at the upper limit
+
+## Enhancing the plot (to look like in the reference paper)
+abline(h = 0.20011, lty = 3, lwd = 2)
+text(-15, 0.21, "Upper limit: d", pos = 4, cex = 1.5)
+
+segments(0,0.1,196,0.1, lty = 3, lwd = 2)
+segments(196,0.1, 196, -0.1, lty = 3, lwd = 2)
+text(200, -0.004, expression(paste("50% germination: ", t[50])), pos = 4, cex = 1.5)
+
+abline(a = 0.20011/2-0.20011*20.77/4, b = 0.20011*20.77/4/196, lty = 3, lwd = 2)
+#text(200, 0.1, expression(paste("Slope: ", b*(-d/(4*t[50])))), pos = 4, cex = 1.5)
+text(200, 0.1, expression("Slope: b" %.% "constant"), pos = 4, cex = 1.5)
+points(196, 0.1, cex = 2, pch = 0)
+
+
+
+## Adding confidence intervals
+
+## Predictions from the event-time model
+#coefVec <- coef(chickweed.m1)
+#names(coefVec) <- c("b","d","e")
+#
+#predFct <- function(tival)
+#{
+#    as.numeric(deltaMethod(coefVec, paste("d/(1+exp(b*(log(",tival,")-log(e))))"), 
+#    vcov(chickweed.m1)))
+#}
+#predFctv <- Vectorize(predFct, "tival")
+#
+#etpred <- t(predFctv(0:340))
+#lines(0:340, etpred[,1]-1.96*etpred[,2], lty=1, lwd=2, col="darkgray")
+#lines(0:340, etpred[,1]+1.96*etpred[,2], lty=1, lwd=2, col="darkgray")
+#
+### Predictions from the nonlinear regression model
+#nrpred <- predict(chickweed.m0b, data.frame(time=0:340), interval="confidence")
+#lines(0:340, nrpred[,2], lty=2, lwd=2, col="darkgray")
+#lines(0:340, nrpred[,3], lty=2, lwd=2, col="darkgray")
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/chickweed.md b/docs/reference/chickweed.md new file mode 100644 index 00000000..70ddff8e --- /dev/null +++ b/docs/reference/chickweed.md @@ -0,0 +1,190 @@ +# Germination of common chickweed (*Stellaria media*) + +Germination data from tests of chickweed seeds from chlorsulfuron +resistant and sensitive biotypes + +## Usage + +``` r +data(chickweed) +``` + +## Format + +A data frame with 35 observations on the following 3 variables. + +- `start`: + + a numeric vector of left endpoints of the monitoring intervals + +- `end`: + + a numeric vector of right endpoints of the monitoring intervals + +- `count`: + + a numeric vector of the number of seeds germinated in the interval + between start and end + +- `time`: + + a numeric vector of the non-zero left endpoints of the monitoring + intervals (often used for recording in practice) + +## Details + +The germination tests of chickweed seeds from chlorsulfuron resistant +and sensitive biotypes in central Zealand were done in petri dishes +(diameter: 9.0cm) in a dark growth cabinet at a temperature of 5 degrees +Celsius. The seeds were incubated for 24 hours in a 0.3% solution of +potassium nitrate in order to imbibe seeds prior to the test. A total of +200 seeds were placed on filter plate. After initialization of the +tests, the number of germinated seeds was recorded and removed at 34 +consecutive inspection times. Definition of a germinated seed was the +breakthrough of the seed testa by the radicle. + +Chickweed is known to have dormant seeds and therefore we would not +expect 100% germination. It means that the upper limit of the proportion +germinated has to be incorporated as a parameter into a model, which +adequately reflects the experimental design as well as any expectations +about the resulting outcome. + +## Source + +Data are kindly provided by Lisa Borggaard (formerly at the Faculty of +Life Sciences, University of Copenhagen). + +## References + +Ritz, C., Pipper, C. B. and Streibig, J. C. (2013) Analysis of +germination data from agricultural experiments, *Europ. J. Agronomy*, +**45**, 1–6. + +## Examples + +``` r +library(drc) + +## Incorrect analysis using a logistic regression model +## (treating event times as binomial data) +## The argument "type" specifies that binomial data are supplied +chickweed.m0a <- drm(count/200 ~ time, weights = rep(200, 34), +data = chickweed0, fct = LL.3(), type = "binomial") +summary(chickweed.m0a) # showing a summmary of the model fit (including parameter estimates) +#> +#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) -15.715465 1.954346 -8.0413 8.886e-16 *** +#> d:(Intercept) 0.207812 0.011541 18.0070 < 2.2e-16 *** +#> e:(Intercept) 198.161626 2.965343 66.8259 < 2.2e-16 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 + +## Incorrect analysis based on nonlinear regression +## LL.3() refers to the three-parameter log-logistic model +## As the argument "type" is not specified it is assumed that the data type +## is continuous and nonlinear regression based on least squares estimation is carried out +chickweed.m0b <- drm(count/200 ~ time, data = chickweed0, fct = LL.3()) +summary(chickweed.m0b) # showing a summmary of the model fit (including parameter estimates) +#> +#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) -27.1427205 1.1960927 -22.693 < 2.2e-16 *** +#> d:(Intercept) 0.1972877 0.0012527 157.490 < 2.2e-16 *** +#> e:(Intercept) 195.8040859 0.3479695 562.705 < 2.2e-16 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.003417113 (31 degrees of freedom) + +## How to re-arrange the data for fitting the event-time model +## (only for illustration of the steps needed for converting a dataset, +## but in this case not needed as both datasets are already provided in "drc") +#chickweed <- data.frame(start = c(0, chickweed0$time), end = c(chickweed0$time, Inf)) +#chickweed$count <- c(0, diff(chickweed0$count), 200 - tail(chickweed0$count, 1)) +#head(chickweed) # showing top 6 lines of the dataset +#tail(chickweed) # showing bottom 6 lines + +## Fitting the event-time model (by specifying the argument type explicitly) +chickweed.m1 <- drm(count~start+end, data = chickweed, fct = LL.3(), type = "event") +summary(chickweed.m1) # showing a summmary of the model fit (including parameter estimates) +#> +#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) -20.76747 2.94423 -7.0536 1.743e-12 *** +#> d:(Intercept) 0.20011 0.02830 7.0711 1.537e-12 *** +#> e:(Intercept) 196.05308 2.50570 78.2427 < 2.2e-16 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 + +## Summary output with robust standard errors +## library(lmtest) +## library(sandwich) +## coeftest(chickweed.m1, vcov = sandwich) + +## Calculating t10, t50, t90 for the distribution of viable seeds +ED(chickweed.m1, c(10, 50, 90)) +#> +#> Estimated effective doses +#> +#> Estimate Std. Error +#> e:10 176.3700 3.4930 +#> e:50 196.0531 2.5057 +#> e:90 217.9328 4.2730 + +## Plotting data and fitted regression curve +plot(chickweed.m1, xlab = "Time (hours)", ylab = "Proportion germinated", +xlim=c(0, 340), ylim=c(0, 0.25), log="", lwd=2, cex=1.2) +## Adding the fitted curve obtained using nonlinear regression +plot(chickweed.m0b, add = TRUE, lty = 2, xlim=c(0, 340), +ylim=c(0, 0.25), log="", lwd=2, cex=1.2) +# Note: the event-time model has slightly better fit at the upper limit + +## Enhancing the plot (to look like in the reference paper) +abline(h = 0.20011, lty = 3, lwd = 2) +text(-15, 0.21, "Upper limit: d", pos = 4, cex = 1.5) + +segments(0,0.1,196,0.1, lty = 3, lwd = 2) +segments(196,0.1, 196, -0.1, lty = 3, lwd = 2) +text(200, -0.004, expression(paste("50% germination: ", t[50])), pos = 4, cex = 1.5) + +abline(a = 0.20011/2-0.20011*20.77/4, b = 0.20011*20.77/4/196, lty = 3, lwd = 2) +#text(200, 0.1, expression(paste("Slope: ", b*(-d/(4*t[50])))), pos = 4, cex = 1.5) +text(200, 0.1, expression("Slope: b" %.% "constant"), pos = 4, cex = 1.5) +points(196, 0.1, cex = 2, pch = 0) + + + +## Adding confidence intervals + +## Predictions from the event-time model +#coefVec <- coef(chickweed.m1) +#names(coefVec) <- c("b","d","e") +# +#predFct <- function(tival) +#{ +# as.numeric(deltaMethod(coefVec, paste("d/(1+exp(b*(log(",tival,")-log(e))))"), +# vcov(chickweed.m1))) +#} +#predFctv <- Vectorize(predFct, "tival") +# +#etpred <- t(predFctv(0:340)) +#lines(0:340, etpred[,1]-1.96*etpred[,2], lty=1, lwd=2, col="darkgray") +#lines(0:340, etpred[,1]+1.96*etpred[,2], lty=1, lwd=2, col="darkgray") +# +### Predictions from the nonlinear regression model +#nrpred <- predict(chickweed.m0b, data.frame(time=0:340), interval="confidence") +#lines(0:340, nrpred[,2], lty=2, lwd=2, col="darkgray") +#lines(0:340, nrpred[,3], lty=2, lwd=2, col="darkgray") +``` diff --git a/docs/reference/chickweed0.html b/docs/reference/chickweed0.html new file mode 100644 index 00000000..a7ecd28e --- /dev/null +++ b/docs/reference/chickweed0.html @@ -0,0 +1,8 @@ + + + + + + + + diff --git a/docs/reference/chlorac-1.png b/docs/reference/chlorac-1.png new file mode 100644 index 00000000..b93ba9ad Binary files /dev/null and b/docs/reference/chlorac-1.png differ diff --git a/docs/reference/chlorac.html b/docs/reference/chlorac.html new file mode 100644 index 00000000..64db7c47 --- /dev/null +++ b/docs/reference/chlorac.html @@ -0,0 +1,118 @@ + +chlorac — chlorac • drc + Skip to contents + + +
    +
    +
    +

    chlorac

    + +
    chlorac.Rd
    +
    + +
    +

    Data from an acute toxicity test where organisms were exposed to different concentrations of chloroacetaldehyde. The number of dead subjects out of a total were recorded for each concentration.

    +
    + +
    +

    Usage

    + 
    data(chlorac)
    +
    + +
    +

    Format

    +

    A data frame with 6 observations on the following 3 variables.

    conc
    +

    a numeric vector

    + +
    total
    +

    a numeric vector

    + +
    num.dead
    +

    a numeric vector

    + + +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Displaying the data
+head(chlorac)
+#>   conc total num.dead
+#> 1    0    40        3
+#> 2   10    40        5
+#> 3   20    40        6
+#> 4   40    40       38
+#> 5   80    40       40
+#> 6  160    40       40
+
+## Fitting a two-parameter log-logistic model for binomial response
+chlorac.m1 <- drm(num.dead/total ~ conc, weights = total,
+data = chlorac, fct = LL.2(), type = "binomial")
+summary(chlorac.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept)  -3.8861     0.5787 -6.7152 1.878e-11 ***
+#> e:(Intercept)  24.1102     1.6173 14.9082 < 2.2e-16 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+## Plotting the fitted curve
+plot(chlorac.m1, xlab = "Concentration", ylab = "Proportion dead")
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/chlorac.md b/docs/reference/chlorac.md new file mode 100644 index 00000000..2d0171cc --- /dev/null +++ b/docs/reference/chlorac.md @@ -0,0 +1,61 @@ +# chlorac + +Data from an acute toxicity test where organisms were exposed to +different concentrations of chloroacetaldehyde. The number of dead +subjects out of a total were recorded for each concentration. + +## Usage + +``` r +data(chlorac) +``` + +## Format + +A data frame with 6 observations on the following 3 variables. + +- `conc`: + + a numeric vector + +- `total`: + + a numeric vector + +- `num.dead`: + + a numeric vector + +## Examples + +``` r +library(drc) + +## Displaying the data +head(chlorac) +#> conc total num.dead +#> 1 0 40 3 +#> 2 10 40 5 +#> 3 20 40 6 +#> 4 40 40 38 +#> 5 80 40 40 +#> 6 160 40 40 + +## Fitting a two-parameter log-logistic model for binomial response +chlorac.m1 <- drm(num.dead/total ~ conc, weights = total, +data = chlorac, fct = LL.2(), type = "binomial") +summary(chlorac.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) -3.8861 0.5787 -6.7152 1.878e-11 *** +#> e:(Intercept) 24.1102 1.6173 14.9082 < 2.2e-16 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 + +## Plotting the fitted curve +plot(chlorac.m1, xlab = "Concentration", ylab = "Proportion dead") +``` diff --git a/docs/reference/chlordan-1.png b/docs/reference/chlordan-1.png new file mode 100644 index 00000000..133cf32d Binary files /dev/null and b/docs/reference/chlordan-1.png differ diff --git a/docs/reference/chlordan.html b/docs/reference/chlordan.html new file mode 100644 index 00000000..e2a87e82 --- /dev/null +++ b/docs/reference/chlordan.html @@ -0,0 +1,125 @@ + +Chlordan — chlordan • drc + Skip to contents + + +
    +
    +
    +

    Chlordan

    + +
    chlordan.Rd
    +
    + +
    +

    Data from a chronic toxicity test measuring the reproduction of Daphnia exposed to different concentrations of chlordane at two time points. The response measured was the number of offspring (repro) per replicate.

    +
    + +
    +

    Usage

    + 
    data(chlordan)
    +
    + +
    +

    Format

    +

    A data frame with 60 observations on the following 5 variables.

    replicate
    +

    a numeric vector

    + +
    conc
    +

    a numeric vector

    + +
    repro
    +

    a numeric vector

    + +
    time
    +

    a numeric vector

    + + +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Displaying the data
+head(chlordan)
+#>   replicate conc repro time
+#> 1         1 0.00   125 21.0
+#> 2         1 0.18    89 21.0
+#> 3         1 0.73    90 21.0
+#> 4         1 1.82    42 21.0
+#> 5         1 2.90    29 21.0
+#> 6         1 7.00    10 11.5
+
+## Fitting a three-parameter log-logistic model
+chlordan.m1 <- drm(repro ~ conc, data = chlordan, fct = LL.3())
+summary(chlordan.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                Estimate Std. Error t-value   p-value    
+#> b:(Intercept)   1.00663    0.14921  6.7463 8.414e-09 ***
+#> d:(Intercept) 115.12320    5.05139 22.7904 < 2.2e-16 ***
+#> e:(Intercept)   1.55178    0.24368  6.3681 3.565e-08 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  16.86007 (57 degrees of freedom)
+
+## Plotting the fitted curve
+plot(chlordan.m1, xlab = "Concentration", ylab = "Reproduction")
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/chlordan.md b/docs/reference/chlordan.md new file mode 100644 index 00000000..b74b0e7e --- /dev/null +++ b/docs/reference/chlordan.md @@ -0,0 +1,70 @@ +# Chlordan + +Data from a chronic toxicity test measuring the reproduction of +*Daphnia* exposed to different concentrations of chlordane at two time +points. The response measured was the number of offspring (repro) per +replicate. + +## Usage + +``` r +data(chlordan) +``` + +## Format + +A data frame with 60 observations on the following 5 variables. + +- `replicate`: + + a numeric vector + +- `conc`: + + a numeric vector + +- `repro`: + + a numeric vector + +- `time`: + + a numeric vector + +## Examples + +``` r +library(drc) + +## Displaying the data +head(chlordan) +#> replicate conc repro time +#> 1 1 0.00 125 21.0 +#> 2 1 0.18 89 21.0 +#> 3 1 0.73 90 21.0 +#> 4 1 1.82 42 21.0 +#> 5 1 2.90 29 21.0 +#> 6 1 7.00 10 11.5 + +## Fitting a three-parameter log-logistic model +chlordan.m1 <- drm(repro ~ conc, data = chlordan, fct = LL.3()) +summary(chlordan.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 1.00663 0.14921 6.7463 8.414e-09 *** +#> d:(Intercept) 115.12320 5.05139 22.7904 < 2.2e-16 *** +#> e:(Intercept) 1.55178 0.24368 6.3681 3.565e-08 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 16.86007 (57 degrees of freedom) + +## Plotting the fitted curve +plot(chlordan.m1, xlab = "Concentration", ylab = "Reproduction") +``` diff --git a/docs/reference/coef.drc.html b/docs/reference/coef.drc.html index 4938de0a..6d3d84fc 100644 --- a/docs/reference/coef.drc.html +++ b/docs/reference/coef.drc.html @@ -1,179 +1,103 @@ - - - - - - +Extract Model Coefficients — coef.drc • drc + Skip to contents -Extract Model Coefficients — coef.drc • drc - - - +
    +
    +
    +

    Extract Model Coefficients

    + Source: R/coef.drc.R +
    coef.drc.Rd
    +
    - - - - +
    +

    Extract parameter estimates.

    +
    +
    +

    Usage

    + 
    # S3 method for class 'drc'
+coef(object, ...)
    +
    +
    +

    Arguments

    - - - +
    object
    +

    an object of class 'drc'.

    - +
    ...
    +

    additional arguments.

    - -
    -
    -
    +
    +

    Value

    +

    A vector of parameter coefficients which are extracted from the +model object object.

    - - -
    -
    - - - - -
    -
    -
    -

    Extract Model Coefficients

    - - +
    +

    Author

    +

    Christian Ritz

    -
    - -

    Extract parameter estimates.

    - +
    +

    Examples

    + 
    ## Fitting a four-parameter log-logistic model
+ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4())
+coef(ryegrass.m1)
+#> b:(Intercept) c:(Intercept) d:(Intercept) e:(Intercept) 
+#>     2.9822191     0.4814132     7.7929583     3.0579550 
+
+
    +
    - 
    # S3 method for drc
-coef(object, ...)
    - -

    Arguments

    - - - - - - - - - - -
    object

    an object of class 'drc'.

    ...

    additional arguments.

    - -

    Value

    - -

    A vector of parameter coefficients which are extracted from the model object 'object'.

    - -

    Note

    - -

    This function may work even in cases where 'summary' does not, because the parameter estimates - are retrieved directly from the model fit object without any additional computations of summary statistics and standard errors.

    - -

    See also

    - -

    A more comprehensive summary is obtained using summary.drc.

    - - -

    Examples

    - 
    
-## Fitting a four-parameter log-logistic model
-ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4())
-coef(ryegrass.m1)
    #> b:(Intercept) c:(Intercept) d:(Intercept) e:(Intercept) 
-#>     2.9822191     0.4814132     7.7929583     3.0579550 
    
-
    -
    - -
    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -

    Site built with pkgdown.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -
    +
    + + + - - - + diff --git a/docs/reference/coef.drc.md b/docs/reference/coef.drc.md new file mode 100644 index 00000000..e7774b59 --- /dev/null +++ b/docs/reference/coef.drc.md @@ -0,0 +1,39 @@ +# Extract Model Coefficients + +Extract parameter estimates. + +## Usage + +``` r +# S3 method for class 'drc' +coef(object, ...) +``` + +## Arguments + +- object: + + an object of class 'drc'. + +- ...: + + additional arguments. + +## Value + +A vector of parameter coefficients which are extracted from the model +object `object`. + +## Author + +Christian Ritz + +## Examples + +``` r +## Fitting a four-parameter log-logistic model +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +coef(ryegrass.m1) +#> b:(Intercept) c:(Intercept) d:(Intercept) e:(Intercept) +#> 2.9822191 0.4814132 7.7929583 3.0579550 +``` diff --git a/docs/reference/commatFct.html b/docs/reference/commatFct.html new file mode 100644 index 00000000..ac085bac --- /dev/null +++ b/docs/reference/commatFct.html @@ -0,0 +1,70 @@ + +Construct contrast matrix — commatFct • drc + Skip to contents + + +
    +
    +
    +

    Construct contrast matrix

    + Source: R/commatFct.R +
    commatFct.Rd
    +
    + +
    +

    Construct contrast matrix

    +
    + +
    +

    Usage

    + 
    commatFct(object, compMatch)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/commatFct.md b/docs/reference/commatFct.md new file mode 100644 index 00000000..4aa073a6 --- /dev/null +++ b/docs/reference/commatFct.md @@ -0,0 +1,9 @@ +# Construct contrast matrix + +Construct contrast matrix + +## Usage + +``` r +commatFct(object, compMatch) +``` diff --git a/docs/reference/compParm.html b/docs/reference/compParm.html index 66b390d3..8d212f33 100644 --- a/docs/reference/compParm.html +++ b/docs/reference/compParm.html @@ -1,231 +1,174 @@ - - - - - - +Comparison of parameters — compParm • drc + Skip to contents -Comparison of parameters — compParm • drc - - - +
    +
    +
    +

    Comparison of parameters

    + Source: R/compParm.R +
    compParm.Rd
    +
    + +
    +

    Compare parameters from different assays, either by means of ratios or differences.

    +
    - +
    +

    Usage

    + 
    compParm(
+  object,
+  strVal,
+  operator = "/",
+  vcov. = vcov,
+  od = FALSE,
+  pool = TRUE,
+  display = TRUE
+)
    +
    - - +
    +

    Arguments

    +
    object
    +

    an object of class 'drc'.

    - - - +
    strVal
    +

    a name of parameter to compare.

    - +
    operator
    +

    a character. If equal to "/" (default) parameter ratios are compared. +If equal to "-" parameter differences are compared.

    - -
    -
    - - - -
    +
    vcov.
    +

    function providing the variance-covariance matrix. vcov is the default, +but sandwich is also an option (for obtaining robust standard errors).

    -
    -
    -
    -

    Comparison of parameters

    - - + +
    od
    +

    logical. If TRUE adjustment for over-dispersion is used.

    + + +
    pool
    +

    logical. If TRUE curves are pooled. Otherwise they are not. This argument only works +for models with independently fitted curves as specified in drm.

    + + +
    display
    +

    logical. If TRUE results are displayed. Otherwise they are not (useful in simulations).

    + +
    +
    +

    Value

    +

    A matrix with columns containing the estimates, estimated standard errors, values of +t-statistics and p-values for the null hypothesis that the ratio equals 1 or that the difference +equals 0 (depending on the operator argument).

    +
    +
    +

    See also

    +

    ED.drc for calculating effective doses and EDcomp for +comparing effective doses.

    +
    +
    +

    Author

    +

    Christian Ritz

    -
    - -

    Compare parameters from different assays, either by means of ratios or differences.

    - +
    +

    Examples

    + 
    spinach.m1 <- drm(SLOPE~DOSE, CURVE, data = spinach,
+fct = LL.4(names = c("b", "lower", "upper", "ed50")))
+
+## Calculating ratios of parameter estimates for "ed50"
+compParm(spinach.m1, "ed50")
+#> 
+#> Comparison of parameter 'ed50' 
+#> 
+#>     Estimate Std. Error t-value  p-value   
+#> 1/2  1.89836    0.71185  1.2620 0.210398   
+#> 1/3  1.30730    0.55416  0.5545 0.580668   
+#> 1/4  9.09638    2.46866  3.2797 0.001508 **
+#> 1/5  8.51523    2.33645  3.2165 0.001836 **
+#> 2/3  0.68865    0.29081 -1.0706 0.287360   
+#> 2/4  4.79171    1.28835  2.9431 0.004189 **
+#> 2/5  4.48557    1.21960  2.8580 0.005361 **
+#> 3/4  6.95813    2.32206  2.5659 0.012045 * 
+#> 3/5  6.51359    2.18960  2.5181 0.013674 * 
+#> 4/5  0.93611    0.07814 -0.8176 0.415868   
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+## Calculating differences between parameter estimates for "ed50"
+compParm(spinach.m1, "ed50", "-")
+#> 
+#> Comparison of parameter 'ed50' 
+#> 
+#>      Estimate Std. Error t-value  p-value   
+#> 1-2  0.849425   0.539400  1.5748 0.119027   
+#> 1-3  0.421932   0.658506  0.6407 0.523414   
+#> 1-4  1.597629   0.478341  3.3399 0.001246 **
+#> 1-5  1.584161   0.478432  3.3112 0.001365 **
+#> 2-3 -0.427493   0.516885 -0.8271 0.410521   
+#> 2-4  0.748204   0.249701  2.9964 0.003580 **
+#> 2-5  0.734736   0.249876  2.9404 0.004221 **
+#> 3-4  1.175696   0.452799  2.5965 0.011095 * 
+#> 3-5  1.162229   0.452896  2.5662 0.012034 * 
+#> 4-5 -0.013467   0.017174 -0.7842 0.435128   
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+
    +
    - 
    compParm(object, strVal, operator = "/", vcov. = vcov, od = FALSE,
-  pool = TRUE, display = TRUE)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    object

    an object of class 'drc'.

    strVal

    a name of parameter to compare.

    operator

    a character. If equal to "/" (default) parameter ratios are compared. If equal to "-" parameter differences are compared.

    vcov.

    function providing the variance-covariance matrix. vcov is the default, - but sandwich is also an option (for obtaining robust standard errors).

    od

    logical. If TRUE adjustment for over-dispersion is used.

    pool

    logical. If TRUE curves are pooled. Otherwise they are not. This argument only works for models with - independently fitted curves as specified in drm.

    display

    logical. If TRUE results are displayed. Otherwise they are not (useful in simulations).

    - -

    Value

    - -

    A matrix with columns containing the estimates, estimated standard errors, values of t-statistics and p-values for the null hypothesis that - the ratio equals 1 or that the difference equals 0 (depending on the operator argument).

    - -

    Details

    - -

    The function compares actual parameter estimates, and therefore the results depend on the parameterisation used. Probably it is most useful - in combination with the argument collapse in drm for specifying parameter constraints in models, either through - data frames or lists with formulas without intercept (-1).

    - - -

    Examples

    - 
    
-# Fitting a model with names assigned to the parameters!
-spinach.m1 <- drm(SLOPE~DOSE, CURVE, data = spinach,
-fct = LL.4(names = c("b", "lower", "upper", "ed50")))
-
-## Calculating ratios of parameter estimates for the parameter named "ed50"
-compParm(spinach.m1, "ed50")
    #> 
-#> Comparison of parameter 'ed50' 
-#> 
-#>     Estimate Std. Error t-value  p-value   
-#> 1/2  1.89836    0.71185  1.2620 0.210398   
-#> 1/3  1.30730    0.55416  0.5545 0.580668   
-#> 1/4  9.09638    2.46866  3.2797 0.001508 **
-#> 1/5  8.51523    2.33645  3.2165 0.001836 **
-#> 2/3  0.68865    0.29081 -1.0706 0.287360   
-#> 2/4  4.79171    1.28835  2.9431 0.004189 **
-#> 2/5  4.48557    1.21960  2.8580 0.005361 **
-#> 3/4  6.95813    2.32206  2.5659 0.012045 * 
-#> 3/5  6.51359    2.18960  2.5181 0.013674 * 
-#> 4/5  0.93611    0.07814 -0.8176 0.415868   
-#> ---
-#> Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
    
-## Calculating differences between parameter estimates for the parameter named "ed50"
-compParm(spinach.m1, "ed50", "-")
    #> 
-#> Comparison of parameter 'ed50' 
-#> 
-#>      Estimate Std. Error t-value  p-value   
-#> 1-2  0.849425   0.539400  1.5748 0.119027   
-#> 1-3  0.421932   0.658506  0.6407 0.523414   
-#> 1-4  1.597629   0.478341  3.3399 0.001246 **
-#> 1-5  1.584161   0.478432  3.3112 0.001365 **
-#> 2-3 -0.427493   0.516885 -0.8271 0.410521   
-#> 2-4  0.748204   0.249701  2.9964 0.003580 **
-#> 2-5  0.734736   0.249876  2.9404 0.004221 **
-#> 3-4  1.175696   0.452799  2.5965 0.011095 * 
-#> 3-5  1.162229   0.452896  2.5662 0.012034 * 
-#> 4-5 -0.013467   0.017174 -0.7842 0.435128   
-#> ---
-#> Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
    
-
    -
    - - -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -

    Site built with pkgdown.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -
    +
    + + + - - - + diff --git a/docs/reference/compParm.md b/docs/reference/compParm.md new file mode 100644 index 00000000..3f52d486 --- /dev/null +++ b/docs/reference/compParm.md @@ -0,0 +1,118 @@ +# Comparison of parameters + +Compare parameters from different assays, either by means of ratios or +differences. + +## Usage + +``` r +compParm( + object, + strVal, + operator = "/", + vcov. = vcov, + od = FALSE, + pool = TRUE, + display = TRUE +) +``` + +## Arguments + +- object: + + an object of class 'drc'. + +- strVal: + + a name of parameter to compare. + +- operator: + + a character. If equal to `"/"` (default) parameter ratios are + compared. If equal to `"-"` parameter differences are compared. + +- vcov.: + + function providing the variance-covariance matrix. + [`vcov`](https://rdrr.io/r/stats/vcov.html) is the default, but + `sandwich` is also an option (for obtaining robust standard errors). + +- od: + + logical. If TRUE adjustment for over-dispersion is used. + +- pool: + + logical. If TRUE curves are pooled. Otherwise they are not. This + argument only works for models with independently fitted curves as + specified in + [`drm`](https://hreinwald.github.io/drc/reference/drm.md). + +- display: + + logical. If TRUE results are displayed. Otherwise they are not (useful + in simulations). + +## Value + +A matrix with columns containing the estimates, estimated standard +errors, values of t-statistics and p-values for the null hypothesis that +the ratio equals 1 or that the difference equals 0 (depending on the +`operator` argument). + +## See also + +[`ED.drc`](https://hreinwald.github.io/drc/reference/ED.drc.md) for +calculating effective doses and +[`EDcomp`](https://hreinwald.github.io/drc/reference/EDcomp.md) for +comparing effective doses. + +## Author + +Christian Ritz + +## Examples + +``` r +spinach.m1 <- drm(SLOPE~DOSE, CURVE, data = spinach, +fct = LL.4(names = c("b", "lower", "upper", "ed50"))) + +## Calculating ratios of parameter estimates for "ed50" +compParm(spinach.m1, "ed50") +#> +#> Comparison of parameter 'ed50' +#> +#> Estimate Std. Error t-value p-value +#> 1/2 1.89836 0.71185 1.2620 0.210398 +#> 1/3 1.30730 0.55416 0.5545 0.580668 +#> 1/4 9.09638 2.46866 3.2797 0.001508 ** +#> 1/5 8.51523 2.33645 3.2165 0.001836 ** +#> 2/3 0.68865 0.29081 -1.0706 0.287360 +#> 2/4 4.79171 1.28835 2.9431 0.004189 ** +#> 2/5 4.48557 1.21960 2.8580 0.005361 ** +#> 3/4 6.95813 2.32206 2.5659 0.012045 * +#> 3/5 6.51359 2.18960 2.5181 0.013674 * +#> 4/5 0.93611 0.07814 -0.8176 0.415868 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 + +## Calculating differences between parameter estimates for "ed50" +compParm(spinach.m1, "ed50", "-") +#> +#> Comparison of parameter 'ed50' +#> +#> Estimate Std. Error t-value p-value +#> 1-2 0.849425 0.539400 1.5748 0.119027 +#> 1-3 0.421932 0.658506 0.6407 0.523414 +#> 1-4 1.597629 0.478341 3.3399 0.001246 ** +#> 1-5 1.584161 0.478432 3.3112 0.001365 ** +#> 2-3 -0.427493 0.516885 -0.8271 0.410521 +#> 2-4 0.748204 0.249701 2.9964 0.003580 ** +#> 2-5 0.734736 0.249876 2.9404 0.004221 ** +#> 3-4 1.175696 0.452799 2.5965 0.011095 * +#> 3-5 1.162229 0.452896 2.5662 0.012034 * +#> 4-5 -0.013467 0.017174 -0.7842 0.435128 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +``` diff --git a/docs/reference/comped-1.png b/docs/reference/comped-1.png deleted file mode 100644 index 6ce057f1..00000000 Binary files a/docs/reference/comped-1.png and /dev/null differ diff --git a/docs/reference/comped.html b/docs/reference/comped.html index 1cf6a02c..c4901527 100644 --- a/docs/reference/comped.html +++ b/docs/reference/comped.html @@ -1,276 +1,145 @@ - - - - - - +Comparison of effective dose values — comped • drc + Skip to contents -Comparison of effective dose values — comped • drc - - - +
    +
    +
    +

    Comparison of effective dose values

    + Source: R/comped.R +
    comped.Rd
    +
    - +
    +

    Comparison of a pair of effective dose values from independent experiments where only the +estimates and their standard errors are reported.

    +
    - - +
    +

    Usage

    + 
    comped(
+  est,
+  se,
+  log = TRUE,
+  interval = TRUE,
+  operator = c("-", "/"),
+  level = 0.95,
+  df = NULL
+)
    +
    +
    +

    Arguments

    - - +
    est
    +

    a numeric vector of length 2 containing the two estimated ED values.

    - +
    se
    +

    a numeric vector of length 2 containing the two standard errors.

    - - -
    -
    - - - -
    -
    -
    -
    -

    Comparison of effective dose values

    - - -
    +
    interval
    +

    logical indicating whether or not a confidence interval should be returned.

    -
    - -

    Comparison of a pair of effective dose values from independent experiments - where only the estimates and their standard errors are reported.

    - -
    - 
    comped(est, se, log = TRUE, interval = TRUE, operator = c("-", "/"),
-  level = 0.95, df = NULL)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    est

    a numeric vector of length 2 containing the two estimated ED values

    se

    a numeric vector of length 2 containing the two standard errors

    log

    logical indicating whether or not estimates and standard errors are on log scale

    interval

    logical indicating whether or not a confidence interval should be returned

    operator

    character string taking one of the two values "-" (default) or "/" corresponding to a comparison - based on the difference or the ratio.

    level

    numeric value giving the confidence level

    df

    numeric value specifying the degrees of freedom for the percentile used in the confidence interval (optional)

    - -

    Details

    - -

    The choice "/" for the argument operator and FALSE for log will result in estimation of a socalled - relative potency (sometimes also called a selectivity index).

    -

    The combination TRUE for log and "/" for operator only influences the confidence interval, - that is no ratio is calculated based on logarithm-transformed effective dose values.

    -

    By default confidence interval relies on percentiles in the normal distribution.

    -

    In case the entire dataset is available the functions drm and (subsequently) EDcomp - should be used instead.

    - -

    Value

    - -

    A matrix with the estimated difference or ratio and the associated standard error and the resulting confidence - interval (unless not requested).

    - -

    References

    - -

    Wheeler, M. W. and Park, R. M. and Bailer, A. J. (2006) - Comparing median lethal concentration values using confidence interval overlap or ratio tests, - Environmental Toxicology and Chemistry, 25, 1441--1441.

    - -

    Note

    - -

    The development of the function comped is a side effect of the project on statistical analysis of - toxicity data funded by the Danish EPA ("Statistisk analyse og biologisk tolkning af toksicitetsdata", - MST j.nr. 669-00079).

    - -

    See also

    - -

    The function ED.drc calculates arbitrary effective dose values based on a model fit. The function - EDcomp calculates relative potencies based on arbitrary effective dose values.

    - - -

    Examples

    - 
    
-## Fitting the model
-S.alba.m1 <- boxcox(drm(DryMatter~Dose, Herbicide, data=S.alba, fct = LL.4(),
-pmodels=data.frame(Herbicide,1,1,Herbicide)), method = "anova")
    
-## Displaying estimated ED values
-ED(S.alba.m1, c(10, 90))
    #> 
-#> Estimated effective doses
-#> 
-#>                 Estimate Std. Error
-#> e:Bentazone:10   18.0321     2.5790
-#> e:Bentazone:90   44.7170     2.6095
-#> e:Glyphosate:10  21.1807     4.1023
-#> e:Glyphosate:90 203.0085    24.8259
    
-## Making comparisons of ED50 in two ways and for both differences and ratios
-compParm(S.alba.m1, "e", "/")
    #> 
-#> Comparison of parameter 'e' 
-#> 
-#>                      Estimate Std. Error t-value   p-value    
-#> Bentazone/Glyphosate 0.433044   0.041805 -13.562 < 2.2e-16 ***
-#> ---
-#> Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
    
-comped(c(28.396147, 65.573335), c(1.874598, 5.618945), log=FALSE, operator = "/")
    #> 
-#> Estimated ratio of effective doses
-#> 
-#>      Estimate Std. Error    Lower  Upper
-#> [1,] 0.433044   0.046842 0.341235 0.5249
    # similar result
-
-compParm(S.alba.m1, "e", "-")
    #> 
-#> Comparison of parameter 'e' 
-#> 
-#>                      Estimate Std. Error t-value   p-value    
-#> Bentazone-Glyphosate -37.1772     5.5365 -6.7149 6.681e-09 ***
-#> ---
-#> Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
    
-comped(c(28.396147, 65.573335), c(1.874598, 5.618945), log=FALSE, operator = "-")
    #> 
-#> Estimated difference of effective doses
-#> 
-#>      Estimate Std. Error    Lower   Upper
-#> [1,] -37.1772     5.9234 -48.7868 -25.567
    # similar result
-
-## Making comparisons of ED10 and ED90
-comped(c(21.173, 44.718), c(11.87, 8.42), log=FALSE, operator = "/")
    #> 
-#> Estimated ratio of effective doses
-#> 
-#>       Estimate Std. Error     Lower  Upper
-#> [1,]  0.473478   0.280013 -0.075336 1.0223
    
-comped(c(21.173, 44.718), c(11.87, 8.42), log=FALSE, operator = "/", interval = FALSE)
    #> 
-#> Estimated ratio of effective doses
-#> 
-#>      Estimate Std. Error
-#> [1,]  0.47348       0.28
    
-comped(c(21.173, 44.718), c(11.87, 8.42), log=FALSE, operator = "-")
    #> 
-#> Estimated difference of effective doses
-#> 
-#>      Estimate Std. Error   Lower  Upper
-#> [1,]  -23.545     14.553 -52.069 4.9786
    
-
    -
    -
    +
    +

    Value

    +

    A matrix with the estimated difference or ratio and the associated standard error and the +resulting confidence interval (unless not requested).

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    + +
    +

    Examples

    + 
    ## Comparing ED50 values as a ratio
+comped(c(28.396, 65.573), c(1.875, 5.619), log = FALSE, operator = "/")
+#> 
+#> Estimated ratio of effective doses
+#> 
+#>      Estimate Std. Error    Lower  Upper
+#> [1,] 0.433044   0.046847 0.341226 0.5249
+
+## Comparing ED50 values as a difference
+comped(c(28.396, 65.573), c(1.875, 5.619), log = FALSE, operator = "-")
+#> 
+#> Estimated difference of effective doses
+#> 
+#>      Estimate Std. Error    Lower   Upper
+#> [1,] -37.1770     5.9236 -48.7870 -25.567
+
+
    +
    +
    -

    Author

    - Christian Ritz -
    - -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -

    Site built with pkgdown.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -
    +
    + + + - - - + diff --git a/docs/reference/comped.md b/docs/reference/comped.md new file mode 100644 index 00000000..9beb8d86 --- /dev/null +++ b/docs/reference/comped.md @@ -0,0 +1,84 @@ +# Comparison of effective dose values + +Comparison of a pair of effective dose values from independent +experiments where only the estimates and their standard errors are +reported. + +## Usage + +``` r +comped( + est, + se, + log = TRUE, + interval = TRUE, + operator = c("-", "/"), + level = 0.95, + df = NULL +) +``` + +## Arguments + +- est: + + a numeric vector of length 2 containing the two estimated ED values. + +- se: + + a numeric vector of length 2 containing the two standard errors. + +- log: + + logical indicating whether or not estimates and standard errors are on + log scale. + +- interval: + + logical indicating whether or not a confidence interval should be + returned. + +- operator: + + character string taking one of the two values `"-"` (default) or `"/"` + corresponding to a comparison based on the difference or the ratio. + +- level: + + numeric value giving the confidence level. + +- df: + + numeric value specifying the degrees of freedom for the percentile + used in the confidence interval (optional). By default confidence + interval relies on the normal distribution. + +## Value + +A matrix with the estimated difference or ratio and the associated +standard error and the resulting confidence interval (unless not +requested). + +## Author + +Christian Ritz + +## Examples + +``` r +## Comparing ED50 values as a ratio +comped(c(28.396, 65.573), c(1.875, 5.619), log = FALSE, operator = "/") +#> +#> Estimated ratio of effective doses +#> +#> Estimate Std. Error Lower Upper +#> [1,] 0.433044 0.046847 0.341226 0.5249 + +## Comparing ED50 values as a difference +comped(c(28.396, 65.573), c(1.875, 5.619), log = FALSE, operator = "-") +#> +#> Estimated difference of effective doses +#> +#> Estimate Std. Error Lower Upper +#> [1,] -37.1770 5.9236 -48.7870 -25.567 +``` diff --git a/docs/reference/confint.basic.html b/docs/reference/confint.basic.html new file mode 100644 index 00000000..bdade6d1 --- /dev/null +++ b/docs/reference/confint.basic.html @@ -0,0 +1,124 @@ + +Basic Confidence Interval Calculation — confint.basic • drc + Skip to contents + + +
    +
    +
    +

    Basic Confidence Interval Calculation

    + Source: R/confint.drc.R +
    confint.basic.Rd
    +
    + +
    +

    An internal helper function that constructs a confidence interval matrix +from a matrix of parameter estimates and their standard errors. A +t-distribution quantile is used for continuous response models; a standard +normal quantile is used for all other response types (binomial, event, +Poisson, negbin1, negbin2).

    +
    + +
    +

    Usage

    + 
    # S3 method for class 'basic'
+confint(estMat, level, intType, dfres, formatting = TRUE)
    +
    + +
    +

    Arguments

    + + +
    estMat
    +

    A numeric matrix with two columns: the first column contains +parameter estimates and the second column contains their standard errors.

    + + +
    level
    +

    The confidence level required (e.g., 0.95 for 95% intervals).

    + + +
    intType
    +

    A character string specifying the response type of the model. +One of "binomial", "continuous", "event", "Poisson", +"negbin1", or "negbin2". Determines whether a normal or t-distribution +quantile is used. For "continuous" models a t-distribution with dfres +degrees of freedom is used; all other types use the standard normal.

    + + +
    dfres
    +

    The residual degrees of freedom. Only used when +intType = "continuous".

    + + +
    formatting
    +

    Logical. If TRUE (default), row and column names are +added to the returned matrix.

    + +
    +
    +

    Value

    +

    A numeric matrix with two columns giving the lower and upper +confidence limits for each parameter.

    +
    +
    +

    See also

    +

    confint.drc() — the user-facing function that calls this helper.

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/confint.basic.md b/docs/reference/confint.basic.md new file mode 100644 index 00000000..312bee87 --- /dev/null +++ b/docs/reference/confint.basic.md @@ -0,0 +1,53 @@ +# Basic Confidence Interval Calculation + +An internal helper function that constructs a confidence interval matrix +from a matrix of parameter estimates and their standard errors. A +t-distribution quantile is used for continuous response models; a +standard normal quantile is used for all other response types (binomial, +event, Poisson, negbin1, negbin2). + +## Usage + +``` r +# S3 method for class 'basic' +confint(estMat, level, intType, dfres, formatting = TRUE) +``` + +## Arguments + +- estMat: + + A numeric matrix with two columns: the first column contains parameter + estimates and the second column contains their standard errors. + +- level: + + The confidence level required (e.g., `0.95` for 95% intervals). + +- intType: + + A character string specifying the response type of the model. One of + `"binomial"`, `"continuous"`, `"event"`, `"Poisson"`, `"negbin1"`, or + `"negbin2"`. Determines whether a normal or t-distribution quantile is + used. For `"continuous"` models a t-distribution with `dfres` degrees + of freedom is used; all other types use the standard normal. + +- dfres: + + The residual degrees of freedom. Only used when + `intType = "continuous"`. + +- formatting: + + Logical. If `TRUE` (default), row and column names are added to the + returned matrix. + +## Value + +A numeric matrix with two columns giving the lower and upper confidence +limits for each parameter. + +## See also + +[`confint.drc()`](https://hreinwald.github.io/drc/reference/confint.drc.md) +— the user-facing function that calls this helper. diff --git a/docs/reference/confint.drc.html b/docs/reference/confint.drc.html index 90bd7793..07631371 100644 --- a/docs/reference/confint.drc.html +++ b/docs/reference/confint.drc.html @@ -1,197 +1,149 @@ - - - - - - +Confidence Intervals for Model Parameters — confint.drc • drc + Skip to contents -Confidence Intervals for model parameters — confint.drc • drc - - - +
    +
    +
    +

    Confidence Intervals for Model Parameters

    + Source: R/confint.drc.R +
    confint.drc.Rd
    +
    - +
    +

    Computes confidence intervals for one or more parameters in a fitted +dose-response model of class "drc". Confidence intervals are constructed +using either a t-distribution (for continuous response models) or a standard +normal distribution (for all other response types).

    +
    - - +
    +

    Usage

    + 
    # S3 method for class 'drc'
+confint(object, parm, level = 0.95, pool = TRUE, ...)
    +
    +
    +

    Arguments

    - - +
    object
    +

    A fitted model object of class "drc".

    - +
    parm
    +

    A specification of which parameters are to be given confidence +intervals, either a vector of indices or a vector of parameter name strings. +If missing, all parameters are considered.

    - - -
    -
    - - - -
    -
    -
    -
    -

    Confidence Intervals for model parameters

    - - +
    pool
    +

    Logical. If TRUE (default), curves are pooled. Otherwise they +are not. This argument only works for models with independently fitted +curves as specified in drm().

    + + +
    ...
    +

    Additional arguments for methods. Currently not used.

    + +
    +
    +

    Value

    +

    A numeric matrix with two columns giving the lower and upper +confidence limits for each parameter. Columns are labelled as +\(\frac{(1 - \text{level})}{2} \times 100\%\) and +\(\left(1 - \frac{(1 - \text{level})}{2}\right) \times 100\%\) +(by default 2.5 % and 97.5 %).

    +
    +
    +

    See also

    +
    +

    • drm() — for fitting dose-response models.

      • +

    • confint.basic() — the internal helper used to construct the intervals.

      • +

    • summary.drc() — for a full summary of model coefficients.

      • +
    +
    +
    +

    Author

    +

    Christian Ritz, Hannes Reinwald

    -
    - -

    Computes confidence intervals for one or more parameters in a model of class 'drc'.

    - +
    +

    Examples

    + 
    ## Fitting a four-parameter log-logistic model
+ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4())
+
+## Confidence intervals for all parameters
+confint(ryegrass.m1)
+#>                    2.5 %    97.5 %
+#> b:(Intercept) 2.01211606 3.9523221
+#> c:(Intercept) 0.03878752 0.9240389
+#> d:(Intercept) 7.39961398 8.1863026
+#> e:(Intercept) 2.67052621 3.4453837
+
+## Confidence interval for a single parameter
+confint(ryegrass.m1, "e")
+#>                  2.5 %   97.5 %
+#> e:(Intercept) 2.670526 3.445384
+
+
    +
    - 
    # S3 method for drc
-confint(object, parm, level = 0.95, pool = TRUE, ...)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - - - - - -
    object

    a model object of class 'drc'.

    parm

    a specification of which parameters are to be given - confidence intervals, either a vector of numbers or a vector - of names. If missing, all parameters are considered.

    level

    the confidence level required.

    pool

    logical. If TRUE curves are pooled. Otherwise they are not. This argument only works for models with - independently fitted curves as specified in drm.

    …

    additional argument(s) for methods. Not used.

    - -

    Details

    - -

    For binomial and Poisson data the confidence intervals are based on the normal distribution, whereas t distributions - are used of for continuous/quantitative data.

    - -

    Value

    - -

    A matrix (or vector) with columns giving lower and upper confidence limits for each parameter. These will be labelled as - (1-level)/2 and 1 - (1-level)/2 in

    - - -

    Examples

    - 
    
-## Fitting a four-parameter log-logistic model
-ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4())
-
-## Confidence intervals for all parameters
-confint(ryegrass.m1)
    #>                    2.5 %    97.5 %
-#> b:(Intercept) 2.01211606 3.9523221
-#> c:(Intercept) 0.03878752 0.9240389
-#> d:(Intercept) 7.39961398 8.1863026
-#> e:(Intercept) 2.67052621 3.4453837
    
-## Confidence interval for a single parameter
-confint(ryegrass.m1, "e")
    #>                  2.5 %   97.5 %
-#> e:(Intercept) 2.670526 3.445384
    
-
    -
    - - -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -

    Site built with pkgdown.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -
    +
    + + + - - - + diff --git a/docs/reference/confint.drc.md b/docs/reference/confint.drc.md new file mode 100644 index 00000000..aeba61ea --- /dev/null +++ b/docs/reference/confint.drc.md @@ -0,0 +1,84 @@ +# Confidence Intervals for Model Parameters + +Computes confidence intervals for one or more parameters in a fitted +dose-response model of class `"drc"`. Confidence intervals are +constructed using either a t-distribution (for continuous response +models) or a standard normal distribution (for all other response +types). + +## Usage + +``` r +# S3 method for class 'drc' +confint(object, parm, level = 0.95, pool = TRUE, ...) +``` + +## Arguments + +- object: + + A fitted model object of class `"drc"`. + +- parm: + + A specification of which parameters are to be given confidence + intervals, either a vector of indices or a vector of parameter name + strings. If missing, all parameters are considered. + +- level: + + The confidence level required. Defaults to `0.95`. + +- pool: + + Logical. If `TRUE` (default), curves are pooled. Otherwise they are + not. This argument only works for models with independently fitted + curves as specified in + [`drm()`](https://hreinwald.github.io/drc/reference/drm.md). + +- ...: + + Additional arguments for methods. Currently not used. + +## Value + +A numeric matrix with two columns giving the lower and upper confidence +limits for each parameter. Columns are labelled as \\\frac{(1 - +\text{level})}{2} \times 100\\\\ and \\\left(1 - \frac{(1 - +\text{level})}{2}\right) \times 100\\\\ (by default `2.5 %` and +`97.5 %`). + +## See also + +- [`drm()`](https://hreinwald.github.io/drc/reference/drm.md) — for + fitting dose-response models. + +- [`confint.basic()`](https://hreinwald.github.io/drc/reference/confint.basic.md) + — the internal helper used to construct the intervals. + +- [`summary.drc()`](https://hreinwald.github.io/drc/reference/summary.drc.md) + — for a full summary of model coefficients. + +## Author + +Christian Ritz, Hannes Reinwald + +## Examples + +``` r +## Fitting a four-parameter log-logistic model +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + +## Confidence intervals for all parameters +confint(ryegrass.m1) +#> 2.5 % 97.5 % +#> b:(Intercept) 2.01211606 3.9523221 +#> c:(Intercept) 0.03878752 0.9240389 +#> d:(Intercept) 7.39961398 8.1863026 +#> e:(Intercept) 2.67052621 3.4453837 + +## Confidence interval for a single parameter +confint(ryegrass.m1, "e") +#> 2.5 % 97.5 % +#> e:(Intercept) 2.670526 3.445384 +``` diff --git a/docs/reference/cooks.distance.drc.html b/docs/reference/cooks.distance.drc.html new file mode 100644 index 00000000..6b8ae486 --- /dev/null +++ b/docs/reference/cooks.distance.drc.html @@ -0,0 +1,114 @@ + +Cook's distance for nonlinear dose-response models — cooks.distance.drc • drc + Skip to contents + + +
    +
    +
    +

    Cook's distance for nonlinear dose-response models

    + Source: R/cooks.distance.drc.R +
    cooks.distance.drc.Rd
    +
    + +
    +

    Cook's distance values are provided for nonlinear dose-response model fits using the +same formulas as in linear regression but based on the corresponding approximate quantities +available for nonlinear models.

    +
    + +
    +

    Usage

    + 
    # S3 method for class 'drc'
+cooks.distance(model, ...)
    +
    + +
    +

    Arguments

    + + +
    model
    +

    an object of class 'drc'.

    + + +
    ...
    +

    additional arguments (not used).

    + +
    +
    +

    Value

    +

    A vector of Cook's distance values, one value per observation.

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    + +
    +

    Examples

    + 
    ryegrass.LL.4 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4())
+
+cooks.distance(ryegrass.LL.4)
+#>            1            2            3            4            5            6 
+#> 7.453159e-03 7.044772e-03 4.714696e-02 4.844894e-02 2.870894e-02 4.723940e-03 
+#>            7            8            9           10           11           12 
+#> 6.453374e-02 4.817127e-02 3.034449e-03 1.086166e-01 1.026316e-03 1.159960e-01 
+#>           13           14           15           16           17           18 
+#> 6.500257e-01 1.505664e-02 6.990776e-01 8.318727e-03 1.370597e-03 1.649069e-03 
+#>           19           20           21           22           23           24 
+#> 3.231490e-03 6.070437e-05 1.244105e-02 1.159916e-02 1.468742e-02 4.949825e-04 
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/cooks.distance.drc.md b/docs/reference/cooks.distance.drc.md new file mode 100644 index 00000000..57fec22c --- /dev/null +++ b/docs/reference/cooks.distance.drc.md @@ -0,0 +1,46 @@ +# Cook's distance for nonlinear dose-response models + +Cook's distance values are provided for nonlinear dose-response model +fits using the same formulas as in linear regression but based on the +corresponding approximate quantities available for nonlinear models. + +## Usage + +``` r +# S3 method for class 'drc' +cooks.distance(model, ...) +``` + +## Arguments + +- model: + + an object of class 'drc'. + +- ...: + + additional arguments (not used). + +## Value + +A vector of Cook's distance values, one value per observation. + +## Author + +Christian Ritz + +## Examples + +``` r +ryegrass.LL.4 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + +cooks.distance(ryegrass.LL.4) +#> 1 2 3 4 5 6 +#> 7.453159e-03 7.044772e-03 4.714696e-02 4.844894e-02 2.870894e-02 4.723940e-03 +#> 7 8 9 10 11 12 +#> 6.453374e-02 4.817127e-02 3.034449e-03 1.086166e-01 1.026316e-03 1.159960e-01 +#> 13 14 15 16 17 18 +#> 6.500257e-01 1.505664e-02 6.990776e-01 8.318727e-03 1.370597e-03 1.649069e-03 +#> 19 20 21 22 23 24 +#> 3.231490e-03 6.070437e-05 1.244105e-02 1.159916e-02 1.468742e-02 4.949825e-04 +``` diff --git a/docs/reference/createsifct.html b/docs/reference/createsifct.html new file mode 100644 index 00000000..6503fa8b --- /dev/null +++ b/docs/reference/createsifct.html @@ -0,0 +1,70 @@ + +Create selectivity index function — createsifct • drc + Skip to contents + + +
    +
    +
    +

    Create selectivity index function

    + Source: R/EDcomp.R +
    createsifct.Rd
    +
    + +
    +

    Create selectivity index function

    +
    + +
    +

    Usage

    + 
    createsifct(edfct, logBase = NULL, fls = FALSE, indexMat, lenCoef)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/createsifct.md b/docs/reference/createsifct.md new file mode 100644 index 00000000..bbdf513a --- /dev/null +++ b/docs/reference/createsifct.md @@ -0,0 +1,9 @@ +# Create selectivity index function + +Create selectivity index function + +## Usage + +``` r +createsifct(edfct, logBase = NULL, fls = FALSE, indexMat, lenCoef) +``` diff --git a/docs/reference/ctb-1.png b/docs/reference/ctb-1.png new file mode 100644 index 00000000..8aaeb006 Binary files /dev/null and b/docs/reference/ctb-1.png differ diff --git a/docs/reference/ctb.html b/docs/reference/ctb.html new file mode 100644 index 00000000..c6852bca --- /dev/null +++ b/docs/reference/ctb.html @@ -0,0 +1,130 @@ + +CellTiter-Blue Cell Viability Assay Data — ctb • drc + Skip to contents + + +
    +
    +
    +

    CellTiter-Blue Cell Viability Assay Data

    + +
    ctb.Rd
    +
    + +
    +

    Neurotoxicity test using the CellTiter-Blue Cell Viability + Assay on SH-SY5Y cells for increasing concentrations of acrylamide.

    +
    + +
    +

    Usage

    + 
    data(ctb)
    +
    + +
    +

    Format

    +

    A data frame with 647 observations on the following 5 variables.

    well
    +

    well ID of a 96 well plate

    + +
    conc
    +

    12 concentrations of acrylamide, ranging from + 0-500mM

    + +
    fluorescence
    +

    measured fluorescence after adding the + resazurin reagent into the wells

    + +
    day
    +

    integer denoting 3 different days

    + +
    plate
    +

    factor with 7 levels representing the plate ID

    + + +
    +
    +

    References

    +

    Frimat, JP, Sisnaiske, J, Subbiah, S, Menne, H, Godoy, P, Lampen, P, + Leist, M, Franzke, J, Hengstler, JG, van Thriel, C, West, J. The + network formation assay: a spatially standardized neurite outgrowth + analytical display for neurotoxicity screening. Lab Chip 2010; 10:701-709.

    +
    + +
    +

    Examples

    + 
    data(ctb)
+ctb$day <- as.factor(ctb$day)
+
+## Fit a four-parameter log-logistic model
+ctb.m1 <- drm(fluorescence ~ conc, data = ctb, fct = LL.4())
+summary(ctb.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                 Estimate Std. Error t-value   p-value    
+#> b:(Intercept)    1.38280    0.18094  7.6423 7.777e-14 ***
+#> c:(Intercept)   -5.87847   62.69971 -0.0938    0.9253    
+#> d:(Intercept) 2018.73268   36.19882 55.7679 < 2.2e-16 ***
+#> e:(Intercept)    5.40830    0.65619  8.2420 9.203e-16 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  625.4192 (643 degrees of freedom)
+plot(ctb.m1, main = "CTB dose-response")
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/ctb.md b/docs/reference/ctb.md new file mode 100644 index 00000000..783bcb3b --- /dev/null +++ b/docs/reference/ctb.md @@ -0,0 +1,70 @@ +# CellTiter-Blue Cell Viability Assay Data + +Neurotoxicity test using the CellTiter-Blue Cell Viability Assay on +SH-SY5Y cells for increasing concentrations of acrylamide. + +## Usage + +``` r +data(ctb) +``` + +## Format + +A data frame with 647 observations on the following 5 variables. + +- `well`: + + well ID of a 96 well plate + +- `conc`: + + 12 concentrations of acrylamide, ranging from 0-500mM + +- `fluorescence`: + + measured fluorescence after adding the resazurin reagent into the + wells + +- `day`: + + integer denoting 3 different days + +- `plate`: + + factor with 7 levels representing the plate ID + +## References + +Frimat, JP, Sisnaiske, J, Subbiah, S, Menne, H, Godoy, P, Lampen, P, +Leist, M, Franzke, J, Hengstler, JG, van Thriel, C, West, J. The network +formation assay: a spatially standardized neurite outgrowth analytical +display for neurotoxicity screening. Lab Chip 2010; 10:701-709. + +## Examples + +``` r +data(ctb) +ctb$day <- as.factor(ctb$day) + +## Fit a four-parameter log-logistic model +ctb.m1 <- drm(fluorescence ~ conc, data = ctb, fct = LL.4()) +summary(ctb.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 1.38280 0.18094 7.6423 7.777e-14 *** +#> c:(Intercept) -5.87847 62.69971 -0.0938 0.9253 +#> d:(Intercept) 2018.73268 36.19882 55.7679 < 2.2e-16 *** +#> e:(Intercept) 5.40830 0.65619 8.2420 9.203e-16 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 625.4192 (643 degrees of freedom) +plot(ctb.m1, main = "CTB dose-response") +``` diff --git a/docs/reference/daphnids-1.png b/docs/reference/daphnids-1.png new file mode 100644 index 00000000..30cfd806 Binary files /dev/null and b/docs/reference/daphnids-1.png differ diff --git a/docs/reference/daphnids-2.png b/docs/reference/daphnids-2.png new file mode 100644 index 00000000..69b003ea Binary files /dev/null and b/docs/reference/daphnids-2.png differ diff --git a/docs/reference/daphnids.html b/docs/reference/daphnids.html new file mode 100644 index 00000000..127231e1 --- /dev/null +++ b/docs/reference/daphnids.html @@ -0,0 +1,171 @@ + +Daphnia test — daphnids • drc + Skip to contents + + +
    +
    +
    +

    Daphnia test

    + +
    daphnids.Rd
    +
    + +
    +

    The number of immobile daphnids –in contrast to mobile daphnids– out of a total of 20 daphnids was counted + for several concentrations of a toxic substance.

    +
    + +
    +

    Usage

    + 
    data(daphnids)
    +
    + +
    +

    Format

    +

    A data frame with 16 observations on the following 4 variables.

    dose
    +

    a numeric vector

    + +
    no
    +

    a numeric vector

    + +
    total
    +

    a numeric vector

    + +
    time
    +

    a factor with levels 24h 48h

    + + +
    +
    +

    Details

    +

    The same daphnids were counted at 24h and later again at 48h.

    +
    +
    +

    Source

    +

    Nina Cedergreen, Faculty of Life Sciences, University of Copenhagen, Denmark.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Fitting a model with different parameters
+## for different curves
+daphnids.m1 <- drm( data = daphnids, no/total~dose, 
+                    curveid = time, weights = total, 
+                    fct = LL.2(), type = "binomial" )
+
+## plot models
+plot(daphnids.m1, ylim = c(0, 1),
+     xlab = "Dose (µg/L)", ylab = "Proportion of daphnids affected", 
+     main = "Model with different parameters for different curves")
+
+
+## Goodness-of-fit test
+modelFit(daphnids.m1)
+#> Goodness-of-fit test
+#> 
+#>             Df Chisq value p value
+#>                                   
+#> DRC model   12      13.873  0.3089
+
+## Summary of the data
+summary(daphnids.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>         Estimate Std. Error t-value   p-value    
+#> b:24h   -1.17384    0.22236 -5.2791 1.298e-07 ***
+#> b:48h   -1.84968    0.27922 -6.6244 3.488e-11 ***
+#> e:24h 5134.03344 1056.74197  4.8584 1.184e-06 ***
+#> e:48h 1509.06539  187.76008  8.0372 9.037e-16 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+## Fitting a model with a common intercept parameter
+daphnids.m2 <- drm(no/total~dose, curveid = time, weights = total, 
+                   data = daphnids, fct = LL.2(), type = "binomial", 
+                   pmodels = list(~1, ~time))
+
+## plot models
+plot(daphnids.m2, ylim = c(0, 1),
+     xlab = "Dose (µg/L)", ylab = "Proportion of daphnids affected", 
+     main = "Models with common intercept parameter")
+
+
+## Goodness-of-fit test
+modelFit(daphnids.m2)
+#> Goodness-of-fit test
+#> 
+#>             Df Chisq value p value
+#>                                   
+#> DRC model   13       17.63  0.1721
+
+## Summary of the data
+summary(daphnids.m2)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                  Estimate  Std. Error t-value   p-value    
+#> b:(Intercept)    -1.49926     0.17345 -8.6436 < 2.2e-16 ***
+#> e:(Intercept)  4614.39264   708.09425  6.5166 7.190e-11 ***
+#> e:time48h     -3122.47346   741.26254 -4.2124 2.527e-05 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/daphnids.md b/docs/reference/daphnids.md new file mode 100644 index 00000000..47762ad7 --- /dev/null +++ b/docs/reference/daphnids.md @@ -0,0 +1,114 @@ +# Daphnia test + +The number of immobile daphnids –in contrast to mobile daphnids– out of +a total of 20 daphnids was counted for several concentrations of a toxic +substance. + +## Usage + +``` r +data(daphnids) +``` + +## Format + +A data frame with 16 observations on the following 4 variables. + +- `dose`: + + a numeric vector + +- `no`: + + a numeric vector + +- `total`: + + a numeric vector + +- `time`: + + a factor with levels `24h` `48h` + +## Details + +The same daphnids were counted at 24h and later again at 48h. + +## Source + +Nina Cedergreen, Faculty of Life Sciences, University of Copenhagen, +Denmark. + +## Examples + +``` r +library(drc) + +## Fitting a model with different parameters +## for different curves +daphnids.m1 <- drm( data = daphnids, no/total~dose, + curveid = time, weights = total, + fct = LL.2(), type = "binomial" ) + +## plot models +plot(daphnids.m1, ylim = c(0, 1), + xlab = "Dose (µg/L)", ylab = "Proportion of daphnids affected", + main = "Model with different parameters for different curves") + + +## Goodness-of-fit test +modelFit(daphnids.m1) +#> Goodness-of-fit test +#> +#> Df Chisq value p value +#> +#> DRC model 12 13.873 0.3089 + +## Summary of the data +summary(daphnids.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:24h -1.17384 0.22236 -5.2791 1.298e-07 *** +#> b:48h -1.84968 0.27922 -6.6244 3.488e-11 *** +#> e:24h 5134.03344 1056.74197 4.8584 1.184e-06 *** +#> e:48h 1509.06539 187.76008 8.0372 9.037e-16 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 + +## Fitting a model with a common intercept parameter +daphnids.m2 <- drm(no/total~dose, curveid = time, weights = total, + data = daphnids, fct = LL.2(), type = "binomial", + pmodels = list(~1, ~time)) + +## plot models +plot(daphnids.m2, ylim = c(0, 1), + xlab = "Dose (µg/L)", ylab = "Proportion of daphnids affected", + main = "Models with common intercept parameter") + + +## Goodness-of-fit test +modelFit(daphnids.m2) +#> Goodness-of-fit test +#> +#> Df Chisq value p value +#> +#> DRC model 13 17.63 0.1721 + +## Summary of the data +summary(daphnids.m2) +#> +#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) -1.49926 0.17345 -8.6436 < 2.2e-16 *** +#> e:(Intercept) 4614.39264 708.09425 6.5166 7.190e-11 *** +#> e:time48h -3122.47346 741.26254 -4.2124 2.527e-05 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +``` diff --git a/docs/reference/decontaminants-1.png b/docs/reference/decontaminants-1.png new file mode 100644 index 00000000..d0eccd75 Binary files /dev/null and b/docs/reference/decontaminants-1.png differ diff --git a/docs/reference/decontaminants.html b/docs/reference/decontaminants.html new file mode 100644 index 00000000..c4b02940 --- /dev/null +++ b/docs/reference/decontaminants.html @@ -0,0 +1,144 @@ + +Performance of decontaminants used in the culturing of a micro-organism — decontaminants • drc + Skip to contents + + +
    +
    +
    +

    Performance of decontaminants used in the culturing of a micro-organism

    + +
    decontaminants.Rd
    +
    + +
    +

    The two decontaminants 1-hexadecylpyridium chloride and oxalic acid were used. Additionally there was a control group (coded as concentration 0 and only included under oxalic acid).

    +
    + +
    +

    Usage

    + 
    data("decontaminants")
    +
    + +
    +

    Format

    +

    A data frame with 128 observations on the following 3 variables.

    conc
    +

    a numeric vector of percentage weight per volume

    + +
    count
    +

    a numeric vector of numbers of M. bovis colonies at stationarity

    + +
    group
    +

    a factor with levels hpc and oxalic of the decontaminants used

    + + +
    +
    +

    Details

    +

    These data examplify Wadley's problem: counts where the maximum number is not known. The data were analyzed by Trajstman (1989) using a three-parameter logistic model and then re-analyzed by Morgan and Smith (1992) using a three-parameter Weibull type II model. In both cases the authors adjusted for overdispersion (in different ways).

    +

    It seems that Morgan and Smith (1992) fitted separate models for the two decontaminants and using the control group for both model fits. In the example below a joint model is fitted where the control group is used once to determine a shared upper limit at concentration 0.

    +
    +
    +

    Source

    +

    Trajstman, A. C. (1989) Indices for Comparing Decontaminants when Data Come from Dose-Response Survival and Contamination Experiments, Applied Statistics, 38, 481–494.

    +
    +
    +

    References

    +

    Morgan, B. J. T. and Smith, D. M. (1992) A Note on Wadley's Problem with Overdispersion, Applied Statistics, 41, 349–354.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Wadley's problem using a three-parameter log-logistic model
+decon.LL.3.1 <- drm(count~conc, group, data = decontaminants, fct = LL.3(), 
+type = "Poisson", pmodels = list(~group, ~1, ~group))
+
+summary(decon.LL.3.1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                Estimate Std. Error t-value   p-value    
+#> b:(Intercept)  1.271354   0.085497 14.8701 < 2.2e-16 ***
+#> b:groupoxalic -0.749995   0.096745 -7.7523 9.065e-15 ***
+#> d:(Intercept) 48.949356   1.162320 42.1135 < 2.2e-16 ***
+#> e:(Intercept)  0.161718   0.011732 13.7844 < 2.2e-16 ***
+#> e:groupoxalic  0.346414   0.109110  3.1749  0.001499 ** 
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+plot(decon.LL.3.1)
+
+
+
+## Same model fit in another parameterization (no intercepts)
+decon.LL.3.2 <- drm(count~conc, group, data = decontaminants, fct=LL.3(), 
+type = "Poisson", pmodels = list(~group-1, ~1, ~group-1))
+
+summary(decon.LL.3.2)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                Estimate Std. Error t-value   p-value    
+#> b:grouphpc     1.271766   0.085523 14.8705 < 2.2e-16 ***
+#> b:groupoxalic  0.521354   0.059869  8.7083 < 2.2e-16 ***
+#> d:(Intercept) 48.953173   1.162656 42.1046 < 2.2e-16 ***
+#> e:grouphpc     0.161766   0.011737 13.7825 < 2.2e-16 ***
+#> e:groupoxalic  0.507902   0.113149  4.4888 7.162e-06 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/decontaminants.md b/docs/reference/decontaminants.md new file mode 100644 index 00000000..4a75ef71 --- /dev/null +++ b/docs/reference/decontaminants.md @@ -0,0 +1,99 @@ +# Performance of decontaminants used in the culturing of a micro-organism + +The two decontaminants 1-hexadecylpyridium chloride and oxalic acid were +used. Additionally there was a control group (coded as concentration 0 +and only included under oxalic acid). + +## Usage + +``` r +data("decontaminants") +``` + +## Format + +A data frame with 128 observations on the following 3 variables. + +- `conc`: + + a numeric vector of percentage weight per volume + +- `count`: + + a numeric vector of numbers of M. bovis colonies at stationarity + +- `group`: + + a factor with levels `hpc` and `oxalic` of the decontaminants used + +## Details + +These data examplify Wadley's problem: counts where the maximum number +is not known. The data were analyzed by Trajstman (1989) using a +three-parameter logistic model and then re-analyzed by Morgan and Smith +(1992) using a three-parameter Weibull type II model. In both cases the +authors adjusted for overdispersion (in different ways). + +It seems that Morgan and Smith (1992) fitted separate models for the two +decontaminants and using the control group for both model fits. In the +example below a joint model is fitted where the control group is used +once to determine a shared upper limit at concentration 0. + +## Source + +Trajstman, A. C. (1989) Indices for Comparing Decontaminants when Data +Come from Dose-Response Survival and Contamination Experiments, *Applied +Statistics*, **38**, 481–494. + +## References + +Morgan, B. J. T. and Smith, D. M. (1992) A Note on Wadley's Problem with +Overdispersion, *Applied Statistics*, **41**, 349–354. + +## Examples + +``` r +library(drc) + +## Wadley's problem using a three-parameter log-logistic model +decon.LL.3.1 <- drm(count~conc, group, data = decontaminants, fct = LL.3(), +type = "Poisson", pmodels = list(~group, ~1, ~group)) + +summary(decon.LL.3.1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 1.271354 0.085497 14.8701 < 2.2e-16 *** +#> b:groupoxalic -0.749995 0.096745 -7.7523 9.065e-15 *** +#> d:(Intercept) 48.949356 1.162320 42.1135 < 2.2e-16 *** +#> e:(Intercept) 0.161718 0.011732 13.7844 < 2.2e-16 *** +#> e:groupoxalic 0.346414 0.109110 3.1749 0.001499 ** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 + +plot(decon.LL.3.1) + + + +## Same model fit in another parameterization (no intercepts) +decon.LL.3.2 <- drm(count~conc, group, data = decontaminants, fct=LL.3(), +type = "Poisson", pmodels = list(~group-1, ~1, ~group-1)) + +summary(decon.LL.3.2) +#> +#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:grouphpc 1.271766 0.085523 14.8705 < 2.2e-16 *** +#> b:groupoxalic 0.521354 0.059869 8.7083 < 2.2e-16 *** +#> d:(Intercept) 48.953173 1.162656 42.1046 < 2.2e-16 *** +#> e:grouphpc 0.161766 0.011737 13.7825 < 2.2e-16 *** +#> e:groupoxalic 0.507902 0.113149 4.4888 7.162e-06 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +``` diff --git a/docs/reference/deguelin-1.png b/docs/reference/deguelin-1.png new file mode 100644 index 00000000..5d61b255 Binary files /dev/null and b/docs/reference/deguelin-1.png differ diff --git a/docs/reference/deguelin.html b/docs/reference/deguelin.html new file mode 100644 index 00000000..f24df4f9 --- /dev/null +++ b/docs/reference/deguelin.html @@ -0,0 +1,141 @@ + +Deguelin applied to chrysanthemum aphis — deguelin • drc + Skip to contents + + +
    +
    +
    +

    Deguelin applied to chrysanthemum aphis

    + +
    deguelin.Rd
    +
    + +
    +

    Quantal assay data from an experiment where the insectide deguelin was applied to + Macrosiphoniella sanborni.

    +
    + +
    +

    Usage

    + 
    data(deguelin)
    +
    + +
    +

    Format

    +

    A data frame with 6 observations on the following 4 variables.

    dose
    +

    a numeric vector of doses applied

    + +
    log10dose
    +

    a numeric vector of logarithm-transformed doses

    + +
    r
    +

    a numeric vector contained number of dead insects

    + +
    n
    +

    a numeric vector contained the total number of insects

    + + +
    +
    +

    Details

    +

    The log-logistic model provides an inadequate fit.

    +

    The dataset is used in Nottingham and Birch (2000) to illustrate a semiparametric approach to dose-response + modelling.

    +
    +
    +

    Source

    +

    Morgan, B. J. T. (1992) Analysis of Quantal Response Data, London: Chapman & Hall/CRC (Table 3.9, p. 117).

    +
    +
    +

    References

    +

    Notttingham, Q. J. and Birch, J. B. (2000) A semiparametric approach to analysing dose-response data, Statist. Med., 19, 389–404.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Log-logistic fit
+deguelin.m1 <- drm(r/n~dose, weights=n, data=deguelin, fct=LL.2(), type="binomial")
+modelFit(deguelin.m1)
+#> Goodness-of-fit test
+#> 
+#>             Df Chisq value p value
+#>                                   
+#> DRC model    4      13.375  0.0096
+summary(deguelin.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept) -1.93709    0.22390 -8.6514 < 2.2e-16 ***
+#> e:(Intercept)  9.95219    0.92186 10.7958 < 2.2e-16 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+## Loess fit
+deguelin.m2 <- loess(r/n~dose, data=deguelin, degree=1)
+
+## Plot of data with fits superimposed
+plot(deguelin.m1, ylim=c(0.2,1))
+lines(1:60, predict(deguelin.m2, newdata=data.frame(dose=1:60)), col = 2, lty = 2)
+
+lines(1:60, 0.95*predict(deguelin.m2, 
+newdata=data.frame(dose=1:60))+0.05*predict(deguelin.m1, newdata=data.frame(dose=1:60), se = FALSE),
+col = 3, lty=3)
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/deguelin.md b/docs/reference/deguelin.md new file mode 100644 index 00000000..b0138c38 --- /dev/null +++ b/docs/reference/deguelin.md @@ -0,0 +1,84 @@ +# Deguelin applied to chrysanthemum aphis + +Quantal assay data from an experiment where the insectide deguelin was +applied to *Macrosiphoniella sanborni*. + +## Usage + +``` r +data(deguelin) +``` + +## Format + +A data frame with 6 observations on the following 4 variables. + +- `dose`: + + a numeric vector of doses applied + +- `log10dose`: + + a numeric vector of logarithm-transformed doses + +- `r`: + + a numeric vector contained number of dead insects + +- `n`: + + a numeric vector contained the total number of insects + +## Details + +The log-logistic model provides an inadequate fit. + +The dataset is used in Nottingham and Birch (2000) to illustrate a +semiparametric approach to dose-response modelling. + +## Source + +Morgan, B. J. T. (1992) *Analysis of Quantal Response Data*, London: +Chapman & Hall/CRC (Table 3.9, p. 117). + +## References + +Notttingham, Q. J. and Birch, J. B. (2000) A semiparametric approach to +analysing dose-response data, *Statist. Med.*, **19**, 389–404. + +## Examples + +``` r +library(drc) + +## Log-logistic fit +deguelin.m1 <- drm(r/n~dose, weights=n, data=deguelin, fct=LL.2(), type="binomial") +modelFit(deguelin.m1) +#> Goodness-of-fit test +#> +#> Df Chisq value p value +#> +#> DRC model 4 13.375 0.0096 +summary(deguelin.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) -1.93709 0.22390 -8.6514 < 2.2e-16 *** +#> e:(Intercept) 9.95219 0.92186 10.7958 < 2.2e-16 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 + +## Loess fit +deguelin.m2 <- loess(r/n~dose, data=deguelin, degree=1) + +## Plot of data with fits superimposed +plot(deguelin.m1, ylim=c(0.2,1)) +lines(1:60, predict(deguelin.m2, newdata=data.frame(dose=1:60)), col = 2, lty = 2) + +lines(1:60, 0.95*predict(deguelin.m2, +newdata=data.frame(dose=1:60))+0.05*predict(deguelin.m1, newdata=data.frame(dose=1:60), se = FALSE), +col = 3, lty=3) +``` diff --git a/docs/reference/divAtInf.html b/docs/reference/divAtInf.html new file mode 100644 index 00000000..da9516b0 --- /dev/null +++ b/docs/reference/divAtInf.html @@ -0,0 +1,70 @@ + +Helper functions for x*log(x) calculations — divAtInf • drc + Skip to contents + + +
    +
    +
    +

    Helper functions for x*log(x) calculations

    + Source: R/xlogx.R +
    divAtInf.Rd
    +
    + +
    +

    Helper functions for x*log(x) calculations

    +
    + +
    +

    Usage

    + 
    divAtInf(x, y)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/divAtInf.md b/docs/reference/divAtInf.md new file mode 100644 index 00000000..7f733bf9 --- /dev/null +++ b/docs/reference/divAtInf.md @@ -0,0 +1,9 @@ +# Helper functions for x\*log(x) calculations + +Helper functions for x\*log(x) calculations + +## Usage + +``` r +divAtInf(x, y) +``` diff --git a/docs/reference/dot-onAttach.html b/docs/reference/dot-onAttach.html new file mode 100644 index 00000000..5d1eabb4 --- /dev/null +++ b/docs/reference/dot-onAttach.html @@ -0,0 +1,70 @@ + +Package attach hook — .onAttach • drc + Skip to contents + + +
    +
    +
    +

    Package attach hook

    + Source: R/onAttach.R +
    dot-onAttach.Rd
    +
    + +
    +

    Package attach hook

    +
    + +
    +

    Usage

    + 
    .onAttach(libname, pkgname)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/dot-onAttach.md b/docs/reference/dot-onAttach.md new file mode 100644 index 00000000..424f3cc1 --- /dev/null +++ b/docs/reference/dot-onAttach.md @@ -0,0 +1,9 @@ +# Package attach hook + +Package attach hook + +## Usage + +``` r +.onAttach(libname, pkgname) +``` diff --git a/docs/reference/drc-package.html b/docs/reference/drc-package.html new file mode 100644 index 00000000..958e0548 --- /dev/null +++ b/docs/reference/drc-package.html @@ -0,0 +1,86 @@ + +drc: Analysis of Dose-Response Data — drc-package • drc + Skip to contents + + +
    +
    +
    +

    drc: Analysis of Dose-Response Data

    + Source: R/drc-package.R +
    drc-package.Rd
    +
    + +
    +

    +

    Analysis of dose-response data is made available through a suite of flexible and versatile model fitting and after-fitting functions.

    +
    + + +
    +

    See also

    +

    Useful links:

    +
    +
    +

    Author

    +

    Maintainer: Hannes Reinwald hannes.reinwald@bayer.com

    +

    Authors:

    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/drc-package.md b/docs/reference/drc-package.md new file mode 100644 index 00000000..561f652b --- /dev/null +++ b/docs/reference/drc-package.md @@ -0,0 +1,30 @@ +# drc: Analysis of Dose-Response Data + +Analysis of dose-response data is made available through a suite of +flexible and versatile model fitting and after-fitting functions. + +## See also + +Useful links: + +- + +- + +- + +- + +- + +- Report bugs at + +## Author + +**Maintainer**: Hannes Reinwald + +Authors: + +- Christian Ritz + +- Jens C. Streibig diff --git a/docs/reference/drc.html b/docs/reference/drc.html new file mode 100644 index 00000000..bcdc1826 --- /dev/null +++ b/docs/reference/drc.html @@ -0,0 +1,8 @@ + + + + + + + + diff --git a/docs/reference/drm.html b/docs/reference/drm.html index a150faa9..cc4014c9 100644 --- a/docs/reference/drm.html +++ b/docs/reference/drm.html @@ -1,275 +1,250 @@ - - - - - - +Fitting dose-response models — drm • drc + Skip to contents -Fitting dose-response models — drm • drc - - - +
    +
    +
    +

    Fitting dose-response models

    + Source: R/drm.R +
    drm.Rd
    +
    - +
    +

    A general model fitting function for analysis of various types of dose-response data.

    +
    - - +
    +

    Usage

    + 
    drm(
+  formula,
+  curveid,
+  pmodels,
+  weights,
+  data = NULL,
+  subset,
+  fct,
+  type = c("continuous", "binomial", "Poisson", "negbin1", "negbin2", "event", "ssd"),
+  bcVal = NULL,
+  bcAdd = 0,
+  start,
+  na.action = na.omit,
+  robust = "mean",
+  logDose = NULL,
+  control = drmc(),
+  lowerl = NULL,
+  upperl = NULL,
+  separate = FALSE,
+  pshifts = NULL,
+  varcov = NULL
+)
    +
    +
    +

    Arguments

    - - +
    formula
    +

    a symbolic description of the model to be fit. Either of the form +response ~ dose or as a data frame with response values in first column and dose +values in second column.

    - +
    curveid
    +

    a numeric vector or factor containing the grouping of the data.

    - - -
    -
    - - - -
    -
    -
    -
    -

    Fitting dose-response models

    - - -
    +
    weights
    +

    a numeric vector containing weights. For continuous/quantitative responses, +inverse weights are multiplied inside the squared errors (weights should have the same unit +as the response). For binomial responses weights provide information about the total number +of binary observations used to obtain the response.

    -
    - -

    A general model fitting function for analysis of concentration/dose/time-effect/response data.

    - -
    - 
    drm(formula, curveid, pmodels, weights, data = NULL, subset, fct,
-  type = c("continuous", "binomial", "Poisson", "negbin1", "negbin2", "event", "ssd"),
-  bcVal = NULL, bcAdd = 0,
-  start, na.action = na.omit, robust = "mean", logDose = NULL,
-  control = drmc(), lowerl = NULL, upperl = NULL, separate = FALSE, pshifts = NULL)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    formula

    a symbolic description of the model to be fit. Either of the form 'response \(~\) dose' - or as a data frame with response values in first column and dose values in second column.

    curveid

    a numeric vector or factor containing the grouping of the data.

    pmodels

    a data frame with a many columns as there are parameters in the non-linear function. - Or a list containing a formula for each parameter in the nonlinear function.

    weights

    a numeric vector containing weights. For continuous/quantitative responses weights are multiplied inside the squared errors (see the details below). - For binomial reponses weights provide information about the total number of binary observations used to obtain the response (which is a proportion): - 1/2 and 10/20 lead to different analyses due to the different totals (2 vs. 20) even though the proportion in both cases is 0.5.

    data

    an optional data frame containing the variables in the model.

    subset

    an optional vector specifying a subset of observations to be used in the fitting process.

    fct

    a list with three or more elements specifying the non-linear - function, the accompanying self starter function, the names of the parameter in the non-linear function and, - optionally, the first and second derivatives as well as information used for calculation of ED values. - Currently available functions include, among others, the four- and five-parameter log-logistic models - LL.4, LL.5 and the Weibull model W1.4. Use - getMeanFunctions for a full list.

    type

    a character string specifying the distribution of the data (parameter estimation will depend on the assumed distribution as different log likelihood functions will be used). - The default is "continuous", corresponding to assuming a normal distribution. The choices "binary" and "event" imply a binomial and multinomial distribution, respectively. The choice "ssd" is for fitting a species sensitivity - distribution.

    bcVal

    a numeric value specifying the lambda parameter to be used in the Box-Cox transformation.

    bcAdd

    a numeric value specifying the constant to be added on both sides prior to Box-Cox transformation. - The default is 0.

    start

    an optional numeric vector containing starting values for all mean parameters in the model. - Overrules any self starter function.

    na.action

    a function for treating mising values ('NA's). Default is na.omit.

    robust

    a character string specifying the rho function for robust estimation. Default is non-robust - least squares estimation ("mean"). Available robust methods are: median estimation ("median"), - least median of squares ("lms"), least trimmed squares ("lts"), metric trimming ("trimmed"), - metric winsorizing ("winsor") and Tukey's biweight ("tukey").

    logDose

    a numeric value or NULL. If log doses value are provided the base of the logarithm should be specified (exp(1) for the natural logarithm - and 10 for 10-logarithm).

    control

    a list of arguments controlling constrained optimisation (zero as boundary), - maximum number of iteration in the optimisation, - relative tolerance in the optimisation, warnings issued during the optimisation.

    lowerl

    a numeric vector of lower limits for all parameters in the model - (the default corresponds to minus infinity for all parameters).

    upperl

    a numeric vector of upper limits for all parameters in the model - (the default corresponds to plus infinity for all parameters).

    separate

    logical value indicating whether curves should be fit separately (independent of each other).

    pshifts

    a matrix of constants to be added to the matrix of parameters. Default is no shift for all parameters.

    - -

    Details

    - -

    This function relies on the general optimiser function optim for the minimisation of negative log likelihood function. - For a continuous response this reduces to least squares estimation, which is carried out by minimising the following sums of squares

    -

    $$\sum_{i=1}^N [w_i (y_i-f_i)]^2$$

    -

    where \(y_i\), \(f_i\), and \(w_i\) correspond to the observed value, expected value, and the weight respectively, for the ith observation (from 1 to \(N\)).

    -

    The control arguments are specified using the function drmc.

    -

    Setting lowerl and/or upperl automatically invokes constrained optimisation.

    -

    The columns of a data frame argument to pmodels are automatically converted into factors. - This does not happen if a list is specified.

    - -

    Value

    - -

    An object of class 'drc'.

    - -

    Note

    - -

    - - -

    -

    For robust estimation MAD (median abslolute deviance) is used to estimate the residual variance.

    -

    - -

    - +
    data
    +

    an optional data frame containing the variables in the model.

    -
    - -
    +
    fct
    +

    a list with three or more elements specifying the non-linear function, the +accompanying self starter function, the names of the parameters in the non-linear function +and, optionally, the first and second derivatives as well as information used for +calculation of ED values. Use getMeanFunctions for a full list.

    + + +
    type
    +

    a character string specifying the distribution of the data. The default is +"continuous", corresponding to a normal distribution. Other choices include +"binomial", "Poisson", "negbin1", "negbin2", "event", +and "ssd".

    + + +
    bcVal
    +

    a numeric value specifying the lambda parameter to be used in the Box-Cox +transformation.

    + + +
    bcAdd
    +

    a numeric value specifying the constant to be added on both sides prior to +Box-Cox transformation. The default is 0.

    + + +
    start
    +

    an optional numeric vector containing starting values for all mean parameters +in the model. Overrules any self starter function.

    + + +
    na.action
    +

    a function for treating missing values (NAs). Default is +na.omit.

    + + +
    robust
    +

    a character string specifying the rho function for robust estimation. +Default is non-robust least squares estimation ("mean"). Available robust methods +are: "median", "lms", "lts", "trimmed", "winsor", and +"tukey".

    + -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    logDose
    +

    a numeric value or NULL. If log dose values are provided the base of +the logarithm should be specified (e.g., exp(1) for natural logarithm, 10 +for base 10).

    + + +
    control
    +

    a list of arguments controlling constrained optimisation, maximum iterations, +relative tolerance, and warnings. See drmc.

    + + +
    lowerl
    +

    a numeric vector of lower limits for all parameters in the model (the default +corresponds to minus infinity for all parameters).

    + + +
    upperl
    +

    a numeric vector of upper limits for all parameters in the model (the default +corresponds to plus infinity for all parameters).

    + + +
    separate
    +

    logical value indicating whether curves should be fit separately +(independent of each other).

    + + +
    pshifts
    +

    a matrix of constants to be added to the matrix of parameters. Default is no +shift for all parameters.

    + + +
    varcov
    +

    an optional user-defined known variance-covariance matrix for the responses. +Default is the identity matrix (NULL), corresponding to independent response values +with a common standard deviation estimated from the data.

    + +
    +
    +

    Value

    +

    An object of (S3) class "drc".

    +
    +
    +

    Details

    +

    This function relies on optim for minimisation of the negative log +likelihood function. For a continuous response this reduces to least squares estimation. +Response values are assumed to be mutually independent unless varcov is specified. +For robust estimation MAD (median absolute deviance) is used to estimate the residual +variance. Setting lowerl and/or upperl automatically invokes constrained +optimisation. Control arguments may be specified using drmc.

    +
    +
    +

    See also

    +

    drmc, LL.4, getMeanFunctions

    +
    +
    +

    Author

    +

    Christian Ritz, Jens C. Streibig and Hannes Reinwald

    +
    + +
    +

    Examples

    + 
    ## Fitting a four-parameter log-logistic model to the ryegrass data
+model <- drm(rootl ~ conc, data = ryegrass, fct = LL.4())
+summary(model)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept)  2.98222    0.46506  6.4125 2.960e-06 ***
+#> c:(Intercept)  0.48141    0.21219  2.2688   0.03451 *  
+#> d:(Intercept)  7.79296    0.18857 41.3272 < 2.2e-16 ***
+#> e:(Intercept)  3.05795    0.18573 16.4644 4.268e-13 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.5196256 (20 degrees of freedom)
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -

    Site built with pkgdown.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -
    + + + + - - - + diff --git a/docs/reference/drm.md b/docs/reference/drm.md new file mode 100644 index 00000000..167b973f --- /dev/null +++ b/docs/reference/drm.md @@ -0,0 +1,199 @@ +# Fitting dose-response models + +A general model fitting function for analysis of various types of +dose-response data. + +## Usage + +``` r +drm( + formula, + curveid, + pmodels, + weights, + data = NULL, + subset, + fct, + type = c("continuous", "binomial", "Poisson", "negbin1", "negbin2", "event", "ssd"), + bcVal = NULL, + bcAdd = 0, + start, + na.action = na.omit, + robust = "mean", + logDose = NULL, + control = drmc(), + lowerl = NULL, + upperl = NULL, + separate = FALSE, + pshifts = NULL, + varcov = NULL +) +``` + +## Arguments + +- formula: + + a symbolic description of the model to be fit. Either of the form + `response ~ dose` or as a data frame with response values in first + column and dose values in second column. + +- curveid: + + a numeric vector or factor containing the grouping of the data. + +- pmodels: + + a data frame with as many columns as there are parameters in the + non-linear function. Or a list containing a formula for each parameter + in the nonlinear function. + +- weights: + + a numeric vector containing weights. For continuous/quantitative + responses, inverse weights are multiplied inside the squared errors + (weights should have the same unit as the response). For binomial + responses weights provide information about the total number of binary + observations used to obtain the response. + +- data: + + an optional data frame containing the variables in the model. + +- subset: + + an optional vector specifying a subset of observations to be used in + the fitting process. + +- fct: + + a list with three or more elements specifying the non-linear function, + the accompanying self starter function, the names of the parameters in + the non-linear function and, optionally, the first and second + derivatives as well as information used for calculation of ED values. + Use + [`getMeanFunctions`](https://hreinwald.github.io/drc/reference/getMeanFunctions.md) + for a full list. + +- type: + + a character string specifying the distribution of the data. The + default is `"continuous"`, corresponding to a normal distribution. + Other choices include `"binomial"`, `"Poisson"`, `"negbin1"`, + `"negbin2"`, `"event"`, and `"ssd"`. + +- bcVal: + + a numeric value specifying the lambda parameter to be used in the + Box-Cox transformation. + +- bcAdd: + + a numeric value specifying the constant to be added on both sides + prior to Box-Cox transformation. The default is 0. + +- start: + + an optional numeric vector containing starting values for all mean + parameters in the model. Overrules any self starter function. + +- na.action: + + a function for treating missing values (`NA`s). Default is + [`na.omit`](https://rdrr.io/r/stats/na.fail.html). + +- robust: + + a character string specifying the rho function for robust estimation. + Default is non-robust least squares estimation (`"mean"`). Available + robust methods are: `"median"`, `"lms"`, `"lts"`, `"trimmed"`, + `"winsor"`, and `"tukey"`. + +- logDose: + + a numeric value or `NULL`. If log dose values are provided the base of + the logarithm should be specified (e.g., `exp(1)` for natural + logarithm, `10` for base 10). + +- control: + + a list of arguments controlling constrained optimisation, maximum + iterations, relative tolerance, and warnings. See + [`drmc`](https://hreinwald.github.io/drc/reference/drmc.md). + +- lowerl: + + a numeric vector of lower limits for all parameters in the model (the + default corresponds to minus infinity for all parameters). + +- upperl: + + a numeric vector of upper limits for all parameters in the model (the + default corresponds to plus infinity for all parameters). + +- separate: + + logical value indicating whether curves should be fit separately + (independent of each other). + +- pshifts: + + a matrix of constants to be added to the matrix of parameters. Default + is no shift for all parameters. + +- varcov: + + an optional user-defined known variance-covariance matrix for the + responses. Default is the identity matrix (`NULL`), corresponding to + independent response values with a common standard deviation estimated + from the data. + +## Value + +An object of (S3) class `"drc"`. + +## Details + +This function relies on [`optim`](https://rdrr.io/r/stats/optim.html) +for minimisation of the negative log likelihood function. For a +continuous response this reduces to least squares estimation. Response +values are assumed to be mutually independent unless `varcov` is +specified. For robust estimation MAD (median absolute deviance) is used +to estimate the residual variance. Setting `lowerl` and/or `upperl` +automatically invokes constrained optimisation. Control arguments may be +specified using +[`drmc`](https://hreinwald.github.io/drc/reference/drmc.md). + +## See also + +[`drmc`](https://hreinwald.github.io/drc/reference/drmc.md), +[`LL.4`](https://hreinwald.github.io/drc/reference/LL.4.md), +[`getMeanFunctions`](https://hreinwald.github.io/drc/reference/getMeanFunctions.md) + +## Author + +Christian Ritz, Jens C. Streibig and Hannes Reinwald + +## Examples + +``` r +## Fitting a four-parameter log-logistic model to the ryegrass data +model <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +summary(model) +#> +#> Model fitted: Log-logistic (ED50 as parameter) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 2.98222 0.46506 6.4125 2.960e-06 *** +#> c:(Intercept) 0.48141 0.21219 2.2688 0.03451 * +#> d:(Intercept) 7.79296 0.18857 41.3272 < 2.2e-16 *** +#> e:(Intercept) 3.05795 0.18573 16.4644 4.268e-13 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.5196256 (20 degrees of freedom) +``` diff --git a/docs/reference/drmConvertParm.html b/docs/reference/drmConvertParm.html new file mode 100644 index 00000000..172113e2 --- /dev/null +++ b/docs/reference/drmConvertParm.html @@ -0,0 +1,70 @@ + +Convert parameter vectors to matrices — drmConvertParm • drc + Skip to contents + + +
    +
    +
    +

    Convert parameter vectors to matrices

    + Source: R/drmConvertParm.R +
    drmConvertParm.Rd
    +
    + +
    +

    Convert parameter vectors to matrices

    +
    + +
    +

    Usage

    + 
    drmConvertParm(startVec, startMat, factor1, colList)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/drmConvertParm.md b/docs/reference/drmConvertParm.md new file mode 100644 index 00000000..8de2c3d1 --- /dev/null +++ b/docs/reference/drmConvertParm.md @@ -0,0 +1,9 @@ +# Convert parameter vectors to matrices + +Convert parameter vectors to matrices + +## Usage + +``` r +drmConvertParm(startVec, startMat, factor1, colList) +``` diff --git a/docs/reference/drmEMbinomial.html b/docs/reference/drmEMbinomial.html new file mode 100644 index 00000000..124b89db --- /dev/null +++ b/docs/reference/drmEMbinomial.html @@ -0,0 +1,81 @@ + +EM algorithm for binomial response — drmEMbinomial • drc + Skip to contents + + +
    +
    +
    +

    EM algorithm for binomial response

    + Source: R/drmEMbinomial.R +
    drmEMbinomial.Rd
    +
    + +
    +

    EM algorithm for binomial response

    +
    + +
    +

    Usage

    + 
    drmEMbinomial(
+  dose,
+  resp,
+  multCurves,
+  startVec,
+  robustFct,
+  weights,
+  rmNA,
+  zeroTol = 1e-12,
+  doseScaling = 1,
+  respScaling = 1
+)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/drmEMbinomial.md b/docs/reference/drmEMbinomial.md new file mode 100644 index 00000000..5972e231 --- /dev/null +++ b/docs/reference/drmEMbinomial.md @@ -0,0 +1,20 @@ +# EM algorithm for binomial response + +EM algorithm for binomial response + +## Usage + +``` r +drmEMbinomial( + dose, + resp, + multCurves, + startVec, + robustFct, + weights, + rmNA, + zeroTol = 1e-12, + doseScaling = 1, + respScaling = 1 +) +``` diff --git a/docs/reference/drmEMls.html b/docs/reference/drmEMls.html new file mode 100644 index 00000000..ff7bc365 --- /dev/null +++ b/docs/reference/drmEMls.html @@ -0,0 +1,82 @@ + +EM algorithm for least squares — drmEMls • drc + Skip to contents + + +
    +
    +
    +

    EM algorithm for least squares

    + Source: R/drmEMls.R +
    drmEMls.Rd
    +
    + +
    +

    EM algorithm for least squares

    +
    + +
    +

    Usage

    + 
    drmEMls(
+  dose,
+  resp,
+  multCurves,
+  startVec,
+  robustFct,
+  weights,
+  rmNA,
+  dmf = NULL,
+  doseScaling = 1,
+  respScaling = 1,
+  varcov = NULL
+)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/drmEMls.md b/docs/reference/drmEMls.md new file mode 100644 index 00000000..47b6ac09 --- /dev/null +++ b/docs/reference/drmEMls.md @@ -0,0 +1,21 @@ +# EM algorithm for least squares + +EM algorithm for least squares + +## Usage + +``` r +drmEMls( + dose, + resp, + multCurves, + startVec, + robustFct, + weights, + rmNA, + dmf = NULL, + doseScaling = 1, + respScaling = 1, + varcov = NULL +) +``` diff --git a/docs/reference/drmLOFPoisson.html b/docs/reference/drmLOFPoisson.html new file mode 100644 index 00000000..6017fbeb --- /dev/null +++ b/docs/reference/drmLOFPoisson.html @@ -0,0 +1,70 @@ + +EM algorithm for Poisson response — drmLOFPoisson • drc + Skip to contents + + +
    +
    +
    +

    EM algorithm for Poisson response

    + Source: R/drmEMPoisson.R +
    drmLOFPoisson.Rd
    +
    + +
    +

    EM algorithm for Poisson response

    +
    + +
    +

    Usage

    + 
    drmLOFPoisson()
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/drmLOFPoisson.md b/docs/reference/drmLOFPoisson.md new file mode 100644 index 00000000..6ec81d46 --- /dev/null +++ b/docs/reference/drmLOFPoisson.md @@ -0,0 +1,9 @@ +# EM algorithm for Poisson response + +EM algorithm for Poisson response + +## Usage + +``` r +drmLOFPoisson() +``` diff --git a/docs/reference/drmLOFbinomial.html b/docs/reference/drmLOFbinomial.html new file mode 100644 index 00000000..deae6345 --- /dev/null +++ b/docs/reference/drmLOFbinomial.html @@ -0,0 +1,70 @@ + +Lack-of-fit test for binomial response — drmLOFbinomial • drc + Skip to contents + + +
    +
    +
    +

    Lack-of-fit test for binomial response

    + Source: R/drmLOFbinomial.R +
    drmLOFbinomial.Rd
    +
    + +
    +

    Lack-of-fit test for binomial response

    +
    + +
    +

    Usage

    + 
    drmLOFbinomial()
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/drmLOFbinomial.md b/docs/reference/drmLOFbinomial.md new file mode 100644 index 00000000..78948dc6 --- /dev/null +++ b/docs/reference/drmLOFbinomial.md @@ -0,0 +1,9 @@ +# Lack-of-fit test for binomial response + +Lack-of-fit test for binomial response + +## Usage + +``` r +drmLOFbinomial() +``` diff --git a/docs/reference/drmLOFeventtime.html b/docs/reference/drmLOFeventtime.html new file mode 100644 index 00000000..0ce2bf32 --- /dev/null +++ b/docs/reference/drmLOFeventtime.html @@ -0,0 +1,70 @@ + +EM algorithm for event time data — drmLOFeventtime • drc + Skip to contents + + +
    +
    +
    +

    EM algorithm for event time data

    + Source: R/drmEMeventtime.R +
    drmLOFeventtime.Rd
    +
    + +
    +

    EM algorithm for event time data

    +
    + +
    +

    Usage

    + 
    drmLOFeventtime()
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/drmLOFeventtime.md b/docs/reference/drmLOFeventtime.md new file mode 100644 index 00000000..5cede74a --- /dev/null +++ b/docs/reference/drmLOFeventtime.md @@ -0,0 +1,9 @@ +# EM algorithm for event time data + +EM algorithm for event time data + +## Usage + +``` r +drmLOFeventtime() +``` diff --git a/docs/reference/drmLOFls.html b/docs/reference/drmLOFls.html new file mode 100644 index 00000000..eae40370 --- /dev/null +++ b/docs/reference/drmLOFls.html @@ -0,0 +1,70 @@ + +Lack-of-fit test for least squares — drmLOFls • drc + Skip to contents + + +
    +
    +
    +

    Lack-of-fit test for least squares

    + Source: R/drmLOFls.R +
    drmLOFls.Rd
    +
    + +
    +

    Lack-of-fit test for least squares

    +
    + +
    +

    Usage

    + 
    drmLOFls()
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/drmLOFls.md b/docs/reference/drmLOFls.md new file mode 100644 index 00000000..6a6b2823 --- /dev/null +++ b/docs/reference/drmLOFls.md @@ -0,0 +1,9 @@ +# Lack-of-fit test for least squares + +Lack-of-fit test for least squares + +## Usage + +``` r +drmLOFls() +``` diff --git a/docs/reference/drmLOFnegbin.html b/docs/reference/drmLOFnegbin.html new file mode 100644 index 00000000..31566716 --- /dev/null +++ b/docs/reference/drmLOFnegbin.html @@ -0,0 +1,70 @@ + +EM algorithm for negative binomial — drmLOFnegbin • drc + Skip to contents + + +
    +
    +
    +

    EM algorithm for negative binomial

    + Source: R/drmEMnegbin.R +
    drmLOFnegbin.Rd
    +
    + +
    +

    EM algorithm for negative binomial

    +
    + +
    +

    Usage

    + 
    drmLOFnegbin()
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/drmLOFnegbin.md b/docs/reference/drmLOFnegbin.md new file mode 100644 index 00000000..61e18952 --- /dev/null +++ b/docs/reference/drmLOFnegbin.md @@ -0,0 +1,9 @@ +# EM algorithm for negative binomial + +EM algorithm for negative binomial + +## Usage + +``` r +drmLOFnegbin() +``` diff --git a/docs/reference/drmLOFssd.html b/docs/reference/drmLOFssd.html new file mode 100644 index 00000000..d3193ce5 --- /dev/null +++ b/docs/reference/drmLOFssd.html @@ -0,0 +1,70 @@ + +EM algorithm for species sensitivity distribution — drmLOFssd • drc + Skip to contents + + +
    +
    +
    +

    EM algorithm for species sensitivity distribution

    + Source: R/drmEMssd.R +
    drmLOFssd.Rd
    +
    + +
    +

    EM algorithm for species sensitivity distribution

    +
    + +
    +

    Usage

    + 
    drmLOFssd()
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/drmLOFssd.md b/docs/reference/drmLOFssd.md new file mode 100644 index 00000000..f8bc1460 --- /dev/null +++ b/docs/reference/drmLOFssd.md @@ -0,0 +1,9 @@ +# EM algorithm for species sensitivity distribution + +EM algorithm for species sensitivity distribution + +## Usage + +``` r +drmLOFssd() +``` diff --git a/docs/reference/drmLOFstandard.html b/docs/reference/drmLOFstandard.html new file mode 100644 index 00000000..1444944b --- /dev/null +++ b/docs/reference/drmLOFstandard.html @@ -0,0 +1,70 @@ + +Standard EM algorithm — drmLOFstandard • drc + Skip to contents + + +
    +
    +
    +

    Standard EM algorithm

    + Source: R/drmEMstandard.R +
    drmLOFstandard.Rd
    +
    + +
    +

    Standard EM algorithm

    +
    + +
    +

    Usage

    + 
    drmLOFstandard()
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/drmLOFstandard.md b/docs/reference/drmLOFstandard.md new file mode 100644 index 00000000..3f702ce1 --- /dev/null +++ b/docs/reference/drmLOFstandard.md @@ -0,0 +1,9 @@ +# Standard EM algorithm + +Standard EM algorithm + +## Usage + +``` r +drmLOFstandard() +``` diff --git a/docs/reference/drmOpt.html b/docs/reference/drmOpt.html new file mode 100644 index 00000000..5abee16d --- /dev/null +++ b/docs/reference/drmOpt.html @@ -0,0 +1,87 @@ + +Optimisation wrapper for drm — drmOpt • drc + Skip to contents + + +
    +
    +
    +

    Optimisation wrapper for drm

    + Source: R/drmOpt.R +
    drmOpt.Rd
    +
    + +
    +

    Optimisation wrapper for drm

    +
    + +
    +

    Usage

    + 
    drmOpt(
+  opfct,
+  opdfct1,
+  startVec,
+  optMethod,
+  constrained,
+  warnVal,
+  upperLimits,
+  lowerLimits,
+  errorMessage,
+  maxIt,
+  relTol,
+  opdfct2 = NULL,
+  parmVec,
+  traceVal,
+  silentVal = TRUE,
+  matchCall
+)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/drmOpt.md b/docs/reference/drmOpt.md new file mode 100644 index 00000000..7d5649ea --- /dev/null +++ b/docs/reference/drmOpt.md @@ -0,0 +1,26 @@ +# Optimisation wrapper for drm + +Optimisation wrapper for drm + +## Usage + +``` r +drmOpt( + opfct, + opdfct1, + startVec, + optMethod, + constrained, + warnVal, + upperLimits, + lowerLimits, + errorMessage, + maxIt, + relTol, + opdfct2 = NULL, + parmVec, + traceVal, + silentVal = TRUE, + matchCall +) +``` diff --git a/docs/reference/drmPNsplit.html b/docs/reference/drmPNsplit.html new file mode 100644 index 00000000..799b2caa --- /dev/null +++ b/docs/reference/drmPNsplit.html @@ -0,0 +1,70 @@ + +Split parameter names — drmPNsplit • drc + Skip to contents + + +
    +
    +
    +

    Split parameter names

    + Source: R/drmPNsplit.R +
    drmPNsplit.Rd
    +
    + +
    +

    Split parameter names

    +
    + +
    +

    Usage

    + 
    drmPNsplit(parmVec, sep)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/drmPNsplit.md b/docs/reference/drmPNsplit.md new file mode 100644 index 00000000..4b67c5be --- /dev/null +++ b/docs/reference/drmPNsplit.md @@ -0,0 +1,9 @@ +# Split parameter names + +Split parameter names + +## Usage + +``` r +drmPNsplit(parmVec, sep) +``` diff --git a/docs/reference/drmParNames.html b/docs/reference/drmParNames.html new file mode 100644 index 00000000..a37b828f --- /dev/null +++ b/docs/reference/drmParNames.html @@ -0,0 +1,76 @@ + +Generate parameter names for drm — drmParNames • drc + Skip to contents + + +
    +
    +
    +

    Generate parameter names for drm

    + Source: R/drmParNames.R +
    drmParNames.Rd
    +
    + +
    +

    Generate parameter names for drm

    +
    + +
    +

    Usage

    + 
    drmParNames(
+  numNames,
+  parNames,
+  collapseList2,
+  repStr1 = "factor(pmodels[, i])",
+  repStr2 = "factor(assayNo)"
+)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/drmParNames.md b/docs/reference/drmParNames.md new file mode 100644 index 00000000..a4c6173f --- /dev/null +++ b/docs/reference/drmParNames.md @@ -0,0 +1,15 @@ +# Generate parameter names for drm + +Generate parameter names for drm + +## Usage + +``` r +drmParNames( + numNames, + parNames, + collapseList2, + repStr1 = "factor(pmodels[, i])", + repStr2 = "factor(assayNo)" +) +``` diff --git a/docs/reference/drmRobust.html b/docs/reference/drmRobust.html new file mode 100644 index 00000000..0403c2bb --- /dev/null +++ b/docs/reference/drmRobust.html @@ -0,0 +1,70 @@ + +Robust estimation functions for drm — drmRobust • drc + Skip to contents + + +
    +
    +
    +

    Robust estimation functions for drm

    + Source: R/drmRobust.R +
    drmRobust.Rd
    +
    + +
    +

    Robust estimation functions for drm

    +
    + +
    +

    Usage

    + 
    drmRobust(robust, fctCall, lenData, lenPar)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/drmRobust.md b/docs/reference/drmRobust.md new file mode 100644 index 00000000..18768474 --- /dev/null +++ b/docs/reference/drmRobust.md @@ -0,0 +1,9 @@ +# Robust estimation functions for drm + +Robust estimation functions for drm + +## Usage + +``` r +drmRobust(robust, fctCall, lenData, lenPar) +``` diff --git a/docs/reference/drm_legacy.html b/docs/reference/drm_legacy.html new file mode 100644 index 00000000..6577cada --- /dev/null +++ b/docs/reference/drm_legacy.html @@ -0,0 +1,219 @@ + +Legacy dose-response model fitting (internal) — drm_legacy • drc + Skip to contents + + +
    +
    +
    +

    Legacy dose-response model fitting (internal)

    + Source: R/drm_legacy.R +
    drm_legacy.Rd
    +
    + +
    +

    This is the legacy implementation of the dose-response model fitting function. +It is kept only as an internal reference point in case questions or errors +might occur with the current drm() implementation.

    +
    + +
    +

    Usage

    + 
    drm_legacy(
+  formula,
+  curveid,
+  pmodels,
+  weights,
+  data = NULL,
+  subset,
+  fct,
+  type = c("continuous", "binomial", "Poisson", "negbin1", "negbin2", "event", "ssd"),
+  bcVal = NULL,
+  bcAdd = 0,
+  start,
+  na.action = na.omit,
+  robust = "mean",
+  logDose = NULL,
+  control = drmc(),
+  lowerl = NULL,
+  upperl = NULL,
+  separate = FALSE,
+  pshifts = NULL,
+  varcov = NULL
+)
    +
    + +
    +

    Arguments

    + + +
    formula
    +

    a symbolic description of the model to be fit. Either of the form +response ~ dose or as a data frame with response values in first column and dose +values in second column.

    + + +
    curveid
    +

    a numeric vector or factor containing the grouping of the data.

    + + +
    pmodels
    +

    a data frame with as many columns as there are parameters in the non-linear +function. Or a list containing a formula for each parameter in the nonlinear function.

    + + +
    weights
    +

    a numeric vector containing weights. For continuous/quantitative responses, +inverse weights are multiplied inside the squared errors (weights should have the same unit +as the response). For binomial responses weights provide information about the total number +of binary observations used to obtain the response.

    + + +
    data
    +

    an optional data frame containing the variables in the model.

    + + +
    subset
    +

    an optional vector specifying a subset of observations to be used in the +fitting process.

    + + +
    fct
    +

    a list with three or more elements specifying the non-linear function, the +accompanying self starter function, the names of the parameters in the non-linear function +and, optionally, the first and second derivatives as well as information used for +calculation of ED values. Use getMeanFunctions for a full list.

    + + +
    type
    +

    a character string specifying the distribution of the data. The default is +"continuous", corresponding to a normal distribution. Other choices include +"binomial", "Poisson", "negbin1", "negbin2", "event", +and "ssd".

    + + +
    bcVal
    +

    a numeric value specifying the lambda parameter to be used in the Box-Cox +transformation.

    + + +
    bcAdd
    +

    a numeric value specifying the constant to be added on both sides prior to +Box-Cox transformation. The default is 0.

    + + +
    start
    +

    an optional numeric vector containing starting values for all mean parameters +in the model. Overrules any self starter function.

    + + +
    na.action
    +

    a function for treating missing values (NAs). Default is +na.omit.

    + + +
    robust
    +

    a character string specifying the rho function for robust estimation. +Default is non-robust least squares estimation ("mean"). Available robust methods +are: "median", "lms", "lts", "trimmed", "winsor", and +"tukey".

    + + +
    logDose
    +

    a numeric value or NULL. If log dose values are provided the base of +the logarithm should be specified (e.g., exp(1) for natural logarithm, 10 +for base 10).

    + + +
    control
    +

    a list of arguments controlling constrained optimisation, maximum iterations, +relative tolerance, and warnings. See drmc.

    + + +
    lowerl
    +

    a numeric vector of lower limits for all parameters in the model (the default +corresponds to minus infinity for all parameters).

    + + +
    upperl
    +

    a numeric vector of upper limits for all parameters in the model (the default +corresponds to plus infinity for all parameters).

    + + +
    separate
    +

    logical value indicating whether curves should be fit separately +(independent of each other).

    + + +
    pshifts
    +

    a matrix of constants to be added to the matrix of parameters. Default is no +shift for all parameters.

    + + +
    varcov
    +

    an optional user-defined known variance-covariance matrix for the responses. +Default is the identity matrix (NULL), corresponding to independent response values +with a common standard deviation estimated from the data.

    + +
    +
    +

    Value

    +

    An object of (S3) class "drc".

    +
    +
    +

    See also

    +

    drm() for the current implementation.

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/drm_legacy.md b/docs/reference/drm_legacy.md new file mode 100644 index 00000000..13b6c58d --- /dev/null +++ b/docs/reference/drm_legacy.md @@ -0,0 +1,161 @@ +# Legacy dose-response model fitting (internal) + +This is the legacy implementation of the dose-response model fitting +function. It is kept only as an internal reference point in case +questions or errors might occur with the current +[`drm()`](https://hreinwald.github.io/drc/reference/drm.md) +implementation. + +## Usage + +``` r +drm_legacy( + formula, + curveid, + pmodels, + weights, + data = NULL, + subset, + fct, + type = c("continuous", "binomial", "Poisson", "negbin1", "negbin2", "event", "ssd"), + bcVal = NULL, + bcAdd = 0, + start, + na.action = na.omit, + robust = "mean", + logDose = NULL, + control = drmc(), + lowerl = NULL, + upperl = NULL, + separate = FALSE, + pshifts = NULL, + varcov = NULL +) +``` + +## Arguments + +- formula: + + a symbolic description of the model to be fit. Either of the form + `response ~ dose` or as a data frame with response values in first + column and dose values in second column. + +- curveid: + + a numeric vector or factor containing the grouping of the data. + +- pmodels: + + a data frame with as many columns as there are parameters in the + non-linear function. Or a list containing a formula for each parameter + in the nonlinear function. + +- weights: + + a numeric vector containing weights. For continuous/quantitative + responses, inverse weights are multiplied inside the squared errors + (weights should have the same unit as the response). For binomial + responses weights provide information about the total number of binary + observations used to obtain the response. + +- data: + + an optional data frame containing the variables in the model. + +- subset: + + an optional vector specifying a subset of observations to be used in + the fitting process. + +- fct: + + a list with three or more elements specifying the non-linear function, + the accompanying self starter function, the names of the parameters in + the non-linear function and, optionally, the first and second + derivatives as well as information used for calculation of ED values. + Use + [`getMeanFunctions`](https://hreinwald.github.io/drc/reference/getMeanFunctions.md) + for a full list. + +- type: + + a character string specifying the distribution of the data. The + default is `"continuous"`, corresponding to a normal distribution. + Other choices include `"binomial"`, `"Poisson"`, `"negbin1"`, + `"negbin2"`, `"event"`, and `"ssd"`. + +- bcVal: + + a numeric value specifying the lambda parameter to be used in the + Box-Cox transformation. + +- bcAdd: + + a numeric value specifying the constant to be added on both sides + prior to Box-Cox transformation. The default is 0. + +- start: + + an optional numeric vector containing starting values for all mean + parameters in the model. Overrules any self starter function. + +- na.action: + + a function for treating missing values (`NA`s). Default is + [`na.omit`](https://rdrr.io/r/stats/na.fail.html). + +- robust: + + a character string specifying the rho function for robust estimation. + Default is non-robust least squares estimation (`"mean"`). Available + robust methods are: `"median"`, `"lms"`, `"lts"`, `"trimmed"`, + `"winsor"`, and `"tukey"`. + +- logDose: + + a numeric value or `NULL`. If log dose values are provided the base of + the logarithm should be specified (e.g., `exp(1)` for natural + logarithm, `10` for base 10). + +- control: + + a list of arguments controlling constrained optimisation, maximum + iterations, relative tolerance, and warnings. See + [`drmc`](https://hreinwald.github.io/drc/reference/drmc.md). + +- lowerl: + + a numeric vector of lower limits for all parameters in the model (the + default corresponds to minus infinity for all parameters). + +- upperl: + + a numeric vector of upper limits for all parameters in the model (the + default corresponds to plus infinity for all parameters). + +- separate: + + logical value indicating whether curves should be fit separately + (independent of each other). + +- pshifts: + + a matrix of constants to be added to the matrix of parameters. Default + is no shift for all parameters. + +- varcov: + + an optional user-defined known variance-covariance matrix for the + responses. Default is the identity matrix (`NULL`), corresponding to + independent response values with a common standard deviation estimated + from the data. + +## Value + +An object of (S3) class `"drc"`. + +## See also + +[`drm()`](https://hreinwald.github.io/drc/reference/drm.md) for the +current implementation. diff --git a/docs/reference/drmc.html b/docs/reference/drmc.html index fdec1471..0dfa9ae4 100644 --- a/docs/reference/drmc.html +++ b/docs/reference/drmc.html @@ -1,270 +1,221 @@ - - - - - - +Sets control arguments — drmc • drc + Skip to contents -Sets control arguments — drmc • drc - - - +
    +
    +
    +

    Sets control arguments

    + Source: R/drmc.R +
    drmc.Rd
    +
    - +
    +

    Set control arguments in the control argument in the function drm.

    +
    - - +
    +

    Usage

    + 
    drmc(
+  constr = FALSE,
+  errorm = TRUE,
+  maxIt = 500,
+  method = "BFGS",
+  noMessage = FALSE,
+  relTol = 1e-10,
+  rmNA = FALSE,
+  useD = FALSE,
+  trace = FALSE,
+  otrace = FALSE,
+  warnVal = -1,
+  dscaleThres = 1e-15,
+  rscaleThres = 1e-15,
+  conCheck = TRUE
+)
    +
    +
    +

    Arguments

    - - +
    constr
    +

    logical. If TRUE optimisation is constrained, only yielding non-negative +parameters.

    - +
    errorm
    +

    logical specifying whether failed convergence in drm should +result in an error or only a warning.

    - - -
    -
    - - - -
    -
    -
    -
    -

    Sets control arguments

    - - +
    method
    +

    character string. The method used in the optimisation procedure. See +optim for available methods.

    + + +
    noMessage
    +

    logical, specifying whether or not messages should be displayed.

    + + +
    relTol
    +

    numeric. The relative tolerance in the optimisation procedure. A tighter +tolerance (smaller value) improves cross-platform reproducibility of results by ensuring +the optimiser converges closer to the true optimum regardless of platform-specific +floating-point behaviour. Default is 1e-10.

    + + +
    rmNA
    +

    logical. Should NAs be removed from sum of squares used for estimation? +Default is FALSE (not removed).

    + + +
    useD
    +

    logical. If TRUE derivatives are used for estimation (if available).

    + + +
    trace
    +

    logical. If TRUE the trace from optim is displayed.

    + + +
    otrace
    +

    logical. If TRUE error messages from the optimisation are displayed.

    + + +
    warnVal
    +

    numeric. If equal to 0 then the warnings are stored and displayed at the end. +See under ‘warn’ in options. The default results in suppression of +warnings.

    + + +
    dscaleThres
    +

    numeric value specifying the threshold for dose scaling.

    + + +
    rscaleThres
    +

    numeric value specifying the threshold for response scaling.

    + + +
    conCheck
    +

    logical, switching on/off handling of control measurements.

    + +
    +
    +

    Value

    +

    A list with components corresponding to each of the above arguments.

    +
    +
    +

    See also

    +

    drm, optim

    +
    +
    +

    Author

    +

    Christian Ritz

    -
    - -

    Set control arguments in the control argument in the function 'drm'.

    - +
    +

    Examples

    + 
    ## Displaying the default settings
+drmc()
+#> $constr
+#> [1] FALSE
+#> 
+#> $errorm
+#> [1] TRUE
+#> 
+#> $maxIt
+#> [1] 500
+#> 
+#> $method
+#> [1] "BFGS"
+#> 
+#> $noMessage
+#> [1] FALSE
+#> 
+#> $relTol
+#> [1] 1e-07
+#> 
+#> $rmNA
+#> [1] FALSE
+#> 
+#> $useD
+#> [1] FALSE
+#> 
+#> $trace
+#> [1] FALSE
+#> 
+#> $otrace
+#> [1] FALSE
+#> 
+#> $warnVal
+#> [1] -1
+#> 
+#> $dscaleThres
+#> [1] 1e-15
+#> 
+#> $rscaleThres
+#> [1] 1e-15
+#> 
+#> $conCheck
+#> [1] TRUE
+#> 
+
+## Using the 'method' argument
+model1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4())
+model2 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4(),
+  control = drmc(method = "Nelder-Mead"))
+
+
    +
    - 
    drmc(constr = FALSE, errorm = TRUE, maxIt = 500, method="BFGS",
-  noMessage = FALSE, relTol = 1e-07, rmNA=FALSE, useD = FALSE,
-  trace = FALSE, otrace = FALSE, warnVal = -1, dscaleThres = 1e-15, rscaleThres = 1e-15,
-  conCheck = TRUE)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    constr

    logical. If TRUE optimisation is constrained, only yielding non-negative parameters.

    errorm

    logical specifying whether failed convergence in drm should result - in an error or only a warning.

    maxIt

    numeric. The maximum number of iterations in the optimisation procedure.

    method

    character string. The method used in the optimisation procedure. - See optim for available methods.

    noMessage

    logical, specifying whether or not messages should be displayed.

    relTol

    numeric. The relative tolerance in the optimisation procedure.

    rmNA

    logical. Should NAs be removed from sum of squares used for estimation? - Default is FALSE (not removed).

    useD

    logical. If TRUE derivatives are used for estimation (if available).

    trace

    logical. If TRUE the trace from optim is displayed.

    otrace

    logical. If TRUE the output from optim is displayed.

    warnVal

    numeric. If equal to 0 then the warnings are stored and displayed at the end. - See under 'warn' in options. The default results in suppression of warnings.

    dscaleThres

    numeric value specifying the threshold for dose scaling.

    rscaleThres

    numeric value specifying the threshold for response scaling.

    conCheck

    logical, switching on/off handling of control measurements.

    - -

    Value

    - -

    A list with 8 components, one for each of the above arguments.

    - -

    Note

    - -

    The use of a non-zero constant bcAdd may in some cases - make it more difficult to obtain convergence of the estimation procedure.

    - - -

    Examples

    - 
    
-### Displaying the default settings
-drmc()
    #> $constr
-#> [1] FALSE
-#> 
-#> $errorm
-#> [1] TRUE
-#> 
-#> $maxIt
-#> [1] 500
-#> 
-#> $method
-#> [1] "BFGS"
-#> 
-#> $noMessage
-#> [1] FALSE
-#> 
-#> $relTol
-#> [1] 1e-07
-#> 
-#> $rmNA
-#> [1] FALSE
-#> 
-#> $useD
-#> [1] FALSE
-#> 
-#> $trace
-#> [1] FALSE
-#> 
-#> $otrace
-#> [1] FALSE
-#> 
-#> $warnVal
-#> [1] -1
-#> 
-#> $dscaleThres
-#> [1] 1e-15
-#> 
-#> $rscaleThres
-#> [1] 1e-15
-#> 
-#> $conCheck
-#> [1] TRUE
-#> 
    
-### Using 'method' argument
-model1 <- drm(ryegrass, fct = LL.4())
-
-model2 <- drm(ryegrass, fct = LL.4(),
-control = drmc(method = "Nelder-Mead"))
    -
    - - -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -

    Site built with pkgdown.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -
    +
    + + + - - - + diff --git a/docs/reference/drmc.md b/docs/reference/drmc.md new file mode 100644 index 00000000..8ec55768 --- /dev/null +++ b/docs/reference/drmc.md @@ -0,0 +1,164 @@ +# Sets control arguments + +Set control arguments in the control argument in the function +[`drm`](https://hreinwald.github.io/drc/reference/drm.md). + +## Usage + +``` r +drmc( + constr = FALSE, + errorm = TRUE, + maxIt = 500, + method = "BFGS", + noMessage = FALSE, + relTol = 1e-10, + rmNA = FALSE, + useD = FALSE, + trace = FALSE, + otrace = FALSE, + warnVal = -1, + dscaleThres = 1e-15, + rscaleThres = 1e-15, + conCheck = TRUE +) +``` + +## Arguments + +- constr: + + logical. If `TRUE` optimisation is constrained, only yielding + non-negative parameters. + +- errorm: + + logical specifying whether failed convergence in + [`drm`](https://hreinwald.github.io/drc/reference/drm.md) should + result in an error or only a warning. + +- maxIt: + + numeric. The maximum number of iterations in the optimisation + procedure. + +- method: + + character string. The method used in the optimisation procedure. See + [`optim`](https://rdrr.io/r/stats/optim.html) for available methods. + +- noMessage: + + logical, specifying whether or not messages should be displayed. + +- relTol: + + numeric. The relative tolerance in the optimisation procedure. A + tighter tolerance (smaller value) improves cross-platform + reproducibility of results by ensuring the optimiser converges closer + to the true optimum regardless of platform-specific floating-point + behaviour. Default is `1e-10`. + +- rmNA: + + logical. Should `NA`s be removed from sum of squares used for + estimation? Default is `FALSE` (not removed). + +- useD: + + logical. If `TRUE` derivatives are used for estimation (if available). + +- trace: + + logical. If `TRUE` the trace from + [`optim`](https://rdrr.io/r/stats/optim.html) is displayed. + +- otrace: + + logical. If `TRUE` error messages from the optimisation are displayed. + +- warnVal: + + numeric. If equal to 0 then the warnings are stored and displayed at + the end. See under ‘warn’ in + [`options`](https://rdrr.io/r/base/options.html). The default results + in suppression of warnings. + +- dscaleThres: + + numeric value specifying the threshold for dose scaling. + +- rscaleThres: + + numeric value specifying the threshold for response scaling. + +- conCheck: + + logical, switching on/off handling of control measurements. + +## Value + +A list with components corresponding to each of the above arguments. + +## See also + +[`drm`](https://hreinwald.github.io/drc/reference/drm.md), +[`optim`](https://rdrr.io/r/stats/optim.html) + +## Author + +Christian Ritz + +## Examples + +``` r +## Displaying the default settings +drmc() +#> $constr +#> [1] FALSE +#> +#> $errorm +#> [1] TRUE +#> +#> $maxIt +#> [1] 500 +#> +#> $method +#> [1] "BFGS" +#> +#> $noMessage +#> [1] FALSE +#> +#> $relTol +#> [1] 1e-07 +#> +#> $rmNA +#> [1] FALSE +#> +#> $useD +#> [1] FALSE +#> +#> $trace +#> [1] FALSE +#> +#> $otrace +#> [1] FALSE +#> +#> $warnVal +#> [1] -1 +#> +#> $dscaleThres +#> [1] 1e-15 +#> +#> $rscaleThres +#> [1] 1e-15 +#> +#> $conCheck +#> [1] TRUE +#> + +## Using the 'method' argument +model1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +model2 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4(), + control = drmc(method = "Nelder-Mead")) +``` diff --git a/docs/reference/earthworms.html b/docs/reference/earthworms.html new file mode 100644 index 00000000..73f61267 --- /dev/null +++ b/docs/reference/earthworms.html @@ -0,0 +1,141 @@ + +Earthworm toxicity test — earthworms • drc + Skip to contents + + +
    +
    +
    +

    Earthworm toxicity test

    + +
    earthworms.Rd
    +
    + +
    +

    The dataset was obtained from a toxicity test using earthworms, and it contains the number of earthworms + remaining in a container that was contaminated with a toxic substance (not disclosed) at various doses; so the number of earthworms not migrating to the neighbouring uncontaminated container.

    +
    + +
    +

    Usage

    + 
    data(earthworms)
    +
    + +
    +

    Format

    +

    A data frame with 35 observations on the following 3 variables.

    dose
    +

    a numeric vector of dose values

    + +
    number
    +

    a numeric vector containing counts of remaining earthworms in the container

    + +
    total
    +

    a numeric vector containing total number of earthworms put in the containers

    + + +
    +
    +

    Details

    +

    At dose 0 around half of the earthworms is expected be in each of the two containers. Thus it is not + appropriate to fit an ordinary logistic regression with log(dose) as explanatory variable to these data + as it implies an upper limit of 1 at dose 0 and in fact this model does not utilise the observations + at dose 0 (see the example section below).

    +
    +
    +

    Source

    +

    The dataset is kindly provided by Nina Cedergreen, Faculty of Life Sciences, University of Copenhagen, + Denmark.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Fitting a logistic regression model
+earthworms.m1 <- drm(number/total~dose, weights = total, data = earthworms,
+fct = LL.2(), type = "binomial")
+modelFit(earthworms.m1)  # a crude goodness-of-fit test
+#> Goodness-of-fit test
+#> 
+#>             Df Chisq value p value
+#>                                   
+#> DRC model   28      35.236  0.1631
+
+## Fitting an extended logistic regression model 
+##  where the upper limit is estimated
+earthworms.m2 <- drm(number/total~dose, weights = total, data = earthworms,
+fct = LL.3(), type = "binomial")
+modelFit(earthworms.m2)  # goodness-of-fit test
+#> Goodness-of-fit test
+#> 
+#>             Df Chisq value p value
+#>                                   
+#> DRC model   32       43.13  0.0905
+# improvement not visible in test!!!
+
+## Comparing model1 and model2 
+## (Can the first model be reduced to the second model?)
+anova(earthworms.m1, earthworms.m2)
+#> 
+#> 1st model
+#>  fct:      LL.2()
+#> 2nd model
+#>  fct:      LL.3()
+#> 
+#> ANOVA-like table
+#> 
+#>           ModelDf  Loglik Df LR value p value
+#> 1st model       2 -347.55                    
+#> 2nd model       3  -36.16  1   622.79       0
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/earthworms.md b/docs/reference/earthworms.md new file mode 100644 index 00000000..716ee05d --- /dev/null +++ b/docs/reference/earthworms.md @@ -0,0 +1,87 @@ +# Earthworm toxicity test + +The dataset was obtained from a toxicity test using earthworms, and it +contains the number of earthworms remaining in a container that was +contaminated with a toxic substance (not disclosed) at various doses; so +the number of earthworms not migrating to the neighbouring +uncontaminated container. + +## Usage + +``` r +data(earthworms) +``` + +## Format + +A data frame with 35 observations on the following 3 variables. + +- `dose`: + + a numeric vector of dose values + +- `number`: + + a numeric vector containing counts of remaining earthworms in the + container + +- `total`: + + a numeric vector containing total number of earthworms put in the + containers + +## Details + +At dose 0 around half of the earthworms is expected be in each of the +two containers. Thus it is not appropriate to fit an ordinary logistic +regression with log(dose) as explanatory variable to these data as it +implies an upper limit of 1 at dose 0 and in fact this model does not +utilise the observations at dose 0 (see the example section below). + +## Source + +The dataset is kindly provided by Nina Cedergreen, Faculty of Life +Sciences, University of Copenhagen, Denmark. + +## Examples + +``` r +library(drc) + +## Fitting a logistic regression model +earthworms.m1 <- drm(number/total~dose, weights = total, data = earthworms, +fct = LL.2(), type = "binomial") +modelFit(earthworms.m1) # a crude goodness-of-fit test +#> Goodness-of-fit test +#> +#> Df Chisq value p value +#> +#> DRC model 28 35.236 0.1631 + +## Fitting an extended logistic regression model +## where the upper limit is estimated +earthworms.m2 <- drm(number/total~dose, weights = total, data = earthworms, +fct = LL.3(), type = "binomial") +modelFit(earthworms.m2) # goodness-of-fit test +#> Goodness-of-fit test +#> +#> Df Chisq value p value +#> +#> DRC model 32 43.13 0.0905 +# improvement not visible in test!!! + +## Comparing model1 and model2 +## (Can the first model be reduced to the second model?) +anova(earthworms.m1, earthworms.m2) +#> +#> 1st model +#> fct: LL.2() +#> 2nd model +#> fct: LL.3() +#> +#> ANOVA-like table +#> +#> ModelDf Loglik Df LR value p value +#> 1st model 2 -347.55 +#> 2nd model 3 -36.16 1 622.79 0 +``` diff --git a/docs/reference/echovirus-1.png b/docs/reference/echovirus-1.png new file mode 100644 index 00000000..cee60575 Binary files /dev/null and b/docs/reference/echovirus-1.png differ diff --git a/docs/reference/echovirus.html b/docs/reference/echovirus.html new file mode 100644 index 00000000..68c5086d --- /dev/null +++ b/docs/reference/echovirus.html @@ -0,0 +1,122 @@ + +Infections as response to exposure with Echovirus 12 — echovirus • drc + Skip to contents + + +
    +
    +
    +

    Infections as response to exposure with Echovirus 12

    + +
    echovirus.Rd
    +
    + +
    +

    For each of four doses of a pathogen, Echovirus 12, the number of exposed and infected human volunteers are reported.

    +
    + +
    +

    Usage

    + 
    data(echovirus)
    +
    + +
    +

    Format

    +

    A data frame with 4 observations on the following 3 variables.

    dose
    +

    a numeric vector reporting the dose in plague forming units (pfu)

    + +
    total
    +

    a numeric vector

    + +
    infected
    +

    a numeric vector

    + + +
    +
    +

    Source

    +

    H. Moon, S. B. Kim, J. J. Chen, N. I. George, and R. L. Kodell (2013). Model uncertainty +and model averaging in the estimation of infectious doses for microbial pathogens. Risk +Analysis, 33(2):220-231.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Displaying the data
+head(echovirus)
+#>    dose total infected
+#> 1   330    50       15
+#> 2  1000    20        9
+#> 3  3300    26       19
+#> 4 10000    12       12
+
+## Fitting a two-parameter log-logistic model for binomial response
+echovirus.m1 <- drm(infected/total ~ dose, weights = total,
+data = echovirus, fct = LL.2(), type = "binomial")
+summary(echovirus.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                Estimate Std. Error t-value   p-value    
+#> b:(Intercept)  -0.94621    0.20507 -4.6141 3.948e-06 ***
+#> e:(Intercept) 921.04805  215.00279  4.2839 1.837e-05 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+## Plotting the fitted curve
+plot(echovirus.m1, xlab = "Dose (pfu)", ylab = "Proportion infected")
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/echovirus.md b/docs/reference/echovirus.md new file mode 100644 index 00000000..f7a862e8 --- /dev/null +++ b/docs/reference/echovirus.md @@ -0,0 +1,64 @@ +# Infections as response to exposure with *Echovirus 12* + +For each of four doses of a pathogen, *Echovirus 12*, the number of +exposed and infected human volunteers are reported. + +## Usage + +``` r +data(echovirus) +``` + +## Format + +A data frame with 4 observations on the following 3 variables. + +- `dose`: + + a numeric vector reporting the dose in plague forming units (pfu) + +- `total`: + + a numeric vector + +- `infected`: + + a numeric vector + +## Source + +H. Moon, S. B. Kim, J. J. Chen, N. I. George, and R. L. Kodell (2013). +Model uncertainty and model averaging in the estimation of infectious +doses for microbial pathogens. Risk Analysis, **33(2)**:220-231. + +## Examples + +``` r +library(drc) + +## Displaying the data +head(echovirus) +#> dose total infected +#> 1 330 50 15 +#> 2 1000 20 9 +#> 3 3300 26 19 +#> 4 10000 12 12 + +## Fitting a two-parameter log-logistic model for binomial response +echovirus.m1 <- drm(infected/total ~ dose, weights = total, +data = echovirus, fct = LL.2(), type = "binomial") +summary(echovirus.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) -0.94621 0.20507 -4.6141 3.948e-06 *** +#> e:(Intercept) 921.04805 215.00279 4.2839 1.837e-05 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 + +## Plotting the fitted curve +plot(echovirus.m1, xlab = "Dose (pfu)", ylab = "Proportion infected") +``` diff --git a/docs/reference/estfun.drc.html b/docs/reference/estfun.drc.html new file mode 100644 index 00000000..4a14ee00 --- /dev/null +++ b/docs/reference/estfun.drc.html @@ -0,0 +1,123 @@ + +Estimating function for the sandwich estimator — estfun.drc • drc + Skip to contents + + +
    +
    +
    +

    Estimating function for the sandwich estimator

    + Source: R/sandwich.R +
    estfun.drc.Rd
    +
    + +
    +

    Evaluates the estimating function (the "meat") for the sandwich estimator of the +variance-covariance matrix for objects of class 'drc'.

    +
    + +
    +

    Usage

    + 
    # S3 method for class 'drc'
+estfun(x, ...)
    +
    + +
    +

    Arguments

    + + +
    x
    +

    object of class drc.

    + + +
    ...
    +

    additional arguments. At the moment none are supported.

    + +
    +
    +

    Value

    +

    The estimating function evaluated at the data and the parameter estimates. +By default no clustering is assumed, corresponding to robust standard errors +under independence.

    +
    +
    +

    Details

    +

    The details are provided by Zeileis (2006).

    +
    +
    +

    References

    +

    Zeileis, A. (2006) Object-oriented Computation of Sandwich Estimators, +J. Statist. Software, 16, Issue 9.

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    + +
    +

    Examples

    + 
    ## The lines below requires that the packages
+## 'lmtest' and 'sandwich' are installed
+# library(lmtest)
+# library(sandwich)
+
+# ryegrass.m1<-drm(rootl ~ conc, data = ryegrass, fct = LL.4())
+
+# Standard summary output
+# coeftest(ryegrass.m1)
+
+# Output with robust standard errors
+# coeftest(ryegrass.m1, vcov = sandwich)
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/estfun.drc.md b/docs/reference/estfun.drc.md new file mode 100644 index 00000000..419e3e82 --- /dev/null +++ b/docs/reference/estfun.drc.md @@ -0,0 +1,57 @@ +# Estimating function for the sandwich estimator + +Evaluates the estimating function (the "meat") for the sandwich +estimator of the variance-covariance matrix for objects of class 'drc'. + +## Usage + +``` r +# S3 method for class 'drc' +estfun(x, ...) +``` + +## Arguments + +- x: + + object of class `drc`. + +- ...: + + additional arguments. At the moment none are supported. + +## Value + +The estimating function evaluated at the data and the parameter +estimates. By default no clustering is assumed, corresponding to robust +standard errors under independence. + +## Details + +The details are provided by Zeileis (2006). + +## References + +Zeileis, A. (2006) Object-oriented Computation of Sandwich Estimators, +*J. Statist. Software*, **16**, Issue 9. + +## Author + +Christian Ritz + +## Examples + +``` r +## The lines below requires that the packages +## 'lmtest' and 'sandwich' are installed +# library(lmtest) +# library(sandwich) + +# ryegrass.m1<-drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + +# Standard summary output +# coeftest(ryegrass.m1) + +# Output with robust standard errors +# coeftest(ryegrass.m1, vcov = sandwich) +``` diff --git a/docs/reference/etmotc-1.png b/docs/reference/etmotc-1.png new file mode 100644 index 00000000..a7d9f7ba Binary files /dev/null and b/docs/reference/etmotc-1.png differ diff --git a/docs/reference/etmotc.html b/docs/reference/etmotc.html new file mode 100644 index 00000000..762b176a --- /dev/null +++ b/docs/reference/etmotc.html @@ -0,0 +1,191 @@ + +Effect of erythromycin on mixed sewage microorganisms — etmotc • drc + Skip to contents + + +
    +
    +
    +

    Effect of erythromycin on mixed sewage microorganisms

    + +
    etmotc.Rd
    +
    + +
    +

    Relative growth rate in biomass of mixed sewage microorganisms (per hour) as a function of + increasing concentrations of the antibiotic erythromycin (mg/l).

    +
    + +
    +

    Usage

    + 
    data(etmotc)
    +
    + +
    +

    Format

    +

    A data frame with 57 observations on the following 4 variables.

    cell
    +

    a numeric vector

    + +
    dose1
    +

    a numeric vector

    + +
    pct1
    +

    a numeric vector

    + +
    rgr1
    +

    a numeric vector

    + + +
    +
    +

    Details

    +

    Data stem from an experiment investigating the effect of pharmaceuticals, + that are used in human and veterinary medicine and that are being released into the aquatic environment through + waste water or through manure used for fertilising agricultural land. The experiment constitutes a typical + dose-response situation. The dose is concentration of the antibiotic erythromycin (mg/l), which is an antibiotic + that can be used by persons or animals showing allergy to penicillin, and the measured response is the relative + growth rate in biomass of mixed sewage microorganisms (per hour), measured as turbidity two hours after exposure + by means of a spectrophotometer. The experiment was designed in such a way that eight replicates were assigned + to the control (dose 0), but no replicates were assigned to the 7 non-zero doses. Further details are found in + Christensen et al (2006).

    +
    +
    +

    Source

    +

    Christensen, A. M. and Ingerslev, F. and Baun, A. 2006 + Ecotoxicity of mixtures of antibiotics used in aquacultures, + Environmental Toxicology and Chemistry, 25, 2208–2215.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+etmotc.m1<-drm(rgr1~dose1, data=etmotc[1:15,], fct=LL.4())
+plot(etmotc.m1)
+modelFit(etmotc.m1)
+#> Lack-of-fit test
+#> 
+#>           ModelDf       RSS Df F value p value
+#> ANOVA           7 5.413e-05                   
+#> DRC model      11 5.978e-04  4 17.5773  0.0009
+summary(etmotc.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                 Estimate Std. Error  t-value   p-value    
+#> b:(Intercept)  0.9365452  0.0680380  13.7650 2.806e-08 ***
+#> c:(Intercept)  0.2225885  0.0199342  11.1662 2.430e-07 ***
+#> d:(Intercept)  0.6496673  0.0025117 258.6611 < 2.2e-16 ***
+#> e:(Intercept) 11.6675539  1.6207593   7.1988 1.755e-05 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.007371964 (11 degrees of freedom)
+
+etmotc.m2<-drm(rgr1~dose1, data=etmotc[1:15,], fct=W2.4())
+plot(etmotc.m2, add = TRUE)
+modelFit(etmotc.m2)
+#> Lack-of-fit test
+#> 
+#>           ModelDf        RSS Df F value p value
+#> ANOVA           7 5.4128e-05                   
+#> DRC model      11 1.5608e-04  4  3.2960  0.0807
+summary(etmotc.m2)
+#> 
+#> Model fitted: Weibull (type 2) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                 Estimate Std. Error  t-value   p-value    
+#> b:(Intercept) -0.4585014  0.0270713 -16.9368 3.154e-09 ***
+#> c:(Intercept)  0.1105817  0.0253882   4.3556  0.001145 ** 
+#> d:(Intercept)  0.6484347  0.0012874 503.6837 < 2.2e-16 ***
+#> e:(Intercept)  9.8112667  1.1944769   8.2139 5.079e-06 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.003766782 (11 degrees of freedom)
+
+etmotc.m3<-drm(rgr1~dose1, data=etmotc[1:15,], fct=W2.3())
+plot(etmotc.m3, add = TRUE)
+
+modelFit(etmotc.m3)
+#> Lack-of-fit test
+#> 
+#>           ModelDf        RSS Df F value p value
+#> ANOVA           7 5.4128e-05                   
+#> DRC model      12 3.0527e-04  5  6.4955  0.0146
+summary(etmotc.m3)
+#> 
+#> Model fitted: Weibull (type 2) with lower limit at 0 (3 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                 Estimate Std. Error t-value   p-value    
+#> b:(Intercept) -0.3748065  0.0079192 -47.329 5.252e-15 ***
+#> d:(Intercept)  0.6491863  0.0017073 380.232 < 2.2e-16 ***
+#> e:(Intercept) 16.3999632  0.5104155  32.131 5.217e-13 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.005043693 (12 degrees of freedom)
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/etmotc.md b/docs/reference/etmotc.md new file mode 100644 index 00000000..a440bec1 --- /dev/null +++ b/docs/reference/etmotc.md @@ -0,0 +1,137 @@ +# Effect of erythromycin on mixed sewage microorganisms + +Relative growth rate in biomass of mixed sewage microorganisms (per +hour) as a function of increasing concentrations of the antibiotic +erythromycin (mg/l). + +## Usage + +``` r +data(etmotc) +``` + +## Format + +A data frame with 57 observations on the following 4 variables. + +- `cell`: + + a numeric vector + +- `dose1`: + + a numeric vector + +- `pct1`: + + a numeric vector + +- `rgr1`: + + a numeric vector + +## Details + +Data stem from an experiment investigating the effect of +pharmaceuticals, that are used in human and veterinary medicine and that +are being released into the aquatic environment through waste water or +through manure used for fertilising agricultural land. The experiment +constitutes a typical dose-response situation. The dose is concentration +of the antibiotic erythromycin (mg/l), which is an antibiotic that can +be used by persons or animals showing allergy to penicillin, and the +measured response is the relative growth rate in biomass of mixed sewage +microorganisms (per hour), measured as turbidity two hours after +exposure by means of a spectrophotometer. The experiment was designed in +such a way that eight replicates were assigned to the control (dose 0), +but no replicates were assigned to the 7 non-zero doses. Further details +are found in Christensen et al (2006). + +## Source + +Christensen, A. M. and Ingerslev, F. and Baun, A. 2006 Ecotoxicity of +mixtures of antibiotics used in aquacultures, *Environmental Toxicology +and Chemistry*, **25**, 2208–2215. + +## Examples + +``` r +library(drc) + +etmotc.m1<-drm(rgr1~dose1, data=etmotc[1:15,], fct=LL.4()) +plot(etmotc.m1) +modelFit(etmotc.m1) +#> Lack-of-fit test +#> +#> ModelDf RSS Df F value p value +#> ANOVA 7 5.413e-05 +#> DRC model 11 5.978e-04 4 17.5773 0.0009 +summary(etmotc.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 0.9365452 0.0680380 13.7650 2.806e-08 *** +#> c:(Intercept) 0.2225885 0.0199342 11.1662 2.430e-07 *** +#> d:(Intercept) 0.6496673 0.0025117 258.6611 < 2.2e-16 *** +#> e:(Intercept) 11.6675539 1.6207593 7.1988 1.755e-05 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.007371964 (11 degrees of freedom) + +etmotc.m2<-drm(rgr1~dose1, data=etmotc[1:15,], fct=W2.4()) +plot(etmotc.m2, add = TRUE) +modelFit(etmotc.m2) +#> Lack-of-fit test +#> +#> ModelDf RSS Df F value p value +#> ANOVA 7 5.4128e-05 +#> DRC model 11 1.5608e-04 4 3.2960 0.0807 +summary(etmotc.m2) +#> +#> Model fitted: Weibull (type 2) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) -0.4585014 0.0270713 -16.9368 3.154e-09 *** +#> c:(Intercept) 0.1105817 0.0253882 4.3556 0.001145 ** +#> d:(Intercept) 0.6484347 0.0012874 503.6837 < 2.2e-16 *** +#> e:(Intercept) 9.8112667 1.1944769 8.2139 5.079e-06 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.003766782 (11 degrees of freedom) + +etmotc.m3<-drm(rgr1~dose1, data=etmotc[1:15,], fct=W2.3()) +plot(etmotc.m3, add = TRUE) + +modelFit(etmotc.m3) +#> Lack-of-fit test +#> +#> ModelDf RSS Df F value p value +#> ANOVA 7 5.4128e-05 +#> DRC model 12 3.0527e-04 5 6.4955 0.0146 +summary(etmotc.m3) +#> +#> Model fitted: Weibull (type 2) with lower limit at 0 (3 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) -0.3748065 0.0079192 -47.329 5.252e-15 *** +#> d:(Intercept) 0.6491863 0.0017073 380.232 < 2.2e-16 *** +#> e:(Intercept) 16.3999632 0.5104155 32.131 5.217e-13 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.005043693 (12 degrees of freedom) +``` diff --git a/docs/reference/fieller.html b/docs/reference/fieller.html new file mode 100644 index 00000000..f8aa99a8 --- /dev/null +++ b/docs/reference/fieller.html @@ -0,0 +1,70 @@ + +Fieller's confidence interval — fieller • drc + Skip to contents + + +
    +
    +
    +

    Fieller's confidence interval

    + Source: R/EDcomp.R +
    fieller.Rd
    +
    + +
    +

    Fieller's confidence interval

    +
    + +
    +

    Usage

    + 
    fieller(mu, df, vcMat, level = 0.95, finney = FALSE, resVar)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/fieller.md b/docs/reference/fieller.md new file mode 100644 index 00000000..0a2c18ed --- /dev/null +++ b/docs/reference/fieller.md @@ -0,0 +1,9 @@ +# Fieller's confidence interval + +Fieller's confidence interval + +## Usage + +``` r +fieller(mu, df, vcMat, level = 0.95, finney = FALSE, resVar) +``` diff --git a/docs/reference/figures/dose-response-curve.png b/docs/reference/figures/dose-response-curve.png new file mode 100644 index 00000000..c23abc42 Binary files /dev/null and b/docs/reference/figures/dose-response-curve.png differ diff --git a/docs/reference/figures/lifecycle-deprecated.svg b/docs/reference/figures/lifecycle-deprecated.svg new file mode 100644 index 00000000..b61c57c3 --- /dev/null +++ b/docs/reference/figures/lifecycle-deprecated.svg @@ -0,0 +1,21 @@ + + lifecycle: deprecated + + + + + + + + + + + + + + + lifecycle + + deprecated + + diff --git a/docs/reference/figures/lifecycle-experimental.svg b/docs/reference/figures/lifecycle-experimental.svg new file mode 100644 index 00000000..5d88fc2c --- /dev/null +++ b/docs/reference/figures/lifecycle-experimental.svg @@ -0,0 +1,21 @@ + + lifecycle: experimental + + + + + + + + + + + + + + + lifecycle + + experimental + + diff --git a/docs/reference/figures/lifecycle-stable.svg b/docs/reference/figures/lifecycle-stable.svg new file mode 100644 index 00000000..9bf21e76 --- /dev/null +++ b/docs/reference/figures/lifecycle-stable.svg @@ -0,0 +1,29 @@ + + lifecycle: stable + + + + + + + + + + + + + + + + lifecycle + + + + stable + + + diff --git a/docs/reference/figures/lifecycle-superseded.svg b/docs/reference/figures/lifecycle-superseded.svg new file mode 100644 index 00000000..db8d757f --- /dev/null +++ b/docs/reference/figures/lifecycle-superseded.svg @@ -0,0 +1,21 @@ + + lifecycle: superseded + + + + + + + + + + + + + + + lifecycle + + superseded + + diff --git a/docs/reference/figures/logo.png b/docs/reference/figures/logo.png new file mode 100644 index 00000000..ad475ae7 Binary files /dev/null and b/docs/reference/figures/logo.png differ diff --git a/docs/reference/findbe1.html b/docs/reference/findbe1.html new file mode 100644 index 00000000..851dfb51 --- /dev/null +++ b/docs/reference/findbe1.html @@ -0,0 +1,70 @@ + +Find initial parameter estimates — findbe1 • drc + Skip to contents + + +
    +
    +
    +

    Find initial parameter estimates

    + Source: R/findbe.R +
    findbe1.Rd
    +
    + +
    +

    Find initial parameter estimates

    +
    + +
    +

    Usage

    + 
    findbe1(doseTr, respTr, sgnb = 1, back = exp)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/findbe1.md b/docs/reference/findbe1.md new file mode 100644 index 00000000..bc8579f7 --- /dev/null +++ b/docs/reference/findbe1.md @@ -0,0 +1,9 @@ +# Find initial parameter estimates + +Find initial parameter estimates + +## Usage + +``` r +findbe1(doseTr, respTr, sgnb = 1, back = exp) +``` diff --git a/docs/reference/findcd.html b/docs/reference/findcd.html new file mode 100644 index 00000000..76d87c47 --- /dev/null +++ b/docs/reference/findcd.html @@ -0,0 +1,70 @@ + +Find c and d parameters — findcd • drc + Skip to contents + + +
    +
    +
    +

    Find c and d parameters

    + Source: R/findcd.R +
    findcd.Rd
    +
    + +
    +

    Find c and d parameters

    +
    + +
    +

    Usage

    + 
    findcd(x, y, scaleInc = 0.001)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/findcd.md b/docs/reference/findcd.md new file mode 100644 index 00000000..069c2311 --- /dev/null +++ b/docs/reference/findcd.md @@ -0,0 +1,9 @@ +# Find c and d parameters + +Find c and d parameters + +## Usage + +``` r +findcd(x, y, scaleInc = 0.001) +``` diff --git a/docs/reference/finney71-1.png b/docs/reference/finney71-1.png new file mode 100644 index 00000000..f86e883d Binary files /dev/null and b/docs/reference/finney71-1.png differ diff --git a/docs/reference/finney71.html b/docs/reference/finney71.html new file mode 100644 index 00000000..b43c52b4 --- /dev/null +++ b/docs/reference/finney71.html @@ -0,0 +1,149 @@ + +Example from Finney (1971) — finney71 • drc + Skip to contents + + +
    +
    +
    +

    Example from Finney (1971)

    + +
    finney71.Rd
    +
    + +
    +

    For each of six concentrations of an insecticide the number of insects affected (out of the total number of insects) + was recorded.

    +
    + +
    +

    Usage

    + 
    data(finney71)
    +
    + +
    +

    Format

    +

    A data frame with 6 observations on the following 3 variables.

    dose
    +

    a numeric vector

    + +
    total
    +

    a numeric vector

    + +
    affected
    +

    a numeric vector

    + + +
    +
    +

    Source

    +

    Finney, D. J. (1971) Probit Analysis, Cambridge: Cambridge University Press.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Model with ED50 as a parameter
+finney71.m1 <- drm(affected/total ~ dose, weights = total,
+data = finney71, fct = LL.2(), type = "binomial")
+
+summary(finney71.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept) -3.10363    0.38773 -8.0047 1.154e-15 ***
+#> e:(Intercept)  4.82890    0.24958 19.3485 < 2.2e-16 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+plot(finney71.m1, broken = TRUE, bp = 0.1, lwd = 2)
+
+
+ED(finney71.m1, c(10, 20, 50), interval = "delta", reference = "control")
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error   Lower   Upper
+#> e:10  2.37896    0.25164 1.88576 2.87217
+#> e:20  3.08932    0.24372 2.61163 3.56700
+#> e:50  4.82890    0.24958 4.33974 5.31806
+
+## Model fitted with 'glm'
+#fitl.glm <- glm(cbind(affected, total-affected) ~ log(dose),
+#family=binomial(link = logit), data=finney71[finney71$dose != 0, ])
+#summary(fitl.glm)  # p-value almost agree for the b parameter
+#
+#xp <- dose.p(fitl.glm, p=c(0.50, 0.90, 0.95))  # from MASS
+#xp.ci <- xp + attr(xp, "SE") %*% matrix(qnorm(1 - 0.05/2)*c(-1,1), nrow=1)
+#zp.est <- exp(cbind(xp.ci[,1],xp,xp.ci[,2]))
+#dimnames(zp.est)[[2]] <- c("zp.lcl","zp","zp.ucl")
+#zp.est  # not far from above results with 'ED'
+
+## Model with log(ED50) as a parameter
+finney71.m2 <- drm(affected/total ~ dose, weights = total,
+data = finney71, fct = LL2.2(), type = "binomial")
+
+## Confidence intervals based on back-transformation
+##  complete agreement with results based on 'glm'
+ED(finney71.m2, c(10, 20, 50), interval = "fls", reference = "control")
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error    Lower    Upper
+#> e:10 2.378930   0.105781 1.933486 2.926996
+#> e:20 3.089292   0.078893 2.646700 3.605896
+#> e:50 4.828919   0.051685 4.363709 5.343725
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/finney71.md b/docs/reference/finney71.md new file mode 100644 index 00000000..de76c32f --- /dev/null +++ b/docs/reference/finney71.md @@ -0,0 +1,90 @@ +# Example from Finney (1971) + +For each of six concentrations of an insecticide the number of insects +affected (out of the total number of insects) was recorded. + +## Usage + +``` r +data(finney71) +``` + +## Format + +A data frame with 6 observations on the following 3 variables. + +- `dose`: + + a numeric vector + +- `total`: + + a numeric vector + +- `affected`: + + a numeric vector + +## Source + +Finney, D. J. (1971) *Probit Analysis*, Cambridge: Cambridge University +Press. + +## Examples + +``` r +library(drc) + +## Model with ED50 as a parameter +finney71.m1 <- drm(affected/total ~ dose, weights = total, +data = finney71, fct = LL.2(), type = "binomial") + +summary(finney71.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) -3.10363 0.38773 -8.0047 1.154e-15 *** +#> e:(Intercept) 4.82890 0.24958 19.3485 < 2.2e-16 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +plot(finney71.m1, broken = TRUE, bp = 0.1, lwd = 2) + + +ED(finney71.m1, c(10, 20, 50), interval = "delta", reference = "control") +#> +#> Estimated effective doses +#> +#> Estimate Std. Error Lower Upper +#> e:10 2.37896 0.25164 1.88576 2.87217 +#> e:20 3.08932 0.24372 2.61163 3.56700 +#> e:50 4.82890 0.24958 4.33974 5.31806 + +## Model fitted with 'glm' +#fitl.glm <- glm(cbind(affected, total-affected) ~ log(dose), +#family=binomial(link = logit), data=finney71[finney71$dose != 0, ]) +#summary(fitl.glm) # p-value almost agree for the b parameter +# +#xp <- dose.p(fitl.glm, p=c(0.50, 0.90, 0.95)) # from MASS +#xp.ci <- xp + attr(xp, "SE") %*% matrix(qnorm(1 - 0.05/2)*c(-1,1), nrow=1) +#zp.est <- exp(cbind(xp.ci[,1],xp,xp.ci[,2])) +#dimnames(zp.est)[[2]] <- c("zp.lcl","zp","zp.ucl") +#zp.est # not far from above results with 'ED' + +## Model with log(ED50) as a parameter +finney71.m2 <- drm(affected/total ~ dose, weights = total, +data = finney71, fct = LL2.2(), type = "binomial") + +## Confidence intervals based on back-transformation +## complete agreement with results based on 'glm' +ED(finney71.m2, c(10, 20, 50), interval = "fls", reference = "control") +#> +#> Estimated effective doses +#> +#> Estimate Std. Error Lower Upper +#> e:10 2.378930 0.105781 1.933486 2.926996 +#> e:20 3.089292 0.078893 2.646700 3.605896 +#> e:50 4.828919 0.051685 4.363709 5.343725 +``` diff --git a/docs/reference/fitted.drc-1.png b/docs/reference/fitted.drc-1.png index 1d6e4f56..a30db95b 100644 Binary files a/docs/reference/fitted.drc-1.png and b/docs/reference/fitted.drc-1.png differ diff --git a/docs/reference/fitted.drc.html b/docs/reference/fitted.drc.html index 9d70f4c4..6570f1e1 100644 --- a/docs/reference/fitted.drc.html +++ b/docs/reference/fitted.drc.html @@ -1,164 +1,100 @@ - - - - - - +Extract fitted values from model — fitted.drc • drc + Skip to contents -Extract fitted values from model — fitted.drc • drc - - - +
    +
    +
    +

    Extract fitted values from model

    + Source: R/fitted.drc.R +
    fitted.drc.Rd
    +
    - - - - +
    +

    Extracts fitted values from an object of class 'drc'.

    +
    +
    +

    Usage

    + 
    # S3 method for class 'drc'
+fitted(object, ...)
    +
    +
    +

    Arguments

    - - - +
    object
    +

    an object of class 'drc'.

    - +
    ...
    +

    additional arguments.

    - -
    -
    -
    +
    +

    Value

    +

    Fitted values extracted from object.

    - - -
    -
    - - - - -
    -
    -
    -

    Extract fitted values from model

    - - +
    +

    Author

    +

    Christian Ritz

    -
    - -

    Extracts fitted values from an object of class 'drc'.

    - +
    +

    Examples

    + 
    ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4())
+plot(fitted(ryegrass.m1), residuals(ryegrass.m1))  # a residual plot
+
+
+
    +
    - 
    # S3 method for drc
-fitted(object, ...)
    - -

    Arguments

    - - - - - - - - - - -
    object

    an object of class 'drc'.

    ...

    additional arguments.

    - -

    Value

    - -

    Fitted values extracted from 'object'.

    - - -

    Examples

    - 
    
-ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4())
-plot(fitted(ryegrass.m1), residuals(ryegrass.m1))  # a residual plot
    
-
    -
    - -
    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -

    Site built with pkgdown.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -
    +
    + + + - - - + diff --git a/docs/reference/fitted.drc.md b/docs/reference/fitted.drc.md new file mode 100644 index 00000000..a5a61ba4 --- /dev/null +++ b/docs/reference/fitted.drc.md @@ -0,0 +1,36 @@ +# Extract fitted values from model + +Extracts fitted values from an object of class 'drc'. + +## Usage + +``` r +# S3 method for class 'drc' +fitted(object, ...) +``` + +## Arguments + +- object: + + an object of class 'drc'. + +- ...: + + additional arguments. + +## Value + +Fitted values extracted from `object`. + +## Author + +Christian Ritz + +## Examples + +``` r +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +plot(fitted(ryegrass.m1), residuals(ryegrass.m1)) # a residual plot + +``` diff --git a/docs/reference/fluoranthene-1.png b/docs/reference/fluoranthene-1.png new file mode 100644 index 00000000..bab3d226 Binary files /dev/null and b/docs/reference/fluoranthene-1.png differ diff --git a/docs/reference/fluoranthene.html b/docs/reference/fluoranthene.html new file mode 100644 index 00000000..ae70dc3a --- /dev/null +++ b/docs/reference/fluoranthene.html @@ -0,0 +1,129 @@ + +Death of fathead minnow larvae after exposure to fluoranthene — fluoranthene • drc + Skip to contents + + +
    +
    +
    +

    Death of fathead minnow larvae after exposure to fluoranthene

    + +
    fluoranthene.Rd
    +
    + +
    +

    Fathead minnow larvae were exposed to fluoranthene, a polycyclic aromatic hydrocarbon, under two different algal densities resulting in different levels of ambient ultraviolet radiation. Number of dead larvaes were reported.

    +
    + +
    +

    Usage

    + 
    data(fluoranthene)
    +
    + +
    +

    Format

    +

    A data frame with 24 observations on the following 4 variables.

    algalconc
    +

    a numeric vector

    + +
    conc
    +

    a numeric vector

    + +
    totalnum
    +

    a numeric vector

    + +
    mortality
    +

    a numeric vector

    + + +
    +
    +

    Source

    +

    M. W. Wheeler, R. M. Park, and A. J. Bailer (2006). Comparing median lethal concentration values using confidence interval overlap or ratio tests. Environmental Toxicology and Chemistry, 25:1441–1444.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Displaying the data
+head(fluoranthene)
+#>   algalconc conc mortality totalnum
+#> 1       0.7    5         0       23
+#> 2       0.7    5         0       19
+#> 3       0.7    5         0       20
+#> 4       1.5    5         0       22
+#> 5       1.5    5         0       25
+#> 6       1.5    5         0       24
+
+## Fitting a two-parameter log-logistic model for binomial response
+## with different curves per algal concentration
+fluoranthene.m1 <- drm(mortality/totalnum ~ conc, algalconc, weights = totalnum,
+data = fluoranthene, fct = LL.2(), type = "binomial")
+summary(fluoranthene.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>       Estimate Std. Error t-value   p-value    
+#> b:0.7 -4.61836    0.53249 -8.6731 < 2.2e-16 ***
+#> b:1.5 -5.14932    0.64726 -7.9556  1.78e-15 ***
+#> e:0.7 15.24767    0.73337 20.7914 < 2.2e-16 ***
+#> e:1.5 17.88383    0.77174 23.1735 < 2.2e-16 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+## Plotting the fitted curves
+plot(fluoranthene.m1, xlab = "Fluoranthene concentration",
+ylab = "Proportion dead")
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/fluoranthene.md b/docs/reference/fluoranthene.md new file mode 100644 index 00000000..33cd5fd9 --- /dev/null +++ b/docs/reference/fluoranthene.md @@ -0,0 +1,76 @@ +# Death of fathead minnow larvae after exposure to fluoranthene + +Fathead minnow larvae were exposed to fluoranthene, a polycyclic +aromatic hydrocarbon, under two different algal densities resulting in +different levels of ambient ultraviolet radiation. Number of dead +larvaes were reported. + +## Usage + +``` r +data(fluoranthene) +``` + +## Format + +A data frame with 24 observations on the following 4 variables. + +- `algalconc`: + + a numeric vector + +- `conc`: + + a numeric vector + +- `totalnum`: + + a numeric vector + +- `mortality`: + + a numeric vector + +## Source + +M. W. Wheeler, R. M. Park, and A. J. Bailer (2006). Comparing median +lethal concentration values using confidence interval overlap or ratio +tests. Environmental Toxicology and Chemistry, **25**:1441–1444. + +## Examples + +``` r +library(drc) + +## Displaying the data +head(fluoranthene) +#> algalconc conc mortality totalnum +#> 1 0.7 5 0 23 +#> 2 0.7 5 0 19 +#> 3 0.7 5 0 20 +#> 4 1.5 5 0 22 +#> 5 1.5 5 0 25 +#> 6 1.5 5 0 24 + +## Fitting a two-parameter log-logistic model for binomial response +## with different curves per algal concentration +fluoranthene.m1 <- drm(mortality/totalnum ~ conc, algalconc, weights = totalnum, +data = fluoranthene, fct = LL.2(), type = "binomial") +summary(fluoranthene.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:0.7 -4.61836 0.53249 -8.6731 < 2.2e-16 *** +#> b:1.5 -5.14932 0.64726 -7.9556 1.78e-15 *** +#> e:0.7 15.24767 0.73337 20.7914 < 2.2e-16 *** +#> e:1.5 17.88383 0.77174 23.1735 < 2.2e-16 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 + +## Plotting the fitted curves +plot(fluoranthene.m1, xlab = "Fluoranthene concentration", +ylab = "Proportion dead") +``` diff --git a/docs/reference/fplogistic.html b/docs/reference/fplogistic.html index 922f7515..e65988ac 100644 --- a/docs/reference/fplogistic.html +++ b/docs/reference/fplogistic.html @@ -1,214 +1,145 @@ - - - - - - +Fractional polynomial-logistic dose-response model — fplogistic • drc + Skip to contents -Fractional polynomial-logistic dose-response models — fplogistic • drc - - - +
    +
    +
    +

    Fractional polynomial-logistic dose-response model

    + Source: R/fplogistic.R +
    fplogistic.Rd
    +
    - +
    +

    Model function for specifying dose-response models that are a combination of a logistic model +and an appropriate class of fractional polynomials.

    +
    - - +
    +

    Usage

    + 
    fplogistic(
+  p1,
+  p2,
+  fixed = c(NA, NA, NA, NA),
+  names = c("b", "c", "d", "e"),
+  method = c("1", "2", "3", "4"),
+  ssfct = NULL,
+  fctName,
+  fctText
+)
    +
    +
    +

    Arguments

    - - +
    p1
    +

    numeric denoting the negative power of log(dose+1) in the fractional polynomial.

    - +
    p2
    +

    numeric denoting the positive power of log(dose+1) in the fractional polynomial.

    - - -
    -
    - - - -
    -
    -
    -
    -

    Fractional polynomial-logistic dose-response models

    - - -
    +
    names
    +

    a vector of character strings giving the names of the parameters (should not contain ":"). +The order of the parameters is: b, c, d, e.

    -
    - -

    Model function for specifying dose-response models that are a combination of a logistic model and an appropriate - class of fractional polynomials.

    - -
    - 
    fplogistic(p1, p2, fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"),
-method = c("1", "2", "3", "4"), ssfct = NULL, fctName, fctText)
-
-FPL.4(p1, p2, fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    p1

    numeric denoting the negative power of log(dose+1) in the fractional polynomial.

    p2

    numeric denoting the positive power of log(dose+1) in the fractional polynomial.

    fixed

    numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.

    names

    a vector of character strings giving the names of the parameters (should not contain ":"). - The default is reasonable (see under 'Usage'). The order of the parameters is: b, c, d, e, f - (see under 'Details').

    method

    character string indicating the self starter function to use.

    ssfct

    a self starter function to be used.

    fctName

    optional character string used internally by convenience functions.

    fctText

    optional character string used internally by convenience functions.

    ...

    Additional arguments (see fplogistic).

    - -

    Details

    - -

    The fractional polynomial dose-response models introduced by Namata et al. (2008) are implemented - using the logistic model as base.

    - -

    Value

    - -

    The value returned is a list containing the nonlinear function, the self starter function - and the parameter names.

    - -

    References

    +
    method
    +

    character string indicating the self starter function to use.

    -

    Namata, Harriet and Aerts, Marc and Faes, Christel and Teunis, Peter (2008) - Model Averaging in Microbial Risk Assessment Using Fractional Polynomials, - Risk Analysis 28, 891--905.

    - -

    See also

    -

    Examples are found on the hep page of maED.

    - +
    ssfct
    +

    a self starter function to be used.

    -
    -
    +
    +

    Value

    +

    A list containing the nonlinear function, the self starter function +and the parameter names.

    +
    +
    +

    Details

    +

    The fractional polynomial dose-response models introduced by Namata et al. (2008) are implemented +using the logistic model as base.

    +
    +
    +

    References

    +

    Namata, Harriet and Aerts, Marc and Faes, Christel and Teunis, Peter (2008) +Model Averaging in Microbial Risk Assessment Using Fractional Polynomials, +Risk Analysis 28, 891–905.

    +
    +
    +

    See also

    +

    FPL.4, maED, drm

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    + +
    -

    Author

    - Christian Ritz -
    - -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -

    Site built with pkgdown.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -
    +
    + + + - - - + diff --git a/docs/reference/fplogistic.md b/docs/reference/fplogistic.md new file mode 100644 index 00000000..fc49a6c4 --- /dev/null +++ b/docs/reference/fplogistic.md @@ -0,0 +1,84 @@ +# Fractional polynomial-logistic dose-response model + +Model function for specifying dose-response models that are a +combination of a logistic model and an appropriate class of fractional +polynomials. + +## Usage + +``` r +fplogistic( + p1, + p2, + fixed = c(NA, NA, NA, NA), + names = c("b", "c", "d", "e"), + method = c("1", "2", "3", "4"), + ssfct = NULL, + fctName, + fctText +) +``` + +## Arguments + +- p1: + + numeric denoting the negative power of log(dose+1) in the fractional + polynomial. + +- p2: + + numeric denoting the positive power of log(dose+1) in the fractional + polynomial. + +- fixed: + + numeric vector. Specifies which parameters are fixed and at what value + they are fixed. NAs for parameters that are not fixed. + +- names: + + a vector of character strings giving the names of the parameters + (should not contain ":"). The order of the parameters is: b, c, d, e. + +- method: + + character string indicating the self starter function to use. + +- ssfct: + + a self starter function to be used. + +- fctName: + + optional character string used internally by convenience functions. + +- fctText: + + optional character string used internally by convenience functions. + +## Value + +A list containing the nonlinear function, the self starter function and +the parameter names. + +## Details + +The fractional polynomial dose-response models introduced by Namata et +al. (2008) are implemented using the logistic model as base. + +## References + +Namata, Harriet and Aerts, Marc and Faes, Christel and Teunis, Peter +(2008) Model Averaging in Microbial Risk Assessment Using Fractional +Polynomials, *Risk Analysis* **28**, 891–905. + +## See also + +[`FPL.4`](https://hreinwald.github.io/drc/reference/FPL.4.md), +[`maED`](https://hreinwald.github.io/drc/reference/maED.md), +[`drm`](https://hreinwald.github.io/drc/reference/drm.md) + +## Author + +Christian Ritz diff --git a/docs/reference/gammadr.html b/docs/reference/gammadr.html index bf98be7f..c2a76e59 100644 --- a/docs/reference/gammadr.html +++ b/docs/reference/gammadr.html @@ -1,186 +1,121 @@ - - - - - - +Gamma Dose-Response Model — gammadr • drc + Skip to contents -Gamma dose-response model — gammadr • drc - - - +
    +
    +
    +

    Gamma Dose-Response Model

    + Source: R/gammadr.R +
    gammadr.Rd
    +
    - +
    +

    A four-parameter dose-response model derived from the cumulative distribution +function of the gamma distribution. Only suitable for increasing dose-response data.

    +
    - - +
    +

    Usage

    + 
    gammadr(
+  fixed = c(NA, NA, NA, NA),
+  names = c("b", "c", "d", "e"),
+  fctName,
+  fctText
+)
    +
    +
    +

    Arguments

    - - +
    fixed
    +

    numeric vector specifying which parameters are fixed and at what value +they are fixed. NAs are used for parameters that are not fixed.

    - +
    names
    +

    a vector of character strings giving the names of the parameters +(should not contain ":"). The default is reasonable.

    - - -
    -
    - - - -
    -
    -
    -
    -

    Gamma dose-response model

    - - -
    +
    fctText
    +

    optional character string used internally by convenience functions.

    -
    - -

    The gamma dose-response model is a four-parameter model derived from the cumulative distribution function of the gamma distribution.

    - +
    +
    +

    Value

    +

    A list containing the nonlinear function, the self starter function, +and the parameter names.

    - - 
    gammadr(fixed = c(NA, NA, NA, NA),
-  names = c("b", "c", "d", "e"), fctName, fctText)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - -
    fixed

    numeric vector specifying which parameters are fixed and at what value they are fixed. - NAs are used for parameters that are not fixed.

    names

    a vector of character strings giving the names of the parameters (should not contain ":"). - The default is reasonable (see under 'Usage').

    fctName

    optional character string used internally by convenience functions.

    fctText

    optional character string used internally by convenience functions.

    - -

    Details

    - -

    Following Wheeler and Bailer (2009) the model function is defined as follows:

    -

    $$f(x) = c + (d-c) * pgamma(b*x, e, 1)$$

    -

    This model is only suitable for increasing dose-response data.

    - -

    Value

    - -

    The value returned is a list containing the nonlinear function, the self starter function - and the parameter names.

    - -

    References

    - +
    +

    Details

    +

    Following Wheeler and Bailer (2009) the model function is:

    +

    $$f(x) = c + (d-c) \cdot \mathrm{pgamma}(b \cdot x, e, 1)$$

    +
    +
    +

    References

    Wheeler, M. W., Bailer, A. J. (2009) - Comparing model averaging with other model selection strategies for benchmark dose estimation, - Environmental and Ecological Statistics, 16, 37--51.

    - - -
    - +
    +

    Author

    +

    Christian Ritz

    +
    -
  • References
    • - +
    -

    Author

    - - Christian Ritz -
    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + -
    - - - - + diff --git a/docs/reference/gammadr.md b/docs/reference/gammadr.md new file mode 100644 index 00000000..fe43d0be --- /dev/null +++ b/docs/reference/gammadr.md @@ -0,0 +1,57 @@ +# Gamma Dose-Response Model + +A four-parameter dose-response model derived from the cumulative +distribution function of the gamma distribution. Only suitable for +increasing dose-response data. + +## Usage + +``` r +gammadr( + fixed = c(NA, NA, NA, NA), + names = c("b", "c", "d", "e"), + fctName, + fctText +) +``` + +## Arguments + +- fixed: + + numeric vector specifying which parameters are fixed and at what value + they are fixed. NAs are used for parameters that are not fixed. + +- names: + + a vector of character strings giving the names of the parameters + (should not contain ":"). The default is reasonable. + +- fctName: + + optional character string used internally by convenience functions. + +- fctText: + + optional character string used internally by convenience functions. + +## Value + +A list containing the nonlinear function, the self starter function, and +the parameter names. + +## Details + +Following Wheeler and Bailer (2009) the model function is: + +\$\$f(x) = c + (d-c) \cdot \mathrm{pgamma}(b \cdot x, e, 1)\$\$ + +## References + +Wheeler, M. W., Bailer, A. J. (2009) Comparing model averaging with +other model selection strategies for benchmark dose estimation, +*Environmental and Ecological Statistics*, **16**, 37–51. + +## Author + +Christian Ritz diff --git a/docs/reference/gaussian.html b/docs/reference/gaussian.html index b8ee6aba..aefb9ef1 100644 --- a/docs/reference/gaussian.html +++ b/docs/reference/gaussian.html @@ -1,197 +1,130 @@ - - - - - - +Normal (Gaussian) biphasic dose-response model — gaussian • drc + Skip to contents -Normal and log-normal biphasic dose-response models — gaussian • drc - - - +
    +
    +
    +

    Normal (Gaussian) biphasic dose-response model

    + Source: R/gaussian.R +
    gaussian.Rd
    +
    - +
    +

    Model function for fitting symmetric or skewed bell-shaped/biphasic dose-response patterns +using the Gaussian (normal distribution) model.

    +
    - - +
    +

    Usage

    + 
    gaussian(
+  fixed = c(NA, NA, NA, NA, NA),
+  names = c("b", "c", "d", "e", "f"),
+  method = c("1", "2", "3", "4"),
+  ssfct = NULL,
+  fctName,
+  fctText,
+  loge = FALSE
+)
    +
    +
    +

    Arguments

    - - +
    fixed
    +

    numeric vector. Specifies which parameters are fixed and at what value they are fixed. +NAs for parameters that are not fixed.

    - +
    names
    +

    a vector of character strings giving the names of the parameters (should not contain ":"). +The order of the parameters is: b, c, d, e, f.

    - - -
    -
    - - - -
    -
    -
    -
    -

    Normal and log-normal biphasic dose-response models

    - - -
    +
    ssfct
    +

    a self starter function to be used.

    -
    - -

    Model functions for fitting symmetric or skewed bell-shaped/biphasic dose-response patterns.

    - -
    - 
    gaussian(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"),
-    method = c("1", "2", "3", "4"), ssfct = NULL, fctName, fctText, loge = FALSE)
-
-    lgaussian(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c",
-    "d", "e", "f"), method = c("1", "2", "3", "4"), ssfct = NULL,
-    fctName, fctText, loge = FALSE)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    fixed

    numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.

    names

    a vector of character strings giving the names of the parameters (should not contain ":"). - The default is reasonable (see under 'Usage'). The order of the parameters is: b, c, d, e, f - (see under 'Details').

    method

    character string indicating the self starter function to use.

    ssfct

    a self starter function to be used.

    fctName

    optional character string used internally by convenience functions.

    fctText

    optional character string used internally by convenience functions.

    loge

    logical indicating whether or not e or log(e) should be a parameter in the model. By default e is a model parameter.

    - -

    Details

    - -

    Details yet to be provided.

    - -

    Value

    +
    fctName
    +

    optional character string used internally by convenience functions.

    -

    The value returned is a list containing the nonlinear function, the self starter function - and the parameter names.

    - -

    Note

    -

    The functions are for use with the function drm.

    - +
    fctText
    +

    optional character string used internally by convenience functions.

    -
    -
    +
    +

    Value

    +

    The value returned is a list containing the nonlinear function, the self starter function +and the parameter names.

    +
    +
    +

    See also

    +

    lgaussian, drm

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    + +
    -

    Author

    - Christian Ritz -
    - -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -

    Site built with pkgdown.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -
    +
    + + + - - - + diff --git a/docs/reference/gaussian.md b/docs/reference/gaussian.md new file mode 100644 index 00000000..6c6938e3 --- /dev/null +++ b/docs/reference/gaussian.md @@ -0,0 +1,66 @@ +# Normal (Gaussian) biphasic dose-response model + +Model function for fitting symmetric or skewed bell-shaped/biphasic +dose-response patterns using the Gaussian (normal distribution) model. + +## Usage + +``` r +gaussian( + fixed = c(NA, NA, NA, NA, NA), + names = c("b", "c", "d", "e", "f"), + method = c("1", "2", "3", "4"), + ssfct = NULL, + fctName, + fctText, + loge = FALSE +) +``` + +## Arguments + +- fixed: + + numeric vector. Specifies which parameters are fixed and at what value + they are fixed. NAs for parameters that are not fixed. + +- names: + + a vector of character strings giving the names of the parameters + (should not contain ":"). The order of the parameters is: b, c, d, e, + f. + +- method: + + character string indicating the self starter function to use. + +- ssfct: + + a self starter function to be used. + +- fctName: + + optional character string used internally by convenience functions. + +- fctText: + + optional character string used internally by convenience functions. + +- loge: + + logical indicating whether or not e or log(e) should be a parameter in + the model. By default e is a model parameter. + +## Value + +The value returned is a list containing the nonlinear function, the self +starter function and the parameter names. + +## See also + +[`lgaussian`](https://hreinwald.github.io/drc/reference/lgaussian.md), +[`drm`](https://hreinwald.github.io/drc/reference/drm.md) + +## Author + +Christian Ritz diff --git a/docs/reference/gaussian.ssf.html b/docs/reference/gaussian.ssf.html new file mode 100644 index 00000000..fc8b5c77 --- /dev/null +++ b/docs/reference/gaussian.ssf.html @@ -0,0 +1,75 @@ + +Self-starter for Gaussian model — gaussian.ssf • drc + Skip to contents + + +
    +
    +
    +

    Self-starter for Gaussian model

    + Source: R/gaussian.ssf.R +
    gaussian.ssf.Rd
    +
    + +
    +

    Self-starter for Gaussian model

    +
    + +
    +

    Usage

    + 
    gaussian.ssf(
+  method = c("1", "2", "3", "4"),
+  fixed,
+  logg = FALSE,
+  useFixed = FALSE
+)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/gaussian.ssf.md b/docs/reference/gaussian.ssf.md new file mode 100644 index 00000000..7585054d --- /dev/null +++ b/docs/reference/gaussian.ssf.md @@ -0,0 +1,14 @@ +# Self-starter for Gaussian model + +Self-starter for Gaussian model + +## Usage + +``` r +gaussian.ssf( + method = c("1", "2", "3", "4"), + fixed, + logg = FALSE, + useFixed = FALSE +) +``` diff --git a/docs/reference/germination.html b/docs/reference/germination.html new file mode 100644 index 00000000..47135d56 --- /dev/null +++ b/docs/reference/germination.html @@ -0,0 +1,189 @@ + +Germination of three crops — germination • drc + Skip to contents + + +
    +
    +
    +

    Germination of three crops

    + +
    germination.Rd
    +
    + +
    +

    Germination data were obtained from experiments involving the three species mungbean, rice, and wheat, which were opposed + to different temperatures between 10 and 40 degrees Celsius. Experiments lasted at most 18 days.

    +
    + +
    +

    Usage

    + 
    data(germination)
    +
    + +
    +

    Format

    +

    A data frame with 192 observations on the following 5 variables.

    temp
    +

    a numeric vector of temperatures that seeds were exposed to

    + +
    species
    +

    a factor with levels mungbean rice wheat

    + +
    start
    +

    a numeric vector of left endpoints of the monitoring intervals

    + +
    end
    +

    a numeric vector of right endpoints of the monitoring intervals

    + +
    germinated
    +

    a numeric vector giving the numbers of seeds germinated

    + + +
    +
    +

    Details

    +

    For each of the three species mungbean, rice, and wheat, a total of 20 seeds were uniformly distributed on filter paper in a petri dish (diameter: 9.0cm) + and then placed in dark climate cabinets with different temperatures (10, 16, 22, 28, 34, 40 degrees Celsius). Not all of the temperatures were applied to all species. + The germinated seeds were counted and removed from the petri dish on a daily basis up to 18 days (or until all seeds had germinated). I

    +

    n this experiment we also assume that the upper limit of the proportion germinated is a parameter that has to be estimated from the data. Moreover, we assume + that different combinations of species and temperature may lead to different germination curves with respect to slope, time required for 50% germination, and upper limit.

    +
    +
    +

    References

    +

    Ritz, C., Pipper, C. B. and Streibig, J. C. (2013) Analysis of germination data from agricultural experiments, Europ. J. Agronomy, 45, 1–6.

    +
    +
    +

    See also

    +

    Analysis of a single germination curve is shown for chickweed.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Fitting two-parameter log-logistic curves to each combination of species and temperature 
+##  (upper limit fixed at 1)
+## Note: Rows 24 and 62 are omitted from the dataset (all mungbean seeds germinated 
+##  and thus no right-censoring in this case)
+
+## germLL.2 <- drm(germinated ~ start + end, species:factor(temp), 
+## data = germination[c(1:23, 25:61, 63:192), ], fct = LL.2(), type = "event")
+## plot(germLL.2, ylim=c(0, 1.5), legendPos=c(2.5,1.5))  # plotting the fitted curves and the data
+## summary(germLL.2)  # showing the parameter estimates
+
+## Fitting two-parameter log-logistic curves to each combination of species and temperature
+## Note: the argument "start" may be used for providing sensible initial 
+##  parameter values for estimation procedure (is needed occasionally)
+##  (initial values were obtained from the model fit germLL.2)
+## Note also: the argument "upper" ensures that the upper limit cannot exceed 1
+## (however, no restrictions are imposed on the two remaining parameters 
+## (as indicated by an infinite value)
+
+## germLL.3 <- drm(germinated~start+end, species:factor(temp), 
+## data = germination[c(1:23, 25:61, 63:192), ], fct = LL.3(), type = "event",
+## start = c(coef(germLL.2)[1:13], rep(0.7,13), coef(germLL.2)[14:26]), 
+## upper = c(rep(Inf, 13), rep(1, 13), rep(Inf, 13)))
+
+## Plotting the fitted curves and the data
+## plot(germLL.3, ylim = c(0, 1.5), legendPos = c(2.5,1.5))
+
+## Showing the parameter estimates
+## summary(germLL.3)
+
+## Showing the parameter estimates with robust standard errors
+## library(lmtest)
+## coeftest(germLL.3, vcov = sandwich) 
+
+## Calculating t50 with associated standard errors
+## ED(germLL.3, 50)
+
+## Calculating t10, t20, t50 with 95% confidence intervals
+## ED(germLL.3, c(10, 20, 50), interval = "delta")
+
+## Comparing t50 between combinations by means of approximate t-tests
+## compParm(germLL.3, "e", "-")
+
+## Making plots of fitted regression curves for each species
+
+## Plot for mungbean
+#plot(germLL.3, log="", ylim=c(0, 1), xlim=c(0, 20), 
+#level=c("mungbean:10", "mungbean:16"), 
+#lty=2:3, lwd = 1.5,
+#xlab="Time (days)", 
+#ylab="Proportion germinated",  
+#main="Mungbean",
+#legendPos=c(3, 1.05), legendText=c(expression(10*degree), expression(16*degree)))
+
+## Plot for rice
+#plot(germLL.3, log="", ylim=c(0, 1), xlim=c(0, 20), 
+#level=c("rice:16", "rice:22", "rice:28", "rice:34", "rice:40"), 
+#lty=2:6, lwd = 1.5,
+#xlab="Time (days)", 
+#ylab="Proportion germinated",
+#main="Rice",   
+#pch=2:6,
+#legendPos=c(3, 1.05), legendText=c(expression(16*degree), expression(22*degree), 
+#expression(28*degree), expression(34*degree), expression(40*degree)))
+
+## Plot for wheat
+#plot(germLL.3, log="", ylim=c(0, 1), xlim=c(0, 20), 
+#level=c("wheat:10", "wheat:16", "wheat:22", "wheat:28", "wheat:34", "wheat:40"), 
+#lty=c("dashed","dotted","dotdash","longdash","twodash","232A"), lwd = 1.5,
+#xlab="Time (days)", 
+#ylab="Proportion germinated", 
+#main="Wheat",
+#legendPos=c(3, 1.05), 
+#legendText=c(expression(10*degree), expression(16*degree), expression(22*degree), 
+#expression(28*degree), expression(34*degree), expression(40*degree)))
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/germination.md b/docs/reference/germination.md new file mode 100644 index 00000000..caa31364 --- /dev/null +++ b/docs/reference/germination.md @@ -0,0 +1,144 @@ +# Germination of three crops + +Germination data were obtained from experiments involving the three +species mungbean, rice, and wheat, which were opposed to different +temperatures between 10 and 40 degrees Celsius. Experiments lasted at +most 18 days. + +## Usage + +``` r +data(germination) +``` + +## Format + +A data frame with 192 observations on the following 5 variables. + +- `temp`: + + a numeric vector of temperatures that seeds were exposed to + +- `species`: + + a factor with levels `mungbean` `rice` `wheat` + +- `start`: + + a numeric vector of left endpoints of the monitoring intervals + +- `end`: + + a numeric vector of right endpoints of the monitoring intervals + +- `germinated`: + + a numeric vector giving the numbers of seeds germinated + +## Details + +For each of the three species mungbean, rice, and wheat, a total of 20 +seeds were uniformly distributed on filter paper in a petri dish +(diameter: 9.0cm) and then placed in dark climate cabinets with +different temperatures (10, 16, 22, 28, 34, 40 degrees Celsius). Not all +of the temperatures were applied to all species. The germinated seeds +were counted and removed from the petri dish on a daily basis up to 18 +days (or until all seeds had germinated). I + +n this experiment we also assume that the upper limit of the proportion +germinated is a parameter that has to be estimated from the data. +Moreover, we assume that different combinations of species and +temperature may lead to different germination curves with respect to +slope, time required for 50% germination, and upper limit. + +## References + +Ritz, C., Pipper, C. B. and Streibig, J. C. (2013) Analysis of +germination data from agricultural experiments, *Europ. J. Agronomy*, +**45**, 1–6. + +## See also + +Analysis of a single germination curve is shown for +[`chickweed`](https://hreinwald.github.io/drc/reference/chickweed.md). + +## Examples + +``` r +library(drc) + +## Fitting two-parameter log-logistic curves to each combination of species and temperature +## (upper limit fixed at 1) +## Note: Rows 24 and 62 are omitted from the dataset (all mungbean seeds germinated +## and thus no right-censoring in this case) + +## germLL.2 <- drm(germinated ~ start + end, species:factor(temp), +## data = germination[c(1:23, 25:61, 63:192), ], fct = LL.2(), type = "event") +## plot(germLL.2, ylim=c(0, 1.5), legendPos=c(2.5,1.5)) # plotting the fitted curves and the data +## summary(germLL.2) # showing the parameter estimates + +## Fitting two-parameter log-logistic curves to each combination of species and temperature +## Note: the argument "start" may be used for providing sensible initial +## parameter values for estimation procedure (is needed occasionally) +## (initial values were obtained from the model fit germLL.2) +## Note also: the argument "upper" ensures that the upper limit cannot exceed 1 +## (however, no restrictions are imposed on the two remaining parameters +## (as indicated by an infinite value) + +## germLL.3 <- drm(germinated~start+end, species:factor(temp), +## data = germination[c(1:23, 25:61, 63:192), ], fct = LL.3(), type = "event", +## start = c(coef(germLL.2)[1:13], rep(0.7,13), coef(germLL.2)[14:26]), +## upper = c(rep(Inf, 13), rep(1, 13), rep(Inf, 13))) + +## Plotting the fitted curves and the data +## plot(germLL.3, ylim = c(0, 1.5), legendPos = c(2.5,1.5)) + +## Showing the parameter estimates +## summary(germLL.3) + +## Showing the parameter estimates with robust standard errors +## library(lmtest) +## coeftest(germLL.3, vcov = sandwich) + +## Calculating t50 with associated standard errors +## ED(germLL.3, 50) + +## Calculating t10, t20, t50 with 95% confidence intervals +## ED(germLL.3, c(10, 20, 50), interval = "delta") + +## Comparing t50 between combinations by means of approximate t-tests +## compParm(germLL.3, "e", "-") + +## Making plots of fitted regression curves for each species + +## Plot for mungbean +#plot(germLL.3, log="", ylim=c(0, 1), xlim=c(0, 20), +#level=c("mungbean:10", "mungbean:16"), +#lty=2:3, lwd = 1.5, +#xlab="Time (days)", +#ylab="Proportion germinated", +#main="Mungbean", +#legendPos=c(3, 1.05), legendText=c(expression(10*degree), expression(16*degree))) + +## Plot for rice +#plot(germLL.3, log="", ylim=c(0, 1), xlim=c(0, 20), +#level=c("rice:16", "rice:22", "rice:28", "rice:34", "rice:40"), +#lty=2:6, lwd = 1.5, +#xlab="Time (days)", +#ylab="Proportion germinated", +#main="Rice", +#pch=2:6, +#legendPos=c(3, 1.05), legendText=c(expression(16*degree), expression(22*degree), +#expression(28*degree), expression(34*degree), expression(40*degree))) + +## Plot for wheat +#plot(germLL.3, log="", ylim=c(0, 1), xlim=c(0, 20), +#level=c("wheat:10", "wheat:16", "wheat:22", "wheat:28", "wheat:34", "wheat:40"), +#lty=c("dashed","dotted","dotdash","longdash","twodash","232A"), lwd = 1.5, +#xlab="Time (days)", +#ylab="Proportion germinated", +#main="Wheat", +#legendPos=c(3, 1.05), +#legendText=c(expression(10*degree), expression(16*degree), expression(22*degree), +#expression(28*degree), expression(34*degree), expression(40*degree))) +``` diff --git a/docs/reference/getInitial.html b/docs/reference/getInitial.html index e3a3245b..81db6a95 100644 --- a/docs/reference/getInitial.html +++ b/docs/reference/getInitial.html @@ -1,158 +1,92 @@ - - - - - - +Showing starting values used — getInitial • drc + Skip to contents -Showing starting values used — getInitial • drc - - - +
    +
    +
    +

    Showing starting values used

    + Source: R/getInitial.R +
    getInitial.Rd
    +
    - - - - - - +
    +

    Returns the starting values of the model parameters used when fitting a dose-response model.

    +
    - - +
    +

    Usage

    + 
    getInitial(object)
    +
    - +
    +

    Arguments

    - +
    object
    +

    object of class 'drc'.

    - -
    -
    -
    +
    +

    Value

    +

    A vector of starting values for the model parameters used to initialize the +estimation procedure.

    - - -
    -
    - - - - -
    -
    -
    -

    Showing starting values used

    - - +
    +

    Note

    +

    This function is masking the standard function in the stats package.

    - -
    - -

    Function for showing the starting values of the model parameters used when fitting a dose-response model

    - +
    +

    Author

    +

    Christian Ritz

    - 
    getInitial(object)
    - -

    Arguments

    - - - - - - -
    object

    object of class 'drc'

    - -

    Value

    - -

    A vector of starting values for the model parameters used to initialize the estimation procedure.

    - -

    Note

    +
    -

    This function is masking the standard function in the stats package.

    - -
    - +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + - -
    - - - + diff --git a/docs/reference/getInitial.md b/docs/reference/getInitial.md new file mode 100644 index 00000000..fd5824cc --- /dev/null +++ b/docs/reference/getInitial.md @@ -0,0 +1,29 @@ +# Showing starting values used + +Returns the starting values of the model parameters used when fitting a +dose-response model. + +## Usage + +``` r +getInitial(object) +``` + +## Arguments + +- object: + + object of class 'drc'. + +## Value + +A vector of starting values for the model parameters used to initialize +the estimation procedure. + +## Note + +This function is masking the standard function in the stats package. + +## Author + +Christian Ritz diff --git a/docs/reference/getMeanFunctions.html b/docs/reference/getMeanFunctions.html index 4a5f5ddf..079a10a0 100644 --- a/docs/reference/getMeanFunctions.html +++ b/docs/reference/getMeanFunctions.html @@ -1,294 +1,229 @@ - - - - - - +Display available dose-response models — getMeanFunctions • drc + Skip to contents -Display available dose-response models — getMeanFunctions • drc - - - +
    +
    +
    +

    Display available dose-response models

    + Source: R/getMeanFunctions.R +
    getMeanFunctions.Rd
    +
    + +
    +

    Display information about available, built-in dose-response models. +The arguments noParm and fname can be combined.

    +
    - +
    +

    Usage

    + 
    getMeanFunctions(noParm = NA, fname = NULL, flist = NULL, display = TRUE)
    +
    - - +
    +

    Arguments

    +
    noParm
    +

    numeric specifying the number of parameters of the models to be displayed. +The default (NA) results in display of all models, regardless of number of parameters.

    - - - +
    fname
    +

    character string or vector of character strings specifying the short name(s) +of the models to be displayed (need to match exactly).

    - +
    flist
    +

    list of built-in functions to be displayed.

    - -
    -
    - - - -
    +
    display
    +

    logical indicating whether or not the requested models should be displayed +on the R console.

    -
    -
    -
    -

    Display available dose-response models

    - - +
    +
    +

    Value

    +

    An invisible list of functions or a list of strings with brief function descriptions.

    +
    +
    +

    Author

    +

    Christian Ritz

    -
    - -

    Display information about available, built-in dose-response models.

    - +
    +

    Examples

    + 
    ## Listing all functions
+getMeanFunctions()
+#> Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 
+#> (2 parameters) 
+#> In 'drc':  LL.2 
+#> 
+#> Log-logistic (ED50 as parameter) with lower limit at 0 
+#> (3 parameters) 
+#> In 'drc':  LL.3 
+#> 
+#> Log-logistic (ED50 as parameter) with upper limit at 1 
+#> (3 parameters) 
+#> In 'drc':  LL.3u 
+#> 
+#> Log-logistic (ED50 as parameter) 
+#> (4 parameters) 
+#> In 'drc':  LL.4 
+#> 
+#> Generalized log-logistic (ED50 as parameter) 
+#> (5 parameters) 
+#> In 'drc':  LL.5 
+#> 
+#> Weibull (type 1) with lower limit at 0 and upper limit at 1 
+#> (2 parameters) 
+#> In 'drc':  W1.2 
+#> 
+#> Weibull (type 1) with lower limit at 0 
+#> (3 parameters) 
+#> In 'drc':  W1.3 
+#> 
+#> Weibull (type 1) 
+#> (4 parameters) 
+#> In 'drc':  W1.4 
+#> 
+#> Weibull (type 2) with lower limit at 0 and upper limit at 1 
+#> (2 parameters) 
+#> In 'drc':  W2.2 
+#> 
+#> Weibull (type 2) with lower limit at 0 
+#> (3 parameters) 
+#> In 'drc':  W2.3 
+#> 
+#> Weibull (type 2) 
+#> (4 parameters) 
+#> In 'drc':  W2.4 
+#> 
+#> Brain-Cousens (hormesis) with lower limit fixed at 0 
+#> (4 parameters) 
+#> In 'drc':  BC.4 
+#> 
+#> Brain-Cousens (hormesis) 
+#> (5 parameters) 
+#> In 'drc':  BC.5 
+#> 
+#> Log-logistic (log(ED50) as parameter) with lower limit at 0 and upper limit at 1 
+#> (2 parameters) 
+#> In 'drc':  LL2.2 
+#> 
+#> Log-logistic (log(ED50) as parameter) with lower limit at 0 
+#> (3 parameters) 
+#> In 'drc':  LL2.3 
+#> 
+#> Log-logistic (log(ED50) as parameter) with upper limit at 1 
+#> (3 parameters) 
+#> In 'drc':  LL2.3u 
+#> 
+#> Log-logistic (log(ED50) as parameter) 
+#> (4 parameters) 
+#> In 'drc':  LL2.4 
+#> 
+#> Generalised log-logistic (log(ED50) as parameter) 
+#> (5 parameters) 
+#> In 'drc':  LL2.5 
+#> 
+#> Asymptotic regression with lower limit at 0 
+#> (2 parameters) 
+#> In 'drc':  AR.2 
+#> 
+#> Shifted asymptotic regression 
+#> (3 parameters) 
+#> In 'drc':  AR.3 
+#> 
+#> Michaelis-Menten 
+#> (2 parameters) 
+#> In 'drc':  MM.2 
+#> 
+#> Shifted Michaelis-Menten 
+#> (3 parameters) 
+#> In 'drc':  MM.3 
+#> 
+
+## Listing all functions with 4 parameters
+getMeanFunctions(4)
+#> Log-logistic (ED50 as parameter) 
+#> (4 parameters) 
+#> In 'drc':  LL.4 
+#> 
+#> Weibull (type 1) 
+#> (4 parameters) 
+#> In 'drc':  W1.4 
+#> 
+#> Weibull (type 2) 
+#> (4 parameters) 
+#> In 'drc':  W2.4 
+#> 
+#> Brain-Cousens (hormesis) with lower limit fixed at 0 
+#> (4 parameters) 
+#> In 'drc':  BC.4 
+#> 
+#> Log-logistic (log(ED50) as parameter) 
+#> (4 parameters) 
+#> In 'drc':  LL2.4 
+#> 
+
+## Listing all (log-)logistic functions
+getMeanFunctions(fname = "L")
+
+## Listing all three-parameter (log-)logistic or Weibull functions
+getMeanFunctions(3, fname = c("LL", "W"))
+
+
    +
    - 
    getMeanFunctions(noParm = NA, fname = NULL, flist = NULL, display =TRUE)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - -
    noParm

    numeric specifying the number of parameters of the models to be displayed. - The default (NA) results in display of all models, regardless of number of parameters.

    fname

    character string or vector of character strings specifying the short name(s) - of the models to be displayed (need to match exactly).

    flist

    list of built-in functions to be displayed.

    display

    logical indicating whether or not the requested models should be displayed on the R console.

    - -

    Details

    - -

    The arguments noParm and fname can be combined.

    - -

    Value

    - -

    An invisible list of functions or a list of strings with brief function descriptions is returned.

    - - -

    Examples

    - 
    
-## Listing all functions
-getMeanFunctions()
    #> Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 
-#> (2 parameters) 
-#> In 'drc':  LL.2 
-#> 
-#> Log-logistic (ED50 as parameter) with lower limit at 0 
-#> (3 parameters) 
-#> In 'drc':  LL.3 
-#> 
-#> Log-logistic (ED50 as parameter) with upper limit at 1 
-#> (3 parameters) 
-#> In 'drc':  LL.3u 
-#> 
-#> Log-logistic (ED50 as parameter) 
-#> (4 parameters) 
-#> In 'drc':  LL.4 
-#> 
-#> Generalized log-logistic (ED50 as parameter) 
-#> (5 parameters) 
-#> In 'drc':  LL.5 
-#> 
-#> Weibull (type 1) with lower limit at 0 and upper limit at 1 
-#> (2 parameters) 
-#> In 'drc':  W1.2 
-#> 
-#> Weibull (type 1) with lower limit at 0 
-#> (3 parameters) 
-#> In 'drc':  W1.3 
-#> 
-#> Weibull (type 1) 
-#> (4 parameters) 
-#> In 'drc':  W1.4 
-#> 
-#> Weibull (type 2) with lower limit at 0 and upper limit at 1 
-#> (2 parameters) 
-#> In 'drc':  W2.2 
-#> 
-#> Weibull (type 2) with lower limit at 0 
-#> (3 parameters) 
-#> In 'drc':  W2.3 
-#> 
-#> Weibull (type 2) 
-#> (4 parameters) 
-#> In 'drc':  W2.4 
-#> 
-#> Brain-Cousens (hormesis) with lower limit fixed at 0 
-#> (4 parameters) 
-#> In 'drc':  BC.4 
-#> 
-#> Brain-Cousens (hormesis) 
-#> (5 parameters) 
-#> In 'drc':  BC.5 
-#> 
-#> Log-logistic (log(ED50) as parameter) with lower limit at 0 and upper limit at 1 
-#> (2 parameters) 
-#> In 'drc':  LL2.2 
-#> 
-#> Log-logistic (log(ED50) as parameter) with lower limit at 0 
-#> (3 parameters) 
-#> In 'drc':  LL2.3 
-#> 
-#> Log-logistic (log(ED50) as parameter) with upper limit at 1 
-#> (3 parameters) 
-#> In 'drc':  LL2.3u 
-#> 
-#> Log-logistic (log(ED50) as parameter) 
-#> (4 parameters) 
-#> In 'drc':  LL2.4 
-#> 
-#> Generalised log-logistic (log(ED50) as parameter) 
-#> (5 parameters) 
-#> In 'drc':  LL2.5 
-#> 
-#> Asymptotic regression with lower limit at 0 
-#> (2 parameters) 
-#> In 'drc':  AR.2 
-#> 
-#> Shifted asymptotic regression 
-#> (3 parameters) 
-#> In 'drc':  AR.3 
-#> 
-#> Michaelis-Menten 
-#> (2 parameters) 
-#> In 'drc':  MM.2 
-#> 
-#> Shifted Michaelis-Menten 
-#> (3 parameters) 
-#> In 'drc':  MM.3 
-#> 
    
-## Listing all functions with 4 parameters
-getMeanFunctions(4)
    #> Log-logistic (ED50 as parameter) 
-#> (4 parameters) 
-#> In 'drc':  LL.4 
-#> 
-#> Weibull (type 1) 
-#> (4 parameters) 
-#> In 'drc':  W1.4 
-#> 
-#> Weibull (type 2) 
-#> (4 parameters) 
-#> In 'drc':  W2.4 
-#> 
-#> Brain-Cousens (hormesis) with lower limit fixed at 0 
-#> (4 parameters) 
-#> In 'drc':  BC.4 
-#> 
-#> Log-logistic (log(ED50) as parameter) 
-#> (4 parameters) 
-#> In 'drc':  LL2.4 
-#> 
    
-## Listing all (log-)logistic functions
-getMeanFunctions(fname = "L")
-
-## Listing all three-parameter (log-)logistic or Weibull functions
-getMeanFunctions(3, fname = c("LL", "W"))
-
-## Listing all four-parameter (log-)logistic or Weibull functions
-getMeanFunctions(4, fname = c("LL", "W"))
    -
    - - -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -

    Site built with pkgdown.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -
    +
    + + + - - - + diff --git a/docs/reference/getMeanFunctions.md b/docs/reference/getMeanFunctions.md new file mode 100644 index 00000000..8c419f02 --- /dev/null +++ b/docs/reference/getMeanFunctions.md @@ -0,0 +1,165 @@ +# Display available dose-response models + +Display information about available, built-in dose-response models. The +arguments `noParm` and `fname` can be combined. + +## Usage + +``` r +getMeanFunctions(noParm = NA, fname = NULL, flist = NULL, display = TRUE) +``` + +## Arguments + +- noParm: + + numeric specifying the number of parameters of the models to be + displayed. The default (NA) results in display of all models, + regardless of number of parameters. + +- fname: + + character string or vector of character strings specifying the short + name(s) of the models to be displayed (need to match exactly). + +- flist: + + list of built-in functions to be displayed. + +- display: + + logical indicating whether or not the requested models should be + displayed on the R console. + +## Value + +An invisible list of functions or a list of strings with brief function +descriptions. + +## Author + +Christian Ritz + +## Examples + +``` r +## Listing all functions +getMeanFunctions() +#> Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 +#> (2 parameters) +#> In 'drc': LL.2 +#> +#> Log-logistic (ED50 as parameter) with lower limit at 0 +#> (3 parameters) +#> In 'drc': LL.3 +#> +#> Log-logistic (ED50 as parameter) with upper limit at 1 +#> (3 parameters) +#> In 'drc': LL.3u +#> +#> Log-logistic (ED50 as parameter) +#> (4 parameters) +#> In 'drc': LL.4 +#> +#> Generalized log-logistic (ED50 as parameter) +#> (5 parameters) +#> In 'drc': LL.5 +#> +#> Weibull (type 1) with lower limit at 0 and upper limit at 1 +#> (2 parameters) +#> In 'drc': W1.2 +#> +#> Weibull (type 1) with lower limit at 0 +#> (3 parameters) +#> In 'drc': W1.3 +#> +#> Weibull (type 1) +#> (4 parameters) +#> In 'drc': W1.4 +#> +#> Weibull (type 2) with lower limit at 0 and upper limit at 1 +#> (2 parameters) +#> In 'drc': W2.2 +#> +#> Weibull (type 2) with lower limit at 0 +#> (3 parameters) +#> In 'drc': W2.3 +#> +#> Weibull (type 2) +#> (4 parameters) +#> In 'drc': W2.4 +#> +#> Brain-Cousens (hormesis) with lower limit fixed at 0 +#> (4 parameters) +#> In 'drc': BC.4 +#> +#> Brain-Cousens (hormesis) +#> (5 parameters) +#> In 'drc': BC.5 +#> +#> Log-logistic (log(ED50) as parameter) with lower limit at 0 and upper limit at 1 +#> (2 parameters) +#> In 'drc': LL2.2 +#> +#> Log-logistic (log(ED50) as parameter) with lower limit at 0 +#> (3 parameters) +#> In 'drc': LL2.3 +#> +#> Log-logistic (log(ED50) as parameter) with upper limit at 1 +#> (3 parameters) +#> In 'drc': LL2.3u +#> +#> Log-logistic (log(ED50) as parameter) +#> (4 parameters) +#> In 'drc': LL2.4 +#> +#> Generalised log-logistic (log(ED50) as parameter) +#> (5 parameters) +#> In 'drc': LL2.5 +#> +#> Asymptotic regression with lower limit at 0 +#> (2 parameters) +#> In 'drc': AR.2 +#> +#> Shifted asymptotic regression +#> (3 parameters) +#> In 'drc': AR.3 +#> +#> Michaelis-Menten +#> (2 parameters) +#> In 'drc': MM.2 +#> +#> Shifted Michaelis-Menten +#> (3 parameters) +#> In 'drc': MM.3 +#> + +## Listing all functions with 4 parameters +getMeanFunctions(4) +#> Log-logistic (ED50 as parameter) +#> (4 parameters) +#> In 'drc': LL.4 +#> +#> Weibull (type 1) +#> (4 parameters) +#> In 'drc': W1.4 +#> +#> Weibull (type 2) +#> (4 parameters) +#> In 'drc': W2.4 +#> +#> Brain-Cousens (hormesis) with lower limit fixed at 0 +#> (4 parameters) +#> In 'drc': BC.4 +#> +#> Log-logistic (log(ED50) as parameter) +#> (4 parameters) +#> In 'drc': LL2.4 +#> + +## Listing all (log-)logistic functions +getMeanFunctions(fname = "L") + +## Listing all three-parameter (log-)logistic or Weibull functions +getMeanFunctions(3, fname = c("LL", "W")) +``` diff --git a/docs/reference/get_ed_interval.html b/docs/reference/get_ed_interval.html new file mode 100644 index 00000000..7c9d6615 --- /dev/null +++ b/docs/reference/get_ed_interval.html @@ -0,0 +1,126 @@ + +Select Appropriate Confidence Interval Method for a drc Model — get_ed_interval • drc + Skip to contents + + +
    +
    +
    +

    Select Appropriate Confidence Interval Method for a drc Model

    + Source: R/ED_robust.R +
    get_ed_interval.Rd
    +
    + +
    +

    This function determines the recommended confidence interval calculation method +('type' argument in drc::ED) based on the model family of a 'drc' object.

    +
    + +
    +

    Usage

    + 
    get_ed_interval(
+  model,
+  small_n = TRUE,
+  fls_pattern = "^LL|^LN|^BC|^CRS",
+  verbose = FALSE
+)
    +
    + +
    +

    Arguments

    + + +
    model
    +

    A drc model object or a character string specifying the model name (e.g., "LL.4").

    + + +
    small_n
    +

    A logical value. If TRUE, the t-distribution-based Fieller's method ("tfls") +is used for small samples for applicable models. If FALSE, the normal-distribution-based +method ("fls") is used. Defaults to TRUE.

    + + +
    fls_pattern
    +

    A regular expression character string. This pattern is used to identify +model families for which the "fls" or "tfls" method is appropriate. The default +covers standard log-logistic, log-normal, Brain-Cousens, and Cedergreen-Ritz-Streibig models.

    + + +
    verbose
    +

    A logical value. If TRUE, a message is printed when the function +resorts to its default choice because the model type was not explicitly matched. +Defaults to TRUE.

    + +
    +
    +

    Value

    +

    A character string: "tfls", "fls", or "delta", representing the +recommended interval type for use in drc::ED().

    +
    +
    +

    Author

    +

    Hannes Reinwald

    +
    + +
    +

    Examples

    + 
    ryegrass_model <- drm(rootl ~ conc, data = ryegrass, fct = LL.4())
+drc:::get_ed_interval(ryegrass_model)
+#> [1] "tfls"
+drc:::get_ed_interval("LL.4")
+#> [1] "tfls"
+drc:::get_ed_interval("W1.4")
+#> [1] "delta"
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/get_ed_interval.md b/docs/reference/get_ed_interval.md new file mode 100644 index 00000000..eca0e806 --- /dev/null +++ b/docs/reference/get_ed_interval.md @@ -0,0 +1,65 @@ +# Select Appropriate Confidence Interval Method for a drc Model + +This function determines the recommended confidence interval calculation +method ('type' argument in drc::ED) based on the model family of a 'drc' +object. + +## Usage + +``` r +get_ed_interval( + model, + small_n = TRUE, + fls_pattern = "^LL|^LN|^BC|^CRS", + verbose = FALSE +) +``` + +## Arguments + +- model: + + A drc model object or a character string specifying the model name + (e.g., "LL.4"). + +- small_n: + + A logical value. If TRUE, the t-distribution-based Fieller's method + ("tfls") is used for small samples for applicable models. If FALSE, + the normal-distribution-based method ("fls") is used. Defaults to + TRUE. + +- fls_pattern: + + A regular expression character string. This pattern is used to + identify model families for which the "fls" or "tfls" method is + appropriate. The default covers standard log-logistic, log-normal, + Brain-Cousens, and Cedergreen-Ritz-Streibig models. + +- verbose: + + A logical value. If TRUE, a message is printed when the function + resorts to its default choice because the model type was not + explicitly matched. Defaults to TRUE. + +## Value + +A character string: "tfls", "fls", or "delta", representing the +recommended interval type for use in +[`drc::ED()`](https://hreinwald.github.io/drc/reference/ED.md). + +## Author + +Hannes Reinwald + +## Examples + +``` r +ryegrass_model <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +drc:::get_ed_interval(ryegrass_model) +#> [1] "tfls" +drc:::get_ed_interval("LL.4") +#> [1] "tfls" +drc:::get_ed_interval("W1.4") +#> [1] "delta" +``` diff --git a/docs/reference/glymet-1.png b/docs/reference/glymet-1.png new file mode 100644 index 00000000..cb685196 Binary files /dev/null and b/docs/reference/glymet-1.png differ diff --git a/docs/reference/glymet-2.png b/docs/reference/glymet-2.png new file mode 100644 index 00000000..b6dbe367 Binary files /dev/null and b/docs/reference/glymet-2.png differ diff --git a/docs/reference/glymet.html b/docs/reference/glymet.html new file mode 100644 index 00000000..27dade62 --- /dev/null +++ b/docs/reference/glymet.html @@ -0,0 +1,207 @@ + +Glyphosate and metsulfuron-methyl tested on algae. — glymet • drc + Skip to contents + + +
    +
    +
    +

    Glyphosate and metsulfuron-methyl tested on algae.

    + +
    glymet.Rd
    +
    + +
    +

    The dataset has 7 mixtures, 8 dilutions, two replicates and 5 common control controls. + Four observations are missing, giving a total of 113 observations.

    +
    + +
    +

    Usage

    + 
    data(glymet)
    +
    + +
    +

    Format

    +

    A data frame with 113 observations on the following 3 variables.

    dose
    +

    a numeric vector of dose values

    + +
    pct
    +

    a numeric vector denoting the grouping according to the mixtures percentages

    + +
    rgr
    +

    a numeric vector of response values (relative growth rates)

    + + +
    +
    +

    Details

    +

    The dataset is analysed in Soerensen et al (2007). + The concentration addition model can be entertained for this dataset.

    +
    +
    +

    Source

    +

    The dataset is kindly provided by Nina Cedergreen, Department of Agricultural Sciences, + Royal Veterinary and Agricultural University, Denmark.

    +
    +
    +

    References

    +

    Soerensen, H. and Cedergreen, N. and Skovgaard, I. M. and Streibig, J. C. (2007) + An isobole-based statistical model and test for synergism/antagonism in binary mixture toxicity experiments, + Environmental and Ecological Statistics, 14, 383–397.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Fitting the model with freely varying ED50 values
+glymet.free <- drm(rgr~dose, pct, data = glymet, 
+fct = LL.3(), pmodels = list(~factor(pct) , ~1, ~factor(pct))) 
+#> Control measurements detected for level: 999
+
+## Lack-of-fit test
+modelFit(glymet.free)  # acceptable
+#> Lack-of-fit test
+#> 
+#>           ModelDf     RSS Df F value p value
+#> ANOVA          57 0.65695                   
+#> DRC model      98 1.35177 41  1.4704  0.0885
+summary(glymet.free)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                 Estimate Std. Error t-value   p-value    
+#> b:100         1.6452e+00 2.0683e-01  7.9547 3.169e-12 ***
+#> b:83          1.8276e+00 2.3584e-01  7.7492 8.663e-12 ***
+#> b:67          1.0654e+00 1.1840e-01  8.9983 1.812e-14 ***
+#> b:50          1.2324e+00 1.4031e-01  8.7834 5.262e-14 ***
+#> b:33          1.3676e+00 1.6478e-01  8.2992 5.809e-13 ***
+#> b:17          1.0100e+00 1.2156e-01  8.3090 5.534e-13 ***
+#> b:0           7.1041e-01 9.2251e-02  7.7008 1.097e-11 ***
+#> d:(Intercept) 1.6191e+00 2.5370e-02 63.8198 < 2.2e-16 ***
+#> e:100         1.3332e+05 1.1477e+04 11.6158 < 2.2e-16 ***
+#> e:83          1.6102e+05 1.3111e+04 12.2806 < 2.2e-16 ***
+#> e:67          1.6150e+05 1.8071e+04  8.9375 2.443e-14 ***
+#> e:50          1.4098e+05 1.4342e+04  9.8302 3.634e-16 ***
+#> e:33          1.2494e+05 1.1922e+04 10.4800 < 2.2e-16 ***
+#> e:17          1.7018e+05 1.9524e+04  8.7164 7.336e-14 ***
+#> e:0           1.2814e+05 1.8568e+04  6.9011 5.140e-10 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.1174459 (98 degrees of freedom)
+
+## Plotting isobole structure
+isobole(glymet.free, exchange=0.01)
+
+## Fitting the concentration addition model
+glymet.ca <- mixture(glymet.free, model = "CA")
+#> Warning: Using formula(x) is deprecated when x is a character vector of length > 1.
+#>   Consider formula(paste(x, collapse = " ")) instead.
+#> Control measurements detected for level: 999
+
+## Comparing to model with freely varying e parameter
+anova(glymet.ca, glymet.free)  # borderline accepted
+#> 
+#> 1st model
+#>  fct:     CA model
+#>  pmodels: ~~~factor(pct), ~1, ~I(1/(pct/100)) - 1, ~I(1/(1 - pct/100)) - 1
+#> 2nd model
+#>  fct:     LL.3()
+#>  pmodels: ~factor(pct), ~1, ~factor(pct)
+#> 
+#> ANOVA table
+#> 
+#>           ModelDf    RSS Df F value p value
+#> 1st model     103 1.4865                   
+#> 2nd model      98 1.3518  5  1.9532  0.0924
+
+## Plotting isobole based on concentration addition
+isobole(glymet.free, glymet.ca, exchange = 0.01)  # acceptable fit
+
+
+## Fitting the Hewlett model
+glymet.hew <- mixture(glymet.free, model = "Hewlett")
+#> Warning: Using formula(x) is deprecated when x is a character vector of length > 1.
+#>   Consider formula(paste(x, collapse = " ")) instead.
+#> Control measurements detected for level: 999
+
+### Comparing to model with freely varying e parameter
+anova(glymet.ca, glymet.hew)  
+#> 
+#> 1st model
+#>  fct:     CA model
+#>  pmodels: ~~~factor(pct), ~1, ~I(1/(pct/100)) - 1, ~I(1/(1 - pct/100)) - 1
+#> 2nd model
+#>  fct:     Hewlett model
+#>  pmodels: ~~~factor(pct), ~1, ~I(1/(pct/100)) - 1, ~I(1/(1 - pct/100)) - 1, ~1
+#> 
+#> ANOVA table
+#> 
+#>           ModelDf    RSS Df F value p value
+#> 1st model     103 1.4865                   
+#> 2nd model     102 1.4730  1  0.9360  0.3356
+# borderline accepted
+# the Hewlett model offers no improvement over concentration addition
+
+## Plotting isobole based on the Hewlett model
+isobole(glymet.free, glymet.hew, exchange = 0.01)  
+
+# no improvement over concentration addition
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/glymet.md b/docs/reference/glymet.md new file mode 100644 index 00000000..2428ec34 --- /dev/null +++ b/docs/reference/glymet.md @@ -0,0 +1,151 @@ +# Glyphosate and metsulfuron-methyl tested on algae. + +The dataset has 7 mixtures, 8 dilutions, two replicates and 5 common +control controls. Four observations are missing, giving a total of 113 +observations. + +## Usage + +``` r +data(glymet) +``` + +## Format + +A data frame with 113 observations on the following 3 variables. + +- `dose`: + + a numeric vector of dose values + +- `pct`: + + a numeric vector denoting the grouping according to the mixtures + percentages + +- `rgr`: + + a numeric vector of response values (relative growth rates) + +## Details + +The dataset is analysed in Soerensen et al (2007). The concentration +addition model can be entertained for this dataset. + +## Source + +The dataset is kindly provided by Nina Cedergreen, Department of +Agricultural Sciences, Royal Veterinary and Agricultural University, +Denmark. + +## References + +Soerensen, H. and Cedergreen, N. and Skovgaard, I. M. and Streibig, J. +C. (2007) An isobole-based statistical model and test for +synergism/antagonism in binary mixture toxicity experiments, +*Environmental and Ecological Statistics*, **14**, 383–397. + +## Examples + +``` r +library(drc) + +## Fitting the model with freely varying ED50 values +glymet.free <- drm(rgr~dose, pct, data = glymet, +fct = LL.3(), pmodels = list(~factor(pct) , ~1, ~factor(pct))) +#> Control measurements detected for level: 999 + +## Lack-of-fit test +modelFit(glymet.free) # acceptable +#> Lack-of-fit test +#> +#> ModelDf RSS Df F value p value +#> ANOVA 57 0.65695 +#> DRC model 98 1.35177 41 1.4704 0.0885 +summary(glymet.free) +#> +#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:100 1.6452e+00 2.0683e-01 7.9547 3.169e-12 *** +#> b:83 1.8276e+00 2.3584e-01 7.7492 8.663e-12 *** +#> b:67 1.0654e+00 1.1840e-01 8.9983 1.812e-14 *** +#> b:50 1.2324e+00 1.4031e-01 8.7834 5.262e-14 *** +#> b:33 1.3676e+00 1.6478e-01 8.2992 5.809e-13 *** +#> b:17 1.0100e+00 1.2156e-01 8.3090 5.534e-13 *** +#> b:0 7.1041e-01 9.2251e-02 7.7008 1.097e-11 *** +#> d:(Intercept) 1.6191e+00 2.5370e-02 63.8198 < 2.2e-16 *** +#> e:100 1.3332e+05 1.1477e+04 11.6158 < 2.2e-16 *** +#> e:83 1.6102e+05 1.3111e+04 12.2806 < 2.2e-16 *** +#> e:67 1.6150e+05 1.8071e+04 8.9375 2.443e-14 *** +#> e:50 1.4098e+05 1.4342e+04 9.8302 3.634e-16 *** +#> e:33 1.2494e+05 1.1922e+04 10.4800 < 2.2e-16 *** +#> e:17 1.7018e+05 1.9524e+04 8.7164 7.336e-14 *** +#> e:0 1.2814e+05 1.8568e+04 6.9011 5.140e-10 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.1174459 (98 degrees of freedom) + +## Plotting isobole structure +isobole(glymet.free, exchange=0.01) + +## Fitting the concentration addition model +glymet.ca <- mixture(glymet.free, model = "CA") +#> Warning: Using formula(x) is deprecated when x is a character vector of length > 1. +#> Consider formula(paste(x, collapse = " ")) instead. +#> Control measurements detected for level: 999 + +## Comparing to model with freely varying e parameter +anova(glymet.ca, glymet.free) # borderline accepted +#> +#> 1st model +#> fct: CA model +#> pmodels: ~~~factor(pct), ~1, ~I(1/(pct/100)) - 1, ~I(1/(1 - pct/100)) - 1 +#> 2nd model +#> fct: LL.3() +#> pmodels: ~factor(pct), ~1, ~factor(pct) +#> +#> ANOVA table +#> +#> ModelDf RSS Df F value p value +#> 1st model 103 1.4865 +#> 2nd model 98 1.3518 5 1.9532 0.0924 + +## Plotting isobole based on concentration addition +isobole(glymet.free, glymet.ca, exchange = 0.01) # acceptable fit + + +## Fitting the Hewlett model +glymet.hew <- mixture(glymet.free, model = "Hewlett") +#> Warning: Using formula(x) is deprecated when x is a character vector of length > 1. +#> Consider formula(paste(x, collapse = " ")) instead. +#> Control measurements detected for level: 999 + +### Comparing to model with freely varying e parameter +anova(glymet.ca, glymet.hew) +#> +#> 1st model +#> fct: CA model +#> pmodels: ~~~factor(pct), ~1, ~I(1/(pct/100)) - 1, ~I(1/(1 - pct/100)) - 1 +#> 2nd model +#> fct: Hewlett model +#> pmodels: ~~~factor(pct), ~1, ~I(1/(pct/100)) - 1, ~I(1/(1 - pct/100)) - 1, ~1 +#> +#> ANOVA table +#> +#> ModelDf RSS Df F value p value +#> 1st model 103 1.4865 +#> 2nd model 102 1.4730 1 0.9360 0.3356 +# borderline accepted +# the Hewlett model offers no improvement over concentration addition + +## Plotting isobole based on the Hewlett model +isobole(glymet.free, glymet.hew, exchange = 0.01) + +# no improvement over concentration addition +``` diff --git a/docs/reference/gompertz.html b/docs/reference/gompertz.html index a64ab801..03fef11e 100644 --- a/docs/reference/gompertz.html +++ b/docs/reference/gompertz.html @@ -1,212 +1,134 @@ - - - - - - +Gompertz dose-response or growth curve model — gompertz • drc + Skip to contents -Mean function for the Gompertz dose-response or growth curve — gompertz • drc - - - +
    +
    +
    +

    Gompertz dose-response or growth curve model

    + Source: R/gompertz.R +
    gompertz.Rd
    +
    - +
    +

    Provides a very general way of specifying the mean function of the decreasing or increasing +Gompertz dose-response or growth curve models.

    +
    - - +
    +

    Usage

    + 
    gompertz(
+  fixed = c(NA, NA, NA, NA),
+  names = c("b", "c", "d", "e"),
+  method = c("1", "2", "3", "4"),
+  ssfct = NULL,
+  fctName,
+  fctText
+)
    +
    +
    +

    Arguments

    - - +
    fixed
    +

    numeric vector. Specifies which parameters are fixed and at what value they are fixed. +NAs for parameters that are not fixed.

    - +
    names
    +

    vector of character strings giving the names of the parameters (should not contain ":"). +The order of the parameters is: b, c, d, e.

    - - -
    -
    - - - -
    -
    -
    -
    -

    Mean function for the Gompertz dose-response or growth curve

    - - -
    +
    ssfct
    +

    a self starter function to be used.

    -
    - -

    This function provides a very general way of specifying the mean function of the decreasing or incresing - Gompertz dose-response or growth curve models.

    - -
    - 
    gompertz(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"),
-  method = c("1", "2", "3", "4"), ssfct = NULL,
-  fctName, fctText)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - - - - - - - - - -
    fixed

    numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.

    names

    vector of character strings giving the names of the parameters (should not contain ":"). - The order of the parameters is: b, c, d, e (see under 'Details' for the precise meaning of each parameter).

    method

    character string indicating the self starter function to use.

    ssfct

    a self starter function to be used.

    fctName

    character string used internally by convenience functions (optional).

    fctText

    character string used internally by convenience functions (optional).

    - -

    Details

    - -

    The Gompertz model is given by the mean function

    -

    $$ f(x) = c + (d-c)(\exp(-\exp(b(x-e)))) $$

    -

    and it is a dose-response/growth curve on the entire real axis, that is it is not limited to - non-negative values even though this is the range for most dose-response and growth data. One consequence is - that the curve needs not reach the lower asymptote at dose 0.

    -

    If $$b<0$$ the mean function is increasing and it is decreasing for $$b>0$$. The decreasing Gompertz model is - not a well-defined dose-response model and other dose-response models such as the Weibull models - should be used instead.

    -

    Various re-parameterisations of the model are used in practice.

    - -

    Value

    - -

    The value returned is a list containing the non-linear function, the self starter function - and the parameter names.

    - -

    References

    - -

    Seber, G. A. F. and Wild, C. J. (1989) Nonlinear Regression, New York: Wiley \& Sons (p. 331).

    - -

    Note

    - -

    The function is for use with the function drm, but typically the convenience functions - G.2, G.3, G.3u, and G.4 should be used.

    - -

    See also

    - -

    The Weibull model weibull2 is closely related to the Gompertz model.

    - +
    fctName
    +

    optional character string used internally by convenience functions.

    -
    -
    +
    +

    Value

    +

    A list containing the non-linear function, the self starter function +and the parameter names.

    +
    +
    +

    Details

    +

    The Gompertz model is given by the mean function +$$f(x) = c + (d-c)(\exp(-\exp(b(x-e))))$$

    +

    If \(b<0\) the mean function is increasing; it is decreasing for \(b>0\).

    +
    +
    +

    References

    +

    Seber, G. A. F. and Wild, C. J. (1989) Nonlinear Regression, New York: Wiley & Sons (p. 331).

    +
    +
    +

    See also

    +

    The Weibull model weibull2 is closely related to the Gompertz model.

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    -
  • Note
    • +
    -
  • See also
    • - -

    Author

    - Christian Ritz -
    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + -
    - - - - + diff --git a/docs/reference/gompertz.md b/docs/reference/gompertz.md new file mode 100644 index 00000000..efae4185 --- /dev/null +++ b/docs/reference/gompertz.md @@ -0,0 +1,73 @@ +# Gompertz dose-response or growth curve model + +Provides a very general way of specifying the mean function of the +decreasing or increasing Gompertz dose-response or growth curve models. + +## Usage + +``` r +gompertz( + fixed = c(NA, NA, NA, NA), + names = c("b", "c", "d", "e"), + method = c("1", "2", "3", "4"), + ssfct = NULL, + fctName, + fctText +) +``` + +## Arguments + +- fixed: + + numeric vector. Specifies which parameters are fixed and at what value + they are fixed. NAs for parameters that are not fixed. + +- names: + + vector of character strings giving the names of the parameters (should + not contain ":"). The order of the parameters is: b, c, d, e. + +- method: + + character string indicating the self starter function to use. + +- ssfct: + + a self starter function to be used. + +- fctName: + + optional character string used internally by convenience functions. + +- fctText: + + optional character string used internally by convenience functions. + +## Value + +A list containing the non-linear function, the self starter function and +the parameter names. + +## Details + +The Gompertz model is given by the mean function \$\$f(x) = c + +(d-c)(\exp(-\exp(b(x-e))))\$\$ + +If \\b\<0\\ the mean function is increasing; it is decreasing for +\\b\>0\\. + +## References + +Seber, G. A. F. and Wild, C. J. (1989) *Nonlinear Regression*, New York: +Wiley & Sons (p. 331). + +## See also + +The Weibull model +[`weibull2`](https://hreinwald.github.io/drc/reference/weibull2.md) is +closely related to the Gompertz model. + +## Author + +Christian Ritz diff --git a/docs/reference/gompertz.ssf.html b/docs/reference/gompertz.ssf.html new file mode 100644 index 00000000..0d2c7923 --- /dev/null +++ b/docs/reference/gompertz.ssf.html @@ -0,0 +1,70 @@ + +Self-starter for Gompertz model — gompertz.ssf • drc + Skip to contents + + +
    +
    +
    +

    Self-starter for Gompertz model

    + Source: R/gompertz.ssf.R +
    gompertz.ssf.Rd
    +
    + +
    +

    Self-starter for Gompertz model

    +
    + +
    +

    Usage

    + 
    gompertz.ssf(method = c("1", "2", "3", "4"), fixed, useFixed = FALSE)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/gompertz.ssf.md b/docs/reference/gompertz.ssf.md new file mode 100644 index 00000000..47e05626 --- /dev/null +++ b/docs/reference/gompertz.ssf.md @@ -0,0 +1,9 @@ +# Self-starter for Gompertz model + +Self-starter for Gompertz model + +## Usage + +``` r +gompertz.ssf(method = c("1", "2", "3", "4"), fixed, useFixed = FALSE) +``` diff --git a/docs/reference/gompertzd.html b/docs/reference/gompertzd.html index 1c220cf5..5c6b47a6 100644 --- a/docs/reference/gompertzd.html +++ b/docs/reference/gompertzd.html @@ -1,176 +1,108 @@ - - - - - - +Derivative of the Gompertz function — gompertzd • drc + Skip to contents -The derivative of the Gompertz function — gompertzd • drc - - - +
    +
    +
    +

    Derivative of the Gompertz function

    + Source: R/gompertzd.R +
    gompertzd.Rd
    +
    - - - - +
    +

    gompertzd provides a way of specifying the derivative of the Gompertz function +as a dose-response model.

    +
    +
    +

    Usage

    + 
    gompertzd(fixed = c(NA, NA), names = c("a", "b"))
    +
    +
    +

    Arguments

    - - - +
    fixed
    +

    numeric vector. Specifies which parameters are fixed and at what value they are fixed. +NAs for parameters that are not fixed.

    - +
    names
    +

    a vector of character strings giving the names of the parameters (should not contain ":"). +The default is (notice the order): a, b.

    - -
    -
    -
    +
    +

    Value

    +

    A list containing the model function, the self starter function +and the parameter names.

    - - -
    -
    - - - - -
    -
    -
    -

    The derivative of the Gompertz function

    - - +
    +

    Details

    +

    The derivative of the Gompertz function is defined as +$$f(x) = a \exp(bx-a/b(\exp(bx)-1))$$ +For \(a>0\) and \(b\) not 0, the function is decreasing, equaling \(a\) at \(x=0\) +and approaching 0 at plus infinity.

    - -
    - -

    'gompertzd' provides a way of specifying the derivative of the Gompertz function - as a dose-response model.

    - +
    +

    See also

    +

    gompertz, drm

    +
    +
    +

    Author

    +

    Christian Ritz

    - 
    gompertzd(fixed = c(NA, NA), names = c("a", "b"))
    - -

    Arguments

    - - - - - - - - - - -
    fixed

    numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.

    names

    a vector of character strings giving the names of the parameters (should not contain ":"). - The default is (notice the order): a, b.

    - -

    Details

    - -

    The derivative of the Gompertz function is defined as

    -

    $$ f(x) = a \exp(bx-a/b(exp(bx)-1))$$

    -

    For \(a>0\) and \(b\) not 0, the function is decreasing, equaling \(a\) at \(x=0\) - and approaching 0 at plus infinity.

    - -

    Value

    - -

    The value returned is a list containing the model function, the self starter function - and the parameter names.

    - -

    Note

    - -

    This function is for use with the function drm.

    - - -
    - -
  • Note
    • - -

    Author

    - Christian Ritz -
    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + - -
    - - - + diff --git a/docs/reference/gompertzd.md b/docs/reference/gompertzd.md new file mode 100644 index 00000000..a35c475c --- /dev/null +++ b/docs/reference/gompertzd.md @@ -0,0 +1,43 @@ +# Derivative of the Gompertz function + +`gompertzd` provides a way of specifying the derivative of the Gompertz +function as a dose-response model. + +## Usage + +``` r +gompertzd(fixed = c(NA, NA), names = c("a", "b")) +``` + +## Arguments + +- fixed: + + numeric vector. Specifies which parameters are fixed and at what value + they are fixed. NAs for parameters that are not fixed. + +- names: + + a vector of character strings giving the names of the parameters + (should not contain ":"). The default is (notice the order): a, b. + +## Value + +A list containing the model function, the self starter function and the +parameter names. + +## Details + +The derivative of the Gompertz function is defined as \$\$f(x) = a +\exp(bx-a/b(\exp(bx)-1))\$\$ For \\a\>0\\ and \\b\\ not 0, the function +is decreasing, equaling \\a\\ at \\x=0\\ and approaching 0 at plus +infinity. + +## See also + +[`gompertz`](https://hreinwald.github.io/drc/reference/gompertz.md), +[`drm`](https://hreinwald.github.io/drc/reference/drm.md) + +## Author + +Christian Ritz diff --git a/docs/reference/guthion-1.png b/docs/reference/guthion-1.png new file mode 100644 index 00000000..c80e8161 Binary files /dev/null and b/docs/reference/guthion-1.png differ diff --git a/docs/reference/guthion.html b/docs/reference/guthion.html new file mode 100644 index 00000000..7099aa09 --- /dev/null +++ b/docs/reference/guthion.html @@ -0,0 +1,129 @@ + +guthion — guthion • drc + Skip to contents + + +
    +
    +
    +

    guthion

    + +
    guthion.Rd
    +
    + +
    +

    Data from an acute toxicity test with the insecticide guthion (azinphos-methyl). For each dose level in two treatment groups, the numbers of alive, moribund, and dead subjects were recorded.

    +
    + +
    +

    Usage

    + 
    data(guthion)
    +
    + +
    +

    Format

    +

    A data frame with 6 observations on the following 6 variables.

    trt
    +

    a categorial vector

    + +
    dose
    +

    a numeric vector

    + +
    alive
    +

    a numeric vector

    + +
    moribund
    +

    a numeric vector

    + +
    dead
    +

    a numeric vector

    + +
    total
    +

    a numeric vector

    + + +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Displaying the data
+head(guthion)
+#>   trt dose alive moribund dead total
+#> 1   S 20.0    44        1    5    50
+#> 2   S 35.0    28        1   21    50
+#> 3   S 45.0     8        7   35    50
+#> 4   T  1.0    37        1   12    50
+#> 5   T  1.5    20        2   28    50
+#> 6   T  2.0     8        6   36    50
+
+## Fitting a two-parameter log-logistic model for binomial response
+guthion.m1 <- drm(dead/total ~ dose, trt, weights = total,
+data = guthion, fct = LL.2(), type = "binomial")
+summary(guthion.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>      Estimate Std. Error t-value   p-value    
+#> b:S -3.768548   0.712361 -5.2902 1.222e-07 ***
+#> b:T -3.051117   0.656853 -4.6451 3.400e-06 ***
+#> e:S 36.891558   1.887823 19.5418 < 2.2e-16 ***
+#> e:T  1.432554   0.083677 17.1201 < 2.2e-16 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+## Plotting the fitted curves
+plot(guthion.m1, xlab = "Dose", ylab = "Proportion dead", ylim = c(0, 1))
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/guthion.md b/docs/reference/guthion.md new file mode 100644 index 00000000..1b2b3620 --- /dev/null +++ b/docs/reference/guthion.md @@ -0,0 +1,75 @@ +# guthion + +Data from an acute toxicity test with the insecticide guthion +(azinphos-methyl). For each dose level in two treatment groups, the +numbers of alive, moribund, and dead subjects were recorded. + +## Usage + +``` r +data(guthion) +``` + +## Format + +A data frame with 6 observations on the following 6 variables. + +- `trt`: + + a categorial vector + +- `dose`: + + a numeric vector + +- `alive`: + + a numeric vector + +- `moribund`: + + a numeric vector + +- `dead`: + + a numeric vector + +- `total`: + + a numeric vector + +## Examples + +``` r +library(drc) + +## Displaying the data +head(guthion) +#> trt dose alive moribund dead total +#> 1 S 20.0 44 1 5 50 +#> 2 S 35.0 28 1 21 50 +#> 3 S 45.0 8 7 35 50 +#> 4 T 1.0 37 1 12 50 +#> 5 T 1.5 20 2 28 50 +#> 6 T 2.0 8 6 36 50 + +## Fitting a two-parameter log-logistic model for binomial response +guthion.m1 <- drm(dead/total ~ dose, trt, weights = total, +data = guthion, fct = LL.2(), type = "binomial") +summary(guthion.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:S -3.768548 0.712361 -5.2902 1.222e-07 *** +#> b:T -3.051117 0.656853 -4.6451 3.400e-06 *** +#> e:S 36.891558 1.887823 19.5418 < 2.2e-16 *** +#> e:T 1.432554 0.083677 17.1201 < 2.2e-16 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 + +## Plotting the fitted curves +plot(guthion.m1, xlab = "Dose", ylab = "Proportion dead", ylim = c(0, 1)) +``` diff --git a/docs/reference/hatvalues.drc.html b/docs/reference/hatvalues.drc.html index 4bac4703..37ed1666 100644 --- a/docs/reference/hatvalues.drc.html +++ b/docs/reference/hatvalues.drc.html @@ -1,207 +1,129 @@ - - - - - - +Model diagnostics for nonlinear dose-response models — hatvalues.drc • drc + Skip to contents -Model diagnostics for nonlinear dose-response models — hatvalues.drc • drc - - - +
    +
    +
    +

    Model diagnostics for nonlinear dose-response models

    + Source: R/hatvalues.drc.R +
    hatvalues.drc.Rd
    +
    - - - - - - +
    +

    Hat values (leverage values) are provided for nonlinear dose-response model fits using the +same formulas as in linear regression but based on the corresponding approximate quantities +available for nonlinear models.

    +
    - - +
    +

    Usage

    + 
    # S3 method for class 'drc'
+hatvalues(model, ...)
    +
    - +
    +

    Arguments

    - +
    model
    +

    an object of class 'drc'.

    - -
    -
    - - - -
    +
    ...
    +

    additional arguments (not used).

    -
    -
    -
    -

    Model diagnostics for nonlinear dose-response models

    - - +
    +
    +

    Value

    +

    A vector of leverage values (hat values), one value per observation.

    - -
    - -

    Hat values (leverage values) and Cook's distance are provided for nonlinear dose-response model fits using the same formulas - as in linear regression but based on the corresponding but approximate quantities available for nonlinear models.

    - +
    +

    Details

    +

    Hat values are calculated using the formula given by Cook et al. (1986) and +McCullagh and Nelder (1989). The output values can be assessed in the same way as +in linear regression.

    - - 
    # S3 method for drc
-cooks.distance(model, ...)
-
-  # S3 method for drc
-hatvalues(model, ...)
    - -

    Arguments

    - - - - - - - - - - -
    model

    an object of class 'drc'.

    …

    additional arguments (not used).

    - -

    Details

    - -

    Hat values and Cook's distance are calculated using the formula given by Cook et al. (1986) and McCullagh and Nelder (1989).

    -

    The output values can be assessed in the same way as in linear regression.

    - -

    Value

    - -

    A vector of leverage values (hat values) or values of Cook's distance (one value per observation).

    - -

    References

    - - +
    +

    References

    Cook, R. D. and Tsai, C.-L. and Wei, B. C. (1986) - Bias in Nonlinear Regression, - Biometrika - 73, 615--623.

    +Bias in Nonlinear Regression, +Biometrika 73, 615–623.

    McCullagh, P. and Nelder, J. A. (1989) - emphGeneralized Linear Models, - Second edition, Chapman \& Hall/CRC.

    - - -

    Examples

    - 
    
-ryegrass.LL.4 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4())
-
-hatvalues(ryegrass.LL.4)
    #>          1          2          3          4          5          6          7 
-#> 0.13332342 0.13332342 0.13332342 0.13332342 0.13332342 0.13332342 0.09539668 
-#>          8          9         10         11         12         13         14 
-#> 0.09539668 0.09539668 0.27948291 0.27948291 0.27948291 0.28191831 0.28191831 
-#>         15         16         17         18         19         20         21 
-#> 0.28191831 0.12467564 0.12467564 0.12467564 0.12949336 0.12949336 0.12949336 
-#>         22         23         24 
-#> 0.15571960 0.15571960 0.15571960 
    
-cooks.distance(ryegrass.LL.4)
    #>            1            2            3            4            5            6 
-#> 7.453159e-03 7.044772e-03 4.714696e-02 4.844894e-02 2.870894e-02 4.723940e-03 
-#>            7            8            9           10           11           12 
-#> 6.453374e-02 4.817127e-02 3.034449e-03 1.086166e-01 1.026316e-03 1.159960e-01 
-#>           13           14           15           16           17           18 
-#> 6.500257e-01 1.505664e-02 6.990776e-01 8.318727e-03 1.370597e-03 1.649069e-03 
-#>           19           20           21           22           23           24 
-#> 3.231490e-03 6.070437e-05 1.244105e-02 1.159916e-02 1.468742e-02 4.949825e-04 
    
-
    -
    - +
    +

    Author

    +

    Christian Ritz

    +
    -
  • References
    • - -
  • Examples
    • - +
    +

    Examples

    + 
    ryegrass.LL.4 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4())
+
+hatvalues(ryegrass.LL.4)
+#>          1          2          3          4          5          6          7 
+#> 0.13332342 0.13332342 0.13332342 0.13332342 0.13332342 0.13332342 0.09539668 
+#>          8          9         10         11         12         13         14 
+#> 0.09539668 0.09539668 0.27948291 0.27948291 0.27948291 0.28191831 0.28191831 
+#>         15         16         17         18         19         20         21 
+#> 0.28191831 0.12467564 0.12467564 0.12467564 0.12949336 0.12949336 0.12949336 
+#>         22         23         24 
+#> 0.15571960 0.15571960 0.15571960 
+
+
    +
    +
    -

    Author

    - - Christian Ritz -
    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + -
    - - - - + diff --git a/docs/reference/hatvalues.drc.md b/docs/reference/hatvalues.drc.md new file mode 100644 index 00000000..5ba8ed14 --- /dev/null +++ b/docs/reference/hatvalues.drc.md @@ -0,0 +1,60 @@ +# Model diagnostics for nonlinear dose-response models + +Hat values (leverage values) are provided for nonlinear dose-response +model fits using the same formulas as in linear regression but based on +the corresponding approximate quantities available for nonlinear models. + +## Usage + +``` r +# S3 method for class 'drc' +hatvalues(model, ...) +``` + +## Arguments + +- model: + + an object of class 'drc'. + +- ...: + + additional arguments (not used). + +## Value + +A vector of leverage values (hat values), one value per observation. + +## Details + +Hat values are calculated using the formula given by Cook et al. (1986) +and McCullagh and Nelder (1989). The output values can be assessed in +the same way as in linear regression. + +## References + +Cook, R. D. and Tsai, C.-L. and Wei, B. C. (1986) Bias in Nonlinear +Regression, *Biometrika* **73**, 615–623. + +McCullagh, P. and Nelder, J. A. (1989) *Generalized Linear Models*, +Second edition, Chapman & Hall/CRC. + +## Author + +Christian Ritz + +## Examples + +``` r +ryegrass.LL.4 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + +hatvalues(ryegrass.LL.4) +#> 1 2 3 4 5 6 7 +#> 0.13332342 0.13332342 0.13332342 0.13332342 0.13332342 0.13332342 0.09539668 +#> 8 9 10 11 12 13 14 +#> 0.09539668 0.09539668 0.27948291 0.27948291 0.27948291 0.28191831 0.28191831 +#> 15 16 17 18 19 20 21 +#> 0.28191831 0.12467564 0.12467564 0.12467564 0.12949336 0.12949336 0.12949336 +#> 22 23 24 +#> 0.15571960 0.15571960 0.15571960 +``` diff --git a/docs/reference/heartrate-1.png b/docs/reference/heartrate-1.png new file mode 100644 index 00000000..1575ab23 Binary files /dev/null and b/docs/reference/heartrate-1.png differ diff --git a/docs/reference/heartrate-2.png b/docs/reference/heartrate-2.png new file mode 100644 index 00000000..c41f893a Binary files /dev/null and b/docs/reference/heartrate-2.png differ diff --git a/docs/reference/heartrate.html b/docs/reference/heartrate.html new file mode 100644 index 00000000..61875241 --- /dev/null +++ b/docs/reference/heartrate.html @@ -0,0 +1,129 @@ + +Heart rate baroreflexes for rabbits — heartrate • drc + Skip to contents + + +
    +
    +
    +

    Heart rate baroreflexes for rabbits

    + +
    heartrate.Rd
    +
    + +
    +

    The dataset contains measurements of mean arterial pressure (mmHG) and heart rate (b/min) for a baroreflex curve.

    +
    + +
    +

    Usage

    + 
    data(heartrate)
    +
    + +
    +

    Format

    +

    A data frame with 18 observations on the following 2 variables.

    pressure
    +

    a numeric vector containing measurements of arterial pressure.

    + +
    rate
    +

    a numeric vector containing measurements of heart rate.

    + + +
    +
    +

    Details

    +

    The dataset is an example of an asymmetric dose-response curve, that is not + easily handled using the log-logistic or Weibull models.

    +
    +
    +

    Source

    +

    Ricketts, J. H. and Head, G. A. (1999) A five-parameter logistic equation for investigating asymmetry of + curvature in baroreflex studies, + Am. J. Physiol. (Regulatory Integrative Comp. Physiol. 46), 277, 441–454.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Fitting the baro5 model
+heartrate.m1 <- drm(rate~pressure, data=heartrate, fct=baro5())
+plot(heartrate.m1)
+
+
+coef(heartrate.m1)
+#> b1:(Intercept) b2:(Intercept)  c:(Intercept)  d:(Intercept)  e:(Intercept) 
+#>       11.07984       46.67492      150.33588      351.29613       75.59392 
+
+#Output:
+#b1:(Intercept) b2:(Intercept)  c:(Intercept)  d:(Intercept)  e:(Intercept)
+#      11.07984       46.67492      150.33588      351.29613       75.59392
+
+## Inserting the estimated baro5 model function in deriv()
+baro5Derivative <- deriv(~ 150.33588 + ((351.29613 - 150.33588)/
+(1 + (1/(1 + exp((2 * 11.07984 * 46.67492/(11.07984 + 46.67492)) * 
+(log(x) - log(75.59392 ))))) * (exp(11.07984 * (log(x) - log(75.59392)))) + 
+(1 - (1/(1 + exp((2 * 11.07984 * 46.67492/(11.07984 + 46.67492)) * 
+(log(x) - log(75.59392 )))))) * (exp(46.67492 * (log(x) - log(75.59392 )))))), "x", function(x){})
+
+## Plotting the derivative
+#pressureVector <- 50:100
+pressureVector <- seq(50, 100, length.out=300)
+derivativeVector <- attr(baro5Derivative(pressureVector), "gradient")
+plot(pressureVector, derivativeVector, type = "l")
+
+
+## Finding the minimum
+pressureVector[which.min(derivativeVector)]
+#> [1] 76.92308
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/heartrate.md b/docs/reference/heartrate.md new file mode 100644 index 00000000..f8dc14ba --- /dev/null +++ b/docs/reference/heartrate.md @@ -0,0 +1,71 @@ +# Heart rate baroreflexes for rabbits + +The dataset contains measurements of mean arterial pressure (mmHG) and +heart rate (b/min) for a baroreflex curve. + +## Usage + +``` r +data(heartrate) +``` + +## Format + +A data frame with 18 observations on the following 2 variables. + +- `pressure`: + + a numeric vector containing measurements of arterial pressure. + +- `rate`: + + a numeric vector containing measurements of heart rate. + +## Details + +The dataset is an example of an asymmetric dose-response curve, that is +not easily handled using the log-logistic or Weibull models. + +## Source + +Ricketts, J. H. and Head, G. A. (1999) A five-parameter logistic +equation for investigating asymmetry of curvature in baroreflex studies, +*Am. J. Physiol. (Regulatory Integrative Comp. Physiol. 46)*, **277**, +441–454. + +## Examples + +``` r +library(drc) + +## Fitting the baro5 model +heartrate.m1 <- drm(rate~pressure, data=heartrate, fct=baro5()) +plot(heartrate.m1) + + +coef(heartrate.m1) +#> b1:(Intercept) b2:(Intercept) c:(Intercept) d:(Intercept) e:(Intercept) +#> 11.07984 46.67492 150.33588 351.29613 75.59392 + +#Output: +#b1:(Intercept) b2:(Intercept) c:(Intercept) d:(Intercept) e:(Intercept) +# 11.07984 46.67492 150.33588 351.29613 75.59392 + +## Inserting the estimated baro5 model function in deriv() +baro5Derivative <- deriv(~ 150.33588 + ((351.29613 - 150.33588)/ +(1 + (1/(1 + exp((2 * 11.07984 * 46.67492/(11.07984 + 46.67492)) * +(log(x) - log(75.59392 ))))) * (exp(11.07984 * (log(x) - log(75.59392)))) + +(1 - (1/(1 + exp((2 * 11.07984 * 46.67492/(11.07984 + 46.67492)) * +(log(x) - log(75.59392 )))))) * (exp(46.67492 * (log(x) - log(75.59392 )))))), "x", function(x){}) + +## Plotting the derivative +#pressureVector <- 50:100 +pressureVector <- seq(50, 100, length.out=300) +derivativeVector <- attr(baro5Derivative(pressureVector), "gradient") +plot(pressureVector, derivativeVector, type = "l") + + +## Finding the minimum +pressureVector[which.min(derivativeVector)] +#> [1] 76.92308 +``` diff --git a/docs/reference/hewlett.html b/docs/reference/hewlett.html new file mode 100644 index 00000000..ac09a659 --- /dev/null +++ b/docs/reference/hewlett.html @@ -0,0 +1,119 @@ + +Hewlett Mixture Model — hewlett • drc + Skip to contents + + +
    +
    +
    +

    Hewlett Mixture Model

    + Source: R/hewlett.R +
    hewlett.Rd
    +
    + +
    +

    Provides the Hewlett model for describing the joint action of two compounds +in binary mixture experiments. Used internally by mixture.

    +
    + +
    +

    Usage

    + 
    hewlett(
+  fixed = c(NA, NA, NA, NA, NA, NA),
+  names = c("b", "c", "d", "e", "f", "g"),
+  method = c("1", "2", "3", "4"),
+  ssfct = NULL,
+  eps = 1e-10
+)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector. Specifies which parameters are fixed and at what value +they are fixed. NAs for parameters that are not fixed.

    + + +
    names
    +

    a vector of character strings giving the names of the parameters +(should not contain ":").

    + + +
    method
    +

    character string indicating the self starter function to use.

    + + +
    ssfct
    +

    a self starter function to be used (optional).

    + + +
    eps
    +

    numeric tolerance for handling zero dose values.

    + +
    +
    +

    Value

    +

    A list containing the nonlinear model function, the self starter function, +and the parameter names.

    +
    +
    +

    See also

    +

    mixture, voelund

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/hewlett.md b/docs/reference/hewlett.md new file mode 100644 index 00000000..95f9d8ec --- /dev/null +++ b/docs/reference/hewlett.md @@ -0,0 +1,55 @@ +# Hewlett Mixture Model + +Provides the Hewlett model for describing the joint action of two +compounds in binary mixture experiments. Used internally by +[`mixture`](https://hreinwald.github.io/drc/reference/mixture.md). + +## Usage + +``` r +hewlett( + fixed = c(NA, NA, NA, NA, NA, NA), + names = c("b", "c", "d", "e", "f", "g"), + method = c("1", "2", "3", "4"), + ssfct = NULL, + eps = 1e-10 +) +``` + +## Arguments + +- fixed: + + numeric vector. Specifies which parameters are fixed and at what value + they are fixed. NAs for parameters that are not fixed. + +- names: + + a vector of character strings giving the names of the parameters + (should not contain ":"). + +- method: + + character string indicating the self starter function to use. + +- ssfct: + + a self starter function to be used (optional). + +- eps: + + numeric tolerance for handling zero dose values. + +## Value + +A list containing the nonlinear model function, the self starter +function, and the parameter names. + +## See also + +[`mixture`](https://hreinwald.github.io/drc/reference/mixture.md), +[`voelund`](https://hreinwald.github.io/drc/reference/voelund.md) + +## Author + +Christian Ritz diff --git a/docs/reference/idrm.html b/docs/reference/idrm.html new file mode 100644 index 00000000..93fe37db --- /dev/null +++ b/docs/reference/idrm.html @@ -0,0 +1,70 @@ + +Interactive dose-response modelling — idrm • drc + Skip to contents + + +
    +
    +
    +

    Interactive dose-response modelling

    + Source: R/idrm.R +
    idrm.Rd
    +
    + +
    +

    Interactive dose-response modelling

    +
    + +
    +

    Usage

    + 
    idrm(x, y, curveid, weights, fct, type, control)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/idrm.md b/docs/reference/idrm.md new file mode 100644 index 00000000..6265787c --- /dev/null +++ b/docs/reference/idrm.md @@ -0,0 +1,9 @@ +# Interactive dose-response modelling + +Interactive dose-response modelling + +## Usage + +``` r +idrm(x, y, curveid, weights, fct, type, control) +``` diff --git a/docs/reference/index.html b/docs/reference/index.html index 88f352ef..4685c28e 100644 --- a/docs/reference/index.html +++ b/docs/reference/index.html @@ -1,574 +1,1584 @@ - - - - - - +Package index • drc + Skip to contents -Function reference • drc - - - +
    +
    +
    +

    Package index

    +
    + +
    +

    Core Functions

    + +

    Main functions for dose-response analysis

    + +
    + + + + +
    + + drm() + +
    +
    Fitting dose-response models
    + +
    + + ED() + +
    +
    Estimating effective doses
    + +
    + + EDcomp() + +
    +
    Comparison of relative potencies between dose-response curves
    + +
    + + compParm() + +
    +
    Comparison of parameters
    + +
    + + mselect() + +
    +
    Dose-response model selection
    + +
    + + drmc() + +
    +
    Sets control arguments
    +
    +

    Model Functions

    + +

    Available dose-response model families

    + +
    + + + + +
    + + LL.2() l2() + +
    +
    Two-parameter log-logistic function
    + +
    + + LL.3() l3() + +
    +
    Three-parameter log-logistic function
    + +
    + + LL.3u() l3u() + +
    +
    Three-parameter log-logistic function with upper limit fixed
    + +
    + + LL.4() l4() + +
    +
    Four-parameter log-logistic function
    + +
    + + LL.5() l5() + +
    +
    Five-parameter log-logistic function
    + +
    + + LL2.2() + +
    +
    Two-Parameter Log-Logistic Model with log(ED50) as Parameter
    + +
    + + LL2.3() + +
    +
    Three-Parameter Log-Logistic Model with log(ED50) and Lower Limit at 0
    + +
    + + LL2.3u() + +
    +
    Three-Parameter Log-Logistic Model with log(ED50) and Fixed Upper Limit
    + +
    + + LL2.4() + +
    +
    Four-Parameter Log-Logistic Model with log(ED50) as Parameter
    + +
    + + LL2.5() + +
    +
    Five-Parameter Generalised Log-Logistic Model with log(ED50) as Parameter
    + +
    + + W1.2() w2() + +
    +
    Two-parameter Weibull type 1 model
    + +
    + + W1.3() w3() + +
    +
    Three-parameter Weibull type 1 model
    + +
    + + W1.3u() + +
    +
    Three-parameter Weibull type 1 model with upper limit fixed
    + +
    + + W1.4() w4() + +
    +
    Four-parameter Weibull type 1 model
    + +
    + + W2.2() + +
    +
    Two-parameter Weibull (type 2) model
    + +
    + + W2.3() + +
    +
    Three-parameter Weibull (type 2) model
    + +
    + + W2.3u() + +
    +
    Three-parameter Weibull (type 2) model with upper limit fixed
    + +
    + + W2.4() + +
    +
    Four-parameter Weibull (type 2) model
    + +
    + + W2x.3() + +
    +
    Three-parameter Weibull type 2 model with lag time
    + +
    + + W2x.4() + +
    +
    Four-parameter Weibull type 2 model with lag time
    + +
    + + G.2() + +
    +
    Two-parameter Gompertz model
    + +
    + + G.3() + +
    +
    Three-parameter Gompertz model
    + +
    + + G.3u() + +
    +
    Three-parameter Gompertz model with upper limit fixed
    + +
    + + G.4() + +
    +
    Four-parameter Gompertz model
    + +
    + + G.aparine + +
    +
    Herbicide applied to Galium aparine
    + +
    + + GiantKelp + +
    +
    Measurements of germination tubes for Giant Kelp
    + +
    + + LN.2() + +
    +
    Two-parameter log-normal dose-response model
    + +
    + + LN.3() + +
    +
    Three-parameter log-normal dose-response model
    + +
    + + LN.3u() + +
    +
    Three-parameter log-normal model with upper limit fixed
    + +
    + + LN.4() + +
    +
    Four-parameter log-normal dose-response model
    + +
    + + BC.4() + +
    +
    Four-parameter Brain-Cousens hormesis model
    + +
    + + BC.5() + +
    +
    Five-parameter Brain-Cousens hormesis model
    + +
    + + CRS.4a() + deprecated +
    +
    Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 1 (Deprecated)
    + +
    + + CRS.4b() + deprecated +
    +
    Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 0.5 (Deprecated)
    + +
    + + CRS.4c() + deprecated +
    +
    Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 0.25 (Deprecated)
    + +
    + + CRS.5() + +
    +
    Wrapper for 5-parameter Cedergreen-Ritz-Streibig Model
    + +
    + + CRS.5a() + deprecated +
    +
    Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 1 (Deprecated)
    + +
    + + CRS.5b() + deprecated +
    +
    Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 0.5 (Deprecated)
    + +
    + + CRS.5c() + deprecated +
    +
    Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 0.25 (Deprecated)
    + +
    + + CRS.6() + +
    +
    Generalised Cedergreen-Ritz-Streibig Model for Hormesis
    + +
    + + UCRS.4a() + +
    +
    U-shaped CRS model with lower limit 0 (alpha=1)
    + +
    + + UCRS.4b() + +
    +
    U-shaped CRS model with lower limit 0 (alpha=0.5)
    + +
    + + UCRS.4c() + +
    +
    U-shaped CRS model with lower limit 0 (alpha=0.25)
    + +
    + + UCRS.5a() + +
    +
    U-shaped CRS five-parameter model (alpha=1)
    + +
    + + UCRS.5b() + +
    +
    U-shaped CRS five-parameter model (alpha=0.5)
    + +
    + + UCRS.5c() + +
    +
    U-shaped CRS five-parameter model (alpha=0.25)
    + +
    + + NEC.2() + +
    +
    Two-parameter NEC model
    + +
    + + NEC.3() + +
    +
    Three-parameter NEC model
    + +
    + + NEC.4() + +
    +
    Four-parameter NEC model
    + +
    + + L.3() + +
    +
    Three-parameter logistic model
    + +
    + + L.4() + +
    +
    Four-parameter logistic model
    + +
    + + L.5() + +
    +
    Five-parameter generalized logistic model
    + +
    + + AR.2() + +
    +
    Two-parameter asymptotic regression model
    + +
    + + AR.3() + +
    +
    Three-parameter shifted asymptotic regression model
    + +
    + + EXD.2() + +
    +
    Two-parameter exponential decay model
    + +
    + + EXD.3() + +
    +
    Three-parameter exponential decay model
    + +
    + + MM.2() + +
    +
    Two-parameter Michaelis-Menten function
    + +
    + + MM.3() + +
    +
    Three-parameter Michaelis-Menten function
    + +
    + + FPL.4() + +
    +
    Four-parameter fractional polynomial-logistic model
    + +
    + + ml3a() + deprecated +
    +
    Alias for CRS.4a (Deprecated)
    + +
    + + ml3b() + deprecated +
    +
    Alias for CRS.4b (Deprecated)
    + +
    + + ml3c() + deprecated +
    +
    Alias for CRS.4c (Deprecated)
    + +
    + + ml4a() + deprecated +
    +
    Alias for CRS.5a (Deprecated)
    + +
    + + ml4b() + deprecated +
    +
    Alias for CRS.5b (Deprecated)
    + +
    + + ml4c() + deprecated +
    +
    Alias for CRS.5c (Deprecated)
    + +
    + + uml3a() + +
    +
    Alias for UCRS.4a
    + +
    + + uml3b() + +
    +
    Alias for UCRS.4b
    + +
    + + uml3c() + +
    +
    Alias for UCRS.4c
    + +
    + + uml4a() + +
    +
    Alias for UCRS.5a
    + +
    + + uml4b() + +
    +
    Alias for UCRS.5b
    + +
    + + uml4c() + +
    +
    Alias for UCRS.5c
    + +
    + + bcl3() + +
    +
    Alias for BC.4
    + +
    + + bcl4() + +
    +
    Alias for BC.5
    + +
    + + baro5() + +
    +
    The Baroreflex Five-Parameter Dose-Response Model
    + +
    + + braincousens() + +
    +
    The Brain-Cousens hormesis models
    + +
    + + cedergreen() + +
    +
    Cedergreen-Ritz-Streibig Model
    + +
    + + ucedergreen() + +
    +
    U-shaped Cedergreen-Ritz-Streibig model
    + +
    + + fplogistic() + +
    +
    Fractional polynomial-logistic dose-response model
    + +
    + + gammadr() + +
    +
    Gamma Dose-Response Model
    + +
    + + gaussian() + +
    +
    Normal (Gaussian) biphasic dose-response model
    + +
    + + gompertz() + +
    +
    Gompertz dose-response or growth curve model
    + +
    + + gompertzd() + +
    +
    Derivative of the Gompertz function
    + +
    + + lgaussian() + +
    +
    Log-normal (log-Gaussian) biphasic dose-response model
    + +
    + + llogistic() + +
    +
    The log-logistic function
    + +
    + + llogistic2() + +
    +
    Five-Parameter Log-Logistic Model with log(ED50) as Parameter
    + +
    + + lnormal() + +
    +
    Log-normal dose-response model
    + +
    + + logistic() + +
    +
    The general asymmetric five-parameter logistic model
    + +
    + + threephase() + +
    +
    Three-Phase Dose-Response Model
    + +
    + + twophase() + +
    +
    Two-Phase Dose-Response Model
    + +
    + + weibull1() + +
    +
    The four-parameter Weibull type 1 model
    + +
    + + weibull2() + +
    +
    The four-parameter Weibull (type 2) model
    + +
    + + weibull2x() + +
    +
    Five-parameter Weibull type 2 model with lag time
    + +
    + + yieldLoss() + +
    +
    Calculating yield loss parameters
    + +
    + + arandaordaz() + +
    +
    Asymptotic Regression Model
    +
    +

    Effective Dose Estimation

    + +

    Functions for estimating effective doses and comparisons

    + +
    + + + + +
    + + ED(<drc>) + +
    +
    Estimating effective doses
    + +
    + + ED_robust() + +
    +
    Robust Calculation of Effective Doses (ED)
    + +
    + + CIcomp() + +
    +
    Classical combination index for effective doses
    + +
    + + CIcompX() + +
    +
    Calculation of combination index for binary mixtures
    + +
    + + comped() + +
    +
    Comparison of effective dose values
    + +
    + + maED() + +
    +
    Estimation of ED values using model-averaging
    + +
    + + maED_robust() + +
    +
    Robust Calculation of Model-Averaged Effective Doses
    + +
    + + isobole() + +
    +
    Creating isobolograms
    + +
    + + NEC() + +
    +
    No Effect Concentration (NEC) dose-response model
    + +
    + + MAX() + +
    +
    Maximum mean response
    + +
    + + PR() + +
    +
    Expected or predicted response
    + +
    + + relpot() + +
    +
    Relative potency function
    +
    +

    Diagnostics and Model Selection

    + +

    Model diagnostics and helper functions

    + +
    + + + + +
    + + modelFit() + +
    +
    Assessing the model fit
    + +
    + + Rsq() + +
    +
    R-squared for dose-response models
    + +
    + + rss() + +
    +
    Residual sum of squares for dose-response models
    + +
    + + rdrm() + +
    +
    Simulating a dose-response curve
    + +
    + + anova(<drc>) + +
    +
    ANOVA Model Comparison for Dose-Response Models
    + +
    + + lin.test() + +
    +
    Lack-of-fit test for the mean structure based on cumulated residuals
    + +
    + + mr.test() + +
    +
    Mizon-Richard test for dose-response models
    + +
    + + neill.test() + +
    +
    Neill's lack-of-fit test for dose-response models
    + +
    + + noEffect() + +
    +
    Testing if there is a dose effect at all
    + +
    + + backfit() + +
    +
    Calculation of backfit values from a fitted dose-response model
    + +
    + + boxcox(<drc>) + +
    +
    Transform-both-sides Box-Cox transformation
    + +
    + + searchdrc() + +
    +
    Search through a range of initial parameter values to obtain convergence
    + +
    + + simDR() + +
    +
    Simulating ED values under various scenarios
    + +
    + + simFct() + +
    +
    Simulation of dose-response data and ED estimation
    + +
    + + plotFACI() + +
    +
    Plot combination index as a function of fraction affected
    + +
    - + getInitial() +
    +
    Showing starting values used
    +
    - - + getMeanFunctions() - +
    +
    Display available dose-response models
    +
    +

    S3 Methods

    +

    Methods for drc model objects

    - +
    - -
    -
    - - - -
    -
    -
    -
    -

    Reference

    -
    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    -

    Fitting dose resonse models

    -

    -
    -

    drm()

    -

    Fitting dose-response models

    -

    Methods

    -

    -
    -

    anova(<drc>)

    -

    ANOVA for dose-response model fits

    -

    boxcox(<drc>)

    -

    Transform-both-sides Box-Cox transformation

    -

    bread.drc() estfun.drc()

    -

    Bread and meat for the sandwich

    -

    coef(<drc>)

    -

    Extract Model Coefficients

    -

    confint(<drc>)

    -

    Confidence Intervals for model parameters

    -

    cooks.distance(<drc>) hatvalues(<drc>)

    -

    Model diagnostics for nonlinear dose-response models

    -

    ED(<drc>)

    -

    Estimating effective doses

    -

    fitted(<drc>)

    -

    Extract fitted values from model

    -

    plot(<drc>)

    -

    Plotting fitted dose-response curves

    -

    predict(<drc>)

    -

    Prediction

    -

    print(<drc>)

    -

    Printing key features

    -

    print(<summary.drc>)

    -

    Printing summary of non-linear model fits

    -

    residuals(<drc>)

    -

    Extracting residuals from the fitted dose-response model

    -

    summary(<drc>)

    -

    Summarising non-linear model fits

    -

    vcov(<drc>)

    -

    Calculating variance-covariance matrix for objects of class 'drc'

    -

    Misc

    -

    -
    -

    backfit()

    -

    Calculation of backfit values from a fitted dose-response model

    -

    CIcomp() CIcompX() plotFACI()

    -

    Calculation of combination index for binary mixtures

    -

    comped()

    -

    Comparison of effective dose values

    -

    compParm()

    -

    Comparison of parameters

    -

    drmc()

    -

    Sets control arguments

    -

    ED(<drc>)

    -

    Estimating effective doses

    -

    EDcomp() relpot()

    -

    Comparison of relative potencies between dose-response curves

    -

    getInitial()

    -

    Showing starting values used

    -

    getMeanFunctions()

    -

    Display available dose-response models

    -

    isobole()

    -

    Creating isobolograms

    -

    lin.test()

    -

    Lack-of-fit test for the mean structure based on cumulated residuals

    -

    maED()

    -

    Estimation of ED values using model-averaging

    -

    MAX()

    -

    Maximum mean response

    -

    mixture()

    -

    Fitting binary mixture models

    -

    modelFit()

    -

    Assessing the model fit

    -

    mr.test()

    -

    Mizon-Richard test for dose-response models

    -

    mselect()

    -

    Dose-response model selection

    -

    neill.test()

    -

    Neill's lack-of-fit test for dose-response models

    -

    noEffect()

    -

    Testing if there is a dose effect at all

    -

    PR()

    -

    Expected or predicted response

    -

    rdrm()

    -

    Simulating a dose-response curve

    -

    searchdrc()

    -

    Searching through a range of initial parameter values to obtain convergence

    -

    simDR()

    -

    Simulating ED values under various scenarios

    -

    Dose-response functions

    -

    -
    -

    AR.2() AR.3()

    -

    Asymptotic regression model

    -

    baro5()

    -

    The modified baro5 function

    -

    BC.5() BC.4()

    -

    The Brain-Cousens hormesis models

    -

    braincousens()

    -

    The Brain-Cousens hormesis models

    -

    cedergreen() CRS.6() ucedergreen()

    -

    The Cedergreen-Ritz-Streibig model

    -

    CRS.4a() UCRS.4a()

    -

    The Cedergreen-Ritz-Streibig model

    -

    CRS.5a() UCRS.5a()

    -

    Cedergreen-Ritz-Streibig dose-reponse model for describing hormesis

    -

    EXD.2() EXD.3()

    -

    Exponential decay model

    -

    fplogistic() FPL.4()

    -

    Fractional polynomial-logistic dose-response models

    -

    gompertz()

    -

    Mean function for the Gompertz dose-response or growth curve

    -

    gammadr()

    -

    Gamma dose-response model

    -

    gaussian() lgaussian()

    -

    Normal and log-normal biphasic dose-response models

    -

    ursa()

    -

    Model function for the universal response surface approach (URSA) for the quantitative assessment of drug interaction

    -

    gompertzd()

    -

    The derivative of the Gompertz function

    -

    logistic() L.3() L.4() L.5()

    -

    The logistic model

    -

    LL.2() l2() LL2.2()

    -

    The two-parameter log-logistic function

    -

    LL.3() LL.3u() l3() l3u() LL2.3() LL2.3u()

    -

    The three-parameter log-logistic function

    -

    LL.4() l4() LL2.4()

    -

    The four-parameter log-logistic function

    -

    LL.5() l5() LL2.5()

    -

    The five-parameter log-logistic function

    -

    llogistic() llogistic2()

    -

    The log-logistic function

    -

    lnormal() LN.2() LN.3() LN.3u() LN.4()

    -

    Log-normal dose-response model

    -

    MM.2() MM.3()

    -

    Michaelis-Menten model

    -

    multi2()

    -

    Multistage dose-response model with quadratic terms

    -

    NEC() NEC.2() NEC.3() NEC.4()

    -

    Dose-response model for estimation of no effect concentration (NEC).

    -

    twophase()

    -

    Two-phase dose-response model

    -

    W1.2() W2.2()

    -

    The two-parameter Weibull functions

    -

    W1.3() W2.3() W2x.3() W1.3u() W2.3u()

    -

    The three-parameter Weibull functions

    -

    W1.4() W2.4()

    -

    The four-parameter Weibull functions

    -

    weibull1() weibull2() weibull2x()

    -

    Weibull model functions

    -
    +
    - -
    + coef(<drc>) + + +
    Extract Model Coefficients
    + +
    + + confint(<drc>) + +
    +
    Confidence Intervals for Model Parameters
    + +
    + + cooks.distance(<drc>) + +
    +
    Cook's distance for nonlinear dose-response models
    + +
    + + estfun(<drc>) + +
    +
    Estimating function for the sandwich estimator
    + +
    + + fitted(<drc>) + +
    +
    Extract fitted values from model
    + +
    + + hatvalues(<drc>) + +
    +
    Model diagnostics for nonlinear dose-response models
    + +
    + + logLik(<drc>) + +
    +
    Extracting the log likelihood
    + +
    + + plot(<drc>) + +
    +
    Plotting fitted dose-response curves
    + +
    + + predict(<drc>) + +
    +
    Prediction
    + +
    + + print(<drc>) + +
    +
    Printing key features
    + +
    + + print(<summary.drc>) + +
    +
    Printing summary of non-linear model fits
    + +
    + + residuals(<drc>) + +
    +
    Extracting residuals from the fitted dose-response model
    + +
    + + summary(<drc>) + +
    +
    Summarising non-linear model fits
    + +
    + + update(<drc>) + +
    +
    Updating and re-fitting a model
    + +
    + + vcov(<drc>) + +
    +
    Calculating variance-covariance matrix for objects of class 'drc'
    + +
    + + bread(<drc>) + +
    +
    Bread for the sandwich estimator
    +
    +

    Datasets

    + +

    Example datasets for dose-response analysis

    + +
    + + + + +
    + + acidiq + +
    +
    Acifluorfen and diquat tested on Lemna minor.
    + +
    + + aconiazide + +
    +
    Weight change in rats after exposure to a medical drug
    + +
    + + acute.inh + +
    +
    Acute inhalation
    + +
    + + algae + +
    +
    Volume of algae as function of increasing concentrations of a herbicide
    + +
    + + arbovirus + +
    +
    arbovirus
    + +
    + + auxins + +
    +
    Effect of technical grade and commercially formulated auxin herbicides
    + +
    + + barley + +
    +
    Barley
    + +
    + + bees + +
    +
    bees
    + +
    + + blackgrass + +
    +
    Seedling Emergence of Blackgrass (Alopecurus myosuroides)
    + +
    + + broccoli + +
    +
    The Effects of Drought Stress on Leaf Development in a Brassica oleracea population
    + +
    + + C.dubia + +
    +
    Offsprings resulting from a toxicity test
    + +
    + + CadmiumDaphnia + +
    +
    Cadmium Daphnia Data
    + +
    + + carbendazim + +
    +
    Damage of lymphocyte cells
    + +
    + + chickweed + +
    +
    Germination of common chickweed (Stellaria media)
    + +
    + + chlorac + +
    +
    chlorac
    + +
    + + chlordan + +
    +
    Chlordan
    + +
    + + ctb + +
    +
    CellTiter-Blue Cell Viability Assay Data
    + +
    + + Cyp17 + +
    +
    Cyp17 expression data
    + +
    + + Daphnia + +
    +
    Daphnia
    + +
    + + daphnids + +
    +
    Daphnia test
    + +
    + + decontaminants + +
    +
    Performance of decontaminants used in the culturing of a micro-organism
    + +
    + + deguelin + +
    +
    Deguelin applied to chrysanthemum aphis
    + +
    + + earthworms + +
    +
    Earthworm toxicity test
    + +
    + + echovirus -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +
    Infections as response to exposure with Echovirus 12
    + +
    + + Eryngium.sparganophyllum + +
    +
    Germination of Eryngium sparganophyllum
    + +
    + + etmotc + +
    +
    Effect of erythromycin on mixed sewage microorganisms
    + +
    + + finney71 + +
    +
    Example from Finney (1971)
    + +
    + + fluoranthene + +
    +
    Death of fathead minnow larvae after exposure to fluoranthene
    + +
    + + germination + +
    +
    Germination of three crops
    + +
    + + GiantKelp + +
    +
    Measurements of germination tubes for Giant Kelp
    + +
    + + glymet + +
    +
    Glyphosate and metsulfuron-methyl tested on algae.
    + +
    + + guthion + +
    +
    guthion
    + +
    + + H.virescens + +
    +
    Mortality of tobacco budworms
    + +
    + + heartrate + +
    +
    Heart rate baroreflexes for rabbits
    + +
    + + leaflength + +
    +
    Leaf length of barley
    + +
    + + lemna + +
    +
    Lemna
    + +
    + + lepidium + +
    +
    Dose-response profile of degradation of agrochemical using lepidium
    + +
    + + lettuce + +
    +
    Hormesis in lettuce plants
    + +
    + + liver.tumor + +
    +
    Liver tumor incidence
    + +
    + + M.bahia + +
    +
    Effect of an effluent on the growth of mysid shrimp
    + +
    + + mdra + +
    +
    3T3 mouse fibroblasts and NRU assay
    + +
    + + mecter + +
    +
    Mechlorprop and terbythylazine tested on Lemna minor
    + +
    + + metals + +
    +
    Data from heavy metal mixture experiments
    + +
    + + methionine + +
    +
    Weight gain for different methionine sources
    + +
    + + mixture() + +
    +
    Fitting binary mixture models
    + +
    + + multi2() + +
    +
    Multistage Dose-Response Model with Quadratic Terms
    + +
    + + nasturtium + +
    +
    Dose-response profile of degradation of agrochemical using nasturtium
    + +
    + + nfa + +
    +
    Network Formation Assay Data
    + +
    + + nicotine + +
    +
    nicotine
    + +
    + + O.mykiss + +
    +
    Test data from a 21 day fish test
    + +
    + + P.promelas + +
    +
    Effect of sodium pentachlorophenate on growth of fathead minnow
    + +
    + + RScompetition + +
    +
    Competition between two biotypes
    + +
    + + red.fescue + +
    +
    Red fescue
    + +
    + + ryegrass + +
    +
    Effect of ferulic acid on growth of ryegrass
    + +
    + + ryegrass2 + +
    +
    Ryegrass
    + +
    + + S.alba + +
    +
    Potency of two herbicides
    + +
    + + S.alba.comp + +
    +
    Potency of two herbicides
    + +
    + + S.capricornutum + +
    +
    Effect of cadmium on growth of green alga
    + +
    + + secalonic + +
    +
    Root length measurements
    + +
    + + selenium + +
    +
    Data from toxicology experiments with selenium
    + +
    + + spinach + +
    +
    Inhibition of photosynthesis
    + +
    + + TCDD + +
    +
    Liver tumor incidence
    + +
    + + terbuthylazin + +
    +
    The effect of terbuthylazin on growth rate
    + +
    + + ursa() + +
    +
    Universal Response Surface Approach (URSA) for Drug Interaction
    + +
    + + vinclozolin + +
    +
    Vinclozolin from AR in vitro assay
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -

    Site built with pkgdown.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -
    + + + + - - - + diff --git a/docs/reference/index.md b/docs/reference/index.md new file mode 100644 index 00000000..78dfb615 --- /dev/null +++ b/docs/reference/index.md @@ -0,0 +1,538 @@ +# Package index + +## Core Functions + +Main functions for dose-response analysis + +- [`drm()`](https://hreinwald.github.io/drc/reference/drm.md) : Fitting + dose-response models +- [`ED()`](https://hreinwald.github.io/drc/reference/ED.md) : Estimating + effective doses +- [`EDcomp()`](https://hreinwald.github.io/drc/reference/EDcomp.md) : + Comparison of relative potencies between dose-response curves +- [`compParm()`](https://hreinwald.github.io/drc/reference/compParm.md) + : Comparison of parameters +- [`mselect()`](https://hreinwald.github.io/drc/reference/mselect.md) : + Dose-response model selection +- [`drmc()`](https://hreinwald.github.io/drc/reference/drmc.md) : Sets + control arguments + +## Model Functions + +Available dose-response model families + +- [`LL.2()`](https://hreinwald.github.io/drc/reference/LL.2.md) + [`l2()`](https://hreinwald.github.io/drc/reference/LL.2.md) : + Two-parameter log-logistic function +- [`LL.3()`](https://hreinwald.github.io/drc/reference/LL.3.md) + [`l3()`](https://hreinwald.github.io/drc/reference/LL.3.md) : + Three-parameter log-logistic function +- [`LL.3u()`](https://hreinwald.github.io/drc/reference/LL.3u.md) + [`l3u()`](https://hreinwald.github.io/drc/reference/LL.3u.md) : + Three-parameter log-logistic function with upper limit fixed +- [`LL.4()`](https://hreinwald.github.io/drc/reference/LL.4.md) + [`l4()`](https://hreinwald.github.io/drc/reference/LL.4.md) : + Four-parameter log-logistic function +- [`LL.5()`](https://hreinwald.github.io/drc/reference/LL.5.md) + [`l5()`](https://hreinwald.github.io/drc/reference/LL.5.md) : + Five-parameter log-logistic function +- [`LL2.2()`](https://hreinwald.github.io/drc/reference/LL2.2.md) : + Two-Parameter Log-Logistic Model with log(ED50) as Parameter +- [`LL2.3()`](https://hreinwald.github.io/drc/reference/LL2.3.md) : + Three-Parameter Log-Logistic Model with log(ED50) and Lower Limit at 0 +- [`LL2.3u()`](https://hreinwald.github.io/drc/reference/LL2.3u.md) : + Three-Parameter Log-Logistic Model with log(ED50) and Fixed Upper + Limit +- [`LL2.4()`](https://hreinwald.github.io/drc/reference/LL2.4.md) : + Four-Parameter Log-Logistic Model with log(ED50) as Parameter +- [`LL2.5()`](https://hreinwald.github.io/drc/reference/LL2.5.md) : + Five-Parameter Generalised Log-Logistic Model with log(ED50) as + Parameter +- [`W1.2()`](https://hreinwald.github.io/drc/reference/W1.2.md) + [`w2()`](https://hreinwald.github.io/drc/reference/W1.2.md) : + Two-parameter Weibull type 1 model +- [`W1.3()`](https://hreinwald.github.io/drc/reference/W1.3.md) + [`w3()`](https://hreinwald.github.io/drc/reference/W1.3.md) : + Three-parameter Weibull type 1 model +- [`W1.3u()`](https://hreinwald.github.io/drc/reference/W1.3u.md) : + Three-parameter Weibull type 1 model with upper limit fixed +- [`W1.4()`](https://hreinwald.github.io/drc/reference/W1.4.md) + [`w4()`](https://hreinwald.github.io/drc/reference/W1.4.md) : + Four-parameter Weibull type 1 model +- [`W2.2()`](https://hreinwald.github.io/drc/reference/W2.2.md) : + Two-parameter Weibull (type 2) model +- [`W2.3()`](https://hreinwald.github.io/drc/reference/W2.3.md) : + Three-parameter Weibull (type 2) model +- [`W2.3u()`](https://hreinwald.github.io/drc/reference/W2.3u.md) : + Three-parameter Weibull (type 2) model with upper limit fixed +- [`W2.4()`](https://hreinwald.github.io/drc/reference/W2.4.md) : + Four-parameter Weibull (type 2) model +- [`W2x.3()`](https://hreinwald.github.io/drc/reference/W2x.3.md) : + Three-parameter Weibull type 2 model with lag time +- [`W2x.4()`](https://hreinwald.github.io/drc/reference/W2x.4.md) : + Four-parameter Weibull type 2 model with lag time +- [`G.2()`](https://hreinwald.github.io/drc/reference/G.2.md) : + Two-parameter Gompertz model +- [`G.3()`](https://hreinwald.github.io/drc/reference/G.3.md) : + Three-parameter Gompertz model +- [`G.3u()`](https://hreinwald.github.io/drc/reference/G.3u.md) : + Three-parameter Gompertz model with upper limit fixed +- [`G.4()`](https://hreinwald.github.io/drc/reference/G.4.md) : + Four-parameter Gompertz model +- [`G.aparine`](https://hreinwald.github.io/drc/reference/G.aparine.md) + : Herbicide applied to Galium aparine +- [`GiantKelp`](https://hreinwald.github.io/drc/reference/GiantKelp.md) + : Measurements of germination tubes for Giant Kelp +- [`LN.2()`](https://hreinwald.github.io/drc/reference/LN.2.md) : + Two-parameter log-normal dose-response model +- [`LN.3()`](https://hreinwald.github.io/drc/reference/LN.3.md) : + Three-parameter log-normal dose-response model +- [`LN.3u()`](https://hreinwald.github.io/drc/reference/LN.3u.md) : + Three-parameter log-normal model with upper limit fixed +- [`LN.4()`](https://hreinwald.github.io/drc/reference/LN.4.md) : + Four-parameter log-normal dose-response model +- [`BC.4()`](https://hreinwald.github.io/drc/reference/BC.4.md) : + Four-parameter Brain-Cousens hormesis model +- [`BC.5()`](https://hreinwald.github.io/drc/reference/BC.5.md) : + Five-parameter Brain-Cousens hormesis model +- [`CRS.4a()`](https://hreinwald.github.io/drc/reference/CRS.4a.md) + **\[deprecated\]** : Cedergreen-Ritz-Streibig Model with Lower Limit + Fixed at 0 and Alpha = 1 (Deprecated) +- [`CRS.4b()`](https://hreinwald.github.io/drc/reference/CRS.4b.md) + **\[deprecated\]** : Cedergreen-Ritz-Streibig Model with Lower Limit + Fixed at 0 and Alpha = 0.5 (Deprecated) +- [`CRS.4c()`](https://hreinwald.github.io/drc/reference/CRS.4c.md) + **\[deprecated\]** : Cedergreen-Ritz-Streibig Model with Lower Limit + Fixed at 0 and Alpha = 0.25 (Deprecated) +- [`CRS.5()`](https://hreinwald.github.io/drc/reference/CRS.5.md) : + Wrapper for 5-parameter Cedergreen-Ritz-Streibig Model +- [`CRS.5a()`](https://hreinwald.github.io/drc/reference/CRS.5a.md) + **\[deprecated\]** : Cedergreen-Ritz-Streibig Five-Parameter Model + with Alpha = 1 (Deprecated) +- [`CRS.5b()`](https://hreinwald.github.io/drc/reference/CRS.5b.md) + **\[deprecated\]** : Cedergreen-Ritz-Streibig Five-Parameter Model + with Alpha = 0.5 (Deprecated) +- [`CRS.5c()`](https://hreinwald.github.io/drc/reference/CRS.5c.md) + **\[deprecated\]** : Cedergreen-Ritz-Streibig Five-Parameter Model + with Alpha = 0.25 (Deprecated) +- [`CRS.6()`](https://hreinwald.github.io/drc/reference/CRS.6.md) : + Generalised Cedergreen-Ritz-Streibig Model for Hormesis +- [`UCRS.4a()`](https://hreinwald.github.io/drc/reference/UCRS.4a.md) : + U-shaped CRS model with lower limit 0 (alpha=1) +- [`UCRS.4b()`](https://hreinwald.github.io/drc/reference/UCRS.4b.md) : + U-shaped CRS model with lower limit 0 (alpha=0.5) +- [`UCRS.4c()`](https://hreinwald.github.io/drc/reference/UCRS.4c.md) : + U-shaped CRS model with lower limit 0 (alpha=0.25) +- [`UCRS.5a()`](https://hreinwald.github.io/drc/reference/UCRS.5a.md) : + U-shaped CRS five-parameter model (alpha=1) +- [`UCRS.5b()`](https://hreinwald.github.io/drc/reference/UCRS.5b.md) : + U-shaped CRS five-parameter model (alpha=0.5) +- [`UCRS.5c()`](https://hreinwald.github.io/drc/reference/UCRS.5c.md) : + U-shaped CRS five-parameter model (alpha=0.25) +- [`NEC.2()`](https://hreinwald.github.io/drc/reference/NEC.2.md) : + Two-parameter NEC model +- [`NEC.3()`](https://hreinwald.github.io/drc/reference/NEC.3.md) : + Three-parameter NEC model +- [`NEC.4()`](https://hreinwald.github.io/drc/reference/NEC.4.md) : + Four-parameter NEC model +- [`L.3()`](https://hreinwald.github.io/drc/reference/L.3.md) : + Three-parameter logistic model +- [`L.4()`](https://hreinwald.github.io/drc/reference/L.4.md) : + Four-parameter logistic model +- [`L.5()`](https://hreinwald.github.io/drc/reference/L.5.md) : + Five-parameter generalized logistic model +- [`AR.2()`](https://hreinwald.github.io/drc/reference/AR.2.md) : + Two-parameter asymptotic regression model +- [`AR.3()`](https://hreinwald.github.io/drc/reference/AR.3.md) : + Three-parameter shifted asymptotic regression model +- [`EXD.2()`](https://hreinwald.github.io/drc/reference/EXD.2.md) : + Two-parameter exponential decay model +- [`EXD.3()`](https://hreinwald.github.io/drc/reference/EXD.3.md) : + Three-parameter exponential decay model +- [`MM.2()`](https://hreinwald.github.io/drc/reference/MM.2.md) : + Two-parameter Michaelis-Menten function +- [`MM.3()`](https://hreinwald.github.io/drc/reference/MM.3.md) : + Three-parameter Michaelis-Menten function +- [`FPL.4()`](https://hreinwald.github.io/drc/reference/FPL.4.md) : + Four-parameter fractional polynomial-logistic model +- [`ml3a()`](https://hreinwald.github.io/drc/reference/ml3a.md) + **\[deprecated\]** : Alias for CRS.4a (Deprecated) +- [`ml3b()`](https://hreinwald.github.io/drc/reference/ml3b.md) + **\[deprecated\]** : Alias for CRS.4b (Deprecated) +- [`ml3c()`](https://hreinwald.github.io/drc/reference/ml3c.md) + **\[deprecated\]** : Alias for CRS.4c (Deprecated) +- [`ml4a()`](https://hreinwald.github.io/drc/reference/ml4a.md) + **\[deprecated\]** : Alias for CRS.5a (Deprecated) +- [`ml4b()`](https://hreinwald.github.io/drc/reference/ml4b.md) + **\[deprecated\]** : Alias for CRS.5b (Deprecated) +- [`ml4c()`](https://hreinwald.github.io/drc/reference/ml4c.md) + **\[deprecated\]** : Alias for CRS.5c (Deprecated) +- [`uml3a()`](https://hreinwald.github.io/drc/reference/uml3a.md) : + Alias for UCRS.4a +- [`uml3b()`](https://hreinwald.github.io/drc/reference/uml3b.md) : + Alias for UCRS.4b +- [`uml3c()`](https://hreinwald.github.io/drc/reference/uml3c.md) : + Alias for UCRS.4c +- [`uml4a()`](https://hreinwald.github.io/drc/reference/uml4a.md) : + Alias for UCRS.5a +- [`uml4b()`](https://hreinwald.github.io/drc/reference/uml4b.md) : + Alias for UCRS.5b +- [`uml4c()`](https://hreinwald.github.io/drc/reference/uml4c.md) : + Alias for UCRS.5c +- [`bcl3()`](https://hreinwald.github.io/drc/reference/bcl3.md) : Alias + for BC.4 +- [`bcl4()`](https://hreinwald.github.io/drc/reference/bcl4.md) : Alias + for BC.5 +- [`baro5()`](https://hreinwald.github.io/drc/reference/baro5.md) : The + Baroreflex Five-Parameter Dose-Response Model +- [`braincousens()`](https://hreinwald.github.io/drc/reference/braincousens.md) + : The Brain-Cousens hormesis models +- [`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md) + : Cedergreen-Ritz-Streibig Model +- [`ucedergreen()`](https://hreinwald.github.io/drc/reference/ucedergreen.md) + : U-shaped Cedergreen-Ritz-Streibig model +- [`fplogistic()`](https://hreinwald.github.io/drc/reference/fplogistic.md) + : Fractional polynomial-logistic dose-response model +- [`gammadr()`](https://hreinwald.github.io/drc/reference/gammadr.md) : + Gamma Dose-Response Model +- [`gaussian()`](https://hreinwald.github.io/drc/reference/gaussian.md) + : Normal (Gaussian) biphasic dose-response model +- [`gompertz()`](https://hreinwald.github.io/drc/reference/gompertz.md) + : Gompertz dose-response or growth curve model +- [`gompertzd()`](https://hreinwald.github.io/drc/reference/gompertzd.md) + : Derivative of the Gompertz function +- [`lgaussian()`](https://hreinwald.github.io/drc/reference/lgaussian.md) + : Log-normal (log-Gaussian) biphasic dose-response model +- [`llogistic()`](https://hreinwald.github.io/drc/reference/llogistic.md) + : The log-logistic function +- [`llogistic2()`](https://hreinwald.github.io/drc/reference/llogistic2.md) + : Five-Parameter Log-Logistic Model with log(ED50) as Parameter +- [`lnormal()`](https://hreinwald.github.io/drc/reference/lnormal.md) : + Log-normal dose-response model +- [`logistic()`](https://hreinwald.github.io/drc/reference/logistic.md) + : The general asymmetric five-parameter logistic model +- [`threephase()`](https://hreinwald.github.io/drc/reference/threephase.md) + : Three-Phase Dose-Response Model +- [`twophase()`](https://hreinwald.github.io/drc/reference/twophase.md) + : Two-Phase Dose-Response Model +- [`weibull1()`](https://hreinwald.github.io/drc/reference/weibull1.md) + : The four-parameter Weibull type 1 model +- [`weibull2()`](https://hreinwald.github.io/drc/reference/weibull2.md) + : The four-parameter Weibull (type 2) model +- [`weibull2x()`](https://hreinwald.github.io/drc/reference/weibull2x.md) + : Five-parameter Weibull type 2 model with lag time +- [`yieldLoss()`](https://hreinwald.github.io/drc/reference/yieldLoss.md) + : Calculating yield loss parameters +- [`arandaordaz()`](https://hreinwald.github.io/drc/reference/arandaordaz.md) + : Asymptotic Regression Model + +## Effective Dose Estimation + +Functions for estimating effective doses and comparisons + +- [`ED(`*``*`)`](https://hreinwald.github.io/drc/reference/ED.drc.md) + : Estimating effective doses +- [`ED_robust()`](https://hreinwald.github.io/drc/reference/ED_robust.md) + : Robust Calculation of Effective Doses (ED) +- [`CIcomp()`](https://hreinwald.github.io/drc/reference/CIcomp.md) : + Classical combination index for effective doses +- [`CIcompX()`](https://hreinwald.github.io/drc/reference/CIcompX.md) : + Calculation of combination index for binary mixtures +- [`comped()`](https://hreinwald.github.io/drc/reference/comped.md) : + Comparison of effective dose values +- [`maED()`](https://hreinwald.github.io/drc/reference/maED.md) : + Estimation of ED values using model-averaging +- [`maED_robust()`](https://hreinwald.github.io/drc/reference/maED_robust.md) + : Robust Calculation of Model-Averaged Effective Doses +- [`isobole()`](https://hreinwald.github.io/drc/reference/isobole.md) : + Creating isobolograms +- [`NEC()`](https://hreinwald.github.io/drc/reference/NEC.md) : No + Effect Concentration (NEC) dose-response model +- [`MAX()`](https://hreinwald.github.io/drc/reference/MAX.md) : Maximum + mean response +- [`PR()`](https://hreinwald.github.io/drc/reference/PR.md) : Expected + or predicted response +- [`relpot()`](https://hreinwald.github.io/drc/reference/relpot.md) : + Relative potency function + +## Diagnostics and Model Selection + +Model diagnostics and helper functions + +- [`modelFit()`](https://hreinwald.github.io/drc/reference/modelFit.md) + : Assessing the model fit +- [`Rsq()`](https://hreinwald.github.io/drc/reference/Rsq.md) : + R-squared for dose-response models +- [`rss()`](https://hreinwald.github.io/drc/reference/rss.md) : Residual + sum of squares for dose-response models +- [`rdrm()`](https://hreinwald.github.io/drc/reference/rdrm.md) : + Simulating a dose-response curve +- [`anova(`*``*`)`](https://hreinwald.github.io/drc/reference/anova.drc.md) + : ANOVA Model Comparison for Dose-Response Models +- [`lin.test()`](https://hreinwald.github.io/drc/reference/lin.test.md) + : Lack-of-fit test for the mean structure based on cumulated residuals +- [`mr.test()`](https://hreinwald.github.io/drc/reference/mr.test.md) : + Mizon-Richard test for dose-response models +- [`neill.test()`](https://hreinwald.github.io/drc/reference/neill.test.md) + : Neill's lack-of-fit test for dose-response models +- [`noEffect()`](https://hreinwald.github.io/drc/reference/noEffect.md) + : Testing if there is a dose effect at all +- [`backfit()`](https://hreinwald.github.io/drc/reference/backfit.md) : + Calculation of backfit values from a fitted dose-response model +- [`boxcox(`*``*`)`](https://hreinwald.github.io/drc/reference/boxcox.drc.md) + : Transform-both-sides Box-Cox transformation +- [`searchdrc()`](https://hreinwald.github.io/drc/reference/searchdrc.md) + : Search through a range of initial parameter values to obtain + convergence +- [`simDR()`](https://hreinwald.github.io/drc/reference/simDR.md) : + Simulating ED values under various scenarios +- [`simFct()`](https://hreinwald.github.io/drc/reference/simFct.md) : + Simulation of dose-response data and ED estimation +- [`plotFACI()`](https://hreinwald.github.io/drc/reference/plotFACI.md) + : Plot combination index as a function of fraction affected +- [`getInitial()`](https://hreinwald.github.io/drc/reference/getInitial.md) + : Showing starting values used +- [`getMeanFunctions()`](https://hreinwald.github.io/drc/reference/getMeanFunctions.md) + : Display available dose-response models + +## S3 Methods + +Methods for drc model objects + +- [`coef(`*``*`)`](https://hreinwald.github.io/drc/reference/coef.drc.md) + : Extract Model Coefficients +- [`confint(`*``*`)`](https://hreinwald.github.io/drc/reference/confint.drc.md) + : Confidence Intervals for Model Parameters +- [`cooks.distance(`*``*`)`](https://hreinwald.github.io/drc/reference/cooks.distance.drc.md) + : Cook's distance for nonlinear dose-response models +- [`estfun(`*``*`)`](https://hreinwald.github.io/drc/reference/estfun.drc.md) + : Estimating function for the sandwich estimator +- [`fitted(`*``*`)`](https://hreinwald.github.io/drc/reference/fitted.drc.md) + : Extract fitted values from model +- [`hatvalues(`*``*`)`](https://hreinwald.github.io/drc/reference/hatvalues.drc.md) + : Model diagnostics for nonlinear dose-response models +- [`logLik(`*``*`)`](https://hreinwald.github.io/drc/reference/logLik.drc.md) + : Extracting the log likelihood +- [`plot(`*``*`)`](https://hreinwald.github.io/drc/reference/plot.drc.md) + : Plotting fitted dose-response curves +- [`predict(`*``*`)`](https://hreinwald.github.io/drc/reference/predict.drc.md) + : Prediction +- [`print(`*``*`)`](https://hreinwald.github.io/drc/reference/print.drc.md) + : Printing key features +- [`print(`*``*`)`](https://hreinwald.github.io/drc/reference/print.summary.drc.md) + : Printing summary of non-linear model fits +- [`residuals(`*``*`)`](https://hreinwald.github.io/drc/reference/residuals.drc.md) + : Extracting residuals from the fitted dose-response model +- [`summary(`*``*`)`](https://hreinwald.github.io/drc/reference/summary.drc.md) + : Summarising non-linear model fits +- [`update(`*``*`)`](https://hreinwald.github.io/drc/reference/update.drc.md) + : Updating and re-fitting a model +- [`vcov(`*``*`)`](https://hreinwald.github.io/drc/reference/vcov.drc.md) + : Calculating variance-covariance matrix for objects of class 'drc' +- [`bread(`*``*`)`](https://hreinwald.github.io/drc/reference/bread.drc.md) + : Bread for the sandwich estimator + +## Datasets + +Example datasets for dose-response analysis + +- [`acidiq`](https://hreinwald.github.io/drc/reference/acidiq.md) : + Acifluorfen and diquat tested on Lemna minor. + +- [`aconiazide`](https://hreinwald.github.io/drc/reference/aconiazide.md) + : Weight change in rats after exposure to a medical drug + +- [`acute.inh`](https://hreinwald.github.io/drc/reference/acute.inh.md) + : Acute inhalation + +- [`algae`](https://hreinwald.github.io/drc/reference/algae.md) : Volume + of algae as function of increasing concentrations of a herbicide + +- [`arbovirus`](https://hreinwald.github.io/drc/reference/arbovirus.md) + : arbovirus + +- [`auxins`](https://hreinwald.github.io/drc/reference/auxins.md) : + Effect of technical grade and commercially formulated auxin herbicides + +- [`barley`](https://hreinwald.github.io/drc/reference/barley.md) : + Barley + +- [`bees`](https://hreinwald.github.io/drc/reference/bees.md) : bees + +- [`blackgrass`](https://hreinwald.github.io/drc/reference/blackgrass.md) + : Seedling Emergence of Blackgrass (Alopecurus myosuroides) + +- [`broccoli`](https://hreinwald.github.io/drc/reference/broccoli.md) : + + The Effects of Drought Stress on Leaf Development in a *Brassica + oleracea* population + +- [`C.dubia`](https://hreinwald.github.io/drc/reference/C.dubia.md) : + Offsprings resulting from a toxicity test + +- [`CadmiumDaphnia`](https://hreinwald.github.io/drc/reference/CadmiumDaphnia.md) + : Cadmium Daphnia Data + +- [`carbendazim`](https://hreinwald.github.io/drc/reference/carbendazim.md) + : Damage of lymphocyte cells + +- [`chickweed`](https://hreinwald.github.io/drc/reference/chickweed.md) + : + + Germination of common chickweed (*Stellaria media*) + +- [`chlorac`](https://hreinwald.github.io/drc/reference/chlorac.md) : + chlorac + +- [`chlordan`](https://hreinwald.github.io/drc/reference/chlordan.md) : + Chlordan + +- [`ctb`](https://hreinwald.github.io/drc/reference/ctb.md) : + CellTiter-Blue Cell Viability Assay Data + +- [`Cyp17`](https://hreinwald.github.io/drc/reference/Cyp17.md) : Cyp17 + expression data + +- [`Daphnia`](https://hreinwald.github.io/drc/reference/Daphnia.md) : + Daphnia + +- [`daphnids`](https://hreinwald.github.io/drc/reference/daphnids.md) : + Daphnia test + +- [`decontaminants`](https://hreinwald.github.io/drc/reference/decontaminants.md) + : Performance of decontaminants used in the culturing of a + micro-organism + +- [`deguelin`](https://hreinwald.github.io/drc/reference/deguelin.md) : + Deguelin applied to chrysanthemum aphis + +- [`earthworms`](https://hreinwald.github.io/drc/reference/earthworms.md) + : Earthworm toxicity test + +- [`echovirus`](https://hreinwald.github.io/drc/reference/echovirus.md) + : + + Infections as response to exposure with *Echovirus 12* + +- [`Eryngium.sparganophyllum`](https://hreinwald.github.io/drc/reference/Eryngium.sparganophyllum.md) + : Germination of Eryngium sparganophyllum + +- [`etmotc`](https://hreinwald.github.io/drc/reference/etmotc.md) : + Effect of erythromycin on mixed sewage microorganisms + +- [`finney71`](https://hreinwald.github.io/drc/reference/finney71.md) : + Example from Finney (1971) + +- [`fluoranthene`](https://hreinwald.github.io/drc/reference/fluoranthene.md) + : Death of fathead minnow larvae after exposure to fluoranthene + +- [`germination`](https://hreinwald.github.io/drc/reference/germination.md) + : Germination of three crops + +- [`GiantKelp`](https://hreinwald.github.io/drc/reference/GiantKelp.md) + : Measurements of germination tubes for Giant Kelp + +- [`glymet`](https://hreinwald.github.io/drc/reference/glymet.md) : + Glyphosate and metsulfuron-methyl tested on algae. + +- [`guthion`](https://hreinwald.github.io/drc/reference/guthion.md) : + guthion + +- [`H.virescens`](https://hreinwald.github.io/drc/reference/H.virescens.md) + : Mortality of tobacco budworms + +- [`heartrate`](https://hreinwald.github.io/drc/reference/heartrate.md) + : Heart rate baroreflexes for rabbits + +- [`leaflength`](https://hreinwald.github.io/drc/reference/leaflength.md) + : Leaf length of barley + +- [`lemna`](https://hreinwald.github.io/drc/reference/lemna.md) : Lemna + +- [`lepidium`](https://hreinwald.github.io/drc/reference/lepidium.md) : + Dose-response profile of degradation of agrochemical using lepidium + +- [`lettuce`](https://hreinwald.github.io/drc/reference/lettuce.md) : + Hormesis in lettuce plants + +- [`liver.tumor`](https://hreinwald.github.io/drc/reference/liver.tumor.md) + : Liver tumor incidence + +- [`M.bahia`](https://hreinwald.github.io/drc/reference/M.bahia.md) : + Effect of an effluent on the growth of mysid shrimp + +- [`mdra`](https://hreinwald.github.io/drc/reference/mdra.md) : 3T3 + mouse fibroblasts and NRU assay + +- [`mecter`](https://hreinwald.github.io/drc/reference/mecter.md) : + Mechlorprop and terbythylazine tested on Lemna minor + +- [`metals`](https://hreinwald.github.io/drc/reference/metals.md) : Data + from heavy metal mixture experiments + +- [`methionine`](https://hreinwald.github.io/drc/reference/methionine.md) + : Weight gain for different methionine sources + +- [`mixture()`](https://hreinwald.github.io/drc/reference/mixture.md) : + Fitting binary mixture models + +- [`multi2()`](https://hreinwald.github.io/drc/reference/multi2.md) : + Multistage Dose-Response Model with Quadratic Terms + +- [`nasturtium`](https://hreinwald.github.io/drc/reference/nasturtium.md) + : Dose-response profile of degradation of agrochemical using + nasturtium + +- [`nfa`](https://hreinwald.github.io/drc/reference/nfa.md) : Network + Formation Assay Data + +- [`nicotine`](https://hreinwald.github.io/drc/reference/nicotine.md) : + nicotine + +- [`O.mykiss`](https://hreinwald.github.io/drc/reference/O.mykiss.md) : + Test data from a 21 day fish test + +- [`P.promelas`](https://hreinwald.github.io/drc/reference/P.promelas.md) + : Effect of sodium pentachlorophenate on growth of fathead minnow + +- [`RScompetition`](https://hreinwald.github.io/drc/reference/RScompetition.md) + : Competition between two biotypes + +- [`red.fescue`](https://hreinwald.github.io/drc/reference/red.fescue.md) + : Red fescue + +- [`ryegrass`](https://hreinwald.github.io/drc/reference/ryegrass.md) : + Effect of ferulic acid on growth of ryegrass + +- [`ryegrass2`](https://hreinwald.github.io/drc/reference/ryegrass2.md) + : Ryegrass + +- [`S.alba`](https://hreinwald.github.io/drc/reference/S.alba.md) : + Potency of two herbicides + +- [`S.alba.comp`](https://hreinwald.github.io/drc/reference/S.alba.comp.md) + : Potency of two herbicides + +- [`S.capricornutum`](https://hreinwald.github.io/drc/reference/S.capricornutum.md) + : Effect of cadmium on growth of green alga + +- [`secalonic`](https://hreinwald.github.io/drc/reference/secalonic.md) + : Root length measurements + +- [`selenium`](https://hreinwald.github.io/drc/reference/selenium.md) : + Data from toxicology experiments with selenium + +- [`spinach`](https://hreinwald.github.io/drc/reference/spinach.md) : + Inhibition of photosynthesis + +- [`TCDD`](https://hreinwald.github.io/drc/reference/TCDD.md) : Liver + tumor incidence + +- [`terbuthylazin`](https://hreinwald.github.io/drc/reference/terbuthylazin.md) + : The effect of terbuthylazin on growth rate + +- [`ursa()`](https://hreinwald.github.io/drc/reference/ursa.md) : + Universal Response Surface Approach (URSA) for Drug Interaction + +- [`vinclozolin`](https://hreinwald.github.io/drc/reference/vinclozolin.md) + : Vinclozolin from AR in vitro assay diff --git a/docs/reference/isobole.html b/docs/reference/isobole.html index c3befee4..e44c2e08 100644 --- a/docs/reference/isobole.html +++ b/docs/reference/isobole.html @@ -1,213 +1,156 @@ - - - - - - +Creating isobolograms — isobole • drc + Skip to contents -Creating isobolograms — isobole • drc - - - +
    +
    +
    +

    Creating isobolograms

    + Source: R/isobole.R +
    isobole.Rd
    +
    - +
    +

    isobole displays isobole based on EC/ED50 estimates from a log-logistic model. +Additionally isoboles determined by the concentration addition model, Hewlett's model +and Voelund's model can be added to the plot.

    +
    - - +
    +

    Usage

    + 
    isobole(
+  object1,
+  object2,
+  exchange = 1,
+  cifactor = 2,
+  ename = "e",
+  xaxis = "100",
+  xlab,
+  ylab,
+  xlim,
+  ylim,
+  ...
+)
    +
    +
    +

    Arguments

    - - +
    object1
    +

    object of class 'drc' where EC/ED50 parameters vary freely.

    - +
    object2
    +

    object of class 'drc' where EC/ED50 parameters vary according to Hewlett's model.

    - - -
    -
    - - - -
    -
    -
    -
    -

    Creating isobolograms

    - - -
    +
    cifactor
    +

    numeric. The factor to be used in the confidence intervals. Default is 2, +but 1 has been used in publications.

    -
    - -

    'isobole' displays isobole based on EC/ED50 estimates from a log-logistic model. - Additionally isoboles determined by the concentration addition model, Hewlett's - model and Voelund's model can be added to the plot.

    - -
    - 
    isobole(object1, object2, exchange = 1, cifactor = 2, ename = "e",
-xaxis = "100", xlab, ylab, xlim, ylim, ...)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    object1

    object of class 'drc' where EC/ED50 parameters vary freely.

    object2

    object of class 'drc' where EC/ED50 parameters vary according to Hewlett's model.

    ename

    character string. The name of the EC/ED50 variable.

    xaxis

    character string. Is the mixture "0:100" or "100:0" on the x axis?

    exchange

    numeric. The exchange rate between the two substances.

    cifactor

    numeric. The factor to be used in the confidence intervals. - Default is 2, but 1 has been used in publications.

    xlab

    an optional label for the x axis.

    ylab

    an optional label for the y axis.

    xlim

    a numeric vector of length two, containing the lower and upper limit for the x axis.

    ylim

    a numeric vector of length two, containing the lower and upper limit for the y axis.

    …

    Additional graphical parameters.

    - -

    Details

    +
    ename
    +

    character string. The name of the EC/ED50 variable.

    -

    The model fits to be supplied as first and optionally second argument are obtained - using mixture and drm.

    - -

    Value

    -

    No value is returned. Only used for the side effect: the isobologram shown.

    - -

    References

    +
    xaxis
    +

    character string. Is the mixture "0:100" or "100:0" on the x axis?

    -

    Ritz, C. and Streibig, J. C. (2014) - From additivity to synergism - A modelling perspective - Synergy, 1, 22--29.

    - -
    - -
    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    ylim
    +

    a numeric vector of length two, containing the lower and upper limit for the y axis.

    + + +
    ...
    +

    Additional graphical parameters.

    + +
    +
    +

    Value

    +

    No value is returned. Only used for the side effect: the isobologram shown.

    +
    +
    +

    Details

    +

    The model fits to be supplied as first and optionally second argument are obtained +using mixture and drm.

    +
    +
    +

    References

    +

    Ritz, C. and Streibig, J. C. (2014) From additivity to synergism - A +modelling perspective Synergy, 1, 22–29.

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -

    Site built with pkgdown.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -
    + + + + - - - + diff --git a/docs/reference/isobole.md b/docs/reference/isobole.md new file mode 100644 index 00000000..3fdbdc79 --- /dev/null +++ b/docs/reference/isobole.md @@ -0,0 +1,95 @@ +# Creating isobolograms + +`isobole` displays isobole based on EC/ED50 estimates from a +log-logistic model. Additionally isoboles determined by the +concentration addition model, Hewlett's model and Voelund's model can be +added to the plot. + +## Usage + +``` r +isobole( + object1, + object2, + exchange = 1, + cifactor = 2, + ename = "e", + xaxis = "100", + xlab, + ylab, + xlim, + ylim, + ... +) +``` + +## Arguments + +- object1: + + object of class 'drc' where EC/ED50 parameters vary freely. + +- object2: + + object of class 'drc' where EC/ED50 parameters vary according to + Hewlett's model. + +- exchange: + + numeric. The exchange rate between the two substances. + +- cifactor: + + numeric. The factor to be used in the confidence intervals. Default is + 2, but 1 has been used in publications. + +- ename: + + character string. The name of the EC/ED50 variable. + +- xaxis: + + character string. Is the mixture "0:100" or "100:0" on the x axis? + +- xlab: + + an optional label for the x axis. + +- ylab: + + an optional label for the y axis. + +- xlim: + + a numeric vector of length two, containing the lower and upper limit + for the x axis. + +- ylim: + + a numeric vector of length two, containing the lower and upper limit + for the y axis. + +- ...: + + Additional graphical parameters. + +## Value + +No value is returned. Only used for the side effect: the isobologram +shown. + +## Details + +The model fits to be supplied as first and optionally second argument +are obtained using +[`mixture`](https://hreinwald.github.io/drc/reference/mixture.md) and +[`drm`](https://hreinwald.github.io/drc/reference/drm.md). + +## References + +Ritz, C. and Streibig, J. C. (2014) From additivity to synergism - A +modelling perspective *Synergy*, **1**, 22–29. + +## Author + +Christian Ritz diff --git a/docs/reference/l2.html b/docs/reference/l2.html new file mode 100644 index 00000000..0cad3219 --- /dev/null +++ b/docs/reference/l2.html @@ -0,0 +1,8 @@ + + + + + + + + diff --git a/docs/reference/l3.html b/docs/reference/l3.html new file mode 100644 index 00000000..1839822a --- /dev/null +++ b/docs/reference/l3.html @@ -0,0 +1,8 @@ + + + + + + + + diff --git a/docs/reference/l3u.html b/docs/reference/l3u.html new file mode 100644 index 00000000..27de0c3c --- /dev/null +++ b/docs/reference/l3u.html @@ -0,0 +1,8 @@ + + + + + + + + diff --git a/docs/reference/l4.html b/docs/reference/l4.html new file mode 100644 index 00000000..a753d58e --- /dev/null +++ b/docs/reference/l4.html @@ -0,0 +1,8 @@ + + + + + + + + diff --git a/docs/reference/l5.html b/docs/reference/l5.html new file mode 100644 index 00000000..ee121f84 --- /dev/null +++ b/docs/reference/l5.html @@ -0,0 +1,8 @@ + + + + + + + + diff --git a/docs/reference/leaflength-1.png b/docs/reference/leaflength-1.png new file mode 100644 index 00000000..48f22058 Binary files /dev/null and b/docs/reference/leaflength-1.png differ diff --git a/docs/reference/leaflength-2.png b/docs/reference/leaflength-2.png new file mode 100644 index 00000000..2f5678a1 Binary files /dev/null and b/docs/reference/leaflength-2.png differ diff --git a/docs/reference/leaflength.html b/docs/reference/leaflength.html new file mode 100644 index 00000000..82c77b35 --- /dev/null +++ b/docs/reference/leaflength.html @@ -0,0 +1,136 @@ + +Leaf length of barley — leaflength • drc + Skip to contents + + +
    +
    +
    +

    Leaf length of barley

    + +
    leaflength.Rd
    +
    + +
    +

    In an experiment barley was grown in a hydroponic solution with a herbicide.

    +
    + +
    +

    Usage

    + 
    data(leaflength)
    +
    + +
    +

    Format

    +

    A data frame with 42 observations on the following 2 variables.

    Dose
    +

    a numeric vector

    + +
    DW
    +

    a numeric vector

    + + +
    +
    +

    Details

    +

    The dataset exhibits a large hormetical effect.

    +
    +
    +

    Source

    +

    Nina Cedergreen, Royal Veterinary and Agricultural University, Denmark.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Fitting a hormesis model
+leaflength.crs4c1 <- drm(DW ~ Dose, data = leaflength, fct = CRS.4c())
+plot(fitted(leaflength.crs4c1), residuals(leaflength.crs4c1))
+
+
+leaflength.crs4c2 <- boxcox(drm(DW ~ Dose, data = leaflength, fct = CRS.4c()), 
+method = "anova", plotit = FALSE)
+summary(leaflength.crs4c2)
+#> 
+#> Model fitted: Cedergreen-Ritz-Streibig with lower limit 0 (alpha=0.25) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                 Estimate Std. Error t-value   p-value    
+#> b:(Intercept)   0.489758   0.030686 15.9603 < 2.2e-16 ***
+#> d:(Intercept)  10.020054   1.590491  6.3000 2.209e-07 ***
+#> e:(Intercept)   0.019138   0.028983  0.6603    0.5130    
+#> f:(Intercept) 381.722590 234.463424  1.6281    0.1118    
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  1.188513 (38 degrees of freedom)
+#> 
+#> Non-normality/heterogeneity adjustment through Box-Cox transformation
+#> 
+#> Estimated lambda: 0.5 
+#> Confidence interval for lambda: [0.420,0.785] 
+#> 
+
+## Plottinf fitted curve and original data
+plot(leaflength.crs4c2, broken = TRUE, conLevel = 0.001, type = "all", legend = FALSE, 
+ylab = "Produced leaf length (cm)", xlab = "Metsulfuron-methyl (mg/l)",
+main = "Hormesis: leaf length of barley")
+#> Warning: "conLevel" is not a graphical parameter
+#> Warning: "conLevel" is not a graphical parameter
+#> Warning: "conLevel" is not a graphical parameter
+#> Warning: "conLevel" is not a graphical parameter
+#> Warning: "conLevel" is not a graphical parameter
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/leaflength.md b/docs/reference/leaflength.md new file mode 100644 index 00000000..4c759bf3 --- /dev/null +++ b/docs/reference/leaflength.md @@ -0,0 +1,77 @@ +# Leaf length of barley + +In an experiment barley was grown in a hydroponic solution with a +herbicide. + +## Usage + +``` r +data(leaflength) +``` + +## Format + +A data frame with 42 observations on the following 2 variables. + +- `Dose`: + + a numeric vector + +- `DW`: + + a numeric vector + +## Details + +The dataset exhibits a large hormetical effect. + +## Source + +Nina Cedergreen, Royal Veterinary and Agricultural University, Denmark. + +## Examples + +``` r +library(drc) + +## Fitting a hormesis model +leaflength.crs4c1 <- drm(DW ~ Dose, data = leaflength, fct = CRS.4c()) +plot(fitted(leaflength.crs4c1), residuals(leaflength.crs4c1)) + + +leaflength.crs4c2 <- boxcox(drm(DW ~ Dose, data = leaflength, fct = CRS.4c()), +method = "anova", plotit = FALSE) +summary(leaflength.crs4c2) +#> +#> Model fitted: Cedergreen-Ritz-Streibig with lower limit 0 (alpha=0.25) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 0.489758 0.030686 15.9603 < 2.2e-16 *** +#> d:(Intercept) 10.020054 1.590491 6.3000 2.209e-07 *** +#> e:(Intercept) 0.019138 0.028983 0.6603 0.5130 +#> f:(Intercept) 381.722590 234.463424 1.6281 0.1118 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 1.188513 (38 degrees of freedom) +#> +#> Non-normality/heterogeneity adjustment through Box-Cox transformation +#> +#> Estimated lambda: 0.5 +#> Confidence interval for lambda: [0.420,0.785] +#> + +## Plottinf fitted curve and original data +plot(leaflength.crs4c2, broken = TRUE, conLevel = 0.001, type = "all", legend = FALSE, +ylab = "Produced leaf length (cm)", xlab = "Metsulfuron-methyl (mg/l)", +main = "Hormesis: leaf length of barley") +#> Warning: "conLevel" is not a graphical parameter +#> Warning: "conLevel" is not a graphical parameter +#> Warning: "conLevel" is not a graphical parameter +#> Warning: "conLevel" is not a graphical parameter +#> Warning: "conLevel" is not a graphical parameter +``` diff --git a/docs/reference/leaveOneOut.html b/docs/reference/leaveOneOut.html new file mode 100644 index 00000000..0eb96fc4 --- /dev/null +++ b/docs/reference/leaveOneOut.html @@ -0,0 +1,70 @@ + +Model-robust dose-response modelling — leaveOneOut • drc + Skip to contents + + +
    +
    +
    +

    Model-robust dose-response modelling

    + Source: R/mrdrm.R +
    leaveOneOut.Rd
    +
    + +
    +

    Model-robust dose-response modelling

    +
    + +
    +

    Usage

    + 
    leaveOneOut(object1, object2, dose, dataSet, resp, fixedEnd)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/leaveOneOut.md b/docs/reference/leaveOneOut.md new file mode 100644 index 00000000..4161e37b --- /dev/null +++ b/docs/reference/leaveOneOut.md @@ -0,0 +1,9 @@ +# Model-robust dose-response modelling + +Model-robust dose-response modelling + +## Usage + +``` r +leaveOneOut(object1, object2, dose, dataSet, resp, fixedEnd) +``` diff --git a/docs/reference/lemna-1.png b/docs/reference/lemna-1.png new file mode 100644 index 00000000..c7a92627 Binary files /dev/null and b/docs/reference/lemna-1.png differ diff --git a/docs/reference/lemna.html b/docs/reference/lemna.html new file mode 100644 index 00000000..efb971ed --- /dev/null +++ b/docs/reference/lemna.html @@ -0,0 +1,120 @@ + +Lemna — lemna • drc + Skip to contents + + +
    +
    +
    +

    Lemna

    + +
    lemna.Rd
    +
    + +
    +

    Data from a dose-response experiment with the aquatic plant Lemna minor (duckweed). The response measured was the frond number (count) at different concentrations of a test substance.

    +
    + +
    +

    Usage

    + 
    data(lemna)
    +
    + +
    +

    Format

    +

    A data frame with 44 observations on the following 2 variables.

    conc
    +

    a numeric vector containing the concentration.

    + +
    frond.num
    +

    a numeric vector containing the response (count).

    + + +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Displaying the data
+head(lemna)
+#>   conc frond.num
+#> 1    0        70
+#> 2    0        66
+#> 3    0        61
+#> 4    0        65
+#> 5    0        65
+#> 6    0        61
+
+## Fitting a four-parameter log-logistic model
+lemna.m1 <- drm(frond.num ~ conc, data = lemna, fct = LL.4())
+summary(lemna.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept)  0.80378    0.13342  6.0246 4.364e-07 ***
+#> c:(Intercept) 25.12544    4.10027  6.1278 3.125e-07 ***
+#> d:(Intercept) 65.67420    1.09101 60.1957 < 2.2e-16 ***
+#> e:(Intercept) 10.05380    3.20991  3.1321  0.003241 ** 
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  3.240232 (40 degrees of freedom)
+
+## Plotting the fitted curve
+plot(lemna.m1, xlab = "Concentration", ylab = "Frond number")
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/lemna.md b/docs/reference/lemna.md new file mode 100644 index 00000000..007cb209 --- /dev/null +++ b/docs/reference/lemna.md @@ -0,0 +1,62 @@ +# Lemna + +Data from a dose-response experiment with the aquatic plant *Lemna +minor* (duckweed). The response measured was the frond number (count) at +different concentrations of a test substance. + +## Usage + +``` r +data(lemna) +``` + +## Format + +A data frame with 44 observations on the following 2 variables. + +- `conc`: + + a numeric vector containing the concentration. + +- `frond.num`: + + a numeric vector containing the response (count). + +## Examples + +``` r +library(drc) + +## Displaying the data +head(lemna) +#> conc frond.num +#> 1 0 70 +#> 2 0 66 +#> 3 0 61 +#> 4 0 65 +#> 5 0 65 +#> 6 0 61 + +## Fitting a four-parameter log-logistic model +lemna.m1 <- drm(frond.num ~ conc, data = lemna, fct = LL.4()) +summary(lemna.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 0.80378 0.13342 6.0246 4.364e-07 *** +#> c:(Intercept) 25.12544 4.10027 6.1278 3.125e-07 *** +#> d:(Intercept) 65.67420 1.09101 60.1957 < 2.2e-16 *** +#> e:(Intercept) 10.05380 3.20991 3.1321 0.003241 ** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 3.240232 (40 degrees of freedom) + +## Plotting the fitted curve +plot(lemna.m1, xlab = "Concentration", ylab = "Frond number") +``` diff --git a/docs/reference/lepidium-1.png b/docs/reference/lepidium-1.png new file mode 100644 index 00000000..6285131a Binary files /dev/null and b/docs/reference/lepidium-1.png differ diff --git a/docs/reference/lepidium.html b/docs/reference/lepidium.html new file mode 100644 index 00000000..0f27898a --- /dev/null +++ b/docs/reference/lepidium.html @@ -0,0 +1,111 @@ + +Dose-response profile of degradation of agrochemical using lepidium — lepidium • drc + Skip to contents + + +
    +
    +
    +

    Dose-response profile of degradation of agrochemical using lepidium

    + +
    lepidium.Rd
    +
    + +
    +

    Estimation of the degradation profile of an agrochemical based on soil samples at depth 0-10cm + from a calibration experiment.

    +
    + +
    +

    Usage

    + 
    data(lepidium)
    +
    + +
    +

    Format

    +

    A data frame with 42 observations on the following 2 variables.

    conc
    +

    a numeric vector of concentrations (g/ha)

    + +
    weight
    +

    a numeric vector of plant weight (g) after 3 weeks' growth

    + + +
    +
    +

    Details

    +

    It is an experiment with seven concentrations and six replicates per concentration. Lepidium + is rather robust as it only responds to high concentrations.

    +
    +
    +

    Source

    +

    Racine-Poon, A. (1988) A Bayesian Approach to Nonlinear Calibration Problems, + J. Am. Statist. Ass., 83, 650–656.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+lepidium.m1 <- drm(weight~conc, data=lepidium, fct = LL.4())
+
+modelFit(lepidium.m1)
+#> Lack-of-fit test
+#> 
+#>           ModelDf    RSS Df F value p value
+#> ANOVA          35 14.187                   
+#> DRC model      38 14.449  3  0.2159  0.8847
+
+plot(lepidium.m1, type = "all", log = "")
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/lepidium.md b/docs/reference/lepidium.md new file mode 100644 index 00000000..5fd163be --- /dev/null +++ b/docs/reference/lepidium.md @@ -0,0 +1,50 @@ +# Dose-response profile of degradation of agrochemical using lepidium + +Estimation of the degradation profile of an agrochemical based on soil +samples at depth 0-10cm from a calibration experiment. + +## Usage + +``` r +data(lepidium) +``` + +## Format + +A data frame with 42 observations on the following 2 variables. + +- `conc`: + + a numeric vector of concentrations (g/ha) + +- `weight`: + + a numeric vector of plant weight (g) after 3 weeks' growth + +## Details + +It is an experiment with seven concentrations and six replicates per +concentration. *Lepidium* is rather robust as it only responds to high +concentrations. + +## Source + +Racine-Poon, A. (1988) A Bayesian Approach to Nonlinear Calibration +Problems, *J. Am. Statist. Ass.*, **83**, 650–656. + +## Examples + +``` r +library(drc) + +lepidium.m1 <- drm(weight~conc, data=lepidium, fct = LL.4()) + +modelFit(lepidium.m1) +#> Lack-of-fit test +#> +#> ModelDf RSS Df F value p value +#> ANOVA 35 14.187 +#> DRC model 38 14.449 3 0.2159 0.8847 + +plot(lepidium.m1, type = "all", log = "") +``` diff --git a/docs/reference/lettuce-1.png b/docs/reference/lettuce-1.png new file mode 100644 index 00000000..395cd497 Binary files /dev/null and b/docs/reference/lettuce-1.png differ diff --git a/docs/reference/lettuce.html b/docs/reference/lettuce.html new file mode 100644 index 00000000..8b022191 --- /dev/null +++ b/docs/reference/lettuce.html @@ -0,0 +1,174 @@ + +Hormesis in lettuce plants — lettuce • drc + Skip to contents + + +
    +
    +
    +

    Hormesis in lettuce plants

    + +
    lettuce.Rd
    +
    + +
    +

    Data are from an experiment where isobutylalcohol was dissolved in a nutrient solution in which lettuce + (Lactuca sativa) plants were grown. The plant biomass of the shoot was determined af 21 days.

    +
    + +
    +

    Usage

    + 
    data(lettuce)
    +
    + +
    +

    Format

    +

    A data frame with 14 observations on the following 2 variables.

    conc
    +

    a numeric vector of concentrations of isobutylalcohol (mg/l)

    + +
    weight
    +

    a numeric vector of biomass of shoot (g)

    + + +
    +
    +

    Details

    +

    The data set illustrates hormesis, presence of a subtoxic stimulus at low concentrations.

    +
    +
    +

    Source

    +

    van Ewijk, P. H. and Hoekstra, J. A. (1993) + Calculation of the EC50 and its Confidence Interval When Subtoxic Stimulus Is Present, + ECOTOXICOLOGY AND ENVIRONMENTAL SAFETY, 25, 25–32.

    +
    +
    +

    References

    +

    van Ewijk, P. H. and Hoekstra, J. A. (1994) + Curvature Measures and Confidence Intervals for the Linear Logistic Model, + Appl. Statist., 43, 477–487.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Look at data
+lettuce
+#>      conc weight
+#> 1    0.00  1.126
+#> 2    0.00  0.833
+#> 3    0.32  1.096
+#> 4    0.32  1.106
+#> 5    1.00  1.163
+#> 6    1.00  1.336
+#> 7    3.20  0.985
+#> 8    3.20  0.754
+#> 9   10.00  0.716
+#> 10  10.00  0.683
+#> 11  32.00  0.560
+#> 12  32.00  0.488
+#> 13 100.00  0.375
+#> 14 100.00  0.344
+
+## Monotonous dose-response model
+lettuce.m1 <- drm(weight~conc, data=lettuce, fct=LL.3())
+
+plot(lettuce.m1, broken = TRUE)
+
+## Model fit in van Ewijk and Hoekstra (1994)
+lettuce.m2 <- drm(weight~conc, data=lettuce, fct=BC.4())
+modelFit(lettuce.m2)
+#> Lack-of-fit test
+#> 
+#>           ModelDf      RSS Df F value p value
+#> ANOVA           7 0.088237                   
+#> DRC model      10 0.124975  3  0.9715  0.4582
+
+plot(lettuce.m2, add = TRUE, broken = TRUE, type = "none", lty = 2)
+
+
+## Hormesis effect only slightly significant
+summary(lettuce.m2)
+#> 
+#> Model fitted: Brain-Cousens (hormesis) with lower limit fixed at 0 (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept) 1.282812   0.049346 25.9964 1.632e-10 ***
+#> d:(Intercept) 0.967302   0.077123 12.5423 1.926e-07 ***
+#> e:(Intercept) 0.847633   0.436093  1.9437   0.08059 .  
+#> f:(Intercept) 1.620703   0.979711  1.6543   0.12908    
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.1117922 (10 degrees of freedom)
+
+## Hormesis effect highly significant
+##  compare with t-test for the "f" parameter in the summary output)
+anova(lettuce.m1, lettuce.m2)
+#> 
+#> 1st model
+#>  fct:      LL.3()
+#> 2nd model
+#>  fct:      BC.4()
+#> 
+#> ANOVA table
+#> 
+#>           ModelDf     RSS Df F value p value
+#> 1st model      11 0.24222                   
+#> 2nd model      10 0.12498  1  9.3817  0.0120
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/lettuce.md b/docs/reference/lettuce.md new file mode 100644 index 00000000..15203c1e --- /dev/null +++ b/docs/reference/lettuce.md @@ -0,0 +1,115 @@ +# Hormesis in lettuce plants + +Data are from an experiment where isobutylalcohol was dissolved in a +nutrient solution in which lettuce (*Lactuca sativa*) plants were grown. +The plant biomass of the shoot was determined af 21 days. + +## Usage + +``` r +data(lettuce) +``` + +## Format + +A data frame with 14 observations on the following 2 variables. + +- conc: + + a numeric vector of concentrations of isobutylalcohol (mg/l) + +- weight: + + a numeric vector of biomass of shoot (g) + +## Details + +The data set illustrates hormesis, presence of a subtoxic stimulus at +low concentrations. + +## Source + +van Ewijk, P. H. and Hoekstra, J. A. (1993) Calculation of the EC50 and +its Confidence Interval When Subtoxic Stimulus Is Present, +*ECOTOXICOLOGY AND ENVIRONMENTAL SAFETY*, **25**, 25–32. + +## References + +van Ewijk, P. H. and Hoekstra, J. A. (1994) Curvature Measures and +Confidence Intervals for the Linear Logistic Model, *Appl. Statist.*, +**43**, 477–487. + +## Examples + +``` r +library(drc) + +## Look at data +lettuce +#> conc weight +#> 1 0.00 1.126 +#> 2 0.00 0.833 +#> 3 0.32 1.096 +#> 4 0.32 1.106 +#> 5 1.00 1.163 +#> 6 1.00 1.336 +#> 7 3.20 0.985 +#> 8 3.20 0.754 +#> 9 10.00 0.716 +#> 10 10.00 0.683 +#> 11 32.00 0.560 +#> 12 32.00 0.488 +#> 13 100.00 0.375 +#> 14 100.00 0.344 + +## Monotonous dose-response model +lettuce.m1 <- drm(weight~conc, data=lettuce, fct=LL.3()) + +plot(lettuce.m1, broken = TRUE) + +## Model fit in van Ewijk and Hoekstra (1994) +lettuce.m2 <- drm(weight~conc, data=lettuce, fct=BC.4()) +modelFit(lettuce.m2) +#> Lack-of-fit test +#> +#> ModelDf RSS Df F value p value +#> ANOVA 7 0.088237 +#> DRC model 10 0.124975 3 0.9715 0.4582 + +plot(lettuce.m2, add = TRUE, broken = TRUE, type = "none", lty = 2) + + +## Hormesis effect only slightly significant +summary(lettuce.m2) +#> +#> Model fitted: Brain-Cousens (hormesis) with lower limit fixed at 0 (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 1.282812 0.049346 25.9964 1.632e-10 *** +#> d:(Intercept) 0.967302 0.077123 12.5423 1.926e-07 *** +#> e:(Intercept) 0.847633 0.436093 1.9437 0.08059 . +#> f:(Intercept) 1.620703 0.979711 1.6543 0.12908 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.1117922 (10 degrees of freedom) + +## Hormesis effect highly significant +## compare with t-test for the "f" parameter in the summary output) +anova(lettuce.m1, lettuce.m2) +#> +#> 1st model +#> fct: LL.3() +#> 2nd model +#> fct: BC.4() +#> +#> ANOVA table +#> +#> ModelDf RSS Df F value p value +#> 1st model 11 0.24222 +#> 2nd model 10 0.12498 1 9.3817 0.0120 +``` diff --git a/docs/reference/lgaussian.html b/docs/reference/lgaussian.html new file mode 100644 index 00000000..4110edcb --- /dev/null +++ b/docs/reference/lgaussian.html @@ -0,0 +1,130 @@ + +Log-normal (log-Gaussian) biphasic dose-response model — lgaussian • drc + Skip to contents + + +
    +
    +
    +

    Log-normal (log-Gaussian) biphasic dose-response model

    + Source: R/lgaussian.R +
    lgaussian.Rd
    +
    + +
    +

    Model function for fitting symmetric or skewed bell-shaped/biphasic dose-response patterns +using the log-Gaussian model. This is the log-transformed variant of the gaussian model.

    +
    + +
    +

    Usage

    + 
    lgaussian(
+  fixed = c(NA, NA, NA, NA, NA),
+  names = c("b", "c", "d", "e", "f"),
+  method = c("1", "2", "3", "4"),
+  ssfct = NULL,
+  fctName,
+  fctText,
+  loge = FALSE
+)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector. Specifies which parameters are fixed and at what value they are fixed. +NAs for parameters that are not fixed.

    + + +
    names
    +

    a vector of character strings giving the names of the parameters (should not contain ":"). +The order of the parameters is: b, c, d, e, f.

    + + +
    method
    +

    character string indicating the self starter function to use.

    + + +
    ssfct
    +

    a self starter function to be used.

    + + +
    fctName
    +

    optional character string used internally by convenience functions.

    + + +
    fctText
    +

    optional character string used internally by convenience functions.

    + + +
    loge
    +

    logical indicating whether or not e or log(e) should be a parameter in the model. +By default e is a model parameter.

    + +
    +
    +

    Value

    +

    The value returned is a list containing the nonlinear function, the self starter function +and the parameter names.

    +
    +
    +

    See also

    +

    gaussian, drm

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/lgaussian.md b/docs/reference/lgaussian.md new file mode 100644 index 00000000..b101d8a9 --- /dev/null +++ b/docs/reference/lgaussian.md @@ -0,0 +1,69 @@ +# Log-normal (log-Gaussian) biphasic dose-response model + +Model function for fitting symmetric or skewed bell-shaped/biphasic +dose-response patterns using the log-Gaussian model. This is the +log-transformed variant of the +[`gaussian`](https://hreinwald.github.io/drc/reference/gaussian.md) +model. + +## Usage + +``` r +lgaussian( + fixed = c(NA, NA, NA, NA, NA), + names = c("b", "c", "d", "e", "f"), + method = c("1", "2", "3", "4"), + ssfct = NULL, + fctName, + fctText, + loge = FALSE +) +``` + +## Arguments + +- fixed: + + numeric vector. Specifies which parameters are fixed and at what value + they are fixed. NAs for parameters that are not fixed. + +- names: + + a vector of character strings giving the names of the parameters + (should not contain ":"). The order of the parameters is: b, c, d, e, + f. + +- method: + + character string indicating the self starter function to use. + +- ssfct: + + a self starter function to be used. + +- fctName: + + optional character string used internally by convenience functions. + +- fctText: + + optional character string used internally by convenience functions. + +- loge: + + logical indicating whether or not e or log(e) should be a parameter in + the model. By default e is a model parameter. + +## Value + +The value returned is a list containing the nonlinear function, the self +starter function and the parameter names. + +## See also + +[`gaussian`](https://hreinwald.github.io/drc/reference/gaussian.md), +[`drm`](https://hreinwald.github.io/drc/reference/drm.md) + +## Author + +Christian Ritz diff --git a/docs/reference/lin.test-1.png b/docs/reference/lin.test-1.png index c7de0c82..1d3c8d8c 100644 Binary files a/docs/reference/lin.test-1.png and b/docs/reference/lin.test-1.png differ diff --git a/docs/reference/lin.test-2.png b/docs/reference/lin.test-2.png deleted file mode 100644 index 35612060..00000000 Binary files a/docs/reference/lin.test-2.png and /dev/null differ diff --git a/docs/reference/lin.test.html b/docs/reference/lin.test.html index 876805ea..f4c2bfca 100644 --- a/docs/reference/lin.test.html +++ b/docs/reference/lin.test.html @@ -1,242 +1,171 @@ - - - - - - +Lack-of-fit test for the mean structure based on cumulated residuals — lin.test • drc + Skip to contents -Lack-of-fit test for the mean structure based on cumulated residuals — lin.test • drc - - - +
    +
    +
    +

    Lack-of-fit test for the mean structure based on cumulated residuals

    + Source: R/lin.test.R +
    lin.test.Rd
    +
    - +
    +

    The function provides a lack-of-fit test for the mean structure based on cumulated +residuals from the model fit.

    +
    - - +
    +

    Usage

    + 
    lin.test(
+  object,
+  noksSim = 20,
+  seed = 20070325,
+  plotit = TRUE,
+  log = "",
+  bp = 0.01,
+  xlab,
+  ylab,
+  ylim,
+  ...
+)
    +
    +
    +

    Arguments

    - - +
    object
    +

    object of class 'drc'.

    - +
    noksSim
    +

    numeric specifying the number of simulations used to obtain the p-value.

    - - -
    -
    - - - -
    -
    -
    -
    -

    Lack-of-fit test for the mean structure based on cumulated residuals

    - - -
    +
    plotit
    +

    logical indicating whether or not the observed cumulated residual process +should be plotted. Default is to plot the process.

    -
    - -

    The function provides a lack-of-fit test for the mean structure based on cumulated residuals from the model fit.

    - -
    - 
    lin.test(object, noksSim = 20, seed = 20070325, plotit = TRUE,
-  log = "", bp = 0.01, xlab, ylab, ylim, ...)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    object

    object of class 'drc'.

    noksSim

    numeric specifying the number of simulations used to obtain the p-value.

    seed

    numeric specifying the seed value for the random number generator.

    plotit

    logical indicating whether or not the observed cumulated residual process should be plotted. Default is to - plot the process.

    log

    character string which should contains '"x"' if the x axis is to be logarithmic, '"y"' if the y axis is to be - logarithmic and '"xy"' or '"yx"' if both axes are to be logarithmic. The default is "x". - The empty string "" yields the original axes.

    bp

    numeric value specifying the break point below which the dose is zero (the amount of stretching on - the dose axis above zero in order to create the visual illusion of a logarithmic scale including 0).

    xlab

    string character specifying an optional label for the x axis.

    ylab

    character string specifying an optional label for the y axis.

    ylim

    numeric vector of length two, containing the lower and upper limit for the y axis.

    …

    additional arguments to be passed further to the basic plot method.

    - -

    Details

    - -

    The function provides a graphical model checking of the mean structure in a dose-response model. The graphical - display is supplemented by a p-value based on a supremum-type test.

    -

    The test is applicable even in cases where data are non-normal or exhibit variance heterogeneity.

    - -

    Value

    - -

    A p-value for test of the null hypothesis that the mean structure is appropriate. - Ritz and Martinussen (2009) provide the details.

    - -

    References

    - -

    Ritz, C and Martinussen, T. (2009) - Lack-of-fit tests for assessing mean structures for continuous dose-response data, - Submitted manuscript

    - -

    See also

    - -

    Other available lack-of-fit tests are the Neill test (neill.test) and - ANOVA-based test (modelFit).

    - - -

    Examples

    - 
    
-## Fitting a log-logistic model to the dataset 'etmotc'
-etmotc.m1<-drm(rgr1~dose1, data=etmotc[1:15,], fct=LL.4())
-
-## Test based on umulated residuals
-lin.test(etmotc.m1, 1000)
    #> [1] 0.074
    #lin.test(etmotc.m1, 10000, plotit = FALSE)  # more precise
-
-## Fitting an exponential model to the dataset 'O.mykiss'
-O.mykiss.m1<-drm(weight~conc, data=O.mykiss, fct=EXD.2(), na.action=na.omit)
-
-## ANOVA-based test
-modelFit(O.mykiss.m1)
    #> Lack-of-fit test
-#> 
-#>           ModelDf    RSS Df F value p value
-#> ANOVA          54 17.620                   
-#> DRC model      59 18.492  5  0.5351  0.7488
    
-## Test based on umulated residuals
-lin.test(O.mykiss.m1, log = "", cl = 0.2, xlab = "Dose (mg/l)", main = "B", ylim = c(-0.6, 0.6))
    #> Warning: "cl" is not a graphical parameter
    #> Warning: "cl" is not a graphical parameter
    #> Warning: "cl" is not a graphical parameter
    #> Warning: "cl" is not a graphical parameter
    #> Warning: "cl" is not a graphical parameter
    #> Warning: "cl" is not a graphical parameter
    #> [1] 0.65
    #lin.test(O.mykiss.m1, noksSim = 10000, plotit = FALSE)  # more precise
-
-
    -
    - -
    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    ylab
    +

    character string specifying an optional label for the y axis.

    + + +
    ylim
    +

    numeric vector of length two, containing the lower and upper limit for the y axis.

    + + +
    ...
    +

    additional arguments to be passed further to the basic plot method.

    + +
    +
    +

    Value

    +

    A p-value for test of the null hypothesis that the mean structure is appropriate. +Ritz and Martinussen (2009) provide the details.

    +
    +
    +

    Details

    +

    The function provides a graphical model checking of the mean structure in a dose-response +model. The graphical display is supplemented by a p-value based on a supremum-type test.

    +

    The test is applicable even in cases where data are non-normal or exhibit variance +heterogeneity.

    +
    +
    +

    References

    +

    Ritz, C and Martinussen, T. (2009) Lack-of-fit tests for assessing mean +structures for continuous dose-response data, Submitted manuscript

    +
    +
    +

    See also

    +

    Other available lack-of-fit tests are the Neill test (neill.test) +and ANOVA-based test (modelFit).

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    + +
    +

    Examples

    + 
    ## Fitting a log-logistic model to the dataset 'etmotc'
+etmotc.m1<-drm(rgr1~dose1, data=etmotc[1:15,], fct=LL.4())
+
+## Test based on cumulated residuals
+lin.test(etmotc.m1, 1000)
+
+#> [1] 0.074
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -

    Site built with pkgdown.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -
    + + + + - - - + diff --git a/docs/reference/lin.test.md b/docs/reference/lin.test.md new file mode 100644 index 00000000..7fb42d66 --- /dev/null +++ b/docs/reference/lin.test.md @@ -0,0 +1,112 @@ +# Lack-of-fit test for the mean structure based on cumulated residuals + +The function provides a lack-of-fit test for the mean structure based on +cumulated residuals from the model fit. + +## Usage + +``` r +lin.test( + object, + noksSim = 20, + seed = 20070325, + plotit = TRUE, + log = "", + bp = 0.01, + xlab, + ylab, + ylim, + ... +) +``` + +## Arguments + +- object: + + object of class 'drc'. + +- noksSim: + + numeric specifying the number of simulations used to obtain the + p-value. + +- seed: + + numeric specifying the seed value for the random number generator. + +- plotit: + + logical indicating whether or not the observed cumulated residual + process should be plotted. Default is to plot the process. + +- log: + + character string which should contain `"x"` if the x axis is to be + logarithmic, `"y"` if the y axis is to be logarithmic and `"xy"` or + `"yx"` if both axes are to be logarithmic. The empty string `""` + yields the original axes. + +- bp: + + numeric value specifying the break point below which the dose is zero. + +- xlab: + + character string specifying an optional label for the x axis. + +- ylab: + + character string specifying an optional label for the y axis. + +- ylim: + + numeric vector of length two, containing the lower and upper limit for + the y axis. + +- ...: + + additional arguments to be passed further to the basic + [`plot`](https://rdrr.io/r/graphics/plot.default.html) method. + +## Value + +A p-value for test of the null hypothesis that the mean structure is +appropriate. Ritz and Martinussen (2009) provide the details. + +## Details + +The function provides a graphical model checking of the mean structure +in a dose-response model. The graphical display is supplemented by a +p-value based on a supremum-type test. + +The test is applicable even in cases where data are non-normal or +exhibit variance heterogeneity. + +## References + +Ritz, C and Martinussen, T. (2009) Lack-of-fit tests for assessing mean +structures for continuous dose-response data, *Submitted manuscript* + +## See also + +Other available lack-of-fit tests are the Neill test +([`neill.test`](https://hreinwald.github.io/drc/reference/neill.test.md)) +and ANOVA-based test +([`modelFit`](https://hreinwald.github.io/drc/reference/modelFit.md)). + +## Author + +Christian Ritz + +## Examples + +``` r +## Fitting a log-logistic model to the dataset 'etmotc' +etmotc.m1<-drm(rgr1~dose1, data=etmotc[1:15,], fct=LL.4()) + +## Test based on cumulated residuals +lin.test(etmotc.m1, 1000) + +#> [1] 0.074 +``` diff --git a/docs/reference/liver.tumor-1.png b/docs/reference/liver.tumor-1.png new file mode 100644 index 00000000..47583a41 Binary files /dev/null and b/docs/reference/liver.tumor-1.png differ diff --git a/docs/reference/liver.tumor.html b/docs/reference/liver.tumor.html new file mode 100644 index 00000000..7aa25567 --- /dev/null +++ b/docs/reference/liver.tumor.html @@ -0,0 +1,129 @@ + +Liver tumor incidence — liver.tumor • drc + Skip to contents + + +
    +
    +
    +

    Liver tumor incidence

    + +
    liver.tumor.Rd
    +
    + +
    +

    Liver tumor incidence in female Sprague-Dawley rats exposed to the chemical like 2,3,7,8-tetrachlorodibenzo-pdioxin +(TCDD).

    +
    + +
    +

    Usage

    + 
    data(liver.tumor)
    +
    + +
    +

    Format

    +

    A data frame with 6 observations on the following 3 variables.

    conc
    +

    a numeric vector reporting the concentration of TCDD (ng/kg)

    + +
    total
    +

    a numeric vector

    + +
    incidence
    +

    a numeric vector

    + + +
    +
    +

    Source

    +

    National Toxicology Program. NTP technical report on the toxicology and carcinogenesis +studies of 2,3,7,8-tetrachlorodibenzo-p-dioxin (tcdd) (CAS No. 1746-01-6) in female Harlan +Sprague-Dawley rats (gavage studies). National Toxicology Program technical report series, +(521):4–232, apr 2006.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Displaying the data
+head(liver.tumor)
+#>    conc total incidence
+#> 1  0.00    49         0
+#> 2  2.56    48         0
+#> 3  5.69    46         0
+#> 4  9.79    50         0
+#> 5 16.57    49         1
+#> 6 29.70    53        13
+
+## Fitting a two-parameter log-logistic model for binomial response
+liver.tumor.m1 <- drm(incidence/total ~ conc, weights = total,
+data = liver.tumor, fct = LL.2(), type = "binomial")
+summary(liver.tumor.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept)  -4.9750     1.6897 -2.9443  0.003237 ** 
+#> e:(Intercept)  37.1774     4.1838  8.8859 < 2.2e-16 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+## Plotting the fitted curve
+plot(liver.tumor.m1, xlab = "Concentration of TCDD (ng/kg)",
+ylab = "Tumor incidence")
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/liver.tumor.md b/docs/reference/liver.tumor.md new file mode 100644 index 00000000..582db14b --- /dev/null +++ b/docs/reference/liver.tumor.md @@ -0,0 +1,69 @@ +# Liver tumor incidence + +Liver tumor incidence in female Sprague-Dawley rats exposed to the +chemical like 2,3,7,8-tetrachlorodibenzo-pdioxin (TCDD). + +## Usage + +``` r +data(liver.tumor) +``` + +## Format + +A data frame with 6 observations on the following 3 variables. + +- `conc`: + + a numeric vector reporting the concentration of TCDD (ng/kg) + +- `total`: + + a numeric vector + +- `incidence`: + + a numeric vector + +## Source + +National Toxicology Program. NTP technical report on the toxicology and +carcinogenesis studies of 2,3,7,8-tetrachlorodibenzo-p-dioxin (tcdd) +(CAS No. 1746-01-6) in female Harlan Sprague-Dawley rats (gavage +studies). National Toxicology Program technical report series, +(521):4–232, apr 2006. + +## Examples + +``` r +library(drc) + +## Displaying the data +head(liver.tumor) +#> conc total incidence +#> 1 0.00 49 0 +#> 2 2.56 48 0 +#> 3 5.69 46 0 +#> 4 9.79 50 0 +#> 5 16.57 49 1 +#> 6 29.70 53 13 + +## Fitting a two-parameter log-logistic model for binomial response +liver.tumor.m1 <- drm(incidence/total ~ conc, weights = total, +data = liver.tumor, fct = LL.2(), type = "binomial") +summary(liver.tumor.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) -4.9750 1.6897 -2.9443 0.003237 ** +#> e:(Intercept) 37.1774 4.1838 8.8859 < 2.2e-16 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 + +## Plotting the fitted curve +plot(liver.tumor.m1, xlab = "Concentration of TCDD (ng/kg)", +ylab = "Tumor incidence") +``` diff --git a/docs/reference/llogistic.html b/docs/reference/llogistic.html index 50498d4e..afc22655 100644 --- a/docs/reference/llogistic.html +++ b/docs/reference/llogistic.html @@ -1,225 +1,135 @@ - - - - - - +The log-logistic function — llogistic • drc + Skip to contents -The log-logistic function — llogistic • drc - - - +
    +
    +
    +

    The log-logistic function

    + Source: R/llogistic.R +
    llogistic.Rd
    +
    - +
    +

    A very general way of specifying log-logistic models under various +constraints on parameters.

    +
    - - +
    +

    Usage

    + 
    llogistic(
+  fixed = c(NA, NA, NA, NA, NA),
+  names = c("b", "c", "d", "e", "f"),
+  method = c("1", "2", "3", "4"),
+  ssfct = NULL,
+  fctName,
+  fctText
+)
    +
    +
    +

    Arguments

    - - +
    fixed
    +

    numeric vector of length 5, specifying fixed parameters +(use NA for non-fixed parameters).

    - +
    names
    +

    character vector of length 5, specifying the names of the +parameters: b, c, d, e, f.

    - - -
    -
    - - - -
    -
    -
    -
    -

    The log-logistic function

    - - -
    +
    ssfct
    +

    a self starter function to be used.

    -
    - -

    'llogistic' provides a very general way of specifying log-logistic models, - under various constraints on the parameters.

    - -
    - 
    llogistic(fixed = c(NA, NA, NA, NA, NA),
-  names = c("b", "c", "d", "e", "f"),
-  method = c("1", "2", "3", "4"), ssfct = NULL,
-  fctName, fctText)
-
-  llogistic2(fixed = c(NA, NA, NA, NA, NA),
-  names = c("b", "c", "d", "e", "f"),
-  ss = c("1", "2", "3"), ssfct = NULL,
-  fctName, fctText)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    fixed

    numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.

    names

    a vector of character strings giving the names of the parameters (should not contain ":"). - The default is reasonable (see under 'Usage'). The order of the parameters is: b, c, d, e, f - (see under 'Details').

    method

    character string indicating the self starter function to use.

    ss

    character string indicating the self starter function to use.

    ssfct

    a self starter function to be used.

    fctName

    optional character string used internally by convenience functions.

    fctText

    optional character string used internally by convenience functions.

    - -

    Details

    - -

    The default arguments yields the five-parameter log-logistic function given by the expression

    -

    $$ f(x) = c + \frac{d-c}{(1+\exp(b(\log(x)-\log(e))))^f}$$

    -

    If the parameter \(f\) differs from 1 then the function is asymmetric; otherwise it - is symmetric (on log scale). This function is fitted using llogistic.

    -

    The log-logistic function with log(e) rather than e as a parameter, that is using the parameterisation

    -

    $$ f(x) = c + \frac{d-c}{(1+\exp(b(\log(x)-e)))^f}$$

    -

    is fitted using llogistic2.

    -

    Sometimes the log-logistic models are also called Hill models.

    - -

    Value

    - -

    The value returned is a list containing the nonlinear function, the self starter function - and the parameter names.

    - -

    References

    - -

    Finney, D. J. (1979) Bioassay and the Practise of Statistical Inference, - Int. Statist. Rev., 47, 1--12.

    -

    Seber, G. A. F. and Wild, C. J. (1989) Nonlinear Regression, New York: Wiley \& Sons (p. 330).

    - -

    Note

    - -

    The functions are for use with the function drm.

    - -

    See also

    - -

    For convenience several special cases are available: - LL.2, LL.3, LL.4 and LL.5. - Examples are provided in the help pages for these functions.

    - +
    fctName
    +

    optional character string used internally.

    -
    -
    +
    +

    Value

    +

    A list containing the nonlinear function, the self starter function, +and the parameter names.

    +
    +
    +

    Details

    +

    The five-parameter log-logistic function is given by the expression +$$f(x) = c + \frac{d-c}{(1+\exp(b(\log(x)-\log(e))))^f}$$

    +
    +
    +

    References

    +

    Finney, D. J. (1979).

    +

    Seber, G. A. F. and Wild, C. J. (1989).

    +
    +
    +

    See also

    +

    LL.2, LL.3, LL.4, +LL.5

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    -
  • Note
    • +
    -
  • See also
    • - -

    Author

    - Christian Ritz -
    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + -
    - - - - + diff --git a/docs/reference/llogistic.md b/docs/reference/llogistic.md new file mode 100644 index 00000000..3645176a --- /dev/null +++ b/docs/reference/llogistic.md @@ -0,0 +1,72 @@ +# The log-logistic function + +A very general way of specifying log-logistic models under various +constraints on parameters. + +## Usage + +``` r +llogistic( + fixed = c(NA, NA, NA, NA, NA), + names = c("b", "c", "d", "e", "f"), + method = c("1", "2", "3", "4"), + ssfct = NULL, + fctName, + fctText +) +``` + +## Arguments + +- fixed: + + numeric vector of length 5, specifying fixed parameters (use NA for + non-fixed parameters). + +- names: + + character vector of length 5, specifying the names of the parameters: + b, c, d, e, f. + +- method: + + character string indicating the self starter function to use. + +- ssfct: + + a self starter function to be used. + +- fctName: + + optional character string used internally. + +- fctText: + + optional character string used internally. + +## Value + +A list containing the nonlinear function, the self starter function, and +the parameter names. + +## Details + +The five-parameter log-logistic function is given by the expression +\$\$f(x) = c + \frac{d-c}{(1+\exp(b(\log(x)-\log(e))))^f}\$\$ + +## References + +Finney, D. J. (1979). + +Seber, G. A. F. and Wild, C. J. (1989). + +## See also + +[`LL.2`](https://hreinwald.github.io/drc/reference/LL.2.md), +[`LL.3`](https://hreinwald.github.io/drc/reference/LL.3.md), +[`LL.4`](https://hreinwald.github.io/drc/reference/LL.4.md), +[`LL.5`](https://hreinwald.github.io/drc/reference/LL.5.md) + +## Author + +Christian Ritz diff --git a/docs/reference/llogistic.ssf.html b/docs/reference/llogistic.ssf.html new file mode 100644 index 00000000..bab901dd --- /dev/null +++ b/docs/reference/llogistic.ssf.html @@ -0,0 +1,70 @@ + +Self-starter for log-logistic model — llogistic.ssf • drc + Skip to contents + + +
    +
    +
    +

    Self-starter for log-logistic model

    + Source: R/llogistic.ssf.R +
    llogistic.ssf.Rd
    +
    + +
    +

    Self-starter for log-logistic model

    +
    + +
    +

    Usage

    + 
    llogistic.ssf(method = c("1", "2", "3", "4"), fixed, useFixed = FALSE)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/llogistic.ssf.md b/docs/reference/llogistic.ssf.md new file mode 100644 index 00000000..89e2ffc5 --- /dev/null +++ b/docs/reference/llogistic.ssf.md @@ -0,0 +1,9 @@ +# Self-starter for log-logistic model + +Self-starter for log-logistic model + +## Usage + +``` r +llogistic.ssf(method = c("1", "2", "3", "4"), fixed, useFixed = FALSE) +``` diff --git a/docs/reference/llogistic2.html b/docs/reference/llogistic2.html new file mode 100644 index 00000000..a85eec95 --- /dev/null +++ b/docs/reference/llogistic2.html @@ -0,0 +1,135 @@ + +Five-Parameter Log-Logistic Model with log(ED50) as Parameter — llogistic2 • drc + Skip to contents + + +
    +
    +
    +

    Five-Parameter Log-Logistic Model with log(ED50) as Parameter

    + Source: R/llogistic2.R +
    llogistic2.Rd
    +
    + +
    +

    A five-parameter log-logistic model where the ED50 is parameterised on the +log scale. The mean function is: +$$f(x) = c + \frac{d - c}{(1 + \exp(b(\log(x) - e)))^f}$$ +where e is the logarithm of the ED50 (not exponentiated).

    +
    + +
    +

    Usage

    + 
    llogistic2(
+  fixed = c(NA, NA, NA, NA, NA),
+  names = c("b", "c", "d", "e", "f"),
+  ss = c("1", "2", "3"),
+  ssfct = NULL,
+  fctName,
+  fctText
+)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector of length 5. Specifies which parameters are +fixed and at what value. Use NA for parameters that should be +estimated.

    + + +
    names
    +

    character vector of length 5 giving the names of the +parameters b, c, d, e, and f.

    + + +
    ss
    +

    character string indicating the self-starter version to use. +One of "1" (default), "2", or "3".

    + + +
    ssfct
    +

    optional self-starter function. If provided, overrides the +built-in self-starter selected by ss.

    + + +
    fctName
    +

    optional character string specifying the name of the function.

    + + +
    fctText
    +

    optional character string providing a short description of +the function.

    + +
    +
    +

    Value

    +

    A list of class "llogistic" containing the nonlinear function, +self-starter function, parameter names, and related helper functions.

    +
    +
    +

    See also

    +

    llogistic, LL2.2, LL2.3, +LL2.4, LL2.5

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/llogistic2.md b/docs/reference/llogistic2.md new file mode 100644 index 00000000..7b2a0069 --- /dev/null +++ b/docs/reference/llogistic2.md @@ -0,0 +1,67 @@ +# Five-Parameter Log-Logistic Model with log(ED50) as Parameter + +A five-parameter log-logistic model where the ED50 is parameterised on +the log scale. The mean function is: \$\$f(x) = c + \frac{d - c}{(1 + +\exp(b(\log(x) - e)))^f}\$\$ where `e` is the logarithm of the ED50 (not +exponentiated). + +## Usage + +``` r +llogistic2( + fixed = c(NA, NA, NA, NA, NA), + names = c("b", "c", "d", "e", "f"), + ss = c("1", "2", "3"), + ssfct = NULL, + fctName, + fctText +) +``` + +## Arguments + +- fixed: + + numeric vector of length 5. Specifies which parameters are fixed and + at what value. Use `NA` for parameters that should be estimated. + +- names: + + character vector of length 5 giving the names of the parameters `b`, + `c`, `d`, `e`, and `f`. + +- ss: + + character string indicating the self-starter version to use. One of + `"1"` (default), `"2"`, or `"3"`. + +- ssfct: + + optional self-starter function. If provided, overrides the built-in + self-starter selected by `ss`. + +- fctName: + + optional character string specifying the name of the function. + +- fctText: + + optional character string providing a short description of the + function. + +## Value + +A list of class `"llogistic"` containing the nonlinear function, +self-starter function, parameter names, and related helper functions. + +## See also + +[`llogistic`](https://hreinwald.github.io/drc/reference/llogistic.md), +[`LL2.2`](https://hreinwald.github.io/drc/reference/LL2.2.md), +[`LL2.3`](https://hreinwald.github.io/drc/reference/LL2.3.md), +[`LL2.4`](https://hreinwald.github.io/drc/reference/LL2.4.md), +[`LL2.5`](https://hreinwald.github.io/drc/reference/LL2.5.md) + +## Author + +Christian Ritz diff --git a/docs/reference/lnormal.html b/docs/reference/lnormal.html index 582d0d91..ac5add1e 100644 --- a/docs/reference/lnormal.html +++ b/docs/reference/lnormal.html @@ -1,245 +1,144 @@ - - - - - - +Log-normal dose-response model — lnormal • drc + Skip to contents -Log-normal dose-response model — lnormal • drc - - - +
    +
    +
    +

    Log-normal dose-response model

    + Source: R/lnormal.R +
    lnormal.Rd
    +
    - - - - +
    +

    lnormal provides a general framework for specifying the mean function of the +decreasing or increasing log-normal dose-response model.

    +
    +
    +

    Usage

    + 
    lnormal(
+  fixed = c(NA, NA, NA, NA),
+  names = c("b", "c", "d", "e"),
+  method = c("1", "2", "3", "4"),
+  ssfct = NULL,
+  fctName,
+  fctText,
+  loge = FALSE
+)
    +
    +
    +

    Arguments

    - - - +
    fixed
    +

    numeric vector. Specifies which parameters are fixed and at what value they are fixed. +NAs for parameters that are not fixed.

    - +
    names
    +

    vector of character strings giving the names of the parameters (should not contain ":"). +The order of the parameters is: b, c, d, e.

    - -
    -
    - - - -
    +
    method
    +

    character string indicating the self starter function to use.

    -
    -
    -
    -

    Log-normal dose-response model

    - - -
    -
    - -

    lnormal and the accompanying convenience functions provide a general framework for specifying - the mean function of the decreasing or incresing log-normal dose-response model.

    - -
    +
    ssfct
    +

    a self starter function to be used.

    - 
    lnormal(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"),
-  method = c("1", "2", "3", "4"), ssfct = NULL,
-  fctName, fctText, loge = FALSE)
-
-  LN.2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...)
-
-  LN.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...)
-
-  LN.3u(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...)
-
-  LN.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    fixed

    numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.

    names

    vector of character strings giving the names of the parameters (should not contain ":"). - The default is reasonable (see under 'Usage'). The order of the parameters is: b, c, d, e, f - (see under 'Details' for the precise meaning of each parameter).

    method

    character string indicating the self starter function to use.

    ssfct

    a self starter function to be used.

    fctName

    character string used internally by convenience functions (optional).

    fctText

    character string used internally by convenience functions (optional).

    loge

    logical indicating whether or not ED50 or log(ED50) should be a parameter in the model. - By default ED50 is a model parameter.

    upper

    numeric specifying the upper horizontal asymptote in the convenience function. - The default is 1.

    ...

    additional arguments to be passed from the convenience functions to lnormal.

    - -

    Details

    - -

    For the case where log(ED50), denoted \(e\) in the equation below, is a parameter in the model, - the mean function is:

    -

    $$f(x) = c + (d-c)(\Phi(b(\log(x)-e)))$$

    -

    and the mean function is:

    -

    $$f(x) = c + (d-c)(\Phi(b(\log(x)-\log(e))))$$

    -

    in case ED50, which is also denoted \(e\), is a parameter in the model. If the former model is fitted - any estimated ED values will need to be back-transformed subsequently in order to obtain effective doses - on the original scale.

    -

    The mean functions above yield the same models as those described by Bruce and Versteeg (1992), - but using a different parameterisation (among other things the natural logarithm is used).

    -

    For the case \(c=0\) and \(d=1\), the log-normal model reduces the classic probit model (Finney, 1971) - with log dose as explanatory variable (mostly used for quantal data). This special case is available through - the convenience function LN.2.

    -

    The case \(c=0\) is available as the function LN.3, whereas the LN.3u corresponds to the special - case where the upper horizontal asymptote is fixed (default is 1). The full four-parameter model is available - through LN.4.

    - -

    Value

    - -

    The value returned is a list containing the non-linear function, the self starter function - and the parameter names.

    - -

    References

    -

    Finney, D. J. (1971) Probit analysis, London: Cambridge University Press.

    -

    Bruce, R. D. and Versteeg, D. J. (1992) A statistical procedure for modeling continuous toxicity data, - Environ. Toxicol. Chem., 11, 1485--1494.

    - -

    Note

    +
    fctName
    +

    optional character string used internally by convenience functions.

    -

    The function is for use with the function drm, but typically the convenience functions - link{LN.2}, link{LN.3}, link{LN.3u}, and link{LN.4} should be used.

    - -

    See also

    -

    The log-logistic model (llogistic) is very similar to the log-normal model at least in the middle, - but they may differ in the tails and thus provide different estimates of low effect concentrations EC/ED.

    - +
    fctText
    +

    optional character string used internally by convenience functions.

    -
    -
    +
    +

    Value

    +

    A list containing the non-linear function, the self starter function +and the parameter names.

    +
    +
    +

    Details

    +

    For the case where log(ED50) is a parameter in the model, the mean function is: +$$f(x) = c + (d-c)(\Phi(b(\log(x)-e)))$$ +and in case ED50 is a parameter: +$$f(x) = c + (d-c)(\Phi(b(\log(x)-\log(e))))$$

    +

    For \(c=0\) and \(d=1\), the model reduces to the classic probit model.

    +
    +
    +

    References

    +

    Finney, D. J. (1971) Probit analysis, London: Cambridge University Press.

    +

    Bruce, R. D. and Versteeg, D. J. (1992) A statistical procedure for modeling continuous toxicity data, +Environ. Toxicol. Chem., 11, 1485–1494.

    +
    +
    +

    See also

    +

    The log-logistic model llogistic is very similar to the log-normal model.

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    -
  • Note
    • +
    -
  • See also
    • - -

    Author

    - Christian Ritz -
    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + -
    - - - - + diff --git a/docs/reference/lnormal.md b/docs/reference/lnormal.md new file mode 100644 index 00000000..627a0fe3 --- /dev/null +++ b/docs/reference/lnormal.md @@ -0,0 +1,83 @@ +# Log-normal dose-response model + +`lnormal` provides a general framework for specifying the mean function +of the decreasing or increasing log-normal dose-response model. + +## Usage + +``` r +lnormal( + fixed = c(NA, NA, NA, NA), + names = c("b", "c", "d", "e"), + method = c("1", "2", "3", "4"), + ssfct = NULL, + fctName, + fctText, + loge = FALSE +) +``` + +## Arguments + +- fixed: + + numeric vector. Specifies which parameters are fixed and at what value + they are fixed. NAs for parameters that are not fixed. + +- names: + + vector of character strings giving the names of the parameters (should + not contain ":"). The order of the parameters is: b, c, d, e. + +- method: + + character string indicating the self starter function to use. + +- ssfct: + + a self starter function to be used. + +- fctName: + + optional character string used internally by convenience functions. + +- fctText: + + optional character string used internally by convenience functions. + +- loge: + + logical indicating whether or not ED50 or log(ED50) should be a + parameter in the model. By default ED50 is a model parameter. + +## Value + +A list containing the non-linear function, the self starter function and +the parameter names. + +## Details + +For the case where log(ED50) is a parameter in the model, the mean +function is: \$\$f(x) = c + (d-c)(\Phi(b(\log(x)-e)))\$\$ and in case +ED50 is a parameter: \$\$f(x) = c + (d-c)(\Phi(b(\log(x)-\log(e))))\$\$ + +For \\c=0\\ and \\d=1\\, the model reduces to the classic probit model. + +## References + +Finney, D. J. (1971) *Probit analysis*, London: Cambridge University +Press. + +Bruce, R. D. and Versteeg, D. J. (1992) A statistical procedure for +modeling continuous toxicity data, *Environ. Toxicol. Chem.*, **11**, +1485–1494. + +## See also + +The log-logistic model +[`llogistic`](https://hreinwald.github.io/drc/reference/llogistic.md) is +very similar to the log-normal model. + +## Author + +Christian Ritz diff --git a/docs/reference/lnormal.ssf.html b/docs/reference/lnormal.ssf.html new file mode 100644 index 00000000..396b7369 --- /dev/null +++ b/docs/reference/lnormal.ssf.html @@ -0,0 +1,70 @@ + +Self-starter for log-normal model — lnormal.ssf • drc + Skip to contents + + +
    +
    +
    +

    Self-starter for log-normal model

    + Source: R/lnormal.ssf.R +
    lnormal.ssf.Rd
    +
    + +
    +

    Self-starter for log-normal model

    +
    + +
    +

    Usage

    + 
    lnormal.ssf(method = c("1", "2", "3", "4"), fixed, loge, useFixed = FALSE)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/lnormal.ssf.md b/docs/reference/lnormal.ssf.md new file mode 100644 index 00000000..102fa863 --- /dev/null +++ b/docs/reference/lnormal.ssf.md @@ -0,0 +1,9 @@ +# Self-starter for log-normal model + +Self-starter for log-normal model + +## Usage + +``` r +lnormal.ssf(method = c("1", "2", "3", "4"), fixed, loge, useFixed = FALSE) +``` diff --git a/docs/reference/logLik.drc.html b/docs/reference/logLik.drc.html index 06c89345..631bf489 100644 --- a/docs/reference/logLik.drc.html +++ b/docs/reference/logLik.drc.html @@ -1,173 +1,106 @@ - - - - - - +Extracting the log likelihood — logLik.drc • drc + Skip to contents -Extracting the log likelihood — logLik.drc • drc - - - +
    +
    +
    +

    Extracting the log likelihood

    + Source: R/logLik.drc.R +
    logLik.drc.Rd
    +
    - - - - +
    +

    logLik extracts the value of the log likelihood function evaluated +at the parameter estimates.

    +
    +
    +

    Usage

    + 
    # S3 method for class 'drc'
+logLik(object, ...)
    +
    +
    +

    Arguments

    - - - +
    object
    +

    an object of class 'drc'.

    - +
    ...
    +

    additional arguments.

    - -
    -
    -
    +
    +

    Value

    +

    The evaluated log likelihood as a numeric value and the +corresponding degrees of freedom as well as the number of observations +as attributes.

    - - -
    -
    - - - - -
    -
    -
    -

    Extracting the log likelihood

    - - +
    +

    Author

    +

    Christian Ritz

    -
    - -

    loglik extracts the value of the log likelihood function evaluated at the parameter estimates.

    - +
    +

    Examples

    + 
    ## Fitting a four-parameter log-logistic model
+ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4())
+logLik(ryegrass.m1)
+#> 'log Lik.' -16.15514 (df=5)
+
+
    +
    - 
    # S3 method for drc
-logLik(object, ...)
    - -

    Arguments

    - - - - - - - - - - -
    object

    an object of class 'drc'.

    ...

    additional arguments.

    - -

    Value

    - -

    The evaluated log likelihood as a numeric value and the corresponding degrees of freedom as well as the number of observations as attributes.

    - -

    Note

    - -

    The value of the log likelihood could be used to compare model fits of the same data based on different - dose-response models or based on the same model but fitted different algorithms, software programmes, or - starting values. For comparisons: Larger is better.

    - - -

    Examples

    - 
    
-## Fitting a four-parameter log-logistic model
-ryegrass.m1 <- drm(rootl ~conc, data = ryegrass, fct = LL.4())
-logLik(ryegrass.m1)
    #> 'log Lik.' -16.15514 (df=5)
    
-
    -
    - -
    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -

    Site built with pkgdown.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -
    +
    + + + - - - + diff --git a/docs/reference/logLik.drc.md b/docs/reference/logLik.drc.md new file mode 100644 index 00000000..30541940 --- /dev/null +++ b/docs/reference/logLik.drc.md @@ -0,0 +1,39 @@ +# Extracting the log likelihood + +`logLik` extracts the value of the log likelihood function evaluated at +the parameter estimates. + +## Usage + +``` r +# S3 method for class 'drc' +logLik(object, ...) +``` + +## Arguments + +- object: + + an object of class 'drc'. + +- ...: + + additional arguments. + +## Value + +The evaluated log likelihood as a numeric value and the corresponding +degrees of freedom as well as the number of observations as attributes. + +## Author + +Christian Ritz + +## Examples + +``` r +## Fitting a four-parameter log-logistic model +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +logLik(ryegrass.m1) +#> 'log Lik.' -16.15514 (df=5) +``` diff --git a/docs/reference/logistic.html b/docs/reference/logistic.html index c7adfc2d..493bc06c 100644 --- a/docs/reference/logistic.html +++ b/docs/reference/logistic.html @@ -1,233 +1,140 @@ - - - - - - +The general asymmetric five-parameter logistic model — logistic • drc + Skip to contents -The logistic model — logistic • drc - - - +
    +
    +
    +

    The general asymmetric five-parameter logistic model

    + Source: R/logistic.R +
    logistic.Rd
    +
    - +
    +

    The five-parameter logistic model given by the expression +$$f(x) = c + \frac{d - c}{(1 + \exp(b(x - e)))^f}$$

    +
    - - +
    +

    Usage

    + 
    logistic(
+  fixed = c(NA, NA, NA, NA, NA),
+  names = c("b", "c", "d", "e", "f"),
+  method = c("1", "2", "3", "4"),
+  ssfct = NULL,
+  fctName,
+  fctText
+)
    +
    +
    +

    Arguments

    - - +
    fixed
    +

    numeric vector of length 5. Specifies which parameters are fixed +and at what value they are fixed. NA indicates that the corresponding +parameter is not fixed.

    - +
    names
    +

    character vector of length 5 giving the names of the parameters +(b, c, d, e, f). Default is c("b", "c", "d", "e", "f").

    - - -
    -
    - - - -
    -
    -
    -
    -

    The logistic model

    - - +
    ssfct
    +

    a self starter function to be used. If NULL (default), +a built-in self starter is selected via method.

    + + +
    fctName
    +

    optional character string used internally to overwrite the +function name.

    + + +
    fctText
    +

    optional character string used internally to overwrite the +description text.

    + +
    +
    +

    Value

    +

    A list of class "Boltzmann" containing the nonlinear function, +self starter function, and parameter names.

    +
    +
    +

    Details

    +

    This model differs from the log-logistic in that it uses x directly +rather than log(x). It is sometimes referred to as the Boltzmann model.

    +
    +
    +

    See also

    +

    L.3, L.4, L.5, +llogistic

    +
    +
    +

    Author

    +

    Christian Ritz

    -
    - -

    The general asymmetric five-parameter logistic model for describing dose-response relationships.

    - +
    +

    Examples

    + 
    ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = L.4())
+
    +
    - 
    logistic(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"),
-  method = c("1", "2", "3", "4"), ssfct = NULL, 
-  fctName, fctText) 
-
-  L.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...)
-  L.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...)
-  L.5(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...)  
-
-
-
-
-
-
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    fixed

    numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.

    names

    a vector of character strings giving the names of the parameters (should not contain ":"). - The order of the parameters is: b, c, d, e, f (see under 'Details').

    method

    character string indicating the self starter function to use.

    ssfct

    a self starter function to be used.

    fctName

    optional character string used internally by convenience functions.

    fctText

    optional character string used internally by convenience functions.

    ...

    Additional arguments (see llogistic).

    - -

    Details

    - -

    The default arguments yields the five-parameter logistic mean function given by the expression

    -

    $$ f(x) = c + \frac{d-c}{(1+\exp(b(x - e)))^f}$$

    -

    The model is different from the log-logistic models llogistic and llogistic2 - where the term $$log(x)$$ is used instead of $$x$$.

    -

    The model is sometimes referred to as the Boltzmann model.

    - -

    Value

    - -

    The value returned is a list containing the nonlinear function, the self starter function - and the parameter names.

    - - -

    Examples

    - 
    
-## Fitting the four-parameter logistic model
-ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = L.4())
-summary(ryegrass.m1)
    #> 
-#> Model fitted: Logistic (ED50 as parameter) (4 parms)
-#> 
-#> Parameter estimates:
-#> 
-#>               Estimate Std. Error t-value   p-value    
-#> b:(Intercept)  1.10548    0.22737  4.8621 9.444e-05 ***
-#> c:(Intercept)  0.64966    0.18978  3.4231  0.002694 ** 
-#> d:(Intercept)  8.07122    0.35994 22.4239 1.268e-15 ***
-#> e:(Intercept)  3.06924    0.19638 15.6290 1.126e-12 ***
-#> ---
-#> Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
-#> 
-#> Residual standard error:
-#> 
-#>  0.5527393 (20 degrees of freedom)
    
-## Fitting an asymmetric logistic model
-##  requires installing the package 'NISTnls'
-# Ratkowsky3.m1 <- drm(y~x, data = Ratkowsky3, 
-# fct = L.5(fixed = c(NA, 0, NA, NA, NA)))
-# plot(Ratkowsky3.m1)
-# summary(Ratkowsky3.m1)  
-## okay agreement with NIST values
-##  for the two parameters that are the same
-
-
    -
    - - -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -

    Site built with pkgdown.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -
    +
    + + + - - - + diff --git a/docs/reference/logistic.md b/docs/reference/logistic.md new file mode 100644 index 00000000..90e84e7e --- /dev/null +++ b/docs/reference/logistic.md @@ -0,0 +1,78 @@ +# The general asymmetric five-parameter logistic model + +The five-parameter logistic model given by the expression \$\$f(x) = c + +\frac{d - c}{(1 + \exp(b(x - e)))^f}\$\$ + +## Usage + +``` r +logistic( + fixed = c(NA, NA, NA, NA, NA), + names = c("b", "c", "d", "e", "f"), + method = c("1", "2", "3", "4"), + ssfct = NULL, + fctName, + fctText +) +``` + +## Arguments + +- fixed: + + numeric vector of length 5. Specifies which parameters are fixed and + at what value they are fixed. `NA` indicates that the corresponding + parameter is not fixed. + +- names: + + character vector of length 5 giving the names of the parameters + `(b, c, d, e, f)`. Default is `c("b", "c", "d", "e", "f")`. + +- method: + + character string indicating the self starter function to use (`"1"`, + `"2"`, `"3"`, or `"4"`). + +- ssfct: + + a self starter function to be used. If `NULL` (default), a built-in + self starter is selected via `method`. + +- fctName: + + optional character string used internally to overwrite the function + name. + +- fctText: + + optional character string used internally to overwrite the description + text. + +## Value + +A list of class `"Boltzmann"` containing the nonlinear function, self +starter function, and parameter names. + +## Details + +This model differs from the log-logistic in that it uses `x` directly +rather than `log(x)`. It is sometimes referred to as the Boltzmann +model. + +## See also + +[`L.3`](https://hreinwald.github.io/drc/reference/L.3.md), +[`L.4`](https://hreinwald.github.io/drc/reference/L.4.md), +[`L.5`](https://hreinwald.github.io/drc/reference/L.5.md), +[`llogistic`](https://hreinwald.github.io/drc/reference/llogistic.md) + +## Author + +Christian Ritz + +## Examples + +``` r +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = L.4()) +``` diff --git a/docs/reference/logistic.ssf.html b/docs/reference/logistic.ssf.html new file mode 100644 index 00000000..38ac9234 --- /dev/null +++ b/docs/reference/logistic.ssf.html @@ -0,0 +1,70 @@ + +Self-starter for logistic model — logistic.ssf • drc + Skip to contents + + +
    +
    +
    +

    Self-starter for logistic model

    + Source: R/logistic.ssf.R +
    logistic.ssf.Rd
    +
    + +
    +

    Self-starter for logistic model

    +
    + +
    +

    Usage

    + 
    logistic.ssf(method = c("1", "2", "3", "4"), fixed, useFixed = FALSE)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/logistic.ssf.md b/docs/reference/logistic.ssf.md new file mode 100644 index 00000000..c86a501d --- /dev/null +++ b/docs/reference/logistic.ssf.md @@ -0,0 +1,9 @@ +# Self-starter for logistic model + +Self-starter for logistic model + +## Usage + +``` r +logistic.ssf(method = c("1", "2", "3", "4"), fixed, useFixed = FALSE) +``` diff --git a/docs/reference/lowFixed.html b/docs/reference/lowFixed.html new file mode 100644 index 00000000..65a7852e --- /dev/null +++ b/docs/reference/lowFixed.html @@ -0,0 +1,86 @@ + +Construct Text for Model with Fixed Lower Limit — lowFixed • drc + Skip to contents + + +
    +
    +
    +

    Construct Text for Model with Fixed Lower Limit

    + Source: R/llogistic2.R +
    lowFixed.Rd
    +
    + +
    +

    Helper function that appends lower limit information to a model description +string.

    +
    + +
    +

    Usage

    + 
    lowFixed(modelStr)
    +
    + +
    +

    Arguments

    + + +
    modelStr
    +

    character string with the base model description.

    + +
    +
    +

    Value

    +

    A character string describing the model with its fixed lower limit.

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/lowFixed.md b/docs/reference/lowFixed.md new file mode 100644 index 00000000..7d1e3e05 --- /dev/null +++ b/docs/reference/lowFixed.md @@ -0,0 +1,20 @@ +# Construct Text for Model with Fixed Lower Limit + +Helper function that appends lower limit information to a model +description string. + +## Usage + +``` r +lowFixed(modelStr) +``` + +## Arguments + +- modelStr: + + character string with the base model description. + +## Value + +A character string describing the model with its fixed lower limit. diff --git a/docs/reference/lowupFixed.html b/docs/reference/lowupFixed.html new file mode 100644 index 00000000..3f719a92 --- /dev/null +++ b/docs/reference/lowupFixed.html @@ -0,0 +1,90 @@ + +Construct Text for Model with Fixed Lower and Upper Limits — lowupFixed • drc + Skip to contents + + +
    +
    +
    +

    Construct Text for Model with Fixed Lower and Upper Limits

    + Source: R/llogistic2.R +
    lowupFixed.Rd
    +
    + +
    +

    Helper function that appends lower and upper limit information to a model +description string.

    +
    + +
    +

    Usage

    + 
    lowupFixed(modelStr, upper)
    +
    + +
    +

    Arguments

    + + +
    modelStr
    +

    character string with the base model description.

    + + +
    upper
    +

    numeric value for the fixed upper limit.

    + +
    +
    +

    Value

    +

    A character string describing the model with its fixed limits.

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/lowupFixed.md b/docs/reference/lowupFixed.md new file mode 100644 index 00000000..d4312652 --- /dev/null +++ b/docs/reference/lowupFixed.md @@ -0,0 +1,24 @@ +# Construct Text for Model with Fixed Lower and Upper Limits + +Helper function that appends lower and upper limit information to a +model description string. + +## Usage + +``` r +lowupFixed(modelStr, upper) +``` + +## Arguments + +- modelStr: + + character string with the base model description. + +- upper: + + numeric value for the fixed upper limit. + +## Value + +A character string describing the model with its fixed limits. diff --git a/docs/reference/maED.html b/docs/reference/maED.html index 5c38c7f7..26b882a2 100644 --- a/docs/reference/maED.html +++ b/docs/reference/maED.html @@ -1,359 +1,253 @@ - - - - - - +Estimation of ED values using model-averaging — maED • drc + Skip to contents -Estimation of ED values using model-averaging — maED • drc - - - +
    +
    +
    +

    Estimation of ED values using model-averaging

    + Source: R/maED.R +
    maED.Rd
    +
    - +
    +

    Estimates and confidence intervals for ED values are estimated using +model-averaging.

    +
    - - +
    +

    Usage

    + 
    maED(
+  object,
+  fctList = NULL,
+  respLev = c(10, 20, 50),
+  interval = c("none", "buckland", "kang"),
+  linreg = FALSE,
+  clevel = NULL,
+  level = 0.95,
+  type = c("relative", "absolute"),
+  display = TRUE,
+  na.rm = FALSE,
+  extended = FALSE
+)
    +
    +
    +

    Arguments

    - - +
    object
    +

    an object of class drc.

    - +
    fctList
    +

    a list of non-linear functions to be compared.

    - - -
    -
    - - - -
    -
    -
    -
    -

    Estimation of ED values using model-averaging

    - - -
    +
    interval
    +

    character string specifying the type of confidence intervals +to be supplied. The default is "none". The choices "buckland" +and "kang" are explained in the Details section.

    -
    - -

    Estimates and confidence intervals for ED values are estimated using model-averaging.

    - -
    - 
    maED(object, fctList = NULL, respLev, interval = c("none", "buckland", "kang"),
-linreg = FALSE, clevel = NULL, level = 0.95, type = c("relative", "absolute"),
-display = TRUE, na.rm = FALSE, extended = FALSE)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    object

    an object of class 'drc'.

    fctList

    a list of non-linear functions to be compared.

    respLev

    a numeric vector containing the response levels.

    interval

    character string specifying the type of confidence intervals to be supplied. The default is "none". - The choices "buckland" and "kang" are explained in the Details section.

    linreg

    logical indicating whether or not additionally a simple linear regression model - should be fitted.

    clevel

    character string specifying the curve id in case on estimates for a specific curve or compound is requested. By default estimates - are shown for all curves.

    level

    numeric. The level for the confidence intervals. The default is 0.95.

    type

    character string. Whether the specified response levels are absolute or relative (default).

    display

    logical. If TRUE results are displayed. Otherwise they are not (useful in simulations).

    na.rm

    logical indicating whether or not NA occurring during model fitting should be left out of - subsequent calculations.

    extended

    logical specifying whether or not an extended output (including fit summaries) should be - returned.

    - -

    Details

    - -

    Model-averaging of individual estimates is carried out as described by Buckland et al. (1997) and - Kang et al. (2000) using AIC-based weights. The two approaches differ w.r.t. the calculation of confidence - intervals: Buckland et al. (1997) provide an approximate variance formula under the assumption of - perfectly correlated estimates (so, confidence intervals will tend to be too wide). - Kang et al. (2000) use the model weights to calculate confidence limits as weighted means of - the confidence limits for the individual fits; this procedure corresponds to using the standard error in Equation (3) - given by Buckland et al. (1997) (assuming symmetric confidence intervals based on the same percentile).

    - -

    Value

    - -

    A matrix with two or more columns, containing the estimates - and the corresponding estimated standard errors and possibly lower and upper confidence limits.

    - -

    References

    +
    linreg
    +

    logical indicating whether or not additionally a simple linear +regression model should be fitted.

    + + +
    clevel
    +

    character string specifying the curve id in case estimates for +a specific curve or compound are requested. By default estimates are shown +for all curves.

    + + +
    level
    +

    numeric. The confidence level. Must be a single value strictly +between 0 and 1. The default is 0.95.

    + + +
    type
    +

    character string. Whether the specified response levels are +absolute or relative (default).

    + + +
    display
    +

    logical. If TRUE results are displayed. Otherwise they +are not (useful in simulations).

    + +
    na.rm
    +

    logical indicating whether or not NA values occurring +during model fitting should be excluded from subsequent calculations.

    + + +
    extended
    +

    logical specifying whether or not an extended output +(including fit summaries) should be returned.

    + +
    +
    +

    Value

    +

    If extended = FALSE, a matrix with two or more columns +containing the model-averaged estimates and the corresponding estimated +standard errors and, optionally, lower and upper confidence limits. +If extended = TRUE, a list with components:

    estimates
    +

    Matrix of model-averaged ED estimates and intervals.

    + +
    fits
    +

    Matrix of per-model ED estimates and AIC-based weights.

    + + +
    +
    +

    Details

    +

    Model-averaging of individual estimates is carried out as described by +Buckland et al. (1997) and Kang et al. (2000) using +AIC-based weights. The two approaches differ w.r.t. the calculation of +confidence intervals: Buckland et al. (1997) provide an approximate +variance formula under the assumption of perfectly correlated estimates +(so, confidence intervals will tend to be too wide). Kang et al. +(2000) use the model weights to calculate confidence limits as weighted +means of the confidence limits for the individual fits.

    +
    +
    +

    References

    Buckland, S. T. and Burnham, K. P. and Augustin, N. H. (1997) - Model Selection: An Integral Part of Inference, - Biometrics 53, 603--618.

    +Model Selection: An Integral Part of Inference, +Biometrics 53, 603–618.

    Kang, Seung-Ho and Kodell, Ralph L. and Chen, James J. (2000) - Incorporating Model Uncertainties along with Data Uncertainties in Microbial Risk Assessment, - Regulatory Toxicology and Pharmacology 32, 68--72.

    - -

    See also

    - -

    The function mselect provides a summary of fit statistics for several models fitted to the same data.

    - - -

    Examples

    - 
    
-## Fitting an example dose-response model
-ryegrass.m1 <- drm(rootl~conc, data = ryegrass, fct = LL.4())
-
-## Comparing models (showing the AIC values)  
-mselect(ryegrass.m1,
-list(LL.5(), LN.4(), W1.4(), W2.4(), FPL.4(-1,1), FPL.4(-2,3), FPL.4(-0.5,0.5)))
    #>                    logLik       IC Lack of fit   Res var
-#> FPL.4(-0.5,0.5) -15.89038 41.78075           0 0.2641185
-#> FPL.4(-1,1)     -15.90480 41.80959           0 0.2644360
-#> W2.4            -15.91352 41.82703           0 0.2646283
-#> LL.4            -16.15514 42.31029           0 0.2700107
-#> LN.4            -16.29214 42.58429           0 0.2731110
-#> FPL.4(-2,3)     -16.61493 43.22985           0 0.2805570
-#> LL.5            -15.87828 43.75656           0 0.2777393
-#> W1.4            -17.46720 44.93439           0 0.3012075
    
-## Doing the actual model-averaging  
-maED(ryegrass.m1,
-list(LL.5(), LN.4(), W1.4(), W2.4(), FPL.4(-1,1), FPL.4(-2,3), FPL.4(-0.5,0.5)),
-c(10, 50, 90))
    #>                     ED10     ED50     ED90     Weight
-#> LL.4            1.463706 3.057955 6.388640 0.14047308
-#> LL.5            1.560325 3.023549 7.729713 0.06816147
-#> LN.4            1.489188 3.044673 6.224889 0.12248817
-#> W1.4            1.405979 3.088964 5.101022 0.03782468
-#> W2.4            1.628278 2.996913 7.805803 0.17886712
-#> FPL.4(-1,1)     1.540346 3.038790 7.086271 0.18043370
-#> FPL.4(-2,3)     1.507055 3.063612 5.836831 0.08869758
-#> FPL.4(-0.5,0.5) 1.531613 3.047967 7.204860 0.18305421
-#> 
    #>        Estimate
-#> e:1:10 1.530770
-#> e:1:50 3.039453
-#> e:1:90 6.891117
    
-## With confidence intervals according to Buckland et al. (1997)  
-maED(ryegrass.m1,
-list(LL.5(), LN.4(), W1.4(), W2.4(), FPL.4(-1,1), FPL.4(-2,3), FPL.4(-0.5,0.5)),
-c(10, 50, 90), "buckland")
    #>                     ED10     ED50     ED90     Weight
-#> LL.4            1.463706 3.057955 6.388640 0.14047308
-#> LL.5            1.560325 3.023549 7.729713 0.06816147
-#> LN.4            1.489188 3.044673 6.224889 0.12248817
-#> W1.4            1.405979 3.088964 5.101022 0.03782468
-#> W2.4            1.628278 2.996913 7.805803 0.17886712
-#> FPL.4(-1,1)     1.540346 3.038790 7.086271 0.18043370
-#> FPL.4(-2,3)     1.507055 3.063612 5.836831 0.08869758
-#> FPL.4(-0.5,0.5) 1.531613 3.047967 7.204860 0.18305421
-#> 
    #>        Estimate Std. Error    Lower    Upper
-#> e:1:10 1.530770  0.1817370 1.174572 1.886968
-#> e:1:50 3.039453  0.1922763 2.662598 3.416307
-#> e:1:90 6.891117  1.4191777 4.109579 9.672654
    
-## With confidence intervals according to Kang et al. (2000)
-maED(ryegrass.m1,
-list(LL.5(), LN.4(), W1.4(), W2.4(), FPL.4(-1,1), FPL.4(-2,3), FPL.4(-0.5,0.5)),
-c(10, 50, 90), "kang")
    #>                     ED10     ED50     ED90     Weight
-#> LL.4            1.463706 3.057955 6.388640 0.14047308
-#> LL.5            1.560325 3.023549 7.729713 0.06816147
-#> LN.4            1.489188 3.044673 6.224889 0.12248817
-#> W1.4            1.405979 3.088964 5.101022 0.03782468
-#> W2.4            1.628278 2.996913 7.805803 0.17886712
-#> FPL.4(-1,1)     1.540346 3.038790 7.086271 0.18043370
-#> FPL.4(-2,3)     1.507055 3.063612 5.836831 0.08869758
-#> FPL.4(-0.5,0.5) 1.531613 3.047967 7.204860 0.18305421
-#> 
    #>        Estimate    Lower    Upper
-#> e:1:10 1.530770 1.172385 1.889155
-#> e:1:50 3.039453 2.641383 3.437523
-#> e:1:90 6.891117 4.377099 9.405134
    
-## Comparing to model-averaged ED values with simple linear regression included
-maED(ryegrass.m1,
-list(LL.5(), LN.4(), W1.4(), W2.4(), FPL.4(-1,1), FPL.4(-2,3), FPL.4(-0.5,0.5)),
-c(10, 50, 90), interval = "buckland", linreg = TRUE)
    #>                     ED10      ED50      ED90       Weight
-#> LL.4            1.463706  3.057955  6.388640 1.404731e-01
-#> LL.5            1.560325  3.023549  7.729713 6.816147e-02
-#> LN.4            1.489188  3.044673  6.224889 1.224882e-01
-#> W1.4            1.405979  3.088964  5.101022 3.782468e-02
-#> W2.4            1.628278  2.996913  7.805803 1.788671e-01
-#> FPL.4(-1,1)     1.540346  3.038790  7.086271 1.804337e-01
-#> FPL.4(-2,3)     1.507055  3.063612  5.836831 8.869758e-02
-#> FPL.4(-0.5,0.5) 1.531613  3.047967  7.204860 1.830542e-01
-#> Lin             2.407225 12.036124 21.665022 1.291283e-15
-#> 
    #>        Estimate Std. Error    Lower     Upper
-#> e:1:10 1.530770  0.1969707 1.144714  1.916826
-#> e:1:50 3.039453  1.0227988 1.034804  5.044102
-#> e:1:90 6.891117  2.0331194 2.906276 10.875957
    
-
-
-## Example with a model fit involving two compounds/curves
-S.alba.m1 <- drm(DryMatter~Dose, Herbicide, data=S.alba, fct = LL.4(),
-pmodels=data.frame(Herbicide,1,1,Herbicide))
-
-## Model-averaged ED50 for both compounds
-maED(S.alba.m1, list(LL.3(), LN.4()), 50)
    #>          ED50       Weight
-#> LL.4 66.89054 5.968947e-01
-#> LL.3 60.10951 1.310984e-15
-#> LN.4 67.18546 4.031053e-01
-#> 
-#>          ED50       Weight
-#> LL.4 28.63235 5.968947e-01
-#> LL.3 60.10951 1.310984e-15
-#> LN.4 28.64257 4.031053e-01
-#> 
    #>                 Estimate
-#> e:Glyphosate:50 67.00943
-#> e:Bentazone:50  28.63647
    
-## Model-averaged ED50 only for one compound (glyphosate)
-maED(S.alba.m1, list(LL.3(), LN.4()), 50, clevel="Glyphosate")
    #>          ED50       Weight
-#> LL.4 66.89054 5.968947e-01
-#> LL.3 60.10951 1.310984e-15
-#> LN.4 67.18546 4.031053e-01
-#> 
    #>                 Estimate
-#> e:Glyphosate:50 67.00943
    
-## With confidence intervals
-maED(S.alba.m1, list(LL.3(), LN.4()), 50, interval="buckland")
    #>          ED50       Weight
-#> LL.4 66.89054 5.968947e-01
-#> LL.3 60.10951 1.310984e-15
-#> LN.4 67.18546 4.031053e-01
-#> 
-#>          ED50       Weight
-#> LL.4 28.63235 5.968947e-01
-#> LL.3 60.10951 1.310984e-15
-#> LN.4 28.64257 4.031053e-01
-#> 
    #>                 Estimate Std. Error     Lower    Upper
-#> e:Glyphosate:50 67.00943   6.439439 54.388360 79.63050
-#> e:Bentazone:50  28.63647  10.677172  7.709599 49.56334
    
-## For comparison model-specific confidence intervals
-ED(S.alba.m1, 50, interval="delta")  # wider!
    #> 
-#> Estimated effective doses
-#> 
-#>                 Estimate Std. Error   Lower   Upper
-#> e:Bentazone:50   28.6324     2.0381 24.5583 32.7065
-#> e:Glyphosate:50  66.8905     5.9688 54.9590 78.8220
    
-
    -
    - +
    +

    See also

    +

    The function mselect provides a summary of fit +statistics for several models fitted to the same data.

    +
    +
    +

    Author

    +

    Christian Ritz, Hannes Reinwald

    +
    -
  • References
    • +
    +

    Examples

    + 
    ## Fitting an example dose-response model
+ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4())
+
+## Model-averaging with default settings (no confidence intervals)
+maED(
+  ryegrass.m1,
+  list(LL.5(), LN.4(), W1.4(), W2.4(), FPL.4(-1, 1), FPL.4(-2, 3), FPL.4(-0.5, 0.5)),
+  c(10, 50, 90)
+)
+#>                     ED10     ED50     ED90     Weight
+#> LL.4            1.463706 3.057955 6.388640 0.14047308
+#> LL.5            1.560325 3.023549 7.729713 0.06816147
+#> LN.4            1.489188 3.044673 6.224889 0.12248817
+#> W1.4            1.405979 3.088964 5.101022 0.03782468
+#> W2.4            1.628278 2.996913 7.805803 0.17886712
+#> FPL.4(-1,1)     1.540346 3.038790 7.086271 0.18043370
+#> FPL.4(-2,3)     1.507055 3.063612 5.836831 0.08869758
+#> FPL.4(-0.5,0.5) 1.531613 3.047967 7.204860 0.18305421
+#> 
+#>      Estimate
+#> e:10 1.530770
+#> e:50 3.039453
+#> e:90 6.891117
+
+## Model-averaging with Buckland confidence intervals
+maED(
+  ryegrass.m1,
+  list(LL.5(), LN.4(), W1.4(), W2.4()),
+  c(10, 50, 90),
+  interval = "buckland"
+)
+#>          ED10     ED50     ED90     Weight
+#> LL.4 1.463706 3.057955 6.388640 0.25642453
+#> LL.5 1.560325 3.023549 7.729713 0.12442435
+#> LN.4 1.489188 3.044673 6.224889 0.22359424
+#> W1.4 1.405979 3.088964 5.101022 0.06904651
+#> W2.4 1.628278 2.996913 7.805803 0.32651037
+#> 
+#>      Estimate Std. Error    Lower    Upper
+#> e:10 1.531174  0.1977800 1.143532 1.918816
+#> e:50 3.032914  0.1945023 2.651697 3.414132
+#> e:90 6.892701  1.5391238 3.876074 9.909329
+
+## Model-averaging with Kang confidence intervals
+maED(
+  ryegrass.m1,
+  list(LL.5(), LN.4(), W1.4(), W2.4()),
+  c(10, 50, 90),
+  interval = "kang"
+)
+#>          ED10     ED50     ED90     Weight
+#> LL.4 1.463706 3.057955 6.388640 0.25642453
+#> LL.5 1.560325 3.023549 7.729713 0.12442435
+#> LN.4 1.489188 3.044673 6.224889 0.22359424
+#> W1.4 1.405979 3.088964 5.101022 0.06904651
+#> W2.4 1.628278 2.996913 7.805803 0.32651037
+#> 
+#>      Estimate Std. Error    Lower    Upper
+#> e:10 1.531174  0.1977800 1.155988 1.906360
+#> e:50 3.032914  0.1945023 2.631988 3.433841
+#> e:90 6.892701  1.5391238 4.241165 9.544238
+
+
    +
    +
    -
  • See also
    • - -
  • Examples
    • - -

    Author

    - Christian Ritz -
    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + -
    - - - - + diff --git a/docs/reference/maED.md b/docs/reference/maED.md new file mode 100644 index 00000000..6cb4dfb8 --- /dev/null +++ b/docs/reference/maED.md @@ -0,0 +1,191 @@ +# Estimation of ED values using model-averaging + +Estimates and confidence intervals for ED values are estimated using +model-averaging. + +## Usage + +``` r +maED( + object, + fctList = NULL, + respLev = c(10, 20, 50), + interval = c("none", "buckland", "kang"), + linreg = FALSE, + clevel = NULL, + level = 0.95, + type = c("relative", "absolute"), + display = TRUE, + na.rm = FALSE, + extended = FALSE +) +``` + +## Arguments + +- object: + + an object of class `drc`. + +- fctList: + + a list of non-linear functions to be compared. + +- respLev: + + a numeric vector containing the response levels. + +- interval: + + character string specifying the type of confidence intervals to be + supplied. The default is `"none"`. The choices `"buckland"` and + `"kang"` are explained in the Details section. + +- linreg: + + logical indicating whether or not additionally a simple linear + regression model should be fitted. + +- clevel: + + character string specifying the curve id in case estimates for a + specific curve or compound are requested. By default estimates are + shown for all curves. + +- level: + + numeric. The confidence level. Must be a single value strictly between + 0 and 1. The default is `0.95`. + +- type: + + character string. Whether the specified response levels are absolute + or relative (default). + +- display: + + logical. If `TRUE` results are displayed. Otherwise they are not + (useful in simulations). + +- na.rm: + + logical indicating whether or not `NA` values occurring during model + fitting should be excluded from subsequent calculations. + +- extended: + + logical specifying whether or not an extended output (including fit + summaries) should be returned. + +## Value + +If `extended = FALSE`, a matrix with two or more columns containing the +model-averaged estimates and the corresponding estimated standard errors +and, optionally, lower and upper confidence limits. If +`extended = TRUE`, a list with components: + +- estimates: + + Matrix of model-averaged ED estimates and intervals. + +- fits: + + Matrix of per-model ED estimates and AIC-based weights. + +## Details + +Model-averaging of individual estimates is carried out as described by +Buckland *et al.* (1997) and Kang *et al.* (2000) using AIC-based +weights. The two approaches differ w.r.t. the calculation of confidence +intervals: Buckland *et al.* (1997) provide an approximate variance +formula under the assumption of perfectly correlated estimates (so, +confidence intervals will tend to be too wide). Kang *et al.* (2000) use +the model weights to calculate confidence limits as weighted means of +the confidence limits for the individual fits. + +## References + +Buckland, S. T. and Burnham, K. P. and Augustin, N. H. (1997) Model +Selection: An Integral Part of Inference, *Biometrics* **53**, 603–618. + +Kang, Seung-Ho and Kodell, Ralph L. and Chen, James J. (2000) +Incorporating Model Uncertainties along with Data Uncertainties in +Microbial Risk Assessment, *Regulatory Toxicology and Pharmacology* +**32**, 68–72. + +## See also + +The function +[`mselect`](https://hreinwald.github.io/drc/reference/mselect.md) +provides a summary of fit statistics for several models fitted to the +same data. + +## Author + +Christian Ritz, Hannes Reinwald + +## Examples + +``` r +## Fitting an example dose-response model +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + +## Model-averaging with default settings (no confidence intervals) +maED( + ryegrass.m1, + list(LL.5(), LN.4(), W1.4(), W2.4(), FPL.4(-1, 1), FPL.4(-2, 3), FPL.4(-0.5, 0.5)), + c(10, 50, 90) +) +#> ED10 ED50 ED90 Weight +#> LL.4 1.463706 3.057955 6.388640 0.14047308 +#> LL.5 1.560325 3.023549 7.729713 0.06816147 +#> LN.4 1.489188 3.044673 6.224889 0.12248817 +#> W1.4 1.405979 3.088964 5.101022 0.03782468 +#> W2.4 1.628278 2.996913 7.805803 0.17886712 +#> FPL.4(-1,1) 1.540346 3.038790 7.086271 0.18043370 +#> FPL.4(-2,3) 1.507055 3.063612 5.836831 0.08869758 +#> FPL.4(-0.5,0.5) 1.531613 3.047967 7.204860 0.18305421 +#> +#> Estimate +#> e:10 1.530770 +#> e:50 3.039453 +#> e:90 6.891117 + +## Model-averaging with Buckland confidence intervals +maED( + ryegrass.m1, + list(LL.5(), LN.4(), W1.4(), W2.4()), + c(10, 50, 90), + interval = "buckland" +) +#> ED10 ED50 ED90 Weight +#> LL.4 1.463706 3.057955 6.388640 0.25642453 +#> LL.5 1.560325 3.023549 7.729713 0.12442435 +#> LN.4 1.489188 3.044673 6.224889 0.22359424 +#> W1.4 1.405979 3.088964 5.101022 0.06904651 +#> W2.4 1.628278 2.996913 7.805803 0.32651037 +#> +#> Estimate Std. Error Lower Upper +#> e:10 1.531174 0.1977800 1.143532 1.918816 +#> e:50 3.032914 0.1945023 2.651697 3.414132 +#> e:90 6.892701 1.5391238 3.876074 9.909329 + +## Model-averaging with Kang confidence intervals +maED( + ryegrass.m1, + list(LL.5(), LN.4(), W1.4(), W2.4()), + c(10, 50, 90), + interval = "kang" +) +#> ED10 ED50 ED90 Weight +#> LL.4 1.463706 3.057955 6.388640 0.25642453 +#> LL.5 1.560325 3.023549 7.729713 0.12442435 +#> LN.4 1.489188 3.044673 6.224889 0.22359424 +#> W1.4 1.405979 3.088964 5.101022 0.06904651 +#> W2.4 1.628278 2.996913 7.805803 0.32651037 +#> +#> Estimate Std. Error Lower Upper +#> e:10 1.531174 0.1977800 1.155988 1.906360 +#> e:50 3.032914 0.1945023 2.631988 3.433841 +#> e:90 6.892701 1.5391238 4.241165 9.544238 +``` diff --git a/docs/reference/maED_robust.html b/docs/reference/maED_robust.html new file mode 100644 index 00000000..26778db9 --- /dev/null +++ b/docs/reference/maED_robust.html @@ -0,0 +1,202 @@ + +Robust Calculation of Model-Averaged Effective Doses — maED_robust • drc + Skip to contents + + +
    +
    +
    +

    Robust Calculation of Model-Averaged Effective Doses

    + Source: R/ED_robust.R +
    maED_robust.Rd
    +
    + +
    +

    This function serves as a robust wrapper for drc::maED. It calculates +model-averaged effective doses (EDs) for specified response levels. The key +feature is its resilience to errors; it iterates through each response level +individually and handles failures gracefully by returning NA values for that +level, rather than terminating the entire operation.

    +
    + +
    +

    Usage

    + 
    maED_robust(
+  mod,
+  fct_ls = NULL,
+  respLev = c(10, 20, 50),
+  interval = "buckland",
+  CI_level = 0.95,
+  verbose = FALSE,
+  ...
+)
    +
    + +
    +

    Arguments

    + + +
    mod
    +

    A model object of class 'drc', which serves as the base model for +the averaging.

    + + +
    fct_ls
    +

    A list of alternative dose-response functions (e.g., LL.3(), +W1.4()) to be used in the model averaging process. The list should be +named.

    + + +
    respLev
    +

    A numeric vector specifying the response levels (in +percentages) for which to calculate the EDs (e.g., c(10, 50) for EC10 +and EC50).

    + + +
    interval
    +

    A character string specifying the type of confidence interval +to be supplied. The default is "buckland". See drc::maED for other options.

    + + +
    CI_level
    +

    A numeric value between 0 and 1 specifying the confidence +level for the confidence intervals. Default is 0.95.

    + + +
    verbose
    +

    A logical value. If TRUE, the function will print status +messages about the calculation progress and any errors encountered for each +response level. Default is FALSE.

    + + +
    ...
    +

    Additional arguments to be passed to the underlying drc::maED +function.

    + +
    +
    +

    Value

    +

    A data.frame with one row for each response level specified in +respLev. The columns are:

    +
    Estimate
    +

    The estimated model-averaged effective dose.

    + +
    stderr
    +

    The standard error of the estimate.

    + +
    Lower
    +

    The lower bound of the confidence interval.

    + +
    Upper
    +

    The upper bound of the confidence interval.

    + +
    confint_level
    +

    The confidence level used for the interval.

    + +
    confint_method
    +

    The method used for the confidence interval calculation.

    + +
    model
    +

    A character string listing the models used for averaging.

    + +
    EC
    +

    The response level (as a percentage).

    + +

    If the calculation for a specific response level fails or results in a +non-positive estimate, the corresponding row will contain NA values for +Estimate, stderr, Lower, and Upper.

    +
    +
    +

    Details

    +

    The function enhances drc::maED by introducing a robust calculation loop. +It iterates over each element of respLev and calls drc::maED within a +tryCatch block. This approach isolates failures, preventing an error at one +response level (e.g., an EC99 that cannot be estimated) from halting the +calculation of others.

    +

    Furthermore, after a successful calculation, the function checks if the +resulting 'Estimate' is positive. If the estimate is NA, non-positive, or +if the tryCatch block catches an error, the function returns a structured +row of NAs for that response level, ensuring a consistent output format.

    +
    +
    +

    See also

    +

    maED

    +
    +
    +

    Author

    +

    Hannes Reinwald

    +
    + +
    +

    Examples

    + 
    data(lettuce)
+base_model <- drm(weight ~ conc, data = lettuce, fct = BC.5())
+model_list <- list(W2.4 = W2.4())
+maED_robust(base_model, fct_ls = model_list, respLev = c(10, 50))
+#>     Estimate    stderr      Lower    Upper confint_level confint_method
+#>        <num>     <num>      <num>    <num>         <num>         <char>
+#> 1:  3.561851  1.610667   0.405001  6.71870          0.95       buckland
+#> 2: 11.952400 11.849870 -11.272918 35.17772          0.95       buckland
+#>        model    EC
+#>       <char> <num>
+#> 1: BC.5/W2.4    10
+#> 2: BC.5/W2.4    50
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/maED_robust.md b/docs/reference/maED_robust.md new file mode 100644 index 00000000..34472db6 --- /dev/null +++ b/docs/reference/maED_robust.md @@ -0,0 +1,149 @@ +# Robust Calculation of Model-Averaged Effective Doses + +This function serves as a robust wrapper for +[`drc::maED`](https://hreinwald.github.io/drc/reference/maED.md). It +calculates model-averaged effective doses (EDs) for specified response +levels. The key feature is its resilience to errors; it iterates through +each response level individually and handles failures gracefully by +returning `NA` values for that level, rather than terminating the entire +operation. + +## Usage + +``` r +maED_robust( + mod, + fct_ls = NULL, + respLev = c(10, 20, 50), + interval = "buckland", + CI_level = 0.95, + verbose = FALSE, + ... +) +``` + +## Arguments + +- mod: + + A model object of class 'drc', which serves as the base model for the + averaging. + +- fct_ls: + + A list of alternative dose-response functions (e.g., + [`LL.3()`](https://hreinwald.github.io/drc/reference/LL.3.md), + [`W1.4()`](https://hreinwald.github.io/drc/reference/W1.4.md)) to be + used in the model averaging process. The list should be named. + +- respLev: + + A numeric vector specifying the response levels (in percentages) for + which to calculate the EDs (e.g., `c(10, 50)` for EC10 and EC50). + +- interval: + + A character string specifying the type of confidence interval to be + supplied. The default is "buckland". See + [`drc::maED`](https://hreinwald.github.io/drc/reference/maED.md) for + other options. + +- CI_level: + + A numeric value between 0 and 1 specifying the confidence level for + the confidence intervals. Default is 0.95. + +- verbose: + + A logical value. If `TRUE`, the function will print status messages + about the calculation progress and any errors encountered for each + response level. Default is `FALSE`. + +- ...: + + Additional arguments to be passed to the underlying + [`drc::maED`](https://hreinwald.github.io/drc/reference/maED.md) + function. + +## Value + +A `data.frame` with one row for each response level specified in +`respLev`. The columns are: + +- Estimate: + + The estimated model-averaged effective dose. + +- stderr: + + The standard error of the estimate. + +- Lower: + + The lower bound of the confidence interval. + +- Upper: + + The upper bound of the confidence interval. + +- confint_level: + + The confidence level used for the interval. + +- confint_method: + + The method used for the confidence interval calculation. + +- model: + + A character string listing the models used for averaging. + +- EC: + + The response level (as a percentage). + +If the calculation for a specific response level fails or results in a +non-positive estimate, the corresponding row will contain `NA` values +for `Estimate`, `stderr`, `Lower`, and `Upper`. + +## Details + +The function enhances +[`drc::maED`](https://hreinwald.github.io/drc/reference/maED.md) by +introducing a robust calculation loop. It iterates over each element of +`respLev` and calls +[`drc::maED`](https://hreinwald.github.io/drc/reference/maED.md) within +a `tryCatch` block. This approach isolates failures, preventing an error +at one response level (e.g., an EC99 that cannot be estimated) from +halting the calculation of others. + +Furthermore, after a successful calculation, the function checks if the +resulting 'Estimate' is positive. If the estimate is `NA`, non-positive, +or if the `tryCatch` block catches an error, the function returns a +structured row of `NA`s for that response level, ensuring a consistent +output format. + +## See also + +[`maED`](https://hreinwald.github.io/drc/reference/maED.md) + +## Author + +Hannes Reinwald + +## Examples + +``` r +data(lettuce) +base_model <- drm(weight ~ conc, data = lettuce, fct = BC.5()) +model_list <- list(W2.4 = W2.4()) +maED_robust(base_model, fct_ls = model_list, respLev = c(10, 50)) +#> Estimate stderr Lower Upper confint_level confint_method +#> +#> 1: 3.561851 1.610667 0.405001 6.71870 0.95 buckland +#> 2: 11.952400 11.849870 -11.272918 35.17772 0.95 buckland +#> model EC +#> +#> 1: BC.5/W2.4 10 +#> 2: BC.5/W2.4 50 +``` diff --git a/docs/reference/mdra-1.png b/docs/reference/mdra-1.png new file mode 100644 index 00000000..3a754e06 Binary files /dev/null and b/docs/reference/mdra-1.png differ diff --git a/docs/reference/mdra.html b/docs/reference/mdra.html new file mode 100644 index 00000000..ed0286fa --- /dev/null +++ b/docs/reference/mdra.html @@ -0,0 +1,121 @@ + +3T3 mouse fibroblasts and NRU assay — mdra • drc + Skip to contents + + +
    +
    +
    +

    3T3 mouse fibroblasts and NRU assay

    + +
    mdra.Rd
    +
    + +
    +

    The toxicity of sodium valproate was tested, using the 3T3 mouse fibroblasts and neutral red uptake (NRU) assay. 22 different experiments were performed independently in six laboratories, using eight concentration levels, each with six replicates on a 96-well plate. In addition, twelve measurements were taken for the solvent control.

    +
    + +
    +

    Usage

    + 
    data("mdra")
    +
    + +
    +

    Format

    +

    A data frame with 1320 observations on the following 4 variables.

    LabID
    +

    a factor with levels A B C D E F

    + +
    ExperimentID
    +

    a factor with levels 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22

    + +
    Concentration
    +

    a numeric vector

    + +
    Response
    +

    a numeric vector

    + + +
    +
    +

    Source

    +

    http://biostatistics.dkfz.de/download/mdra/MDRA_ExampleData.csv

    +
    +
    +

    References

    +

    Clothier, R., Gomez-Lechon, M. J., Kinsner-Ovaskainen, A., Kopp-Schneider, A., O'Connor, J. E., Prieto, P., and Stanzel, S. (2013). Comparative analysis of eight cytotoxicity assays evaluated within the ACuteTox Project. Toxicology in vitro, 27(4):1347–1356.

    +
    + +
    +

    Examples

    + 
    data(mdra)
+
+## Fit a three-parameter log-logistic model
+mdra.m1 <- drm(Response ~ Concentration, data = mdra, fct = LL.3())
+summary(mdra.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                 Estimate Std. Error t-value   p-value    
+#> b:(Intercept) 0.87155467 0.05369552  16.231 < 2.2e-16 ***
+#> d:(Intercept) 1.03125713 0.00904617 113.999 < 2.2e-16 ***
+#> e:(Intercept) 0.00381995 0.00021312  17.924 < 2.2e-16 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.2333374 (1317 degrees of freedom)
+plot(mdra.m1, main = "MDRA dose-response")
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/mdra.md b/docs/reference/mdra.md new file mode 100644 index 00000000..0e7d4003 --- /dev/null +++ b/docs/reference/mdra.md @@ -0,0 +1,71 @@ +# 3T3 mouse fibroblasts and NRU assay + +The toxicity of sodium valproate was tested, using the 3T3 mouse +fibroblasts and neutral red uptake (NRU) assay. 22 different experiments +were performed independently in six laboratories, using eight +concentration levels, each with six replicates on a 96-well plate. In +addition, twelve measurements were taken for the solvent control. + +## Usage + +``` r +data("mdra") +``` + +## Format + +A data frame with 1320 observations on the following 4 variables. + +- `LabID`: + + a factor with levels `A` `B` `C` `D` `E` `F` + +- `ExperimentID`: + + a factor with levels `1` `2` `3` `4` `5` `6` `7` `8` `9` `10` `11` + `12` `13` `14` `15` `16` `17` `18` `19` `20` `21` `22` + +- `Concentration`: + + a numeric vector + +- `Response`: + + a numeric vector + +## Source + +http://biostatistics.dkfz.de/download/mdra/MDRA_ExampleData.csv + +## References + +Clothier, R., Gomez-Lechon, M. J., Kinsner-Ovaskainen, A., +Kopp-Schneider, A., O'Connor, J. E., Prieto, P., and Stanzel, S. (2013). +Comparative analysis of eight cytotoxicity assays evaluated within the +ACuteTox Project. Toxicology in vitro, 27(4):1347–1356. + +## Examples + +``` r +data(mdra) + +## Fit a three-parameter log-logistic model +mdra.m1 <- drm(Response ~ Concentration, data = mdra, fct = LL.3()) +summary(mdra.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 0.87155467 0.05369552 16.231 < 2.2e-16 *** +#> d:(Intercept) 1.03125713 0.00904617 113.999 < 2.2e-16 *** +#> e:(Intercept) 0.00381995 0.00021312 17.924 < 2.2e-16 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.2333374 (1317 degrees of freedom) +plot(mdra.m1, main = "MDRA dose-response") +``` diff --git a/docs/reference/mecter-1.png b/docs/reference/mecter-1.png new file mode 100644 index 00000000..d3a6a81c Binary files /dev/null and b/docs/reference/mecter-1.png differ diff --git a/docs/reference/mecter-2.png b/docs/reference/mecter-2.png new file mode 100644 index 00000000..19651abd Binary files /dev/null and b/docs/reference/mecter-2.png differ diff --git a/docs/reference/mecter-3.png b/docs/reference/mecter-3.png new file mode 100644 index 00000000..b4473071 Binary files /dev/null and b/docs/reference/mecter-3.png differ diff --git a/docs/reference/mecter.html b/docs/reference/mecter.html new file mode 100644 index 00000000..2d898373 --- /dev/null +++ b/docs/reference/mecter.html @@ -0,0 +1,220 @@ + +Mechlorprop and terbythylazine tested on Lemna minor — mecter • drc + Skip to contents + + +
    +
    +
    +

    Mechlorprop and terbythylazine tested on Lemna minor

    + +
    mecter.Rd
    +
    + +
    +

    Data consist of 5 mixture, 6 dilutions, three replicates, and 12 common controls; in total 102 onservations.

    +
    + +
    +

    Usage

    + 
    data(mecter)
    +
    + +
    +

    Format

    +

    A data frame with 102 observations on the following 3 variables.

    dose
    +

    a numeric vector of dose values

    + +
    pct
    +

    a numeric vector denoting the grouping according to the mixtures percentages

    + +
    rgr
    +

    a numeric vector of response values (relative growth rates)

    + + +
    +
    +

    Details

    +

    The dataset is analysed in Soerensen et al (2007). + The asymmetric Voelund model is appropriate, whereas the symmetric Hewlett model is not.

    +
    +
    +

    Source

    +

    The dataset is kindly provided by Nina Cedergreen, Department of Agricultural Sciences, + Royal Veterinary and Agricultural University, Denmark.

    +
    +
    +

    References

    +

    Soerensen, H. and Cedergreen, N. and Skovgaard, I. M. and Streibig, J. C. (2007) + An isobole-based statistical model and test for synergism/antagonism in binary mixture toxicity experiments, + Environmental and Ecological Statistics, 14, 383–397.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Fitting the model with freely varying ED50 values
+mecter.free <- drm(rgr ~ dose, pct, data = mecter, 
+fct = LL.4(), pmodels = list(~1, ~1, ~1, ~factor(pct) - 1)) 
+#> Control measurements detected for level: 999
+
+## Lack-of-fit test
+modelFit(mecter.free)  # not really acceptable
+#> Lack-of-fit test
+#> 
+#>           ModelDf      RSS Df F value p value
+#> ANOVA          71 0.033732                   
+#> DRC model      94 0.063801 23  2.7518  0.0006
+summary(mecter.free)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                  Estimate  Std. Error t-value   p-value    
+#> b:(Intercept)  1.1263e+00  1.2130e-01  9.2851 6.153e-15 ***
+#> c:(Intercept) -4.1327e-02  2.1251e-02 -1.9447    0.0548 .  
+#> d:(Intercept)  3.0006e-01  5.8249e-03 51.5127 < 2.2e-16 ***
+#> e:100          1.5090e+04  2.4007e+03  6.2856 1.015e-08 ***
+#> e:75           3.1667e+04  5.2165e+03  6.0705 2.673e-08 ***
+#> e:50           3.0038e+04  5.0377e+03  5.9627 4.321e-08 ***
+#> e:25           1.9395e+04  3.2661e+03  5.9382 4.818e-08 ***
+#> e:0            1.9855e+04  3.5090e+03  5.6583 1.646e-07 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.02605256 (94 degrees of freedom)
+
+## Plotting isobole structure
+isobole(mecter.free, exchange = 0.02)
+
+## Fitting the concentration addition model
+mecter.ca <- mixture(mecter.free, model = "CA")
+#> Warning: Using formula(x) is deprecated when x is a character vector of length > 1.
+#>   Consider formula(paste(x, collapse = " ")) instead.
+#> Control measurements detected for level: 999
+
+## Comparing to model with freely varying e parameter
+anova(mecter.ca, mecter.free)  # rejected
+#> 
+#> 1st model
+#>  fct:     CA model
+#>  pmodels: ~~~1, ~1, ~1, ~I(1/(pct/100)) - 1, ~I(1/(1 - pct/100)) - 1
+#> 2nd model
+#>  fct:     LL.4()
+#>  pmodels: ~1, ~1, ~1, ~factor(pct) - 1
+#> 
+#> ANOVA table
+#> 
+#>           ModelDf      RSS Df F value p value
+#> 1st model      97 0.091446                   
+#> 2nd model      94 0.063801  3  13.577   0.000
+
+## Plotting isobole based on concentration addition
+isobole(mecter.free, mecter.ca, exchange = 0.02)  # poor fit
+
+
+## Fitting the Hewlett model
+mecter.hew <- mixture(mecter.free, model = "Hewlett")
+#> Warning: Using formula(x) is deprecated when x is a character vector of length > 1.
+#>   Consider formula(paste(x, collapse = " ")) instead.
+#> Control measurements detected for level: 999
+
+## Comparing to model with freely varying e parameter
+anova(mecter.hew, mecter.free)  # rejected
+#> 
+#> 1st model
+#>  fct:     Hewlett model
+#>  pmodels: ~~~1, ~1, ~1, ~I(1/(pct/100)) - 1, ~I(1/(1 - pct/100)) - 1, ~1
+#> 2nd model
+#>  fct:     LL.4()
+#>  pmodels: ~1, ~1, ~1, ~factor(pct) - 1
+#> 
+#> ANOVA table
+#> 
+#>           ModelDf      RSS Df F value p value
+#> 1st model      96 0.074836                   
+#> 2nd model      94 0.063801  2  8.1286  0.0006
+
+## Plotting isobole based on the Hewlett model
+isobole(mecter.free, mecter.hew, exchange = 0.02)  # poor fit
+
+
+## Fitting the Voelund model
+mecter.voe<-mixture(mecter.free, model = "Voelund")
+#> Warning: Using formula(x) is deprecated when x is a character vector of length > 1.
+#>   Consider formula(paste(x, collapse = " ")) instead.
+#> Control measurements detected for level: 999
+
+## Comparing to model with freely varying e parameter
+anova(mecter.voe, mecter.free)  # accepted
+#> 
+#> 1st model
+#>  fct:     Voelund model
+#>  pmodels: ~~~1, ~1, ~1, ~I(1/(pct/100)) - 1, ~I(1/(1 - pct/100)) - 1, ~1, ~1
+#> 2nd model
+#>  fct:     LL.4()
+#>  pmodels: ~1, ~1, ~1, ~factor(pct) - 1
+#> 
+#> ANOVA table
+#> 
+#>           ModelDf      RSS Df F value p value
+#> 1st model      95 0.065481                   
+#> 2nd model      94 0.063801  1  2.4755  0.1190
+
+## Plotting isobole based on the Voelund model
+isobole(mecter.free, mecter.voe, exchange = 0.02)  # good fit
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/mecter.md b/docs/reference/mecter.md new file mode 100644 index 00000000..5a664237 --- /dev/null +++ b/docs/reference/mecter.md @@ -0,0 +1,166 @@ +# Mechlorprop and terbythylazine tested on Lemna minor + +Data consist of 5 mixture, 6 dilutions, three replicates, and 12 common +controls; in total 102 onservations. + +## Usage + +``` r +data(mecter) +``` + +## Format + +A data frame with 102 observations on the following 3 variables. + +- `dose`: + + a numeric vector of dose values + +- `pct`: + + a numeric vector denoting the grouping according to the mixtures + percentages + +- `rgr`: + + a numeric vector of response values (relative growth rates) + +## Details + +The dataset is analysed in Soerensen et al (2007). The asymmetric +Voelund model is appropriate, whereas the symmetric Hewlett model is +not. + +## Source + +The dataset is kindly provided by Nina Cedergreen, Department of +Agricultural Sciences, Royal Veterinary and Agricultural University, +Denmark. + +## References + +Soerensen, H. and Cedergreen, N. and Skovgaard, I. M. and Streibig, J. +C. (2007) An isobole-based statistical model and test for +synergism/antagonism in binary mixture toxicity experiments, +*Environmental and Ecological Statistics*, **14**, 383–397. + +## Examples + +``` r +library(drc) + +## Fitting the model with freely varying ED50 values +mecter.free <- drm(rgr ~ dose, pct, data = mecter, +fct = LL.4(), pmodels = list(~1, ~1, ~1, ~factor(pct) - 1)) +#> Control measurements detected for level: 999 + +## Lack-of-fit test +modelFit(mecter.free) # not really acceptable +#> Lack-of-fit test +#> +#> ModelDf RSS Df F value p value +#> ANOVA 71 0.033732 +#> DRC model 94 0.063801 23 2.7518 0.0006 +summary(mecter.free) +#> +#> Model fitted: Log-logistic (ED50 as parameter) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 1.1263e+00 1.2130e-01 9.2851 6.153e-15 *** +#> c:(Intercept) -4.1327e-02 2.1251e-02 -1.9447 0.0548 . +#> d:(Intercept) 3.0006e-01 5.8249e-03 51.5127 < 2.2e-16 *** +#> e:100 1.5090e+04 2.4007e+03 6.2856 1.015e-08 *** +#> e:75 3.1667e+04 5.2165e+03 6.0705 2.673e-08 *** +#> e:50 3.0038e+04 5.0377e+03 5.9627 4.321e-08 *** +#> e:25 1.9395e+04 3.2661e+03 5.9382 4.818e-08 *** +#> e:0 1.9855e+04 3.5090e+03 5.6583 1.646e-07 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.02605256 (94 degrees of freedom) + +## Plotting isobole structure +isobole(mecter.free, exchange = 0.02) + +## Fitting the concentration addition model +mecter.ca <- mixture(mecter.free, model = "CA") +#> Warning: Using formula(x) is deprecated when x is a character vector of length > 1. +#> Consider formula(paste(x, collapse = " ")) instead. +#> Control measurements detected for level: 999 + +## Comparing to model with freely varying e parameter +anova(mecter.ca, mecter.free) # rejected +#> +#> 1st model +#> fct: CA model +#> pmodels: ~~~1, ~1, ~1, ~I(1/(pct/100)) - 1, ~I(1/(1 - pct/100)) - 1 +#> 2nd model +#> fct: LL.4() +#> pmodels: ~1, ~1, ~1, ~factor(pct) - 1 +#> +#> ANOVA table +#> +#> ModelDf RSS Df F value p value +#> 1st model 97 0.091446 +#> 2nd model 94 0.063801 3 13.577 0.000 + +## Plotting isobole based on concentration addition +isobole(mecter.free, mecter.ca, exchange = 0.02) # poor fit + + +## Fitting the Hewlett model +mecter.hew <- mixture(mecter.free, model = "Hewlett") +#> Warning: Using formula(x) is deprecated when x is a character vector of length > 1. +#> Consider formula(paste(x, collapse = " ")) instead. +#> Control measurements detected for level: 999 + +## Comparing to model with freely varying e parameter +anova(mecter.hew, mecter.free) # rejected +#> +#> 1st model +#> fct: Hewlett model +#> pmodels: ~~~1, ~1, ~1, ~I(1/(pct/100)) - 1, ~I(1/(1 - pct/100)) - 1, ~1 +#> 2nd model +#> fct: LL.4() +#> pmodels: ~1, ~1, ~1, ~factor(pct) - 1 +#> +#> ANOVA table +#> +#> ModelDf RSS Df F value p value +#> 1st model 96 0.074836 +#> 2nd model 94 0.063801 2 8.1286 0.0006 + +## Plotting isobole based on the Hewlett model +isobole(mecter.free, mecter.hew, exchange = 0.02) # poor fit + + +## Fitting the Voelund model +mecter.voe<-mixture(mecter.free, model = "Voelund") +#> Warning: Using formula(x) is deprecated when x is a character vector of length > 1. +#> Consider formula(paste(x, collapse = " ")) instead. +#> Control measurements detected for level: 999 + +## Comparing to model with freely varying e parameter +anova(mecter.voe, mecter.free) # accepted +#> +#> 1st model +#> fct: Voelund model +#> pmodels: ~~~1, ~1, ~1, ~I(1/(pct/100)) - 1, ~I(1/(1 - pct/100)) - 1, ~1, ~1 +#> 2nd model +#> fct: LL.4() +#> pmodels: ~1, ~1, ~1, ~factor(pct) - 1 +#> +#> ANOVA table +#> +#> ModelDf RSS Df F value p value +#> 1st model 95 0.065481 +#> 2nd model 94 0.063801 1 2.4755 0.1190 + +## Plotting isobole based on the Voelund model +isobole(mecter.free, mecter.voe, exchange = 0.02) # good fit +``` diff --git a/docs/reference/metals-1.png b/docs/reference/metals-1.png new file mode 100644 index 00000000..16de96a9 Binary files /dev/null and b/docs/reference/metals-1.png differ diff --git a/docs/reference/metals-2.png b/docs/reference/metals-2.png new file mode 100644 index 00000000..795490ec Binary files /dev/null and b/docs/reference/metals-2.png differ diff --git a/docs/reference/metals.html b/docs/reference/metals.html new file mode 100644 index 00000000..5bd80d9f --- /dev/null +++ b/docs/reference/metals.html @@ -0,0 +1,149 @@ + +Data from heavy metal mixture experiments — metals • drc + Skip to contents + + +
    +
    +
    +

    Data from heavy metal mixture experiments

    + +
    metals.Rd
    +
    + +
    +

    Data are from a study of the response of the cyanobacterial self-luminescent metallothionein-based whole-cell biosensor Synechoccocus elongatus PCC 7942 pBG2120 to binary mixtures of 6 heavy metals (Zn, Cu, Cd, Ag, Co and Hg).

    +
    + +
    +

    Usage

    + 
    data("metals")
    +
    + +
    +

    Format

    +

    A data frame with 543 observations on the following 3 variables.

    metal
    +

    a factor with levels Ag AgCd Cd Co CoAg CoCd Cu CuAg CuCd CuCo CuHg CuZn Hg HgCd HgCo Zn ZnAg ZnCd ZnCo ZnHg

    + +
    conc
    +

    a numeric vector of concentrations

    + +
    BIF
    +

    a numeric vector of luminescence induction factors

    + + +
    +
    +

    Details

    +

    Data are from the study described by Martin-Betancor et al. (2015).

    +
    +
    +

    Source

    +

    Martin-Betancor, K. and Ritz, C. and Fernandez-Pinas, F. and Leganes, F. and Rodea-Palomares, I. (2015) +Defining an additivity framework for mixture research in inducible whole-cell biosensors, +Scientific Reports +17200.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## One example from the paper by Martin-Betancor et al (2015)
+
+## Figure 2
+
+## Fitting a model for "Zn"
+Zn.lgau <- drm(BIF ~ conc, data = subset(metals, metal == "Zn"), 
+fct = lgaussian(), bcVal = 0, bcAdd = 10)
+
+## Plotting data and fitted curve
+plot(Zn.lgau, log = "", type = "all", 
+xlab = expression(paste(plain("Zn")^plain("2+"), " ", mu, "", plain("M"))))
+
+
+## Calculating effective doses
+ED(Zn.lgau, 50, interval = "delta")
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error   Lower   Upper
+#> e:50  3.34241    0.18363 2.96627 3.71855
+ED(Zn.lgau, -50, interval = "delta", bound = FALSE)
+#> 
+#> Estimated effective doses
+#> 
+#>       Estimate Std. Error    Lower    Upper
+#> e:-50 1.508038   0.082849 1.338329 1.677746
+ED(Zn.lgau, 99.999,interval = "delta")  # approx. for ED0
+#> 
+#> Estimated effective doses
+#> 
+#>          Estimate Std. Error    Lower    Upper
+#> e:99.999 2.258720   0.058849 2.138173 2.379267
+
+## Fitting a model for "Cu"
+Cu.lgau <- drm(BIF ~ conc, data = subset(metals, metal == "Cu"), 
+fct = lgaussian()) 
+
+## Fitting a model for the mixture Cu-Zn
+CuZn.lgau <- drm(BIF ~ conc, data = subset(metals, metal == "CuZn"), 
+fct = lgaussian()) 
+
+## Calculating effects needed for the FA-CI plot
+CuZn.effects <- CIcompX(0.015, list(CuZn.lgau, Cu.lgau, Zn.lgau), 
+c(-5, -10, -20, -30, -40, -50, -60, -70, -80, -90, -99, 99, 90, 80, 70, 60, 50, 40, 30, 20, 10))
+
+## Reproducing the FA-cI plot shown in Figure 5d
+plotFACI(CuZn.effects, "ED", ylim = c(0.8, 1.6), showPoints = TRUE)
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/metals.md b/docs/reference/metals.md new file mode 100644 index 00000000..51599dd5 --- /dev/null +++ b/docs/reference/metals.md @@ -0,0 +1,95 @@ +# Data from heavy metal mixture experiments + +Data are from a study of the response of the cyanobacterial +self-luminescent metallothionein-based whole-cell biosensor +Synechoccocus elongatus PCC 7942 pBG2120 to binary mixtures of 6 heavy +metals (Zn, Cu, Cd, Ag, Co and Hg). + +## Usage + +``` r +data("metals") +``` + +## Format + +A data frame with 543 observations on the following 3 variables. + +- `metal`: + + a factor with levels `Ag` `AgCd` `Cd` `Co` `CoAg` `CoCd` `Cu` `CuAg` + `CuCd` `CuCo` `CuHg` `CuZn` `Hg` `HgCd` `HgCo` `Zn` `ZnAg` `ZnCd` + `ZnCo` `ZnHg` + +- `conc`: + + a numeric vector of concentrations + +- `BIF`: + + a numeric vector of luminescence induction factors + +## Details + +Data are from the study described by Martin-Betancor et al. (2015). + +## Source + +Martin-Betancor, K. and Ritz, C. and Fernandez-Pinas, F. and Leganes, F. +and Rodea-Palomares, I. (2015) Defining an additivity framework for +mixture research in inducible whole-cell biosensors, *Scientific +Reports* **17200**. + +## Examples + +``` r +library(drc) + +## One example from the paper by Martin-Betancor et al (2015) + +## Figure 2 + +## Fitting a model for "Zn" +Zn.lgau <- drm(BIF ~ conc, data = subset(metals, metal == "Zn"), +fct = lgaussian(), bcVal = 0, bcAdd = 10) + +## Plotting data and fitted curve +plot(Zn.lgau, log = "", type = "all", +xlab = expression(paste(plain("Zn")^plain("2+"), " ", mu, "", plain("M")))) + + +## Calculating effective doses +ED(Zn.lgau, 50, interval = "delta") +#> +#> Estimated effective doses +#> +#> Estimate Std. Error Lower Upper +#> e:50 3.34241 0.18363 2.96627 3.71855 +ED(Zn.lgau, -50, interval = "delta", bound = FALSE) +#> +#> Estimated effective doses +#> +#> Estimate Std. Error Lower Upper +#> e:-50 1.508038 0.082849 1.338329 1.677746 +ED(Zn.lgau, 99.999,interval = "delta") # approx. for ED0 +#> +#> Estimated effective doses +#> +#> Estimate Std. Error Lower Upper +#> e:99.999 2.258720 0.058849 2.138173 2.379267 + +## Fitting a model for "Cu" +Cu.lgau <- drm(BIF ~ conc, data = subset(metals, metal == "Cu"), +fct = lgaussian()) + +## Fitting a model for the mixture Cu-Zn +CuZn.lgau <- drm(BIF ~ conc, data = subset(metals, metal == "CuZn"), +fct = lgaussian()) + +## Calculating effects needed for the FA-CI plot +CuZn.effects <- CIcompX(0.015, list(CuZn.lgau, Cu.lgau, Zn.lgau), +c(-5, -10, -20, -30, -40, -50, -60, -70, -80, -90, -99, 99, 90, 80, 70, 60, 50, 40, 30, 20, 10)) + +## Reproducing the FA-cI plot shown in Figure 5d +plotFACI(CuZn.effects, "ED", ylim = c(0.8, 1.6), showPoints = TRUE) +``` diff --git a/docs/reference/methionine-1.png b/docs/reference/methionine-1.png new file mode 100644 index 00000000..2dd3ea82 Binary files /dev/null and b/docs/reference/methionine-1.png differ diff --git a/docs/reference/methionine.html b/docs/reference/methionine.html new file mode 100644 index 00000000..d19b8a98 --- /dev/null +++ b/docs/reference/methionine.html @@ -0,0 +1,130 @@ + +Weight gain for different methionine sources — methionine • drc + Skip to contents + + +
    +
    +
    +

    Weight gain for different methionine sources

    + +
    methionine.Rd
    +
    + +
    +

    Data consist of average body weight gain of chickens being treated + with one of the two methionine sources DLM and HMTBA.

    +
    + +
    +

    Usage

    + 
    data(methionine)
    +
    + +
    +

    Format

    +

    A data frame with 9 observations on the following 3 variables:

    product
    +

    a factor with levels control, DLM and MHA denoting the treatments

    + +
    dose
    +

    a numeric vector of methionine dose

    + +
    gain
    +

    a numeric vector of average body weight gain

    + + +
    +
    +

    Details

    +

    The dataset contains a common control measurement for the two treatments.

    +
    +
    +

    Source

    +

    Kratzer. D. D. and Littell, R. C. (2006) Appropriate Statistical Methods to Compare + Dose Responses of Methionine Sources, Poultry Science, 85, 947–954.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Fitting model with constraint on one parameter 
+met.ar.m1 <- drm(gain~dose, product, data = methionine, 
+fct = AR.3(), pmodels = list(~1, ~factor(product), ~factor(product)), 
+upperl = c(Inf, Inf, 1700, Inf, Inf)) 
+#> Control measurements detected for level: control
+
+plot(met.ar.m1, xlim=c(0,0.3), ylim=c(1450, 1800))
+abline(h=1700, lty=1)
+
+
+summary(met.ar.m1)
+#> 
+#> Model fitted: Shifted asymptotic regression (3 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                 Estimate Std. Error t-value   p-value    
+#> c:(Intercept) 1.4483e+03 2.1249e+01 68.1582 2.776e-07 ***
+#> d:DLM         1.6887e+03 1.9221e+01 87.8589 1.006e-07 ***
+#> d:MHA         1.7000e+03 2.0773e+01 81.8359 1.336e-07 ***
+#> e:DLM         4.4217e-02 1.4050e-02  3.1472   0.03461 *  
+#> e:MHA         5.9462e-02 1.4529e-02  4.0925   0.01494 *  
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  22.32469 (4 degrees of freedom)
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/methionine.md b/docs/reference/methionine.md new file mode 100644 index 00000000..8f0a1407 --- /dev/null +++ b/docs/reference/methionine.md @@ -0,0 +1,73 @@ +# Weight gain for different methionine sources + +Data consist of average body weight gain of chickens being treated with +one of the two methionine sources DLM and HMTBA. + +## Usage + +``` r +data(methionine) +``` + +## Format + +A data frame with 9 observations on the following 3 variables: + +- `product`: + + a factor with levels `control`, `DLM` and `MHA` denoting the + treatments + +- `dose`: + + a numeric vector of methionine dose + +- `gain`: + + a numeric vector of average body weight gain + +## Details + +The dataset contains a common control measurement for the two +treatments. + +## Source + +Kratzer. D. D. and Littell, R. C. (2006) Appropriate Statistical Methods +to Compare Dose Responses of Methionine Sources, *Poultry Science*, +**85**, 947–954. + +## Examples + +``` r +library(drc) + +## Fitting model with constraint on one parameter +met.ar.m1 <- drm(gain~dose, product, data = methionine, +fct = AR.3(), pmodels = list(~1, ~factor(product), ~factor(product)), +upperl = c(Inf, Inf, 1700, Inf, Inf)) +#> Control measurements detected for level: control + +plot(met.ar.m1, xlim=c(0,0.3), ylim=c(1450, 1800)) +abline(h=1700, lty=1) + + +summary(met.ar.m1) +#> +#> Model fitted: Shifted asymptotic regression (3 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> c:(Intercept) 1.4483e+03 2.1249e+01 68.1582 2.776e-07 *** +#> d:DLM 1.6887e+03 1.9221e+01 87.8589 1.006e-07 *** +#> d:MHA 1.7000e+03 2.0773e+01 81.8359 1.336e-07 *** +#> e:DLM 4.4217e-02 1.4050e-02 3.1472 0.03461 * +#> e:MHA 5.9462e-02 1.4529e-02 4.0925 0.01494 * +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 22.32469 (4 degrees of freedom) +``` diff --git a/docs/reference/mixture.html b/docs/reference/mixture.html index 07ce8368..94b11119 100644 --- a/docs/reference/mixture.html +++ b/docs/reference/mixture.html @@ -1,187 +1,128 @@ - - - - - - +Fitting binary mixture models — mixture • drc + Skip to contents -Fitting binary mixture models — mixture • drc - - - +
    +
    +
    +

    Fitting binary mixture models

    + Source: R/mixture.R +
    mixture.Rd
    +
    - +
    +

    mixture fits a concentration addition, Hewlett or Voelund model to data from binary +mixture toxicity experiments.

    +
    - - +
    +

    Usage

    + 
    mixture(
+  object,
+  model = c("CA", "Hewlett", "Voelund"),
+  start,
+  startm,
+  control = drmc()
+)
    +
    +
    +

    Arguments

    - - +
    object
    +

    object of class 'drc' corresponding to the model with freely varying EC50 values.

    - +
    model
    +

    character string. It can be "CA", "Hewlett" or "Voelund".

    - - -
    -
    - - - -
    -
    -
    -
    -

    Fitting binary mixture models

    - - -
    +
    startm
    +

    optional numeric vector supplying the lambda parameter in the Hewlett model or +the eta parameters (two parameters) in the Voelund model.

    -
    - -

    'mixture' fits a concentration addition, Hewlett or Voelund model to data from binary mixture toxicity experiments.

    - -
    - 
    mixture(object, model = c("CA", "Hewlett", "Voelund"), start, startm, control = drmc())
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - - - - - -
    object

    object of class 'drc' corresponding to the model with freely varying EC50 values.

    model

    character string. It can be "CA", "Hewlett" or "Voelund".

    start

    optional numeric vector supplying starting values for all parameters in the mixture model.

    startm

    optional numeric vector supplying the lambda parameter in the Hewlett model or - the eta parameters (two parameters) in the Voelund model.

    control

    list of arguments controlling constrained optimisation (zero as boundary), - maximum number of iteration in the optimisation, - relative tolerance in the optimisation, warnings issued during the optimisation.

    - -

    Details

    - -

    The function is a wrapper to drm, implementing the models described in Soerensen et al. (2007). - See the paper for a discussion of the merits of the different models.

    -

    Currently only the log-logistic models are available. Application of Box-Cox transformation is not yet available.

    - -

    Value

    +
    control
    +

    list of arguments controlling constrained optimisation (zero as boundary), +maximum number of iteration in the optimisation, relative tolerance in the optimisation, +warnings issued during the optimisation.

    +
    +
    +

    Value

    An object of class 'drc' with a few additional components.

    - -

    References

    - -

    Ritz, C. and Streibig, J. C. (2014) - From additivity to synergism - A modelling perspective - Synergy, 1, 22--29.

    - - -
    - +
    +

    Details

    +

    The function is a wrapper to drm, implementing the models described in +Soerensen et al. (2007). See the paper for a discussion of the merits of the different models.

    +

    Currently only the log-logistic models are available. Application of Box-Cox transformation +is not yet available.

    +
    +
    +

    References

    +

    Ritz, C. and Streibig, J. C. (2014) From additivity to synergism - A +modelling perspective Synergy, 1, 22–29.

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    -
  • Value
    • +
    -
  • References
    • - -

    Author

    - Christian Ritz -
    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + -
    - - - - + diff --git a/docs/reference/mixture.md b/docs/reference/mixture.md new file mode 100644 index 00000000..8e5225c9 --- /dev/null +++ b/docs/reference/mixture.md @@ -0,0 +1,67 @@ +# Fitting binary mixture models + +`mixture` fits a concentration addition, Hewlett or Voelund model to +data from binary mixture toxicity experiments. + +## Usage + +``` r +mixture( + object, + model = c("CA", "Hewlett", "Voelund"), + start, + startm, + control = drmc() +) +``` + +## Arguments + +- object: + + object of class 'drc' corresponding to the model with freely varying + EC50 values. + +- model: + + character string. It can be "CA", "Hewlett" or "Voelund". + +- start: + + optional numeric vector supplying starting values for all parameters + in the mixture model. + +- startm: + + optional numeric vector supplying the lambda parameter in the Hewlett + model or the eta parameters (two parameters) in the Voelund model. + +- control: + + list of arguments controlling constrained optimisation (zero as + boundary), maximum number of iteration in the optimisation, relative + tolerance in the optimisation, warnings issued during the + optimisation. + +## Value + +An object of class 'drc' with a few additional components. + +## Details + +The function is a wrapper to +[`drm`](https://hreinwald.github.io/drc/reference/drm.md), implementing +the models described in Soerensen et al. (2007). See the paper for a +discussion of the merits of the different models. + +Currently only the log-logistic models are available. Application of +Box-Cox transformation is not yet available. + +## References + +Ritz, C. and Streibig, J. C. (2014) From additivity to synergism - A +modelling perspective *Synergy*, **1**, 22–29. + +## Author + +Christian Ritz diff --git a/docs/reference/ml3a.html b/docs/reference/ml3a.html new file mode 100644 index 00000000..6f76e6b8 --- /dev/null +++ b/docs/reference/ml3a.html @@ -0,0 +1,196 @@ + +Alias for CRS.4a (Deprecated) — ml3a • drc + Skip to contents + + +
    +
    +
    +

    Alias for CRS.4a (Deprecated)

    + Source: R/cedergreen.R +
    ml3a.Rd
    +
    + +
    +

    [Deprecated]

    +

    This function is a deprecated alias for CRS.4a(), itself deprecated as of +version 3.3.0. Please use CRS.5() instead, which provides a more general +and flexible interface.

    +
    + +
    +

    Usage

    + 
    ml3a(names = c("b", "c", "d", "e", "f"), fixed = c(NA, 0, NA, NA, NA), ...)
    +
    + +
    +

    Arguments

    + + +
    names
    +

    A character vector of length 5 specifying the names of the model +parameters in the following order:

    b
    +

    Hill slope (steepness of the dose-response curve).

    + +
    c
    +

    Lower asymptote (fixed at 0 via the fixed argument).

    + +
    d
    +

    Upper asymptote.

    + +
    e
    +

    Effective dose producing a response midway between c and d +(ED50).

    + +
    f
    +

    Hormesis parameter controlling the magnitude of the stimulatory +effect at low doses.

    + + +

    Defaults to c("b", "c", "d", "e", "f").

    + + +
    fixed
    +

    A numeric vector of length 5 specifying fixed (non-estimated) +parameter values. Use NA for parameters that should be estimated freely. +Defaults to c(NA, 0, NA, NA, NA), which fixes the lower asymptote c +at 0.

    + + +
    ...
    +

    Additional arguments passed to cedergreen().

    + +
    +
    +

    Value

    +

    A list of class "drcMean" as returned by cedergreen(), containing +the model definition including the mean function, its gradient, parameter +names, and fixed values. This object is intended for use as the fct +argument in drm().

    +
    +
    +

    See also

    +
    +

    • CRS.5() — the recommended replacement for this deprecated function.

      • +

    • CRS.4a() — the function this alias points to.

      • +

    • cedergreen() — the underlying model constructor.

      • +
    +
    +
    +

    Author

    +

    Christian Ritz, Hannes Reinwald

    +
    + +
    +

    Examples

    + 
    # NOTE: ml3a() is a deprecated alias for CRS.4a(). Use CRS.5() instead.
+# The example below is retained for backward compatibility illustration only.
+
+lettuce.crsm1 <- drm( lettuce[, c(2, 1)], fct = ml3a() )
+summary(lettuce.crsm1)
+#> 
+#> Model fitted: Cedergreen-Ritz-Streibig with lower limit 0 (alpha=1) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                 Estimate Std. Error t-value   p-value    
+#> b:(Intercept) 7.7892e-01 2.5343e-01  3.0735   0.01177 *  
+#> d:(Intercept) 1.1091e+00 7.8336e-02 14.1586 6.081e-08 ***
+#> e:(Intercept) 2.8572e+01 3.1328e+01  0.9120   0.38322    
+#> f:(Intercept) 5.5833e-04 4.1209e-01  0.0014   0.99895    
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.155635 (10 degrees of freedom)
+ED(lettuce.crsm1, c(50))
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error
+#> e:50   28.608     11.751
+
+# Recommended replacement:
+fct_spec <- CRS.5(alpha_type = "a", fixed = c(NA, 0, NA, NA, NA))
+lettuce.crs5 <- drm(lettuce[, c(2, 1)], fct = fct_spec)
+summary(lettuce.crs5)
+#> 
+#> Model fitted: Cedergreen-Ritz-Streibig (alpha=1) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                 Estimate Std. Error t-value   p-value    
+#> b:(Intercept) 7.7892e-01 2.5343e-01  3.0735   0.01177 *  
+#> d:(Intercept) 1.1091e+00 7.8336e-02 14.1586 6.081e-08 ***
+#> e:(Intercept) 2.8572e+01 3.1328e+01  0.9120   0.38322    
+#> f:(Intercept) 5.5833e-04 4.1209e-01  0.0014   0.99895    
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.155635 (10 degrees of freedom)
+ED(lettuce.crs5, c(50))
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error
+#> e:50   28.608     11.751
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/ml3a.md b/docs/reference/ml3a.md new file mode 100644 index 00000000..d246a775 --- /dev/null +++ b/docs/reference/ml3a.md @@ -0,0 +1,141 @@ +# Alias for CRS.4a (Deprecated) + +**\[deprecated\]** + +This function is a deprecated alias for +[`CRS.4a()`](https://hreinwald.github.io/drc/reference/CRS.4a.md), +itself deprecated as of version 3.3.0. Please use +[`CRS.5()`](https://hreinwald.github.io/drc/reference/CRS.5.md) instead, +which provides a more general and flexible interface. + +## Usage + +``` r +ml3a(names = c("b", "c", "d", "e", "f"), fixed = c(NA, 0, NA, NA, NA), ...) +``` + +## Arguments + +- names: + + A character vector of length 5 specifying the names of the model + parameters in the following order: + + `b` + + : Hill slope (steepness of the dose-response curve). + + `c` + + : Lower asymptote (fixed at 0 via the `fixed` argument). + + `d` + + : Upper asymptote. + + `e` + + : Effective dose producing a response midway between `c` and `d` + (ED50). + + `f` + + : Hormesis parameter controlling the magnitude of the stimulatory + effect at low doses. + + Defaults to `c("b", "c", "d", "e", "f")`. + +- fixed: + + A numeric vector of length 5 specifying fixed (non-estimated) + parameter values. Use `NA` for parameters that should be estimated + freely. Defaults to `c(NA, 0, NA, NA, NA)`, which fixes the lower + asymptote `c` at 0. + +- ...: + + Additional arguments passed to + [`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md). + +## Value + +A list of class `"drcMean"` as returned by +[`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md), +containing the model definition including the mean function, its +gradient, parameter names, and fixed values. This object is intended for +use as the `fct` argument in +[`drm()`](https://hreinwald.github.io/drc/reference/drm.md). + +## See also + +- [`CRS.5()`](https://hreinwald.github.io/drc/reference/CRS.5.md) — the + recommended replacement for this deprecated function. + +- [`CRS.4a()`](https://hreinwald.github.io/drc/reference/CRS.4a.md) — + the function this alias points to. + +- [`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md) + — the underlying model constructor. + +## Author + +Christian Ritz, Hannes Reinwald + +## Examples + +``` r +# NOTE: ml3a() is a deprecated alias for CRS.4a(). Use CRS.5() instead. +# The example below is retained for backward compatibility illustration only. + +lettuce.crsm1 <- drm( lettuce[, c(2, 1)], fct = ml3a() ) +summary(lettuce.crsm1) +#> +#> Model fitted: Cedergreen-Ritz-Streibig with lower limit 0 (alpha=1) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 7.7892e-01 2.5343e-01 3.0735 0.01177 * +#> d:(Intercept) 1.1091e+00 7.8336e-02 14.1586 6.081e-08 *** +#> e:(Intercept) 2.8572e+01 3.1328e+01 0.9120 0.38322 +#> f:(Intercept) 5.5833e-04 4.1209e-01 0.0014 0.99895 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.155635 (10 degrees of freedom) +ED(lettuce.crsm1, c(50)) +#> +#> Estimated effective doses +#> +#> Estimate Std. Error +#> e:50 28.608 11.751 + +# Recommended replacement: +fct_spec <- CRS.5(alpha_type = "a", fixed = c(NA, 0, NA, NA, NA)) +lettuce.crs5 <- drm(lettuce[, c(2, 1)], fct = fct_spec) +summary(lettuce.crs5) +#> +#> Model fitted: Cedergreen-Ritz-Streibig (alpha=1) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 7.7892e-01 2.5343e-01 3.0735 0.01177 * +#> d:(Intercept) 1.1091e+00 7.8336e-02 14.1586 6.081e-08 *** +#> e:(Intercept) 2.8572e+01 3.1328e+01 0.9120 0.38322 +#> f:(Intercept) 5.5833e-04 4.1209e-01 0.0014 0.99895 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.155635 (10 degrees of freedom) +ED(lettuce.crs5, c(50)) +#> +#> Estimated effective doses +#> +#> Estimate Std. Error +#> e:50 28.608 11.751 +``` diff --git a/docs/reference/ml3b.html b/docs/reference/ml3b.html new file mode 100644 index 00000000..bfb2a331 --- /dev/null +++ b/docs/reference/ml3b.html @@ -0,0 +1,196 @@ + +Alias for CRS.4b (Deprecated) — ml3b • drc + Skip to contents + + +
    +
    +
    +

    Alias for CRS.4b (Deprecated)

    + Source: R/cedergreen.R +
    ml3b.Rd
    +
    + +
    +

    [Deprecated]

    +

    This function is a deprecated alias for CRS.4b(), itself deprecated as of +version 3.3.0. Please use CRS.5() instead, which provides a more general +and flexible interface.

    +
    + +
    +

    Usage

    + 
    ml3b(names = c("b", "c", "d", "e", "f"), fixed = c(NA, 0, NA, NA, NA), ...)
    +
    + +
    +

    Arguments

    + + +
    names
    +

    A character vector of length 5 specifying the names of the model +parameters in the following order:

    b
    +

    Hill slope (steepness of the dose-response curve).

    + +
    c
    +

    Lower asymptote (fixed at 0 via the fixed argument).

    + +
    d
    +

    Upper asymptote.

    + +
    e
    +

    Effective dose producing a response midway between c and d +(ED50).

    + +
    f
    +

    Hormesis parameter controlling the magnitude of the stimulatory +effect at low doses.

    + + +

    Defaults to c("b", "c", "d", "e", "f").

    + + +
    fixed
    +

    A numeric vector of length 5 specifying fixed (non-estimated) +parameter values. Use NA for parameters that should be estimated freely. +Defaults to c(NA, 0, NA, NA, NA), which fixes the lower asymptote c +at 0.

    + + +
    ...
    +

    Additional arguments passed to cedergreen().

    + +
    +
    +

    Value

    +

    A list of class "drcMean" as returned by cedergreen(), containing +the model definition including the mean function, its gradient, parameter +names, and fixed values. This object is intended for use as the fct +argument in drm().

    +
    +
    +

    See also

    +
    +

    • CRS.5() — the recommended replacement for this deprecated function.

      • +

    • CRS.4b() — the function this alias points to.

      • +

    • cedergreen() — the underlying model constructor.

      • +
    +
    +
    +

    Author

    +

    Christian Ritz, Hannes Reinwald

    +
    + +
    +

    Examples

    + 
    # NOTE: ml3b() is a deprecated alias for CRS.4b(). Use CRS.5() instead.
+# The example below is retained for backward compatibility illustration only.
+
+lettuce.crsm2 <- drm( lettuce[, c(2, 1)], fct = ml3b() )
+summary(lettuce.crsm2)
+#> 
+#> Model fitted: Cedergreen-Ritz-Streibig with lower limit 0 (alpha=0.5) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept) 0.569426   0.068538  8.3081 8.444e-06 ***
+#> d:(Intercept) 1.008915   0.094919 10.6292 9.061e-07 ***
+#> e:(Intercept) 0.642290   1.533937  0.4187    0.6843    
+#> f:(Intercept) 4.446933   5.821389  0.7639    0.4626    
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.1345066 (10 degrees of freedom)
+ED(lettuce.crsm2, c(50))
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error
+#> e:50  26.1252     8.6286
+
+# Recommended replacement:
+fct_spec <- CRS.5(alpha_type = "b", fixed = c(NA, 0, NA, NA, NA))
+lettuce.crs5 <- drm(lettuce[, c(2, 1)], fct = fct_spec)
+summary(lettuce.crs5)
+#> 
+#> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.5) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept) 0.569426   0.068538  8.3081 8.444e-06 ***
+#> d:(Intercept) 1.008915   0.094919 10.6292 9.061e-07 ***
+#> e:(Intercept) 0.642290   1.533937  0.4187    0.6843    
+#> f:(Intercept) 4.446933   5.821389  0.7639    0.4626    
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.1345066 (10 degrees of freedom)
+ED(lettuce.crs5, c(50))
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error
+#> e:50  26.1252     8.6286
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/ml3b.md b/docs/reference/ml3b.md new file mode 100644 index 00000000..d30e1415 --- /dev/null +++ b/docs/reference/ml3b.md @@ -0,0 +1,141 @@ +# Alias for CRS.4b (Deprecated) + +**\[deprecated\]** + +This function is a deprecated alias for +[`CRS.4b()`](https://hreinwald.github.io/drc/reference/CRS.4b.md), +itself deprecated as of version 3.3.0. Please use +[`CRS.5()`](https://hreinwald.github.io/drc/reference/CRS.5.md) instead, +which provides a more general and flexible interface. + +## Usage + +``` r +ml3b(names = c("b", "c", "d", "e", "f"), fixed = c(NA, 0, NA, NA, NA), ...) +``` + +## Arguments + +- names: + + A character vector of length 5 specifying the names of the model + parameters in the following order: + + `b` + + : Hill slope (steepness of the dose-response curve). + + `c` + + : Lower asymptote (fixed at 0 via the `fixed` argument). + + `d` + + : Upper asymptote. + + `e` + + : Effective dose producing a response midway between `c` and `d` + (ED50). + + `f` + + : Hormesis parameter controlling the magnitude of the stimulatory + effect at low doses. + + Defaults to `c("b", "c", "d", "e", "f")`. + +- fixed: + + A numeric vector of length 5 specifying fixed (non-estimated) + parameter values. Use `NA` for parameters that should be estimated + freely. Defaults to `c(NA, 0, NA, NA, NA)`, which fixes the lower + asymptote `c` at 0. + +- ...: + + Additional arguments passed to + [`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md). + +## Value + +A list of class `"drcMean"` as returned by +[`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md), +containing the model definition including the mean function, its +gradient, parameter names, and fixed values. This object is intended for +use as the `fct` argument in +[`drm()`](https://hreinwald.github.io/drc/reference/drm.md). + +## See also + +- [`CRS.5()`](https://hreinwald.github.io/drc/reference/CRS.5.md) — the + recommended replacement for this deprecated function. + +- [`CRS.4b()`](https://hreinwald.github.io/drc/reference/CRS.4b.md) — + the function this alias points to. + +- [`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md) + — the underlying model constructor. + +## Author + +Christian Ritz, Hannes Reinwald + +## Examples + +``` r +# NOTE: ml3b() is a deprecated alias for CRS.4b(). Use CRS.5() instead. +# The example below is retained for backward compatibility illustration only. + +lettuce.crsm2 <- drm( lettuce[, c(2, 1)], fct = ml3b() ) +summary(lettuce.crsm2) +#> +#> Model fitted: Cedergreen-Ritz-Streibig with lower limit 0 (alpha=0.5) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 0.569426 0.068538 8.3081 8.444e-06 *** +#> d:(Intercept) 1.008915 0.094919 10.6292 9.061e-07 *** +#> e:(Intercept) 0.642290 1.533937 0.4187 0.6843 +#> f:(Intercept) 4.446933 5.821389 0.7639 0.4626 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.1345066 (10 degrees of freedom) +ED(lettuce.crsm2, c(50)) +#> +#> Estimated effective doses +#> +#> Estimate Std. Error +#> e:50 26.1252 8.6286 + +# Recommended replacement: +fct_spec <- CRS.5(alpha_type = "b", fixed = c(NA, 0, NA, NA, NA)) +lettuce.crs5 <- drm(lettuce[, c(2, 1)], fct = fct_spec) +summary(lettuce.crs5) +#> +#> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.5) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 0.569426 0.068538 8.3081 8.444e-06 *** +#> d:(Intercept) 1.008915 0.094919 10.6292 9.061e-07 *** +#> e:(Intercept) 0.642290 1.533937 0.4187 0.6843 +#> f:(Intercept) 4.446933 5.821389 0.7639 0.4626 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.1345066 (10 degrees of freedom) +ED(lettuce.crs5, c(50)) +#> +#> Estimated effective doses +#> +#> Estimate Std. Error +#> e:50 26.1252 8.6286 +``` diff --git a/docs/reference/ml3c.html b/docs/reference/ml3c.html new file mode 100644 index 00000000..000bc0cf --- /dev/null +++ b/docs/reference/ml3c.html @@ -0,0 +1,196 @@ + +Alias for CRS.4c (Deprecated) — ml3c • drc + Skip to contents + + +
    +
    +
    +

    Alias for CRS.4c (Deprecated)

    + Source: R/cedergreen.R +
    ml3c.Rd
    +
    + +
    +

    [Deprecated]

    +

    This function is a deprecated alias for CRS.4c(), itself deprecated as of +version 3.3.0. Please use CRS.5() instead, which provides a more general +and flexible interface.

    +
    + +
    +

    Usage

    + 
    ml3c(names = c("b", "c", "d", "e", "f"), fixed = c(NA, 0, NA, NA, NA), ...)
    +
    + +
    +

    Arguments

    + + +
    names
    +

    A character vector of length 5 specifying the names of the model +parameters in the following order:

    b
    +

    Hill slope (steepness of the dose-response curve).

    + +
    c
    +

    Lower asymptote (fixed at 0 via the fixed argument).

    + +
    d
    +

    Upper asymptote.

    + +
    e
    +

    Effective dose producing a response midway between c and d +(ED50).

    + +
    f
    +

    Hormesis parameter controlling the magnitude of the stimulatory +effect at low doses.

    + + +

    Defaults to c("b", "c", "d", "e", "f").

    + + +
    fixed
    +

    A numeric vector of length 5 specifying fixed (non-estimated) +parameter values. Use NA for parameters that should be estimated freely. +Defaults to c(NA, 0, NA, NA, NA), which fixes the lower asymptote c +at 0.

    + + +
    ...
    +

    Additional arguments passed to cedergreen().

    + +
    +
    +

    Value

    +

    A list of class "drcMean" as returned by cedergreen(), containing +the model definition including the mean function, its gradient, parameter +names, and fixed values. This object is intended for use as the fct +argument in drm().

    +
    +
    +

    See also

    +
    +

    • CRS.5() — the recommended replacement for this deprecated function.

      • +

    • CRS.4c() — the function this alias points to.

      • +

    • cedergreen() — the underlying model constructor.

      • +
    +
    +
    +

    Author

    +

    Christian Ritz, Hannes Reinwald

    +
    + +
    +

    Examples

    + 
    # NOTE: ml3c() is a deprecated alias for CRS.4c(). Use CRS.5() instead.
+# The example below is retained for backward compatibility illustration only.
+
+lettuce.crsm3 <- drm( lettuce[, c(2, 1)], fct = ml3c() )
+summary(lettuce.crsm3)
+#> 
+#> Model fitted: Cedergreen-Ritz-Streibig with lower limit 0 (alpha=0.25) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept) 0.488440   0.133643  3.6548  0.004427 ** 
+#> d:(Intercept) 0.973666   0.086883 11.2066 5.544e-07 ***
+#> e:(Intercept) 1.314657   3.614266  0.3637  0.723624    
+#> f:(Intercept) 2.998547   3.626210  0.8269  0.427579    
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.123575 (10 degrees of freedom)
+ED(lettuce.crsm3, c(50))
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error
+#> e:50   37.033     15.437
+
+# Recommended replacement:
+fct_spec <- CRS.5(alpha_type = "c", fixed = c(NA, 0, NA, NA, NA))
+lettuce.crs5 <- drm(lettuce[, c(2, 1)], fct = fct_spec)
+summary(lettuce.crs5)
+#> 
+#> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.25) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept) 0.488440   0.133643  3.6548  0.004427 ** 
+#> d:(Intercept) 0.973666   0.086883 11.2066 5.544e-07 ***
+#> e:(Intercept) 1.314657   3.614266  0.3637  0.723624    
+#> f:(Intercept) 2.998547   3.626210  0.8269  0.427579    
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.123575 (10 degrees of freedom)
+ED(lettuce.crs5, c(50))
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error
+#> e:50   37.033     15.437
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/ml3c.md b/docs/reference/ml3c.md new file mode 100644 index 00000000..ca1df1c2 --- /dev/null +++ b/docs/reference/ml3c.md @@ -0,0 +1,141 @@ +# Alias for CRS.4c (Deprecated) + +**\[deprecated\]** + +This function is a deprecated alias for +[`CRS.4c()`](https://hreinwald.github.io/drc/reference/CRS.4c.md), +itself deprecated as of version 3.3.0. Please use +[`CRS.5()`](https://hreinwald.github.io/drc/reference/CRS.5.md) instead, +which provides a more general and flexible interface. + +## Usage + +``` r +ml3c(names = c("b", "c", "d", "e", "f"), fixed = c(NA, 0, NA, NA, NA), ...) +``` + +## Arguments + +- names: + + A character vector of length 5 specifying the names of the model + parameters in the following order: + + `b` + + : Hill slope (steepness of the dose-response curve). + + `c` + + : Lower asymptote (fixed at 0 via the `fixed` argument). + + `d` + + : Upper asymptote. + + `e` + + : Effective dose producing a response midway between `c` and `d` + (ED50). + + `f` + + : Hormesis parameter controlling the magnitude of the stimulatory + effect at low doses. + + Defaults to `c("b", "c", "d", "e", "f")`. + +- fixed: + + A numeric vector of length 5 specifying fixed (non-estimated) + parameter values. Use `NA` for parameters that should be estimated + freely. Defaults to `c(NA, 0, NA, NA, NA)`, which fixes the lower + asymptote `c` at 0. + +- ...: + + Additional arguments passed to + [`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md). + +## Value + +A list of class `"drcMean"` as returned by +[`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md), +containing the model definition including the mean function, its +gradient, parameter names, and fixed values. This object is intended for +use as the `fct` argument in +[`drm()`](https://hreinwald.github.io/drc/reference/drm.md). + +## See also + +- [`CRS.5()`](https://hreinwald.github.io/drc/reference/CRS.5.md) — the + recommended replacement for this deprecated function. + +- [`CRS.4c()`](https://hreinwald.github.io/drc/reference/CRS.4c.md) — + the function this alias points to. + +- [`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md) + — the underlying model constructor. + +## Author + +Christian Ritz, Hannes Reinwald + +## Examples + +``` r +# NOTE: ml3c() is a deprecated alias for CRS.4c(). Use CRS.5() instead. +# The example below is retained for backward compatibility illustration only. + +lettuce.crsm3 <- drm( lettuce[, c(2, 1)], fct = ml3c() ) +summary(lettuce.crsm3) +#> +#> Model fitted: Cedergreen-Ritz-Streibig with lower limit 0 (alpha=0.25) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 0.488440 0.133643 3.6548 0.004427 ** +#> d:(Intercept) 0.973666 0.086883 11.2066 5.544e-07 *** +#> e:(Intercept) 1.314657 3.614266 0.3637 0.723624 +#> f:(Intercept) 2.998547 3.626210 0.8269 0.427579 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.123575 (10 degrees of freedom) +ED(lettuce.crsm3, c(50)) +#> +#> Estimated effective doses +#> +#> Estimate Std. Error +#> e:50 37.033 15.437 + +# Recommended replacement: +fct_spec <- CRS.5(alpha_type = "c", fixed = c(NA, 0, NA, NA, NA)) +lettuce.crs5 <- drm(lettuce[, c(2, 1)], fct = fct_spec) +summary(lettuce.crs5) +#> +#> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.25) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 0.488440 0.133643 3.6548 0.004427 ** +#> d:(Intercept) 0.973666 0.086883 11.2066 5.544e-07 *** +#> e:(Intercept) 1.314657 3.614266 0.3637 0.723624 +#> f:(Intercept) 2.998547 3.626210 0.8269 0.427579 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.123575 (10 degrees of freedom) +ED(lettuce.crs5, c(50)) +#> +#> Estimated effective doses +#> +#> Estimate Std. Error +#> e:50 37.033 15.437 +``` diff --git a/docs/reference/ml4a.html b/docs/reference/ml4a.html new file mode 100644 index 00000000..3cbbfb39 --- /dev/null +++ b/docs/reference/ml4a.html @@ -0,0 +1,197 @@ + +Alias for CRS.5a (Deprecated) — ml4a • drc + Skip to contents + + +
    +
    +
    +

    Alias for CRS.5a (Deprecated)

    + Source: R/cedergreen.R +
    ml4a.Rd
    +
    + +
    +

    [Deprecated]

    +

    This function is a deprecated alias for CRS.5a(), itself deprecated as of +version 3.3.0. Please use CRS.5() instead, which provides a more general +and flexible interface.

    +
    + +
    +

    Usage

    + 
    ml4a(names = c("b", "c", "d", "e", "f"), fixed = c(NA, NA, NA, NA, NA), ...)
    +
    + +
    +

    Arguments

    + + +
    names
    +

    A character vector of length 5 specifying the names of the model +parameters in the following order:

    b
    +

    Hill slope (steepness of the dose-response curve).

    + +
    c
    +

    Lower asymptote (freely estimated).

    + +
    d
    +

    Upper asymptote.

    + +
    e
    +

    Effective dose producing a response midway between c and d +(ED50).

    + +
    f
    +

    Hormesis parameter controlling the magnitude of the stimulatory +effect at low doses.

    + + +

    Defaults to c("b", "c", "d", "e", "f").

    + + +
    fixed
    +

    A numeric vector of length 5 specifying fixed (non-estimated) +parameter values. Use NA for parameters that should be estimated freely. +Defaults to c(NA, NA, NA, NA, NA), meaning all five parameters are +freely estimated.

    + + +
    ...
    +

    Additional arguments passed to cedergreen().

    + +
    +
    +

    Value

    +

    A list of class "drcMean" as returned by cedergreen(), containing +the model definition including the mean function, its gradient, parameter +names, and fixed values. This object is intended for use as the fct +argument in drm().

    +
    +
    +

    See also

    +
    +

    • CRS.5() — the recommended replacement for this deprecated function.

      • +

    • CRS.5a() — the function this alias points to.

      • +

    • cedergreen() — the underlying model constructor.

      • +
    +
    +
    +

    Author

    +

    Christian Ritz, Hannes Reinwald

    +
    + +
    +

    Examples

    + 
    # NOTE: ml4a() is a deprecated alias for CRS.5a(). Use CRS.5() instead.
+# The example below is retained for backward compatibility illustration only.
+
+lettuce.m1 <- drm( lettuce[, c(2, 1)], fct = ml4a() )
+summary(lettuce.m1)
+#> 
+#> Model fitted: Cedergreen-Ritz-Streibig (alpha=1) (5 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept) 1.334173   0.358675  3.7197  0.004773 ** 
+#> c:(Intercept) 0.447962   0.080700  5.5510  0.000356 ***
+#> d:(Intercept) 1.035658   0.077323 13.3940 3.004e-07 ***
+#> e:(Intercept) 1.337869   1.185153  1.1289  0.288148    
+#> f:(Intercept) 1.993259   2.017541  0.9880  0.348985    
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.1305067 (9 degrees of freedom)
+ED(lettuce.m1, c(50))
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error
+#> e:50   5.5439     1.9480
+
+# Recommended replacement:
+lettuce.crs5 <- drm( lettuce[, c(2, 1)], fct = CRS.5(alpha_type = "a") )
+summary(lettuce.crs5)
+#> 
+#> Model fitted: Cedergreen-Ritz-Streibig (alpha=1) (5 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept) 1.334173   0.358675  3.7197  0.004773 ** 
+#> c:(Intercept) 0.447962   0.080700  5.5510  0.000356 ***
+#> d:(Intercept) 1.035658   0.077323 13.3940 3.004e-07 ***
+#> e:(Intercept) 1.337869   1.185153  1.1289  0.288148    
+#> f:(Intercept) 1.993259   2.017541  0.9880  0.348985    
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.1305067 (9 degrees of freedom)
+ED(lettuce.crs5, c(50))
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error
+#> e:50   5.5439     1.9480
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/ml4a.md b/docs/reference/ml4a.md new file mode 100644 index 00000000..7e74a6bd --- /dev/null +++ b/docs/reference/ml4a.md @@ -0,0 +1,142 @@ +# Alias for CRS.5a (Deprecated) + +**\[deprecated\]** + +This function is a deprecated alias for +[`CRS.5a()`](https://hreinwald.github.io/drc/reference/CRS.5a.md), +itself deprecated as of version 3.3.0. Please use +[`CRS.5()`](https://hreinwald.github.io/drc/reference/CRS.5.md) instead, +which provides a more general and flexible interface. + +## Usage + +``` r +ml4a(names = c("b", "c", "d", "e", "f"), fixed = c(NA, NA, NA, NA, NA), ...) +``` + +## Arguments + +- names: + + A character vector of length 5 specifying the names of the model + parameters in the following order: + + `b` + + : Hill slope (steepness of the dose-response curve). + + `c` + + : Lower asymptote (freely estimated). + + `d` + + : Upper asymptote. + + `e` + + : Effective dose producing a response midway between `c` and `d` + (ED50). + + `f` + + : Hormesis parameter controlling the magnitude of the stimulatory + effect at low doses. + + Defaults to `c("b", "c", "d", "e", "f")`. + +- fixed: + + A numeric vector of length 5 specifying fixed (non-estimated) + parameter values. Use `NA` for parameters that should be estimated + freely. Defaults to `c(NA, NA, NA, NA, NA)`, meaning all five + parameters are freely estimated. + +- ...: + + Additional arguments passed to + [`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md). + +## Value + +A list of class `"drcMean"` as returned by +[`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md), +containing the model definition including the mean function, its +gradient, parameter names, and fixed values. This object is intended for +use as the `fct` argument in +[`drm()`](https://hreinwald.github.io/drc/reference/drm.md). + +## See also + +- [`CRS.5()`](https://hreinwald.github.io/drc/reference/CRS.5.md) — the + recommended replacement for this deprecated function. + +- [`CRS.5a()`](https://hreinwald.github.io/drc/reference/CRS.5a.md) — + the function this alias points to. + +- [`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md) + — the underlying model constructor. + +## Author + +Christian Ritz, Hannes Reinwald + +## Examples + +``` r +# NOTE: ml4a() is a deprecated alias for CRS.5a(). Use CRS.5() instead. +# The example below is retained for backward compatibility illustration only. + +lettuce.m1 <- drm( lettuce[, c(2, 1)], fct = ml4a() ) +summary(lettuce.m1) +#> +#> Model fitted: Cedergreen-Ritz-Streibig (alpha=1) (5 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 1.334173 0.358675 3.7197 0.004773 ** +#> c:(Intercept) 0.447962 0.080700 5.5510 0.000356 *** +#> d:(Intercept) 1.035658 0.077323 13.3940 3.004e-07 *** +#> e:(Intercept) 1.337869 1.185153 1.1289 0.288148 +#> f:(Intercept) 1.993259 2.017541 0.9880 0.348985 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.1305067 (9 degrees of freedom) +ED(lettuce.m1, c(50)) +#> +#> Estimated effective doses +#> +#> Estimate Std. Error +#> e:50 5.5439 1.9480 + +# Recommended replacement: +lettuce.crs5 <- drm( lettuce[, c(2, 1)], fct = CRS.5(alpha_type = "a") ) +summary(lettuce.crs5) +#> +#> Model fitted: Cedergreen-Ritz-Streibig (alpha=1) (5 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 1.334173 0.358675 3.7197 0.004773 ** +#> c:(Intercept) 0.447962 0.080700 5.5510 0.000356 *** +#> d:(Intercept) 1.035658 0.077323 13.3940 3.004e-07 *** +#> e:(Intercept) 1.337869 1.185153 1.1289 0.288148 +#> f:(Intercept) 1.993259 2.017541 0.9880 0.348985 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.1305067 (9 degrees of freedom) +ED(lettuce.crs5, c(50)) +#> +#> Estimated effective doses +#> +#> Estimate Std. Error +#> e:50 5.5439 1.9480 +``` diff --git a/docs/reference/ml4b.html b/docs/reference/ml4b.html new file mode 100644 index 00000000..77f28bec --- /dev/null +++ b/docs/reference/ml4b.html @@ -0,0 +1,197 @@ + +Alias for CRS.5b (Deprecated) — ml4b • drc + Skip to contents + + +
    +
    +
    +

    Alias for CRS.5b (Deprecated)

    + Source: R/cedergreen.R +
    ml4b.Rd
    +
    + +
    +

    [Deprecated]

    +

    This function is a deprecated alias for CRS.5b(), itself deprecated as of +version 3.3.0. Please use CRS.5() instead, which provides a more general +and flexible interface.

    +
    + +
    +

    Usage

    + 
    ml4b(names = c("b", "c", "d", "e", "f"), fixed = c(NA, NA, NA, NA, NA), ...)
    +
    + +
    +

    Arguments

    + + +
    names
    +

    A character vector of length 5 specifying the names of the model +parameters in the following order:

    b
    +

    Hill slope (steepness of the dose-response curve).

    + +
    c
    +

    Lower asymptote (freely estimated).

    + +
    d
    +

    Upper asymptote.

    + +
    e
    +

    Effective dose producing a response midway between c and d +(ED50).

    + +
    f
    +

    Hormesis parameter controlling the magnitude of the stimulatory +effect at low doses.

    + + +

    Defaults to c("b", "c", "d", "e", "f").

    + + +
    fixed
    +

    A numeric vector of length 5 specifying fixed (non-estimated) +parameter values. Use NA for parameters that should be estimated freely. +Defaults to c(NA, NA, NA, NA, NA), meaning all five parameters are +freely estimated.

    + + +
    ...
    +

    Additional arguments passed to cedergreen().

    + +
    +
    +

    Value

    +

    A list of class "drcMean" as returned by cedergreen(), containing +the model definition including the mean function, its gradient, parameter +names, and fixed values. This object is intended for use as the fct +argument in drm().

    +
    +
    +

    See also

    +
    +

    • CRS.5() — the recommended replacement for this deprecated function.

      • +

    • CRS.5b() — the function this alias points to.

      • +

    • cedergreen() — the underlying model constructor.

      • +
    +
    +
    +

    Author

    +

    Christian Ritz, Hannes Reinwald

    +
    + +
    +

    Examples

    + 
    # NOTE: ml4b() is a deprecated alias for CRS.5b(). Use CRS.5() instead.
+# The example below is retained for backward compatibility illustration only.
+
+lettuce.m2 <- drm( lettuce[, c(2, 1)], fct = ml4b() )
+summary(lettuce.m2)
+#> 
+#> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.5) (5 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept) 0.806096   0.537800  1.4989    0.1681    
+#> c:(Intercept) 0.316586   0.199024  1.5907    0.1461    
+#> d:(Intercept) 0.971581   0.081936 11.8577 8.523e-07 ***
+#> e:(Intercept) 0.814111   2.969068  0.2742    0.7901    
+#> f:(Intercept) 3.288976   8.216399  0.4003    0.6983    
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.1167711 (9 degrees of freedom)
+ED(lettuce.m2, c(50))
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error
+#> e:50   11.550      8.603
+
+# Recommended replacement:
+lettuce.crs5 <- drm( lettuce[, c(2, 1)], fct = CRS.5(alpha_type = "b") )
+summary(lettuce.crs5)
+#> 
+#> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.5) (5 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept) 0.806096   0.537800  1.4989    0.1681    
+#> c:(Intercept) 0.316586   0.199024  1.5907    0.1461    
+#> d:(Intercept) 0.971581   0.081936 11.8577 8.523e-07 ***
+#> e:(Intercept) 0.814111   2.969068  0.2742    0.7901    
+#> f:(Intercept) 3.288976   8.216399  0.4003    0.6983    
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.1167711 (9 degrees of freedom)
+ED(lettuce.crs5, c(50))
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error
+#> e:50   11.550      8.603
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/ml4b.md b/docs/reference/ml4b.md new file mode 100644 index 00000000..875ba9b0 --- /dev/null +++ b/docs/reference/ml4b.md @@ -0,0 +1,142 @@ +# Alias for CRS.5b (Deprecated) + +**\[deprecated\]** + +This function is a deprecated alias for +[`CRS.5b()`](https://hreinwald.github.io/drc/reference/CRS.5b.md), +itself deprecated as of version 3.3.0. Please use +[`CRS.5()`](https://hreinwald.github.io/drc/reference/CRS.5.md) instead, +which provides a more general and flexible interface. + +## Usage + +``` r +ml4b(names = c("b", "c", "d", "e", "f"), fixed = c(NA, NA, NA, NA, NA), ...) +``` + +## Arguments + +- names: + + A character vector of length 5 specifying the names of the model + parameters in the following order: + + `b` + + : Hill slope (steepness of the dose-response curve). + + `c` + + : Lower asymptote (freely estimated). + + `d` + + : Upper asymptote. + + `e` + + : Effective dose producing a response midway between `c` and `d` + (ED50). + + `f` + + : Hormesis parameter controlling the magnitude of the stimulatory + effect at low doses. + + Defaults to `c("b", "c", "d", "e", "f")`. + +- fixed: + + A numeric vector of length 5 specifying fixed (non-estimated) + parameter values. Use `NA` for parameters that should be estimated + freely. Defaults to `c(NA, NA, NA, NA, NA)`, meaning all five + parameters are freely estimated. + +- ...: + + Additional arguments passed to + [`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md). + +## Value + +A list of class `"drcMean"` as returned by +[`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md), +containing the model definition including the mean function, its +gradient, parameter names, and fixed values. This object is intended for +use as the `fct` argument in +[`drm()`](https://hreinwald.github.io/drc/reference/drm.md). + +## See also + +- [`CRS.5()`](https://hreinwald.github.io/drc/reference/CRS.5.md) — the + recommended replacement for this deprecated function. + +- [`CRS.5b()`](https://hreinwald.github.io/drc/reference/CRS.5b.md) — + the function this alias points to. + +- [`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md) + — the underlying model constructor. + +## Author + +Christian Ritz, Hannes Reinwald + +## Examples + +``` r +# NOTE: ml4b() is a deprecated alias for CRS.5b(). Use CRS.5() instead. +# The example below is retained for backward compatibility illustration only. + +lettuce.m2 <- drm( lettuce[, c(2, 1)], fct = ml4b() ) +summary(lettuce.m2) +#> +#> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.5) (5 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 0.806096 0.537800 1.4989 0.1681 +#> c:(Intercept) 0.316586 0.199024 1.5907 0.1461 +#> d:(Intercept) 0.971581 0.081936 11.8577 8.523e-07 *** +#> e:(Intercept) 0.814111 2.969068 0.2742 0.7901 +#> f:(Intercept) 3.288976 8.216399 0.4003 0.6983 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.1167711 (9 degrees of freedom) +ED(lettuce.m2, c(50)) +#> +#> Estimated effective doses +#> +#> Estimate Std. Error +#> e:50 11.550 8.603 + +# Recommended replacement: +lettuce.crs5 <- drm( lettuce[, c(2, 1)], fct = CRS.5(alpha_type = "b") ) +summary(lettuce.crs5) +#> +#> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.5) (5 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 0.806096 0.537800 1.4989 0.1681 +#> c:(Intercept) 0.316586 0.199024 1.5907 0.1461 +#> d:(Intercept) 0.971581 0.081936 11.8577 8.523e-07 *** +#> e:(Intercept) 0.814111 2.969068 0.2742 0.7901 +#> f:(Intercept) 3.288976 8.216399 0.4003 0.6983 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.1167711 (9 degrees of freedom) +ED(lettuce.crs5, c(50)) +#> +#> Estimated effective doses +#> +#> Estimate Std. Error +#> e:50 11.550 8.603 +``` diff --git a/docs/reference/ml4c.html b/docs/reference/ml4c.html new file mode 100644 index 00000000..7da58f8b --- /dev/null +++ b/docs/reference/ml4c.html @@ -0,0 +1,197 @@ + +Alias for CRS.5c (Deprecated) — ml4c • drc + Skip to contents + + +
    +
    +
    +

    Alias for CRS.5c (Deprecated)

    + Source: R/cedergreen.R +
    ml4c.Rd
    +
    + +
    +

    [Deprecated]

    +

    This function is a deprecated alias for CRS.5c(), itself deprecated as of +version 3.3.0. Please use CRS.5() instead, which provides a more general +and flexible interface.

    +
    + +
    +

    Usage

    + 
    ml4c(names = c("b", "c", "d", "e", "f"), fixed = c(NA, NA, NA, NA, NA), ...)
    +
    + +
    +

    Arguments

    + + +
    names
    +

    A character vector of length 5 specifying the names of the model +parameters in the following order:

    b
    +

    Hill slope (steepness of the dose-response curve).

    + +
    c
    +

    Lower asymptote (freely estimated).

    + +
    d
    +

    Upper asymptote.

    + +
    e
    +

    Effective dose producing a response midway between c and d +(ED50).

    + +
    f
    +

    Hormesis parameter controlling the magnitude of the stimulatory +effect at low doses.

    + + +

    Defaults to c("b", "c", "d", "e", "f").

    + + +
    fixed
    +

    A numeric vector of length 5 specifying fixed (non-estimated) +parameter values. Use NA for parameters that should be estimated freely. +Defaults to c(NA, NA, NA, NA, NA), meaning all five parameters are +freely estimated.

    + + +
    ...
    +

    Additional arguments passed to cedergreen().

    + +
    +
    +

    Value

    +

    A list of class "drcMean" as returned by cedergreen(), containing +the model definition including the mean function, its gradient, parameter +names, and fixed values. This object is intended for use as the fct +argument in drm().

    +
    +
    +

    See also

    +
    +

    • CRS.5() — the recommended replacement for this deprecated function.

      • +

    • CRS.5c() — the function this alias points to.

      • +

    • cedergreen() — the underlying model constructor.

      • +
    +
    +
    +

    Author

    +

    Christian Ritz, Hannes Reinwald

    +
    + +
    +

    Examples

    + 
    # NOTE: ml4c() is a deprecated alias for CRS.5c(). Use CRS.5() instead.
+# The example below is retained for backward compatibility illustration only.
+
+lettuce.m3 <- drm( lettuce[, c(2, 1)], fct = ml4c() )
+summary(lettuce.m3)
+#> 
+#> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.25) (5 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept) 0.981945   0.559334  1.7556   0.11305    
+#> c:(Intercept) 0.336670   0.182883  1.8409   0.09877 .  
+#> d:(Intercept) 0.969845   0.088261 10.9883 1.624e-06 ***
+#> e:(Intercept) 3.883893   2.462313  1.5773   0.14917    
+#> f:(Intercept) 1.027934   0.766823  1.3405   0.21293    
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.1256841 (9 degrees of freedom)
+ED(lettuce.m3, c(50))
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error
+#> e:50  11.4243     8.7214
+
+# Recommended replacement:
+lettuce.crs5 <- drm( lettuce[, c(2, 1)], fct = CRS.5(alpha_type = "c") )
+summary(lettuce.crs5)
+#> 
+#> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.25) (5 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept) 0.981945   0.559334  1.7556   0.11305    
+#> c:(Intercept) 0.336670   0.182883  1.8409   0.09877 .  
+#> d:(Intercept) 0.969845   0.088261 10.9883 1.624e-06 ***
+#> e:(Intercept) 3.883893   2.462313  1.5773   0.14917    
+#> f:(Intercept) 1.027934   0.766823  1.3405   0.21293    
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.1256841 (9 degrees of freedom)
+ED(lettuce.crs5, c(50))
+#> 
+#> Estimated effective doses
+#> 
+#>      Estimate Std. Error
+#> e:50  11.4243     8.7214
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/ml4c.md b/docs/reference/ml4c.md new file mode 100644 index 00000000..f624eabd --- /dev/null +++ b/docs/reference/ml4c.md @@ -0,0 +1,142 @@ +# Alias for CRS.5c (Deprecated) + +**\[deprecated\]** + +This function is a deprecated alias for +[`CRS.5c()`](https://hreinwald.github.io/drc/reference/CRS.5c.md), +itself deprecated as of version 3.3.0. Please use +[`CRS.5()`](https://hreinwald.github.io/drc/reference/CRS.5.md) instead, +which provides a more general and flexible interface. + +## Usage + +``` r +ml4c(names = c("b", "c", "d", "e", "f"), fixed = c(NA, NA, NA, NA, NA), ...) +``` + +## Arguments + +- names: + + A character vector of length 5 specifying the names of the model + parameters in the following order: + + `b` + + : Hill slope (steepness of the dose-response curve). + + `c` + + : Lower asymptote (freely estimated). + + `d` + + : Upper asymptote. + + `e` + + : Effective dose producing a response midway between `c` and `d` + (ED50). + + `f` + + : Hormesis parameter controlling the magnitude of the stimulatory + effect at low doses. + + Defaults to `c("b", "c", "d", "e", "f")`. + +- fixed: + + A numeric vector of length 5 specifying fixed (non-estimated) + parameter values. Use `NA` for parameters that should be estimated + freely. Defaults to `c(NA, NA, NA, NA, NA)`, meaning all five + parameters are freely estimated. + +- ...: + + Additional arguments passed to + [`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md). + +## Value + +A list of class `"drcMean"` as returned by +[`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md), +containing the model definition including the mean function, its +gradient, parameter names, and fixed values. This object is intended for +use as the `fct` argument in +[`drm()`](https://hreinwald.github.io/drc/reference/drm.md). + +## See also + +- [`CRS.5()`](https://hreinwald.github.io/drc/reference/CRS.5.md) — the + recommended replacement for this deprecated function. + +- [`CRS.5c()`](https://hreinwald.github.io/drc/reference/CRS.5c.md) — + the function this alias points to. + +- [`cedergreen()`](https://hreinwald.github.io/drc/reference/cedergreen.md) + — the underlying model constructor. + +## Author + +Christian Ritz, Hannes Reinwald + +## Examples + +``` r +# NOTE: ml4c() is a deprecated alias for CRS.5c(). Use CRS.5() instead. +# The example below is retained for backward compatibility illustration only. + +lettuce.m3 <- drm( lettuce[, c(2, 1)], fct = ml4c() ) +summary(lettuce.m3) +#> +#> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.25) (5 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 0.981945 0.559334 1.7556 0.11305 +#> c:(Intercept) 0.336670 0.182883 1.8409 0.09877 . +#> d:(Intercept) 0.969845 0.088261 10.9883 1.624e-06 *** +#> e:(Intercept) 3.883893 2.462313 1.5773 0.14917 +#> f:(Intercept) 1.027934 0.766823 1.3405 0.21293 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.1256841 (9 degrees of freedom) +ED(lettuce.m3, c(50)) +#> +#> Estimated effective doses +#> +#> Estimate Std. Error +#> e:50 11.4243 8.7214 + +# Recommended replacement: +lettuce.crs5 <- drm( lettuce[, c(2, 1)], fct = CRS.5(alpha_type = "c") ) +summary(lettuce.crs5) +#> +#> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.25) (5 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 0.981945 0.559334 1.7556 0.11305 +#> c:(Intercept) 0.336670 0.182883 1.8409 0.09877 . +#> d:(Intercept) 0.969845 0.088261 10.9883 1.624e-06 *** +#> e:(Intercept) 3.883893 2.462313 1.5773 0.14917 +#> f:(Intercept) 1.027934 0.766823 1.3405 0.21293 +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.1256841 (9 degrees of freedom) +ED(lettuce.crs5, c(50)) +#> +#> Estimated effective doses +#> +#> Estimate Std. Error +#> e:50 11.4243 8.7214 +``` diff --git a/docs/reference/modelFit.html b/docs/reference/modelFit.html index 8e360e08..3f8e43a7 100644 --- a/docs/reference/modelFit.html +++ b/docs/reference/modelFit.html @@ -1,191 +1,126 @@ - - - - - - +Assessing the model fit — modelFit • drc + Skip to contents -Assessing the model fit — modelFit • drc - - - +
    +
    +
    +

    Assessing the model fit

    + Source: R/modelFit.R +
    modelFit.Rd
    +
    - - - - +
    +

    Checking the fit of a dose-response model by means of formal significance tests.

    +
    +
    +

    Usage

    + 
    modelFit(object, test = NULL, method = c("gof", "cum"))
    +
    +
    +

    Arguments

    - - - +
    object
    +

    object of class 'drc'.

    - +
    test
    +

    character string defining the test method to apply.

    - -
    -
    - - - -
    +
    method
    +

    character string specifying the method to be used for assessing the model fit.

    -
    -
    -
    -

    Assessing the model fit

    - - +
    +
    +

    Value

    +

    An object of class 'anova' which will be displayed in much the same way as an +ordinary ANOVA table.

    +
    +
    +

    Details

    +

    Currently two methods are available. For continuous data the classical lack-of-fit test is +applied (Bates and Watts, 1988). The test compares the dose-response model to a more general +ANOVA model using an approximate F-test. For quantal data the crude goodness-of-fit test +based on Pearson's statistic is used.

    +

    None of these tests are very powerful. A significant test result is more alarming than a +non-significant one.

    +
    +
    +

    References

    +

    Bates, D. M. and Watts, D. G. (1988) +Nonlinear Regression Analysis and Its Applications, +New York: Wiley & Sons (pp. 103–104).

    +
    +
    +

    Author

    +

    Christian Ritz

    -
    - -

    Checking the fit of dose-response model by means of formal significance tests or graphical procedures.

    - +
    +

    Examples

    + 
    ## Comparing the four-parameter log-logistic model
+##  to a one-way ANOVA model using an approximate F test
+## in other words applying a lack-of-fit test
+ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4())
+modelFit(ryegrass.m1)
+#> Lack-of-fit test
+#> 
+#>           ModelDf    RSS Df F value p value
+#> ANOVA          17 5.1799                   
+#> DRC model      20 6.0242  3  0.9236  0.4506
+
+
    +
    - 
    modelFit(object, test = NULL, method = c("gof", "cum"))
    - -

    Arguments

    - - - - - - - - - - - - - - -
    object

    object of class 'drc'

    test

    character string defining the test method to apply

    method

    character string specifying the method to be used for assessing the model fit

    - -

    Details

    - -

    Currently two methods are available. For continuous data the clasical lack-of-fit test is applied - (Bates and Watts, 1988). The test compares the dose-response model to a more general ANOVA model - using an approximate F-test. For quantal data the crude goodness-of-fit test based on Pearson's statistic is used.

    -

    None of these tests are very powerful. A significant test result is more alarming than a non-significant one.

    - -

    Value

    - -

    An object of class 'anova' which will be displayed in much the same way as an ordinary ANOVA table.

    - -

    References

    - -

    Bates, D. M. and Watts, D. G. (1988) - Nonlinear Regression Analysis and Its Applications, - New York: Wiley \& Sons (pp. 103--104).

    - - -

    Examples

    - 
    
-## Comparing the four-parameter log-logistic model 
-##  to a one-way ANOVA model using an approximate F test
-## in other words applying a lack-of-fit test
-ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4())
-modelFit(ryegrass.m1)
    #> Lack-of-fit test
-#> 
-#>           ModelDf    RSS Df F value p value
-#> ANOVA          17 5.1799                   
-#> DRC model      20 6.0242  3  0.9236  0.4506
    
-
    -
    - - -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -

    Site built with pkgdown.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -
    +
    + + + - - - + diff --git a/docs/reference/modelFit.md b/docs/reference/modelFit.md new file mode 100644 index 00000000..e9398f7d --- /dev/null +++ b/docs/reference/modelFit.md @@ -0,0 +1,65 @@ +# Assessing the model fit + +Checking the fit of a dose-response model by means of formal +significance tests. + +## Usage + +``` r +modelFit(object, test = NULL, method = c("gof", "cum")) +``` + +## Arguments + +- object: + + object of class 'drc'. + +- test: + + character string defining the test method to apply. + +- method: + + character string specifying the method to be used for assessing the + model fit. + +## Value + +An object of class 'anova' which will be displayed in much the same way +as an ordinary ANOVA table. + +## Details + +Currently two methods are available. For continuous data the classical +lack-of-fit test is applied (Bates and Watts, 1988). The test compares +the dose-response model to a more general ANOVA model using an +approximate F-test. For quantal data the crude goodness-of-fit test +based on Pearson's statistic is used. + +None of these tests are very powerful. A significant test result is more +alarming than a non-significant one. + +## References + +Bates, D. M. and Watts, D. G. (1988) *Nonlinear Regression Analysis and +Its Applications*, New York: Wiley & Sons (pp. 103–104). + +## Author + +Christian Ritz + +## Examples + +``` r +## Comparing the four-parameter log-logistic model +## to a one-way ANOVA model using an approximate F test +## in other words applying a lack-of-fit test +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) +modelFit(ryegrass.m1) +#> Lack-of-fit test +#> +#> ModelDf RSS Df F value p value +#> ANOVA 17 5.1799 +#> DRC model 20 6.0242 3 0.9236 0.4506 +``` diff --git a/docs/reference/modelFunction.html b/docs/reference/modelFunction.html new file mode 100644 index 00000000..0d13ce18 --- /dev/null +++ b/docs/reference/modelFunction.html @@ -0,0 +1,82 @@ + +Create model evaluation function — modelFunction • drc + Skip to contents + + +
    +
    +
    +

    Create model evaluation function

    + Source: R/modelFunction.R +
    modelFunction.Rd
    +
    + +
    +

    Create model evaluation function

    +
    + +
    +

    Usage

    + 
    modelFunction(
+  dose,
+  parm2mat,
+  drcFct,
+  cm,
+  assayNoOld,
+  upperPos,
+  retFct,
+  doseScaling,
+  respScaling,
+  isFinite,
+  pshifts = NULL
+)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/modelFunction.md b/docs/reference/modelFunction.md new file mode 100644 index 00000000..0f87bb2b --- /dev/null +++ b/docs/reference/modelFunction.md @@ -0,0 +1,21 @@ +# Create model evaluation function + +Create model evaluation function + +## Usage + +``` r +modelFunction( + dose, + parm2mat, + drcFct, + cm, + assayNoOld, + upperPos, + retFct, + doseScaling, + respScaling, + isFinite, + pshifts = NULL +) +``` diff --git a/docs/reference/mr.test.html b/docs/reference/mr.test.html index a44bb379..5f105e54 100644 --- a/docs/reference/mr.test.html +++ b/docs/reference/mr.test.html @@ -1,226 +1,157 @@ - - - - - - +Mizon-Richard test for dose-response models — mr.test • drc + Skip to contents -Mizon-Richard test for dose-response models — mr.test • drc - - - +
    +
    +
    +

    Mizon-Richard test for dose-response models

    + Source: R/mr.test.R +
    mr.test.Rd
    +
    - +
    +

    The function provides a lack-of-fit test for the mean structure based on the +Mizon-Richard test as compared to a specific alternative model.

    +
    - - +
    +

    Usage

    + 
    mr.test(object1, object2, object, x, var.equal = TRUE, component = 1)
    +
    +
    +

    Arguments

    - - +
    object1
    +

    object of class 'drc' (null model).

    - +
    object2
    +

    object of class 'drc' (alternative model).

    - - -
    -
    - - - -
    -
    -
    -
    -

    Mizon-Richard test for dose-response models

    - - -
    +
    x
    +

    numeric vector of dose values.

    -
    - -

    The function provides a lack-of-fit test for the mean structure based on the Mizon-Richard test as compared to a - specific alternative model.

    - -
    - 
    mr.test(object1, object2, object, x, var.equal = TRUE, component = 1)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - - - - - - - - - -
    object1

    object of class 'drc' (null model).

    object2

    object of class 'drc' (alternative model).

    object

    object of class 'drc' (fitted model under alternative).

    x

    numeric vector of dose values.

    var.equal

    logical indicating whether or not equal variances can be assumed across doses.

    component

    numeric vector specifying the component(s) in the parameter vector to use in the test.

    - -

    Details

    - -

    The function provides a p-value indicating whether or not the mean structure is appropriate.

    -

    The test is applicable even in cases where data are non-normal or exhibit variance heterogeneity.

    - -

    Value

    - -

    A p-value for test of the null hypothesis that the chosen mean structure is appropriate as compared - to the alternative mean structure provided (see Ritz and Martinussen (2011) for a detailed explanation).

    - -

    References

    - - -

    Ritz, C and Martinussen, T. (2011) - Lack-of-fit tests for assessing mean structures for continuous dose-response data, - Environmental and Ecological Statistics, 18, 349--366

    - -

    Note

    - -

    This functionality is still experimental: Currently, the null and alternative models are hardcoded! - In the future the function will be working for null and alternative models specified by the user.

    - -

    See also

    - -

    See also modelFit for details on the related lack-of-fit test against an ANOVA model.

    - - -

    Examples

    - 
    
-## Fitting log-logistic and Weibull models 
-## The Weibull model is the alternative
-etmotc.m1<-drm(rgr1~dose1, data=etmotc[1:15,], fct=LL.4())
-etmotc.m2 <- update(etmotc.m1, fct=W1.4())
-
-## Fitting the fitted model (using the alternative model)
-etmotc.m3 <- drm(fitted(etmotc.m1)~dose1, data=etmotc[1:15,], fct=W1.4())
-
-## Handling missing values
-xVec <- etmotc[1:15,]$dose1
-xVec[1:8] <- 1e-10  # avoiding 0's
-
-## Obtaining the Mizon-Richard test
-mr.test(etmotc.m1, etmotc.m2, etmotc.m3, xVec, var.equal = FALSE)
    #>   Statistic     p-value  Difference          SE 
-#> -1.65084985  0.09876924 -0.01936982  0.01173324 
    
-
    -
    -
    +
    +

    Value

    +

    A p-value for test of the null hypothesis that the chosen mean structure is +appropriate as compared to the alternative mean structure provided (see Ritz and +Martinussen (2011) for a detailed explanation).

    +
    +
    +

    Details

    +

    The function provides a p-value indicating whether or not the mean structure is appropriate.

    +

    The test is applicable even in cases where data are non-normal or exhibit variance +heterogeneity.

    +
    +
    +

    Note

    +

    This functionality is still experimental: Currently, the null and alternative models +are hardcoded! In the future the function will be working for null and alternative models +specified by the user.

    +
    +
    +

    References

    +

    Ritz, C and Martinussen, T. (2011) Lack-of-fit tests for assessing mean +structures for continuous dose-response data, Environmental and Ecological +Statistics, 18, 349–366

    +
    +
    +

    See also

    +

    See also modelFit for details on the related lack-of-fit test +against an ANOVA model.

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    -
  • See also
    • - -
  • Examples
    • - +
    +

    Examples

    + 
    ## Fitting log-logistic and Weibull models
+## The Weibull model is the alternative
+etmotc.m1<-drm(rgr1~dose1, data=etmotc[1:15,], fct=LL.4())
+etmotc.m2 <- update(etmotc.m1, fct=W1.4())
+
+## Fitting the fitted model (using the alternative model)
+etmotc.m3 <- drm(fitted(etmotc.m1)~dose1, data=etmotc[1:15,], fct=W1.4())
+
+## Handling missing values
+xVec <- etmotc[1:15,]$dose1
+xVec[1:8] <- 1e-10  # avoiding 0's
+
+## Obtaining the Mizon-Richard test
+mr.test(etmotc.m1, etmotc.m2, etmotc.m3, xVec, var.equal = FALSE)
+#>   Statistic     p-value  Difference          SE 
+#> -1.65084985  0.09876924 -0.01936982  0.01173324 
+
+
    +
    +
    -

    Author

    - - Christian Ritz -
    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + -
    - - - - + diff --git a/docs/reference/mr.test.md b/docs/reference/mr.test.md new file mode 100644 index 00000000..5f84a6ae --- /dev/null +++ b/docs/reference/mr.test.md @@ -0,0 +1,95 @@ +# Mizon-Richard test for dose-response models + +The function provides a lack-of-fit test for the mean structure based on +the Mizon-Richard test as compared to a specific alternative model. + +## Usage + +``` r +mr.test(object1, object2, object, x, var.equal = TRUE, component = 1) +``` + +## Arguments + +- object1: + + object of class 'drc' (null model). + +- object2: + + object of class 'drc' (alternative model). + +- object: + + object of class 'drc' (fitted model under alternative). + +- x: + + numeric vector of dose values. + +- var.equal: + + logical indicating whether or not equal variances can be assumed + across doses. + +- component: + + numeric vector specifying the component(s) in the parameter vector to + use in the test. + +## Value + +A p-value for test of the null hypothesis that the chosen mean structure +is appropriate as compared to the alternative mean structure provided +(see Ritz and Martinussen (2011) for a detailed explanation). + +## Details + +The function provides a p-value indicating whether or not the mean +structure is appropriate. + +The test is applicable even in cases where data are non-normal or +exhibit variance heterogeneity. + +## Note + +This functionality is still experimental: Currently, the null and +alternative models are hardcoded! In the future the function will be +working for null and alternative models specified by the user. + +## References + +Ritz, C and Martinussen, T. (2011) Lack-of-fit tests for assessing mean +structures for continuous dose-response data, *Environmental and +Ecological Statistics*, **18**, 349–366 + +## See also + +See also +[`modelFit`](https://hreinwald.github.io/drc/reference/modelFit.md) for +details on the related lack-of-fit test against an ANOVA model. + +## Author + +Christian Ritz + +## Examples + +``` r +## Fitting log-logistic and Weibull models +## The Weibull model is the alternative +etmotc.m1<-drm(rgr1~dose1, data=etmotc[1:15,], fct=LL.4()) +etmotc.m2 <- update(etmotc.m1, fct=W1.4()) + +## Fitting the fitted model (using the alternative model) +etmotc.m3 <- drm(fitted(etmotc.m1)~dose1, data=etmotc[1:15,], fct=W1.4()) + +## Handling missing values +xVec <- etmotc[1:15,]$dose1 +xVec[1:8] <- 1e-10 # avoiding 0's + +## Obtaining the Mizon-Richard test +mr.test(etmotc.m1, etmotc.m2, etmotc.m3, xVec, var.equal = FALSE) +#> Statistic p-value Difference SE +#> -1.65084985 0.09876924 -0.01936982 0.01173324 +``` diff --git a/docs/reference/mselect.html b/docs/reference/mselect.html index aa0e35d6..f02634a8 100644 --- a/docs/reference/mselect.html +++ b/docs/reference/mselect.html @@ -1,235 +1,171 @@ - - - - - - +Dose-response model selection — mselect • drc + Skip to contents -Dose-response model selection — mselect • drc - - - +
    +
    +
    +

    Dose-response model selection

    + Source: R/mselect.R +
    mselect.Rd
    +
    - +
    +

    Model selection by comparison of different models using the following criteria: the log +likelihood value, Akaike's information criterion (AIC), the estimated residual standard +error or the p-value from a lack-of-fit test.

    +
    - - +
    +

    Usage

    + 
    mselect(
+  object,
+  fctList = NULL,
+  nested = FALSE,
+  sorted = c("IC", "Res var", "Lack of fit", "no"),
+  linreg = FALSE,
+  icfct = AIC
+)
    +
    +
    +

    Arguments

    - - +
    object
    +

    an object of class 'drc'.

    - +
    fctList
    +

    a list of dose-response functions to be compared.

    - - -
    -
    - - - -
    -
    -
    -
    -

    Dose-response model selection

    - - +
    sorted
    +

    character string determining according to which criterion the model fits +are ranked.

    + + +
    linreg
    +

    logical indicating whether or not additionally polynomial regression models +(linear, quadratic, and cubic models) should be fitted.

    + + +
    icfct
    +

    function for supplying the information criterion to be used. +AIC and BIC are two options.

    + +
    +
    +

    Value

    +

    A matrix with one row for each model and one column for each criterion.

    +
    +
    +

    Details

    +

    For Akaike's information criterion and the residual standard error: the smaller the better +and for lack-of-fit test (against a one-way ANOVA model): the larger (the p-value) the +better. Note that the residual standard error is only available for continuous dose-response +data.

    +

    Log likelihood values cannot be used for comparison unless the models are nested.

    +
    +
    +

    Author

    +

    Christian Ritz

    -
    - -

    Model selection by comparison of different models using the following criteria: the log likelihood value, - Akaike's information criterion (AIC), the estimated residual standard error - or the p-value from a lack-of-fit test.

    - +
    +

    Examples

    + 
    ### Example with continuous/quantitative data
+## Fitting initial four-parameter log-logistic model
+ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4())
+
+## Model selection
+mselect(ryegrass.m1, list(LL.3(), LL.5(), W1.3(), W1.4(), W2.4(), baro5()))
+#>          logLik       IC Lack of fit   Res var
+#> W2.4  -15.91352 41.82703  0.94507131 0.2646283
+#> LL.4  -16.15514 42.31029  0.86648304 0.2700107
+#> baro5 -15.86422 43.72844  0.86239408 0.2774141
+#> LL.5  -15.87828 43.75656  0.85384758 0.2777393
+#> W1.4  -17.46720 44.93439  0.45056762 0.3012075
+#> LL.3  -18.60413 45.20827  0.35316787 0.3153724
+#> W1.3  -22.22047 52.44094  0.04379149 0.4262881
+
+## Model selection including linear, quadratic, and cubic regression models
+mselect(ryegrass.m1, list(LL.3(), LL.5(), W1.3(), W1.4(), W2.4(), baro5()), linreg = TRUE)
+#>          logLik        IC Lack of fit   Res var
+#> W2.4  -15.91352  41.82703  0.94507131 0.2646283
+#> LL.4  -16.15514  42.31029  0.86648304 0.2700107
+#> baro5 -15.86422  43.72844  0.86239408 0.2774141
+#> LL.5  -15.87828  43.75656  0.85384758 0.2777393
+#> W1.4  -17.46720  44.93439  0.45056762 0.3012075
+#> LL.3  -18.60413  45.20827  0.35316787 0.3153724
+#> W1.3  -22.22047  52.44094  0.04379149 0.4262881
+#> Cubic -25.53428  61.06856          NA 0.5899609
+#> Quad  -35.11558  78.23116          NA 1.2485122
+#> Lin   -50.47554 106.95109          NA 4.2863247
+
+## Comparing nested models
+mselect(ryegrass.m1, list(LL.5()), nested = TRUE)
+#>         logLik       IC Lack of fit   Res var Nested F test
+#> LL.4 -16.15514 42.31029   0.8664830 0.2700107            NA
+#> LL.5 -15.87828 43.75656   0.8538476 0.2777393     0.5134602
+
+
    +
    - 
    mselect(object, fctList = NULL, nested = FALSE,
-  sorted = c("IC", "Res var", "Lack of fit", "no"), linreg = FALSE, icfct = AIC)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - - - - - - - - - -
    object

    an object of class 'drc'.

    fctList

    a list of dose-response functions to be compared.

    nested

    logical. TRUE results in F tests between adjacent models (in 'fctList'). - Only sensible for nested models.

    sorted

    character string determining according to which criterion the model fits are ranked.

    linreg

    logical indicating whether or not additionally polynomial regression models (linear, quadratic, and cubic models) - should be fitted (they could be useful for a kind of informal lack-of-test consideration for the models specified, - capturing unexpected departures).

    icfct

    function for supplying the information criterion to be used. AIC and BIC are two options.

    - -

    Details

    - -

    For Akaike's information criterion and the residual standard error: the smaller the better and - for lack-of-fit test (against a one-way ANOVA model): the larger (the p-value) the better. Note that the residual standard error is only available for - continuous dose-response data.

    -

    Log likelihood values cannot be used for comparison unless the models are nested.

    - -

    Value

    -

    A matrix with one row for each model and one column for each criterion.

    - - -

    Examples

    - 
    
-### Example with continuous/quantitative data
-## Fitting initial four-parameter log-logistic model
-ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4())
-
-## Model selection
-mselect(ryegrass.m1, list(LL.3(), LL.5(), W1.3(), W1.4(), W2.4(), baro5()))
    #>          logLik       IC Lack of fit   Res var
-#> W2.4  -15.91352 41.82703           0 0.2646283
-#> LL.4  -16.15514 42.31029           0 0.2700107
-#> baro5 -15.86422 43.72844           0 0.2774141
-#> LL.5  -15.87828 43.75656           0 0.2777393
-#> W1.4  -17.46720 44.93439           0 0.3012075
-#> LL.3  -18.60413 45.20827           0 0.3153724
-#> W1.3  -22.22047 52.44094           0 0.4262881
    
-## Model selection including linear, quadratic, and cubic regression models
-mselect(ryegrass.m1, list(LL.3(), LL.5(), W1.3(), W1.4(), W2.4(), baro5()), linreg = TRUE)
    #>          logLik        IC Lack of fit   Res var
-#> W2.4  -15.91352  41.82703           0 0.2646283
-#> LL.4  -16.15514  42.31029           0 0.2700107
-#> baro5 -15.86422  43.72844           0 0.2774141
-#> LL.5  -15.87828  43.75656           0 0.2777393
-#> W1.4  -17.46720  44.93439           0 0.3012075
-#> LL.3  -18.60413  45.20827           0 0.3153724
-#> W1.3  -22.22047  52.44094           0 0.4262881
-#> Cubic -25.53428  61.06856          NA 0.5899609
-#> Quad  -35.11558  78.23116          NA 1.2485122
-#> Lin   -50.47554 106.95109          NA 4.2863247
    
-## Comparing nested models
-mselect(ryegrass.m1, list(LL.5()), nested = TRUE)
    #>         logLik       IC Lack of fit   Res var Nested F test
-#> LL.4 -16.15514 42.31029   0.8664830 0.2700107            NA
-#> LL.5 -15.87828 43.75656   0.8538476 0.2777393     0.5134602
    
-### Example with quantal data
-## Fitting initial two-parameter log-logistic model
-earthworms.m1 <- drm(number/total~dose, weights=total,
-data = earthworms, fct = LL.2(), type = "binomial")
-
-## Comparing 4 models
-mselect(earthworms.m1, list(W1.2(), W2.2(), LL.3()))
    #>          logLik        IC Lack of fit
-#> LL.3  -36.15518  78.31036           0
-#> LL.2 -347.55013 699.10026           0
-#> W2.2 -347.63989 699.27978           0
-#> W1.2 -348.82481 701.64963           0
    
-
-
    -
    - +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + -
    - - - - + diff --git a/docs/reference/mselect.md b/docs/reference/mselect.md new file mode 100644 index 00000000..c1d7cf86 --- /dev/null +++ b/docs/reference/mselect.md @@ -0,0 +1,107 @@ +# Dose-response model selection + +Model selection by comparison of different models using the following +criteria: the log likelihood value, Akaike's information criterion +(AIC), the estimated residual standard error or the p-value from a +lack-of-fit test. + +## Usage + +``` r +mselect( + object, + fctList = NULL, + nested = FALSE, + sorted = c("IC", "Res var", "Lack of fit", "no"), + linreg = FALSE, + icfct = AIC +) +``` + +## Arguments + +- object: + + an object of class 'drc'. + +- fctList: + + a list of dose-response functions to be compared. + +- nested: + + logical. TRUE results in F tests between adjacent models (in + `fctList`). Only sensible for nested models. + +- sorted: + + character string determining according to which criterion the model + fits are ranked. + +- linreg: + + logical indicating whether or not additionally polynomial regression + models (linear, quadratic, and cubic models) should be fitted. + +- icfct: + + function for supplying the information criterion to be used. + [`AIC`](https://rdrr.io/r/stats/AIC.html) and + [`BIC`](https://rdrr.io/r/stats/AIC.html) are two options. + +## Value + +A matrix with one row for each model and one column for each criterion. + +## Details + +For Akaike's information criterion and the residual standard error: the +smaller the better and for lack-of-fit test (against a one-way ANOVA +model): the larger (the p-value) the better. Note that the residual +standard error is only available for continuous dose-response data. + +Log likelihood values cannot be used for comparison unless the models +are nested. + +## Author + +Christian Ritz + +## Examples + +``` r +### Example with continuous/quantitative data +## Fitting initial four-parameter log-logistic model +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + +## Model selection +mselect(ryegrass.m1, list(LL.3(), LL.5(), W1.3(), W1.4(), W2.4(), baro5())) +#> logLik IC Lack of fit Res var +#> W2.4 -15.91352 41.82703 0.94507131 0.2646283 +#> LL.4 -16.15514 42.31029 0.86648304 0.2700107 +#> baro5 -15.86422 43.72844 0.86239408 0.2774141 +#> LL.5 -15.87828 43.75656 0.85384758 0.2777393 +#> W1.4 -17.46720 44.93439 0.45056762 0.3012075 +#> LL.3 -18.60413 45.20827 0.35316787 0.3153724 +#> W1.3 -22.22047 52.44094 0.04379149 0.4262881 + +## Model selection including linear, quadratic, and cubic regression models +mselect(ryegrass.m1, list(LL.3(), LL.5(), W1.3(), W1.4(), W2.4(), baro5()), linreg = TRUE) +#> logLik IC Lack of fit Res var +#> W2.4 -15.91352 41.82703 0.94507131 0.2646283 +#> LL.4 -16.15514 42.31029 0.86648304 0.2700107 +#> baro5 -15.86422 43.72844 0.86239408 0.2774141 +#> LL.5 -15.87828 43.75656 0.85384758 0.2777393 +#> W1.4 -17.46720 44.93439 0.45056762 0.3012075 +#> LL.3 -18.60413 45.20827 0.35316787 0.3153724 +#> W1.3 -22.22047 52.44094 0.04379149 0.4262881 +#> Cubic -25.53428 61.06856 NA 0.5899609 +#> Quad -35.11558 78.23116 NA 1.2485122 +#> Lin -50.47554 106.95109 NA 4.2863247 + +## Comparing nested models +mselect(ryegrass.m1, list(LL.5()), nested = TRUE) +#> logLik IC Lack of fit Res var Nested F test +#> LL.4 -16.15514 42.31029 0.8664830 0.2700107 NA +#> LL.5 -15.87828 43.75656 0.8538476 0.2777393 0.5134602 +``` diff --git a/docs/reference/multi2.html b/docs/reference/multi2.html index 21a862d4..6bfed017 100644 --- a/docs/reference/multi2.html +++ b/docs/reference/multi2.html @@ -1,196 +1,127 @@ - - - - - - +Multistage Dose-Response Model with Quadratic Terms — multi2 • drc + Skip to contents -Multistage dose-response model with quadratic terms — multi2 • drc - - - +
    +
    +
    +

    Multistage Dose-Response Model with Quadratic Terms

    + Source: R/multi2.R +
    multi2.Rd
    +
    - - - - +
    +

    A five-parameter multistage dose-response model useful for describing more complex +dose-response patterns.

    +
    +
    +

    Usage

    + 
    multi2(
+  fixed = c(NA, NA, NA, NA, NA),
+  names = c("b1", "b2", "b3", "c", "d"),
+  ssfct = NULL,
+  fctName,
+  fctText
+)
    +
    +
    +

    Arguments

    - - - +
    fixed
    +

    numeric vector specifying which parameters are fixed and at what value +they are fixed. NAs are used for parameters that are not fixed.

    - +
    names
    +

    a vector of character strings giving the names of the parameters +(should not contain ":"). The default is reasonable.

    - -
    -
    - - - -
    +
    ssfct
    +

    a self starter function to be used.

    -
    -
    -
    -

    Multistage dose-response model with quadratic terms

    - - -
    -
    - -

    The multistage dose-response model is a combination of log-logistic models that should be useful for describing - more complex dose-response patterns.

    - -
    +
    fctName
    +

    optional character string used internally by convenience functions.

    - 
    multi2(
-  fixed = c(NA, NA, NA, NA, NA),
-  names = c("b1", "b2", "b3", "c", "d"),
-  ssfct = NULL,
-  fctName,
-  fctText)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - - - - - -
    fixed

    numeric vector specifying which parameters are fixed and at what value they are fixed. - NAs are used for parameters that are not fixed.

    names

    a vector of character strings giving the names of the parameters (should not contain ":"). - The default is reasonable (see under 'Usage').

    ssfct

    a self starter function to be used.

    fctName

    optional character string used internally by convenience functions.

    fctText

    optional character string used internally by convenience functions.

    - -

    Details

    - -

    The multistage model function with quadratic terms is defined as follows

    -

    $$ f(x) = c + (d-c)\exp(-b1-b2x-b3x^2)$$

    -

    where x denotes the dose or the logarithm-transformed dose.

    - -

    Value

    -

    The value returned is a list containing the nonlinear function, the self starter function - and the parameter names.

    - -

    References

    +
    fctText
    +

    optional character string used internally by convenience functions.

    +
    +
    +

    Value

    +

    A list containing the nonlinear function, the self starter function, +and the parameter names.

    +
    +
    +

    Details

    +

    The multistage model function with quadratic terms is:

    +

    $$f(x) = c + (d-c)\exp(-b1 - b2 x - b3 x^2)$$

    +

    where x denotes the dose or the logarithm-transformed dose.

    +
    +
    +

    References

    Wheeler, M. W., Bailer, A. J. (2009) - Comparing model averaging with other model selection strategies for benchmark dose estimation, - Environmental and Ecological Statistics, 16, 37--51.

    - - -
    - +
    +

    Author

    +

    Christian Ritz

    +
    -
  • References
    • - +
    -

    Author

    - - Christian Ritz -
    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + -
    - - - - + diff --git a/docs/reference/multi2.md b/docs/reference/multi2.md new file mode 100644 index 00000000..3b646eac --- /dev/null +++ b/docs/reference/multi2.md @@ -0,0 +1,63 @@ +# Multistage Dose-Response Model with Quadratic Terms + +A five-parameter multistage dose-response model useful for describing +more complex dose-response patterns. + +## Usage + +``` r +multi2( + fixed = c(NA, NA, NA, NA, NA), + names = c("b1", "b2", "b3", "c", "d"), + ssfct = NULL, + fctName, + fctText +) +``` + +## Arguments + +- fixed: + + numeric vector specifying which parameters are fixed and at what value + they are fixed. NAs are used for parameters that are not fixed. + +- names: + + a vector of character strings giving the names of the parameters + (should not contain ":"). The default is reasonable. + +- ssfct: + + a self starter function to be used. + +- fctName: + + optional character string used internally by convenience functions. + +- fctText: + + optional character string used internally by convenience functions. + +## Value + +A list containing the nonlinear function, the self starter function, and +the parameter names. + +## Details + +The multistage model function with quadratic terms is: + +\$\$f(x) = c + (d-c)\exp(-b1 - b2 x - b3 x^2)\$\$ + +where x denotes the dose or the logarithm-transformed dose. + +## References + +Wheeler, M. W., Bailer, A. J. (2009) Comparing model averaging with +other model selection strategies for benchmark dose estimation, +*Environmental and Ecological Statistics*, **16**, 37–51. + +## Author + +Christian Ritz diff --git a/docs/reference/nasturtium-1.png b/docs/reference/nasturtium-1.png new file mode 100644 index 00000000..2edc7dfd Binary files /dev/null and b/docs/reference/nasturtium-1.png differ diff --git a/docs/reference/nasturtium.html b/docs/reference/nasturtium.html new file mode 100644 index 00000000..5c156f84 --- /dev/null +++ b/docs/reference/nasturtium.html @@ -0,0 +1,115 @@ + +Dose-response profile of degradation of agrochemical using nasturtium — nasturtium • drc + Skip to contents + + +
    +
    +
    +

    Dose-response profile of degradation of agrochemical using nasturtium

    + +
    nasturtium.Rd
    +
    + +
    +

    Estimation of the degradation profile of an agrochemical based on soil samples at depth 0-10cm + from a calibration experiment.

    +
    + +
    +

    Usage

    + 
    data(nasturtium)
    +
    + +
    +

    Format

    +

    A data frame with 42 observations on the following 2 variables.

    conc
    +

    a numeric vector of concentrations (g/ha)

    + +
    wt
    +

    a numeric vector of plant weight (mg) after 3 weeks' growth

    + +
    rep
    +

    a numeric vector of replicates

    + + +
    +
    +

    Details

    +

    It is an experiment with seven concentrations and six replicates per concentration. Nasturtium + is sensitive and its weight reduces noticeable at low concentrations.

    +

    Racine-Poon (1988) suggests using a three-parameter log-logistic model.

    +
    +
    +

    Source

    +

    Racine-Poon, A. (1988) A Bayesian Approach to Nonlinear Calibration Problems, + J. Am. Statist. Ass., 83, 650–656.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+nasturtium.m1 <- drm(wt~conc, data=nasturtium, fct = LL.3())
+
+modelFit(nasturtium.m1)
+#> Lack-of-fit test
+#> 
+#>           ModelDf    RSS Df F value p value
+#> ANOVA          35 104464                   
+#> DRC model      39 120387  4  1.3337  0.2768
+
+plot(nasturtium.m1, type = "all", log = "", xlab = "Concentration (g/ha)", ylab = "Weight (mg)")
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/nasturtium.md b/docs/reference/nasturtium.md new file mode 100644 index 00000000..044faf05 --- /dev/null +++ b/docs/reference/nasturtium.md @@ -0,0 +1,56 @@ +# Dose-response profile of degradation of agrochemical using nasturtium + +Estimation of the degradation profile of an agrochemical based on soil +samples at depth 0-10cm from a calibration experiment. + +## Usage + +``` r +data(nasturtium) +``` + +## Format + +A data frame with 42 observations on the following 2 variables. + +- `conc`: + + a numeric vector of concentrations (g/ha) + +- `wt`: + + a numeric vector of plant weight (mg) after 3 weeks' growth + +- `rep`: + + a numeric vector of replicates + +## Details + +It is an experiment with seven concentrations and six replicates per +concentration. *Nasturtium* is sensitive and its weight reduces +noticeable at low concentrations. + +Racine-Poon (1988) suggests using a three-parameter log-logistic model. + +## Source + +Racine-Poon, A. (1988) A Bayesian Approach to Nonlinear Calibration +Problems, *J. Am. Statist. Ass.*, **83**, 650–656. + +## Examples + +``` r +library(drc) + +nasturtium.m1 <- drm(wt~conc, data=nasturtium, fct = LL.3()) + +modelFit(nasturtium.m1) +#> Lack-of-fit test +#> +#> ModelDf RSS Df F value p value +#> ANOVA 35 104464 +#> DRC model 39 120387 4 1.3337 0.2768 + +plot(nasturtium.m1, type = "all", log = "", xlab = "Concentration (g/ha)", ylab = "Weight (mg)") +``` diff --git a/docs/reference/neill.test.html b/docs/reference/neill.test.html index a8d4bc31..a44f3d9d 100644 --- a/docs/reference/neill.test.html +++ b/docs/reference/neill.test.html @@ -1,248 +1,201 @@ - - - - - - +Neill's lack-of-fit test for dose-response models — neill.test • drc + Skip to contents -Neill's lack-of-fit test for dose-response models — neill.test • drc - - - +
    +
    +
    +

    Neill's lack-of-fit test for dose-response models

    + Source: R/neill.test.R +
    neill.test.Rd
    +
    - +
    +

    neill.test provides a lack-of-fit test for non-linear regression models. It is +applicable both in cases where there are replicates (in which case it reduces to the +standard lack-of-fit test against an ANOVA model) and in cases where there are no +replicates, though then a grouping has to be provided.

    +
    - - +
    +

    Usage

    + 
    neill.test(
+  object,
+  grouping,
+  method = c("c-finest", "finest", "percentiles"),
+  breakp = NULL,
+  display = TRUE
+)
    +
    +
    +

    Arguments

    - - +
    object
    +

    object of class 'drc' or 'nls'.

    - +
    grouping
    +

    character or numeric vector that provides the grouping of the dose values.

    - - -
    -
    - - - -
    -
    -
    -
    -

    Neill's lack-of-fit test for dose-response models

    - - -
    +
    breakp
    +

    numeric vector of break points for generating dose intervals that form a grouping.

    -
    - -

    'neill.test' provides a lack-of-fit test for non-linear regression models. It is applicable both in cases - where there are replicates (in which case it reduces to the standard lack-of-fit test against an ANOVA - model) and in cases where there are no replicates, though then a grouping has to be provided.

    - -
    - - 
    neill.test(object, grouping, method = c("c-finest", "finest", "percentiles"),
-  breakp = NULL, display = TRUE)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - - - - - -
    object

    object of class 'drc' or 'nls'.

    grouping

    character or numeric vector that provides the grouping of the dose values.

    method

    character string specifying the method to be used to generate a grouping of the dose values.

    breakp

    numeric vector of break points for generating dose intervals that form a grouping.

    display

    logical. If TRUE results are displayed. Otherwise they are not (useful in simulations).

    - -

    Details

    - -

    The functions used the methods df.residual and residuals and the 'data' - component of object (only for determining the number of observations).

    - -

    Value

    - -

    The function returns an object of class anova which is displayed using print.anova.

    - -

    References

    - -

    Neill, J. W. (1988) Testing for lack of fit in nonlinear regression, - Ann. Statist., 16, 733--740

    - -

    Note

    - -

    A clustering technique could be employed to determine the grouping to be used in cases where there are - no replicates. There should at most be ceiling(n/2) clusters as otherwise some observations will not be used - in the test. At the other end there need to be more clusters than parameters in the model.

    - -

    See also

    - -

    See also modelFit for details on the lack-of-fit test against an ANOVA model.

    - - -

    Examples

    - 
    
-### Example with 'drc' object
-
-## Lack-of-fit test against ANOVA
-ryegrass.m1 <-drm(rootl~conc, data = ryegrass, fct = LL.4())
-modelFit(ryegrass.m1)
    #> Lack-of-fit test
-#> 
-#>           ModelDf    RSS Df F value p value
-#> ANOVA          17 5.1799                   
-#> DRC model      20 5.4002  3  0.2411  0.8665
    
-## The same test using 'neill.test'
-neill.test(ryegrass.m1, ryegrass$conc)
    #> Grouping used
-#> 
-#>    0 0.94 1.88 3.75  7.5   15   30 
-#>    6    3    3    3    3    3    3 
-#> 
    #> Neill's lack-of-fit test
-#> 
-#>  F value p value
-#>   0.2411  0.8665
    
-## Generating a grouping
-neill.test(ryegrass.m1, method="c-finest")
    #> Grouping used
-#> 
-#> 1 2 3 4 5 6 7 
-#> 6 3 3 3 3 3 3 
-#> 
    #> Neill's lack-of-fit test
-#> 
-#>  F value p value
-#>   0.2411  0.8665
    neill.test(ryegrass.m1, method="finest")
    #> Grouping used
-#> 
-#>  1  2  3  4  5  6  7  8  9 10 11 12 
-#>  2  2  2  2  2  2  2  2  2  2  2  2 
-#> 
    #> Neill's lack-of-fit test
-#> 
-#>  F value p value
-#>   1.0625  0.4462
    neill.test(ryegrass.m1, method="perc")
    #> Grouping used
-#> 
-#>    (-Inf,0]    (0,1.88] (1.88,3.75]   (3.75,15]   (15, Inf] 
-#>           6           6           3           6           3 
-#> 
    #> Neill's lack-of-fit test
-#> 
-#>  F value p value
-#>   0.7545  0.3959
    
-
-
    -
    -
    +
    +

    Value

    +

    The function returns an object of class anova which is displayed using +print.anova.

    +
    +
    +

    Details

    +

    The functions use the methods df.residual and residuals and +the data component of object (only for determining the number of observations).

    +
    +
    +

    Note

    +

    A clustering technique could be employed to determine the grouping to be used in cases +where there are no replicates. There should at most be ceiling(n/2) clusters as otherwise +some observations will not be used in the test. At the other end there need to be more +clusters than parameters in the model.

    +
    +
    +

    References

    +

    Neill, J. W. (1988) Testing for lack of fit in nonlinear regression, +Ann. Statist., 16, 733–740

    +
    +
    +

    See also

    +

    See also modelFit for details on the lack-of-fit test against an +ANOVA model.

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    -
  • Note
    • +
    +

    Examples

    + 
    ### Example with 'drc' object
+
+## Lack-of-fit test against ANOVA
+ryegrass.m1 <-drm(rootl~conc, data = ryegrass, fct = LL.4())
+modelFit(ryegrass.m1)
+#> Lack-of-fit test
+#> 
+#>           ModelDf    RSS Df F value p value
+#> ANOVA          17 5.1799                   
+#> DRC model      20 5.4002  3  0.2411  0.8665
+
+## The same test using 'neill.test'
+neill.test(ryegrass.m1, ryegrass$conc)
+#> Grouping used
+#> 
+#>    0 0.94 1.88 3.75  7.5   15   30 
+#>    6    3    3    3    3    3    3 
+#> 
+#> Neill's lack-of-fit test
+#> 
+#>  F value p value
+#>   0.2411  0.8665
+
+## Generating a grouping
+neill.test(ryegrass.m1, method="c-finest")
+#> Grouping used
+#> 
+#> 1 2 3 4 5 6 7 
+#> 6 3 3 3 3 3 3 
+#> 
+#> Neill's lack-of-fit test
+#> 
+#>  F value p value
+#>   0.2411  0.8665
+neill.test(ryegrass.m1, method="finest")
+#> Grouping used
+#> 
+#>  1  2  3  4  5  6  7  8  9 10 11 12 
+#>  2  2  2  2  2  2  2  2  2  2  2  2 
+#> 
+#> Neill's lack-of-fit test
+#> 
+#>  F value p value
+#>   1.0625  0.4462
+neill.test(ryegrass.m1, method="perc")
+#> Grouping used
+#> 
+#>    (-Inf,0]    (0,1.88] (1.88,3.75]   (3.75,15]   (15, Inf] 
+#>           6           6           3           6           3 
+#> 
+#> Neill's lack-of-fit test
+#> 
+#>  F value p value
+#>   0.7545  0.3959
+
+
    +
    +
    -
  • See also
    • - -
  • Examples
    • - -

    Author

    - Christian Ritz -
    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + -
    - - - - + diff --git a/docs/reference/neill.test.md b/docs/reference/neill.test.md new file mode 100644 index 00000000..4515039f --- /dev/null +++ b/docs/reference/neill.test.md @@ -0,0 +1,139 @@ +# Neill's lack-of-fit test for dose-response models + +`neill.test` provides a lack-of-fit test for non-linear regression +models. It is applicable both in cases where there are replicates (in +which case it reduces to the standard lack-of-fit test against an ANOVA +model) and in cases where there are no replicates, though then a +grouping has to be provided. + +## Usage + +``` r +neill.test( + object, + grouping, + method = c("c-finest", "finest", "percentiles"), + breakp = NULL, + display = TRUE +) +``` + +## Arguments + +- object: + + object of class 'drc' or 'nls'. + +- grouping: + + character or numeric vector that provides the grouping of the dose + values. + +- method: + + character string specifying the method to be used to generate a + grouping of the dose values. + +- breakp: + + numeric vector of break points for generating dose intervals that form + a grouping. + +- display: + + logical. If TRUE results are displayed. Otherwise they are not (useful + in simulations). + +## Value + +The function returns an object of class anova which is displayed using +`print.anova`. + +## Details + +The functions use the methods +[`df.residual`](https://rdrr.io/r/stats/df.residual.html) and +[`residuals`](https://rdrr.io/r/stats/residuals.html) and the `data` +component of `object` (only for determining the number of observations). + +## Note + +A clustering technique could be employed to determine the grouping to be +used in cases where there are no replicates. There should at most be +ceiling(n/2) clusters as otherwise some observations will not be used in +the test. At the other end there need to be more clusters than +parameters in the model. + +## References + +Neill, J. W. (1988) Testing for lack of fit in nonlinear regression, +*Ann. Statist.*, **16**, 733–740 + +## See also + +See also +[`modelFit`](https://hreinwald.github.io/drc/reference/modelFit.md) for +details on the lack-of-fit test against an ANOVA model. + +## Author + +Christian Ritz + +## Examples + +``` r +### Example with 'drc' object + +## Lack-of-fit test against ANOVA +ryegrass.m1 <-drm(rootl~conc, data = ryegrass, fct = LL.4()) +modelFit(ryegrass.m1) +#> Lack-of-fit test +#> +#> ModelDf RSS Df F value p value +#> ANOVA 17 5.1799 +#> DRC model 20 5.4002 3 0.2411 0.8665 + +## The same test using 'neill.test' +neill.test(ryegrass.m1, ryegrass$conc) +#> Grouping used +#> +#> 0 0.94 1.88 3.75 7.5 15 30 +#> 6 3 3 3 3 3 3 +#> +#> Neill's lack-of-fit test +#> +#> F value p value +#> 0.2411 0.8665 + +## Generating a grouping +neill.test(ryegrass.m1, method="c-finest") +#> Grouping used +#> +#> 1 2 3 4 5 6 7 +#> 6 3 3 3 3 3 3 +#> +#> Neill's lack-of-fit test +#> +#> F value p value +#> 0.2411 0.8665 +neill.test(ryegrass.m1, method="finest") +#> Grouping used +#> +#> 1 2 3 4 5 6 7 8 9 10 11 12 +#> 2 2 2 2 2 2 2 2 2 2 2 2 +#> +#> Neill's lack-of-fit test +#> +#> F value p value +#> 1.0625 0.4462 +neill.test(ryegrass.m1, method="perc") +#> Grouping used +#> +#> (-Inf,0] (0,1.88] (1.88,3.75] (3.75,15] (15, Inf] +#> 6 6 3 6 3 +#> +#> Neill's lack-of-fit test +#> +#> F value p value +#> 0.7545 0.3959 +``` diff --git a/docs/reference/nfa-1.png b/docs/reference/nfa-1.png new file mode 100644 index 00000000..dfc0f10b Binary files /dev/null and b/docs/reference/nfa-1.png differ diff --git a/docs/reference/nfa.html b/docs/reference/nfa.html new file mode 100644 index 00000000..2d2ea1b4 --- /dev/null +++ b/docs/reference/nfa.html @@ -0,0 +1,126 @@ + +Network Formation Assay Data — nfa • drc + Skip to contents + + +
    +
    +
    +

    Network Formation Assay Data

    + +
    nfa.Rd
    +
    + +
    +

    Neurotoxicity test using a network formation assay studying + the inhibition of network formation at acrylamide exposure.

    +
    + +
    +

    Usage

    + 
    data(nfa)
    +
    + +
    +

    Format

    +

    A data frame with 45 observations on the following 4 variables.

    chip
    +

    chip ID

    + +
    conc
    +

    7 concentrations of acrylamide, ranging from + 0-5mM

    + +
    experiment
    +

    factor with levels 1 or 2 denoting two + consecutive experiments

    + +
    response
    +

    Number of connections [%]

    + + +
    +
    +

    References

    +

    Frimat, JP, Sisnaiske, J, Subbiah, S, Menne, H, Godoy, P, Lampen, P, + Leist, M, Franzke, J, Hengstler, JG, van Thriel, C, West, J. The + network formation assay: a spatially standardized neurite outgrowth + analytical display for neurotoxicity screening. Lab Chip 2010; 10:701-709.

    +
    + +
    +

    Examples

    + 
    data(nfa)
+
+## Fit a four-parameter log-logistic model
+nfa.m1 <- drm(response ~ conc, data = nfa, fct = LL.4())
+summary(nfa.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                Estimate Std. Error t-value   p-value    
+#> b:(Intercept)  1.828165   0.429684  4.2547 0.0001184 ***
+#> c:(Intercept) -3.879086   5.620773 -0.6901 0.4939982    
+#> d:(Intercept) 88.533870   2.366218 37.4158 < 2.2e-16 ***
+#> e:(Intercept)  0.730916   0.086889  8.4121 1.813e-10 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  9.591243 (41 degrees of freedom)
+plot(nfa.m1, main = "NFA dose-response")
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/nfa.md b/docs/reference/nfa.md new file mode 100644 index 00000000..db0e232a --- /dev/null +++ b/docs/reference/nfa.md @@ -0,0 +1,64 @@ +# Network Formation Assay Data + +Neurotoxicity test using a network formation assay studying the +inhibition of network formation at acrylamide exposure. + +## Usage + +``` r +data(nfa) +``` + +## Format + +A data frame with 45 observations on the following 4 variables. + +- `chip`: + + chip ID + +- `conc`: + + 7 concentrations of acrylamide, ranging from 0-5mM + +- `experiment`: + + factor with levels 1 or 2 denoting two consecutive experiments + +- `response`: + + Number of connections \[%\] + +## References + +Frimat, JP, Sisnaiske, J, Subbiah, S, Menne, H, Godoy, P, Lampen, P, +Leist, M, Franzke, J, Hengstler, JG, van Thriel, C, West, J. The network +formation assay: a spatially standardized neurite outgrowth analytical +display for neurotoxicity screening. Lab Chip 2010; 10:701-709. + +## Examples + +``` r +data(nfa) + +## Fit a four-parameter log-logistic model +nfa.m1 <- drm(response ~ conc, data = nfa, fct = LL.4()) +summary(nfa.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 1.828165 0.429684 4.2547 0.0001184 *** +#> c:(Intercept) -3.879086 5.620773 -0.6901 0.4939982 +#> d:(Intercept) 88.533870 2.366218 37.4158 < 2.2e-16 *** +#> e:(Intercept) 0.730916 0.086889 8.4121 1.813e-10 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 9.591243 (41 degrees of freedom) +plot(nfa.m1, main = "NFA dose-response") +``` diff --git a/docs/reference/nicotine-1.png b/docs/reference/nicotine-1.png new file mode 100644 index 00000000..24e1fa31 Binary files /dev/null and b/docs/reference/nicotine-1.png differ diff --git a/docs/reference/nicotine.html b/docs/reference/nicotine.html new file mode 100644 index 00000000..f58fbafd --- /dev/null +++ b/docs/reference/nicotine.html @@ -0,0 +1,118 @@ + +nicotine — nicotine • drc + Skip to contents + + +
    +
    +
    +

    nicotine

    + +
    nicotine.Rd
    +
    + +
    +

    Data from an acute toxicity test with nicotine. For each of several concentrations, the total number of subjects and the number of dead subjects were recorded.

    +
    + +
    +

    Usage

    + 
    data(nicotine)
    +
    + +
    +

    Format

    +

    A data frame with 12 observations on the following 3 variables.

    conc
    +

    a numeric vector

    + +
    total
    +

    a numeric vector

    + +
    num.dead
    +

    a numeric vector

    + + +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Displaying the data
+head(nicotine)
+#>     conc total num.dead
+#> 1 0.0000    45        3
+#> 2 0.0025    50        5
+#> 3 0.0050    46        4
+#> 4 0.0100    50        3
+#> 5 0.0200    46       11
+#> 6 0.0300    46       20
+
+## Fitting a two-parameter log-logistic model for binomial response
+nicotine.m1 <- drm(num.dead/total ~ conc, weights = total,
+data = nicotine, fct = LL.2(), type = "binomial")
+summary(nicotine.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                 Estimate Std. Error t-value   p-value    
+#> b:(Intercept) -1.7590301  0.1470173 -11.965 < 2.2e-16 ***
+#> e:(Intercept)  0.0288876  0.0021099  13.691 < 2.2e-16 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+## Plotting the fitted curve
+plot(nicotine.m1, xlab = "Concentration", ylab = "Proportion dead", ylim = c(0, 1))
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/nicotine.md b/docs/reference/nicotine.md new file mode 100644 index 00000000..d2bb7219 --- /dev/null +++ b/docs/reference/nicotine.md @@ -0,0 +1,61 @@ +# nicotine + +Data from an acute toxicity test with nicotine. For each of several +concentrations, the total number of subjects and the number of dead +subjects were recorded. + +## Usage + +``` r +data(nicotine) +``` + +## Format + +A data frame with 12 observations on the following 3 variables. + +- `conc`: + + a numeric vector + +- `total`: + + a numeric vector + +- `num.dead`: + + a numeric vector + +## Examples + +``` r +library(drc) + +## Displaying the data +head(nicotine) +#> conc total num.dead +#> 1 0.0000 45 3 +#> 2 0.0025 50 5 +#> 3 0.0050 46 4 +#> 4 0.0100 50 3 +#> 5 0.0200 46 11 +#> 6 0.0300 46 20 + +## Fitting a two-parameter log-logistic model for binomial response +nicotine.m1 <- drm(num.dead/total ~ conc, weights = total, +data = nicotine, fct = LL.2(), type = "binomial") +summary(nicotine.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) -1.7590301 0.1470173 -11.965 < 2.2e-16 *** +#> e:(Intercept) 0.0288876 0.0021099 13.691 < 2.2e-16 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 + +## Plotting the fitted curve +plot(nicotine.m1, xlab = "Concentration", ylab = "Proportion dead", ylim = c(0, 1)) +``` diff --git a/docs/reference/noEffect.html b/docs/reference/noEffect.html index b78f8506..04e76ed2 100644 --- a/docs/reference/noEffect.html +++ b/docs/reference/noEffect.html @@ -1,170 +1,109 @@ - - - - - - +Testing if there is a dose effect at all — noEffect • drc + Skip to contents -Testing if there is a dose effect at all — noEffect • drc - - - +
    +
    +
    +

    Testing if there is a dose effect at all

    + Source: R/noEffect.R +
    noEffect.Rd
    +
    - - - - - - +
    +

    A significance test is provided for the comparison of the dose-response model considered +and the simple linear regression model with slope 0 (a horizontal regression line +corresponding to no dose effect).

    +
    - - +
    +

    Usage

    + 
    noEffect(object)
    +
    - +
    +

    Arguments

    - +
    object
    +

    an object of class 'drc'.

    - -
    -
    -
    +
    +

    Value

    +

    The likelihood ratio test statistic and the corresponding degrees of freedom +and p-value are reported.

    - - -
    -
    - - - - -
    -
    -
    -

    Testing if there is a dose effect at all

    - - +
    +

    Details

    +

    Perhaps useful for screening purposes.

    - -
    - -

    A significance test is provided for the comparison of the dose-response model considered and the simple linear regression - model with slope 0 (a horizontal regression line corresponding to no dose effect)

    - +
    +

    Author

    +

    Christian Ritz

    - 
    noEffect(object)
    - -

    Arguments

    - - - - - - -
    object

    an object of class 'drc'.

    - -

    Details

    - -

    Perhaps useful for screening purposes.

    - -

    Value

    - -

    The likelihood ratio test statistic and the corresponding degrees of freedom and p-value are reported.

    - - -

    Examples

    - 
    
-ryegrass.LL.4 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4())
+    
    
+    
    Examples
    
+    
    ryegrass.LL.4 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4())
+
+noEffect(ryegrass.LL.4)
+#> Chi-square test              Df         p-value 
+#>        91.87776         3.00000         0.00000 
+# p-value < 0.0001: there is a highly significant dose effect!
+
+
    
+    
    
+  
    
 
-noEffect(ryegrass.LL.4)
    #> Chi-square test Df p-value -#> 91.87776 3.00000 0.00000
    # p-value < 0.0001: there is a highly significant dose effect! -
    -
    - +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + - -
    - - - + diff --git a/docs/reference/noEffect.md b/docs/reference/noEffect.md new file mode 100644 index 00000000..35a9da66 --- /dev/null +++ b/docs/reference/noEffect.md @@ -0,0 +1,41 @@ +# Testing if there is a dose effect at all + +A significance test is provided for the comparison of the dose-response +model considered and the simple linear regression model with slope 0 (a +horizontal regression line corresponding to no dose effect). + +## Usage + +``` r +noEffect(object) +``` + +## Arguments + +- object: + + an object of class 'drc'. + +## Value + +The likelihood ratio test statistic and the corresponding degrees of +freedom and p-value are reported. + +## Details + +Perhaps useful for screening purposes. + +## Author + +Christian Ritz + +## Examples + +``` r +ryegrass.LL.4 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + +noEffect(ryegrass.LL.4) +#> Chi-square test Df p-value +#> 91.87776 3.00000 0.00000 +# p-value < 0.0001: there is a highly significant dose effect! +``` diff --git a/docs/reference/pickParm.html b/docs/reference/pickParm.html new file mode 100644 index 00000000..7e3fcc30 --- /dev/null +++ b/docs/reference/pickParm.html @@ -0,0 +1,70 @@ + +Pick parameters from model — pickParm • drc + Skip to contents + + +
    +
    +
    +

    Pick parameters from model

    + Source: R/pickParm.R +
    pickParm.Rd
    +
    + +
    +

    Pick parameters from model

    +
    + +
    +

    Usage

    + 
    pickParm(parmVec, indexVec, parmNo)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/pickParm.md b/docs/reference/pickParm.md new file mode 100644 index 00000000..1cb3778d --- /dev/null +++ b/docs/reference/pickParm.md @@ -0,0 +1,9 @@ +# Pick parameters from model + +Pick parameters from model + +## Usage + +``` r +pickParm(parmVec, indexVec, parmNo) +``` diff --git a/docs/reference/plot.drc-1.png b/docs/reference/plot.drc-1.png index 06c33569..bdb2d447 100644 Binary files a/docs/reference/plot.drc-1.png and b/docs/reference/plot.drc-1.png differ diff --git a/docs/reference/plot.drc-10.png b/docs/reference/plot.drc-10.png deleted file mode 100644 index e9bf2071..00000000 Binary files a/docs/reference/plot.drc-10.png and /dev/null differ diff --git a/docs/reference/plot.drc-11.png b/docs/reference/plot.drc-11.png deleted file mode 100644 index 3861f9eb..00000000 Binary files a/docs/reference/plot.drc-11.png and /dev/null differ diff --git a/docs/reference/plot.drc-12.png b/docs/reference/plot.drc-12.png deleted file mode 100644 index 195b2e5d..00000000 Binary files a/docs/reference/plot.drc-12.png and /dev/null differ diff --git a/docs/reference/plot.drc-13.png b/docs/reference/plot.drc-13.png deleted file mode 100644 index ef9750c3..00000000 Binary files a/docs/reference/plot.drc-13.png and /dev/null differ diff --git a/docs/reference/plot.drc-14.png b/docs/reference/plot.drc-14.png deleted file mode 100644 index a4f783b0..00000000 Binary files a/docs/reference/plot.drc-14.png and /dev/null differ diff --git a/docs/reference/plot.drc-2.png b/docs/reference/plot.drc-2.png index 89a32f42..587f53b0 100644 Binary files a/docs/reference/plot.drc-2.png and b/docs/reference/plot.drc-2.png differ diff --git a/docs/reference/plot.drc-3.png b/docs/reference/plot.drc-3.png deleted file mode 100644 index 25a37008..00000000 Binary files a/docs/reference/plot.drc-3.png and /dev/null differ diff --git a/docs/reference/plot.drc-4.png b/docs/reference/plot.drc-4.png deleted file mode 100644 index 4c972b1c..00000000 Binary files a/docs/reference/plot.drc-4.png and /dev/null differ diff --git a/docs/reference/plot.drc-5.png b/docs/reference/plot.drc-5.png deleted file mode 100644 index c702ba52..00000000 Binary files a/docs/reference/plot.drc-5.png and /dev/null differ diff --git a/docs/reference/plot.drc-6.png b/docs/reference/plot.drc-6.png deleted file mode 100644 index 4d25fb15..00000000 Binary files a/docs/reference/plot.drc-6.png and /dev/null differ diff --git a/docs/reference/plot.drc-7.png b/docs/reference/plot.drc-7.png deleted file mode 100644 index 2af61a84..00000000 Binary files a/docs/reference/plot.drc-7.png and /dev/null differ diff --git a/docs/reference/plot.drc-8.png b/docs/reference/plot.drc-8.png deleted file mode 100644 index 27fb19a3..00000000 Binary files a/docs/reference/plot.drc-8.png and /dev/null differ diff --git a/docs/reference/plot.drc-9.png b/docs/reference/plot.drc-9.png deleted file mode 100644 index 3e0fae6c..00000000 Binary files a/docs/reference/plot.drc-9.png and /dev/null differ diff --git a/docs/reference/plot.drc.html b/docs/reference/plot.drc.html index 6d654368..df9fc0bc 100644 --- a/docs/reference/plot.drc.html +++ b/docs/reference/plot.drc.html @@ -1,401 +1,360 @@ - - - - - - +Plotting fitted dose-response curves — plot.drc • drc + Skip to contents -Plotting fitted dose-response curves — plot.drc • drc - - - +
    +
    +
    +

    Plotting fitted dose-response curves

    + Source: R/plot.drc.R +
    plot.drc.Rd
    +
    - +
    +

    plot displays fitted curves and observations in the same plot window, +distinguishing between curves by different plot symbols and line types.

    +
    - - +
    +

    Usage

    + 
    # S3 method for class 'drc'
+plot(
+  x,
+  ...,
+  add = FALSE,
+  level = NULL,
+  type = c("average", "all", "bars", "none", "obs", "confidence"),
+  broken = FALSE,
+  bp,
+  bcontrol = NULL,
+  conName = NULL,
+  axes = TRUE,
+  gridsize = 100,
+  log = "x",
+  xtsty,
+  xttrim = TRUE,
+  xt = NULL,
+  xtlab = NULL,
+  xlab,
+  xlim,
+  yt = NULL,
+  ytlab = NULL,
+  ylab,
+  ylim,
+  cex,
+  cex.axis = 1,
+  col = FALSE,
+  errbar.col = NULL,
+  errbar.lwd = NULL,
+  lty,
+  pch,
+  legend,
+  legendText,
+  legendPos,
+  cex.legend = 1,
+  normal = FALSE,
+  normRef = 1,
+  confidence.level = 0.95
+)
    +
    +
    +

    Arguments

    - - +
    x
    +

    an object of class 'drc'.

    - +
    ...
    +

    additional graphical arguments. For instance, use lwd=2 or +lwd=3 to increase the width of plot symbols.

    - - -
    -
    - - - -
    -
    -
    -
    -

    Plotting fitted dose-response curves

    - - -
    +
    level
    +

    vector of character strings. To plot only the curves specified +by their names.

    -
    - -

    plot displays fitted curves and observations in the same plot window, - distinguishing between curves by different plot symbols and line types.

    - -
    - 
    # S3 method for drc
-plot(x, ..., add = FALSE, level = NULL,
-  type = c("average", "all", "bars", "none", "obs", "confidence"),
-  broken = FALSE, bp, bcontrol = NULL, conName = NULL, axes = TRUE,
-  gridsize = 100, log = "x", xtsty, xttrim = TRUE,
-  xt = NULL, xtlab = NULL, xlab, xlim,
-  yt = NULL, ytlab = NULL, ylab, ylim,
-  cex, cex.axis = 1, col = FALSE, lty, pch,
-  legend, legendText, legendPos, cex.legend = 1,
-  normal = FALSE, normRef = 1, confidence.level = 0.95)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    x

    an object of class 'drc'.

    ...

    additional graphical arguments. For instance, use lwd=2 or lwd=3 to increase the width of plot symbols.

    add

    logical. If TRUE then add to already existing plot.

    level

    vector of character strings. To plot only the curves specified by their names.

    type

    a character string specifying how to plot the data. There are currently - 5 options: "average" (averages and fitted curve(s); default), - "none" (only the fitted curve(s)), "obs" (only the data points), - "all" (all data points and fitted curve(s)), - "bars" (averages and fitted curve(s) with model-based standard errors (see Details)), and - "confidence" (confidence bands for fitted curve(s)).

    broken

    logical. If TRUE the x axis is broken provided this axis is logarithmic - (using functionality in the CRAN package 'plotrix').

    bp

    numeric value specifying the break point below which the dose is zero (the amount of stretching on - the dose axis above zero in order to create the visual illusion of a logarithmic scale including 0). - The default is the base-10 value corresponding to the rounded value of the minimum of the log10 values of - all positive dose values. This argument is only working for logarithmic dose axes.

    bcontrol

    a list with components factor, style and width. - Controlling the appearance of the break (in case broken is TRUE). - The component factor is the distance from the control to the break as a - multiple of the value of bp (default is 2). - The component style can take the values: gap, slash or zigzag. - The component width is the width of the break symbol (default is 0.02).

    conName

    character string. Name on x axis for dose zero. Default is '"0"'.

    axes

    logical indicating whether both axes should be drawn on the plot.

    gridsize

    numeric. Number of points in the grid used for plotting the fitted curves.

    log

    a character string which contains '"x"' if the x axis is to be logarithmic, '"y"' if the y axis is to be logarithmic and '"xy"' or - '"yx"' if both axes are to be logarithmic. The default is "x". The empty string "" yields the original axes.

    xtsty

    a character string specifying the dose axis style for arrangement of tick marks. By default ("base10") - For a logarithmic axis by default only base 10 tick marks are shown ("base10"). Otherwise sensible - equidistantly located tick marks are shown ("standard"), relying on axTicks.

    xttrim

    logical specifying if the number of tick marks should be trimmed in case too many tick marks - are initially determined.

    xt

    a numeric vector containing the positions of the tick marks on the x axis.

    xtlab

    a vector containing the tick marks on the x axis.

    xlab

    an optional label for the x axis.

    xlim

    a numeric vector of length two, containing the lower and upper limit for the x axis.

    yt

    a numeric vector, containing the positions of the tick marks on the y axis.

    ytlab

    a vector containing the tick marks on the y axis.

    ylab

    an optional label for the y axis.

    ylim

    a numeric vector of length two, containing the lower and upper limit for the y axis.

    cex

    numeric or numeric vector specifying the size of plotting symbols and text - (see par for details).

    cex.axis

    numeric value specifying the magnification to be used for axis annotation - relative to the current setting of cex.

    col

    either logical or a vector of colours. If TRUE default colours are used. - If FALSE (default) no colours are used.

    legend

    logical. If TRUE a legend is displayed.

    legendText

    a character string or vector of character strings specifying the legend text - (the position of the upper right corner of the legend box).

    legendPos

    numeric vector of length 2 giving the position of the legend.

    cex.legend

    numeric specifying the legend text size.

    lty

    a numeric vector specifying the line types.

    pch

    a vector of plotting characters or symbols (see points).

    normal

    logical. If TRUE the plot of the normalized data and fitted curves are shown - (for details see Weimer et al. (2012) for details).

    normRef

    numeric specifying the reference for the normalization (default is 1).

    confidence.level

    confidence level for error bars. Defaults to 0.95.

    - -

    Details

    - -

    The use of xlim allows changing the range of the x axis, extrapolating the fitted dose-response curves. - Note that changing the range on the x axis may also entail a change of the range on the y axis. Sometimes - it may be useful to extend the upper limit on the y axis (using ylim) in order to fit a legend into - the plot.

    -

    See colors for the available colours.

    -

    Suitable labels are automatically provided.

    -

    The arguments broken and bcontrol rely on the function - link{axis.break} with arguments - style and brw in the package plotrix.

    -

    The model-based standard errors used for the error bars are calculated - as the fitted value plus/minus the estimated error times the - 1-(alpha/2) quantile in the t distribution with degrees of freedom - equal to the residual degrees of freedom for the model (or using a - standard normal distribution in case of binomial and poisson data), - where alpha=1-confidence.level. The standard errors are obtained using - the predict method with the arguments interval = "confidence" - and level=confidence.level.

    - -

    Value

    - -

    An invisible data frame with the values used for plotting the fitted curves. The first column contains the dose values, -and the following columns (one for each curve) contain the fitted response values.

    - -

    References

    - -

    Weimer, M., Jiang, X., Ponta, O., Stanzel, S., Freyberger, A., Kopp-Schneider, A. (2012) - The impact of data transformations on concentration-response modeling. - Toxicology Letters, 213, 292--298.

    - - -

    Examples

    - 
    
-## Fitting models to be plotted below
-ryegrass.m1 <- drm(rootl~conc, data = ryegrass, fct = LL.4())
-ryegrass.m2 <- drm(rootl~conc, data = ryegrass, fct = LL.3())  # lower limit fixed at 0
-
-## Plotting observations and fitted curve for the first model
-plot(ryegrass.m1, broken = TRUE)
    
-## Adding fitted curve for the second model (not much difference)
-plot(ryegrass.m2, broken = TRUE, add = TRUE, type = "none", col = 2, lty = 2)
    
-## Add confidence region for the first model.
-plot(ryegrass.m1, broken = TRUE, type="confidence", add=TRUE)
    
-## Finetuning the axis break
-plot(ryegrass.m1, broken = TRUE, bcontrol = list(style = "gap"))
    plot(ryegrass.m1, broken = TRUE, bcontrol = list(style = "slash"))
    plot(ryegrass.m1, broken = TRUE, bcontrol = list(style = "zigzag"))
    
-## Plot without axes
-plot(ryegrass.m1, axes = FALSE)
    
-## Fitting model to be plotted below
-spinach.m1 <- drm(SLOPE~DOSE, CURVE, data = spinach, fct = LL.4())
-
-## Plot with no colours
-plot(spinach.m1, main = "Different line types (default)")
    
-## Plot with default colours
-plot(spinach.m1, col = TRUE, main = "Default colours")
    
-## Plot with specified colours
-plot(spinach.m1, col = c(2,6,3,23,56), main = "User-specified colours")
    
-## Plot of curves 1 and 2 only
-plot(spinach.m1, level = c(1,2), main = "User-specified curves")
    
-## Plot with symbol of different sizes
-plot(spinach.m1, cex = c(1,2,3,4,5), main = "User-specified symbil sizes")
    
-## Plot with confidence regions
-plot(spinach.m1, col = TRUE, main = "Confidence Regions", type = "confidence")
    
-## Add points
-plot(spinach.m1, col = TRUE, add=TRUE)
    
-## Fitting another model to be plotted below
-lettuce.m1 <- drm(weight~conc, data = lettuce, fct = LL.4())
-
-## Using the argument 'bp'. Compare the plots!
-par(mfrow = c(2, 2))
-plot(lettuce.m1, main = "bp = default")  # using the default
-plot(lettuce.m1, bp = 1e-4, main = "bp = 1e-4")
-plot(lettuce.m1, bp = 1e-6, main = "bp = 1e-6")
-plot(lettuce.m1, bp = 1e-8, main = "bp = 1e-8")
    par(mfrow = c(1,1))
-
-## User-specified position of legend
-S.alba.m1 <- drm(DryMatter~Dose, Herbicide, data = S.alba, fct = LL.4())
-
-plot(S.alba.m1)
    plot(S.alba.m1, legendPos = c(0.3, 4.8))
    
-
    -
    - -
    +
    bp
    +

    numeric value specifying the break point below which the dose is +zero. The default is the base-10 value corresponding to the rounded value +of the minimum of the log10 values of all positive dose values. Only works +for logarithmic dose axes.

    + + +
    bcontrol
    +

    a list with components factor, style and +width controlling the appearance of the break (when broken +is TRUE).

    + + +
    conName
    +

    character string. Name on x axis for dose zero. Default is +"0".

    + + +
    axes
    +

    logical indicating whether both axes should be drawn on the plot.

    + + +
    gridsize
    +

    numeric. Number of points in the grid used for plotting the +fitted curves.

    + + +
    log
    +

    a character string which contains "x" if the x axis is to +be logarithmic, "y" if the y axis is to be logarithmic and +"xy" or "yx" if both axes are to be logarithmic. The default +is "x". The empty string "" yields the original axes.

    + + +
    xtsty
    +

    a character string specifying the dose axis style for +arrangement of tick marks. By default for a logarithmic axis only base 10 +tick marks are shown ("base10"). Otherwise sensible equidistantly +located tick marks are shown ("standard").

    + + +
    xttrim
    +

    logical specifying if the number of tick marks should be +trimmed in case too many tick marks are initially determined.

    + + +
    xt
    +

    a numeric vector containing the positions of the tick marks on the +x axis.

    + + +
    xtlab
    +

    a vector containing the tick marks on the x axis.

    + + +
    xlab
    +

    an optional label for the x axis.

    + + +
    xlim
    +

    a numeric vector of length two, containing the lower and upper +limit for the x axis.

    + + +
    yt
    +

    a numeric vector containing the positions of the tick marks on the +y axis.

    + + +
    ytlab
    +

    a vector containing the tick marks on the y axis.

    + + +
    ylab
    +

    an optional label for the y axis.

    + -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    ylim
    +

    a numeric vector of length two, containing the lower and upper +limit for the y axis.

    + + +
    cex
    +

    numeric or numeric vector specifying the size of plotting symbols +and text (see par for details).

    + + +
    cex.axis
    +

    numeric value specifying the magnification to be used for +axis annotation relative to the current setting of cex.

    + + +
    col
    +

    either logical or a vector of colours. If TRUE default colours are +used. If FALSE (default) no colours are used.

    + + +
    errbar.col
    +

    colour(s) for error bars when using type = "bars". +If NULL (default), error bars will match the curve colours specified +by col. Use errbar.col = "black" to restore the previous +behaviour of black error bars.

    + + +
    errbar.lwd
    +

    line width(s) for error bars when using type = "bars". +If NULL (default), error bars will inherit the line width specified +by lwd (via ...). If lwd is also not specified, the +default graphical parameter par("lwd") is used.

    + + +
    lty
    +

    a numeric vector specifying the line types.

    + + +
    pch
    +

    a vector of plotting characters or symbols (see +points).

    + + +
    legend
    +

    logical. If TRUE a legend is displayed.

    + + +
    legendText
    +

    a character string or vector of character strings +specifying the legend text.

    + + +
    legendPos
    +

    numeric vector of length 2 giving the position of the +legend.

    + + +
    cex.legend
    +

    numeric specifying the legend text size.

    + + +
    normal
    +

    logical. If TRUE the plot of the normalized data and fitted +curves are shown (see Weimer et al. (2012) for details).

    + + +
    normRef
    +

    numeric specifying the reference for the normalization +(default is 1).

    + + +
    confidence.level
    +

    confidence level for error bars. Defaults to 0.95.

    + +
    +
    +

    Value

    +

    An invisible data frame with the values used for plotting the fitted +curves. The first column contains the dose values, and the following +columns (one for each curve) contain the fitted response values.

    +
    +
    +

    Details

    +

    The use of xlim allows changing the range of the x axis, +extrapolating the fitted dose-response curves. Note that changing the range +on the x axis may also entail a change of the range on the y axis. Sometimes +it may be useful to extend the upper limit on the y axis (using ylim) +in order to fit a legend into the plot.

    +

    See colors for the available colours. Suitable labels are +automatically provided.

    +

    The arguments broken and bcontrol rely on the function +axis.break with arguments style and brw in the package +plotrix.

    +

    The model-based standard errors used for the error bars are calculated as the +fitted value plus/minus the estimated error times the 1-(alpha/2) quantile in +the t distribution with degrees of freedom equal to the residual degrees of +freedom for the model (or using a standard normal distribution in case of +binomial and Poisson data), where alpha = 1 - confidence.level. The standard +errors are obtained using the predict method with the arguments +interval = "confidence" and level = confidence.level.

    +
    +
    +

    See also

    +

    colors

    +
    +
    +

    Author

    +

    Christian Ritz and Jens C. Streibig. Contributions from Xiaoyan Wang +and Greg Warnes.

    +
    + +
    +

    Examples

    + 
    ## Fitting models to be plotted below
+ryegrass.m1 <- drm(rootl~conc, data = ryegrass, fct = LL.4())
+ryegrass.m2 <- drm(rootl~conc, data = ryegrass, fct = LL.3())
+
+## Plotting observations and fitted curve for the first model
+plot(ryegrass.m1, broken = TRUE)
+
+## Adding fitted curve for the second model
+plot(ryegrass.m2, broken = TRUE, add = TRUE, type = "none", col = 2, lty = 2)
+
+## Add confidence region for the first model
+plot(ryegrass.m1, broken = TRUE, type="confidence", add=TRUE)
+
+
+## Fitting model with multiple curves
+spinach.m1 <- drm(SLOPE~DOSE, CURVE, data = spinach, fct = LL.4())
+
+## Plot with default colours
+plot(spinach.m1, col = TRUE, main = "Default colours")
+
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -

    Site built with pkgdown.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -
    + + + + - - - + diff --git a/docs/reference/plot.drc.md b/docs/reference/plot.drc.md new file mode 100644 index 00000000..61ddecd1 --- /dev/null +++ b/docs/reference/plot.drc.md @@ -0,0 +1,293 @@ +# Plotting fitted dose-response curves + +`plot` displays fitted curves and observations in the same plot window, +distinguishing between curves by different plot symbols and line types. + +## Usage + +``` r +# S3 method for class 'drc' +plot( + x, + ..., + add = FALSE, + level = NULL, + type = c("average", "all", "bars", "none", "obs", "confidence"), + broken = FALSE, + bp, + bcontrol = NULL, + conName = NULL, + axes = TRUE, + gridsize = 100, + log = "x", + xtsty, + xttrim = TRUE, + xt = NULL, + xtlab = NULL, + xlab, + xlim, + yt = NULL, + ytlab = NULL, + ylab, + ylim, + cex, + cex.axis = 1, + col = FALSE, + errbar.col = NULL, + errbar.lwd = NULL, + lty, + pch, + legend, + legendText, + legendPos, + cex.legend = 1, + normal = FALSE, + normRef = 1, + confidence.level = 0.95 +) +``` + +## Arguments + +- x: + + an object of class 'drc'. + +- ...: + + additional graphical arguments. For instance, use `lwd=2` or `lwd=3` + to increase the width of plot symbols. + +- add: + + logical. If TRUE then add to already existing plot. + +- level: + + vector of character strings. To plot only the curves specified by + their names. + +- type: + + a character string specifying how to plot the data. Options are: + `"average"` (averages and fitted curve(s); default), `"none"` (only + the fitted curve(s)), `"obs"` (only the data points), `"all"` (all + data points and fitted curve(s)), `"bars"` (averages and fitted + curve(s) with model-based standard errors), and `"confidence"` + (confidence bands for fitted curve(s)). + +- broken: + + logical. If TRUE the x axis is broken provided this axis is + logarithmic (using functionality in the CRAN package 'plotrix'). + +- bp: + + numeric value specifying the break point below which the dose is zero. + The default is the base-10 value corresponding to the rounded value of + the minimum of the log10 values of all positive dose values. Only + works for logarithmic dose axes. + +- bcontrol: + + a list with components `factor`, `style` and `width` controlling the + appearance of the break (when `broken` is `TRUE`). + +- conName: + + character string. Name on x axis for dose zero. Default is `"0"`. + +- axes: + + logical indicating whether both axes should be drawn on the plot. + +- gridsize: + + numeric. Number of points in the grid used for plotting the fitted + curves. + +- log: + + a character string which contains `"x"` if the x axis is to be + logarithmic, `"y"` if the y axis is to be logarithmic and `"xy"` or + `"yx"` if both axes are to be logarithmic. The default is `"x"`. The + empty string `""` yields the original axes. + +- xtsty: + + a character string specifying the dose axis style for arrangement of + tick marks. By default for a logarithmic axis only base 10 tick marks + are shown (`"base10"`). Otherwise sensible equidistantly located tick + marks are shown (`"standard"`). + +- xttrim: + + logical specifying if the number of tick marks should be trimmed in + case too many tick marks are initially determined. + +- xt: + + a numeric vector containing the positions of the tick marks on the x + axis. + +- xtlab: + + a vector containing the tick marks on the x axis. + +- xlab: + + an optional label for the x axis. + +- xlim: + + a numeric vector of length two, containing the lower and upper limit + for the x axis. + +- yt: + + a numeric vector containing the positions of the tick marks on the y + axis. + +- ytlab: + + a vector containing the tick marks on the y axis. + +- ylab: + + an optional label for the y axis. + +- ylim: + + a numeric vector of length two, containing the lower and upper limit + for the y axis. + +- cex: + + numeric or numeric vector specifying the size of plotting symbols and + text (see [`par`](https://rdrr.io/r/graphics/par.html) for details). + +- cex.axis: + + numeric value specifying the magnification to be used for axis + annotation relative to the current setting of cex. + +- col: + + either logical or a vector of colours. If TRUE default colours are + used. If FALSE (default) no colours are used. + +- errbar.col: + + colour(s) for error bars when using `type = "bars"`. If `NULL` + (default), error bars will match the curve colours specified by `col`. + Use `errbar.col = "black"` to restore the previous behaviour of black + error bars. + +- errbar.lwd: + + line width(s) for error bars when using `type = "bars"`. If `NULL` + (default), error bars will inherit the line width specified by `lwd` + (via `...`). If `lwd` is also not specified, the default graphical + parameter `par("lwd")` is used. + +- lty: + + a numeric vector specifying the line types. + +- pch: + + a vector of plotting characters or symbols (see + [`points`](https://rdrr.io/r/graphics/points.html)). + +- legend: + + logical. If TRUE a legend is displayed. + +- legendText: + + a character string or vector of character strings specifying the + legend text. + +- legendPos: + + numeric vector of length 2 giving the position of the legend. + +- cex.legend: + + numeric specifying the legend text size. + +- normal: + + logical. If TRUE the plot of the normalized data and fitted curves are + shown (see Weimer et al. (2012) for details). + +- normRef: + + numeric specifying the reference for the normalization (default is 1). + +- confidence.level: + + confidence level for error bars. Defaults to 0.95. + +## Value + +An invisible data frame with the values used for plotting the fitted +curves. The first column contains the dose values, and the following +columns (one for each curve) contain the fitted response values. + +## Details + +The use of `xlim` allows changing the range of the x axis, extrapolating +the fitted dose-response curves. Note that changing the range on the x +axis may also entail a change of the range on the y axis. Sometimes it +may be useful to extend the upper limit on the y axis (using `ylim`) in +order to fit a legend into the plot. + +See [`colors`](https://rdrr.io/r/grDevices/colors.html) for the +available colours. Suitable labels are automatically provided. + +The arguments `broken` and `bcontrol` rely on the function `axis.break` +with arguments `style` and `brw` in the package plotrix. + +The model-based standard errors used for the error bars are calculated +as the fitted value plus/minus the estimated error times the 1-(alpha/2) +quantile in the t distribution with degrees of freedom equal to the +residual degrees of freedom for the model (or using a standard normal +distribution in case of binomial and Poisson data), where alpha = 1 - +confidence.level. The standard errors are obtained using the predict +method with the arguments `interval = "confidence"` and +`level = confidence.level`. + +## See also + +[`colors`](https://rdrr.io/r/grDevices/colors.html) + +## Author + +Christian Ritz and Jens C. Streibig. Contributions from Xiaoyan Wang and +Greg Warnes. + +## Examples + +``` r +## Fitting models to be plotted below +ryegrass.m1 <- drm(rootl~conc, data = ryegrass, fct = LL.4()) +ryegrass.m2 <- drm(rootl~conc, data = ryegrass, fct = LL.3()) + +## Plotting observations and fitted curve for the first model +plot(ryegrass.m1, broken = TRUE) + +## Adding fitted curve for the second model +plot(ryegrass.m2, broken = TRUE, add = TRUE, type = "none", col = 2, lty = 2) + +## Add confidence region for the first model +plot(ryegrass.m1, broken = TRUE, type="confidence", add=TRUE) + + +## Fitting model with multiple curves +spinach.m1 <- drm(SLOPE~DOSE, CURVE, data = spinach, fct = LL.4()) + +## Plot with default colours +plot(spinach.m1, col = TRUE, main = "Default colours") + +``` diff --git a/docs/reference/plotFACI.html b/docs/reference/plotFACI.html new file mode 100644 index 00000000..d84ddd9e --- /dev/null +++ b/docs/reference/plotFACI.html @@ -0,0 +1,123 @@ + +Plot combination index as a function of fraction affected — plotFACI • drc + Skip to contents + + +
    +
    +
    +

    Plot combination index as a function of fraction affected

    + Source: R/CIcompX.R +
    plotFACI.Rd
    +
    + +
    +

    Visualizes the combination index from CIcompX as a function of the fraction affected.

    +
    + +
    +

    Usage

    + 
    plotFACI(
+  effList,
+  indAxis = c("ED", "EF"),
+  caRef = TRUE,
+  showPoints = FALSE,
+  add = FALSE,
+  ylim,
+  ...
+)
    +
    + +
    +

    Arguments

    + + +
    effList
    +

    a list as returned by CIcompX.

    + + +
    indAxis
    +

    character string. Either "ED" for effective doses or "EF" for effects.

    + + +
    caRef
    +

    logical. If TRUE (default), a reference line for concentration addition is drawn.

    + + +
    showPoints
    +

    logical. If TRUE, estimated combination indices are plotted as points.

    + + +
    add
    +

    logical. If TRUE, the plot is added to an existing plot.

    + + +
    ylim
    +

    numeric vector of length 2 giving the range for the y axis.

    + + +
    ...
    +

    additional graphical arguments.

    + +
    +
    +

    Value

    +

    Invisibly returns the plot matrix of combination index values.

    +
    +
    +

    See also

    +

    CIcompX, CIcomp

    +
    +
    +

    Author

    +

    Christian Ritz and Ismael Rodea-Palomares

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/plotFACI.md b/docs/reference/plotFACI.md new file mode 100644 index 00000000..7041470a --- /dev/null +++ b/docs/reference/plotFACI.md @@ -0,0 +1,64 @@ +# Plot combination index as a function of fraction affected + +Visualizes the combination index from +[`CIcompX`](https://hreinwald.github.io/drc/reference/CIcompX.md) as a +function of the fraction affected. + +## Usage + +``` r +plotFACI( + effList, + indAxis = c("ED", "EF"), + caRef = TRUE, + showPoints = FALSE, + add = FALSE, + ylim, + ... +) +``` + +## Arguments + +- effList: + + a list as returned by + [`CIcompX`](https://hreinwald.github.io/drc/reference/CIcompX.md). + +- indAxis: + + character string. Either "ED" for effective doses or "EF" for effects. + +- caRef: + + logical. If TRUE (default), a reference line for concentration + addition is drawn. + +- showPoints: + + logical. If TRUE, estimated combination indices are plotted as points. + +- add: + + logical. If TRUE, the plot is added to an existing plot. + +- ylim: + + numeric vector of length 2 giving the range for the y axis. + +- ...: + + additional graphical arguments. + +## Value + +Invisibly returns the plot matrix of combination index values. + +## See also + +[`CIcompX`](https://hreinwald.github.io/drc/reference/CIcompX.md), +[`CIcomp`](https://hreinwald.github.io/drc/reference/CIcomp.md) + +## Author + +Christian Ritz and Ismael Rodea-Palomares diff --git a/docs/reference/predict.drc.html b/docs/reference/predict.drc.html index 3f6612ae..bf6d5c74 100644 --- a/docs/reference/predict.drc.html +++ b/docs/reference/predict.drc.html @@ -1,254 +1,192 @@ - - - - - - +Prediction — predict.drc • drc + Skip to contents -Prediction — predict.drc • drc - - - +
    +
    +
    +

    Prediction

    + Source: R/predict.drc.R +
    predict.drc.Rd
    +
    - +
    +

    Predicted values for models of class 'drc'.

    +
    - - +
    +

    Usage

    + 
    # S3 method for class 'drc'
+predict(
+  object,
+  newdata,
+  se.fit = FALSE,
+  interval = c("none", "confidence", "prediction", "ssd"),
+  level = 0.95,
+  na.action = na.pass,
+  od = FALSE,
+  vcov. = vcov,
+  ssdSEfct = NULL,
+  constrain = TRUE,
+  checkND = TRUE,
+  ...
+)
    +
    +
    +

    Arguments

    - - +
    object
    +

    an object of class 'drc'.

    - +
    newdata
    +

    an optional data frame in which to look for variables with +which to predict. If omitted, the fitted values are used.

    - - -
    -
    - - - -
    -
    -
    -
    -

    Prediction

    - - +
    interval
    +

    character string. Type of interval calculation: +"none", "confidence", "prediction", or "ssd".

    + + +
    level
    +

    tolerance/confidence level.

    + + +
    na.action
    +

    function determining what should be done with missing values +in newdata. The default is to predict NA.

    + + +
    od
    +

    logical. If TRUE adjustment for over-dispersion is used.

    + + +
    vcov.
    +

    function providing the variance-covariance matrix. +vcov is the default, but sandwich is also an option +(for obtaining robust standard errors).

    + + +
    ssdSEfct
    +

    specifies the function for interpolating standard errors +between observed standard errors. The default is linear interpolation on +log-log scale (back-transformed).

    + + +
    constrain
    +

    logical. If TRUE (default) predicted values are truncated +within meaningful limits, i.e., 0 and, possibly, 1.

    + + +
    checkND
    +

    logical indicating whether or not names in newdata +data frame match the names in the original data frame used for fitting +the model. Default is TRUE.

    + + +
    ...
    +

    further arguments passed to or from other methods.

    + +
    +
    +

    Value

    +

    A matrix with as many rows as there are dose values provided in +newdata or in the original dataset (in case newdata is not +specified) and, at most, 4 columns containing fitted values, standard +errors, lower and upper limits of confidence/prediction intervals.

    +
    +
    +

    See also

    +

    For details see the help page for predict.lm.

    +
    +
    +

    Author

    +

    Christian Ritz

    -
    - -

    Predicted values for models of class 'drc'.

    - +
    +

    Examples

    + 
    ## Fitting a model
+spinach.model1 <- drm(SLOPE~DOSE, CURVE, data = spinach, fct = LL.4())
+
+## Predicting values at dose=2 (with standard errors)
+predict(spinach.model1, data.frame(dose=2, CURVE=c("1", "2", "3")), se.fit = TRUE)
+#>      Prediction         SE
+#> [1,]  0.9048476 0.02496135
+#> [2,]  0.4208307 0.02924987
+#> [3,]  0.5581673 0.03067170
+
+## Getting confidence intervals
+predict(spinach.model1, data.frame(dose=2, CURVE=c("1", "2", "3")),
+interval = "confidence")
+#>      Prediction     Lower     Upper
+#> [1,]  0.9048476 0.8552178 0.9544775
+#> [2,]  0.4208307 0.3626741 0.4789873
+#> [3,]  0.5581673 0.4971838 0.6191509
+
+## Getting prediction intervals
+predict(spinach.model1, data.frame(dose=2, CURVE=c("1", "2", "3")),
+interval = "prediction")
+#>      Prediction     Lower     Upper
+#> [1,]  0.9048476 0.7504590 1.0592363
+#> [2,]  0.4208307 0.2634937 0.5781677
+#> [3,]  0.5581673 0.3997636 0.7165710
+
+
    +
    - 
    # S3 method for drc
-predict(object, newdata, se.fit = FALSE, 
-  interval = c("none", "confidence", "prediction", "ssd"), 
-  level = 0.95, na.action = na.pass, od = FALSE, vcov. = vcov, 
-  ssdSEfct = NULL, constrain = TRUE, checkND = TRUE, ...)
-
-
-
-
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    object

    an object of class 'drc'.

    newdata

    An optional data frame in which to look for variables with which to predict. - If omitted, the fitted values are used.

    se.fit

    logical. If TRUE standard errors are required.

    interval

    character string. Type of interval calculation: "none", "confidence", "prediction", or "ssd".

    level

    Tolerance/confidence level.

    na.action

    function determining what should be done with missing values in 'newdata'. - The default is to predict 'NA'.

    od

    logical. If TRUE adjustment for over-dispersion is used.

    vcov.

    function providing the variance-covariance matrix. vcov is the default, - but sandwich is also an option (for obtaining robust standard errors).

    ssdSEfct

    specifies the function for interpolating standard errors between observed standard errors. - The default is linear interpolation on log-log scale (back-transformed). See Details for more explanation.

    constrain

    logical. If TRUE (default) predicted values are truncated within meaningful limits, i.e., - 0 and, possibly, 1.

    checkND

    logical indicating whether or not names in "newdata" data frame match - the names in the original data frame (used for fitting the model). Default is TRUE.

    …

    further arguments passed to or from other methods.

    - -

    Details

    - -

    For the built-in log-logistic, log-normal, and Weibull-type models standard errors and confidence/prediction - intervals can be calculated. For other built-in models it may not yet be implemented (drop us an e-mail if - you need them).

    -

    The function for interpolating standard errors of estimates, which may be used when fitting an SSD, should - have 3 arguments: observed estimates and corresponding standard errors and future estimates and should return - interpolated standard errors corresponding to the future estimates provided.

    - -

    Value

    - -

    A matrix with as many rows as there are dose values provided in 'newdata' or in the original dataset - (in case 'newdata' is not specified) and, at most, 4 columns containing fitted, standard errors, lower and - upper limits of confidence/prediction intervals.

    - -

    See also

    - -

    For details are found in the help page for predict.lm.

    - - -

    Examples

    - 
    
-## Fitting a model
-spinach.model1 <- drm(SLOPE~DOSE, CURVE, data = spinach, fct = LL.4())
-
-## Predicting values a dose=2 (with standard errors)
-predict(spinach.model1, data.frame(dose=2, CURVE=c("1", "2", "3")), se.fit = TRUE)
    #>      Prediction         SE
-#> [1,]  0.9048476 0.02496135
-#> [2,]  0.4208307 0.02924987
-#> [3,]  0.5581673 0.03067170
    
-## Getting confidence intervals
-predict(spinach.model1, data.frame(dose=2, CURVE=c("1", "2", "3")),
-interval = "confidence")
    #>      Prediction     Lower     Upper
-#> [1,]  0.9048476 0.8552178 0.9544775
-#> [2,]  0.4208307 0.3626741 0.4789873
-#> [3,]  0.5581673 0.4971838 0.6191509
    
-## Getting prediction intervals
-predict(spinach.model1, data.frame(dose=2, CURVE=c("1", "2", "3")),
-interval = "prediction")
    #>      Prediction     Lower     Upper
-#> [1,]  0.9048476 0.7504590 1.0592363
-#> [2,]  0.4208307 0.2634937 0.5781677
-#> [3,]  0.5581673 0.3997636 0.7165710
    
-
    -
    - - -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -

    Site built with pkgdown.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -
    +
    + + + - - - + diff --git a/docs/reference/predict.drc.md b/docs/reference/predict.drc.md new file mode 100644 index 00000000..c0a1b3c1 --- /dev/null +++ b/docs/reference/predict.drc.md @@ -0,0 +1,129 @@ +# Prediction + +Predicted values for models of class 'drc'. + +## Usage + +``` r +# S3 method for class 'drc' +predict( + object, + newdata, + se.fit = FALSE, + interval = c("none", "confidence", "prediction", "ssd"), + level = 0.95, + na.action = na.pass, + od = FALSE, + vcov. = vcov, + ssdSEfct = NULL, + constrain = TRUE, + checkND = TRUE, + ... +) +``` + +## Arguments + +- object: + + an object of class 'drc'. + +- newdata: + + an optional data frame in which to look for variables with which to + predict. If omitted, the fitted values are used. + +- se.fit: + + logical. If TRUE standard errors are required. + +- interval: + + character string. Type of interval calculation: `"none"`, + `"confidence"`, `"prediction"`, or `"ssd"`. + +- level: + + tolerance/confidence level. + +- na.action: + + function determining what should be done with missing values in + `newdata`. The default is to predict `NA`. + +- od: + + logical. If TRUE adjustment for over-dispersion is used. + +- vcov.: + + function providing the variance-covariance matrix. + [`vcov`](https://rdrr.io/r/stats/vcov.html) is the default, but + `sandwich` is also an option (for obtaining robust standard errors). + +- ssdSEfct: + + specifies the function for interpolating standard errors between + observed standard errors. The default is linear interpolation on + log-log scale (back-transformed). + +- constrain: + + logical. If TRUE (default) predicted values are truncated within + meaningful limits, i.e., 0 and, possibly, 1. + +- checkND: + + logical indicating whether or not names in `newdata` data frame match + the names in the original data frame used for fitting the model. + Default is TRUE. + +- ...: + + further arguments passed to or from other methods. + +## Value + +A matrix with as many rows as there are dose values provided in +`newdata` or in the original dataset (in case `newdata` is not +specified) and, at most, 4 columns containing fitted values, standard +errors, lower and upper limits of confidence/prediction intervals. + +## See also + +For details see the help page for +[`predict.lm`](https://rdrr.io/r/stats/predict.lm.html). + +## Author + +Christian Ritz + +## Examples + +``` r +## Fitting a model +spinach.model1 <- drm(SLOPE~DOSE, CURVE, data = spinach, fct = LL.4()) + +## Predicting values at dose=2 (with standard errors) +predict(spinach.model1, data.frame(dose=2, CURVE=c("1", "2", "3")), se.fit = TRUE) +#> Prediction SE +#> [1,] 0.9048476 0.02496135 +#> [2,] 0.4208307 0.02924987 +#> [3,] 0.5581673 0.03067170 + +## Getting confidence intervals +predict(spinach.model1, data.frame(dose=2, CURVE=c("1", "2", "3")), +interval = "confidence") +#> Prediction Lower Upper +#> [1,] 0.9048476 0.8552178 0.9544775 +#> [2,] 0.4208307 0.3626741 0.4789873 +#> [3,] 0.5581673 0.4971838 0.6191509 + +## Getting prediction intervals +predict(spinach.model1, data.frame(dose=2, CURVE=c("1", "2", "3")), +interval = "prediction") +#> Prediction Lower Upper +#> [1,] 0.9048476 0.7504590 1.0592363 +#> [2,] 0.4208307 0.2634937 0.5781677 +#> [3,] 0.5581673 0.3997636 0.7165710 +``` diff --git a/docs/reference/print.drc.html b/docs/reference/print.drc.html index 2ef16ea8..fbf63f7b 100644 --- a/docs/reference/print.drc.html +++ b/docs/reference/print.drc.html @@ -1,183 +1,127 @@ - - - - - - +Printing key features — print.drc • drc + Skip to contents -Printing key features — print.drc • drc - - - +
    +
    +
    +

    Printing key features

    + Source: R/print.drc.R +
    print.drc.Rd
    +
    - - - - +
    +

    print displays brief information on an object of class 'drc'.

    +
    +
    +

    Usage

    + 
    # S3 method for class 'drc'
+print(x, ..., digits = max(3, getOption("digits") - 3))
    +
    +
    +

    Arguments

    - - - +
    x
    +

    an object of class 'drc'.

    - +
    ...
    +

    additional arguments.

    - -
    -
    - - - -
    +
    digits
    +

    an integer giving the number of digits of the parameter coefficients. Default is 3.

    -
    -
    -
    -

    Printing key features

    - - +
    +
    +

    Value

    +

    The object is returned invisibly.

    +
    +
    +

    Author

    +

    Christian Ritz

    -
    - -

    'print' displays brief information on an object of class 'drc'.

    - +
    +

    Examples

    + 
    ## Fitting a four-parameter log-logistic model
+ryegrass.m1 <- drm(rootl ~conc, data = ryegrass, fct = LL.4())
+
+## Displaying the model fit
+print(ryegrass.m1)
+#> 
+#> A 'drc' model.
+#> 
+#> Call:
+#> drm(formula = rootl ~ conc, data = ryegrass, fct = LL.4())
+#> 
+#> Coefficients:
+#> b:(Intercept)  c:(Intercept)  d:(Intercept)  e:(Intercept)  
+#>        2.9822         0.4814         7.7930         3.0580  
+#> 
+ryegrass.m1  # gives the same output as the previous line
+#> 
+#> A 'drc' model.
+#> 
+#> Call:
+#> drm(formula = rootl ~ conc, data = ryegrass, fct = LL.4())
+#> 
+#> Coefficients:
+#> b:(Intercept)  c:(Intercept)  d:(Intercept)  e:(Intercept)  
+#>        2.9822         0.4814         7.7930         3.0580  
+#> 
+
+
    +
    - 
    # S3 method for drc
-print(x, ..., digits = max(3, getOption("digits") - 3))
    - -

    Arguments

    - - - - - - - - - - - - - - -
    x

    an object of class 'drc'.

    ...

    additional arguments.

    digits

    an integer giving the number of digits of the parameter coefficients. Default is 3.

    - - -

    Examples

    - 
    
-## Fitting a four-parameter log-logistic model
-ryegrass.m1 <- drm(rootl ~conc, data = ryegrass, fct = LL.4())
-
-## Displaying the model fit
-print(ryegrass.m1)
    #> 
-#> A 'drc' model.
-#> 
-#> Call:
-#> drm(formula = rootl ~ conc, data = ryegrass, fct = LL.4())
-#> 
-#> Coefficients:
-#> b:(Intercept)  c:(Intercept)  d:(Intercept)  e:(Intercept)  
-#>        2.9822         0.4814         7.7930         3.0580  
-#> 
    ryegrass.m1  # gives the same output as the previous line
    #> 
-#> A 'drc' model.
-#> 
-#> Call:
-#> drm(formula = rootl ~ conc, data = ryegrass, fct = LL.4())
-#> 
-#> Coefficients:
-#> b:(Intercept)  c:(Intercept)  d:(Intercept)  e:(Intercept)  
-#>        2.9822         0.4814         7.7930         3.0580  
-#> 
    
-
    -
    - - -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -

    Site built with pkgdown.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -
    +
    + + + - - - + diff --git a/docs/reference/print.drc.md b/docs/reference/print.drc.md new file mode 100644 index 00000000..dc83da1f --- /dev/null +++ b/docs/reference/print.drc.md @@ -0,0 +1,64 @@ +# Printing key features + +`print` displays brief information on an object of class 'drc'. + +## Usage + +``` r +# S3 method for class 'drc' +print(x, ..., digits = max(3, getOption("digits") - 3)) +``` + +## Arguments + +- x: + + an object of class 'drc'. + +- ...: + + additional arguments. + +- digits: + + an integer giving the number of digits of the parameter coefficients. + Default is 3. + +## Value + +The object is returned invisibly. + +## Author + +Christian Ritz + +## Examples + +``` r +## Fitting a four-parameter log-logistic model +ryegrass.m1 <- drm(rootl ~conc, data = ryegrass, fct = LL.4()) + +## Displaying the model fit +print(ryegrass.m1) +#> +#> A 'drc' model. +#> +#> Call: +#> drm(formula = rootl ~ conc, data = ryegrass, fct = LL.4()) +#> +#> Coefficients: +#> b:(Intercept) c:(Intercept) d:(Intercept) e:(Intercept) +#> 2.9822 0.4814 7.7930 3.0580 +#> +ryegrass.m1 # gives the same output as the previous line +#> +#> A 'drc' model. +#> +#> Call: +#> drm(formula = rootl ~ conc, data = ryegrass, fct = LL.4()) +#> +#> Coefficients: +#> b:(Intercept) c:(Intercept) d:(Intercept) e:(Intercept) +#> 2.9822 0.4814 7.7930 3.0580 +#> +``` diff --git a/docs/reference/print.summary.drc.html b/docs/reference/print.summary.drc.html index 2418c4fc..a01d1f5c 100644 --- a/docs/reference/print.summary.drc.html +++ b/docs/reference/print.summary.drc.html @@ -1,182 +1,119 @@ - - - - - - +Printing summary of non-linear model fits — print.summary.drc • drc + Skip to contents -Printing summary of non-linear model fits — print.summary.drc • drc - - - +
    +
    +
    +

    Printing summary of non-linear model fits

    + Source: R/print.summary.drc.R +
    print.summary.drc.Rd
    +
    - - - - +
    +

    This method produces formatted output of the summary statistics: parameter estimates, +estimated standard errors, z-test statistics and corresponding p-values.

    +
    +
    +

    Usage

    + 
    # S3 method for class 'summary.drc'
+print(x, ...)
    +
    +
    +

    Arguments

    - - - +
    x
    +

    an object of class 'drc'.

    - +
    ...
    +

    additional arguments.

    - -
    -
    -
    +
    +

    Value

    +

    The object (argument x) is returned invisibly.

    - - -
    -
    - - - - -
    -
    -
    -

    Printing summary of non-linear model fits

    - - +
    +

    Author

    +

    Christian Ritz

    -
    - -

    This method produces formatted output of the summary statistics: parameter estimates, estimated standard errors, - z-test statistics and corresponding p-values.

    - +
    +

    Examples

    + 
    ryegrass.m1 <- drm(rootl~conc, data=ryegrass, fct= LL.4())
+
+summary(ryegrass.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept)  2.98222    0.46506  6.4125 2.960e-06 ***
+#> c:(Intercept)  0.48141    0.21219  2.2688   0.03451 *  
+#> d:(Intercept)  7.79296    0.18857 41.3272 < 2.2e-16 ***
+#> e:(Intercept)  3.05795    0.18573 16.4644 4.268e-13 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.5196256 (20 degrees of freedom)
+
+
    +
    - 
    # S3 method for summary.drc
-print(x, ...)
    - -

    Arguments

    - - - - - - - - - - -
    x

    an object of class 'drc'.

    ...

    additional arguments.

    - -

    Value

    -

    The object (argument x) is returned invisibly.

    - - -

    Examples

    - 
    
-ryegrass.m1 <- drm(rootl~conc, data=ryegrass, fct= LL.4())
-
-summary(ryegrass.m1)
    #> 
-#> Model fitted: Log-logistic (ED50 as parameter) (4 parms)
-#> 
-#> Parameter estimates:
-#> 
-#>               Estimate Std. Error t-value   p-value    
-#> b:(Intercept)  2.98222    0.46506  6.4125 2.960e-06 ***
-#> c:(Intercept)  0.48141    0.21219  2.2688   0.03451 *  
-#> d:(Intercept)  7.79296    0.18857 41.3272 < 2.2e-16 ***
-#> e:(Intercept)  3.05795    0.18573 16.4644 4.268e-13 ***
-#> ---
-#> Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
-#> 
-#> Residual standard error:
-#> 
-#>  0.5196256 (20 degrees of freedom)
    
-
    -
    - +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + - -
    - - - + diff --git a/docs/reference/print.summary.drc.md b/docs/reference/print.summary.drc.md new file mode 100644 index 00000000..38397b9d --- /dev/null +++ b/docs/reference/print.summary.drc.md @@ -0,0 +1,54 @@ +# Printing summary of non-linear model fits + +This method produces formatted output of the summary statistics: +parameter estimates, estimated standard errors, z-test statistics and +corresponding p-values. + +## Usage + +``` r +# S3 method for class 'summary.drc' +print(x, ...) +``` + +## Arguments + +- x: + + an object of class 'drc'. + +- ...: + + additional arguments. + +## Value + +The object (argument `x`) is returned invisibly. + +## Author + +Christian Ritz + +## Examples + +``` r +ryegrass.m1 <- drm(rootl~conc, data=ryegrass, fct= LL.4()) + +summary(ryegrass.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 2.98222 0.46506 6.4125 2.960e-06 *** +#> c:(Intercept) 0.48141 0.21219 2.2688 0.03451 * +#> d:(Intercept) 7.79296 0.18857 41.3272 < 2.2e-16 *** +#> e:(Intercept) 3.05795 0.18573 16.4644 4.268e-13 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.5196256 (20 degrees of freedom) +``` diff --git a/docs/reference/rdrm.html b/docs/reference/rdrm.html index f76abf70..b5379685 100644 --- a/docs/reference/rdrm.html +++ b/docs/reference/rdrm.html @@ -1,331 +1,270 @@ - - - - - - +Simulating a dose-response curve — rdrm • drc + Skip to contents -Simulating a dose-response curve — rdrm • drc - - - +
    +
    +
    +

    Simulating a dose-response curve

    + Source: R/rdrm.R +
    rdrm.Rd
    +
    - +
    +

    Simulation of a dose-response curve with user-specified dose values and error distribution.

    +
    - - +
    +

    Usage

    + 
    rdrm(
+  nosim,
+  fct,
+  mpar,
+  xerror,
+  xpar = 1,
+  yerror = "rnorm",
+  ypar = c(0, 1),
+  onlyY = FALSE
+)
    +
    +
    +

    Arguments

    - - +
    nosim
    +

    numeric. The number of simulated curves to be returned.

    - +
    fct
    +

    list. Any built-in function in the package drc or a list with similar +components.

    - - -
    -
    - - - -
    -
    -
    -
    -

    Simulating a dose-response curve

    - - +
    xerror
    +

    numeric or character. The distribution for the dose values.

    + + +
    xpar
    +

    numeric vector supplying the parameter values defining the distribution for the +dose values. If xerror is a distribution then remember that the number of dose +values also is part of this argument (the first argument).

    + + +
    yerror
    +

    numeric or character. The error distribution for the response values.

    + + +
    ypar
    +

    numeric vector supplying the parameter values defining the error distribution +for the response values.

    + + +
    onlyY
    +

    logical. If TRUE then only the response values are returned (useful in +simulations). Otherwise both dose values and response values (and for binomial data also +the weights) are returned.

    + +
    +
    +

    Value

    +

    A list with up to 3 components (depending on the value of the onlyY argument).

    +
    +
    +

    Details

    +

    The distribution for the dose values can either be a fixed set of dose values (a numeric +vector) used repeatedly for creating all curves or be a distribution specified as a +character string resulting in varying dose values from curve to curve.

    +

    The error distribution for the response values can be any continuous distribution +like rnorm or rgamma. Alternatively it can be the binomial +distribution rbinom.

    +
    +
    +

    Author

    +

    Christian Ritz

    -
    - -

    Simulation of a dose-response curve with user-specified dose values and error distribution.

    - +
    +

    Examples

    + 
    ## Simulating normally distributed dose-response data
+
+## Model fit to simulate from
+ryegrass.m1 <- drm(rootl~conc, data = ryegrass, fct = LL.4())
+
+## 10 random dose-response curves based on the model fit
+sim10a <- rdrm(10, LL.4(), coef(ryegrass.m1), xerror = ryegrass$conc)
+sim10a
+#> $x
+#>       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
+#>  [1,]    0    0    0    0    0    0 0.94 0.94 0.94  1.88  1.88  1.88  3.75
+#>  [2,]    0    0    0    0    0    0 0.94 0.94 0.94  1.88  1.88  1.88  3.75
+#>  [3,]    0    0    0    0    0    0 0.94 0.94 0.94  1.88  1.88  1.88  3.75
+#>  [4,]    0    0    0    0    0    0 0.94 0.94 0.94  1.88  1.88  1.88  3.75
+#>  [5,]    0    0    0    0    0    0 0.94 0.94 0.94  1.88  1.88  1.88  3.75
+#>  [6,]    0    0    0    0    0    0 0.94 0.94 0.94  1.88  1.88  1.88  3.75
+#>  [7,]    0    0    0    0    0    0 0.94 0.94 0.94  1.88  1.88  1.88  3.75
+#>  [8,]    0    0    0    0    0    0 0.94 0.94 0.94  1.88  1.88  1.88  3.75
+#>  [9,]    0    0    0    0    0    0 0.94 0.94 0.94  1.88  1.88  1.88  3.75
+#> [10,]    0    0    0    0    0    0 0.94 0.94 0.94  1.88  1.88  1.88  3.75
+#>       [,14] [,15] [,16] [,17] [,18] [,19] [,20] [,21] [,22] [,23] [,24]
+#>  [1,]  3.75  3.75   7.5   7.5   7.5    15    15    15    30    30    30
+#>  [2,]  3.75  3.75   7.5   7.5   7.5    15    15    15    30    30    30
+#>  [3,]  3.75  3.75   7.5   7.5   7.5    15    15    15    30    30    30
+#>  [4,]  3.75  3.75   7.5   7.5   7.5    15    15    15    30    30    30
+#>  [5,]  3.75  3.75   7.5   7.5   7.5    15    15    15    30    30    30
+#>  [6,]  3.75  3.75   7.5   7.5   7.5    15    15    15    30    30    30
+#>  [7,]  3.75  3.75   7.5   7.5   7.5    15    15    15    30    30    30
+#>  [8,]  3.75  3.75   7.5   7.5   7.5    15    15    15    30    30    30
+#>  [9,]  3.75  3.75   7.5   7.5   7.5    15    15    15    30    30    30
+#> [10,]  3.75  3.75   7.5   7.5   7.5    15    15    15    30    30    30
+#> 
+#> $y
+#>           [,1]     [,2]     [,3]     [,4]     [,5]     [,6]     [,7]     [,8]
+#>  [1,] 8.066417 7.161786 7.222872 7.433376 7.642343 7.093628 7.923545 8.284291
+#>  [2,] 7.505974 6.078136 6.503759 9.352759 8.065649 6.720029 5.781844 9.058972
+#>  [3,] 8.327354 8.645831 8.467516 6.698238 7.510698 7.972966 6.409988 8.056339
+#>  [4,] 9.096690 7.312124 7.864879 8.735890 7.560072 7.266967 6.735318 7.963788
+#>  [5,] 7.258083 7.368628 7.055604 7.881555 9.301122 7.410662 8.285907 5.714209
+#>  [6,] 8.925786 8.569848 8.836314 6.614582 6.187379 9.516748 7.477650 7.078747
+#>  [7,] 7.756834 7.929422 8.581864 7.078809 7.346530 8.146883 9.577975 6.928401
+#>  [8,] 6.745958 7.191619 7.892295 8.153598 7.667378 8.120790 7.654978 5.718323
+#>  [9,] 6.821557 7.894365 8.438348 7.674455 6.469690 6.945612 9.229277 8.995717
+#> [10,] 6.432471 6.722794 8.476714 7.572785 7.125783 9.020141 8.071111 6.930408
+#>           [,9]    [,10]    [,11]    [,12]    [,13]    [,14]    [,15]
+#>  [1,] 7.682404 5.945141 7.216933 6.672380 3.534480 3.682829 2.271530
+#>  [2,] 7.918867 7.208031 5.846323 6.933062 2.748299 2.012915 4.586617
+#>  [3,] 7.368475 5.145932 7.872643 7.086995 2.439913 4.865038 3.591403
+#>  [4,] 7.136487 4.542725 5.603221 7.256139 3.473104 2.556701 2.730241
+#>  [5,] 7.198957 5.342127 7.880616 5.818385 4.857711 3.314165 3.127980
+#>  [6,] 7.839711 5.641550 4.678501 6.531467 4.267781 2.426996 3.342862
+#>  [7,] 9.595229 4.304123 6.371873 6.219813 3.506707 1.541592 2.231613
+#>  [8,] 6.915723 6.990295 9.310118 7.827924 3.052878 2.193345 2.968142
+#>  [9,] 8.450324 4.982754 7.405585 5.090363 3.405927 3.903577 2.018578
+#> [10,] 8.549147 5.522101 7.072001 7.075904 3.291795 3.194503 3.627527
+#>              [,16]      [,17]     [,18]      [,19]      [,20]       [,21]
+#>  [1,] -0.140879059  0.9380080 0.8254205  1.0379614  0.7350702  1.45249011
+#>  [2,]  0.191662263  0.4805241 1.1798748  1.1113034  1.1001285  0.35779707
+#>  [3,]  1.240025609 -0.4437699 1.7199829  1.0841137 -1.1948623  1.45354148
+#>  [4,]  0.187723805 -0.7442005 0.4908456 -0.1032920  0.4326651  1.23307403
+#>  [5,] -0.917179274  2.0086702 0.3563959  0.5159329 -0.0761879 -1.53666510
+#>  [6,]  2.007846286  1.3812106 1.1360886  1.2690461  1.2988363  1.29623123
+#>  [7,]  1.187094786  0.5637970 2.4621087 -0.5056758 -0.1282062  1.85899709
+#>  [8,]  0.610012833  0.7283811 0.4562212  1.9244428  1.1058905  1.56657138
+#>  [9,]  2.431699280  1.4385857 3.1617329  1.3540638  0.3321539  1.58547389
+#> [10,]  0.008404434  1.3859897 0.9772450 -0.3431308 -0.4085134  0.03729916
+#>            [,22]       [,23]      [,24]
+#>  [1,] -0.4207740  1.16833992 -0.1482707
+#>  [2,]  1.3377319 -1.38459417  0.1999361
+#>  [3,]  1.1004658  0.63946903  1.6297087
+#>  [4,]  0.1653214  0.84414207 -0.1439696
+#>  [5,]  0.9388422  1.83629562  1.9284379
+#>  [6,]  0.2781959 -0.04695046 -0.5979337
+#>  [7,]  0.9842609 -0.02732443  1.7252574
+#>  [8,] -1.2229484  1.57082584  0.4368156
+#>  [9,]  0.4443086 -0.01412220  2.4056532
+#> [10,] -0.4591859 -1.80289191  0.1164907
+#> 
+
+## Simulating binomial dose-response data
+
+## Model fit to simulate from
+deguelin.m1 <- drm(r/n~dose, weights=n, data=deguelin, fct=LL.2(), type="binomial")
+
+## 10 random dose-response curves
+sim10b <- rdrm(10, LL.2(), coef(deguelin.m1), deguelin$dose, yerror="rbinom", ypar=deguelin$n)
+sim10b
+#> $x
+#>           [,1] [,2]     [,3]     [,4]     [,5]     [,6]
+#>  [1,] 5.128614   10 20.41738 30.19952 40.73803 50.11872
+#>  [2,] 5.128614   10 20.41738 30.19952 40.73803 50.11872
+#>  [3,] 5.128614   10 20.41738 30.19952 40.73803 50.11872
+#>  [4,] 5.128614   10 20.41738 30.19952 40.73803 50.11872
+#>  [5,] 5.128614   10 20.41738 30.19952 40.73803 50.11872
+#>  [6,] 5.128614   10 20.41738 30.19952 40.73803 50.11872
+#>  [7,] 5.128614   10 20.41738 30.19952 40.73803 50.11872
+#>  [8,] 5.128614   10 20.41738 30.19952 40.73803 50.11872
+#>  [9,] 5.128614   10 20.41738 30.19952 40.73803 50.11872
+#> [10,] 5.128614   10 20.41738 30.19952 40.73803 50.11872
+#> 
+#> $w
+#>       [,1] [,2] [,3] [,4] [,5] [,6]
+#>  [1,]   49   48   48   49   50   48
+#>  [2,]   49   48   48   49   50   48
+#>  [3,]   49   48   48   49   50   48
+#>  [4,]   49   48   48   49   50   48
+#>  [5,]   49   48   48   49   50   48
+#>  [6,]   49   48   48   49   50   48
+#>  [7,]   49   48   48   49   50   48
+#>  [8,]   49   48   48   49   50   48
+#>  [9,]   49   48   48   49   50   48
+#> [10,]   49   48   48   49   50   48
+#> 
+#> $y
+#>       [,1] [,2] [,3] [,4] [,5] [,6]
+#>  [1,]    9   29   39   42   48   44
+#>  [2,]   14   24   40   44   48   48
+#>  [3,]   13   24   39   41   45   45
+#>  [4,]   12   19   39   44   43   43
+#>  [5,]    5   28   36   43   42   42
+#>  [6,]   11   25   45   38   47   47
+#>  [7,]    9   20   41   40   49   47
+#>  [8,]    9   25   38   43   48   45
+#>  [9,]   11   30   38   46   47   46
+#> [10,]   11   20   36   44   48   44
+#> 
+
+
    +
    - 
    rdrm(nosim, fct, mpar, xerror, xpar = 1, yerror = "rnorm", ypar = c(0, 1),
-  onlyY = FALSE)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    nosim

    numeric. The number of simulated curves to be returned.

    fct

    list. Any built-in function in the package drc or a list with similar components.

    mpar

    numeric. The model parameters to be supplied to fct.

    xerror

    numeric or character. The distribution for the dose values.

    xpar

    numeric vector supplying the parameter values defining the distribution for the dose values. - If xerror is a distribution then remember that the number of dose values also is part of this argument - (the first argument).

    yerror

    numeric or character. The error distribution for the response values.

    ypar

    numeric vector supplying the parameter values defining the error distribution for the - response values.

    onlyY

    logical. If TRUE then only the response values are returned (useful in simulations). - Otherwise both dose values and response values (and for binomial data also the weights) are returned.

    - -

    Details

    - -

    The distribution for the dose values can either be a fixed set of dose values (a numeric vector) - used repeatedly for creating all curves or be a distribution specified as a character string resulting in - varying dose values from curve to curve.

    -

    The error distribution for the response values can be any continuous distribution - like rnorm or rgamma. Alternatively it can be the binomial distribution - rbinom.

    - -

    Value

    -

    A list with up to 3 components (depending on the value of the onlyY argument).

    - -

    References

    - -

    ~put references to the literature/web site here ~

    - - -

    Examples

    - 
    
-## Simulating normally distributed dose-response data
-
-## Model fit to simulate from
-ryegrass.m1 <- drm(rootl~conc, data = ryegrass, fct = LL.4())
-
-## 10 random dose-response curves based on the model fit
-sim10a <- rdrm(10, LL.4(), coef(ryegrass.m1), xerror = ryegrass$conc)
-sim10a
    #> $x
-#>       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
-#>  [1,]    0    0    0    0    0    0 0.94 0.94 0.94  1.88  1.88  1.88  3.75
-#>  [2,]    0    0    0    0    0    0 0.94 0.94 0.94  1.88  1.88  1.88  3.75
-#>  [3,]    0    0    0    0    0    0 0.94 0.94 0.94  1.88  1.88  1.88  3.75
-#>  [4,]    0    0    0    0    0    0 0.94 0.94 0.94  1.88  1.88  1.88  3.75
-#>  [5,]    0    0    0    0    0    0 0.94 0.94 0.94  1.88  1.88  1.88  3.75
-#>  [6,]    0    0    0    0    0    0 0.94 0.94 0.94  1.88  1.88  1.88  3.75
-#>  [7,]    0    0    0    0    0    0 0.94 0.94 0.94  1.88  1.88  1.88  3.75
-#>  [8,]    0    0    0    0    0    0 0.94 0.94 0.94  1.88  1.88  1.88  3.75
-#>  [9,]    0    0    0    0    0    0 0.94 0.94 0.94  1.88  1.88  1.88  3.75
-#> [10,]    0    0    0    0    0    0 0.94 0.94 0.94  1.88  1.88  1.88  3.75
-#>       [,14] [,15] [,16] [,17] [,18] [,19] [,20] [,21] [,22] [,23] [,24]
-#>  [1,]  3.75  3.75   7.5   7.5   7.5    15    15    15    30    30    30
-#>  [2,]  3.75  3.75   7.5   7.5   7.5    15    15    15    30    30    30
-#>  [3,]  3.75  3.75   7.5   7.5   7.5    15    15    15    30    30    30
-#>  [4,]  3.75  3.75   7.5   7.5   7.5    15    15    15    30    30    30
-#>  [5,]  3.75  3.75   7.5   7.5   7.5    15    15    15    30    30    30
-#>  [6,]  3.75  3.75   7.5   7.5   7.5    15    15    15    30    30    30
-#>  [7,]  3.75  3.75   7.5   7.5   7.5    15    15    15    30    30    30
-#>  [8,]  3.75  3.75   7.5   7.5   7.5    15    15    15    30    30    30
-#>  [9,]  3.75  3.75   7.5   7.5   7.5    15    15    15    30    30    30
-#> [10,]  3.75  3.75   7.5   7.5   7.5    15    15    15    30    30    30
-#> 
-#> $y
-#>           [,1]     [,2]     [,3]     [,4]     [,5]     [,6]     [,7]     [,8]
-#>  [1,] 6.504645 6.326134 5.334205 7.721202 9.280034 8.953097 8.703807 7.333097
-#>  [2,] 6.420938 9.161273 6.536564 7.337932 8.386111 7.967100 6.042894 8.796776
-#>  [3,] 7.414667 7.698021 7.028222 9.195544 6.626636 7.150189 7.447056 7.527533
-#>  [4,] 7.017743 7.495155 7.560129 9.241746 8.414481 7.207792 6.760996 6.809115
-#>  [5,] 9.183904 7.089027 7.374186 6.748351 6.399402 7.604708 7.790634 6.241715
-#>  [6,] 6.134385 7.303266 7.847950 8.040487 9.282043 8.071802 7.753336 5.879548
-#>  [7,] 8.490428 7.052179 7.388594 7.561643 8.870711 6.718094 7.597215 7.018335
-#>  [8,] 5.947482 7.518250 7.690510 7.762480 7.360530 7.197111 7.051964 7.325444
-#>  [9,] 7.275794 7.330922 8.238051 8.001791 7.889586 8.739220 6.651174 7.463123
-#> [10,] 8.675090 7.771790 8.066295 9.090500 6.165093 5.745235 9.189518 6.900071
-#>            [,9]    [,10]    [,11]    [,12]     [,13]    [,14]    [,15]
-#>  [1,]  6.570567 5.612329 8.439093 5.725059 4.6255186 4.136818 2.847341
-#>  [2,]  8.912928 5.837975 5.809030 5.885423 1.2847168 2.656616 4.135515
-#>  [3,]  6.975992 6.776143 5.970530 7.495005 1.3256084 2.932646 5.392964
-#>  [4,]  6.955902 6.197190 6.544389 4.809748 4.5259949 3.442191 2.201608
-#>  [5,]  7.766050 6.081771 6.320336 6.096133 0.8870236 2.843685 3.247255
-#>  [6,]  7.702998 6.966522 7.664001 6.077113 3.7001785 3.243735 2.575318
-#>  [7,]  8.607236 7.167234 6.508569 5.501808 3.3235976 3.972992 2.751160
-#>  [8,] 10.278203 7.473212 6.522847 6.964712 3.1802275 2.223553 3.608103
-#>  [9,]  6.822510 5.916967 5.559288 5.928278 2.1638781 1.529925 4.733718
-#> [10,]  7.467960 6.556054 5.234875 5.667755 5.0065202 2.121485 3.979983
-#>            [,16]      [,17]      [,18]      [,19]       [,20]      [,21]
-#>  [1,] -0.1772826  1.4946823 1.07618626  0.5701545 -0.79956605  0.8410635
-#>  [2,]  1.8225973  2.4251136 1.35403261  1.5643747 -0.19840579  0.4945068
-#>  [3,]  2.4672549 -0.3663400 1.21427588 -0.8536887  0.18719848  1.3170112
-#>  [4,]  2.6203378  0.5224968 0.78408026  1.6771057  1.32744970  0.7337417
-#>  [5,]  0.4195733 -1.4093856 1.65943262  1.5170427  0.02742336 -0.2350584
-#>  [6,]  1.3925381  0.2880446 0.52271382  0.6178868  0.56556894  1.3782432
-#>  [7,]  1.1363785  2.0036613 0.07354404  1.1129297  0.95959186  0.9374834
-#>  [8,]  0.6957562  1.8322343 2.42254184  0.3288058  1.27139695  0.3331472
-#>  [9,]  0.1789984  1.2700344 1.41729933  0.8824420  0.78596437  1.4537650
-#> [10,]  1.0334706 -0.0352803 3.65460642 -0.5870528 -1.25933144  2.1941271
-#>             [,22]      [,23]      [,24]
-#>  [1,]  1.64332715  0.8393622  1.1101611
-#>  [2,]  0.40815097 -0.5670276  1.1362685
-#>  [3,] -0.34331827  1.6551181 -0.6208794
-#>  [4,] -1.13885533  0.9022009  2.3675480
-#>  [5,] -0.03425121  0.9520896  0.3430201
-#>  [6,]  0.18861683  0.2546174  1.2096681
-#>  [7,]  0.95328850  0.4604991 -1.0384838
-#>  [8,]  0.01987101 -0.6476905  0.2563355
-#>  [9,]  1.81413736 -0.3708223 -0.9416715
-#> [10,] -0.18689642 -0.3632936  1.1226729
-#> 
    
-
-## Simulating binomial dose-response data
-
-## Model fit to simulate from
-deguelin.m1 <- drm(r/n~dose, weights=n, data=deguelin, fct=LL.2(), type="binomial")
-
-## 10 random dose-response curves
-sim10b <- rdrm(10, LL.2(), coef(deguelin.m1), deguelin$dose, yerror="rbinom", ypar=deguelin$n)
-sim10b
    #> $x
-#>           [,1] [,2]     [,3]     [,4]     [,5]     [,6]
-#>  [1,] 5.128614   10 20.41738 30.19952 40.73803 50.11872
-#>  [2,] 5.128614   10 20.41738 30.19952 40.73803 50.11872
-#>  [3,] 5.128614   10 20.41738 30.19952 40.73803 50.11872
-#>  [4,] 5.128614   10 20.41738 30.19952 40.73803 50.11872
-#>  [5,] 5.128614   10 20.41738 30.19952 40.73803 50.11872
-#>  [6,] 5.128614   10 20.41738 30.19952 40.73803 50.11872
-#>  [7,] 5.128614   10 20.41738 30.19952 40.73803 50.11872
-#>  [8,] 5.128614   10 20.41738 30.19952 40.73803 50.11872
-#>  [9,] 5.128614   10 20.41738 30.19952 40.73803 50.11872
-#> [10,] 5.128614   10 20.41738 30.19952 40.73803 50.11872
-#> 
-#> $w
-#>       [,1] [,2] [,3] [,4] [,5] [,6]
-#>  [1,]   49   48   48   49   50   48
-#>  [2,]   49   48   48   49   50   48
-#>  [3,]   49   48   48   49   50   48
-#>  [4,]   49   48   48   49   50   48
-#>  [5,]   49   48   48   49   50   48
-#>  [6,]   49   48   48   49   50   48
-#>  [7,]   49   48   48   49   50   48
-#>  [8,]   49   48   48   49   50   48
-#>  [9,]   49   48   48   49   50   48
-#> [10,]   49   48   48   49   50   48
-#> 
-#> $y
-#>       [,1] [,2] [,3] [,4] [,5] [,6]
-#>  [1,]    7   17   35   44   45   46
-#>  [2,]   18   30   41   45   47   46
-#>  [3,]   14   26   37   41   48   48
-#>  [4,]    9   27   37   41   46   45
-#>  [5,]    9   16   41   46   48   47
-#>  [6,]    8   18   39   49   45   47
-#>  [7,]   12   21   32   42   49   47
-#>  [8,]   17   26   38   47   48   45
-#>  [9,]   10   27   34   42   47   47
-#> [10,]   12   22   37   45   46   47
-#> 
    
-
    -
    - +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + -
    - - - - + diff --git a/docs/reference/rdrm.md b/docs/reference/rdrm.md new file mode 100644 index 00000000..5e811b0d --- /dev/null +++ b/docs/reference/rdrm.md @@ -0,0 +1,213 @@ +# Simulating a dose-response curve + +Simulation of a dose-response curve with user-specified dose values and +error distribution. + +## Usage + +``` r +rdrm( + nosim, + fct, + mpar, + xerror, + xpar = 1, + yerror = "rnorm", + ypar = c(0, 1), + onlyY = FALSE +) +``` + +## Arguments + +- nosim: + + numeric. The number of simulated curves to be returned. + +- fct: + + list. Any built-in function in the package *drc* or a list with + similar components. + +- mpar: + + numeric. The model parameters to be supplied to `fct`. + +- xerror: + + numeric or character. The distribution for the dose values. + +- xpar: + + numeric vector supplying the parameter values defining the + distribution for the dose values. If `xerror` is a distribution then + remember that the number of dose values also is part of this argument + (the first argument). + +- yerror: + + numeric or character. The error distribution for the response values. + +- ypar: + + numeric vector supplying the parameter values defining the error + distribution for the response values. + +- onlyY: + + logical. If TRUE then only the response values are returned (useful in + simulations). Otherwise both dose values and response values (and for + binomial data also the weights) are returned. + +## Value + +A list with up to 3 components (depending on the value of the `onlyY` +argument). + +## Details + +The distribution for the dose values can either be a fixed set of dose +values (a numeric vector) used repeatedly for creating all curves or be +a distribution specified as a character string resulting in varying dose +values from curve to curve. + +The error distribution for the response values can be any continuous +distribution like [`rnorm`](https://rdrr.io/r/stats/Normal.html) or +[`rgamma`](https://rdrr.io/r/stats/GammaDist.html). Alternatively it can +be the binomial distribution +[`rbinom`](https://rdrr.io/r/stats/Binomial.html). + +## Author + +Christian Ritz + +## Examples + +``` r +## Simulating normally distributed dose-response data + +## Model fit to simulate from +ryegrass.m1 <- drm(rootl~conc, data = ryegrass, fct = LL.4()) + +## 10 random dose-response curves based on the model fit +sim10a <- rdrm(10, LL.4(), coef(ryegrass.m1), xerror = ryegrass$conc) +sim10a +#> $x +#> [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] +#> [1,] 0 0 0 0 0 0 0.94 0.94 0.94 1.88 1.88 1.88 3.75 +#> [2,] 0 0 0 0 0 0 0.94 0.94 0.94 1.88 1.88 1.88 3.75 +#> [3,] 0 0 0 0 0 0 0.94 0.94 0.94 1.88 1.88 1.88 3.75 +#> [4,] 0 0 0 0 0 0 0.94 0.94 0.94 1.88 1.88 1.88 3.75 +#> [5,] 0 0 0 0 0 0 0.94 0.94 0.94 1.88 1.88 1.88 3.75 +#> [6,] 0 0 0 0 0 0 0.94 0.94 0.94 1.88 1.88 1.88 3.75 +#> [7,] 0 0 0 0 0 0 0.94 0.94 0.94 1.88 1.88 1.88 3.75 +#> [8,] 0 0 0 0 0 0 0.94 0.94 0.94 1.88 1.88 1.88 3.75 +#> [9,] 0 0 0 0 0 0 0.94 0.94 0.94 1.88 1.88 1.88 3.75 +#> [10,] 0 0 0 0 0 0 0.94 0.94 0.94 1.88 1.88 1.88 3.75 +#> [,14] [,15] [,16] [,17] [,18] [,19] [,20] [,21] [,22] [,23] [,24] +#> [1,] 3.75 3.75 7.5 7.5 7.5 15 15 15 30 30 30 +#> [2,] 3.75 3.75 7.5 7.5 7.5 15 15 15 30 30 30 +#> [3,] 3.75 3.75 7.5 7.5 7.5 15 15 15 30 30 30 +#> [4,] 3.75 3.75 7.5 7.5 7.5 15 15 15 30 30 30 +#> [5,] 3.75 3.75 7.5 7.5 7.5 15 15 15 30 30 30 +#> [6,] 3.75 3.75 7.5 7.5 7.5 15 15 15 30 30 30 +#> [7,] 3.75 3.75 7.5 7.5 7.5 15 15 15 30 30 30 +#> [8,] 3.75 3.75 7.5 7.5 7.5 15 15 15 30 30 30 +#> [9,] 3.75 3.75 7.5 7.5 7.5 15 15 15 30 30 30 +#> [10,] 3.75 3.75 7.5 7.5 7.5 15 15 15 30 30 30 +#> +#> $y +#> [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] +#> [1,] 8.066417 7.161786 7.222872 7.433376 7.642343 7.093628 7.923545 8.284291 +#> [2,] 7.505974 6.078136 6.503759 9.352759 8.065649 6.720029 5.781844 9.058972 +#> [3,] 8.327354 8.645831 8.467516 6.698238 7.510698 7.972966 6.409988 8.056339 +#> [4,] 9.096690 7.312124 7.864879 8.735890 7.560072 7.266967 6.735318 7.963788 +#> [5,] 7.258083 7.368628 7.055604 7.881555 9.301122 7.410662 8.285907 5.714209 +#> [6,] 8.925786 8.569848 8.836314 6.614582 6.187379 9.516748 7.477650 7.078747 +#> [7,] 7.756834 7.929422 8.581864 7.078809 7.346530 8.146883 9.577975 6.928401 +#> [8,] 6.745958 7.191619 7.892295 8.153598 7.667378 8.120790 7.654978 5.718323 +#> [9,] 6.821557 7.894365 8.438348 7.674455 6.469690 6.945612 9.229277 8.995717 +#> [10,] 6.432471 6.722794 8.476714 7.572785 7.125783 9.020141 8.071111 6.930408 +#> [,9] [,10] [,11] [,12] [,13] [,14] [,15] +#> [1,] 7.682404 5.945141 7.216933 6.672380 3.534480 3.682829 2.271530 +#> [2,] 7.918867 7.208031 5.846323 6.933062 2.748299 2.012915 4.586617 +#> [3,] 7.368475 5.145932 7.872643 7.086995 2.439913 4.865038 3.591403 +#> [4,] 7.136487 4.542725 5.603221 7.256139 3.473104 2.556701 2.730241 +#> [5,] 7.198957 5.342127 7.880616 5.818385 4.857711 3.314165 3.127980 +#> [6,] 7.839711 5.641550 4.678501 6.531467 4.267781 2.426996 3.342862 +#> [7,] 9.595229 4.304123 6.371873 6.219813 3.506707 1.541592 2.231613 +#> [8,] 6.915723 6.990295 9.310118 7.827924 3.052878 2.193345 2.968142 +#> [9,] 8.450324 4.982754 7.405585 5.090363 3.405927 3.903577 2.018578 +#> [10,] 8.549147 5.522101 7.072001 7.075904 3.291795 3.194503 3.627527 +#> [,16] [,17] [,18] [,19] [,20] [,21] +#> [1,] -0.140879059 0.9380080 0.8254205 1.0379614 0.7350702 1.45249011 +#> [2,] 0.191662263 0.4805241 1.1798748 1.1113034 1.1001285 0.35779707 +#> [3,] 1.240025609 -0.4437699 1.7199829 1.0841137 -1.1948623 1.45354148 +#> [4,] 0.187723805 -0.7442005 0.4908456 -0.1032920 0.4326651 1.23307403 +#> [5,] -0.917179274 2.0086702 0.3563959 0.5159329 -0.0761879 -1.53666510 +#> [6,] 2.007846286 1.3812106 1.1360886 1.2690461 1.2988363 1.29623123 +#> [7,] 1.187094786 0.5637970 2.4621087 -0.5056758 -0.1282062 1.85899709 +#> [8,] 0.610012833 0.7283811 0.4562212 1.9244428 1.1058905 1.56657138 +#> [9,] 2.431699280 1.4385857 3.1617329 1.3540638 0.3321539 1.58547389 +#> [10,] 0.008404434 1.3859897 0.9772450 -0.3431308 -0.4085134 0.03729916 +#> [,22] [,23] [,24] +#> [1,] -0.4207740 1.16833992 -0.1482707 +#> [2,] 1.3377319 -1.38459417 0.1999361 +#> [3,] 1.1004658 0.63946903 1.6297087 +#> [4,] 0.1653214 0.84414207 -0.1439696 +#> [5,] 0.9388422 1.83629562 1.9284379 +#> [6,] 0.2781959 -0.04695046 -0.5979337 +#> [7,] 0.9842609 -0.02732443 1.7252574 +#> [8,] -1.2229484 1.57082584 0.4368156 +#> [9,] 0.4443086 -0.01412220 2.4056532 +#> [10,] -0.4591859 -1.80289191 0.1164907 +#> + +## Simulating binomial dose-response data + +## Model fit to simulate from +deguelin.m1 <- drm(r/n~dose, weights=n, data=deguelin, fct=LL.2(), type="binomial") + +## 10 random dose-response curves +sim10b <- rdrm(10, LL.2(), coef(deguelin.m1), deguelin$dose, yerror="rbinom", ypar=deguelin$n) +sim10b +#> $x +#> [,1] [,2] [,3] [,4] [,5] [,6] +#> [1,] 5.128614 10 20.41738 30.19952 40.73803 50.11872 +#> [2,] 5.128614 10 20.41738 30.19952 40.73803 50.11872 +#> [3,] 5.128614 10 20.41738 30.19952 40.73803 50.11872 +#> [4,] 5.128614 10 20.41738 30.19952 40.73803 50.11872 +#> [5,] 5.128614 10 20.41738 30.19952 40.73803 50.11872 +#> [6,] 5.128614 10 20.41738 30.19952 40.73803 50.11872 +#> [7,] 5.128614 10 20.41738 30.19952 40.73803 50.11872 +#> [8,] 5.128614 10 20.41738 30.19952 40.73803 50.11872 +#> [9,] 5.128614 10 20.41738 30.19952 40.73803 50.11872 +#> [10,] 5.128614 10 20.41738 30.19952 40.73803 50.11872 +#> +#> $w +#> [,1] [,2] [,3] [,4] [,5] [,6] +#> [1,] 49 48 48 49 50 48 +#> [2,] 49 48 48 49 50 48 +#> [3,] 49 48 48 49 50 48 +#> [4,] 49 48 48 49 50 48 +#> [5,] 49 48 48 49 50 48 +#> [6,] 49 48 48 49 50 48 +#> [7,] 49 48 48 49 50 48 +#> [8,] 49 48 48 49 50 48 +#> [9,] 49 48 48 49 50 48 +#> [10,] 49 48 48 49 50 48 +#> +#> $y +#> [,1] [,2] [,3] [,4] [,5] [,6] +#> [1,] 9 29 39 42 48 44 +#> [2,] 14 24 40 44 48 48 +#> [3,] 13 24 39 41 45 45 +#> [4,] 12 19 39 44 43 43 +#> [5,] 5 28 36 43 42 42 +#> [6,] 11 25 45 38 47 47 +#> [7,] 9 20 41 40 49 47 +#> [8,] 9 25 38 43 48 45 +#> [9,] 11 30 38 46 47 46 +#> [10,] 11 20 36 44 48 44 +#> +``` diff --git a/docs/reference/red.fescue-1.png b/docs/reference/red.fescue-1.png new file mode 100644 index 00000000..f334c976 Binary files /dev/null and b/docs/reference/red.fescue-1.png differ diff --git a/docs/reference/red.fescue.html b/docs/reference/red.fescue.html new file mode 100644 index 00000000..47b6d505 --- /dev/null +++ b/docs/reference/red.fescue.html @@ -0,0 +1,124 @@ + +Red fescue — red.fescue • drc + Skip to contents + + +
    +
    +
    +

    Red fescue

    + +
    red.fescue.Rd
    +
    + +
    +

    Data from a dose-response experiment with red fescue (Festuca rubra). Biomass was measured at different dose levels and at two time points (day 0 and day 16).

    +
    + +
    +

    Usage

    + 
    data(red.fescue)
    +
    + +
    +

    Format

    +

    A data frame with 26 observations on the following 3 variables.

    dose
    +

    a numeric vector

    + +
    day
    +

    a numeric vector

    + +
    biomass
    +

    a numeric vector

    + + +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Displaying the data
+head(red.fescue)
+#>   dose day biomass
+#> 1    0   0    45.0
+#> 2    0   0    69.0
+#> 3    0  16   137.0
+#> 4    0  16   102.0
+#> 5    0  16   101.4
+#> 6   87  16   139.7
+
+## Fitting a four-parameter log-logistic model with separate curves per day
+red.fescue.m1 <- drm(biomass ~ dose, day, data = red.fescue, fct = LL.4())
+#> Control measurements detected for level: 0
+summary(red.fescue.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept)   2.2098     1.0445  2.1156   0.04594 *  
+#> c:(Intercept)  26.2056    12.0292  2.1785   0.04037 *  
+#> d:(Intercept) 109.0601     8.6786 12.5666 1.631e-11 ***
+#> e:(Intercept) 456.5766   185.6060  2.4599   0.02222 *  
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  25.21797 (22 degrees of freedom)
+
+## Plotting the fitted curves
+plot(red.fescue.m1, xlab = "Dose", ylab = "Biomass")
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/red.fescue.md b/docs/reference/red.fescue.md new file mode 100644 index 00000000..1433599d --- /dev/null +++ b/docs/reference/red.fescue.md @@ -0,0 +1,67 @@ +# Red fescue + +Data from a dose-response experiment with red fescue (*Festuca rubra*). +Biomass was measured at different dose levels and at two time points +(day 0 and day 16). + +## Usage + +``` r +data(red.fescue) +``` + +## Format + +A data frame with 26 observations on the following 3 variables. + +- `dose`: + + a numeric vector + +- `day`: + + a numeric vector + +- `biomass`: + + a numeric vector + +## Examples + +``` r +library(drc) + +## Displaying the data +head(red.fescue) +#> dose day biomass +#> 1 0 0 45.0 +#> 2 0 0 69.0 +#> 3 0 16 137.0 +#> 4 0 16 102.0 +#> 5 0 16 101.4 +#> 6 87 16 139.7 + +## Fitting a four-parameter log-logistic model with separate curves per day +red.fescue.m1 <- drm(biomass ~ dose, day, data = red.fescue, fct = LL.4()) +#> Control measurements detected for level: 0 +summary(red.fescue.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 2.2098 1.0445 2.1156 0.04594 * +#> c:(Intercept) 26.2056 12.0292 2.1785 0.04037 * +#> d:(Intercept) 109.0601 8.6786 12.5666 1.631e-11 *** +#> e:(Intercept) 456.5766 185.6060 2.4599 0.02222 * +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 25.21797 (22 degrees of freedom) + +## Plotting the fitted curves +plot(red.fescue.m1, xlab = "Dose", ylab = "Biomass") +``` diff --git a/docs/reference/relpot.html b/docs/reference/relpot.html new file mode 100644 index 00000000..00d81bcf --- /dev/null +++ b/docs/reference/relpot.html @@ -0,0 +1,129 @@ + +Relative potency function — relpot • drc + Skip to contents + + +
    +
    +
    +

    Relative potency function

    + Source: R/relpot.R +
    relpot.Rd
    +
    + +
    +

    Calculates and optionally plots relative potency as a function of the response level +for two curves in a dose-response model, using EDcomp for the underlying comparisons.

    +
    + +
    +

    Usage

    + 
    relpot(
+  object,
+  plotit = TRUE,
+  compMatch = NULL,
+  percVec = NULL,
+  interval = "none",
+  type = c("relative", "absolute"),
+  scale = c("original", "percent", "unconstrained"),
+  ...
+)
    +
    + +
    +

    Arguments

    + + +
    object
    +

    an object of class 'drc'.

    + + +
    plotit
    +

    logical. If TRUE (default), a plot of relative potency against response level is produced.

    + + +
    compMatch
    +

    a numeric vector of length 2 specifying which two curves to compare.

    + + +
    percVec
    +

    numeric vector of response levels at which to evaluate relative potency. +If NULL, a suitable range is determined automatically.

    + + +
    interval
    +

    character string specifying confidence interval type. Default is "none".

    + + +
    type
    +

    character string. Either "relative" (default) or "absolute" response levels.

    + + +
    scale
    +

    character string. One of "original" (default), "percent", or "unconstrained".

    + + +
    ...
    +

    additional graphical arguments passed to plot.

    + +
    +
    +

    Value

    +

    An invisible list with components x, y (relative potency values), +and percVec.

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/relpot.md b/docs/reference/relpot.md new file mode 100644 index 00000000..6ed52a34 --- /dev/null +++ b/docs/reference/relpot.md @@ -0,0 +1,69 @@ +# Relative potency function + +Calculates and optionally plots relative potency as a function of the +response level for two curves in a dose-response model, using +[`EDcomp`](https://hreinwald.github.io/drc/reference/EDcomp.md) for the +underlying comparisons. + +## Usage + +``` r +relpot( + object, + plotit = TRUE, + compMatch = NULL, + percVec = NULL, + interval = "none", + type = c("relative", "absolute"), + scale = c("original", "percent", "unconstrained"), + ... +) +``` + +## Arguments + +- object: + + an object of class 'drc'. + +- plotit: + + logical. If TRUE (default), a plot of relative potency against + response level is produced. + +- compMatch: + + a numeric vector of length 2 specifying which two curves to compare. + +- percVec: + + numeric vector of response levels at which to evaluate relative + potency. If NULL, a suitable range is determined automatically. + +- interval: + + character string specifying confidence interval type. Default is + "none". + +- type: + + character string. Either "relative" (default) or "absolute" response + levels. + +- scale: + + character string. One of "original" (default), "percent", or + "unconstrained". + +- ...: + + additional graphical arguments passed to `plot`. + +## Value + +An invisible list with components `x`, `y` (relative potency values), +and `percVec`. + +## Author + +Christian Ritz diff --git a/docs/reference/repChar.html b/docs/reference/repChar.html new file mode 100644 index 00000000..bdef02c6 --- /dev/null +++ b/docs/reference/repChar.html @@ -0,0 +1,70 @@ + +Replace characters in strings — repChar • drc + Skip to contents + + +
    +
    +
    +

    Replace characters in strings

    + Source: R/repChar.R +
    repChar.Rd
    +
    + +
    +

    Replace characters in strings

    +
    + +
    +

    Usage

    + 
    repChar(str, names, fixed, keep)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/repChar.md b/docs/reference/repChar.md new file mode 100644 index 00000000..1287180a --- /dev/null +++ b/docs/reference/repChar.md @@ -0,0 +1,9 @@ +# Replace characters in strings + +Replace characters in strings + +## Usage + +``` r +repChar(str, names, fixed, keep) +``` diff --git a/docs/reference/resPrint.html b/docs/reference/resPrint.html new file mode 100644 index 00000000..370adc71 --- /dev/null +++ b/docs/reference/resPrint.html @@ -0,0 +1,70 @@ + +Print residual information — resPrint • drc + Skip to contents + + +
    +
    +
    +

    Print residual information

    + Source: R/resPrint.R +
    resPrint.Rd
    +
    + +
    +

    Print residual information

    +
    + +
    +

    Usage

    + 
    resPrint(resMat, headerText, interval, intervalLabel, display)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/resPrint.md b/docs/reference/resPrint.md new file mode 100644 index 00000000..9bbf3c96 --- /dev/null +++ b/docs/reference/resPrint.md @@ -0,0 +1,9 @@ +# Print residual information + +Print residual information + +## Usage + +``` r +resPrint(resMat, headerText, interval, intervalLabel, display) +``` diff --git a/docs/reference/residuals.drc-1.png b/docs/reference/residuals.drc-1.png index 1d6e4f56..a30db95b 100644 Binary files a/docs/reference/residuals.drc-1.png and b/docs/reference/residuals.drc-1.png differ diff --git a/docs/reference/residuals.drc-2.png b/docs/reference/residuals.drc-2.png index 3d8e3628..e9aca441 100644 Binary files a/docs/reference/residuals.drc-2.png and b/docs/reference/residuals.drc-2.png differ diff --git a/docs/reference/residuals.drc.html b/docs/reference/residuals.drc.html index d23a6b5b..63cc8e41 100644 --- a/docs/reference/residuals.drc.html +++ b/docs/reference/residuals.drc.html @@ -1,198 +1,128 @@ - - - - - - +Extracting residuals from the fitted dose-response model — residuals.drc • drc + Skip to contents -Extracting residuals from the fitted dose-response model — residuals.drc • drc - - - +
    +
    +
    +

    Extracting residuals from the fitted dose-response model

    + Source: R/residuals.drc.R +
    residuals.drc.Rd
    +
    + +
    +

    residuals extracts different types of residuals from an object of +class 'drc'.

    +
    - +
    +

    Usage

    + 
    # S3 method for class 'drc'
+residuals(
+  object,
+  typeRes = c("working", "standardised", "studentised"),
+  trScale = TRUE,
+  ...
+)
    +
    - - +
    +

    Arguments

    +
    object
    +

    an object of class 'drc'.

    - - - +
    typeRes
    +

    character string specifying the type of residual to be +returned: raw/working residuals, residuals standardised using the +estimated residual standard error, or studentised residuals based on the +H matrix of partial derivatives of the model function.

    - +
    trScale
    +

    logical value indicating whether or not to return residuals +on the transformed scale (in case a Box-Cox transformation was applied).

    - -
    -
    - - - -
    +
    ...
    +

    additional arguments.

    -
    -
    -
    -

    Extracting residuals from the fitted dose-response model

    - - +
    +
    +

    Value

    +

    The raw (also called working) residuals or some kind of scaled +residuals extracted from object.

    +
    +
    +

    Author

    +

    Christian Ritz

    -
    - -

    'residuals' extracts different types of residuals from an object of class 'drc'.

    - +
    +

    Examples

    + 
    ## Fitting a four-parameter log-logistic model
+ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4())
+
+## Displaying the residual plot (raw residuals)
+plot(fitted(ryegrass.m1), residuals(ryegrass.m1))
+
+
+## Using the standardised residuals
+plot(fitted(ryegrass.m1), residuals(ryegrass.m1, typeRes = "standard"))
+
+
+
    +
    - 
    # S3 method for drc
-residuals(object, typeRes = c("working", "standardised", "studentised"),
-  trScale = TRUE, ...)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - -
    object

    an object of class 'drc'.

    typeRes

    character string specifying the type of residual to be returned: raw/working residuals, - residuals standardised using the estimated residual standard error, - or studentised residuals based on the H matrix of partial derivatives of the model function.

    trScale

    logical value indicating whether or not to return residuals on the transformed scale (in case a Box-Cox transformation was applied).

    ...

    additional arguments.

    - -

    Value

    - -

    The raw (also called working) residuals or some kind of scaled residuals extracted from 'object'.

    - -

    Details

    - -

    Standardised residuals are the raw residuals divided by a scale estimate (if available).

    -

    Studentised residuals are obtained by dividing by a scale estimate and in - addition a correction factor (square root of 1 minus h with h is a diagonal element in the hat matrix).

    - -

    Note

    - -

    The 'standardised' residuals are available for least squares estimation - with or without Box-Cox transformation or variance as a power of the - mean.

    - - -

    Examples

    - 
    
-## Fitting a four-parameter log-logistic model
-ryegrass.m1 <- drm(rootl ~conc, data = ryegrass, fct = LL.4())
-
-## Displaying the residual plot (raw residuals)
-plot(fitted(ryegrass.m1), residuals(ryegrass.m1))
    
-## Using the standardised residuals
-plot(fitted(ryegrass.m1), residuals(ryegrass.m1, typeRes = "standard"))
    
-## Overlayering the studentised residuals ... not much of a difference
-points(fitted(ryegrass.m1), residuals(ryegrass.m1, typeRes = "student"), col = 2)
    
-
    -
    - - -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -

    Site built with pkgdown.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -
    +
    + + + - - - + diff --git a/docs/reference/residuals.drc.md b/docs/reference/residuals.drc.md new file mode 100644 index 00000000..4292d8ac --- /dev/null +++ b/docs/reference/residuals.drc.md @@ -0,0 +1,62 @@ +# Extracting residuals from the fitted dose-response model + +`residuals` extracts different types of residuals from an object of +class 'drc'. + +## Usage + +``` r +# S3 method for class 'drc' +residuals( + object, + typeRes = c("working", "standardised", "studentised"), + trScale = TRUE, + ... +) +``` + +## Arguments + +- object: + + an object of class 'drc'. + +- typeRes: + + character string specifying the type of residual to be returned: + raw/working residuals, residuals standardised using the estimated + residual standard error, or studentised residuals based on the H + matrix of partial derivatives of the model function. + +- trScale: + + logical value indicating whether or not to return residuals on the + transformed scale (in case a Box-Cox transformation was applied). + +- ...: + + additional arguments. + +## Value + +The raw (also called working) residuals or some kind of scaled residuals +extracted from `object`. + +## Author + +Christian Ritz + +## Examples + +``` r +## Fitting a four-parameter log-logistic model +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + +## Displaying the residual plot (raw residuals) +plot(fitted(ryegrass.m1), residuals(ryegrass.m1)) + + +## Using the standardised residuals +plot(fitted(ryegrass.m1), residuals(ryegrass.m1, typeRes = "standard")) + +``` diff --git a/docs/reference/rse.html b/docs/reference/rse.html new file mode 100644 index 00000000..1fcbf692 --- /dev/null +++ b/docs/reference/rse.html @@ -0,0 +1,70 @@ + +Residual standard error — rse • drc + Skip to contents + + +
    +
    +
    +

    Residual standard error

    + Source: R/rse.R +
    rse.Rd
    +
    + +
    +

    Residual standard error

    +
    + +
    +

    Usage

    + 
    rse(object, resvar = FALSE)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/rse.md b/docs/reference/rse.md new file mode 100644 index 00000000..731b3add --- /dev/null +++ b/docs/reference/rse.md @@ -0,0 +1,9 @@ +# Residual standard error + +Residual standard error + +## Usage + +``` r +rse(object, resvar = FALSE) +``` diff --git a/docs/reference/rss.html b/docs/reference/rss.html new file mode 100644 index 00000000..686ecbb2 --- /dev/null +++ b/docs/reference/rss.html @@ -0,0 +1,99 @@ + +Residual sum of squares for dose-response models — rss • drc + Skip to contents + + +
    +
    +
    +

    Residual sum of squares for dose-response models

    + Source: R/rss.R +
    rss.Rd
    +
    + +
    +

    Calculates and displays the residual sum of squares (RSS) for a fitted dose-response model. +For models with multiple curves, per-curve and total RSS values are returned.

    +
    + +
    +

    Usage

    + 
    rss(object, print = TRUE)
    +
    + +
    +

    Arguments

    + + +
    object
    +

    an object of class 'drc'.

    + + +
    print
    +

    logical. If TRUE (the default), the RSS values are printed.

    + +
    +
    +

    Value

    +

    Invisibly returns a matrix of RSS values. For single-curve models, a 1x1 matrix. +For multi-curve models, includes per-curve values and a total RSS.

    +
    +
    +

    See also

    +

    Rsq() which uses this function to compute R-squared.

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/rss.md b/docs/reference/rss.md new file mode 100644 index 00000000..bf4519b7 --- /dev/null +++ b/docs/reference/rss.md @@ -0,0 +1,36 @@ +# Residual sum of squares for dose-response models + +Calculates and displays the residual sum of squares (RSS) for a fitted +dose-response model. For models with multiple curves, per-curve and +total RSS values are returned. + +## Usage + +``` r +rss(object, print = TRUE) +``` + +## Arguments + +- object: + + an object of class 'drc'. + +- print: + + logical. If `TRUE` (the default), the RSS values are printed. + +## Value + +Invisibly returns a matrix of RSS values. For single-curve models, a 1x1 +matrix. For multi-curve models, includes per-curve values and a total +RSS. + +## See also + +[`Rsq()`](https://hreinwald.github.io/drc/reference/Rsq.md) which uses +this function to compute R-squared. + +## Author + +Christian Ritz diff --git a/docs/reference/ryegrass-1.png b/docs/reference/ryegrass-1.png new file mode 100644 index 00000000..5c67b309 Binary files /dev/null and b/docs/reference/ryegrass-1.png differ diff --git a/docs/reference/ryegrass-2.png b/docs/reference/ryegrass-2.png new file mode 100644 index 00000000..63bb7702 Binary files /dev/null and b/docs/reference/ryegrass-2.png differ diff --git a/docs/reference/ryegrass-3.png b/docs/reference/ryegrass-3.png new file mode 100644 index 00000000..f5d8e483 Binary files /dev/null and b/docs/reference/ryegrass-3.png differ diff --git a/docs/reference/ryegrass.html b/docs/reference/ryegrass.html new file mode 100644 index 00000000..e98f5ff9 --- /dev/null +++ b/docs/reference/ryegrass.html @@ -0,0 +1,199 @@ + +Effect of ferulic acid on growth of ryegrass — ryegrass • drc + Skip to contents + + +
    +
    +
    +

    Effect of ferulic acid on growth of ryegrass

    + +
    ryegrass.Rd
    +
    + +
    +

    A single dose-response curve.

    +
    + +
    +

    Usage

    + 
    data(ryegrass)
    +
    + +
    +

    Format

    +

    A data frame with 24 observations on the following 2 variables.

    rootl
    +

    a numeric vector of root lengths

    + +
    conc
    +

    a numeric vector of concentrations of ferulic acid

    + + +
    +
    +

    Details

    +

    The data are part of a study to investigate the joint action + of phenolic acids on root growth inhibition of perennial ryegrass (Lolium perenne L).

    +

    conc is the concentration of ferulic acid is in mM, and rootl is the root length + of perennial ryegrass measured in cm.

    +
    +
    +

    Source

    +

    Inderjit and J. C. Streibig, and M. Olofsdotter (2002) Joint action of + phenolic acid mixtures and its significance in allelopathy + research, Physiologia Plantarum, 114, 422–428, 2002.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Displaying the data set
+ryegrass
+#>        rootl  conc
+#> 1  7.5800000  0.00
+#> 2  8.0000000  0.00
+#> 3  8.3285714  0.00
+#> 4  7.2500000  0.00
+#> 5  7.3750000  0.00
+#> 6  7.9625000  0.00
+#> 7  8.3555556  0.94
+#> 8  6.9142857  0.94
+#> 9  7.7500000  0.94
+#> 10 6.8714286  1.88
+#> 11 6.4500000  1.88
+#> 12 5.9222222  1.88
+#> 13 1.9250000  3.75
+#> 14 2.8857143  3.75
+#> 15 4.2333333  3.75
+#> 16 1.1875000  7.50
+#> 17 0.8571429  7.50
+#> 18 1.0571429  7.50
+#> 19 0.6875000 15.00
+#> 20 0.5250000 15.00
+#> 21 0.8250000 15.00
+#> 22 0.2500000 30.00
+#> 23 0.2200000 30.00
+#> 24 0.4400000 30.00
+
+## Fitting a four-parameter Weibull model (type 2)
+ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W2.4())
+
+## Displaying a summary of the model fit
+summary(ryegrass.m1)
+#> 
+#> Model fitted: Weibull (type 2) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept) -1.96791    0.29070 -6.7696 1.389e-06 ***
+#> c:(Intercept)  0.32459    0.24902  1.3035    0.2072    
+#> d:(Intercept)  7.72630    0.17339 44.5594 < 2.2e-16 ***
+#> e:(Intercept)  2.48765    0.14781 16.8304 2.829e-13 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.5144203 (20 degrees of freedom)
+
+## Plotting the fitted curve together with the original data
+plot(ryegrass.m1)
+
+
+## Fitting a four-parameter Weibull model (type 1)
+ryegrass.m2 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4())
+plot(ryegrass.m2)
+
+
+## Fitting a four-parameter log-logistic model
+## with user-defined parameter names
+ryegrass.m3 <- drm(rootl ~ conc, data = ryegrass, 
+fct = LL.4(names = c("Slope", "Lower Limit", "Upper Limit", "ED50")))
+summary(ryegrass.m3)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                         Estimate Std. Error t-value   p-value    
+#> Slope:(Intercept)        2.98222    0.46506  6.4125 2.960e-06 ***
+#> Lower Limit:(Intercept)  0.48141    0.21219  2.2688   0.03451 *  
+#> Upper Limit:(Intercept)  7.79296    0.18857 41.3272 < 2.2e-16 ***
+#> ED50:(Intercept)         3.05795    0.18573 16.4644 4.268e-13 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.5196256 (20 degrees of freedom)
+
+## Comparing log-logistic and Weibull models
+## (Figure 2 in Ritz (2009))
+ryegrass.m0 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4())
+ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4())
+ryegrass.m2 <- drm(rootl ~ conc, data = ryegrass, fct = W2.4())
+
+plot(ryegrass.m0, broken=TRUE, xlab="Dose (mM)", ylab="Root length (cm)", lwd=2, 
+cex=1.2, cex.axis=1.2, cex.lab=1.2)
+plot(ryegrass.m1, add=TRUE, broken=TRUE, lty=2, lwd=2)
+plot(ryegrass.m2, add=TRUE, broken=TRUE, lty=3, lwd=2)
+
+arrows(3, 7.5, 1.4, 7.5, 0.15, lwd=2)
+text(3,7.5, "Weibull-2", pos=4, cex=1.2)
+
+arrows(2.5, 0.9, 5.7, 0.9, 0.15, lwd=2)
+text(3,0.9, "Weibull-1", pos=2, cex=1.2)
+
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/ryegrass.md b/docs/reference/ryegrass.md new file mode 100644 index 00000000..36a9e39b --- /dev/null +++ b/docs/reference/ryegrass.md @@ -0,0 +1,141 @@ +# Effect of ferulic acid on growth of ryegrass + +A single dose-response curve. + +## Usage + +``` r +data(ryegrass) +``` + +## Format + +A data frame with 24 observations on the following 2 variables. + +- rootl: + + a numeric vector of root lengths + +- conc: + + a numeric vector of concentrations of ferulic acid + +## Details + +The data are part of a study to investigate the joint action of phenolic +acids on root growth inhibition of perennial ryegrass (*Lolium perenne +L*). + +`conc` is the concentration of ferulic acid is in mM, and `rootl` is the +root length of perennial ryegrass measured in cm. + +## Source + +Inderjit and J. C. Streibig, and M. Olofsdotter (2002) Joint action of +phenolic acid mixtures and its significance in allelopathy research, +*Physiologia Plantarum*, **114**, 422–428, 2002. + +## Examples + +``` r +library(drc) + +## Displaying the data set +ryegrass +#> rootl conc +#> 1 7.5800000 0.00 +#> 2 8.0000000 0.00 +#> 3 8.3285714 0.00 +#> 4 7.2500000 0.00 +#> 5 7.3750000 0.00 +#> 6 7.9625000 0.00 +#> 7 8.3555556 0.94 +#> 8 6.9142857 0.94 +#> 9 7.7500000 0.94 +#> 10 6.8714286 1.88 +#> 11 6.4500000 1.88 +#> 12 5.9222222 1.88 +#> 13 1.9250000 3.75 +#> 14 2.8857143 3.75 +#> 15 4.2333333 3.75 +#> 16 1.1875000 7.50 +#> 17 0.8571429 7.50 +#> 18 1.0571429 7.50 +#> 19 0.6875000 15.00 +#> 20 0.5250000 15.00 +#> 21 0.8250000 15.00 +#> 22 0.2500000 30.00 +#> 23 0.2200000 30.00 +#> 24 0.4400000 30.00 + +## Fitting a four-parameter Weibull model (type 2) +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W2.4()) + +## Displaying a summary of the model fit +summary(ryegrass.m1) +#> +#> Model fitted: Weibull (type 2) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) -1.96791 0.29070 -6.7696 1.389e-06 *** +#> c:(Intercept) 0.32459 0.24902 1.3035 0.2072 +#> d:(Intercept) 7.72630 0.17339 44.5594 < 2.2e-16 *** +#> e:(Intercept) 2.48765 0.14781 16.8304 2.829e-13 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.5144203 (20 degrees of freedom) + +## Plotting the fitted curve together with the original data +plot(ryegrass.m1) + + +## Fitting a four-parameter Weibull model (type 1) +ryegrass.m2 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) +plot(ryegrass.m2) + + +## Fitting a four-parameter log-logistic model +## with user-defined parameter names +ryegrass.m3 <- drm(rootl ~ conc, data = ryegrass, +fct = LL.4(names = c("Slope", "Lower Limit", "Upper Limit", "ED50"))) +summary(ryegrass.m3) +#> +#> Model fitted: Log-logistic (ED50 as parameter) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> Slope:(Intercept) 2.98222 0.46506 6.4125 2.960e-06 *** +#> Lower Limit:(Intercept) 0.48141 0.21219 2.2688 0.03451 * +#> Upper Limit:(Intercept) 7.79296 0.18857 41.3272 < 2.2e-16 *** +#> ED50:(Intercept) 3.05795 0.18573 16.4644 4.268e-13 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.5196256 (20 degrees of freedom) + +## Comparing log-logistic and Weibull models +## (Figure 2 in Ritz (2009)) +ryegrass.m0 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) +ryegrass.m2 <- drm(rootl ~ conc, data = ryegrass, fct = W2.4()) + +plot(ryegrass.m0, broken=TRUE, xlab="Dose (mM)", ylab="Root length (cm)", lwd=2, +cex=1.2, cex.axis=1.2, cex.lab=1.2) +plot(ryegrass.m1, add=TRUE, broken=TRUE, lty=2, lwd=2) +plot(ryegrass.m2, add=TRUE, broken=TRUE, lty=3, lwd=2) + +arrows(3, 7.5, 1.4, 7.5, 0.15, lwd=2) +text(3,7.5, "Weibull-2", pos=4, cex=1.2) + +arrows(2.5, 0.9, 5.7, 0.9, 0.15, lwd=2) +text(3,0.9, "Weibull-1", pos=2, cex=1.2) + +``` diff --git a/docs/reference/ryegrass2-1.png b/docs/reference/ryegrass2-1.png new file mode 100644 index 00000000..4e77b11f Binary files /dev/null and b/docs/reference/ryegrass2-1.png differ diff --git a/docs/reference/ryegrass2.html b/docs/reference/ryegrass2.html new file mode 100644 index 00000000..25f4483d --- /dev/null +++ b/docs/reference/ryegrass2.html @@ -0,0 +1,124 @@ + +Ryegrass — ryegrass2 • drc + Skip to contents + + +
    +
    +
    +

    Ryegrass

    + +
    ryegrass2.Rd
    +
    + +
    +

    Data from a dose-response experiment with ryegrass (Lolium sp.). Biomass was measured at different dose levels and at two time points.

    +
    + +
    +

    Usage

    + 
    data(ryegrass2)
    +
    + +
    +

    Format

    +

    A data frame with 27 observations on the following 3 variables.

    dose
    +

    a numeric vector

    + +
    biomass
    +

    a numeric vector

    + +
    day
    +

    a categorial vector

    + + +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Displaying the data
+head(ryegrass2)
+#>   dose biomass day
+#> 1    0    77.5   0
+#> 2    0    78.0   0
+#> 3    0    75.0   0
+#> 4    0   214.4  15
+#> 5    0   215.4  15
+#> 6    0   227.5  15
+
+## Fitting a four-parameter log-logistic model with separate curves per day
+ryegrass2.m1 <- drm(biomass ~ dose, day, data = ryegrass2, fct = LL.4())
+#> Control measurements detected for level: 0
+summary(ryegrass2.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept)   2.9412     2.4262  1.2123  0.237709    
+#> c:(Intercept)  82.7372    21.4655  3.8544  0.000807 ***
+#> d:(Intercept) 179.8062    12.4500 14.4423 5.046e-13 ***
+#> e:(Intercept)  13.6913     6.2483  2.1912  0.038827 *  
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  44.3814 (23 degrees of freedom)
+
+## Plotting the fitted curves
+plot(ryegrass2.m1, xlab = "Dose", ylab = "Biomass")
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/ryegrass2.md b/docs/reference/ryegrass2.md new file mode 100644 index 00000000..99fd85ca --- /dev/null +++ b/docs/reference/ryegrass2.md @@ -0,0 +1,66 @@ +# Ryegrass + +Data from a dose-response experiment with ryegrass (*Lolium* sp.). +Biomass was measured at different dose levels and at two time points. + +## Usage + +``` r +data(ryegrass2) +``` + +## Format + +A data frame with 27 observations on the following 3 variables. + +- `dose`: + + a numeric vector + +- `biomass`: + + a numeric vector + +- `day`: + + a categorial vector + +## Examples + +``` r +library(drc) + +## Displaying the data +head(ryegrass2) +#> dose biomass day +#> 1 0 77.5 0 +#> 2 0 78.0 0 +#> 3 0 75.0 0 +#> 4 0 214.4 15 +#> 5 0 215.4 15 +#> 6 0 227.5 15 + +## Fitting a four-parameter log-logistic model with separate curves per day +ryegrass2.m1 <- drm(biomass ~ dose, day, data = ryegrass2, fct = LL.4()) +#> Control measurements detected for level: 0 +summary(ryegrass2.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 2.9412 2.4262 1.2123 0.237709 +#> c:(Intercept) 82.7372 21.4655 3.8544 0.000807 *** +#> d:(Intercept) 179.8062 12.4500 14.4423 5.046e-13 *** +#> e:(Intercept) 13.6913 6.2483 2.1912 0.038827 * +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 44.3814 (23 degrees of freedom) + +## Plotting the fitted curves +plot(ryegrass2.m1, xlab = "Dose", ylab = "Biomass") +``` diff --git a/docs/reference/searchdrc.html b/docs/reference/searchdrc.html index 686a51e8..f09de97d 100644 --- a/docs/reference/searchdrc.html +++ b/docs/reference/searchdrc.html @@ -1,181 +1,159 @@ - - - - - - +Search through a range of initial parameter values to obtain convergence — searchdrc • drc + Skip to contents -Searching through a range of initial parameter values to obtain convergence — searchdrc • drc - - - +
    +
    +
    +

    Search through a range of initial parameter values to obtain convergence

    + Source: R/searchdrc.R +
    searchdrc.Rd
    +
    + +
    +

    searchdrc provides a facility for searching through a range of initial +values for a single parameter in order to obtain convergence of the non-linear +estimation procedure used in dose-response curve fitting.

    +
    - +
    +

    Usage

    + 
    searchdrc(object, which, range, len = 50, verbose = FALSE)
    +
    - - +
    +

    Arguments

    +
    object
    +

    an object of class 'drc', which must have valid +$start and $parNames fields populated. This is typically +an object from a model that failed to converge but was still constructed +with initial parameter values.

    - - - +
    which
    +

    a character string containing the parameter name +without the curve suffix (e.g., "b" not "b:1"). +Must exactly match one of the parameter names in the model object.

    - +
    range
    +

    a numeric vector of exactly length 2 specifying the interval +endpoints c(lower, upper) for the search range. The two endpoints +must be different.

    - -
    -
    - - - -
    +
    len
    +

    a positive integer (minimum 2). The maximum number of evenly +spaced starting values to try within range. The search stops early +as soon as convergence is achieved, so the actual number of attempts may +be less than len. Defaults to 50.

    -
    -
    -
    -

    Searching through a range of initial parameter values to obtain convergence

    - - + +
    verbose
    +

    logical. If TRUE, prints progress messages indicating +which starting value is currently being tried. Defaults to FALSE.

    + +
    +
    +

    Value

    +

    If convergence is achieved, returns the fitted model object of class +'drc', corresponding to the first starting value in the +search grid that led to a successful fit. If no starting value leads to +convergence, the function throws an error.

    +
    +
    +

    Details

    +

    The function iterates through at most len evenly spaced values within +the specified range, using each as a starting value for the chosen +parameter. The search stops as soon as the first successful model fit is +found. You would need to identify the parameter which is most likely to cause +problems for the estimation procedure.

    +

    Parameter names should be provided without the curve suffix. For +example, use "b" rather than "b:1". The function internally +matches the parameter using the pattern "^<which>:" against the full +parameter names stored in the model object.

    +
    +
    +

    See also

    +

    drm for the main model fitting function, +drmc for control arguments, +update for the update method used internally.

    +
    +
    +

    Author

    +

    Christian Ritz, Hannes Reinwald.

    -
    - -

    'searchdrc' provides a facility for searching through a range of parameter values (one-dimensional) - in order to obtain convergence of the estimation procedure.

    - +
    +

    Examples

    + 
    if (FALSE) { # \dontrun{
+library(drc)
+
+# Fit an initial model (which may fail to converge)
+myModel <- drm(response ~ dose, data = myData, fct = LL.4())
+
+# Search over a range of starting values for the slope parameter "b"
+myModelFixed <- searchdrc(myModel, which = "b", range = c(-5, 5), len = 100)
+
+# With progress messages enabled
+myModelFixed <- searchdrc(myModel, which = "b", range = c(-5, 5),
+                          len = 100, verbose = TRUE)
+} # }
+
+
    +
    - 
    searchdrc(object, which, range, len = 50)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - -
    object

    an object of class 'drc'. The object can be from a model that could not fitted.

    which

    a character string containing the parameter name

    range

    a numeric vector of length 2 specifying the interval endpoints for the range.

    len

    numeric. The number of points in the interval.

    - -

    Details

    - -

    The function goes through the range with increments such that in total at most len sets of parameter values - are used as initial values for the estimation procedure. You would need to identify the parameter which is most likely to - cause problems for the estimation procedure.

    - -

    Value

    - -

    An object of class 'drc'.

    - - -

    Examples

    - 
    
-## No example yet
-
-
    -
    - - -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -

    Site built with pkgdown.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -
    +
    + + + - - - + diff --git a/docs/reference/searchdrc.md b/docs/reference/searchdrc.md new file mode 100644 index 00000000..92473ab8 --- /dev/null +++ b/docs/reference/searchdrc.md @@ -0,0 +1,94 @@ +# Search through a range of initial parameter values to obtain convergence + +`searchdrc` provides a facility for searching through a range of initial +values for a single parameter in order to obtain convergence of the +non-linear estimation procedure used in dose-response curve fitting. + +## Usage + +``` r +searchdrc(object, which, range, len = 50, verbose = FALSE) +``` + +## Arguments + +- object: + + an object of class `'drc'`, which must have valid `$start` and + `$parNames` fields populated. This is typically an object from a model + that failed to converge but was still constructed with initial + parameter values. + +- which: + + a character string containing the parameter name **without** the curve + suffix (e.g., `"b"` not `"b:1"`). Must exactly match one of the + parameter names in the model object. + +- range: + + a numeric vector of exactly length 2 specifying the interval endpoints + `c(lower, upper)` for the search range. The two endpoints must be + different. + +- len: + + a positive integer (minimum 2). The maximum number of evenly spaced + starting values to try within `range`. The search stops early as soon + as convergence is achieved, so the actual number of attempts may be + less than `len`. Defaults to `50`. + +- verbose: + + logical. If `TRUE`, prints progress messages indicating which starting + value is currently being tried. Defaults to `FALSE`. + +## Value + +If convergence is achieved, returns the fitted model object of class +`'drc'`, corresponding to the **first** starting value in the search +grid that led to a successful fit. If no starting value leads to +convergence, the function throws an error. + +## Details + +The function iterates through at most `len` evenly spaced values within +the specified `range`, using each as a starting value for the chosen +parameter. The search stops as soon as the first successful model fit is +found. You would need to identify the parameter which is most likely to +cause problems for the estimation procedure. + +Parameter names should be provided **without** the curve suffix. For +example, use `"b"` rather than `"b:1"`. The function internally matches +the parameter using the pattern `"^:"` against the full parameter +names stored in the model object. + +## See also + +[`drm`](https://hreinwald.github.io/drc/reference/drm.md) for the main +model fitting function, +[`drmc`](https://hreinwald.github.io/drc/reference/drmc.md) for control +arguments, [`update`](https://rdrr.io/r/stats/update.html) for the +update method used internally. + +## Author + +Christian Ritz, Hannes Reinwald. + +## Examples + +``` r +if (FALSE) { # \dontrun{ +library(drc) + +# Fit an initial model (which may fail to converge) +myModel <- drm(response ~ dose, data = myData, fct = LL.4()) + +# Search over a range of starting values for the slope parameter "b" +myModelFixed <- searchdrc(myModel, which = "b", range = c(-5, 5), len = 100) + +# With progress messages enabled +myModelFixed <- searchdrc(myModel, which = "b", range = c(-5, 5), + len = 100, verbose = TRUE) +} # } +``` diff --git a/docs/reference/secalonic-1.png b/docs/reference/secalonic-1.png new file mode 100644 index 00000000..fc3a5b5b Binary files /dev/null and b/docs/reference/secalonic-1.png differ diff --git a/docs/reference/secalonic.html b/docs/reference/secalonic.html new file mode 100644 index 00000000..e31208d3 --- /dev/null +++ b/docs/reference/secalonic.html @@ -0,0 +1,154 @@ + +Root length measurements — secalonic • drc + Skip to contents + + +
    +
    +
    +

    Root length measurements

    + +
    secalonic.Rd
    +
    + +
    +

    Data stem from an experiment assessing the inhibitory effect of secalonic acids on plant growth.

    +
    + +
    +

    Usage

    + 
    data(secalonic)
    +
    + +
    +

    Format

    +

    A data frame with 7 observations on the following 2 variables:

    dose
    +

    a numeric vector containing dose values (mM)

    + +
    rootl
    +

    a numeric vector containing root lengths (cm)

    + + +
    +
    +

    Details

    +

    For each dose the root length is an average three measurements.

    +
    +
    +

    Source

    +

    Gong, X. and Zeng, R. and Luo, S. and Yong, C. and Zheng, Q. (2004) Two new + secalonic acids from Aspergillus Japonicus and their allelopathic effects on higher plants, + Proceedings of International Symposium on Allelopathy Research and Application, 27-29 April, + Shanshui, Guangdong, China (Editors: R. Zeng and S. Luo), 209–217.

    +

    Ritz, C (2009) + Towards a unified approach to dose-response modeling in ecotoxicology + To appear in Environ Toxicol Chem.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Fitting a four-parameter log-logistic model
+secalonic.m1 <- drm(rootl ~ dose, data = secalonic, fct = LL.4())
+summary(secalonic.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                Estimate Std. Error t-value   p-value    
+#> b:(Intercept) 2.6542086  0.6962333  3.8122 0.0317398 *  
+#> c:(Intercept) 0.0917852  0.3747246  0.2449 0.8223012    
+#> d:(Intercept) 5.5297495  0.2010300 27.5071 0.0001055 ***
+#> e:(Intercept) 0.0803547  0.0078829 10.1935 0.0020121 ** 
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.2957497 (3 degrees of freedom)
+
+## Fitting a three-parameter log-logistic model
+##  lower limit fixed at 0
+secalonic.m2 <- drm(rootl ~ dose, data = secalonic, fct = LL.3())
+summary(secalonic.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                Estimate Std. Error t-value   p-value    
+#> b:(Intercept) 2.6542086  0.6962333  3.8122 0.0317398 *  
+#> c:(Intercept) 0.0917852  0.3747246  0.2449 0.8223012    
+#> d:(Intercept) 5.5297495  0.2010300 27.5071 0.0001055 ***
+#> e:(Intercept) 0.0803547  0.0078829 10.1935 0.0020121 ** 
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.2957497 (3 degrees of freedom)
+
+## Comparing logistic and log-logistic models
+## (Figure 1 in Ritz (2009))
+secalonic.LL4 <- drm(rootl ~ dose, data = secalonic, fct = LL.4())
+secalonic.L4 <- drm(rootl ~ dose, data = secalonic, fct = L.4())
+
+plot(secalonic.LL4, broken=TRUE, ylim=c(0,7), xlab="Dose (mM)", ylab="Root length (cm)", 
+cex=1.2, cex.axis=1.2, cex.lab=1.2, lwd=2)
+
+plot(secalonic.L4, broken=TRUE, ylim=c(0,7), add=TRUE, type="none", lty=2, lwd=2)
+
+abline(h=coef(secalonic.L4)[3], lty=3, lwd=2)
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/secalonic.md b/docs/reference/secalonic.md new file mode 100644 index 00000000..877130f0 --- /dev/null +++ b/docs/reference/secalonic.md @@ -0,0 +1,96 @@ +# Root length measurements + +Data stem from an experiment assessing the inhibitory effect of +secalonic acids on plant growth. + +## Usage + +``` r +data(secalonic) +``` + +## Format + +A data frame with 7 observations on the following 2 variables: + +- `dose`: + + a numeric vector containing dose values (mM) + +- `rootl`: + + a numeric vector containing root lengths (cm) + +## Details + +For each dose the root length is an average three measurements. + +## Source + +Gong, X. and Zeng, R. and Luo, S. and Yong, C. and Zheng, Q. (2004) Two +new secalonic acids from *Aspergillus Japonicus* and their allelopathic +effects on higher plants, *Proceedings of International Symposium on +Allelopathy Research and Application, 27-29 April, Shanshui, Guangdong, +China (Editors: R. Zeng and S. Luo)*, 209–217. + +Ritz, C (2009) Towards a unified approach to dose-response modeling in +ecotoxicology *To appear in Environ Toxicol Chem*. + +## Examples + +``` r +library(drc) + +## Fitting a four-parameter log-logistic model +secalonic.m1 <- drm(rootl ~ dose, data = secalonic, fct = LL.4()) +summary(secalonic.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 2.6542086 0.6962333 3.8122 0.0317398 * +#> c:(Intercept) 0.0917852 0.3747246 0.2449 0.8223012 +#> d:(Intercept) 5.5297495 0.2010300 27.5071 0.0001055 *** +#> e:(Intercept) 0.0803547 0.0078829 10.1935 0.0020121 ** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.2957497 (3 degrees of freedom) + +## Fitting a three-parameter log-logistic model +## lower limit fixed at 0 +secalonic.m2 <- drm(rootl ~ dose, data = secalonic, fct = LL.3()) +summary(secalonic.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 2.6542086 0.6962333 3.8122 0.0317398 * +#> c:(Intercept) 0.0917852 0.3747246 0.2449 0.8223012 +#> d:(Intercept) 5.5297495 0.2010300 27.5071 0.0001055 *** +#> e:(Intercept) 0.0803547 0.0078829 10.1935 0.0020121 ** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.2957497 (3 degrees of freedom) + +## Comparing logistic and log-logistic models +## (Figure 1 in Ritz (2009)) +secalonic.LL4 <- drm(rootl ~ dose, data = secalonic, fct = LL.4()) +secalonic.L4 <- drm(rootl ~ dose, data = secalonic, fct = L.4()) + +plot(secalonic.LL4, broken=TRUE, ylim=c(0,7), xlab="Dose (mM)", ylab="Root length (cm)", +cex=1.2, cex.axis=1.2, cex.lab=1.2, lwd=2) + +plot(secalonic.L4, broken=TRUE, ylim=c(0,7), add=TRUE, type="none", lty=2, lwd=2) + +abline(h=coef(secalonic.L4)[3], lty=3, lwd=2) +``` diff --git a/docs/reference/selenium-1.png b/docs/reference/selenium-1.png new file mode 100644 index 00000000..0ad3112a Binary files /dev/null and b/docs/reference/selenium-1.png differ diff --git a/docs/reference/selenium-2.png b/docs/reference/selenium-2.png new file mode 100644 index 00000000..1741f735 Binary files /dev/null and b/docs/reference/selenium-2.png differ diff --git a/docs/reference/selenium-3.png b/docs/reference/selenium-3.png new file mode 100644 index 00000000..e100dadf Binary files /dev/null and b/docs/reference/selenium-3.png differ diff --git a/docs/reference/selenium.html b/docs/reference/selenium.html new file mode 100644 index 00000000..4079d303 --- /dev/null +++ b/docs/reference/selenium.html @@ -0,0 +1,209 @@ + +Data from toxicology experiments with selenium — selenium • drc + Skip to contents + + +
    +
    +
    +

    Data from toxicology experiments with selenium

    + +
    selenium.Rd
    +
    + +
    +

    Comparison of toxicity of four types of selenium by means of dose-response analysis

    +
    + +
    +

    Usage

    + 
    data(selenium)
    +
    + +
    +

    Format

    +

    A data frame with 25 observations on the following 4 variables.

    type
    +

    a numeric vector indicating the form of selenium applied

    + +
    conc
    +

    a numeric vector of (total) selenium concentrations

    + +
    total
    +

    a numeric vector containing the total number of flies

    + +
    dead
    +

    a numeric vector containing the number of dead flies

    + + +
    +
    +

    Details

    +

    The experiment is described in more details by Jeske et al. (2009).

    +
    +
    +

    Source

    +

    Jeske, D. R., Xu, H. K., Blessinger, T., Jensen, P. and Trumble, J. (2009) Testing for the Equality of EC50 Values in the Presence of + Unequal Slopes With Application to Toxicity of Selenium Types, Journal of Agricultural, Biological, and Environmental Statistics, + 14, 469–483

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Analysis similar to what is proposed in Jeske et al (2009)
+##  but simply using existing functionality in "drc"
+
+## Fitting the two-parameter log-logistic model with unequal ED50 and slope
+sel.m1 <- drm(dead/total~conc, type, weights=total, data=selenium, fct=LL.2(), 
+type="binomial")
+#sel.m1b <- drm(dead/total~conc, type, weights=total, data=selenium, fct=LN.2(), 
+# type="binomial", start=c(1,1,1,1,50,50,50,50))
+plot(sel.m1, ylim = c(0, 1.3))
+
+summary(sel.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>      Estimate Std. Error  t-value   p-value    
+#> b:1  -1.50353    0.15547  -9.6706 < 2.2e-16 ***
+#> b:2  -0.84323    0.13911  -6.0617 1.347e-09 ***
+#> b:3  -2.16354    0.13824 -15.6504 < 2.2e-16 ***
+#> b:4  -1.45303    0.16861  -8.6179 < 2.2e-16 ***
+#> e:1 252.25555   13.82683  18.2439 < 2.2e-16 ***
+#> e:2 378.46048   39.37070   9.6127 < 2.2e-16 ***
+#> e:3 119.71320    5.90536  20.2719 < 2.2e-16 ***
+#> e:4  88.80529    8.61614  10.3069 < 2.2e-16 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+## Testing for equality of slopes
+sel.m2 <- drm(dead/total~conc, type, weights=total, data=selenium, fct=LL.2(), 
+type="binomial", pmodels=list(~1, ~factor(type)-1))
+sel.m2b <- drm(dead/total~conc, type, weights=total, data=selenium, fct=LN.2(), 
+type="binomial", pmodels=list(~1, ~factor(type)-1))
+plot(sel.m2, ylim = c(0, 1.3))
+
+summary(sel.m2)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                   Estimate Std. Error t-value   p-value    
+#> b:(Intercept)    -1.590121   0.069452 -22.895 < 2.2e-16 ***
+#> e:factor(type)1 253.442530  13.109512  19.333 < 2.2e-16 ***
+#> e:factor(type)2 331.625839  16.855683  19.674 < 2.2e-16 ***
+#> e:factor(type)3 114.793108   6.760525  16.980 < 2.2e-16 ***
+#> e:factor(type)4  84.970604   6.173312  13.764 < 2.2e-16 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+anova(sel.m2, sel.m1)  # 48.654
+#> 
+#> 1st model
+#>  fct:     LL.2()
+#>  pmodels: ~1, ~factor(type) - 1
+#> 2nd model
+#>  fct:     LL.2()
+#>  pmodels: type (for all parameters)
+#> 
+#> ANOVA-like table
+#> 
+#>           ModelDf  Loglik Df LR value p value
+#> 1st model       5 -400.54                    
+#> 2nd model       8 -376.21  3   48.654       0
+#anova(sel.m2b, sel.m1b)
+# close to the value 48.46 reported in the paper
+
+## Testing for equality of ED50
+sel.m3<-drm(dead/total~conc, type, weights=total, data=selenium, fct=LL.2(), 
+type="binomial", pmodels=list(~factor(type)-1, ~1))
+#sel.m3b<-drm(dead/total~conc, type, weights=total, data=selenium, fct=LN.2(), 
+# type="binomial", pmodels=list(~factor(type)-1, ~1), start=c(1,1,1,1,50))
+plot(sel.m3, ylim = c(0, 1.3))
+
+summary(sel.m3)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                   Estimate Std. Error  t-value   p-value    
+#> b:factor(type)1  -0.603492   0.100467  -6.0069 1.892e-09 ***
+#> b:factor(type)2  -0.058099   0.082599  -0.7034    0.4818    
+#> b:factor(type)3  -2.177597   0.137733 -15.8102 < 2.2e-16 ***
+#> b:factor(type)4  -1.095290   0.102328 -10.7037 < 2.2e-16 ***
+#> e:(Intercept)   126.512287   6.854739  18.4562 < 2.2e-16 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+anova(sel.m3, sel.m1)  # 123.56
+#> 
+#> 1st model
+#>  fct:     LL.2()
+#>  pmodels: ~factor(type) - 1, ~1
+#> 2nd model
+#>  fct:     LL.2()
+#>  pmodels: type (for all parameters)
+#> 
+#> ANOVA-like table
+#> 
+#>           ModelDf  Loglik Df LR value p value
+#> 1st model       5 -437.99                    
+#> 2nd model       8 -376.21  3   123.56       0
+#anova(sel.m3b, sel.m1b) 
+# not too far from the value 138.45 reported in the paper
+# (note that the estimation procedure is not exactly the same)
+# (and we use the log-logistic model instead of the log-normal model)
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/selenium.md b/docs/reference/selenium.md new file mode 100644 index 00000000..971b0a58 --- /dev/null +++ b/docs/reference/selenium.md @@ -0,0 +1,155 @@ +# Data from toxicology experiments with selenium + +Comparison of toxicity of four types of selenium by means of +dose-response analysis + +## Usage + +``` r +data(selenium) +``` + +## Format + +A data frame with 25 observations on the following 4 variables. + +- `type`: + + a numeric vector indicating the form of selenium applied + +- `conc`: + + a numeric vector of (total) selenium concentrations + +- `total`: + + a numeric vector containing the total number of flies + +- `dead`: + + a numeric vector containing the number of dead flies + +## Details + +The experiment is described in more details by Jeske et al. (2009). + +## Source + +Jeske, D. R., Xu, H. K., Blessinger, T., Jensen, P. and Trumble, J. +(2009) Testing for the Equality of EC50 Values in the Presence of +Unequal Slopes With Application to Toxicity of Selenium Types, *Journal +of Agricultural, Biological, and Environmental Statistics*, **14**, +469–483 + +## Examples + +``` r +library(drc) + +## Analysis similar to what is proposed in Jeske et al (2009) +## but simply using existing functionality in "drc" + +## Fitting the two-parameter log-logistic model with unequal ED50 and slope +sel.m1 <- drm(dead/total~conc, type, weights=total, data=selenium, fct=LL.2(), +type="binomial") +#sel.m1b <- drm(dead/total~conc, type, weights=total, data=selenium, fct=LN.2(), +# type="binomial", start=c(1,1,1,1,50,50,50,50)) +plot(sel.m1, ylim = c(0, 1.3)) + +summary(sel.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:1 -1.50353 0.15547 -9.6706 < 2.2e-16 *** +#> b:2 -0.84323 0.13911 -6.0617 1.347e-09 *** +#> b:3 -2.16354 0.13824 -15.6504 < 2.2e-16 *** +#> b:4 -1.45303 0.16861 -8.6179 < 2.2e-16 *** +#> e:1 252.25555 13.82683 18.2439 < 2.2e-16 *** +#> e:2 378.46048 39.37070 9.6127 < 2.2e-16 *** +#> e:3 119.71320 5.90536 20.2719 < 2.2e-16 *** +#> e:4 88.80529 8.61614 10.3069 < 2.2e-16 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 + +## Testing for equality of slopes +sel.m2 <- drm(dead/total~conc, type, weights=total, data=selenium, fct=LL.2(), +type="binomial", pmodels=list(~1, ~factor(type)-1)) +sel.m2b <- drm(dead/total~conc, type, weights=total, data=selenium, fct=LN.2(), +type="binomial", pmodels=list(~1, ~factor(type)-1)) +plot(sel.m2, ylim = c(0, 1.3)) + +summary(sel.m2) +#> +#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) -1.590121 0.069452 -22.895 < 2.2e-16 *** +#> e:factor(type)1 253.442530 13.109512 19.333 < 2.2e-16 *** +#> e:factor(type)2 331.625839 16.855683 19.674 < 2.2e-16 *** +#> e:factor(type)3 114.793108 6.760525 16.980 < 2.2e-16 *** +#> e:factor(type)4 84.970604 6.173312 13.764 < 2.2e-16 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +anova(sel.m2, sel.m1) # 48.654 +#> +#> 1st model +#> fct: LL.2() +#> pmodels: ~1, ~factor(type) - 1 +#> 2nd model +#> fct: LL.2() +#> pmodels: type (for all parameters) +#> +#> ANOVA-like table +#> +#> ModelDf Loglik Df LR value p value +#> 1st model 5 -400.54 +#> 2nd model 8 -376.21 3 48.654 0 +#anova(sel.m2b, sel.m1b) +# close to the value 48.46 reported in the paper + +## Testing for equality of ED50 +sel.m3<-drm(dead/total~conc, type, weights=total, data=selenium, fct=LL.2(), +type="binomial", pmodels=list(~factor(type)-1, ~1)) +#sel.m3b<-drm(dead/total~conc, type, weights=total, data=selenium, fct=LN.2(), +# type="binomial", pmodels=list(~factor(type)-1, ~1), start=c(1,1,1,1,50)) +plot(sel.m3, ylim = c(0, 1.3)) + +summary(sel.m3) +#> +#> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:factor(type)1 -0.603492 0.100467 -6.0069 1.892e-09 *** +#> b:factor(type)2 -0.058099 0.082599 -0.7034 0.4818 +#> b:factor(type)3 -2.177597 0.137733 -15.8102 < 2.2e-16 *** +#> b:factor(type)4 -1.095290 0.102328 -10.7037 < 2.2e-16 *** +#> e:(Intercept) 126.512287 6.854739 18.4562 < 2.2e-16 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 + +anova(sel.m3, sel.m1) # 123.56 +#> +#> 1st model +#> fct: LL.2() +#> pmodels: ~factor(type) - 1, ~1 +#> 2nd model +#> fct: LL.2() +#> pmodels: type (for all parameters) +#> +#> ANOVA-like table +#> +#> ModelDf Loglik Df LR value p value +#> 1st model 5 -437.99 +#> 2nd model 8 -376.21 3 123.56 0 +#anova(sel.m3b, sel.m1b) +# not too far from the value 138.45 reported in the paper +# (note that the estimation procedure is not exactly the same) +# (and we use the log-logistic model instead of the log-normal model) +``` diff --git a/docs/reference/siInner.html b/docs/reference/siInner.html new file mode 100644 index 00000000..7fa85ef7 --- /dev/null +++ b/docs/reference/siInner.html @@ -0,0 +1,85 @@ + +Inner function for selectivity index — siInner • drc + Skip to contents + + +
    +
    +
    +

    Inner function for selectivity index

    + Source: R/siInner.R +
    siInner.Rd
    +
    + +
    +

    Inner function for selectivity index

    +
    + +
    +

    Usage

    + 
    siInner(
+  indPair,
+  pVec,
+  compMatch,
+  object,
+  indexMat,
+  parmMat,
+  varMat,
+  level,
+  reference,
+  type,
+  sifct,
+  interval,
+  degfree,
+  logBase
+)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/siInner.md b/docs/reference/siInner.md new file mode 100644 index 00000000..2b784a0c --- /dev/null +++ b/docs/reference/siInner.md @@ -0,0 +1,24 @@ +# Inner function for selectivity index + +Inner function for selectivity index + +## Usage + +``` r +siInner( + indPair, + pVec, + compMatch, + object, + indexMat, + parmMat, + varMat, + level, + reference, + type, + sifct, + interval, + degfree, + logBase +) +``` diff --git a/docs/reference/simDR.html b/docs/reference/simDR.html index 3b7c6326..c82ab614 100644 --- a/docs/reference/simDR.html +++ b/docs/reference/simDR.html @@ -1,217 +1,173 @@ - - - - - - +Simulating ED values under various scenarios — simDR • drc + Skip to contents -Simulating ED values under various scenarios — simDR • drc - - - +
    +
    +
    +

    Simulating ED values under various scenarios

    + Source: R/simDR.R +
    simDR.Rd
    +
    - +
    +

    Simulating ED values for a given model and given dose values.

    +
    - - +
    +

    Usage

    + 
    simDR(
+  mpar,
+  sigma,
+  fct,
+  noSim = 1000,
+  conc,
+  edVec = c(10, 50),
+  seedVal = 20070723
+)
    +
    +
    +

    Arguments

    - - +
    mpar
    +

    numeric vector of model parameters.

    - +
    sigma
    +

    numeric specifying the residual standard deviation.

    - - -
    -
    - - - -
    -
    -
    -
    -

    Simulating ED values under various scenarios

    - - +
    noSim
    +

    numeric giving the number of simulations. Defaults to 1000.

    + + +
    conc
    +

    numeric vector of concentration/dose values. Must contain at least 5 values.

    + + +
    edVec
    +

    numeric vector of ED levels to estimate in each simulation. Defaults to +c(10, 50).

    + + +
    seedVal
    +

    numeric giving the seed used to initialise the random number generator. +Defaults to 20070723.

    + +
    +
    +

    Value

    +

    Invisibly returns a list with one element:

    se
    +

    A 3D array of dimensions +(length(conc) - 4) x 6 x length(edVec) containing empirical +standard deviations of the estimated ED values. Rows correspond to the +number of concentration levels used (starting from 5). Columns correspond +to the number of replicates per concentration (1 to 6). The third dimension +corresponds to each ED level in edVec.

    + + +

    The array values are also printed to the console during execution.

    +
    +
    +

    Details

    +

    The arguments mpar and sigma are typically obtained from a +previous model fit. Only dose-response models assuming normally distributed +errors can be used.

    +
    +
    +

    Author

    +

    Christian Ritz, Hannes Reinwald

    -
    - -

    Simulating ED values for a given model and given dose values.

    - +
    +

    Examples

    + 
    ryegrass.m1 <- drm(ryegrass, fct = LL.4())
+
+simDR(
+  mpar     = coef(ryegrass.m1),
+  sigma    = sqrt(summary(ryegrass.m1)$resVar),
+  fct      = LL.4(),
+  noSim    = 2,
+  conc     = c(1.88, 3.75, 7.50, 0.94, 15, 0.47, 30, 0.23, 60),
+  seedVal  = 20070723
+)
+#> Concentrations used: 1.88 3.75 7.5 0.94 15 0.47 30 0.23 60 
+#> 
+#> ED value considered: 10 
+#> Conc. no.\Replicates: 
+#>           1          2         3          4         5          6
+#> 5 1.7937943 0.70676461 0.7070331 0.74477323 0.0314240 0.47265995
+#> 6 0.7715370 0.07489298 0.1991687 0.50345455 0.0274019 0.26133303
+#> 7 0.6766681 0.43816932 0.3241948 0.57191204 0.4956274 0.02968537
+#> 8 0.5276024 0.20800084 0.2113615 0.05549555 0.2561400 0.28737212
+#> 9 0.1800602 0.76739811 0.5514185 0.11201042 0.4834278 0.46828149
+#> 
+#> 
+#> ED value considered: 50 
+#> Conc. no.\Replicates: 
+#>           1          2          3         4         5         6
+#> 5 0.6998346 1.32865730 0.49266733 0.4490645 0.1069289 0.6018208
+#> 6 6.7983515 0.39097416 0.09645987 0.5823232 0.4309704 0.4252761
+#> 7 0.9155897 0.03037852 0.46647071 0.2017280 0.3129933 0.3744331
+#> 8 0.3950825 0.16439311 0.21879117 0.0803034 0.2577441 0.2953281
+#> 9 0.3519176 1.19098825 0.34427430 0.1302080 0.4812865 0.2009490
+#> 
+#> 
+
+
    +
    - 
    simDR(mpar, sigma, fct, noSim = 1000, conc, edVec = c(10, 50), seedVal = 20070723)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    mpar

    numeric vector of model parameters

    sigma

    numeric specifying the residual standard deviation

    fct

    list supplying the chosen mean function

    conc

    numeric vector of concentration/dose values

    edVec

    numeric vector of ED values to estimate in each simulation

    noSim

    numeric giving the number of simulations

    seedVal

    numeric giving the seed used to initiate the random number generator

    - -

    Details

    - -

    The arguments mpar and sigma are typically obtained from a previous model fit.

    -

    Only dose-response models assuming normally distributed errors can be used.

    - -

    Value

    - -

    A list of matrices with as many components as there are chosen ED values. The entries in the matrices are - empirical standard deviations of the estimated ED values. Row-wise from top to bottom more and more - concentration/dose values are included in the simulations; top row starting with 5 concentrations. The - number of replicates increases column by column from left to right.

    -

    The list is returned invisbly as the matrices also are displayed.

    - - -

    Examples

    - 
    
-ryegrass.m1 <- drm(ryegrass, fct=LL.4())
-
-simDR(coef(ryegrass.m1), sqrt(summary(ryegrass.m1)$resVar), LL.4(), 2,
-c(1.88, 3.75, 7.50, 0.94, 15, 0.47, 30, 0.23, 60), seedVal = 200710291)
    #> Concentrations used: 1.88 3.75 7.5 0.94 15 0.47 30 0.23 60 
-#> 
-#> ED value considered: 10 
-#> Conc. no.\Replicates: 
-#>            1          2          3          4          5          6
-#> 5 0.21663344 0.81050743 0.03720474 0.31941962 0.27602174 1.06748994
-#> 6 0.94123238 0.09153931 0.05169959 0.42236519 0.05903568 0.65652040
-#> 7 0.37505197 0.89749084 1.10562748 0.46717540 0.09427895 0.09941082
-#> 8 0.29322754 0.35947683 0.36292195 0.12434167 0.25382652 0.44720085
-#> 9 0.05051407 0.81151253 0.36009230 0.09176809 0.05572999 0.07993389
-#> 
-#> 
-#> ED value considered: 50 
-#> Conc. no.\Replicates: 
-#>            1         2         3         4         5         6
-#> 5 0.41931241 2.5598687 0.1999825 0.1641816 0.0184324 1.2226656
-#> 6 0.59150811 0.1644054 0.1555681 0.3922277 0.1010897 0.6564398
-#> 7 0.79504087 0.5011138 0.4209378 0.3844431 0.3784710 0.4346236
-#> 8 0.01548633 0.4687979 0.4580110 0.6642111 0.2163613 0.1593073
-#> 9 1.82422377 0.4866429 0.5804128 0.1243123 0.2344158 0.1205998
-#> 
-#> 
    
-
    -
    - - -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -

    Site built with pkgdown.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -
    +
    + + + - - - + diff --git a/docs/reference/simDR.md b/docs/reference/simDR.md new file mode 100644 index 00000000..80deb6ab --- /dev/null +++ b/docs/reference/simDR.md @@ -0,0 +1,113 @@ +# Simulating ED values under various scenarios + +Simulating ED values for a given model and given dose values. + +## Usage + +``` r +simDR( + mpar, + sigma, + fct, + noSim = 1000, + conc, + edVec = c(10, 50), + seedVal = 20070723 +) +``` + +## Arguments + +- mpar: + + numeric vector of model parameters. + +- sigma: + + numeric specifying the residual standard deviation. + +- fct: + + list supplying the chosen dose-response mean function (e.g., + [`LL.4()`](https://hreinwald.github.io/drc/reference/LL.4.md)). + +- noSim: + + numeric giving the number of simulations. Defaults to `1000`. + +- conc: + + numeric vector of concentration/dose values. Must contain at least 5 + values. + +- edVec: + + numeric vector of ED levels to estimate in each simulation. Defaults + to `c(10, 50)`. + +- seedVal: + + numeric giving the seed used to initialise the random number + generator. Defaults to `20070723`. + +## Value + +Invisibly returns a list with one element: + +- `se`: + + A 3D array of dimensions `(length(conc) - 4) x 6 x length(edVec)` + containing empirical standard deviations of the estimated ED values. + Rows correspond to the number of concentration levels used (starting + from 5). Columns correspond to the number of replicates per + concentration (1 to 6). The third dimension corresponds to each ED + level in `edVec`. + +The array values are also printed to the console during execution. + +## Details + +The arguments `mpar` and `sigma` are typically obtained from a previous +model fit. Only dose-response models assuming normally distributed +errors can be used. + +## Author + +Christian Ritz, Hannes Reinwald + +## Examples + +``` r +ryegrass.m1 <- drm(ryegrass, fct = LL.4()) + +simDR( + mpar = coef(ryegrass.m1), + sigma = sqrt(summary(ryegrass.m1)$resVar), + fct = LL.4(), + noSim = 2, + conc = c(1.88, 3.75, 7.50, 0.94, 15, 0.47, 30, 0.23, 60), + seedVal = 20070723 +) +#> Concentrations used: 1.88 3.75 7.5 0.94 15 0.47 30 0.23 60 +#> +#> ED value considered: 10 +#> Conc. no.\Replicates: +#> 1 2 3 4 5 6 +#> 5 1.7937943 0.70676461 0.7070331 0.74477323 0.0314240 0.47265995 +#> 6 0.7715370 0.07489298 0.1991687 0.50345455 0.0274019 0.26133303 +#> 7 0.6766681 0.43816932 0.3241948 0.57191204 0.4956274 0.02968537 +#> 8 0.5276024 0.20800084 0.2113615 0.05549555 0.2561400 0.28737212 +#> 9 0.1800602 0.76739811 0.5514185 0.11201042 0.4834278 0.46828149 +#> +#> +#> ED value considered: 50 +#> Conc. no.\Replicates: +#> 1 2 3 4 5 6 +#> 5 0.6998346 1.32865730 0.49266733 0.4490645 0.1069289 0.6018208 +#> 6 6.7983515 0.39097416 0.09645987 0.5823232 0.4309704 0.4252761 +#> 7 0.9155897 0.03037852 0.46647071 0.2017280 0.3129933 0.3744331 +#> 8 0.3950825 0.16439311 0.21879117 0.0803034 0.2577441 0.2953281 +#> 9 0.3519176 1.19098825 0.34427430 0.1302080 0.4812865 0.2009490 +#> +#> +``` diff --git a/docs/reference/simFct.html b/docs/reference/simFct.html new file mode 100644 index 00000000..6efbe21c --- /dev/null +++ b/docs/reference/simFct.html @@ -0,0 +1,187 @@ + +Simulation of dose-response data and ED estimation — simFct • drc + Skip to contents + + +
    +
    +
    +

    Simulation of dose-response data and ED estimation

    + Source: R/simFct.R +
    simFct.Rd
    +
    + +
    +

    Simulates dose-response datasets using parametric or non-parametric methods and estimates +effective doses (ED values) from each simulated dataset. Useful for assessing the +performance of ED estimation methods via Monte Carlo simulation.

    +
    + +
    +

    Usage

    + 
    simFct(
+  noSim,
+  edVal = c(10, 20, 50),
+  type = c("non-parametric", "parametric"),
+  response = c("bin", "con"),
+  fct = LL.2(),
+  coefVec,
+  method = c("sp", "p", "np"),
+  doseVec,
+  nVec,
+  pVec,
+  rVec,
+  resVar,
+  pfct = fct,
+  reference = NULL,
+  span = NA,
+  minmax = "response",
+  lower = NULL,
+  upper = NULL,
+  seedVal = 200810201
+)
    +
    + +
    +

    Arguments

    + + +
    noSim
    +

    integer. Number of simulations to run.

    + + +
    edVal
    +

    numeric vector of ED levels to estimate (default is c(10, 20, 50)).

    + + +
    type
    +

    character string. Either "non-parametric" or "parametric" simulation.

    + + +
    response
    +

    character string. Either "bin" (binomial) or "con" (continuous) response.

    + + +
    fct
    +

    dose-response function used for simulation (default is LL.2()).

    + + +
    coefVec
    +

    numeric vector of model coefficients for parametric simulation.

    + + +
    method
    +

    character string. Estimation method: "sp" (semi-parametric), "p" (parametric), +or "np" (non-parametric).

    + + +
    doseVec
    +

    numeric vector of dose values.

    + + +
    nVec
    +

    numeric vector of sample sizes per dose (for binomial response).

    + + +
    pVec
    +

    numeric vector of expected response probabilities (for non-parametric simulation).

    + + +
    rVec
    +

    numeric vector of responses.

    + + +
    resVar
    +

    numeric. Residual variance (for continuous response).

    + + +
    pfct
    +

    dose-response function used for fitting (defaults to fct).

    + + +
    reference
    +

    character string specifying the reference for ED estimation.

    + + +
    span
    +

    numeric. Smoothing parameter for local regression. NA uses default.

    + + +
    minmax
    +

    character string. Type of min/max calculation. Default is "response".

    + + +
    lower
    +

    numeric. Lower bounds for optimization.

    + + +
    upper
    +

    numeric. Upper bounds for optimization.

    + + +
    seedVal
    +

    integer. Random seed for reproducibility (default is 200810201).

    + +
    +
    +

    Value

    +

    A list with components edArray (array of ED estimates), mixVec, +edVal, aicVec, and spanVec.

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/simFct.md b/docs/reference/simFct.md new file mode 100644 index 00000000..aab18267 --- /dev/null +++ b/docs/reference/simFct.md @@ -0,0 +1,123 @@ +# Simulation of dose-response data and ED estimation + +Simulates dose-response datasets using parametric or non-parametric +methods and estimates effective doses (ED values) from each simulated +dataset. Useful for assessing the performance of ED estimation methods +via Monte Carlo simulation. + +## Usage + +``` r +simFct( + noSim, + edVal = c(10, 20, 50), + type = c("non-parametric", "parametric"), + response = c("bin", "con"), + fct = LL.2(), + coefVec, + method = c("sp", "p", "np"), + doseVec, + nVec, + pVec, + rVec, + resVar, + pfct = fct, + reference = NULL, + span = NA, + minmax = "response", + lower = NULL, + upper = NULL, + seedVal = 200810201 +) +``` + +## Arguments + +- noSim: + + integer. Number of simulations to run. + +- edVal: + + numeric vector of ED levels to estimate (default is `c(10, 20, 50)`). + +- type: + + character string. Either "non-parametric" or "parametric" simulation. + +- response: + + character string. Either "bin" (binomial) or "con" (continuous) + response. + +- fct: + + dose-response function used for simulation (default is + [`LL.2()`](https://hreinwald.github.io/drc/reference/LL.2.md)). + +- coefVec: + + numeric vector of model coefficients for parametric simulation. + +- method: + + character string. Estimation method: "sp" (semi-parametric), "p" + (parametric), or "np" (non-parametric). + +- doseVec: + + numeric vector of dose values. + +- nVec: + + numeric vector of sample sizes per dose (for binomial response). + +- pVec: + + numeric vector of expected response probabilities (for non-parametric + simulation). + +- rVec: + + numeric vector of responses. + +- resVar: + + numeric. Residual variance (for continuous response). + +- pfct: + + dose-response function used for fitting (defaults to `fct`). + +- reference: + + character string specifying the reference for ED estimation. + +- span: + + numeric. Smoothing parameter for local regression. NA uses default. + +- minmax: + + character string. Type of min/max calculation. Default is "response". + +- lower: + + numeric. Lower bounds for optimization. + +- upper: + + numeric. Upper bounds for optimization. + +- seedVal: + + integer. Random seed for reproducibility (default is 200810201). + +## Value + +A list with components `edArray` (array of ED estimates), `mixVec`, +`edVal`, `aicVec`, and `spanVec`. + +## Author + +Christian Ritz diff --git a/docs/reference/spinach-1.png b/docs/reference/spinach-1.png new file mode 100644 index 00000000..533af508 Binary files /dev/null and b/docs/reference/spinach-1.png differ diff --git a/docs/reference/spinach.html b/docs/reference/spinach.html new file mode 100644 index 00000000..45e52c0f --- /dev/null +++ b/docs/reference/spinach.html @@ -0,0 +1,147 @@ + +Inhibition of photosynthesis — spinach • drc + Skip to contents + + +
    +
    +
    +

    Inhibition of photosynthesis

    + +
    spinach.Rd
    +
    + +
    +

    Data from an experiment investigating the inhibition of photosynthesis in response to two synthetic + photosystem II inhibitors, the herbicides diuron and bentazon. + More specifically, the effect of oxygen consumption of thylakoid membranes (chloroplasts) from spinach + was measured after incubation with the synthetic inhibitors in 5 assays, resulting in 5 dose-response curves.

    +
    + +
    +

    Usage

    + 
    data(spinach)
    +
    + +
    +

    Format

    +

    A data frame with 105 observations on the following four variables:

    CURVE
    +

    a numeric vector specifying the assay or curve (a total of 5 independent assays where used in this experiment).

    + +
    HERBICIDE
    +

    a character vector specifying the herbicide applied: bentazon or diuron.

    + +
    DOSE
    +

    a numeric vector giving the herbicide concentration in muMol.

    + +
    SLOPE
    +

    a numeric vector with the measured response: oxygen consumption of thylakoid membranes.

    + + +
    +
    +

    Details

    +

    The experiment is described in more details by Streibig (1998).

    +
    +
    +

    Source

    +

    Streibig, J. C. (1998) Joint action of natural and synthetic photosystem II inhibitors, Pesticide Science, 55, 137–146.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## Displaying the first rows in the dataset
+head(spinach)
+#>   CURVE HERBICIDE DOSE   SLOPE
+#> 1     1  bentazon 0.00 1.81295
+#> 2     1  bentazon 0.00 1.86704
+#> 3     1  bentazon 0.00 1.95606
+#> 4     1  bentazon 0.62 1.39073
+#> 5     1  bentazon 0.62 1.15721
+#> 6     1  bentazon 0.62 1.06126
+
+## Fitting a four-parameter log-logistic model with separate curves per herbicide
+spinach.m1 <- drm(SLOPE ~ DOSE, HERBICIDE, data = spinach, fct = LL.4())
+summary(spinach.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>            Estimate Std. Error t-value   p-value    
+#> b:bentazon 0.508817   0.161880  3.1432  0.002218 ** 
+#> b:diuron   1.750572   0.334200  5.2381 9.433e-07 ***
+#> c:bentazon 0.033202   0.159736  0.2079  0.835779    
+#> c:diuron   0.036149   0.080884  0.4469  0.655925    
+#> d:bentazon 1.298217   0.067350 19.2757 < 2.2e-16 ***
+#> d:diuron   1.979936   0.055804 35.4799 < 2.2e-16 ***
+#> e:bentazon 1.599804   1.000457  1.5991  0.113057    
+#> e:diuron   0.203161   0.022802  8.9098 3.022e-14 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.2022188 (97 degrees of freedom)
+
+## Plotting the fitted curves
+plot(spinach.m1, xlab = "Dose (muMol)", ylab = "Oxygen consumption (slope)")
+
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/spinach.md b/docs/reference/spinach.md new file mode 100644 index 00000000..6434d126 --- /dev/null +++ b/docs/reference/spinach.md @@ -0,0 +1,89 @@ +# Inhibition of photosynthesis + +Data from an experiment investigating the inhibition of photosynthesis +in response to two synthetic photosystem II inhibitors, the herbicides +diuron and bentazon. More specifically, the effect of oxygen consumption +of thylakoid membranes (chloroplasts) from spinach was measured after +incubation with the synthetic inhibitors in 5 assays, resulting in 5 +dose-response curves. + +## Usage + +``` r +data(spinach) +``` + +## Format + +A data frame with 105 observations on the following four variables: + +- CURVE: + + a numeric vector specifying the assay or curve (a total of 5 + independent assays where used in this experiment). + +- HERBICIDE: + + a character vector specifying the herbicide applied: bentazon or + diuron. + +- DOSE: + + a numeric vector giving the herbicide concentration in muMol. + +- SLOPE: + + a numeric vector with the measured response: oxygen consumption of + thylakoid membranes. + +## Details + +The experiment is described in more details by Streibig (1998). + +## Source + +Streibig, J. C. (1998) Joint action of natural and synthetic photosystem +II inhibitors, *Pesticide Science*, **55**, 137–146. + +## Examples + +``` r +library(drc) + +## Displaying the first rows in the dataset +head(spinach) +#> CURVE HERBICIDE DOSE SLOPE +#> 1 1 bentazon 0.00 1.81295 +#> 2 1 bentazon 0.00 1.86704 +#> 3 1 bentazon 0.00 1.95606 +#> 4 1 bentazon 0.62 1.39073 +#> 5 1 bentazon 0.62 1.15721 +#> 6 1 bentazon 0.62 1.06126 + +## Fitting a four-parameter log-logistic model with separate curves per herbicide +spinach.m1 <- drm(SLOPE ~ DOSE, HERBICIDE, data = spinach, fct = LL.4()) +summary(spinach.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:bentazon 0.508817 0.161880 3.1432 0.002218 ** +#> b:diuron 1.750572 0.334200 5.2381 9.433e-07 *** +#> c:bentazon 0.033202 0.159736 0.2079 0.835779 +#> c:diuron 0.036149 0.080884 0.4469 0.655925 +#> d:bentazon 1.298217 0.067350 19.2757 < 2.2e-16 *** +#> d:diuron 1.979936 0.055804 35.4799 < 2.2e-16 *** +#> e:bentazon 1.599804 1.000457 1.5991 0.113057 +#> e:diuron 0.203161 0.022802 8.9098 3.022e-14 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.2022188 (97 degrees of freedom) + +## Plotting the fitted curves +plot(spinach.m1, xlab = "Dose (muMol)", ylab = "Oxygen consumption (slope)") +``` diff --git a/docs/reference/splitInd.html b/docs/reference/splitInd.html new file mode 100644 index 00000000..28b5cfcc --- /dev/null +++ b/docs/reference/splitInd.html @@ -0,0 +1,70 @@ + +Split index vectors into shared and unique components — splitInd • drc + Skip to contents + + +
    +
    +
    +

    Split index vectors into shared and unique components

    + Source: R/EDcomp.R +
    splitInd.Rd
    +
    + +
    +

    Split index vectors into shared and unique components

    +
    + +
    +

    Usage

    + 
    splitInd(ind1, ind2)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/splitInd.md b/docs/reference/splitInd.md new file mode 100644 index 00000000..88d25216 --- /dev/null +++ b/docs/reference/splitInd.md @@ -0,0 +1,9 @@ +# Split index vectors into shared and unique components + +Split index vectors into shared and unique components + +## Usage + +``` r +splitInd(ind1, ind2) +``` diff --git a/docs/reference/summary.drc.html b/docs/reference/summary.drc.html index 5b26499b..84d1c19f 100644 --- a/docs/reference/summary.drc.html +++ b/docs/reference/summary.drc.html @@ -1,166 +1,130 @@ - - - - - - +Summarising non-linear model fits — summary.drc • drc + Skip to contents -Summarising non-linear model fits — summary.drc • drc - - - +
    +
    +
    +

    Summarising non-linear model fits

    + Source: R/summary.drc.R +
    summary.drc.Rd
    +
    + +
    +

    summary compiles a comprehensive summary for objects of class 'drc'.

    +
    - +
    +

    Usage

    + 
    # S3 method for class 'drc'
+summary(object, od = FALSE, pool = TRUE, ...)
    +
    - - +
    +

    Arguments

    +
    object
    +

    an object of class 'drc'.

    - - - +
    od
    +

    logical. If TRUE adjustment for over-dispersion is used.

    - +
    pool
    +

    logical. If TRUE curves are pooled. Otherwise they are not. This +argument only works for models with independently fitted curves as +specified in drm.

    - -
    -
    - - - -
    +
    ...
    +

    additional arguments.

    -
    -
    -
    -

    Summarising non-linear model fits

    - - +
    +
    +

    Value

    +

    A list of summary statistics that includes parameter estimates and +estimated standard errors.

    +
    +
    +

    See also

    +

    drm, coef.drc, confint.drc

    +
    +
    +

    Author

    +

    Christian Ritz

    -
    - -

    'summary' compiles a comprehensive summary for objects of class 'drc'.

    - +
    +

    Examples

    + 
    ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4())
+summary(ryegrass.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>               Estimate Std. Error t-value   p-value    
+#> b:(Intercept)  2.98222    0.46506  6.4125 2.960e-06 ***
+#> c:(Intercept)  0.48141    0.21219  2.2688   0.03451 *  
+#> d:(Intercept)  7.79296    0.18857 41.3272 < 2.2e-16 ***
+#> e:(Intercept)  3.05795    0.18573 16.4644 4.268e-13 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.5196256 (20 degrees of freedom)
+
+
    +
    - 
    # S3 method for drc
-summary(object, od = FALSE, pool = TRUE, ...)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - -
    object

    an object of class 'drc'.

    od

    logical. If TRUE adjustment for over-dispersion is used.

    pool

    logical. If TRUE curves are pooled. Otherwise they are not. This argument only works for models with - independently fitted curves as specified in drm.

    ...

    additional arguments.

    - -

    Value

    - -

    A list of summary statistics that includes parameter estimates and estimated standard errors.

    - -
    - +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + -
    - - - - + diff --git a/docs/reference/summary.drc.md b/docs/reference/summary.drc.md new file mode 100644 index 00000000..0e130f0f --- /dev/null +++ b/docs/reference/summary.drc.md @@ -0,0 +1,69 @@ +# Summarising non-linear model fits + +`summary` compiles a comprehensive summary for objects of class 'drc'. + +## Usage + +``` r +# S3 method for class 'drc' +summary(object, od = FALSE, pool = TRUE, ...) +``` + +## Arguments + +- object: + + an object of class 'drc'. + +- od: + + logical. If TRUE adjustment for over-dispersion is used. + +- pool: + + logical. If TRUE curves are pooled. Otherwise they are not. This + argument only works for models with independently fitted curves as + specified in + [`drm`](https://hreinwald.github.io/drc/reference/drm.md). + +- ...: + + additional arguments. + +## Value + +A list of summary statistics that includes parameter estimates and +estimated standard errors. + +## See also + +[`drm`](https://hreinwald.github.io/drc/reference/drm.md), +[`coef.drc`](https://hreinwald.github.io/drc/reference/coef.drc.md), +[`confint.drc`](https://hreinwald.github.io/drc/reference/confint.drc.md) + +## Author + +Christian Ritz + +## Examples + +``` r +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +summary(ryegrass.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 2.98222 0.46506 6.4125 2.960e-06 *** +#> c:(Intercept) 0.48141 0.21219 2.2688 0.03451 * +#> d:(Intercept) 7.79296 0.18857 41.3272 < 2.2e-16 *** +#> e:(Intercept) 3.05795 0.18573 16.4644 4.268e-13 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.5196256 (20 degrees of freedom) +``` diff --git a/docs/reference/terbuthylazin-1.png b/docs/reference/terbuthylazin-1.png new file mode 100644 index 00000000..e9db992e Binary files /dev/null and b/docs/reference/terbuthylazin-1.png differ diff --git a/docs/reference/terbuthylazin.html b/docs/reference/terbuthylazin.html new file mode 100644 index 00000000..a83731a1 --- /dev/null +++ b/docs/reference/terbuthylazin.html @@ -0,0 +1,155 @@ + +The effect of terbuthylazin on growth rate — terbuthylazin • drc + Skip to contents + + +
    +
    +
    +

    The effect of terbuthylazin on growth rate

    + +
    terbuthylazin.Rd
    +
    + +
    +

    Test on the effect of terbuthylazin on Lemna minor, performed on an aseptic + culture according to the OECD-guidelines.

    +
    + +
    +

    Usage

    + 
    data(terbuthylazin)
    +
    + +
    +

    Format

    +

    A data frame with 30 observations on the following 2 variables.

    dose
    +

    a numeric vector of dose values.

    + +
    rgr
    +

    a numeric vector of relative growth rates.

    + + +
    +
    +

    Details

    +

    Dose is $$\mu l^{-1}$$ and rgr is the relative growth rate of Lemna.

    +
    +
    +

    Source

    +

    Cedergreen N. (2004). Unpublished bioassay data.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+## displaying first 6 rows of the data set
+head(terbuthylazin)
+#>   dose       rgr
+#> 1    0 0.3017731
+#> 2    0 0.2760291
+#> 3    0 0.3145257
+#> 4    0 0.2663174
+#> 5    0 0.2871303
+#> 6    0 0.3805772
+
+## Fitting log-logistic model
+terbuthylazin.m1 <- drm(rgr~dose, data = terbuthylazin, fct = LL.4())
+summary(terbuthylazin.m1)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                 Estimate Std. Error t-value   p-value    
+#> b:(Intercept) 1.2474e+00 2.3543e-01  5.2984 1.532e-05 ***
+#> c:(Intercept) 8.0293e-04 2.4913e-02  0.0322    0.9745    
+#> d:(Intercept) 3.0695e-01 9.6088e-03 31.9441 < 2.2e-16 ***
+#> e:(Intercept) 1.8914e+02 3.7726e+01  5.0136 3.242e-05 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.02699266 (26 degrees of freedom)
+
+## Fitting log-logistic model
+##  with Box-Cox transformation
+terbuthylazin.m2 <- boxcox(terbuthylazin.m1, method = "anova")
+
+summary(terbuthylazin.m2)
+#> 
+#> Model fitted: Log-logistic (ED50 as parameter) (4 parms)
+#> 
+#> Parameter estimates:
+#> 
+#>                 Estimate Std. Error t-value   p-value    
+#> b:(Intercept) 1.3226e+00 2.3707e-01  5.5788 7.346e-06 ***
+#> c:(Intercept) 5.6549e-03 1.5383e-02  0.3676    0.7161    
+#> d:(Intercept) 3.0520e-01 1.1147e-02 27.3785 < 2.2e-16 ***
+#> e:(Intercept) 1.8290e+02 2.6858e+01  6.8098 3.153e-07 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+#> 
+#> Residual standard error:
+#> 
+#>  0.04562085 (26 degrees of freedom)
+#> 
+#> Non-normality/heterogeneity adjustment through Box-Cox transformation
+#> 
+#> Estimated lambda: 0.707 
+#> Confidence interval for lambda: [0.439,1.016] 
+#> 
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/terbuthylazin.md b/docs/reference/terbuthylazin.md new file mode 100644 index 00000000..eba9fc9a --- /dev/null +++ b/docs/reference/terbuthylazin.md @@ -0,0 +1,95 @@ +# The effect of terbuthylazin on growth rate + +Test on the effect of terbuthylazin on *Lemna minor*, performed on an +aseptic culture according to the OECD-guidelines. + +## Usage + +``` r +data(terbuthylazin) +``` + +## Format + +A data frame with 30 observations on the following 2 variables. + +- dose: + + a numeric vector of dose values. + +- rgr: + + a numeric vector of relative growth rates. + +## Details + +Dose is \$\$\mu l^{-1}\$\$ and rgr is the relative growth rate of +*Lemna*. + +## Source + +Cedergreen N. (2004). Unpublished bioassay data. + +## Examples + +``` r +library(drc) + +## displaying first 6 rows of the data set +head(terbuthylazin) +#> dose rgr +#> 1 0 0.3017731 +#> 2 0 0.2760291 +#> 3 0 0.3145257 +#> 4 0 0.2663174 +#> 5 0 0.2871303 +#> 6 0 0.3805772 + +## Fitting log-logistic model +terbuthylazin.m1 <- drm(rgr~dose, data = terbuthylazin, fct = LL.4()) +summary(terbuthylazin.m1) +#> +#> Model fitted: Log-logistic (ED50 as parameter) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 1.2474e+00 2.3543e-01 5.2984 1.532e-05 *** +#> c:(Intercept) 8.0293e-04 2.4913e-02 0.0322 0.9745 +#> d:(Intercept) 3.0695e-01 9.6088e-03 31.9441 < 2.2e-16 *** +#> e:(Intercept) 1.8914e+02 3.7726e+01 5.0136 3.242e-05 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.02699266 (26 degrees of freedom) + +## Fitting log-logistic model +## with Box-Cox transformation +terbuthylazin.m2 <- boxcox(terbuthylazin.m1, method = "anova") + +summary(terbuthylazin.m2) +#> +#> Model fitted: Log-logistic (ED50 as parameter) (4 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b:(Intercept) 1.3226e+00 2.3707e-01 5.5788 7.346e-06 *** +#> c:(Intercept) 5.6549e-03 1.5383e-02 0.3676 0.7161 +#> d:(Intercept) 3.0520e-01 1.1147e-02 27.3785 < 2.2e-16 *** +#> e:(Intercept) 1.8290e+02 2.6858e+01 6.8098 3.153e-07 *** +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 0.04562085 (26 degrees of freedom) +#> +#> Non-normality/heterogeneity adjustment through Box-Cox transformation +#> +#> Estimated lambda: 0.707 +#> Confidence interval for lambda: [0.439,1.016] +#> +``` diff --git a/docs/reference/threephase.html b/docs/reference/threephase.html new file mode 100644 index 00000000..a6f180f7 --- /dev/null +++ b/docs/reference/threephase.html @@ -0,0 +1,123 @@ + +Three-Phase Dose-Response Model — threephase • drc + Skip to contents + + +
    +
    +
    +

    Three-Phase Dose-Response Model

    + Source: R/threephase.R +
    threephase.Rd
    +
    + +
    +

    A ten-parameter dose-response model combining three log-logistic components, +extending the two-phase model (twophase) for describing even more +complex dose-response patterns.

    +
    + +
    +

    Usage

    + 
    threephase(
+  fixed = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA),
+  names = c("b1", "c1", "d1", "e1", "b2", "d2", "e2", "b3", "d3", "e3"),
+  fctName,
+  fctText
+)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector specifying which parameters are fixed and at what value +they are fixed. NAs are used for parameters that are not fixed.

    + + +
    names
    +

    a vector of character strings giving the names of the parameters +(should not contain ":"). The default is reasonable.

    + + +
    fctName
    +

    optional character string used internally by convenience functions.

    + + +
    fctText
    +

    optional character string used internally by convenience functions.

    + +
    +
    +

    Value

    +

    A list containing the nonlinear function, the self starter function, +and the parameter names.

    +
    +
    +

    Details

    +

    The model function is the sum of a four-parameter log-logistic model and two +three-parameter log-logistic models:

    +

    $$f(x) = \mathrm{LL.4}(x; b1, c1, d1, e1) + \mathrm{LL.3}(x; b2, d2, e2) + \mathrm{LL.3}(x; b3, d3, e3)$$

    +
    +
    +

    See also

    +

    twophase, llogistic

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/threephase.md b/docs/reference/threephase.md new file mode 100644 index 00000000..64143ca4 --- /dev/null +++ b/docs/reference/threephase.md @@ -0,0 +1,59 @@ +# Three-Phase Dose-Response Model + +A ten-parameter dose-response model combining three log-logistic +components, extending the two-phase model +([`twophase`](https://hreinwald.github.io/drc/reference/twophase.md)) +for describing even more complex dose-response patterns. + +## Usage + +``` r +threephase( + fixed = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), + names = c("b1", "c1", "d1", "e1", "b2", "d2", "e2", "b3", "d3", "e3"), + fctName, + fctText +) +``` + +## Arguments + +- fixed: + + numeric vector specifying which parameters are fixed and at what value + they are fixed. NAs are used for parameters that are not fixed. + +- names: + + a vector of character strings giving the names of the parameters + (should not contain ":"). The default is reasonable. + +- fctName: + + optional character string used internally by convenience functions. + +- fctText: + + optional character string used internally by convenience functions. + +## Value + +A list containing the nonlinear function, the self starter function, and +the parameter names. + +## Details + +The model function is the sum of a four-parameter log-logistic model and +two three-parameter log-logistic models: + +\$\$f(x) = \mathrm{LL.4}(x; b1, c1, d1, e1) + \mathrm{LL.3}(x; b2, d2, +e2) + \mathrm{LL.3}(x; b3, d3, e3)\$\$ + +## See also + +[`twophase`](https://hreinwald.github.io/drc/reference/twophase.md), +[`llogistic`](https://hreinwald.github.io/drc/reference/llogistic.md) + +## Author + +Christian Ritz diff --git a/docs/reference/twophase.html b/docs/reference/twophase.html index 02c5782c..a3c7eda3 100644 --- a/docs/reference/twophase.html +++ b/docs/reference/twophase.html @@ -1,196 +1,129 @@ - - - - - - +Two-Phase Dose-Response Model — twophase • drc + Skip to contents -Two-phase dose-response model — twophase • drc - - - +
    +
    +
    +

    Two-Phase Dose-Response Model

    + Source: R/twophase.R +
    twophase.Rd
    +
    - +
    +

    A seven-parameter dose-response model combining two log-logistic components, +useful for describing more complex dose-response patterns.

    +
    - - +
    +

    Usage

    + 
    twophase(
+  fixed = c(NA, NA, NA, NA, NA, NA, NA),
+  names = c("b1", "c1", "d1", "e1", "b2", "d2", "e2"),
+  fctName,
+  fctText
+)
    +
    +
    +

    Arguments

    - - +
    fixed
    +

    numeric vector specifying which parameters are fixed and at what value +they are fixed. NAs are used for parameters that are not fixed.

    - +
    names
    +

    a vector of character strings giving the names of the parameters +(should not contain ":"). The default is reasonable.

    - - -
    -
    - - - -
    -
    -
    -
    -

    Two-phase dose-response model

    - - -
    +
    fctText
    +

    optional character string used internally by convenience functions.

    -
    - -

    The two-phase dose-response model is a combination of log-logistic models that should be useful for describing - more complex dose-response patterns.

    - +
    +
    +

    Value

    +

    A list containing the nonlinear function, the self starter function, +and the parameter names.

    +
    +
    +

    Details

    +

    Following Groot et al (1996) the two-phase model function is:

    +

    $$f(x) = c + \frac{d1-c}{1+\exp(b1(\log(x)-\log(e1)))} + \frac{d2}{1+\exp(b2(\log(x)-\log(e2)))}$$

    +

    For each of the two phases, the parameters have the same interpretation as in +the ordinary log-logistic model.

    +
    +
    +

    References

    +

    Groot, J. C. J., Cone, J. W., Williams, B. A., Debersaques, F. M. A., +Lantinga, E. A. (1996) Multiphasic analysis of gas production kinetics for +in vitro fermentation of ruminant feeds, +Animal Feed Science Technology, 64, 77–89.

    +
    +
    +

    See also

    +

    The basic component in the two-phase model is the log-logistic model +llogistic.

    +
    +
    +

    Author

    +

    Christian Ritz

    - 
    twophase(fixed = c(NA, NA, NA, NA, NA, NA, NA),
-  names = c("b1", "c1", "d1", "e1", "b2", "d2", "e2"), fctName, fctText)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - -
    fixed

    numeric vector specifying which parameters are fixed and at what value they are fixed. - NAs are used for parameters that are not fixed.

    names

    a vector of character strings giving the names of the parameters (should not contain ":"). - The default is reasonable (see under 'Usage').

    fctName

    optional character string used internally by convenience functions.

    fctText

    optional character string used internally by convenience functions.

    - -

    Details

    - -

    Following Groot et al (1996) the two-phase model function is defined as follows

    -

    $$ f(x) = c + \frac{d1-c}{1+\exp(b1(\log(x)-\log(e1)))} + \frac{d2}{1+\exp(b2(\log(x)-\log(e2)))}$$

    -

    For each of the two phases, the parameters have the same interpretation as in the ordinary log-logistic - model.

    - -

    Value

    - -

    The value returned is a list containing the nonlinear function, the self starter function - and the parameter names.

    - -

    References

    - -

    Groot, J. C. J., Cone, J. W., Williams, B. A., Debersaques, F. M. A., Lantinga, E. A. (1996) - Multiphasic analysis of gas production kinetics for in vitro fermentation of ruminant feeds, - Animal Feed Science Technology, 64, 77--89.

    - -

    See also

    - -

    The basic component in the two-phase model is the log-logistic model - llogistic.

    - - -
    - -

    Author

    - - Christian Ritz -
    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + -
    - - - - + diff --git a/docs/reference/twophase.md b/docs/reference/twophase.md new file mode 100644 index 00000000..e94c7a9d --- /dev/null +++ b/docs/reference/twophase.md @@ -0,0 +1,66 @@ +# Two-Phase Dose-Response Model + +A seven-parameter dose-response model combining two log-logistic +components, useful for describing more complex dose-response patterns. + +## Usage + +``` r +twophase( + fixed = c(NA, NA, NA, NA, NA, NA, NA), + names = c("b1", "c1", "d1", "e1", "b2", "d2", "e2"), + fctName, + fctText +) +``` + +## Arguments + +- fixed: + + numeric vector specifying which parameters are fixed and at what value + they are fixed. NAs are used for parameters that are not fixed. + +- names: + + a vector of character strings giving the names of the parameters + (should not contain ":"). The default is reasonable. + +- fctName: + + optional character string used internally by convenience functions. + +- fctText: + + optional character string used internally by convenience functions. + +## Value + +A list containing the nonlinear function, the self starter function, and +the parameter names. + +## Details + +Following Groot *et al* (1996) the two-phase model function is: + +\$\$f(x) = c + \frac{d1-c}{1+\exp(b1(\log(x)-\log(e1)))} + +\frac{d2}{1+\exp(b2(\log(x)-\log(e2)))}\$\$ + +For each of the two phases, the parameters have the same interpretation +as in the ordinary log-logistic model. + +## References + +Groot, J. C. J., Cone, J. W., Williams, B. A., Debersaques, F. M. A., +Lantinga, E. A. (1996) Multiphasic analysis of gas production kinetics +for in vitro fermentation of ruminant feeds, *Animal Feed Science +Technology*, **64**, 77–89. + +## See also + +The basic component in the two-phase model is the log-logistic model +[`llogistic`](https://hreinwald.github.io/drc/reference/llogistic.md). + +## Author + +Christian Ritz diff --git a/docs/reference/ucedergreen.html b/docs/reference/ucedergreen.html new file mode 100644 index 00000000..6537795b --- /dev/null +++ b/docs/reference/ucedergreen.html @@ -0,0 +1,147 @@ + +U-shaped Cedergreen-Ritz-Streibig model — ucedergreen • drc + Skip to contents + + +
    +
    +
    +

    U-shaped Cedergreen-Ritz-Streibig model

    + Source: R/ucedergreen.R +
    ucedergreen.Rd
    +
    + +
    +

    ucedergreen provides a very general way of specifying the Cedergreen-Ritz-Streibig +modified log-logistic model for describing u-shaped hormesis, under various constraints on the parameters.

    +
    + +
    +

    Usage

    + 
    ucedergreen(
+  fixed = c(NA, NA, NA, NA, NA),
+  names = c("b", "c", "d", "e", "f"),
+  method = c("loglinear", "anke", "method3", "normolle"),
+  ssfct = NULL,
+  alpha,
+  fctName,
+  fctText
+)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    A numeric vector of length 5 specifying any parameters to be held fixed +during the estimation. The order is c(b, c, d, e, f). Use NA for +parameters that should be estimated. The default is to estimate all parameters.

    + + +
    names
    +

    A character vector of length 5 providing names for the parameters. +The default is c("b", "c", "d", "e", "f").

    + + +
    method
    +

    A character string specifying the method for the self-starter function +to use for finding initial parameter values. Options are "loglinear", +"anke", "method3", and "normolle". This is only used if ssfct is NULL.

    + + +
    ssfct
    +

    A custom self-starter function. If NULL (the default), a +self-starter is automatically generated by calling cedergreen.ssf +with the specified method, fixed, and alpha arguments.

    + + +
    alpha
    +

    A mandatory numeric value specifying the fixed shape parameter \(\alpha\). +The function will stop if this is not provided.

    + + +
    fctName
    +

    An optional character string to name the function object.

    + + +
    fctText
    +

    An optional character string providing a descriptive text for the model.

    + +
    +
    +

    Value

    +

    A list of class "UCRS", containing the model function (fct), +the self-starter function (ssfct), parameter names (names), and other +components required for use with modeling functions like drm.

    +
    +
    +

    Details

    +

    The u-shaped model is given by the expression +$$f(x) = c + d - \frac{d-c+f \exp(-1/x^{\alpha})}{1+\exp(b(\log(x)-\log(e)))}$$

    +
    +
    +

    References

    +

    Cedergreen, N. and Ritz, C. and Streibig, J. C. (2005) +Improved empirical models describing hormesis, +Environmental Toxicology and Chemistry 24, 3166–3172.

    +
    +
    +

    See also

    +

    cedergreen, UCRS.4a, UCRS.5a, drm

    +
    +
    +

    Author

    +

    Christian Ritz, Hannes Reinwald

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/ucedergreen.md b/docs/reference/ucedergreen.md new file mode 100644 index 00000000..3f1912d6 --- /dev/null +++ b/docs/reference/ucedergreen.md @@ -0,0 +1,90 @@ +# U-shaped Cedergreen-Ritz-Streibig model + +`ucedergreen` provides a very general way of specifying the +Cedergreen-Ritz-Streibig modified log-logistic model for describing +u-shaped hormesis, under various constraints on the parameters. + +## Usage + +``` r +ucedergreen( + fixed = c(NA, NA, NA, NA, NA), + names = c("b", "c", "d", "e", "f"), + method = c("loglinear", "anke", "method3", "normolle"), + ssfct = NULL, + alpha, + fctName, + fctText +) +``` + +## Arguments + +- fixed: + + A numeric vector of length 5 specifying any parameters to be held + fixed during the estimation. The order is `c(b, c, d, e, f)`. Use `NA` + for parameters that should be estimated. The default is to estimate + all parameters. + +- names: + + A character vector of length 5 providing names for the parameters. The + default is `c("b", "c", "d", "e", "f")`. + +- method: + + A character string specifying the method for the self-starter function + to use for finding initial parameter values. Options are + `"loglinear"`, `"anke"`, `"method3"`, and `"normolle"`. This is only + used if `ssfct` is `NULL`. + +- ssfct: + + A custom self-starter function. If `NULL` (the default), a + self-starter is automatically generated by calling + [`cedergreen.ssf`](https://hreinwald.github.io/drc/reference/cedergreen.ssf.md) + with the specified `method`, `fixed`, and `alpha` arguments. + +- alpha: + + A mandatory numeric value specifying the fixed shape parameter + \\\alpha\\. The function will stop if this is not provided. + +- fctName: + + An optional character string to name the function object. + +- fctText: + + An optional character string providing a descriptive text for the + model. + +## Value + +A list of class `"UCRS"`, containing the model function (`fct`), the +self-starter function (`ssfct`), parameter names (`names`), and other +components required for use with modeling functions like +[`drm`](https://hreinwald.github.io/drc/reference/drm.md). + +## Details + +The u-shaped model is given by the expression \$\$f(x) = c + d - +\frac{d-c+f \exp(-1/x^{\alpha})}{1+\exp(b(\log(x)-\log(e)))}\$\$ + +## References + +Cedergreen, N. and Ritz, C. and Streibig, J. C. (2005) Improved +empirical models describing hormesis, *Environmental Toxicology and +Chemistry* **24**, 3166–3172. + +## See also + +[`cedergreen`](https://hreinwald.github.io/drc/reference/cedergreen.md), +[`UCRS.4a`](https://hreinwald.github.io/drc/reference/UCRS.4a.md), +[`UCRS.5a`](https://hreinwald.github.io/drc/reference/UCRS.5a.md), +[`drm`](https://hreinwald.github.io/drc/reference/drm.md) + +## Author + +Christian Ritz, Hannes Reinwald diff --git a/docs/reference/uml3a.html b/docs/reference/uml3a.html new file mode 100644 index 00000000..cd0caa14 --- /dev/null +++ b/docs/reference/uml3a.html @@ -0,0 +1,87 @@ + +Alias for UCRS.4a — uml3a • drc + Skip to contents + + +
    +
    +
    +

    Alias for UCRS.4a

    + Source: R/ucedergreen.R +
    uml3a.Rd
    +
    + +
    +

    uml3a is an alias for UCRS.4a.

    +
    + +
    +

    Usage

    + 
    uml3a(names = c("b", "d", "e", "f"), ...)
    +
    + +
    +

    Arguments

    + + +
    names
    +

    a vector of character strings giving the names of the parameters.

    + + +
    ...
    +

    additional arguments passed to ucedergreen.

    + +
    +
    +

    See also

    +

    UCRS.4a

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/uml3a.md b/docs/reference/uml3a.md new file mode 100644 index 00000000..16016d76 --- /dev/null +++ b/docs/reference/uml3a.md @@ -0,0 +1,25 @@ +# Alias for UCRS.4a + +`uml3a` is an alias for +[`UCRS.4a`](https://hreinwald.github.io/drc/reference/UCRS.4a.md). + +## Usage + +``` r +uml3a(names = c("b", "d", "e", "f"), ...) +``` + +## Arguments + +- names: + + a vector of character strings giving the names of the parameters. + +- ...: + + additional arguments passed to + [`ucedergreen`](https://hreinwald.github.io/drc/reference/ucedergreen.md). + +## See also + +[`UCRS.4a`](https://hreinwald.github.io/drc/reference/UCRS.4a.md) diff --git a/docs/reference/uml3b.html b/docs/reference/uml3b.html new file mode 100644 index 00000000..1a97e380 --- /dev/null +++ b/docs/reference/uml3b.html @@ -0,0 +1,87 @@ + +Alias for UCRS.4b — uml3b • drc + Skip to contents + + +
    +
    +
    +

    Alias for UCRS.4b

    + Source: R/ucedergreen.R +
    uml3b.Rd
    +
    + +
    +

    uml3b is an alias for UCRS.4b.

    +
    + +
    +

    Usage

    + 
    uml3b(names = c("b", "d", "e", "f"), ...)
    +
    + +
    +

    Arguments

    + + +
    names
    +

    a vector of character strings giving the names of the parameters.

    + + +
    ...
    +

    additional arguments passed to ucedergreen.

    + +
    +
    +

    See also

    +

    UCRS.4b

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/uml3b.md b/docs/reference/uml3b.md new file mode 100644 index 00000000..8ca29047 --- /dev/null +++ b/docs/reference/uml3b.md @@ -0,0 +1,25 @@ +# Alias for UCRS.4b + +`uml3b` is an alias for +[`UCRS.4b`](https://hreinwald.github.io/drc/reference/UCRS.4b.md). + +## Usage + +``` r +uml3b(names = c("b", "d", "e", "f"), ...) +``` + +## Arguments + +- names: + + a vector of character strings giving the names of the parameters. + +- ...: + + additional arguments passed to + [`ucedergreen`](https://hreinwald.github.io/drc/reference/ucedergreen.md). + +## See also + +[`UCRS.4b`](https://hreinwald.github.io/drc/reference/UCRS.4b.md) diff --git a/docs/reference/uml3c.html b/docs/reference/uml3c.html new file mode 100644 index 00000000..3df1b57b --- /dev/null +++ b/docs/reference/uml3c.html @@ -0,0 +1,87 @@ + +Alias for UCRS.4c — uml3c • drc + Skip to contents + + +
    +
    +
    +

    Alias for UCRS.4c

    + Source: R/ucedergreen.R +
    uml3c.Rd
    +
    + +
    +

    uml3c is an alias for UCRS.4c.

    +
    + +
    +

    Usage

    + 
    uml3c(names = c("b", "d", "e", "f"), ...)
    +
    + +
    +

    Arguments

    + + +
    names
    +

    a vector of character strings giving the names of the parameters.

    + + +
    ...
    +

    additional arguments passed to ucedergreen.

    + +
    +
    +

    See also

    +

    UCRS.4c

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/uml3c.md b/docs/reference/uml3c.md new file mode 100644 index 00000000..78061804 --- /dev/null +++ b/docs/reference/uml3c.md @@ -0,0 +1,25 @@ +# Alias for UCRS.4c + +`uml3c` is an alias for +[`UCRS.4c`](https://hreinwald.github.io/drc/reference/UCRS.4c.md). + +## Usage + +``` r +uml3c(names = c("b", "d", "e", "f"), ...) +``` + +## Arguments + +- names: + + a vector of character strings giving the names of the parameters. + +- ...: + + additional arguments passed to + [`ucedergreen`](https://hreinwald.github.io/drc/reference/ucedergreen.md). + +## See also + +[`UCRS.4c`](https://hreinwald.github.io/drc/reference/UCRS.4c.md) diff --git a/docs/reference/uml4a.html b/docs/reference/uml4a.html new file mode 100644 index 00000000..bbe0ed87 --- /dev/null +++ b/docs/reference/uml4a.html @@ -0,0 +1,87 @@ + +Alias for UCRS.5a — uml4a • drc + Skip to contents + + +
    +
    +
    +

    Alias for UCRS.5a

    + Source: R/ucedergreen.R +
    uml4a.Rd
    +
    + +
    +

    uml4a is an alias for UCRS.5a.

    +
    + +
    +

    Usage

    + 
    uml4a(names = c("b", "c", "d", "e", "f"), ...)
    +
    + +
    +

    Arguments

    + + +
    names
    +

    a vector of character strings giving the names of the parameters.

    + + +
    ...
    +

    additional arguments passed to ucedergreen.

    + +
    +
    +

    See also

    +

    UCRS.5a

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/uml4a.md b/docs/reference/uml4a.md new file mode 100644 index 00000000..c980de4d --- /dev/null +++ b/docs/reference/uml4a.md @@ -0,0 +1,25 @@ +# Alias for UCRS.5a + +`uml4a` is an alias for +[`UCRS.5a`](https://hreinwald.github.io/drc/reference/UCRS.5a.md). + +## Usage + +``` r +uml4a(names = c("b", "c", "d", "e", "f"), ...) +``` + +## Arguments + +- names: + + a vector of character strings giving the names of the parameters. + +- ...: + + additional arguments passed to + [`ucedergreen`](https://hreinwald.github.io/drc/reference/ucedergreen.md). + +## See also + +[`UCRS.5a`](https://hreinwald.github.io/drc/reference/UCRS.5a.md) diff --git a/docs/reference/uml4b.html b/docs/reference/uml4b.html new file mode 100644 index 00000000..b2edbd83 --- /dev/null +++ b/docs/reference/uml4b.html @@ -0,0 +1,87 @@ + +Alias for UCRS.5b — uml4b • drc + Skip to contents + + +
    +
    +
    +

    Alias for UCRS.5b

    + Source: R/ucedergreen.R +
    uml4b.Rd
    +
    + +
    +

    uml4b is an alias for UCRS.5b.

    +
    + +
    +

    Usage

    + 
    uml4b(names = c("b", "c", "d", "e", "f"), ...)
    +
    + +
    +

    Arguments

    + + +
    names
    +

    a vector of character strings giving the names of the parameters.

    + + +
    ...
    +

    additional arguments passed to ucedergreen.

    + +
    +
    +

    See also

    +

    UCRS.5b

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/uml4b.md b/docs/reference/uml4b.md new file mode 100644 index 00000000..c5d74f21 --- /dev/null +++ b/docs/reference/uml4b.md @@ -0,0 +1,25 @@ +# Alias for UCRS.5b + +`uml4b` is an alias for +[`UCRS.5b`](https://hreinwald.github.io/drc/reference/UCRS.5b.md). + +## Usage + +``` r +uml4b(names = c("b", "c", "d", "e", "f"), ...) +``` + +## Arguments + +- names: + + a vector of character strings giving the names of the parameters. + +- ...: + + additional arguments passed to + [`ucedergreen`](https://hreinwald.github.io/drc/reference/ucedergreen.md). + +## See also + +[`UCRS.5b`](https://hreinwald.github.io/drc/reference/UCRS.5b.md) diff --git a/docs/reference/uml4c.html b/docs/reference/uml4c.html new file mode 100644 index 00000000..680949aa --- /dev/null +++ b/docs/reference/uml4c.html @@ -0,0 +1,87 @@ + +Alias for UCRS.5c — uml4c • drc + Skip to contents + + +
    +
    +
    +

    Alias for UCRS.5c

    + Source: R/ucedergreen.R +
    uml4c.Rd
    +
    + +
    +

    uml4c is an alias for UCRS.5c.

    +
    + +
    +

    Usage

    + 
    uml4c(names = c("b", "c", "d", "e", "f"), ...)
    +
    + +
    +

    Arguments

    + + +
    names
    +

    a vector of character strings giving the names of the parameters.

    + + +
    ...
    +

    additional arguments passed to ucedergreen.

    + +
    +
    +

    See also

    +

    UCRS.5c

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/uml4c.md b/docs/reference/uml4c.md new file mode 100644 index 00000000..0e6e7394 --- /dev/null +++ b/docs/reference/uml4c.md @@ -0,0 +1,25 @@ +# Alias for UCRS.5c + +`uml4c` is an alias for +[`UCRS.5c`](https://hreinwald.github.io/drc/reference/UCRS.5c.md). + +## Usage + +``` r +uml4c(names = c("b", "c", "d", "e", "f"), ...) +``` + +## Arguments + +- names: + + a vector of character strings giving the names of the parameters. + +- ...: + + additional arguments passed to + [`ucedergreen`](https://hreinwald.github.io/drc/reference/ucedergreen.md). + +## See also + +[`UCRS.5c`](https://hreinwald.github.io/drc/reference/UCRS.5c.md) diff --git a/docs/reference/upFixed.html b/docs/reference/upFixed.html new file mode 100644 index 00000000..6141af6f --- /dev/null +++ b/docs/reference/upFixed.html @@ -0,0 +1,90 @@ + +Construct Text for Model with Fixed Upper Limit — upFixed • drc + Skip to contents + + +
    +
    +
    +

    Construct Text for Model with Fixed Upper Limit

    + Source: R/llogistic2.R +
    upFixed.Rd
    +
    + +
    +

    Helper function that appends upper limit information to a model description +string.

    +
    + +
    +

    Usage

    + 
    upFixed(modelStr, upper)
    +
    + +
    +

    Arguments

    + + +
    modelStr
    +

    character string with the base model description.

    + + +
    upper
    +

    numeric value for the fixed upper limit.

    + +
    +
    +

    Value

    +

    A character string describing the model with its fixed upper limit.

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/upFixed.md b/docs/reference/upFixed.md new file mode 100644 index 00000000..83c99763 --- /dev/null +++ b/docs/reference/upFixed.md @@ -0,0 +1,24 @@ +# Construct Text for Model with Fixed Upper Limit + +Helper function that appends upper limit information to a model +description string. + +## Usage + +``` r +upFixed(modelStr, upper) +``` + +## Arguments + +- modelStr: + + character string with the base model description. + +- upper: + + numeric value for the fixed upper limit. + +## Value + +A character string describing the model with its fixed upper limit. diff --git a/docs/reference/update.drc.html b/docs/reference/update.drc.html index 78c12018..1043aef5 100644 --- a/docs/reference/update.drc.html +++ b/docs/reference/update.drc.html @@ -1,182 +1,118 @@ - - - - - - +Updating and re-fitting a model — update.drc • drc + Skip to contents -Updating and re-fitting a model — update.drc • drc - - - +
    +
    +
    +

    Updating and re-fitting a model

    + Source: R/update.drc.R +
    update.drc.Rd
    +
    - - - - +
    +

    update updates and re-fits a model on the basis of an object of class 'drc'.

    +
    +
    +

    Usage

    + 
    # S3 method for class 'drc'
+update(object, ..., evaluate = TRUE)
    +
    +
    +

    Arguments

    - - - +
    object
    +

    an object of class 'drc'.

    - +
    ...
    +

    arguments to alter in object.

    - -
    -
    - - - -
    +
    evaluate
    +

    logical. If TRUE model is re-fit; otherwise an unevaluated call is returned.

    -
    -
    -
    -

    Updating and re-fitting a model

    - - +
    +
    +

    Value

    +

    An object of class 'drc'.

    +
    +
    +

    Author

    +

    Christian Ritz

    -
    - -

    'update' updates and re-fits a model on the basis of an object of class 'drc'.

    - +
    +

    Examples

    + 
    ## Fitting a four-parameter Weibull model
+model1 <- drm(ryegrass, fct = W1.4())
+
+## Updating 'model1' by fitting a three-parameter Weibull model instead
+model2 <- update(model1, fct = W1.3())
+anova(model2, model1)
+#> 
+#> 1st model
+#>  fct:      W1.3()
+#> 2nd model
+#>  fct:      W1.4()
+#> 
+#> ANOVA table
+#> 
+#>           ModelDf    RSS Df F value p value
+#> 1st model      21 8.9520                   
+#> 2nd model      20 6.0242  1  9.7205  0.0054
+
+
    +
    - 
    # S3 method for drc
-update(object, ..., evaluate = TRUE)
    - -

    Arguments

    - - - - - - - - - - - - - - -
    object

    an object of class 'drc'.

    ...

    arguments to alter in object.

    evaluate

    logical. If TRUE model is re-fit; otherwise an unevaluated call is returned.

    - -

    Value

    -

    An object of class 'drc'.

    - - -

    Examples

    - 
    
-## Fitting a four-parameter Weibull model
-model1 <- drm(ryegrass, fct = W1.4())
-
-## Updating 'model1' by fitting a three-parameter Weibull model instead
-model2 <- update(model1, fct = W1.3())
-anova(model2, model1)
    #> 
-#> 1st model
-#>  fct:      W1.3()
-#> 2nd model
-#>  fct:      W1.4()
-#> 
    #> ANOVA table
-#> 
-#>           ModelDf    RSS Df F value p value
-#> 1st model      21 8.9520                   
-#> 2nd model      20 6.0242  1  9.7205  0.0054
    
-
-
    -
    - +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + -
    - - - - + diff --git a/docs/reference/update.drc.md b/docs/reference/update.drc.md new file mode 100644 index 00000000..0e7afd9d --- /dev/null +++ b/docs/reference/update.drc.md @@ -0,0 +1,56 @@ +# Updating and re-fitting a model + +`update` updates and re-fits a model on the basis of an object of class +'drc'. + +## Usage + +``` r +# S3 method for class 'drc' +update(object, ..., evaluate = TRUE) +``` + +## Arguments + +- object: + + an object of class 'drc'. + +- ...: + + arguments to alter in object. + +- evaluate: + + logical. If TRUE model is re-fit; otherwise an unevaluated call is + returned. + +## Value + +An object of class 'drc'. + +## Author + +Christian Ritz + +## Examples + +``` r +## Fitting a four-parameter Weibull model +model1 <- drm(ryegrass, fct = W1.4()) + +## Updating 'model1' by fitting a three-parameter Weibull model instead +model2 <- update(model1, fct = W1.3()) +anova(model2, model1) +#> +#> 1st model +#> fct: W1.3() +#> 2nd model +#> fct: W1.4() +#> +#> ANOVA table +#> +#> ModelDf RSS Df F value p value +#> 1st model 21 8.9520 +#> 2nd model 20 6.0242 1 9.7205 0.0054 +``` diff --git a/docs/reference/ursa.html b/docs/reference/ursa.html index 3b016d8e..d742059c 100644 --- a/docs/reference/ursa.html +++ b/docs/reference/ursa.html @@ -1,224 +1,160 @@ - - - - - - +Universal Response Surface Approach (URSA) for Drug Interaction — ursa • drc + Skip to contents -Model function for the universal response surface approach (URSA) for the quantitative assessment of drug interaction — ursa • drc - - - +
    +
    +
    +

    Universal Response Surface Approach (URSA) for Drug Interaction

    + Source: R/ursa.R +
    ursa.Rd
    +
    - - - - +
    +

    URSA provides a parametric approach for modelling the joint action of several +agents. The model allows quantification of synergistic effects through a single +parameter. The model function is defined implicitly through an appropriate equation.

    +
    +
    +

    Usage

    + 
    ursa(
+  fixed = rep(NA, 7),
+  names = c("b1", "b2", "c", "d", "e1", "e2", "f"),
+  ssfct = NULL
+)
    +
    +
    +

    Arguments

    - - - +
    fixed
    +

    numeric vector. Specifies which parameters are fixed and at what value +they are fixed. NAs for parameters that are not fixed.

    - +
    names
    +

    a vector of character strings giving the names of the parameters. +The default is reasonable.

    - -
    -
    - - - -
    +
    ssfct
    +

    a self starter function to be used (optional).

    -
    -
    -
    -

    Model function for the universal response surface approach (URSA) for the quantitative assessment of drug interaction

    - - +
    +
    +

    Value

    +

    A list containing the nonlinear function, the self starter function, +and the parameter names.

    - -
    - -

    URSA provides a parametric approach for modelling the joint action of several agents. The model allows quantification of synergistic effects through a single parameter.

    - +
    +

    References

    +

    Greco, W. R. and Park H. S. and Rustum, Y. M. (1990) Application of a New +Approach for the Quantitation of Drug Synergism to the Combination of +cis-Diamminedichloroplatinum and 1-beta-D-Arabinofuranosylcytosine, +Cancer Research, 50, 5318–5327.

    +

    Greco, W. R. Bravo, G. and Parsons, J. C. (1995) The Search for Synergy: +A Critical Review from a Response Surface Perspective, +Pharmacological Reviews, 47, Issue 2, 331–385.

    +
    +
    +

    See also

    +

    Other models for fitting mixture data: mixture.

    +
    +
    +

    Author

    +

    Christian Ritz after an idea by Hugo Ceulemans.

    - 
    ursa(fixed = rep(NA, 7), names = c("b1", "b2", "c", "d", "e1", "e1", "f"),
-  ssfct = NULL)
    - -

    Arguments

    - - - - - - - - - - - - - - -
    fixed

    numeric vector. Specifies which parameters are fixed and at what value they are fixed. NAs for parameter that are not fixed.

    names

    a vector of character strings giving the names of the parameters. The default is reasonable.

    ssfct

    a self starter function to be used (optional).

    - -

    Details

    - -

    The model function is defined implicitly through an appropriate equation. More details are provided by Greco et al (1990, 1995).

    - -

    Value

    - -

    A list containing the nonlinear function, the self starter function, and the parameter names.

    - -

    References

    - - -

    Greco, W. R. and Park H. S. and Rustum, Y. M. (1990) Application of a New Approach for the Quantitation of Drug Synergism - to the Combination of cis-Diamminedichloroplatinum and 1-beta-D-Arabinofuranosylcytosine, Cancer Research, 50, 5318--5327.

    -

    Greco, W. R. Bravo, G. and Parsons, J. C. (1995) The Search for Synergy: A Critical Review from a Response Surface Perspective, - Pharmacological Reviews, 47, Issue 2, 331--385.

    - -

    See also

    - -

    Other models for fitting mixture data are the Hewlett and Voelund models mixture.

    - - -

    Examples

    - 
    
-## Here is the complete statistical analysis of the data 
-##  from Greco et al. (1995) by means of the URSA model
-if (FALSE)
-{
-d1 <- c(0, 0, 0, 0, 0, 0, 0, 0, 2, 5, 10, 20, 50, 2, 2, 2,
-2, 2, 5, 5, 5, 5, 5, 10, 10, 10, 10, 10, 20, 20, 20, 20,
-20, 50, 50, 50, 50, 50)
-
-d2 <- c(0, 0, 0, 0.2, 0.5, 1, 2, 5, 0, 0, 0, 0, 0, 0.2,
-0.5, 1, 2, 5, 0.2, 0.5,  1, 2, 5, 0.2, 0.5, 1, 2, 5, 0.2,
-0.5, 1, 2, 5, 0.2, 0.5, 1, 2, 5)
-
-effect <- c(106.00, 99.20, 115.00, 79.20, 70.10, 49.00,
-21.00, 3.83, 74.20, 71.50,48.10, 30.90, 16.30, 76.30,
-48.80, 44.50, 15.50, 3.21, 56.70, 47.50, 26.80, 16.90,
-3.25, 46.70, 35.60, 21.50, 11.10, 2.94, 24.80, 21.60,
-17.30, 7.78, 1.84, 13.60, 11.10, 6.43, 3.34, 0.89)
-
-greco <- data.frame(d1, d2, effect)
-
-greco.m1 <- drm(effect ~ d1 + d2, data = greco, fct = ursa(fixed = c(NA, NA, 0, NA, NA, NA, NA)))
-
-plot(fitted(greco.m1), residuals(greco.m1)) # wedge-shaped
-
-summary(greco.m1)
-
-## Transform-both-sides approach using a logarithm transformation
-greco.m2 <- drm(effect ~ d1 + d2, data = greco, fct = ursa(fixed = c(NA, NA, 0, NA, NA, NA, NA)),
-bcVal = 0, control = drmc(relTol = 1e-12))
-
-plot(fitted(greco.m2), residuals(greco.m2))  # looks okay
-
-summary(greco.m2)
-# close to the estimates reported by Greco et al. (1995)
-}
    -
    -
    -

    Author

    - - Christian Ritz after an idea by Hugo Ceulemans. -
    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + -
    - - - - + diff --git a/docs/reference/ursa.md b/docs/reference/ursa.md new file mode 100644 index 00000000..33eb1788 --- /dev/null +++ b/docs/reference/ursa.md @@ -0,0 +1,95 @@ +# Universal Response Surface Approach (URSA) for Drug Interaction + +URSA provides a parametric approach for modelling the joint action of +several agents. The model allows quantification of synergistic effects +through a single parameter. The model function is defined implicitly +through an appropriate equation. + +## Usage + +``` r +ursa( + fixed = rep(NA, 7), + names = c("b1", "b2", "c", "d", "e1", "e2", "f"), + ssfct = NULL +) +``` + +## Arguments + +- fixed: + + numeric vector. Specifies which parameters are fixed and at what value + they are fixed. NAs for parameters that are not fixed. + +- names: + + a vector of character strings giving the names of the parameters. The + default is reasonable. + +- ssfct: + + a self starter function to be used (optional). + +## Value + +A list containing the nonlinear function, the self starter function, and +the parameter names. + +## References + +Greco, W. R. and Park H. S. and Rustum, Y. M. (1990) Application of a +New Approach for the Quantitation of Drug Synergism to the Combination +of cis-Diamminedichloroplatinum and 1-beta-D-Arabinofuranosylcytosine, +*Cancer Research*, **50**, 5318–5327. + +Greco, W. R. Bravo, G. and Parsons, J. C. (1995) The Search for Synergy: +A Critical Review from a Response Surface Perspective, *Pharmacological +Reviews*, **47**, Issue 2, 331–385. + +## See also + +Other models for fitting mixture data: +[`mixture`](https://hreinwald.github.io/drc/reference/mixture.md). + +## Author + +Christian Ritz after an idea by Hugo Ceulemans. + +## Examples + +``` r +d1 <- c(0, 0, 0, 0, 0, 0, 0, 0, 2, 5, 10, 20, 50, 2, 2, 2, + 2, 2, 5, 5, 5, 5, 5, 10, 10, 10, 10, 10, 20, 20, 20, 20, + 20, 50, 50, 50, 50, 50) +d2 <- c(0, 0, 0, 0.2, 0.5, 1, 2, 5, 0, 0, 0, 0, 0, 0.2, + 0.5, 1, 2, 5, 0.2, 0.5, 1, 2, 5, 0.2, 0.5, 1, 2, 5, 0.2, + 0.5, 1, 2, 5, 0.2, 0.5, 1, 2, 5) +effect <- c(106, 99.2, 115, 79.2, 70.1, 49, 21, 3.83, 74.2, + 71.5, 48.1, 30.9, 16.3, 76.3, 48.8, 44.5, 15.5, 3.21, + 56.7, 47.5, 26.8, 16.9, 3.25, 46.7, 35.6, 21.5, 11.1, + 2.94, 24.8, 21.6, 17.3, 7.78, 1.84, 13.6, 11.1, 6.43, + 3.34, 0.89) +greco <- data.frame(d1, d2, effect) +greco.m1 <- drm(effect ~ d1 + d2, data = greco, + fct = ursa(fixed = c(NA, NA, 0, NA, NA, NA, NA))) +summary(greco.m1) +#> +#> Model fitted: URSA (6 parms) +#> +#> Parameter estimates: +#> +#> Estimate Std. Error t-value p-value +#> b1:(Intercept) -0.959953 0.098934 -9.7030 4.716e-11 *** +#> b2:(Intercept) -1.414817 0.145057 -9.7535 4.160e-11 *** +#> d:(Intercept) 103.466985 2.772607 37.3176 < 2.2e-16 *** +#> e1:(Intercept) 9.209402 0.959596 9.5972 6.139e-11 *** +#> e2:(Intercept) 0.807378 0.072583 11.1236 1.574e-12 *** +#> f:(Intercept) 0.480612 0.273154 1.7595 0.08805 . +#> --- +#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 +#> +#> Residual standard error: +#> +#> 4.727843 (32 degrees of freedom) +``` diff --git a/docs/reference/vcov.drc.html b/docs/reference/vcov.drc.html index 1bd753d9..591e3f62 100644 --- a/docs/reference/vcov.drc.html +++ b/docs/reference/vcov.drc.html @@ -1,192 +1,134 @@ - - - - - - +Calculating variance-covariance matrix for objects of class 'drc' — vcov.drc • drc + Skip to contents -Calculating variance-covariance matrix for objects of class 'drc' — vcov.drc • drc - - - +
    +
    +
    +

    Calculating variance-covariance matrix for objects of class 'drc'

    + Source: R/vcov.drc.R +
    vcov.drc.Rd
    +
    + +
    +

    vcov returns the estimated variance-covariance matrix for the +parameters in the non-linear function.

    +
    - +
    +

    Usage

    + 
    # S3 method for class 'drc'
+vcov(object, ..., corr = FALSE, od = FALSE, pool = TRUE, unscaled = FALSE)
    +
    - - +
    +

    Arguments

    +
    object
    +

    an object of class 'drc'.

    - - - +
    ...
    +

    additional arguments.

    - +
    corr
    +

    logical. If TRUE a correlation matrix is returned.

    - -
    -
    - - - -
    +
    od
    +

    logical. If TRUE adjustment for over-dispersion is used. This +argument only makes a difference for binomial data.

    -
    -
    -
    -

    Calculating variance-covariance matrix for objects of class 'drc'

    - - + +
    pool
    +

    logical. If TRUE curves are pooled. Otherwise they are not. This +argument only works for models with independently fitted curves as +specified in drm.

    + + +
    unscaled
    +

    logical. If TRUE the unscaled variance-covariance is +returned. This argument only makes a difference for continuous data.

    + +
    +
    +

    Value

    +

    A matrix of estimated variances and covariances.

    +
    +
    +

    Author

    +

    Christian Ritz

    -
    - -

    'vcov' returns the estimated variance-covariance matrix for the parameters in the non-linear function.

    - +
    +

    Examples

    + 
    ## Fitting a four-parameter log-logistic model
+ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4())
+vcov(ryegrass.m1)
+#>              [,1]        [,2]        [,3]         [,4]
+#> [1,]  0.216282967  0.04601511 -0.03504683 -0.003763692
+#> [2,]  0.046015113  0.04502563 -0.00471192 -0.016918440
+#> [3,] -0.035046835 -0.00471192  0.03555759 -0.012868772
+#> [4,] -0.003763692 -0.01691844 -0.01286877  0.034496126
+vcov(ryegrass.m1, corr = TRUE)
+#>             [,1]       [,2]       [,3]        [,4]
+#> [1,]  1.00000000  0.4662936 -0.3996423 -0.04357304
+#> [2,]  0.46629357  1.0000000 -0.1177611 -0.42928455
+#> [3,] -0.39964231 -0.1177611  1.0000000 -0.36743943
+#> [4,] -0.04357304 -0.4292845 -0.3674394  1.00000000
+
+
    +
    - 
    # S3 method for drc
-vcov(object, ..., corr = FALSE, od = FALSE, pool = TRUE, unscaled = FALSE)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - - - - - - - - - -
    object

    an object of class 'drc'.

    ...

    additional arguments.

    corr

    logical. If TRUE a correlation matrix is returned.

    od

    logical. If TRUE adjustment for over-dispersion is used. This argument only makes a difference for - binomial data.

    pool

    logical. If TRUE curves are pooled. Otherwise they are not. This argument only works for models with - independently fitted curves as specified in drm.

    unscaled

    logical. If TRUE the unscaled variance-covariance is returned. This argument only makes a difference - for continuous data.

    - -

    Value

    -

    A matrix of estimated variances and covariances.

    - - -

    Examples

    - 
    
-## Fitting a four-parameter log-logistic model
-ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4())
-vcov(ryegrass.m1)
    #>              [,1]        [,2]        [,3]         [,4]
-#> [1,]  0.216282967  0.04601511 -0.03504683 -0.003763692
-#> [2,]  0.046015113  0.04502563 -0.00471192 -0.016918440
-#> [3,] -0.035046835 -0.00471192  0.03555759 -0.012868772
-#> [4,] -0.003763692 -0.01691844 -0.01286877  0.034496126
    vcov(ryegrass.m1, corr = TRUE)
    #>             [,1]       [,2]       [,3]        [,4]
-#> [1,]  1.00000000  0.4662936 -0.3996423 -0.04357304
-#> [2,]  0.46629357  1.0000000 -0.1177611 -0.42928455
-#> [3,] -0.39964231 -0.1177611  1.0000000 -0.36743943
-#> [4,] -0.04357304 -0.4292845 -0.3674394  1.00000000
    
-
    -
    - +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + -
    - - - - + diff --git a/docs/reference/vcov.drc.md b/docs/reference/vcov.drc.md new file mode 100644 index 00000000..dd972a2c --- /dev/null +++ b/docs/reference/vcov.drc.md @@ -0,0 +1,69 @@ +# Calculating variance-covariance matrix for objects of class 'drc' + +`vcov` returns the estimated variance-covariance matrix for the +parameters in the non-linear function. + +## Usage + +``` r +# S3 method for class 'drc' +vcov(object, ..., corr = FALSE, od = FALSE, pool = TRUE, unscaled = FALSE) +``` + +## Arguments + +- object: + + an object of class 'drc'. + +- ...: + + additional arguments. + +- corr: + + logical. If TRUE a correlation matrix is returned. + +- od: + + logical. If TRUE adjustment for over-dispersion is used. This argument + only makes a difference for binomial data. + +- pool: + + logical. If TRUE curves are pooled. Otherwise they are not. This + argument only works for models with independently fitted curves as + specified in + [`drm`](https://hreinwald.github.io/drc/reference/drm.md). + +- unscaled: + + logical. If TRUE the unscaled variance-covariance is returned. This + argument only makes a difference for continuous data. + +## Value + +A matrix of estimated variances and covariances. + +## Author + +Christian Ritz + +## Examples + +``` r +## Fitting a four-parameter log-logistic model +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +vcov(ryegrass.m1) +#> [,1] [,2] [,3] [,4] +#> [1,] 0.216282967 0.04601511 -0.03504683 -0.003763692 +#> [2,] 0.046015113 0.04502563 -0.00471192 -0.016918440 +#> [3,] -0.035046835 -0.00471192 0.03555759 -0.012868772 +#> [4,] -0.003763692 -0.01691844 -0.01286877 0.034496126 +vcov(ryegrass.m1, corr = TRUE) +#> [,1] [,2] [,3] [,4] +#> [1,] 1.00000000 0.4662936 -0.3996423 -0.04357304 +#> [2,] 0.46629357 1.0000000 -0.1177611 -0.42928455 +#> [3,] -0.39964231 -0.1177611 1.0000000 -0.36743943 +#> [4,] -0.04357304 -0.4292845 -0.3674394 1.00000000 +``` diff --git a/docs/reference/vec2mat.html b/docs/reference/vec2mat.html new file mode 100644 index 00000000..b4984e25 --- /dev/null +++ b/docs/reference/vec2mat.html @@ -0,0 +1,70 @@ + +Convert function specification to list — vec2mat • drc + Skip to contents + + +
    +
    +
    +

    Convert function specification to list

    + Source: R/fct2list.R +
    vec2mat.Rd
    +
    + +
    +

    Convert function specification to list

    +
    + +
    +

    Usage

    + 
    vec2mat(fct, no)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/vec2mat.md b/docs/reference/vec2mat.md new file mode 100644 index 00000000..f8ee4b01 --- /dev/null +++ b/docs/reference/vec2mat.md @@ -0,0 +1,9 @@ +# Convert function specification to list + +Convert function specification to list + +## Usage + +``` r +vec2mat(fct, no) +``` diff --git a/docs/reference/vinclozolin-1.png b/docs/reference/vinclozolin-1.png new file mode 100644 index 00000000..ec592e11 Binary files /dev/null and b/docs/reference/vinclozolin-1.png differ diff --git a/docs/reference/vinclozolin.html b/docs/reference/vinclozolin.html new file mode 100644 index 00000000..e1a4e018 --- /dev/null +++ b/docs/reference/vinclozolin.html @@ -0,0 +1,142 @@ + +Vinclozolin from AR in vitro assay — vinclozolin • drc + Skip to contents + + +
    +
    +
    +

    Vinclozolin from AR in vitro assay

    + +
    vinclozolin.Rd
    +
    + +
    +

    Dose-response experiment with vinclozolin in an AR reporter gene assay

    +
    + +
    +

    Usage

    + 
    data(vinclozolin)
    +
    + +
    +

    Format

    +

    A data frame with 53 observations on the following 3 variables.

    exper
    +

    a factor with levels 10509 10821 10828 10904 11023 11106

    + +
    conc
    +

    a numeric vector of concentrations of vinclozolin

    + +
    effect
    +

    a numeric vector of luminescense effects

    + + +
    +
    +

    Details

    +

    The basic dose-response experiment was repeated 6 times on different days. Chinese Hamster Ovary cells + were exposed to various concentrations of vinclozolin for 22 hours and the resulting luminescense effects + were recorded.

    +

    Data are part of mixture experiment reported in Nellemann et al (2003).

    +
    +
    +

    Source

    +

    Nellemann C., Dalgaard M., Lam H.R. and Vinggaard A.M. (2003) + The combined effects of vinclozolin and procymidone do not deviate from expected additivity in vitro + and in vivo, Toxicological Sciences, 71, 251–262.

    +
    + +
    +

    Examples

    + 
    library(drc)
+
+vinclozolin.m1 <- drm(effect~conc, exper, data=vinclozolin, fct = LL.3())
+plot(vinclozolin.m1, xlim=c(0,50), ylim=c(0,2800), conLevel=1e-4)
+#> Warning: "conLevel" is not a graphical parameter
+#> Warning: "conLevel" is not a graphical parameter
+#> Warning: "conLevel" is not a graphical parameter
+#> Warning: "conLevel" is not a graphical parameter
+#> Warning: "conLevel" is not a graphical parameter
+#> Warning: "conLevel" is not a graphical parameter
+#> Warning: "conLevel" is not a graphical parameter
+#> Warning: "conLevel" is not a graphical parameter
+#> Warning: "conLevel" is not a graphical parameter
+#> Warning: "conLevel" is not a graphical parameter
+#> Warning: "conLevel" is not a graphical parameter
+#> Warning: "conLevel" is not a graphical parameter
+#> Warning: "conLevel" is not a graphical parameter
+#> Warning: "conLevel" is not a graphical parameter
+#> Warning: "conLevel" is not a graphical parameter
+
+vinclozolin.m2 <- drm(effect~conc, data=vinclozolin, fct = LL.3())
+plot(vinclozolin.m2, xlim=c(0,50), conLevel=1e-4, add=TRUE, type="none", col="red")
+#> Warning: "conLevel" is not a graphical parameter
+
+
+## Are the ED50 values indetical across experiments?
+vinclozolin.m3 <- update(vinclozolin.m1, pmodels=data.frame(exper, exper, 1))
+anova(vinclozolin.m3, vinclozolin.m1)  # No!
+#> 
+#> 1st model
+#>  fct:     LL.3()
+#>  pmodels: exper, exper, 1
+#> 2nd model
+#>  fct:     LL.3()
+#>  pmodels: exper (for all parameters)
+#> 
+#> ANOVA table
+#> 
+#>           ModelDf    RSS Df F value p value
+#> 1st model      40 972732                   
+#> 2nd model      35 385169  5  10.678   0.000
+
    +
    +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/vinclozolin.md b/docs/reference/vinclozolin.md new file mode 100644 index 00000000..10bf3665 --- /dev/null +++ b/docs/reference/vinclozolin.md @@ -0,0 +1,88 @@ +# Vinclozolin from AR in vitro assay + +Dose-response experiment with vinclozolin in an AR reporter gene assay + +## Usage + +``` r +data(vinclozolin) +``` + +## Format + +A data frame with 53 observations on the following 3 variables. + +- `exper`: + + a factor with levels `10509` `10821` `10828` `10904` `11023` `11106` + +- `conc`: + + a numeric vector of concentrations of vinclozolin + +- `effect`: + + a numeric vector of luminescense effects + +## Details + +The basic dose-response experiment was repeated 6 times on different +days. Chinese Hamster Ovary cells were exposed to various concentrations +of vinclozolin for 22 hours and the resulting luminescense effects were +recorded. + +Data are part of mixture experiment reported in Nellemann *et al* +(2003). + +## Source + +Nellemann C., Dalgaard M., Lam H.R. and Vinggaard A.M. (2003) The +combined effects of vinclozolin and procymidone do not deviate from +expected additivity *in vitro* and *in vivo*, *Toxicological Sciences*, +**71**, 251–262. + +## Examples + +``` r +library(drc) + +vinclozolin.m1 <- drm(effect~conc, exper, data=vinclozolin, fct = LL.3()) +plot(vinclozolin.m1, xlim=c(0,50), ylim=c(0,2800), conLevel=1e-4) +#> Warning: "conLevel" is not a graphical parameter +#> Warning: "conLevel" is not a graphical parameter +#> Warning: "conLevel" is not a graphical parameter +#> Warning: "conLevel" is not a graphical parameter +#> Warning: "conLevel" is not a graphical parameter +#> Warning: "conLevel" is not a graphical parameter +#> Warning: "conLevel" is not a graphical parameter +#> Warning: "conLevel" is not a graphical parameter +#> Warning: "conLevel" is not a graphical parameter +#> Warning: "conLevel" is not a graphical parameter +#> Warning: "conLevel" is not a graphical parameter +#> Warning: "conLevel" is not a graphical parameter +#> Warning: "conLevel" is not a graphical parameter +#> Warning: "conLevel" is not a graphical parameter +#> Warning: "conLevel" is not a graphical parameter + +vinclozolin.m2 <- drm(effect~conc, data=vinclozolin, fct = LL.3()) +plot(vinclozolin.m2, xlim=c(0,50), conLevel=1e-4, add=TRUE, type="none", col="red") +#> Warning: "conLevel" is not a graphical parameter + + +## Are the ED50 values indetical across experiments? +vinclozolin.m3 <- update(vinclozolin.m1, pmodels=data.frame(exper, exper, 1)) +anova(vinclozolin.m3, vinclozolin.m1) # No! +#> +#> 1st model +#> fct: LL.3() +#> pmodels: exper, exper, 1 +#> 2nd model +#> fct: LL.3() +#> pmodels: exper (for all parameters) +#> +#> ANOVA table +#> +#> ModelDf RSS Df F value p value +#> 1st model 40 972732 +#> 2nd model 35 385169 5 10.678 0.000 +``` diff --git a/docs/reference/voelund.html b/docs/reference/voelund.html new file mode 100644 index 00000000..d1a28c6c --- /dev/null +++ b/docs/reference/voelund.html @@ -0,0 +1,119 @@ + +Voelund Mixture Model — voelund • drc + Skip to contents + + +
    +
    +
    +

    Voelund Mixture Model

    + Source: R/voelund.R +
    voelund.Rd
    +
    + +
    +

    Provides the Voelund model for describing the joint action of two compounds +in binary mixture experiments. Used internally by mixture.

    +
    + +
    +

    Usage

    + 
    voelund(
+  fixed = c(NA, NA, NA, NA, NA, NA, NA),
+  names = c("b", "c", "d", "e", "f", "g", "h"),
+  method = c("1", "2", "3", "4"),
+  ssfct = NULL,
+  eps = 1e-10
+)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector. Specifies which parameters are fixed and at what value +they are fixed. NAs for parameters that are not fixed.

    + + +
    names
    +

    a vector of character strings giving the names of the parameters +(should not contain ":").

    + + +
    method
    +

    character string indicating the self starter function to use.

    + + +
    ssfct
    +

    a self starter function to be used (optional).

    + + +
    eps
    +

    numeric tolerance for handling zero dose values.

    + +
    +
    +

    Value

    +

    A list containing the nonlinear model function, the self starter function, +and the parameter names.

    +
    +
    +

    See also

    +

    mixture, hewlett

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/voelund.md b/docs/reference/voelund.md new file mode 100644 index 00000000..012a5f5e --- /dev/null +++ b/docs/reference/voelund.md @@ -0,0 +1,55 @@ +# Voelund Mixture Model + +Provides the Voelund model for describing the joint action of two +compounds in binary mixture experiments. Used internally by +[`mixture`](https://hreinwald.github.io/drc/reference/mixture.md). + +## Usage + +``` r +voelund( + fixed = c(NA, NA, NA, NA, NA, NA, NA), + names = c("b", "c", "d", "e", "f", "g", "h"), + method = c("1", "2", "3", "4"), + ssfct = NULL, + eps = 1e-10 +) +``` + +## Arguments + +- fixed: + + numeric vector. Specifies which parameters are fixed and at what value + they are fixed. NAs for parameters that are not fixed. + +- names: + + a vector of character strings giving the names of the parameters + (should not contain ":"). + +- method: + + character string indicating the self starter function to use. + +- ssfct: + + a self starter function to be used (optional). + +- eps: + + numeric tolerance for handling zero dose values. + +## Value + +A list containing the nonlinear model function, the self starter +function, and the parameter names. + +## See also + +[`mixture`](https://hreinwald.github.io/drc/reference/mixture.md), +[`hewlett`](https://hreinwald.github.io/drc/reference/hewlett.md) + +## Author + +Christian Ritz diff --git a/docs/reference/w2.html b/docs/reference/w2.html new file mode 100644 index 00000000..99da27d4 --- /dev/null +++ b/docs/reference/w2.html @@ -0,0 +1,8 @@ + + + + + + + + diff --git a/docs/reference/w3.html b/docs/reference/w3.html new file mode 100644 index 00000000..d3fd21e0 --- /dev/null +++ b/docs/reference/w3.html @@ -0,0 +1,8 @@ + + + + + + + + diff --git a/docs/reference/w4.html b/docs/reference/w4.html new file mode 100644 index 00000000..084e4dda --- /dev/null +++ b/docs/reference/w4.html @@ -0,0 +1,8 @@ + + + + + + + + diff --git a/docs/reference/weibull1-1.png b/docs/reference/weibull1-1.png deleted file mode 100644 index 91cf66c5..00000000 Binary files a/docs/reference/weibull1-1.png and /dev/null differ diff --git a/docs/reference/weibull1.html b/docs/reference/weibull1.html index eab9a46f..5af69bf0 100644 --- a/docs/reference/weibull1.html +++ b/docs/reference/weibull1.html @@ -1,277 +1,164 @@ - - - - - - +The four-parameter Weibull type 1 model — weibull1 • drc + Skip to contents -Weibull model functions — weibull1 • drc - - - +
    +
    +
    +

    The four-parameter Weibull type 1 model

    + Source: R/weibull1.R +
    weibull1.Rd
    +
    - +
    +

    The general Weibull type 1 model for fitting dose-response data.

    +
    - - +
    +

    Usage

    + 
    weibull1(
+  fixed = c(NA, NA, NA, NA),
+  names = c("b", "c", "d", "e"),
+  method = c("1", "2", "3", "4"),
+  ssfct = NULL,
+  fctName,
+  fctText
+)
    +
    +
    +

    Arguments

    - - +
    fixed
    +

    numeric vector of length 4. Specifies which parameters are +fixed and at what value. Use NA for parameters that are not fixed.

    - +
    names
    +

    character vector of length 4 giving the names of the +parameters b, c, d, and e.

    - - -
    -
    - - - -
    -
    -
    -
    -

    Weibull model functions

    - - -
    +
    ssfct
    +

    a self starter function to be used. If NULL (default), +the built-in self starter is used.

    -
    - -

    'weibull' and 'weibull2' provide a very general way of specifying Weibull dose response functions, - under various constraints on the parameters.

    - -
    - 
    weibull1(fixed = c(NA, NA, NA, NA),
-           names = c("b", "c", "d", "e"),
-           method = c("1", "2", "3", "4"),
-           ssfct = NULL,
-           fctName, fctText)
-
-  weibull2(fixed = c(NA, NA, NA, NA),
-           names = c("b", "c", "d", "e"),
-           method = c("1", "2", "3", "4"),
-           ssfct = NULL,
-           fctName, fctText)
-
-  weibull2x(fixed = rep(NA, 5),
-           names = c("b", "c", "d", "e", "t0"),
-           method = c("1", "2", "3", "4"),
-           ssfct = NULL,
-           fctName, fctText)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - - - - - - - - - -
    fixed

    numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.

    names

    a vector of character strings giving the names of the parameters (should not contain ":"). - The default is reasonable (see under 'Usage'). The order of the parameters is: b, c, d, e (see under 'Details').

    method

    character string indicating the self starter function to use.

    ssfct

    a self starter function to be used.

    fctName

    optional character string used internally by convenience functions.

    fctText

    optional character string used internally by convenience functions.

    - -

    Details

    - -

    As pointed out in Seber and Wild (1989), there exist two different parameterisations of the Weibull model. They - do not yield the same fitted curve for a given dataset (see under Examples).

    -

    The four-parameter Weibull type 1 model ('weibull1') is - $$ f(x) = c + (d-c) \exp(-\exp(b(\log(x)-\log(e)))).$$

    -

    Thw four-parameter Weibull type 2 model ('weibull2') is - $$ f(x) = c + (d-c) (1 - \exp(-\exp(b(\log(x)-\log(e))))).$$

    -

    Both four-parameter model functions are asymmetric with inflection point at the dose equal \(e\).

    - -

    Value

    - -

    The value returned is a list containing the non-linear function, the self starter function - and the parameter names.

    - -

    References

    - -

    Seber, G. A. F. and Wild, C. J (1989) - Nonlinear Regression, - New York: Wiley \& Sons (pp. 338--339).

    - -

    Note

    - -

    The functions are for use with the function drm.

    - -

    See also

    - -

    For convenience several special cases of the function 'weibull1' are available: - W1.2, W1.3 and W1.4.

    -

    Special cases of 'weibull2' are: - W2.2, W2.3 and W2.4.

    -

    These convenience functions should be used rather than the underlying functions - weibull1 and weibull2.

    - - -

    Examples

    - 
    
-## Fitting two different Weibull models
-ryegrass.m1 <- drm(ryegrass, fct = W1.4())
-plot(ryegrass.m1, conLevel=0.5)
    #> Warning: "conLevel" is not a graphical parameter
    #> Warning: "conLevel" is not a graphical parameter
    #> Warning: "conLevel" is not a graphical parameter
    #> Warning: "conLevel" is not a graphical parameter
    #> Warning: "conLevel" is not a graphical parameter
    
-ryegrass.m2 <- drm(ryegrass, fct = W2.4())
-plot(ryegrass.m2, conLevel=0.5, add = TRUE, type = "none", col = 2)
    #> Warning: "conLevel" is not a graphical parameter
    # you could also look at the ED values to see the difference
-
-## A four-parameter Weibull model with b fixed at 1
-ryegrass.m3 <- drm(ryegrass, fct = W1.4(fixed = c(1, NA, NA, NA)))
-summary(ryegrass.m3)
    #> 
-#> Model fitted: Weibull (type 1) (3 parms)
-#> 
-#> Parameter estimates:
-#> 
-#>               Estimate Std. Error t-value   p-value    
-#> c:(Intercept)  0.12945    0.36866  0.3511     0.729    
-#> d:(Intercept)  8.23936    0.30335 27.1613 < 2.2e-16 ***
-#> e:(Intercept)  4.53797    0.63886  7.1032 5.243e-07 ***
-#> ---
-#> Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
-#> 
-#> Residual standard error:
-#> 
-#>  0.8384585 (21 degrees of freedom)
    
-## A four-parameter Weibull model with the constraint b>3
-ryegrass.m4 <- drm(ryegrass, fct = W1.4(), lowerl = c(3, -Inf, -Inf, -Inf),
-control = drmc(constr=TRUE))
-summary(ryegrass.m4)
    #> 
-#> Model fitted: Weibull (type 1) (4 parms)
-#> 
-#> Parameter estimates:
-#> 
-#>               Estimate Std. Error t-value   p-value    
-#> b:(Intercept)  3.00000    0.82015  3.6579  0.001563 ** 
-#> c:(Intercept)  0.68190    0.18943  3.5999  0.001789 ** 
-#> d:(Intercept)  7.68189    0.23088 33.2719 < 2.2e-16 ***
-#> e:(Intercept)  3.58441    0.16992 21.0951 3.946e-15 ***
-#> ---
-#> Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
-#> 
-#> Residual standard error:
-#> 
-#>  0.5657677 (20 degrees of freedom)
    
-
    -
    -
    +
    +

    Value

    +

    A list of class Weibull-1 containing the nonlinear function, +self starter function, and parameter names.

    +
    +
    +

    Details

    +

    The four-parameter Weibull type 1 model is given by the expression +$$f(x) = c + (d - c) \exp(-\exp(b(\log(x) - \log(e))))$$

    +

    The model is sometimes also called the Gompertz model.

    +

    The method argument determines how starting values for the parameters +b and e are estimated (the starting values for c and +d are always based on the range of the response values). Four methods +are available:

    "1" (default)
    +

    Linear regression on transformed data. Applies a +log-log transformation to the response and a log transformation to the +dose, then fits a linear regression to estimate starting values for +b and e.

    + +
    "2"
    +

    Anke's procedure. Estimates e by finding the dose +at which the response crosses the midpoint between c and d, +then estimates b as the median of back-calculated values.

    + +
    "3"
    +

    Stepwise approach. Identifies where the mean response +crosses the midpoint between c and d and uses the +corresponding dose as the starting value for e. The starting value +for b is based on the sign of the slope at that point.

    + +
    "4"
    +

    Normolle's procedure. Uses the mean of the dose range as +an initial estimate for e, then estimates b and e +using median-based back-calculations.

    + + +
    +
    +

    References

    +

    Seber, G. A. F. and Wild, C. J. (1989) +Nonlinear Regression, New York: Wiley & Sons (pp. 338–339).

    +
    +
    +

    See also

    +

    W1.2, W1.3, W1.4, +weibull2

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    -
  • See also
    • - -
  • Examples
    • - +
    -

    Author

    - Christian Ritz -
    - -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -

    Site built with pkgdown.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -
    +
    + + + - - - + diff --git a/docs/reference/weibull1.md b/docs/reference/weibull1.md new file mode 100644 index 00000000..f4913d38 --- /dev/null +++ b/docs/reference/weibull1.md @@ -0,0 +1,107 @@ +# The four-parameter Weibull type 1 model + +The general Weibull type 1 model for fitting dose-response data. + +## Usage + +``` r +weibull1( + fixed = c(NA, NA, NA, NA), + names = c("b", "c", "d", "e"), + method = c("1", "2", "3", "4"), + ssfct = NULL, + fctName, + fctText +) +``` + +## Arguments + +- fixed: + + numeric vector of length 4. Specifies which parameters are fixed and + at what value. Use `NA` for parameters that are not fixed. + +- names: + + character vector of length 4 giving the names of the parameters `b`, + `c`, `d`, and `e`. + +- method: + + character string indicating the self starter function to use for + obtaining starting values (`"1"` (default), `"2"`, `"3"`, or `"4"`). + See Details. + +- ssfct: + + a self starter function to be used. If `NULL` (default), the built-in + self starter is used. + +- fctName: + + optional character string used internally for the function name. + +- fctText: + + optional character string used internally for the function text + description. + +## Value + +A list of class `Weibull-1` containing the nonlinear function, self +starter function, and parameter names. + +## Details + +The four-parameter Weibull type 1 model is given by the expression +\$\$f(x) = c + (d - c) \exp(-\exp(b(\log(x) - \log(e))))\$\$ + +The model is sometimes also called the Gompertz model. + +The `method` argument determines how starting values for the parameters +`b` and `e` are estimated (the starting values for `c` and `d` are +always based on the range of the response values). Four methods are +available: + +- `"1"` (default): + + Linear regression on transformed data. Applies a log-log + transformation to the response and a log transformation to the dose, + then fits a linear regression to estimate starting values for `b` and + `e`. + +- `"2"`: + + Anke's procedure. Estimates `e` by finding the dose at which the + response crosses the midpoint between `c` and `d`, then estimates `b` + as the median of back-calculated values. + +- `"3"`: + + Stepwise approach. Identifies where the mean response crosses the + midpoint between `c` and `d` and uses the corresponding dose as the + starting value for `e`. The starting value for `b` is based on the + sign of the slope at that point. + +- `"4"`: + + Normolle's procedure. Uses the mean of the dose range as an initial + estimate for `e`, then estimates `b` and `e` using median-based + back-calculations. + +## References + +Seber, G. A. F. and Wild, C. J. (1989) *Nonlinear Regression*, New York: +Wiley & Sons (pp. 338–339). + +## See also + +[`W1.2`](https://hreinwald.github.io/drc/reference/W1.2.md), +[`W1.3`](https://hreinwald.github.io/drc/reference/W1.3.md), +[`W1.4`](https://hreinwald.github.io/drc/reference/W1.4.md), +[`weibull2`](https://hreinwald.github.io/drc/reference/weibull2.md) + +## Author + +Christian Ritz diff --git a/docs/reference/weibull1.ssf.html b/docs/reference/weibull1.ssf.html new file mode 100644 index 00000000..37b62ac6 --- /dev/null +++ b/docs/reference/weibull1.ssf.html @@ -0,0 +1,70 @@ + +Self-starter for Weibull type 1 model — weibull1.ssf • drc + Skip to contents + + +
    +
    +
    +

    Self-starter for Weibull type 1 model

    + Source: R/weibull1.ssf.R +
    weibull1.ssf.Rd
    +
    + +
    +

    Self-starter for Weibull type 1 model

    +
    + +
    +

    Usage

    + 
    weibull1.ssf(method = c("1", "2", "3", "4"), fixed, useFixed = FALSE)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/weibull1.ssf.md b/docs/reference/weibull1.ssf.md new file mode 100644 index 00000000..e66c3324 --- /dev/null +++ b/docs/reference/weibull1.ssf.md @@ -0,0 +1,9 @@ +# Self-starter for Weibull type 1 model + +Self-starter for Weibull type 1 model + +## Usage + +``` r +weibull1.ssf(method = c("1", "2", "3", "4"), fixed, useFixed = FALSE) +``` diff --git a/docs/reference/weibull2.html b/docs/reference/weibull2.html new file mode 100644 index 00000000..2b5f6611 --- /dev/null +++ b/docs/reference/weibull2.html @@ -0,0 +1,165 @@ + +The four-parameter Weibull (type 2) model — weibull2 • drc + Skip to contents + + +
    +
    +
    +

    The four-parameter Weibull (type 2) model

    + Source: R/weibull2.R +
    weibull2.Rd
    +
    + +
    +

    Provides a general framework for the four-parameter Weibull type 2 model +given by the equation +$$f(x) = c + (d - c)(1 - \exp(-\exp(b(\log(x) - \log(e)))))$$

    +
    + +
    +

    Usage

    + 
    weibull2(
+  fixed = c(NA, NA, NA, NA),
+  names = c("b", "c", "d", "e"),
+  method = c("1", "2", "3", "4"),
+  ssfct = NULL,
+  fctName,
+  fctText
+)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector of length 4, specifying fixed parameters (use NA for +parameters that should be estimated).

    + + +
    names
    +

    character vector of length 4 giving the names of the parameters +(default c("b", "c", "d", "e")).

    + + +
    method
    +

    character string indicating the self starter method to use for +obtaining starting values. One of "1" (default), "2", +"3", or "4". See Details.

    + + +
    ssfct
    +

    a self starter function. If NULL (default), a built-in +self starter is used based on method.

    + + +
    fctName
    +

    optional character string used internally for the function name.

    + + +
    fctText
    +

    optional character string used internally for the function description.

    + +
    +
    +

    Value

    +

    A list containing the nonlinear function, self starter function, +and parameter names. The list has class "Weibull-2".

    +
    +
    +

    Details

    +

    The method argument determines how starting values for the parameters +b and e are estimated (the starting values for c and +d are always based on the range of the response values). Four methods +are available:

    "1" (default)
    +

    Linear regression on transformed data. Applies a +complementary log-log transformation to the response and a log +transformation to the dose, then fits a linear regression to estimate +starting values for b and e.

    + +
    "2"
    +

    Anke's procedure. Estimates e by finding the dose +at which the response crosses the midpoint between c and d, +then estimates b as the median of back-calculated values.

    + +
    "3"
    +

    Stepwise approach. Identifies where the mean response +crosses the midpoint between c and d and uses the +corresponding dose as the starting value for e. The starting value +for b is based on the sign of the slope at that point.

    + +
    "4"
    +

    Normolle's procedure. Uses the mean of the dose range as +an initial estimate for e, then estimates b and e +using median-based back-calculations.

    + + +
    +
    +

    References

    +

    Seber, G. A. F. and Wild, C. J. (1989) +Nonlinear Regression, New York: Wiley & Sons (pp. 338–339).

    +
    +
    +

    See also

    +

    weibull1, W2.2, W2.3, +W2.4

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/weibull2.md b/docs/reference/weibull2.md new file mode 100644 index 00000000..853746ba --- /dev/null +++ b/docs/reference/weibull2.md @@ -0,0 +1,104 @@ +# The four-parameter Weibull (type 2) model + +Provides a general framework for the four-parameter Weibull type 2 model +given by the equation \$\$f(x) = c + (d - c)(1 - \exp(-\exp(b(\log(x) - +\log(e)))))\$\$ + +## Usage + +``` r +weibull2( + fixed = c(NA, NA, NA, NA), + names = c("b", "c", "d", "e"), + method = c("1", "2", "3", "4"), + ssfct = NULL, + fctName, + fctText +) +``` + +## Arguments + +- fixed: + + numeric vector of length 4, specifying fixed parameters (use `NA` for + parameters that should be estimated). + +- names: + + character vector of length 4 giving the names of the parameters + (default `c("b", "c", "d", "e")`). + +- method: + + character string indicating the self starter method to use for + obtaining starting values. One of `"1"` (default), `"2"`, `"3"`, or + `"4"`. See Details. + +- ssfct: + + a self starter function. If `NULL` (default), a built-in self starter + is used based on `method`. + +- fctName: + + optional character string used internally for the function name. + +- fctText: + + optional character string used internally for the function + description. + +## Value + +A list containing the nonlinear function, self starter function, and +parameter names. The list has class `"Weibull-2"`. + +## Details + +The `method` argument determines how starting values for the parameters +`b` and `e` are estimated (the starting values for `c` and `d` are +always based on the range of the response values). Four methods are +available: + +- `"1"` (default): + + Linear regression on transformed data. Applies a complementary log-log + transformation to the response and a log transformation to the dose, + then fits a linear regression to estimate starting values for `b` and + `e`. + +- `"2"`: + + Anke's procedure. Estimates `e` by finding the dose at which the + response crosses the midpoint between `c` and `d`, then estimates `b` + as the median of back-calculated values. + +- `"3"`: + + Stepwise approach. Identifies where the mean response crosses the + midpoint between `c` and `d` and uses the corresponding dose as the + starting value for `e`. The starting value for `b` is based on the + sign of the slope at that point. + +- `"4"`: + + Normolle's procedure. Uses the mean of the dose range as an initial + estimate for `e`, then estimates `b` and `e` using median-based + back-calculations. + +## References + +Seber, G. A. F. and Wild, C. J. (1989) *Nonlinear Regression*, New York: +Wiley & Sons (pp. 338–339). + +## See also + +[`weibull1`](https://hreinwald.github.io/drc/reference/weibull1.md), +[`W2.2`](https://hreinwald.github.io/drc/reference/W2.2.md), +[`W2.3`](https://hreinwald.github.io/drc/reference/W2.3.md), +[`W2.4`](https://hreinwald.github.io/drc/reference/W2.4.md) + +## Author + +Christian Ritz diff --git a/docs/reference/weibull2.ssf.html b/docs/reference/weibull2.ssf.html new file mode 100644 index 00000000..e395f6c2 --- /dev/null +++ b/docs/reference/weibull2.ssf.html @@ -0,0 +1,70 @@ + +Self-starter for Weibull type 2 model — weibull2.ssf • drc + Skip to contents + + +
    +
    +
    +

    Self-starter for Weibull type 2 model

    + Source: R/weibull2.ssf.R +
    weibull2.ssf.Rd
    +
    + +
    +

    Self-starter for Weibull type 2 model

    +
    + +
    +

    Usage

    + 
    weibull2.ssf(method = c("1", "2", "3", "4"), fixed, useFixed = FALSE)
    +
    + + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/weibull2.ssf.md b/docs/reference/weibull2.ssf.md new file mode 100644 index 00000000..d4d194fc --- /dev/null +++ b/docs/reference/weibull2.ssf.md @@ -0,0 +1,9 @@ +# Self-starter for Weibull type 2 model + +Self-starter for Weibull type 2 model + +## Usage + +``` r +weibull2.ssf(method = c("1", "2", "3", "4"), fixed, useFixed = FALSE) +``` diff --git a/docs/reference/weibull2x.html b/docs/reference/weibull2x.html new file mode 100644 index 00000000..57c06718 --- /dev/null +++ b/docs/reference/weibull2x.html @@ -0,0 +1,139 @@ + +Five-parameter Weibull type 2 model with lag time — weibull2x • drc + Skip to contents + + +
    +
    +
    +

    Five-parameter Weibull type 2 model with lag time

    + Source: R/weibull2x.R +
    weibull2x.Rd
    +
    + +
    +

    A five-parameter Weibull type 2 model extended with a lag time parameter +t0. The model is given by the expression +$$f(x) = c + (d - c)(1 - \exp(-\exp(b(\log(x - t0) - \log(e)))))$$ +for \(x > t0\) and \(f(x) = c\) otherwise.

    +
    + +
    +

    Usage

    + 
    weibull2x(
+  fixed = rep(NA, 5),
+  names = c("b", "c", "d", "e", "t0"),
+  method = c("1", "2", "3", "4"),
+  ssfct = NULL,
+  fctName,
+  fctText
+)
    +
    + +
    +

    Arguments

    + + +
    fixed
    +

    numeric vector of length 5. Specifies which parameters are +fixed and at what value. Use NA for parameters that should be +estimated (default is rep(NA, 5)).

    + + +
    names
    +

    character vector of length 5 giving the names of the +parameters (default is c("b", "c", "d", "e", "t0")).

    + + +
    method
    +

    character string indicating the self starter method to use. +One of "1", "2", "3", or "4".

    + + +
    ssfct
    +

    a self starter function. If NULL (default), a built-in +self starter is used.

    + + +
    fctName
    +

    optional character string specifying the function name +(used internally).

    + + +
    fctText
    +

    optional character string specifying the function description +(used internally).

    + +
    +
    +

    Value

    +

    A list of class "Weibull-2" containing the nonlinear +function, self starter function, and parameter names.

    +
    +
    +

    Details

    +

    The lag time parameter t0 cannot be fixed.

    +
    +
    +

    See also

    +

    weibull2, W2x.3, W2x.4

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    + +
    + + +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    +
    + +
    +

    Site built with pkgdown 2.2.0.

    +
    + +
    + + + + + + + diff --git a/docs/reference/weibull2x.md b/docs/reference/weibull2x.md new file mode 100644 index 00000000..474f44a8 --- /dev/null +++ b/docs/reference/weibull2x.md @@ -0,0 +1,71 @@ +# Five-parameter Weibull type 2 model with lag time + +A five-parameter Weibull type 2 model extended with a lag time parameter +`t0`. The model is given by the expression \$\$f(x) = c + (d - c)(1 - +\exp(-\exp(b(\log(x - t0) - \log(e)))))\$\$ for \\x \> t0\\ and \\f(x) = +c\\ otherwise. + +## Usage + +``` r +weibull2x( + fixed = rep(NA, 5), + names = c("b", "c", "d", "e", "t0"), + method = c("1", "2", "3", "4"), + ssfct = NULL, + fctName, + fctText +) +``` + +## Arguments + +- fixed: + + numeric vector of length 5. Specifies which parameters are fixed and + at what value. Use `NA` for parameters that should be estimated + (default is `rep(NA, 5)`). + +- names: + + character vector of length 5 giving the names of the parameters + (default is `c("b", "c", "d", "e", "t0")`). + +- method: + + character string indicating the self starter method to use. One of + `"1"`, `"2"`, `"3"`, or `"4"`. + +- ssfct: + + a self starter function. If `NULL` (default), a built-in self starter + is used. + +- fctName: + + optional character string specifying the function name (used + internally). + +- fctText: + + optional character string specifying the function description (used + internally). + +## Value + +A list of class `"Weibull-2"` containing the nonlinear function, self +starter function, and parameter names. + +## Details + +The lag time parameter `t0` cannot be fixed. + +## See also + +[`weibull2`](https://hreinwald.github.io/drc/reference/weibull2.md), +[`W2x.3`](https://hreinwald.github.io/drc/reference/W2x.3.md), +[`W2x.4`](https://hreinwald.github.io/drc/reference/W2x.4.md) + +## Author + +Christian Ritz diff --git a/docs/reference/yieldLoss.html b/docs/reference/yieldLoss.html index 9d56845b..c264788b 100644 --- a/docs/reference/yieldLoss.html +++ b/docs/reference/yieldLoss.html @@ -1,226 +1,161 @@ - - - - - - +Calculating yield loss parameters — yieldLoss • drc + Skip to contents -Calculating yield loss parameters — yieldLoss • drc - - - +
    +
    +
    +

    Calculating yield loss parameters

    + Source: R/yieldLoss.R +
    yieldLoss.Rd
    +
    - +
    +

    Calculation of parameters in the re-parameterization of the Michaelis-Menten model that is commonly +used to assess yield loss (the rectangular hyperbola model).

    +
    - - +
    +

    Usage

    + 
    yieldLoss(object, interval = c("none", "as"), level = 0.95, display = TRUE)
    +
    +
    +

    Arguments

    - - +
    object
    +

    object of class 'drc'.

    - +
    interval
    +

    character string specifying the type of confidence intervals. The default is "none". +Use "as" for asymptotically-based confidence intervals.

    - - -
    -
    - - - -
    -
    -
    -
    -

    Calculating yield loss parameters

    - - -
    +
    display
    +

    logical. If TRUE results are displayed. Otherwise they are not (useful in simulations).

    -
    - -

    Calculation of parameters in the re-parameterization of the Michaelis-Menten model that is commonly - used to assess yield loss (the rectangular hyperbola model)

    - +
    +
    +

    Value

    +

    For each of the two parameters, a matrix with two or more columns, containing the estimates +and the corresponding estimated standard errors and possibly lower and upper confidence limits.

    - - 
    yieldLoss(object, interval = c("none", "as"), level = 0.95, display = TRUE)
    - -

    Arguments

    - - - - - - - - - - - - - - - - - - -
    object

    object of class 'drc

    interval

    character string specifying the type of confidence intervals to be supplied. The default is "none". - Use "as" for asymptotically-based confidence intervals.

    level

    numeric. The level for the confidence intervals. The default is 0.95.

    display

    logical. If TRUE results are displayed. Otherwise they are not (useful in simulations).

    - -

    Details

    - +
    +

    Details

    The rectangular hyperbola model is a reparameterization of the Michaelis-Menten in terms of parameters - \(A\) and \(I\)

    -

    $$ Y_L = \frac{Id}{1+Id/A}$$

    -

    where \(d\) denotes the weed density and \(Y_L\) the resulting yield loss.

    - -

    Value

    - -

    For each of the two parameters, a matrix with two or more columns, containing the estimates - and the corresponding estimated standard errors and possibly lower and upper confidence limits.

    - -

    References

    - -

    Cousens, R. (1985). A simple model relating yield loss to weed density, - Ann. Appl. Biol., 107, 239--252.

    - -

    Note

    - +\(A\) and \(I\): +$$Y_L = \frac{Id}{1+Id/A}$$ +where \(d\) denotes the weed density and \(Y_L\) the resulting yield loss.

    +
    +
    +

    Note

    This function is only for use with model fits based on Michaelis-Menten models.

    - - -

    Examples

    - 
    
-## Fitting Michaelis-Menten model
-met.mm.m1 <- drm(gain~dose, product, data = methionine, fct = MM.3(),
-pmodels = list(~1, ~factor(product), ~factor(product)))
    #> Control measurements detected for level: control
    
-## Yield loss parameters with standard errrors
-yieldLoss(met.mm.m1)
    #> 
-#> Estimated A parameters
-#> 
-#>     Estimate Std. Error
-#> DLM 1736.141     18.922
-#> MHA 1868.517     43.930
-#> 
-#> 
-#> Estimated I parameters
-#> 
-#>     Estimate Std. Error
-#> DLM  44578.0    11225.6
-#> MHA  16827.3     3942.7
    
-## Also showing confidence intervals
-yieldLoss(met.mm.m1, "as")
    #> 
-#> Estimated A parameters
-#> 
-#>     Estimate Std. Error    Lower    Upper
-#> DLM 1736.141     18.922 1683.606 1788.676
-#> MHA 1868.517     43.930 1746.547 1990.487
-#> 
-#> 
-#> Estimated I parameters
-#> 
-#>     Estimate Std. Error   Lower   Upper
-#> DLM  44578.0    11225.6 13410.7 75745.2
-#> MHA  16827.3     3942.7  5880.7 27773.8
    
-
    -
    - +
    +

    References

    +

    Cousens, R. (1985). A simple model relating yield loss to weed density, +Ann. Appl. Biol., 107, 239–252.

    +
    +
    +

    Author

    +

    Christian Ritz

    +
    -
  • References
    • +
    +

    Examples

    + 
    ## Fitting Michaelis-Menten model
+met.mm.m1 <- drm(gain~dose, product, data = methionine, fct = MM.3(),
+pmodels = list(~1, ~factor(product), ~factor(product)))
+#> Control measurements detected for level: control
+
+## Yield loss parameters with standard errors
+yieldLoss(met.mm.m1)
+#> 
+#> Estimated A parameters
+#> 
+#>     Estimate Std. Error
+#> DLM 1736.141     18.922
+#> MHA 1868.517     43.930
+#> 
+#> 
+#> Estimated I parameters
+#> 
+#>     Estimate Std. Error
+#> DLM  44578.0    11225.6
+#> MHA  16827.3     3942.7
+
+## Also showing confidence intervals
+yieldLoss(met.mm.m1, "as")
+#> 
+#> Estimated A parameters
+#> 
+#>     Estimate Std. Error    Lower    Upper
+#> DLM 1736.141     18.922 1683.606 1788.676
+#> MHA 1868.517     43.930 1746.547 1990.487
+#> 
+#> 
+#> Estimated I parameters
+#> 
+#>     Estimate Std. Error   Lower   Upper
+#> DLM  44578.0    11225.6 13410.7 75745.2
+#> MHA  16827.3     3942.7  5880.7 27773.8
+
+
    +
    +
    -
  • Note
    • - -
  • Examples
    • - -

    Author

    - Christian Ritz -
    +
    +

    Developed by Christian Ritz, Jens C. Streibig, Hannes Reinwald.

    -
    -
    -

    Developed by Christian Ritz, Jens C. Streibig.

    +
    +

    Site built with pkgdown 2.2.0.

    -
    -

    Site built with pkgdown.

    -
    +
    + + -
    - - - - + diff --git a/docs/reference/yieldLoss.md b/docs/reference/yieldLoss.md new file mode 100644 index 00000000..6071ff25 --- /dev/null +++ b/docs/reference/yieldLoss.md @@ -0,0 +1,100 @@ +# Calculating yield loss parameters + +Calculation of parameters in the re-parameterization of the +Michaelis-Menten model that is commonly used to assess yield loss (the +rectangular hyperbola model). + +## Usage + +``` r +yieldLoss(object, interval = c("none", "as"), level = 0.95, display = TRUE) +``` + +## Arguments + +- object: + + object of class 'drc'. + +- interval: + + character string specifying the type of confidence intervals. The + default is "none". Use "as" for asymptotically-based confidence + intervals. + +- level: + + numeric. The level for the confidence intervals. The default is 0.95. + +- display: + + logical. If TRUE results are displayed. Otherwise they are not (useful + in simulations). + +## Value + +For each of the two parameters, a matrix with two or more columns, +containing the estimates and the corresponding estimated standard errors +and possibly lower and upper confidence limits. + +## Details + +The rectangular hyperbola model is a reparameterization of the +Michaelis-Menten in terms of parameters \\A\\ and \\I\\: \$\$Y_L = +\frac{Id}{1+Id/A}\$\$ where \\d\\ denotes the weed density and \\Y_L\\ +the resulting yield loss. + +## Note + +This function is only for use with model fits based on Michaelis-Menten +models. + +## References + +Cousens, R. (1985). A simple model relating yield loss to weed density, +*Ann. Appl. Biol.*, **107**, 239–252. + +## Author + +Christian Ritz + +## Examples + +``` r +## Fitting Michaelis-Menten model +met.mm.m1 <- drm(gain~dose, product, data = methionine, fct = MM.3(), +pmodels = list(~1, ~factor(product), ~factor(product))) +#> Control measurements detected for level: control + +## Yield loss parameters with standard errors +yieldLoss(met.mm.m1) +#> +#> Estimated A parameters +#> +#> Estimate Std. Error +#> DLM 1736.141 18.922 +#> MHA 1868.517 43.930 +#> +#> +#> Estimated I parameters +#> +#> Estimate Std. Error +#> DLM 44578.0 11225.6 +#> MHA 16827.3 3942.7 + +## Also showing confidence intervals +yieldLoss(met.mm.m1, "as") +#> +#> Estimated A parameters +#> +#> Estimate Std. Error Lower Upper +#> DLM 1736.141 18.922 1683.606 1788.676 +#> MHA 1868.517 43.930 1746.547 1990.487 +#> +#> +#> Estimated I parameters +#> +#> Estimate Std. Error Lower Upper +#> DLM 44578.0 11225.6 13410.7 75745.2 +#> MHA 16827.3 3942.7 5880.7 27773.8 +``` diff --git a/docs/search.json b/docs/search.json new file mode 100644 index 00000000..efac20e4 --- /dev/null +++ b/docs/search.json @@ -0,0 +1 @@ +[{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"executive-summary","dir":"Articles","previous_headings":"","what":"Executive Summary","title":"A Practical Workflow for Dose-Response Analysis","text":"vignette provides comprehensive, step--step workflow conducting proper dose-response analysis using drc package. demonstrate complete analysis process initial model fitting model selection, validation, interpretation. following workflow, even inexperienced users can perform rigorous dose-response modeling avoiding common pitfalls.","code":""},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"introduction","dir":"Articles","previous_headings":"","what":"Introduction","title":"A Practical Workflow for Dose-Response Analysis","text":"Dose-response analysis fundamental toxicology, ecotoxicology, pharmacology, related fields. relationship dose (concentration) biological response often follows non-linear patterns require specialized statistical models. drc package provides comprehensive framework fitting, comparing, interpreting dose-response models.","code":""},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"what-you-will-learn","dir":"Articles","previous_headings":"Introduction","what":"What You Will Learn","title":"A Practical Workflow for Dose-Response Analysis","text":"vignette demonstrates complete workflow including: Initial exploratory model fitting Visual assessment model adequacy Statistical evaluation model fit Systematic model comparison selection Model-averaged estimation robust inference Understanding impact parameter constraints Choosing appropriate models different data types","code":""},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"the-example-dataset","dir":"Articles","previous_headings":"Introduction","what":"The Example Dataset","title":"A Practical Workflow for Dose-Response Analysis","text":"use ryegrass dataset, contains measurements root length perennial ryegrass (Lolium perenne L.) exposed different concentrations ferulic acid, phenolic compound inhibits plant growth. dataset contains 24 observations : - conc: Ferulic acid concentration millimolar (mM) - rootl: Root length centimeters (cm) observe clear dose-response relationship: concentration increases, root length decreases, indicating inhibitory effect ferulic acid ryegrass root growth.","code":"# Load the ryegrass dataset data(ryegrass) # Examine the data structure head(ryegrass, 10) #> rootl conc #> 1 7.580000 0.00 #> 2 8.000000 0.00 #> 3 8.328571 0.00 #> 4 7.250000 0.00 #> 5 7.375000 0.00 #> 6 7.962500 0.00 #> 7 8.355556 0.94 #> 8 6.914286 0.94 #> 9 7.750000 0.94 #> 10 6.871429 1.88 # Summary statistics summary(ryegrass) #> rootl conc #> Min. :0.2200 Min. : 0.000 #> 1st Qu.:0.8491 1st Qu.: 0.705 #> Median :5.0778 Median : 2.815 #> Mean :4.3272 Mean : 7.384 #> 3rd Qu.:7.4262 3rd Qu.: 9.375 #> Max. :8.3556 Max. :30.000 # Simple exploratory plot plot(rootl ~ conc, data = ryegrass, xlab = \"Ferulic acid concentration (mM)\", ylab = \"Root length (cm)\", main = \"Ryegrass Root Growth vs. Ferulic Acid Concentration\", pch = 16, cex = 1.2)"},{"path":[]},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"choosing-a-starting-model","dir":"Articles","previous_headings":"Step 1: Initial Model Fitting","what":"Choosing a Starting Model","title":"A Practical Workflow for Dose-Response Analysis","text":"typical monotonic dose-response curve, four-parameter log-logistic model (LL.4) excellent starting point. flexible, well-characterized, commonly used toxicology. LL.4 model form: f(x)=c+d−c1+exp(b(log(x)−log(e)))f(x) = c + \\frac{d-c}{1 + \\exp(b(\\log(x) - \\log(e)))} : - b: Slope parameter (steepness curve) - c: Lower asymptote (response infinite dose) - d: Upper asymptote (response zero dose, control response) - e: ED50 EC50 (dose producing 50% maximal effect)","code":""},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"fitting-the-initial-model","dir":"Articles","previous_headings":"Step 1: Initial Model Fitting","what":"Fitting the Initial Model","title":"A Practical Workflow for Dose-Response Analysis","text":"summary provides: - Parameter estimates standard errors - Residual standard error - Model convergence information Interpretation Parameters: - d parameter (upper limit) represents control root length (zero concentration) - c parameter (lower limit) represents minimum root length high concentrations - e parameter (ED50) concentration causing 50% reduction control - b parameter controls steepness dose-response curve","code":"# Fit a four-parameter log-logistic model ryegrass.LL4 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) # Display model summary summary(ryegrass.LL4) #> #> Model fitted: Log-logistic (ED50 as parameter) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 2.98222 0.46506 6.4125 2.960e-06 *** #> c:(Intercept) 0.48141 0.21219 2.2688 0.03451 * #> d:(Intercept) 7.79296 0.18857 41.3272 < 2.2e-16 *** #> e:(Intercept) 3.05795 0.18573 16.4644 4.268e-13 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.5196256 (20 degrees of freedom)"},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"step-2-visual-assessment-of-model-fit","dir":"Articles","previous_headings":"","what":"Step 2: Visual Assessment of Model Fit","title":"A Practical Workflow for Dose-Response Analysis","text":"Visual diagnostics crucial assessing whether fitted model adequately describes data. use two primary tools: standard dose-response plot quantile-quantile (Q-Q) plots.","code":""},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"standard-dose-response-plot","dir":"Articles","previous_headings":"Step 2: Visual Assessment of Model Fit","what":"Standard Dose-Response Plot","title":"A Practical Workflow for Dose-Response Analysis","text":"plot shows: - Observed data points - Fitted dose-response curve - Overall pattern fit Look : - fitted values follow general trend data? - systematic deviations (e.g., points curve certain regions)? - outliers might influence fit?","code":"# Plot the fitted model with data points plot(ryegrass.LL4, type = \"all\", main = \"LL.4 Model Fit to Ryegrass Data\", xlab = \"Ferulic acid concentration (mM)\", ylab = \"Root length (cm)\", lwd = 2, cex = 1.2)"},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"quantile-quantile-q-q-plot","dir":"Articles","previous_headings":"Step 2: Visual Assessment of Model Fit","what":"Quantile-Quantile (Q-Q) Plot","title":"A Practical Workflow for Dose-Response Analysis","text":"Q-Q plots assess whether model residuals follow normal distribution, assumption fitting procedure. Interpretation: - Points fall approximately along diagonal line - Systematic deviations suggest non-normality residuals - Deviations extremes common often acceptable - Severe deviations may indicate model inadequacy outliers","code":"# Create Q-Q plot for residual diagnostics qqnorm(residuals(ryegrass.LL4), main = \"Normal Q-Q Plot of Residuals (LL.4)\", pch = 16, cex = 1.2) qqline(residuals(ryegrass.LL4), col = \"red\", lwd = 2)"},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"residual-plot","dir":"Articles","previous_headings":"Step 2: Visual Assessment of Model Fit","what":"Residual Plot","title":"A Practical Workflow for Dose-Response Analysis","text":"additional useful diagnostic plotting residuals fitted values: Look : - Random scatter around zero (systematic pattern) - Constant variance across fitted values (homoscedasticity) - obvious outliers influential points","code":"# Residuals vs. Fitted values plot(fitted(ryegrass.LL4), residuals(ryegrass.LL4), xlab = \"Fitted values\", ylab = \"Residuals\", main = \"Residual Plot (LL.4)\", pch = 16, cex = 1.2) abline(h = 0, col = \"red\", lwd = 2, lty = 2)"},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"step-3-statistical-evaluation-of-model-fit","dir":"Articles","previous_headings":"","what":"Step 3: Statistical Evaluation of Model Fit","title":"A Practical Workflow for Dose-Response Analysis","text":"Beyond visual assessment, use formal statistical tests evaluate model adequacy significance.","code":""},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"test-for-dose-effect-noeffect","dir":"Articles","previous_headings":"Step 3: Statistical Evaluation of Model Fit","what":"Test for Dose Effect: noEffect()","title":"A Practical Workflow for Dose-Response Analysis","text":"noEffect() function performs likelihood ratio test comparing dose-response model null model (dose effect). Interpretation: - null hypothesis “dose effect” (responses equal) - significant p-value (< 0.05) indicates dose-response model fits significantly better null model - confirms ferulic acid concentration significant effect root length","code":"# Test whether there is a significant dose effect noEffect(ryegrass.LL4) #> Chi-square test Df p-value #> 91.87776 3.00000 0.00000"},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"goodness-of-fit-test-modelfit","dir":"Articles","previous_headings":"Step 3: Statistical Evaluation of Model Fit","what":"Goodness-of-Fit Test: modelFit()","title":"A Practical Workflow for Dose-Response Analysis","text":"modelFit() function assesses whether model adequately describes data using lack--fit test. Interpretation: - test compares fitted model saturated model (perfect fit) - non-significant p-value suggests adequate fit (model significantly worse perfect fit) - significant p-value indicates lack fit (model may inadequate) - Note: test requires replication dose levels","code":"# Perform goodness-of-fit test modelFit(ryegrass.LL4) #> Lack-of-fit test #> #> ModelDf RSS Df F value p value #> ANOVA 17 5.1799 #> DRC model 20 5.4002 3 0.2411 0.8665"},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"estimating-effective-doses-ed","dir":"Articles","previous_headings":"Step 3: Statistical Evaluation of Model Fit","what":"Estimating Effective Doses: ED()","title":"A Practical Workflow for Dose-Response Analysis","text":"Effective dose (ED) effective concentration (EC) values key outputs dose-response analysis. represent dose required produce specified level effect. Understanding ED Values: - EC10: Concentration causing 10% effect (reduction root length) - EC20: Concentration causing 20% effect - EC50: Concentration causing 50% effect (often used summary measure potency) Confidence Intervals: - interval = \"delta\" argument uses delta method CI estimation - Alternative methods include \"fls\" (fieller), \"tfls\" (transformed fieller) - Narrower CIs indicate precise estimates","code":"# Estimate EC10, EC20, and EC50 with 95% confidence intervals # Using delta method for confidence intervals ed_values <- ED(ryegrass.LL4, respLev = c(10, 20, 50), interval = \"delta\") #> #> Estimated effective doses #> #> Estimate Std. Error Lower Upper #> e:10 1.46371 0.18677 1.07411 1.85330 #> e:20 1.92109 0.17774 1.55032 2.29186 #> e:50 3.05795 0.18573 2.67053 3.44538 ed_values #> Estimate Std. Error Lower Upper #> e:10 1.463706 0.1867704 1.074109 1.853302 #> e:20 1.921091 0.1777432 1.550325 2.291857 #> e:50 3.057955 0.1857313 2.670526 3.445384"},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"alternative-confidence-interval-methods","dir":"Articles","previous_headings":"Step 3: Statistical Evaluation of Model Fit","what":"Alternative Confidence Interval Methods","title":"A Practical Workflow for Dose-Response Analysis","text":"Fieller method often preferred ED50 estimation accounts ratio nature parameter.","code":"# Compare different confidence interval methods cat(\"Delta method:\\n\") #> Delta method: ED(ryegrass.LL4, respLev = 50, interval = \"delta\") #> #> Estimated effective doses #> #> Estimate Std. Error Lower Upper #> e:50 3.05795 0.18573 2.67053 3.44538 cat(\"\\nFieller method:\\n\") #> #> Fieller method: ED(ryegrass.LL4, respLev = 50, interval = \"fls\") #> #> Estimated effective doses #> #> Estimate Std. Error Lower Upper #> e:50 21.28399 0.18573 14.44757 31.35531"},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"step-4-model-comparison-and-selection","dir":"Articles","previous_headings":"","what":"Step 4: Model Comparison and Selection","title":"A Practical Workflow for Dose-Response Analysis","text":"critical step dose-response analysis comparing alternative models select appropriate one. Different model families may fit data better depending underlying biological mechanism.","code":""},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"comparing-multiple-models","dir":"Articles","previous_headings":"Step 4: Model Comparison and Selection","what":"Comparing Multiple Models","title":"A Practical Workflow for Dose-Response Analysis","text":"’ll compare initial LL.4 model several alternatives: LN.4: Four-parameter log-normal model W1.4: Four-parameter Weibull type 1 model W2.4: Four-parameter Weibull type 2 model BC.4: Four-parameter Brain-Cousens hormesis model LL.5: Five-parameter log-logistic model (asymmetric) EXD.3: Three-parameter exponential decay model Understanding Output: table shows: - logLik: Log-likelihood (higher better, penalized parameters) - IC: Information criterion (AIC default; lower better) - Res var: Residual variance (lower better) - Lack fit: P-value lack--fit test (non-significant better) Models sorted IC (AIC), best-fitting model top.","code":"# Use mselect() to compare multiple models # This fits each model and compares using AIC model_comparison <- suppressWarnings( mselect( ryegrass.LL4, fctList = list(LN.4(), W1.4(), W2.4(), BC.4(), LL.5(), EXD.3()) ) ) model_comparison #> logLik IC Lack of fit Res var #> W2.4 -15.91352 41.82703 0.945071314 0.2646283 #> LL.4 -16.15514 42.31029 0.866483043 0.2700107 #> LN.4 -16.29214 42.58429 0.818641010 0.2731110 #> LL.5 -15.87828 43.75656 0.853847582 0.2777393 #> BC.4 -17.05120 44.10241 0.565407254 0.2909448 #> W1.4 -17.46720 44.93439 0.450567622 0.3012075 #> EXD.3 -28.22358 64.44717 0.000886637 0.7030127"},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"selecting-the-best-model","dir":"Articles","previous_headings":"Step 4: Model Comparison and Selection","what":"Selecting the Best Model","title":"A Practical Workflow for Dose-Response Analysis","text":"","code":"# Based on mselect results, fit the best model # (In this example, we'll use the model with lowest AIC from the comparison) # For ryegrass data, typically W1.4 or LL.4 performs well ryegrass.best <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) # Summary of best model summary(ryegrass.best) #> #> Model fitted: Weibull (type 1) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 2.39341 0.47832 5.0038 6.813e-05 *** #> c:(Intercept) 0.66045 0.18857 3.5023 0.002243 ** #> d:(Intercept) 7.80586 0.20852 37.4348 < 2.2e-16 *** #> e:(Intercept) 3.60013 0.20311 17.7250 1.068e-13 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.5488238 (20 degrees of freedom) # ED estimates for best model ed_best <- ED(ryegrass.best, respLev = c(10, 20, 50), interval = \"delta\") #> #> Estimated effective doses #> #> Estimate Std. Error Lower Upper #> e:10 1.40598 0.25357 0.87705 1.93491 #> e:20 1.92374 0.23477 1.43403 2.41346 #> e:50 3.08896 0.17331 2.72744 3.45048 ed_best #> Estimate Std. Error Lower Upper #> e:10 1.405979 0.2535663 0.8770491 1.934909 #> e:20 1.923744 0.2347672 1.4340283 2.413460 #> e:50 3.088964 0.1733114 2.7274422 3.450485"},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"visual-comparison-of-models","dir":"Articles","previous_headings":"Step 4: Model Comparison and Selection","what":"Visual Comparison of Models","title":"A Practical Workflow for Dose-Response Analysis","text":"Plotting multiple models together helps visualize differences fit:","code":"# Plot initial LL.4 model plot(ryegrass.LL4, type = \"all\", main = \"Comparison: LL.4 vs W1.4 Models\", xlab = \"Ferulic acid concentration (mM)\", ylab = \"Root length (cm)\", lwd = 2, cex = 1.2, col = \"blue\", legend = FALSE) # Overlay the best model (W1.4) plot(ryegrass.best, add = TRUE, type = \"none\", lwd = 2, col = \"red\", lty = 2) # Add legend legend(\"topright\", legend = c(\"LL.4 (initial)\", \"W1.4 (best)\"), col = c(\"blue\", \"red\"), lwd = 2, lty = c(1, 2), cex = 1.1)"},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"comparing-ed-estimates-between-models","dir":"Articles","previous_headings":"Step 4: Model Comparison and Selection","what":"Comparing ED Estimates Between Models","title":"A Practical Workflow for Dose-Response Analysis","text":"Important Notes: - Different models may yield different ED estimates - Model selection based statistical criteria (AIC) biological plausibility - Small differences AIC (< 2) suggest models essentially equivalent","code":"# Compare EC50 estimates between models cat(\"EC50 from LL.4 model:\\n\") #> EC50 from LL.4 model: ED(ryegrass.LL4, respLev = 50, interval = \"delta\") #> #> Estimated effective doses #> #> Estimate Std. Error Lower Upper #> e:50 3.05795 0.18573 2.67053 3.44538 cat(\"\\nEC50 from W1.4 model:\\n\") #> #> EC50 from W1.4 model: ED(ryegrass.best, respLev = 50, interval = \"delta\") #> #> Estimated effective doses #> #> Estimate Std. Error Lower Upper #> e:50 3.08896 0.17331 2.72744 3.45048"},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"step-5-model-averaged-ed-estimation","dir":"Articles","previous_headings":"","what":"Step 5: Model-Averaged ED Estimation","title":"A Practical Workflow for Dose-Response Analysis","text":"multiple models fit similarly well, model averaging provides robust approach accounts model uncertainty. maED() function computes model-averaged ED estimates using AIC-based weights.","code":""},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"computing-model-averaged-eds","dir":"Articles","previous_headings":"Step 5: Model-Averaged ED Estimation","what":"Computing Model-Averaged EDs","title":"A Practical Workflow for Dose-Response Analysis","text":"Understanding Model Averaging: model receives weight based AIC value Better-fitting models (lower AIC) receive higher weights final estimate weighted average across models Confidence intervals account parameter uncertainty model uncertainty","code":"# Model-averaged EC50 estimation using top 3 models # Based on our mselect results, we'll average over several competitive models ma_results <- maED(ryegrass.LL4, fctList = list(W1.4(), W2.4(), LL.5()), respLev = 50, interval = \"buckland\") #> ED50 Weight #> LL.4 3.057955 0.33027128 #> W1.4 3.088964 0.08893096 #> W2.4 2.996913 0.42054089 #> LL.5 3.023549 0.16025686 ma_results #> Estimate Std. Error Lower Upper #> e:50 3.029528 0.1969989 2.643417 3.415639"},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"comparing-single-model-vs-model-averaged-estimates","dir":"Articles","previous_headings":"Step 5: Model-Averaged ED Estimation","what":"Comparing Single-Model vs Model-Averaged Estimates","title":"A Practical Workflow for Dose-Response Analysis","text":"Use Model Averaging: - Multiple models similar AIC values (ΔAIC < 2-4) - want robust estimates don’t depend selecting single model - Regulatory risk assessment contexts requiring conservative estimates Use Single Model: - One model clearly superior (ΔAIC > 10) - Strong biological rationale specific model form - Simpler interpretation needed","code":"# Compare model-averaged EC50 with single-model estimates cat(\"Single model (W1.4) EC50:\\n\") #> Single model (W1.4) EC50: ED(ryegrass.best, respLev = 50, interval = \"delta\") #> #> Estimated effective doses #> #> Estimate Std. Error Lower Upper #> e:50 3.08896 0.17331 2.72744 3.45048 cat(\"\\nModel-averaged EC50 (top 3 models):\\n\") #> #> Model-averaged EC50 (top 3 models): print(ma_results) #> Estimate Std. Error Lower Upper #> e:50 3.029528 0.1969989 2.643417 3.415639"},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"step-6-impact-of-fixing-asymptotes","dir":"Articles","previous_headings":"","what":"Step 6: Impact of Fixing Asymptotes","title":"A Practical Workflow for Dose-Response Analysis","text":"upper lower asymptotes (parameters d c) can estimated data fixed based prior knowledge. Understanding fix parameters crucial proper model fitting.","code":""},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"understanding-asymptote-parameters","dir":"Articles","previous_headings":"Step 6: Impact of Fixing Asymptotes","what":"Understanding Asymptote Parameters","title":"A Practical Workflow for Dose-Response Analysis","text":"d (upper limit): Response zero dose (control response) c (lower limit): Response infinite dose (maximal effect)","code":""},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"models-with-different-asymptote-constraints","dir":"Articles","previous_headings":"Step 6: Impact of Fixing Asymptotes","what":"Models with Different Asymptote Constraints","title":"A Practical Workflow for Dose-Response Analysis","text":"","code":"# LL.4: Both asymptotes free (4 parameters) ryegrass.LL4 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) # LL.3: Lower asymptote fixed at 0 (3 parameters) ryegrass.LL3 <- drm(rootl ~ conc, data = ryegrass, fct = LL.3()) # LL.3u: Upper asymptote fixed at 1 (3 parameters) # Note: Requires normalized data for this to be meaningful ryegrass_norm <- ryegrass ryegrass_norm$rootl_norm <- ryegrass$rootl / max(ryegrass$rootl) ryegrass.LL3u <- drm(rootl_norm ~ conc, data = ryegrass_norm, fct = LL.3u()) # LL.2: Both asymptotes fixed (2 parameters) ryegrass.LL2 <- drm(rootl_norm ~ conc, data = ryegrass_norm, fct = LL.2()) # Compare models cat(\"LL.4 (both free):\\n\") #> LL.4 (both free): summary(ryegrass.LL4) #> #> Model fitted: Log-logistic (ED50 as parameter) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 2.98222 0.46506 6.4125 2.960e-06 *** #> c:(Intercept) 0.48141 0.21219 2.2688 0.03451 * #> d:(Intercept) 7.79296 0.18857 41.3272 < 2.2e-16 *** #> e:(Intercept) 3.05795 0.18573 16.4644 4.268e-13 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.5196256 (20 degrees of freedom) cat(\"\\nLL.3 (lower = 0):\\n\") #> #> LL.3 (lower = 0): summary(ryegrass.LL3) #> #> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 2.47033 0.34168 7.2299 4.011e-07 *** #> d:(Intercept) 7.85543 0.20438 38.4352 < 2.2e-16 *** #> e:(Intercept) 3.26336 0.19641 16.6154 1.474e-13 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.5615802 (21 degrees of freedom) cat(\"\\nAIC Comparison:\\n\") #> #> AIC Comparison: cat(\"LL.4 (4 params):\", AIC(ryegrass.LL4), \"\\n\") #> LL.4 (4 params): 42.31029 cat(\"LL.3 (3 params):\", AIC(ryegrass.LL3), \"\\n\") #> LL.3 (3 params): 45.20827"},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"visual-comparison-of-constrained-models","dir":"Articles","previous_headings":"Step 6: Impact of Fixing Asymptotes","what":"Visual Comparison of Constrained Models","title":"A Practical Workflow for Dose-Response Analysis","text":"","code":"# Plot models with different constraints plot(ryegrass.LL4, type = \"all\", main = \"Effect of Asymptote Constraints\", xlab = \"Ferulic acid concentration (mM)\", ylab = \"Root length (cm)\", lwd = 2, col = \"black\", legend = FALSE, cex = 1.2) plot(ryegrass.LL3, add = TRUE, type = \"none\", lwd = 2, col = \"blue\", lty = 2) legend(\"topright\", legend = c(\"LL.4 (both free)\", \"LL.3 (c = 0)\"), col = c(\"black\", \"blue\"), lwd = 2, lty = c(1, 2), cex = 1.1)"},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"implications-of-fixing-asymptotes","dir":"Articles","previous_headings":"Step 6: Impact of Fixing Asymptotes","what":"Implications of Fixing Asymptotes","title":"A Practical Workflow for Dose-Response Analysis","text":"Benefits Fixing Asymptotes: 1. Reduced parameter count: Simpler model, fewer parameters estimate 2. Improved stability: Fewer parameters can mean stable fits 3. Biological relevance: Incorporating prior knowledge (e.g., c = 0 complete inhibition impossible) 4. Identifiability: datasets may contain enough information estimate parameters Fix Asymptotes: - Fix c = 0 : - Response go zero (e.g., growth, survival) - Biological knowledge indicates complete inhibition doesn’t occur - Data doesn’t extend high enough doses estimate c Control response known independent measurements Data normalized known maximum (e.g., 100%) want focus relative potency comparisons Keep Asymptotes Free: - Data extends wide dose range - asymptotes clearly identifiable data - strong prior knowledge asymptote values - Model comparison/selection workflow","code":""},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"effect-on-ed-estimates","dir":"Articles","previous_headings":"Step 6: Impact of Fixing Asymptotes","what":"Effect on ED Estimates","title":"A Practical Workflow for Dose-Response Analysis","text":"Important Note: choice asymptote constraints can substantially affect ED estimates, especially EC10 EC20 values depend heavily asymptote values EC50.","code":"# Compare ED estimates with different constraints cat(\"EC50 with LL.4 (both asymptotes free):\\n\") #> EC50 with LL.4 (both asymptotes free): ED(ryegrass.LL4, respLev = 50, interval = \"delta\") #> #> Estimated effective doses #> #> Estimate Std. Error Lower Upper #> e:50 3.05795 0.18573 2.67053 3.44538 cat(\"\\nEC50 with LL.3 (lower asymptote = 0):\\n\") #> #> EC50 with LL.3 (lower asymptote = 0): ED(ryegrass.LL3, respLev = 50, interval = \"delta\") #> #> Estimated effective doses #> #> Estimate Std. Error Lower Upper #> e:50 3.26336 0.19641 2.85491 3.67181"},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"step-7-overview-of-available-models","dir":"Articles","previous_headings":"","what":"Step 7: Overview of Available Models","title":"A Practical Workflow for Dose-Response Analysis","text":"drc package provides numerous dose-response models suitable different types data biological mechanisms. Understanding model use crucial proper analysis.","code":""},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"monotonic-non-hormesis-models","dir":"Articles","previous_headings":"Step 7: Overview of Available Models","what":"Monotonic (Non-Hormesis) Models","title":"A Practical Workflow for Dose-Response Analysis","text":"Monotonic models describe dose-response relationships either strictly increasing strictly decreasing. appropriate response changes consistently one direction dose increases.","code":""},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"log-logistic-models-ll-family","dir":"Articles","previous_headings":"Step 7: Overview of Available Models > Monotonic (Non-Hormesis) Models","what":"Log-Logistic Models (LL family)","title":"A Practical Workflow for Dose-Response Analysis","text":"Characteristics: - Symmetric log-dose scale - commonly used toxicology - S-shaped curve - Parameters: b (slope), c (lower), d (upper), e (ED50) Variants: - LL.2(): 2 parameters (c=0, d=1 fixed) - LL.3(): 3 parameters (c=0) - LL.3u(): 3 parameters (d=1) - LL.4(): 4 parameters (flexible) - LL.5(): 5 parameters (asymmetric, f parameter) Best : - General dose-response data - Toxicity studies - EC50/ED50 estimation Example:","code":"# Standard application of log-logistic model example.LL <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) plot(example.LL, main = \"Log-Logistic Model (LL.4)\")"},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"weibull-models-w1-and-w2-families","dir":"Articles","previous_headings":"Step 7: Overview of Available Models > Monotonic (Non-Hormesis) Models","what":"Weibull Models (W1 and W2 families)","title":"A Practical Workflow for Dose-Response Analysis","text":"Characteristics: - Asymmetric log-dose scale - Two types: W1 (increasing asymmetry) W2 (decreasing asymmetry) - Flexible shape - parameter structure log-logistic Variants: - W1.2(), W1.3(), W1.4(): Weibull type 1 - W2.2(), W2.3(), W2.4(): Weibull type 2 Best : - Data asymmetric dose-response curves - Time--event data - Germination/mortality studies Example:","code":"# Weibull models often fit plant growth data well example.W1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) example.W2 <- drm(rootl ~ conc, data = ryegrass, fct = W2.4()) # Compare plot(example.W1, type = \"all\", main = \"Weibull Type 1 vs Type 2\", lwd = 2, col = \"blue\", legend = FALSE) plot(example.W2, add = TRUE, type = \"none\", lwd = 2, col = \"red\", lty = 2) legend(\"topright\", legend = c(\"W1.4\", \"W2.4\"), col = c(\"blue\", \"red\"), lwd = 2, lty = c(1, 2))"},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"log-normal-models-ln-family","dir":"Articles","previous_headings":"Step 7: Overview of Available Models > Monotonic (Non-Hormesis) Models","what":"Log-Normal Models (LN family)","title":"A Practical Workflow for Dose-Response Analysis","text":"Characteristics: - Based log-normal distribution - Symmetric log-dose scale - Similar log-logistic different tail behavior Variants: - LN.2(), LN.3(), LN.3u(), LN.4() Best : - Data normal distribution log scale - Particle size distributions - Alternative log-logistic AIC suggests Example:","code":"example.LN <- drm(rootl ~ conc, data = ryegrass, fct = LN.4())"},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"exponential-decay-models-exd-family","dir":"Articles","previous_headings":"Step 7: Overview of Available Models > Monotonic (Non-Hormesis) Models","what":"Exponential Decay Models (EXD family)","title":"A Practical Workflow for Dose-Response Analysis","text":"Characteristics: - Exponential decrease - lower asymptote (unless constrained) - Simpler sigmoidal models Variants: - EXD.2(): 2 parameters - EXD.3(): 3 parameters Best : - Exponential decay processes - Radioactive decay - Simple inhibition without clear asymptote Example:","code":"example.EXD <- drm(rootl ~ conc, data = ryegrass, fct = EXD.3())"},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"hormesis-non-monotonic-models","dir":"Articles","previous_headings":"Step 7: Overview of Available Models","what":"Hormesis (Non-Monotonic) Models","title":"A Practical Workflow for Dose-Response Analysis","text":"Hormesis describes biphasic dose-response relationship low doses stimulate response (increase) high doses inhibit (decrease). creates characteristic inverted U-shape J-shape curve.","code":""},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"brain-cousens-models-bc-family","dir":"Articles","previous_headings":"Step 7: Overview of Available Models > Hormesis (Non-Monotonic) Models","what":"Brain-Cousens Models (BC family)","title":"A Practical Workflow for Dose-Response Analysis","text":"Characteristics: - Adds hormesis parameter log-logistic model - Peak response intermediate dose - Widely used hormetic data Variants: - BC.4(): 4 parameters (c=0 fixed) - BC.5(): 5 parameters (free) Parameters: - Standard LL parameters plus f: hormesis parameter (controls magnitude stimulation) Best : - Plant growth stimulation low herbicide doses - Pharmaceutical hormesis - Toxicological hormesis Example (conceptual):","code":"# Example with hormetic data (not ryegrass which is monotonic) # hormetic.model <- drm(response ~ dose, data = hormetic_data, fct = BC.5()) # plot(hormetic.model)"},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"cedergreen-ritz-streibig-models-crs-family","dir":"Articles","previous_headings":"Step 7: Overview of Available Models > Hormesis (Non-Monotonic) Models","what":"Cedergreen-Ritz-Streibig Models (CRS family)","title":"A Practical Workflow for Dose-Response Analysis","text":"Characteristics: - flexible hormesis models - Multiple parameterizations (, b, c variants) - Better pronounced hormesis Variants: - CRS.4a(), CRS.4b(), CRS.4c(): 4-parameter variants - CRS.5a(), CRS.5b(), CRS.5c(): 5-parameter variants - CRS.6(): 6 parameters (flexible) Best : - Strong hormesis effects - BC models don’t fit well - Detailed hormesis characterization","code":""},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"u-shaped-cedergreen-models-ucrs-family","dir":"Articles","previous_headings":"Step 7: Overview of Available Models > Hormesis (Non-Monotonic) Models","what":"U-Shaped Cedergreen Models (UCRS family)","title":"A Practical Workflow for Dose-Response Analysis","text":"Characteristics: - U-shaped response (opposite hormesis) - Low high doses harmful, intermediate doses beneficial - Less common hormesis Variants: - UCRS.4a(), UCRS.4b(), UCRS.4c() - UCRS.5a(), UCRS.5b(), UCRS.5c() Best : - Essential nutrients (deficiency toxicity) - Biphasic therapeutic responses","code":""},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"model-selection-decision-tree","dir":"Articles","previous_headings":"Step 7: Overview of Available Models","what":"Model Selection Decision Tree","title":"A Practical Workflow for Dose-Response Analysis","text":"","code":"Is your dose-response curve monotonic? │ ├─ YES (Monotonic/No Hormesis) │ │ │ ├─ Standard S-shaped curve? → Start with LL.4 │ ├─ Asymmetric curve? → Try W1.4 or W2.4 │ ├─ Simple decay? → Try EXD.3 │ └─ Unknown? → Compare LL.4, W1.4, W2.4, LN.4 using mselect() │ └─ NO (Non-Monotonic/Hormesis) │ ├─ Inverted U-shape (stimulation then inhibition)? → Try BC.5 ├─ Strong hormesis? → Try CRS.5a ├─ U-shaped (harm-benefit-harm)? → Try UCRS.5a └─ Unknown? → Compare BC.5, CRS.5a with mselect()"},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"practical-recommendations","dir":"Articles","previous_headings":"Step 7: Overview of Available Models","what":"Practical Recommendations","title":"A Practical Workflow for Dose-Response Analysis","text":"Start Simple: Begin LL.4 W1.4 monotonic data Use Model Selection: Always compare multiple models mselect() Check Residuals: Visual diagnostics essential Consider Biology: Model choice make biological sense Parameter Constraints: Use simpler models (LL.3, LL.2) appropriate Hormesis Testing: suspect hormesis, explicitly test BC CRS models","code":""},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"comprehensive-model-comparison-example","dir":"Articles","previous_headings":"Step 7: Overview of Available Models","what":"Comprehensive Model Comparison Example","title":"A Practical Workflow for Dose-Response Analysis","text":"","code":"# Compare a wide range of monotonic models for ryegrass data comprehensive <- suppressWarnings( mselect(ryegrass.LL4, nested = TRUE, fctList = list(LL.3(), LL.5(), W1.3(), W1.4(), W2.3(), W2.4(), LN.3(), LN.4(), EXD.3())) ) comprehensive #> logLik IC Lack of fit Res var Nested F test #> W2.3 -16.77862 41.55725 0.794024850 0.2708671 1.000000e+00 #> W2.4 -15.91352 41.82703 0.945071314 0.2646283 2.356418e-01 #> LL.4 -16.15514 42.31029 0.866483043 0.2700107 NA #> LN.4 -16.29214 42.58429 0.818641010 0.2731110 2.899907e-02 #> LL.5 -15.87828 43.75656 0.853847582 0.2777393 1.155597e-01 #> W1.4 -17.46720 44.93439 0.450567622 0.3012075 5.421708e-03 #> LL.3 -18.60413 45.20827 0.353167872 0.3153724 4.597125e-02 #> LN.3 -19.22361 46.44721 0.254436052 0.3320803 2.032428e-02 #> W1.3 -22.22047 52.44094 0.043791495 0.4262881 6.598584e-03 #> EXD.3 -28.22358 64.44717 0.000886637 0.7030127 1.040468e-05"},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"conclusion","dir":"Articles","previous_headings":"","what":"Conclusion","title":"A Practical Workflow for Dose-Response Analysis","text":"vignette demonstrated comprehensive workflow dose-response analysis using drc package. following steps, can:","code":""},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"key-takeaways","dir":"Articles","previous_headings":"Conclusion","what":"Key Takeaways","title":"A Practical Workflow for Dose-Response Analysis","text":"Always Start Exploration: Visualize data fitting models Fit Multiple Models: Don’t rely single model without comparison Use Visual Diagnostics: Q-Q plots residual plots essential Perform Statistical Tests: Use noEffect() modelFit() validate model Compare Systematically: Use mselect() AIC objective model selection Consider Model Averaging: Use maED() multiple models fit similarly Understand Parameter Constraints: Know fix free asymptotes (c, d parameters) Choose Models Based Data Type: Distinguish monotonic hormetic responses","code":""},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"common-pitfalls-to-avoid","dir":"Articles","previous_headings":"Conclusion","what":"Common Pitfalls to Avoid","title":"A Practical Workflow for Dose-Response Analysis","text":"Fitting one model: Always compare alternatives Ignoring diagnostics: Visual statistical checks crucial -parameterization: parameters isn’t always better Inappropriate constraints: Don’t fix parameters without justification Ignoring biology: Statistical fit align biological plausibility Using hormesis models monotonic data: can lead spurious hormesis reporting confidence intervals: Point estimates without uncertainty incomplete","code":""},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"recommended-workflow-summary","dir":"Articles","previous_headings":"Conclusion","what":"Recommended Workflow Summary","title":"A Practical Workflow for Dose-Response Analysis","text":"Explore data plots Fit initial general model (e.g., LL.4) Assess fit visually (Q-Q plots, residual plots) Test statistically (noEffect, modelFit) Compare multiple models (mselect) Select best model use model averaging Estimate EDs/ECs appropriate confidence intervals Evaluate parameter constraints needed Interpret results biological context Report model choice, fit statistics, ED estimates CIs","code":""},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"further-resources","dir":"Articles","previous_headings":"Conclusion","what":"Further Resources","title":"A Practical Workflow for Dose-Response Analysis","text":"See ?drm detailed function documentation See ?LL.4, ?W1.4, etc. specific model documentation See ?mselect model selection details See ?ED effective dose estimation options See “Understanding NEC Models” vignette threshold models","code":""},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"references","dir":"Articles","previous_headings":"","what":"References","title":"A Practical Workflow for Dose-Response Analysis","text":"Ritz, C., Baty, F., Streibig, J. C., Gerhard, D. (2015). Dose-Response Analysis Using R. PLOS ONE, 10(12), e0146021. Ritz, C., Streibig, J. C. (2005). Bioassay analysis using R. Journal Statistical Software, 12(5), 1-22. Brain, P., Cousens, R. (1989). equation describe dose-responses stimulation growth low doses. Weed Research, 29, 93-96. Cedergreen, N., Ritz, C., Streibig, J. C. (2005). Improved empirical models describing hormesis. Environmental Toxicology Chemistry, 24, 3166-3172. Inderjit, Streibig, J. C., Olofsdotter, M. (2002). Joint action phenolic acid mixtures significance allelopathy research. Physiologia Plantarum, 114, 422-428.","code":""},{"path":"https://hreinwald.github.io/drc/articles/dose-response-workflow.html","id":"see-also","dir":"Articles","previous_headings":"","what":"See Also","title":"A Practical Workflow for Dose-Response Analysis","text":"vignette(\"nec-models\") - Understanding NEC Models drc Package ?drm - Main function fitting dose-response models ?ED - Estimating effective doses ?mselect - Model selection ?modelFit - Goodness--fit testing ?plot.drc - Plotting dose-response curves","code":""},{"path":"https://hreinwald.github.io/drc/articles/nec-models.html","id":"executive-summary","dir":"Articles","previous_headings":"","what":"Executive Summary","title":"Understanding NEC Models in the drc Package","text":"drc R package contains 4 NEC (Effect Concentration) functions: NEC, NEC.2, NEC.3, NEC.4. thorough analysis, functions necessary serve distinct purposes. redundancy.","code":""},{"path":"https://hreinwald.github.io/drc/articles/nec-models.html","id":"introduction","dir":"Articles","previous_headings":"","what":"Introduction","title":"Understanding NEC Models in the drc Package","text":"Effect Concentration (NEC) model dose-response model threshold response assumed constant equal control response. proposed alternative classical NOEC (Observed Effect Concentration) regression-based EC/ED approach (Pires et al., 2002). vignette explains differences four NEC functions available drc package provides guidance use variant.","code":""},{"path":"https://hreinwald.github.io/drc/articles/nec-models.html","id":"the-nec-model-equation","dir":"Articles","previous_headings":"","what":"The NEC Model Equation","title":"Understanding NEC Models in the drc Package","text":"NEC model function proposed Pires et al. (2002) : f(x)=c+(d−c)exp(−b(x−e)(x−e))f(x) = c + (d-c) \\exp(-b(x-e)(x-e)) (x−e)(x-e) indicator function equal 0 x≤ex \\leq e 1 x>ex > e.","code":""},{"path":"https://hreinwald.github.io/drc/articles/nec-models.html","id":"model-parameters","dir":"Articles","previous_headings":"The NEC Model Equation","what":"Model Parameters","title":"Understanding NEC Models in the drc Package","text":"b: Slope/rate parameter controlling steepness dose-response curve threshold c: Lower limit (control response) - response level threshold d: Upper limit (maximum response) - asymptotic response high doses e: NEC threshold (effect concentration) - dose effect","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/articles/nec-models.html","id":"base-implementation-nec-not-exported","dir":"Articles","previous_headings":"Function Overview","what":"Base Implementation: NEC (Not Exported)","title":"Understanding NEC Models in the drc Package","text":"NEC function core implementation provides flexible NEC dose-response model. exported package NAMESPACE serves internal implementation engine. Key Features: Accepts fixed argument specify parameters fixed Uses log-logistic self-starter function initialization Returns model list nonlinear function, self starter, parameter names function called internally numbered variants (NEC.2, NEC.3, NEC.4) specific parameter constraints.","code":""},{"path":"https://hreinwald.github.io/drc/articles/nec-models.html","id":"nec-2-two-parameter-nec-model","dir":"Articles","previous_headings":"Function Overview","what":"NEC.2: Two-Parameter NEC Model","title":"Understanding NEC Models in the drc Package","text":"Purpose: Convenience wrapper highly constrained scenarios lower upper limits known. Free Parameters: 2 b: Slope parameter e: NEC threshold Fixed Parameters: c: Fixed 0 d: Fixed user-specified value (default 1) Use Cases: Response bounded known scale (e.g., 0-1 proportions, 0-100 percentages) bounds well-defined experimental design Focus estimation slope threshold Reduces model complexity improves parameter identifiability Example:","code":"# Example with proportion data (bounded 0-1) # Using ryegrass data, normalizing to 0-1 scale data(ryegrass) ryegrass$prop_rootl <- ryegrass$rootl / max(ryegrass$rootl) # Fit NEC.2 model with upper limit fixed at 1 nec2.model <- drm(prop_rootl ~ conc, data = ryegrass, fct = NEC.2()) summary(nec2.model) #> #> Model fitted: NEC with lower limit at 0 and upper limit at 1 (2 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 0.303610 0.035141 8.6397 1.609e-08 *** #> e:(Intercept) 0.751527 0.156092 4.8146 8.261e-05 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.08003264 (22 degrees of freedom)"},{"path":"https://hreinwald.github.io/drc/articles/nec-models.html","id":"nec-3-three-parameter-nec-model","dir":"Articles","previous_headings":"Function Overview","what":"NEC.3: Three-Parameter NEC Model","title":"Understanding NEC Models in the drc Package","text":"Purpose: common variant - assumes zero baseline response variable maximum. Free Parameters: 3 b: Slope parameter d: Upper limit e: NEC threshold Fixed Parameters: c: Fixed 0 Use Cases: Standard toxicological/biological scenarios Baseline response zero (treatment/exposure) Maximum response varies treatment Balances flexibility model stability Reduces overfitting compared NEC.4 Example:","code":"# Fit NEC.3 model - most common case # Assumes zero baseline response nec3.model <- drm(rootl ~ conc, data = ryegrass, fct = NEC.3()) summary(nec3.model) #> #> Model fitted: NEC with lower limit at 0 (3 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 2.54094 NaN NaN NaN #> d:(Intercept) 7.39655 0.23498 31.477 < 2.2e-16 *** #> e:(Intercept) 3.39679 NaN NaN NaN #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.81401 (21 degrees of freedom) # Plot the fitted model plot(nec3.model, type = \"all\", log = \"\", main = \"NEC.3 Model for Ryegrass Root Length\", xlab = \"Ferulic acid concentration (mM)\", ylab = \"Root length (cm)\")"},{"path":"https://hreinwald.github.io/drc/articles/nec-models.html","id":"nec-4-four-parameter-nec-model","dir":"Articles","previous_headings":"Function Overview","what":"NEC.4: Four-Parameter NEC Model","title":"Understanding NEC Models in the drc Package","text":"Purpose: Full flexibility - parameters estimated data. Free Parameters: 4 b: Slope parameter c: Lower limit d: Upper limit e: NEC threshold Use Cases: biological constraints parameters baseline maximum responses vary Model selection comparison workflows Maximum flexibility data supports Cases control/baseline response non-zero unknown Example:","code":"# Fit NEC.4 model - full flexibility nec4.model <- drm(rootl ~ conc, data = ryegrass, fct = NEC.4()) summary(nec4.model) #> #> Model fitted: NEC (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 3.16938 393.27265 0.0081 0.993650 #> c:(Intercept) 0.67201 0.23463 2.8641 0.009592 ** #> d:(Intercept) 7.39666 0.20260 36.5091 < 2.2e-16 *** #> e:(Intercept) 3.41729 41.27705 0.0828 0.934842 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.7017905 (20 degrees of freedom) # Compare parameter estimates coef(nec4.model) #> b:(Intercept) c:(Intercept) d:(Intercept) e:(Intercept) #> 3.1693834 0.6720099 7.3966630 3.4172914"},{"path":"https://hreinwald.github.io/drc/articles/nec-models.html","id":"comparison-of-nec-variants","dir":"Articles","previous_headings":"","what":"Comparison of NEC Variants","title":"Understanding NEC Models in the drc Package","text":"following table summarizes key differences NEC functions:","code":""},{"path":"https://hreinwald.github.io/drc/articles/nec-models.html","id":"model-comparison-example","dir":"Articles","previous_headings":"","what":"Model Comparison Example","title":"Understanding NEC Models in the drc Package","text":"Let’s compare three exported NEC variants ryegrass dataset:","code":"# Fit all three models nec2.fit <- drm(rootl ~ conc, data = ryegrass, fct = NEC.2(upper = max(ryegrass$rootl))) nec3.fit <- drm(rootl ~ conc, data = ryegrass, fct = NEC.3()) nec4.fit <- drm(rootl ~ conc, data = ryegrass, fct = NEC.4()) # Compare models using AIC cat(\"Model Comparison (AIC values):\\n\") #> Model Comparison (AIC values): cat(\"NEC.2:\", AIC(nec2.fit), \"\\n\") #> NEC.2: 52.70586 cat(\"NEC.3:\", AIC(nec3.fit), \"\\n\") #> NEC.3: 63.02673 cat(\"NEC.4:\", AIC(nec4.fit), \"\\n\") #> NEC.4: 56.73556 # Plot all three models together my_plot = function(mod, col = \"black\", lwd = 2, pch = 16) { plot(mod, type = \"all\", main = mod$fct$name, col = col, lwd = lwd, pch = pch, xlab = \"Ferulic acid concentration (mM)\", ylab = \"Root length (cm)\") } my_plot(nec2.fit) my_plot(nec3.fit, col = \"darkblue\", lwd = 2) my_plot(nec4.fit, col = \"darkred\", lwd = 2)"},{"path":"https://hreinwald.github.io/drc/articles/nec-models.html","id":"design-pattern-in-the-drc-package","dir":"Articles","previous_headings":"","what":"Design Pattern in the drc Package","title":"Understanding NEC Models in the drc Package","text":"NEC functions follow standard drc package design pattern used consistently across model families:","code":""},{"path":"https://hreinwald.github.io/drc/articles/nec-models.html","id":"examples-of-similar-patterns","dir":"Articles","previous_headings":"Design Pattern in the drc Package","what":"Examples of Similar Patterns:","title":"Understanding NEC Models in the drc Package","text":"Log-logistic models: llogistic, LL.2, LL.3, LL.3u, LL.4, LL.5 Weibull type 1: weibull1, W1.2, W1.3, W1.3u, W1.4 Weibull type 2: weibull2, W2.2, W2.3, W2.3u, W2.4 Gompertz: gompertz, G.2, G.3, G.3u, G.4 Log-normal: lnormal, LN.2, LN.3, LN.3u, LN.4","code":""},{"path":"https://hreinwald.github.io/drc/articles/nec-models.html","id":"pattern-structure","dir":"Articles","previous_headings":"Design Pattern in the drc Package","what":"Pattern Structure:","title":"Understanding NEC Models in the drc Package","text":"Provides core implementation full parameter flexibility Often exported (used internally) Accepts fixed argument parameter constraints Convenience wrappers common parameter combinations Exported user convenience Number indicates count free parameters serves specific biological/experimental scenarios","code":""},{"path":"https://hreinwald.github.io/drc/articles/nec-models.html","id":"benefits-of-this-design","dir":"Articles","previous_headings":"Design Pattern in the drc Package","what":"Benefits of This Design:","title":"Understanding NEC Models in the drc Package","text":"User convenience: Common cases easy specify Parameter identifiability: Constraining parameters appropriate improves estimation Model selection: Easy compare nested models Biological meaning: Parameter constraints reflect experimental knowledge Backwards compatibility: Adding variants doesn’t break existing code Documentation clarity: variant can specific use-case documentation","code":""},{"path":"https://hreinwald.github.io/drc/articles/nec-models.html","id":"choosing-the-right-nec-variant","dir":"Articles","previous_headings":"","what":"Choosing the Right NEC Variant","title":"Understanding NEC Models in the drc Package","text":"’s decision guide help choose appropriate NEC function: Yes → Use NEC.2 → Go step 2 Yes → Use NEC.3 (common case) → Go step 3 Yes → Use NEC.4 Unsure → Start NEC.3 compare NEC.4 using model selection criteria (AIC, BIC)","code":""},{"path":"https://hreinwald.github.io/drc/articles/nec-models.html","id":"example-decision-process","dir":"Articles","previous_headings":"Choosing the Right NEC Variant","what":"Example Decision Process:","title":"Understanding NEC Models in the drc Package","text":"","code":"# Toxicology study with percentage mortality (0-100%) # Known bounds: lower = 0%, upper = 100% # → Use NEC.2 mortality.model <- drm(mortality ~ dose, data = mydata, fct = NEC.2(upper = 100)) # Plant growth study measuring root length # Control (no treatment) shows some growth (not zero) # → Try both NEC.3 and NEC.4, compare with AIC model3 <- drm(rootlength ~ concentration, data = mydata, fct = NEC.3()) model4 <- drm(rootlength ~ concentration, data = mydata, fct = NEC.4()) mselect(model3, model4) # Standard dose-response with zero baseline # Maximum response unknown # → Use NEC.3 response.model <- drm(response ~ dose, data = mydata, fct = NEC.3())"},{"path":[]},{"path":"https://hreinwald.github.io/drc/articles/nec-models.html","id":"are-any-nec-functions-redundant","dir":"Articles","previous_headings":"Redundancy Assessment","what":"Are any NEC functions redundant?","title":"Understanding NEC Models in the drc Package","text":"Answer: - functions necessary.","code":""},{"path":"https://hreinwald.github.io/drc/articles/nec-models.html","id":"reasoning","dir":"Articles","previous_headings":"Redundancy Assessment","what":"Reasoning:","title":"Understanding NEC Models in the drc Package","text":"removed: Contains actual mathematical implementation functions wrappers call NEC specific constraints Removing break NEC.2, NEC.3, NEC.4 Unique purpose: variant upper lower limits fixed Distinct use case: Bounded response scales (proportions, percentages) replicated: NEC.3 fixes lower limit, NEC.4 fixes nothing Statistical benefit: Reduces parameters 4 2, greatly improving identifiability common scenario: Standard toxicology zero baseline Optimal balance: flexible NEC.2, stable NEC.4 Common convention: Matches typical experimental designs control = 0 Unique constraint: variant fixing lower limit freeing upper limit Essential flexibility: way estimate 4 parameters Model selection: Needed comparing constrained models Non-zero baselines: option control response unknown non-zero Diagnostic tool: Helps determine constraints appropriate","code":""},{"path":"https://hreinwald.github.io/drc/articles/nec-models.html","id":"user-experience-comparison","dir":"Articles","previous_headings":"Redundancy Assessment","what":"User Experience Comparison:","title":"Understanding NEC Models in the drc Package","text":"functions combined, users need manually specify constraints: current design: - Reduces usability barriers - Prevents errors wrong constraint specifications - Provides helpful documentation common cases - Maintains backwards compatibility - Follows established drc package conventions","code":"# Current approach (user-friendly): drm(y ~ x, data = mydata, fct = NEC.3()) # If combined (cumbersome and error-prone): drm(y ~ x, data = mydata, fct = NEC(fixed = c(NA, 0, NA, NA)))"},{"path":[]},{"path":"https://hreinwald.github.io/drc/articles/nec-models.html","id":"starting-with-model-selection","dir":"Articles","previous_headings":"Practical Tips","what":"1. Starting with Model Selection","title":"Understanding NEC Models in the drc Package","text":"unsure variant use, start NEC.3 (common) compare variants:","code":"# Fit an initial model, then compare with alternative NEC variants m3 <- drm(response ~ dose, data = mydata, fct = NEC.3()) # Compare using model selection (mselect takes one fitted model + a list of alternatives) mselect(m3, fctList = list(NEC.2(), NEC.4()))"},{"path":"https://hreinwald.github.io/drc/articles/nec-models.html","id":"checking-parameter-identifiability","dir":"Articles","previous_headings":"Practical Tips","what":"2. Checking Parameter Identifiability","title":"Understanding NEC Models in the drc Package","text":"NEC.4 model shows large standard errors fails converge, consider constraining parameters:","code":"# If NEC.4 has convergence issues, try NEC.3 summary(nec4.model) # Check standard errors # If c is close to 0 with large SE, use NEC.3 nec3.model <- drm(response ~ dose, data = mydata, fct = NEC.3())"},{"path":"https://hreinwald.github.io/drc/articles/nec-models.html","id":"interpreting-the-threshold-parameter","dir":"Articles","previous_headings":"Practical Tips","what":"3. Interpreting the Threshold Parameter","title":"Understanding NEC Models in the drc Package","text":"e parameter represents NEC threshold - concentration effect:","code":"# Extract the threshold estimate threshold <- coef(nec3.model)[\"e:(Intercept)\"] cat(\"Estimated NEC threshold:\", threshold, \"\\n\") # Get confidence interval for the threshold confint(nec3.model)"},{"path":"https://hreinwald.github.io/drc/articles/nec-models.html","id":"conclusion","dir":"Articles","previous_headings":"","what":"Conclusion","title":"Understanding NEC Models in the drc Package","text":"4 NEC functions serve distinct necessary purposes drc package: NEC: Internal implementation engine NEC.2: Highly constrained models known bounds (2 parameters) NEC.3: Standard case zero baseline (3 parameters) - commonly used NEC.4: Full flexibility complex scenarios (4 parameters) design represents: Sound software architecture: Internal implementation separated user interface Statistical best practice: Providing appropriate model complexity different scenarios User experience optimization: Common cases simple, complex cases possible Package consistency: Matches established pattern used model families","code":""},{"path":"https://hreinwald.github.io/drc/articles/nec-models.html","id":"references","dir":"Articles","previous_headings":"","what":"References","title":"Understanding NEC Models in the drc Package","text":"Pires, . M., Branco, J. ., Picado, ., Mendonca, E. (2002) Models estimation ‘effect concentration’, Environmetrics, 13, 15-27.","code":""},{"path":"https://hreinwald.github.io/drc/articles/nec-models.html","id":"see-also","dir":"Articles","previous_headings":"","what":"See Also","title":"Understanding NEC Models in the drc Package","text":"?NEC - Base NEC function documentation ?NEC.2 - Two-parameter NEC model ?NEC.3 - Three-parameter NEC model ?NEC.4 - Four-parameter NEC model ?drm - Main function fitting dose-response models ?mselect - Model selection function","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/articles/package-version-comparative-analysis.html","id":"executive-summary","dir":"Articles","previous_headings":"","what":"Executive Summary","title":"Comparative Analysis: hreinwald/drc vs DoseResponse/drc","text":"drc R package (Ritz et al., 2015, PLOS ONE) among widely deployed tools dose-response analysis bioassay, toxicology, pharmacology, ecotoxicology. version maintained DoseResponse/drc (v3.2-0, last updated January 2021) harbors multiple correctness bugs varying severity silently corrupt downstream results. fork hreinwald/drc (dev branch, v3.3.2) addresses systematically. critical bug discovered missing lower-asymptote term (c parameter) U-shaped Cedergreen-Ritz-Streibig hormesis models (UCRS.*), rendering every result computed functions incorrect. Secondary bugs include incorrect gradient vectors absolute-type effective dose (ED) standard errors across least seven model families, wrong derivative gammadr(), function-level edfct signature mismatch logistic model family. Beyond bug correction, hreinwald/drc delivers substantially refactored codebase: dead code removed 70+ source files, file naming standardized, comprehensive test suite 79 testthat files added (versus 3 ad-hoc test scripts original), full pkgdown documentation deployed https://hreinwald.github.io/drc/. CI/CD integrated three GitHub Actions workflows (R-CMD-check, code coverage, pkgdown deployment). fork source lacks equivalent infrastructure: deprecated Travis CI configuration, CITATION.cff, seven-line README. Taken together, evidence supports framing mere maintenance release substantive correction scientific record. Users computed ED confidence intervals using type=\"absolute\" Weibull, log-logistic, log-normal, logistic, Brain-Cousens, fplogistic models—fitted UCRS hormesis model—may published incorrect standard errors incorrect fitted values.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/articles/package-version-comparative-analysis.html","id":"missing-lower-asymptote-c-in-u-shaped-crs-model-severity-critical","dir":"Articles","previous_headings":"1. Critical Bugs Identified","what":"1.1 Missing Lower Asymptote (c) in U-shaped CRS Model — SEVERITY: CRITICAL","title":"Comparative Analysis: hreinwald/drc vs DoseResponse/drc","text":"Affected model/function: ucedergreen() convenience wrappers UCRS.4a, UCRS.4b, UCRS.4c, UCRS.5a, UCRS.5b, UCRS.5c File: R/ucedergreen.R Original (incorrect) code (DoseResponse/drc, R/ucedergreen.R, line ~32): Fixed code (hreinwald/drc, R/ucedergreen.R, line ~56): Scientific impact: published model formula (Cedergreen, Ritz & Streibig, 2005, Environ. Toxicol. Chem. 24:3166) : f(x)=c+d−d−c+fe−1/xα1+exp(b(logx−loge))f(x) = c + d - \\frac{d - c + f\\,e^{-1/x^\\alpha}}{1 + \\exp(b(\\log x - \\log e))} original implementation returns d - numTerm/denTerm, .e., fitted response shifted upward c (lower horizontal asymptote) dose values. c = 0 (common case UCRS.4x models), result numerically coincidentally correct; however, c estimated (UCRS.5x) supplied non-zero fixed value, every fitted value wrong exactly c. paper used UCRS.5a, UCRS.5b, UCRS.5c estimated c ≠ 0 reported dose-response parameters, EC values, hormesis estimates incorrect results propagate downstream comparisons. Additionally, deriv1 (gradient respect c parameter) original code 1/t3 (positive), whereas corrected formula’s partial derivative 1 + 1/t3. means even fitted values perceptibly shifted (c ≈ 0), standard errors c-parameter estimate systematically wrong.","code":"fct <- function(dose, parm) { parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE) parmMat[, notFixed] <- parm numTerm <- parmMat[, 3] - parmMat[, 2] + parmMat[, 5]*exp(-1/dose^alpha) denTerm <- 1 + exp(parmMat[, 1]*(log(dose) - log(parmMat[, 4]))) parmMat[, 3] - numTerm/denTerm # WRONG: missing parmMat[, 2] (c parameter) } fct <- function(dose, parm) { parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE) parmMat[, notFixed] <- parm numTerm <- parmMat[, 3] - parmMat[, 2] + parmMat[, 5]*exp(-1/dose^alpha) denTerm <- 1 + exp(parmMat[, 1]*(log(dose) - log(parmMat[, 4]))) parmMat[, 2] + parmMat[, 3] - numTerm/denTerm # CORRECT: c + d - numTerm/denTerm }"},{"path":"https://hreinwald.github.io/drc/articles/package-version-comparative-analysis.html","id":"wrong-multiplier-in-gammadr-gradient-severity-high","dir":"Articles","previous_headings":"1. Critical Bugs Identified","what":"1.2 Wrong Multiplier in gammadr() Gradient — SEVERITY: HIGH","title":"Comparative Analysis: hreinwald/drc vs DoseResponse/drc","text":"Affected model/function: gammadr() — Gamma dose-response model File: R/gammadr.r (DoseResponse) vs R/gammadr.R (hreinwald) Original (incorrect) code (DoseResponse/drc, R/gammadr.r, inside deriv1): Fixed code (hreinwald/drc, R/gammadr.R, inside deriv1): Scientific impact: derivative f(x) = c + (d-c) · pgamma(b·x, e, 1) respect b (d-c) · dgamma(b·x, e, 1) · x. original uses b instead x product, yielding gradient vector scales incorrectly dose. corrupts delta-method standard errors b parameter propagates standard errors derived quantities (ED values, predicted values CIs) computed models fit gammadr().","code":"cbind( t1 * dgamma(parmMat[, 1] * dose, parmMat[, 4], 1) * parmMat[, 1], # WRONG: uses b not dose 1 - t2, t2, t1 * logGamma(parmMat[, 1] * dose, parmMat[, 4]) )[, notFixed] cbind( t1 * dgamma(parmMat[, 1] * dose, parmMat[, 4], 1) * dose, # CORRECT: uses dose 1 - t2, t2, t1 * logGamma(parmMat[, 1] * dose, parmMat[, 4]) )[, notFixed]"},{"path":"https://hreinwald.github.io/drc/articles/package-version-comparative-analysis.html","id":"zero-gradients-for-absolute-type-ed-standard-errors-7-model-families-severity-high","dir":"Articles","previous_headings":"1. Critical Bugs Identified","what":"1.3 Zero Gradients for Absolute-Type ED Standard Errors (7 Model Families) — SEVERITY: HIGH","title":"Comparative Analysis: hreinwald/drc vs DoseResponse/drc","text":"Affected models/functions: braincousens(), fplogistic(), llogistic(), llogistic2(), lnormal(), weibull1(), weibull2() Files: Respective R/*.R files repositories Root cause (shared pattern, shown weibull1()): Original code (DoseResponse/drc, R/weibull1.r, edfct): Fixed code (hreinwald/drc, R/weibull1.R, edfct): Scientific impact: users call ED(model, respLev, type=\"absolute\", interval=\"delta\"), delta-method standard errors reported ED values incorrect ∂ED/∂c ∂ED/∂d set zero. absolute--relative conversion (absToRel/EDhelper) makes p function c d; chain rule therefore requires non-zero partial derivatives. magnitude error depends spread response: data large ranges c d, absolute type conversion creates large sensitivity asymptote estimates, zeroing terms can substantially underestimate true confidence interval width. published confidence intervals absolute ED values original package potentially narrow.","code":"edfct <- function(parm, respl, reference, type, ...) { parmVec[notFixed] <- parm p <- EDhelper(parmVec, respl, reference, type) tempVal <- log(-log((100-p)/100)) EDp <- exp(tempVal/parmVec[1] + log(parmVec[4])) EDder <- EDp*c(-tempVal/(parmVec[1]^2), 0, 0, 1/parmVec[4]) # ^^^ derivatives for c and d are always 0 — correct only for relative type return(list(EDp, EDder[notFixed])) } edfct <- function(parm, respl, reference, type, ...) { parmVec[notFixed] <- parm p <- EDhelper(parmVec, respl, reference, type) tempVal <- log(-log((100-p)/100)) EDp <- exp(tempVal/parmVec[1] + log(parmVec[4])) EDder <- EDp*c(-tempVal/(parmVec[1]^2), 0, 0, 1/parmVec[4]) ## Fix: correct c and d derivatives for absolute type using central differences. if (identical(type, \"absolute\")) { .edval <- function(pv) { ... } # full chain-rule evaluation for (.i in c(2, 3)) { .h <- ... EDder[.i] <- (.edval(.pvUp) - .edval(.pvDn)) / (2 * .h) } } return(list(EDp, EDder[notFixed])) }"},{"path":"https://hreinwald.github.io/drc/articles/package-version-comparative-analysis.html","id":"logistic-edfct-signature-mismatch-and-wrong-p-swap-severity-high","dir":"Articles","previous_headings":"1. Critical Bugs Identified","what":"1.4 logistic() edfct Signature Mismatch and Wrong p-swap — SEVERITY: HIGH","title":"Comparative Analysis: hreinwald/drc vs DoseResponse/drc","text":"Affected model/function: logistic() convenience wrappers L.3, L.4, L.5 File: R/logistic.r (DoseResponse) vs R/logistic.R (hreinwald) Original (incorrect) code (DoseResponse/drc, R/logistic.r, edfct): Fixed code (hreinwald/drc, R/logistic.R, edfct): Scientific impact: logistic model (L.3, L.4, L.5) uses raw dose values (log(dose)), sign convention b reversed compared log-logistic models. original code ignores type reference arguments, meaning ED(model, type=\"absolute\") silently return wrong values (error thrown; wrong formula runs). Furthermore, original code delegate EDhelper applies incorrect p-swap model family, yielding ED values computed complementary percentile (e.g., computing ED10 instead ED90).","code":"edfct <- function(parm, p, ...) { parmVec[notFixed] <- parm # ... (no reference or type handling) # ... always uses p directly, no type=\"absolute\" support return(list(EDp, EDder[notFixed])) } edfct <- function(parm, respl, reference = \"control\", type = \"relative\", ...) { parmVec[notFixed] <- parm if (identical(type, \"absolute\")) { p <- 100 * ((parmVec[3] - respl) / (parmVec[3] - parmVec[2])) } else { p <- respl } ## NOTE: unlike log-logistic models, logistic model has b < 0 = increasing, ## so EDhelper's p-swap for b < 0 would be incorrect here. ... }"},{"path":"https://hreinwald.github.io/drc/articles/package-version-comparative-analysis.html","id":"ucedergreen-additional-bugs-17-total-severity-criticalhighmedium","dir":"Articles","previous_headings":"1. Critical Bugs Identified","what":"1.5 ucedergreen() — Additional Bugs (17 Total) — SEVERITY: CRITICAL/HIGH/MEDIUM","title":"Comparative Analysis: hreinwald/drc vs DoseResponse/drc","text":"ucedergreen() function DoseResponse/drc contained 17 separate bugs documented hreinwald NEWS.md v3.3.0.02. summary impactful: absence deriv1 return list means Newton-type optimizers relying gradient information fail silently fall back finite differences, producing degraded convergence.","code":""},{"path":"https://hreinwald.github.io/drc/articles/package-version-comparative-analysis.html","id":"mselect-parse-error-severity-medium","dir":"Articles","previous_headings":"1. Critical Bugs Identified","what":"1.6 mselect() Parse Error — SEVERITY: MEDIUM","title":"Comparative Analysis: hreinwald/drc vs DoseResponse/drc","text":"File: R/mselect.r / R/mselect.R Bug: Two missing closing braces mselect(). caused parse error function sourced directly file (though load correctly via compiled package). user attempting modify source-load function encounter confusing parse failure.","code":""},{"path":"https://hreinwald.github.io/drc/articles/package-version-comparative-analysis.html","id":"ed-lin-r-incorrect-delta-method-for-quadratic-models-severity-medium","dir":"Articles","previous_headings":"1. Critical Bugs Identified","what":"1.7 ED.lin.R Incorrect Delta Method for Quadratic Models — SEVERITY: MEDIUM","title":"Comparative Analysis: hreinwald/drc vs DoseResponse/drc","text":"File: R/ED.lin.R Bugs fixed hreinwald: - Duplicate -block (dead code evaluating condition twice) - Stray debug print() statement (emits output analysis) - Missing parameterNames = c(\"b0\", \"b1\", \"b2\") argument deltaMethod() call quadratic models — causing incorrect parameter mapping therefore wrong confidence intervals ED values quadratic linear models.","code":""},{"path":"https://hreinwald.github.io/drc/articles/package-version-comparative-analysis.html","id":"drmopt-inverted-tracesilent-logic-severity-medium","dir":"Articles","previous_headings":"1. Critical Bugs Identified","what":"1.8 drmOpt() Inverted Trace/Silent Logic — SEVERITY: MEDIUM","title":"Comparative Analysis: hreinwald/drc vs DoseResponse/drc","text":"File: R/drmOpt.R Bug: otrace/silentVal logic inverted: otrace=TRUE (intending verbose output) incorrectly caused silent=TRUE try(optim()), suppressing error messages rather displaying . cause optimization failures silently ignored debugging sessions.","code":""},{"path":"https://hreinwald.github.io/drc/articles/package-version-comparative-analysis.html","id":"justification-for-refactoring","dir":"Articles","previous_headings":"","what":"2. Justification for Refactoring","title":"Comparative Analysis: hreinwald/drc vs DoseResponse/drc","text":"codebase DoseResponse/drc effectively unmaintained since January 2021 (version 3.2-0). time, multiple bugs accumulated undermine scientific validity results produced package. justification refactoring rests five concrete lines evidence: 1. Mathematical incorrectness production models. missing c parameter ucedergreen() (§1.1), wrong multiplier gammadr() (§1.2), zero-gradient errors seven model families (§1.3) constitute mathematical errors silently corrupt numerical results. software bugs traditional sense (crashes, type errors) — pass silently deliver plausible-looking wrong numbers. 2. API mismatch framework’s calling conventions. edfct function called ED.drc signature (parm, respl, reference, type, ...). logistic model’s edfct accepted (parm, p, ...), silently dropping reference type. Similarly, ucedergreen()’s edfct dropped reference type. documentation problem; undetected interface violation causes incorrect behavior whenever users deviate default parameters. 3. Dead code commented-experiments production files. Across 70+ source files, (FALSE){...} blocks (sometimes hundreds lines), stray print() debug statements, large sections commented-alternative implementations existed production codebase. constitutes significant technical debt impedes maintenance, review, ability reason code paths active. 4. Non-standard file naming. Many R source files used lowercase extensions (.r instead .R): backfit.r, baro5.r, comped.r, drmc.r, fct2list.r, gammadr.r, gompertz.r, hewlett.r, iband.r, idrm.r, isobole.r, lnormal.r, logistic.r, max.r, mixture.r, mrdrm.r, mselect.r, multi2.r, nec.r, pr.r, rdrm.r, relpot.r, sandwich.r, twophase.r, ursa.r, voelund.r, weibull1.r, weibull2.r, xlogx.r. case-sensitive file systems (Linux, CI environments), can cause load failures. 5. Complete absence automated testing. DoseResponse/drc contains 3 ad-hoc test scripts (test1.r, test2.r, test3.r) plus one seed-germination script — testthat framework, assertions, coverage tracking. hreinwald/drc introduces 79 testthat test files covering major model families, utility functions, edge cases.","code":""},{"path":[]},{"path":[]},{"path":"https://hreinwald.github.io/drc/articles/package-version-comparative-analysis.html","id":"roxygen2-documentation-quality","dir":"Articles","previous_headings":"3. Documentation Improvements","what":"3.2 Roxygen2 Documentation Quality","title":"Comparative Analysis: hreinwald/drc vs DoseResponse/drc","text":"DoseResponse/drc uses Roxygen2 version 6.1.1 (declared DESCRIPTION). model files minimal @param, @return, @examples, @details tags — functions defined Roxygen headers . hreinwald/drc uses Roxygen2 7.3.3 markdown support (Roxygen: list(markdown = TRUE)). Every exported function : @title @description @param argument type purpose @return describing return structure @details mathematical formula LaTeX @examples working, runnable code @seealso cross-references @references full bibliographic citations @author attributions @keywords Example improvement — weibull1() documentation added: 4-item describe block explaining 4 self-starter methods LaTeX formula Weibull type 1 model Complete @param 7 arguments 3 working examples across W1.2, W1.3, W1.4, EXD.2, EXD.3","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/articles/package-version-comparative-analysis.html","id":"vignettes","dir":"Articles","previous_headings":"3. Documentation Improvements","what":"3.4 Vignettes","title":"Comparative Analysis: hreinwald/drc vs DoseResponse/drc","text":"hreinwald/drc introduces two new vignettes absent DoseResponse/drc: dose-response-workflow.Rmd (28,149 bytes): complete end--end workflow demonstrating data loading, model fitting, ED estimation, multi-curve comparison, model selection mselect(), result visualization. References corrected ED output format. nec-models.Rmd (14,499 bytes): Dedicated documentation -Effect Concentration (NEC) models scientific context, fitting examples, interpretation guidance.","code":""},{"path":"https://hreinwald.github.io/drc/articles/package-version-comparative-analysis.html","id":"citation-cff","dir":"Articles","previous_headings":"3. Documentation Improvements","what":"3.5 CITATION.cff","title":"Comparative Analysis: hreinwald/drc vs DoseResponse/drc","text":"DoseResponse/drc plain-text inst/citation file (517 bytes) structured metadata. hreinwald/drc proper CITATION.cff (1,523 bytes) CFF version 1.2.0, author ORCID identifiers four original authors, version, DOI, release date, two structured references entries (PLoS ONE 2015 article CRC Press 2019 book).","code":""},{"path":[]},{"path":[]},{"path":"https://hreinwald.github.io/drc/articles/package-version-comparative-analysis.html","id":"new-model-variants","dir":"Articles","previous_headings":"4. New Features & Improvements","what":"4.2 New Model Variants","title":"Comparative Analysis: hreinwald/drc vs DoseResponse/drc","text":"UCRS models (UCRS.4a/4b/4c, UCRS.5a/5b/5c) completely rewritten — existed DoseResponse/drc, functionally broken (see §1.1, §1.5) effectively new working implementations. CRS.4a, CRS.4b, CRS.4c display text fixes (e.g., CRS.4b now correctly shows “alpha=0.5” instead “alpha=”).","code":""},{"path":"https://hreinwald.github.io/drc/articles/package-version-comparative-analysis.html","id":"enhancements-to-existing-functions","dir":"Articles","previous_headings":"4. New Features & Improvements","what":"4.3 Enhancements to Existing Functions","title":"Comparative Analysis: hreinwald/drc vs DoseResponse/drc","text":"ED() / ED.drc(): Multiple robustness improvements — correct matrix handling indexMat vector (single-parameter models), NaN/Inf handling LL.5, dynamic curve loop post-hoc clevel filtering, drop=FALSE covariance matrix slices, unnamed gradient vectors. maED(): Excludes models non-finite ED estimates fitting errors model-averaged estimate; returns NA instead NaN candidates fail. predict.drc(): Fixed “incorrect number dimensions” models many fixed parameters. plot.drc(): New errbar.col parameter control error bar colors; default now matches curve colors. anova.drc(): Corrected documentation accurately reflect actual behavior; improved error handling. mselect(): Fixed parse error missing closing braces. noEffect(): Added warning degrees freedom difference ≤ 0. searchdrc(): Fixed regex error convergence failure behavior. drmOpt(): Fixed inverted otrace/silentVal logic.","code":""},{"path":[]},{"path":[]},{"path":[]},{"path":[]},{"path":"https://hreinwald.github.io/drc/articles/package-version-comparative-analysis.html","id":"items-that-strengthen-the-submission-now","dir":"Articles","previous_headings":"6. Publication Readiness Summary","what":"Items That Strengthen the Submission Now:","title":"Comparative Analysis: hreinwald/drc vs DoseResponse/drc","text":"Bug evidence documented reproducible. NEWS.md provides detailed bug report fix. 79 testthat tests provide regression guards. ucedergreen() bug compelling primary justification: unambiguous, affects named published model family, affects previous users. Breadth fixes across 7 model families absolute-type ED gradient bug provides evidence systematic, incidental, review.","code":""},{"path":"https://hreinwald.github.io/drc/articles/package-version-comparative-analysis.html","id":"items-recommended-before-submission-jss-joss-the-r-journal","dir":"Articles","previous_headings":"6. Publication Readiness Summary","what":"Items Recommended Before Submission (JSS / JOSS / The R Journal):","title":"Comparative Analysis: hreinwald/drc vs DoseResponse/drc","text":"Benchmark study: Quantify numerical difference old new results synthetic real datasets (e.g., table showing correct vs. incorrect ED confidence intervals type=\"absolute\" W1.4, LN.4, LL.4 — critical reviewers assess impact magnitude). Version stability: dev branch still primary development branch. stable tagged release main (main_beta promoted) expected journal submission processes. CRAN submission: README explicitly discourages CRAN version. corrected CRAN submission maximally reach user community required R Journal papers referencing package. Vignette corrected bugs: dedicated vignette showing /comparisons (old vs. new results) critical bugs directly serve paper’s narrative. Acknowledgment original authors: paper prominently acknowledge Ritz, Baty, Streibig & Gerhard originators. framing “corrected modernized” already appropriately respectful. Test coverage metric: README references Codecov badge. coverage percentage ≥ 70% key model functions strong claim methods paper.","code":""},{"path":"https://hreinwald.github.io/drc/articles/package-version-comparative-analysis.html","id":"suggested-abstract-draft","dir":"Articles","previous_headings":"","what":"7. Suggested Abstract Draft","title":"Comparative Analysis: hreinwald/drc vs DoseResponse/drc","text":"drc R package (Ritz et al., 2015) provides widely-used framework parametric dose-response modeling bioassay, toxicology, ecotoxicology. Since last CRAN release (v3.2-0, January 2021), package received substantive maintenance despite continued use scientific literature. present drc v3.3.2, corrected modernized version package, addressing series bugs ranging severity silently incorrect fitted values systematically underestimated confidence intervals. critical error, discovered U-shaped Cedergreen-Ritz-Streibig hormesis model family (UCRS.*), omits lower horizontal asymptote parameter model function, rendering every fitted value incorrect whenever lower asymptote differs zero. Additionally, gradient functions used delta-method standard error calculations absolute-type effective dose (ED) estimates incorrect seven model families (Weibull type 1 2, log-logistic, log-normal, logistic, Brain-Cousens, fractional polynomial logistic), consistently setting chain-rule contributions zero producing confidence intervals potentially narrow. gradient error Gamma model inverted rate-parameter derivative. bugs affect published results obtained using original package. Beyond correctness, refactored package introduces 79 testthat unit tests (versus zero original), comprehensive Roxygen2 documentation mathematical formulae worked examples, pkgdown documentation website, three GitHub Actions CI/CD workflows, CITATION.cff metadata file. package available https://github.com/hreinwald/drc fully backward compatible existing drm() interface.","code":""},{"path":"https://hreinwald.github.io/drc/articles/package-version-comparative-analysis.html","id":"source-repositories","dir":"Articles","previous_headings":"","what":"Source Repositories","title":"Comparative Analysis: hreinwald/drc vs DoseResponse/drc","text":"Refactored package (subject): https://github.com/hreinwald/drc (branch: dev, commit 508f602) Fork source (baseline): https://github.com/DoseResponse/drc (default branch master, commit 8719d43) GitHub Pages: https://hreinwald.github.io/drc/","code":""},{"path":"https://hreinwald.github.io/drc/authors.html","id":null,"dir":"","previous_headings":"","what":"Authors","title":"Authors and Citation","text":"Christian Ritz. Author. Jens C. Streibig. Author. Hannes Reinwald. Author, maintainer.","code":""},{"path":"https://hreinwald.github.io/drc/authors.html","id":"citation","dir":"","previous_headings":"","what":"Citation","title":"Authors and Citation","text":"Ritz C, Streibig JC, Reinwald H (2026). drc: Analysis Dose-Response Data. R package version 3.3.2, https://hreinwald.github.io/drc.","code":"@Manual{, title = {drc: Analysis of Dose-Response Data}, author = {Christian Ritz and Jens C. Streibig and Hannes Reinwald}, year = {2026}, note = {R package version 3.3.2}, url = {https://hreinwald.github.io/drc}, }"},{"path":[]},{"path":"https://hreinwald.github.io/drc/index.html","id":"note","dir":"","previous_headings":"","what":"Note","title":"Analysis of Dose-Response Data","text":"repository contains refactored development version drc R package first published Christian Ritz, Florent Baty, Jens C. Streibig und Daniel Gerhard (2015). foundational work dose–response modeling R gratefully acknowledged inspired present refactoring. goal project modernize codebase, improve maintainability, provide clearer development structure preserving core functionality original package. repository focuses structural refactoring development improvements. Behavior interfaces may change codebase modernized.","code":""},{"path":"https://hreinwald.github.io/drc/index.html","id":"overview","dir":"","previous_headings":"","what":"Overview","title":"Analysis of Dose-Response Data","text":"drc package provides comprehensive framework fitting, analyzing, visualizing dose-response curves R. widely used bioassay, toxicology, pharmacology, agricultural research model relationship exposure (e.g., concentration substance) dose biological response. package offers: Flexible model fitting via central drm() function, supporting multiple data types (continuous, binomial, Poisson, negative binomial, event-time, species sensitivity distributions). 40+ built-parametric models including log-logistic, Weibull, Gompertz, Brain-Cousens, Cedergreen, many , self-starting parameter initialization. Effective dose (ED) estimation confidence intervals (delta method, Fieller, inverse regression) ED(). Model comparison diagnostics: ANOVA, lack--fit tests, Neill’s test, Box-Cox transformations, R-squared, Cook’s distance, hat values. Multi-curve analysis: fit compare dose-response curves across groups, compute relative potency selectivity indices via EDcomp(). Robust inference: sandwich variance estimators heteroscedasticity-consistent standard errors. Simulation tools: generate random dose-response data power analysis method comparison. details visit: 📖 drc github documentation⚡ drc example workflow Feature requests ideas? 💡 Post ","code":""},{"path":"https://hreinwald.github.io/drc/index.html","id":"installation","dir":"","previous_headings":"","what":"Installation","title":"Analysis of Dose-Response Data","text":"⚠️ Important: recommend installing currently heavily outdated CRAN version package. Instead, recommend installing development (dev) stable beta (main_beta) version GitHub.","code":""},{"path":"https://hreinwald.github.io/drc/index.html","id":"install-from-github-recommended","dir":"","previous_headings":"Installation","what":"Install from GitHub (Recommended)","title":"Analysis of Dose-Response Data","text":"","code":"# install.packages(\"devtools\") # Install the re-factored development version devtools::install_github(\"hreinwald/drc\") # Install the re-factored stable beta version devtools::install_github(\"hreinwald/drc@main_beta\")"},{"path":"https://hreinwald.github.io/drc/index.html","id":"local-installation-from-targz","dir":"","previous_headings":"Installation","what":"Local Installation from tar.gz","title":"Analysis of Dose-Response Data","text":"GitHub installation failing, can run installation local tar.gz file. Download latest release. downloading file, run following:","code":"# Specify the path to the directory where you saved the downloaded tar.gz file. targz <- file.path(\"~/Downloads/drc-3.3.2.tar.gz\") # Local installation with base R install.packages(targz, repos = NULL, type = \"source\")"},{"path":"https://hreinwald.github.io/drc/index.html","id":"outdated-cran-version-not-recommended","dir":"","previous_headings":"Installation","what":"Outdated CRAN Version (Not Recommended)","title":"Analysis of Dose-Response Data","text":"install outdated version CRAN:","code":"install.packages(\"drc\")"},{"path":[]},{"path":"https://hreinwald.github.io/drc/index.html","id":"fitting-a-basic-dose-response-model","dir":"","previous_headings":"Quick Start","what":"Fitting a basic dose-response model","title":"Analysis of Dose-Response Data","text":"","code":"library(drc) # Fit a four-parameter log-logistic model to the built-in 'ryegrass' dataset model <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) # View model summary with parameter estimates and standard errors summary(model) # Plot the fitted dose-response curve plot(model, xlab = \"Concentration\", ylab = \"Root length\")"},{"path":"https://hreinwald.github.io/drc/index.html","id":"estimating-effective-doses-ed-values","dir":"","previous_headings":"Quick Start","what":"Estimating effective doses (ED values)","title":"Analysis of Dose-Response Data","text":"","code":"# Estimate the ED50 (dose producing 50% effect) with confidence intervals ED(model, respLev = c(10, 50, 90), interval = \"delta\")"},{"path":"https://hreinwald.github.io/drc/index.html","id":"comparing-curves-across-groups","dir":"","previous_headings":"Quick Start","what":"Comparing curves across groups","title":"Analysis of Dose-Response Data","text":"","code":"# Fit separate curves for multiple groups model_multi <- drm(rootl ~ conc, curveid = herbicide, data = ryegrass, fct = LL.4()) # Compare ED50 values between groups EDcomp(model_multi, percVec = c(50), interval = \"delta\")"},{"path":"https://hreinwald.github.io/drc/index.html","id":"model-selection","dir":"","previous_headings":"Quick Start","what":"Model selection","title":"Analysis of Dose-Response Data","text":"","code":"# Compare different dose-response model families mselect(model, fctList = list(W1.4(), W2.4(), LL.3()))"},{"path":"https://hreinwald.github.io/drc/index.html","id":"vignettes","dir":"","previous_headings":"","what":"Vignettes","title":"Analysis of Dose-Response Data","text":"package includes detailed vignettes help understand specific topics:","code":"# View available vignettes vignette(package = \"drc\") # Access the NEC models vignette vignette(\"nec-models\", package = \"drc\")"},{"path":[]},{"path":[]},{"path":"https://hreinwald.github.io/drc/index.html","id":"data-types-supported","dir":"","previous_headings":"","what":"Data Types Supported","title":"Analysis of Dose-Response Data","text":"drm() function supports multiple response types via type argument: \"continuous\" (default): Standard continuous dose-response data. \"binomial\": Quantal/binary response data (e.g., proportion individuals affected). \"Poisson\": Count data following Poisson distribution. \"negbin1\", \"negbin2\": Negative binomial count data. \"event\": Event-time / time--event data (e.g., germination time). \"ssd\": Species sensitivity distributions ecotoxicology.","code":""},{"path":"https://hreinwald.github.io/drc/index.html","id":"dependencies","dir":"","previous_headings":"","what":"Dependencies","title":"Analysis of Dose-Response Data","text":"drc depends : - R (≥ 4.0.0), MASS, stats imports : car, graphics, gtools, lifecycle, multcomp, plotrix, sandwich, scales, utils.","code":""},{"path":"https://hreinwald.github.io/drc/index.html","id":"references","dir":"","previous_headings":"","what":"References","title":"Analysis of Dose-Response Data","text":"Ritz, C., Baty, F., Streibig, J. C., Gerhard, D. (2015). Dose-Response Analysis Using R. PLOS ONE, 10(12), e0146021. Ritz, C. Streibig, J. C. (2005). Bioassay Analysis using R. Journal Statistical Software, 12(5), 1–22.","code":""},{"path":"https://hreinwald.github.io/drc/index.html","id":"bug-reports","dir":"","previous_headings":"","what":"Bug Reports","title":"Analysis of Dose-Response Data","text":"Please report issues re-factory version .","code":""},{"path":"https://hreinwald.github.io/drc/index.html","id":"license","dir":"","previous_headings":"","what":"License","title":"Analysis of Dose-Response Data","text":"GPL-2.0","code":""},{"path":"https://hreinwald.github.io/drc/reference/absToRel.html","id":null,"dir":"Reference","previous_headings":"","what":"Convert absolute to relative response levels — absToRel","title":"Convert absolute to relative response levels — absToRel","text":"Internal helper converts absolute response level relative (percentage) scale based upper lower asymptotes dose-response curve.","code":""},{"path":"https://hreinwald.github.io/drc/reference/absToRel.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Convert absolute to relative response levels — absToRel","text":"","code":"absToRel(parmVec, respl, typeCalc)"},{"path":"https://hreinwald.github.io/drc/reference/absToRel.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Convert absolute to relative response levels — absToRel","text":"parmVec numeric vector model parameters third element upper asymptote second element lower asymptote. respl numeric response level convert. typeCalc character string. \"absolute\", conversion performed; otherwise input respl returned unchanged.","code":""},{"path":"https://hreinwald.github.io/drc/reference/absToRel.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Convert absolute to relative response levels — absToRel","text":"numeric value representing (possibly converted) response level percentage.","code":""},{"path":"https://hreinwald.github.io/drc/reference/acidiq.html","id":null,"dir":"Reference","previous_headings":"","what":"Acifluorfen and diquat tested on Lemna minor. — acidiq","title":"Acifluorfen and diquat tested on Lemna minor. — acidiq","text":"Data experiment chemicals acifluorfen diquat tested Lemna minor. dataset 7 mixtures used 8 dilutions three replicates 12 common controls, total 180 observations.","code":""},{"path":"https://hreinwald.github.io/drc/reference/acidiq.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Acifluorfen and diquat tested on Lemna minor. — acidiq","text":"","code":"data(acidiq)"},{"path":"https://hreinwald.github.io/drc/reference/acidiq.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Acifluorfen and diquat tested on Lemna minor. — acidiq","text":"data frame 180 observations following 3 variables. dose numeric vector dose values pct numeric vector denoting grouping according mixtures percentages rgr numeric vector response values (relative growth rates)","code":""},{"path":"https://hreinwald.github.io/drc/reference/acidiq.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Acifluorfen and diquat tested on Lemna minor. — acidiq","text":"dataset analysed Soerensen et al (2007). Hewlett's symmetric model seems appropriate dataset.","code":""},{"path":"https://hreinwald.github.io/drc/reference/acidiq.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Acifluorfen and diquat tested on Lemna minor. — acidiq","text":"dataset kindly provided Nina Cedergreen, Department Agricultural Sciences, Royal Veterinary Agricultural University, Denmark.","code":""},{"path":"https://hreinwald.github.io/drc/reference/acidiq.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Acifluorfen and diquat tested on Lemna minor. — acidiq","text":"Soerensen, H. Cedergreen, N. Skovgaard, . M. Streibig, J. C. (2007) isobole-based statistical model test synergism/antagonism binary mixture toxicity experiments, Environmental Ecological Statistics, 14, 383–397.","code":""},{"path":"https://hreinwald.github.io/drc/reference/acidiq.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Acifluorfen and diquat tested on Lemna minor. — acidiq","text":"","code":"library(drc) ## Fitting the model with freely varying ED50 values ## Ooops: Box-Cox transformation is needed acidiq.free <- drm(rgr ~ dose, pct, data = acidiq, fct = LL.4(), pmodels = list(~factor(pct), ~1, ~1, ~factor(pct) - 1)) #> Control measurements detected for level: 999 ## Lack-of-fit test modelFit(acidiq.free) #> Lack-of-fit test #> #> ModelDf RSS Df F value p value #> ANOVA 123 0.023854 #> DRC model 164 0.046386 41 2.8337 0.0000 summary(acidiq.free) #> #> Model fitted: Log-logistic (ED50 as parameter) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:100 1.3589e+00 1.1035e-01 12.3150 < 2.2e-16 *** #> b:83 1.7675e+00 1.5803e-01 11.1846 < 2.2e-16 *** #> b:67 2.1577e+00 2.0216e-01 10.6732 < 2.2e-16 *** #> b:50 2.2777e+00 2.2913e-01 9.9407 < 2.2e-16 *** #> b:33 2.2302e+00 2.5416e-01 8.7746 2.177e-15 *** #> b:17 2.5058e+00 2.6607e-01 9.4176 < 2.2e-16 *** #> b:0 2.3076e+00 2.5911e-01 8.9060 9.250e-16 *** #> c:(Intercept) 2.9700e-02 3.0952e-03 9.5953 < 2.2e-16 *** #> d:(Intercept) 3.0209e-01 2.5854e-03 116.8429 < 2.2e-16 *** #> e:100 3.0844e+02 2.1265e+01 14.5043 < 2.2e-16 *** #> e:83 3.7660e+02 2.2280e+01 16.9033 < 2.2e-16 *** #> e:67 4.8746e+02 2.6072e+01 18.6970 < 2.2e-16 *** #> e:50 5.1669e+02 2.6541e+01 19.4678 < 2.2e-16 *** #> e:33 5.2288e+02 2.8379e+01 18.4247 < 2.2e-16 *** #> e:17 3.7891e+02 1.8619e+01 20.3515 < 2.2e-16 *** #> e:0 3.4766e+02 1.7712e+01 19.6282 < 2.2e-16 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.01681793 (164 degrees of freedom) ## Plotting isobole structure isobole(acidiq.free, xlim = c(0, 400), ylim = c(0, 450)) ## Fitting the concentration addition model acidiq.ca <- mixture(acidiq.free, model = \"CA\") #> Warning: Using formula(x) is deprecated when x is a character vector of length > 1. #> Consider formula(paste(x, collapse = \" \")) instead. #> Control measurements detected for level: 999 ## Comparing to model with freely varying e parameter anova(acidiq.ca, acidiq.free) # rejected #> #> 1st model #> fct: CA model #> pmodels: ~~~factor(pct), ~1, ~1, ~I(1/(pct/100)) - 1, ~I(1/(1 - pct/100)) - 1 #> 2nd model #> fct: LL.4() #> pmodels: ~factor(pct), ~1, ~1, ~factor(pct) - 1 #> #> ANOVA table #> #> ModelDf RSS Df F value p value #> 1st model 169 0.073150 #> 2nd model 164 0.046386 5 18.925 0.000 ## Plotting isobole based on concentration addition -- poor fit isobole(acidiq.free, acidiq.ca, xlim = c(0, 420), ylim = c(0, 450)) # poor fit ## Fitting the Hewlett model acidiq.hew <- mixture(acidiq.free, model = \"Hewlett\") #> Warning: Using formula(x) is deprecated when x is a character vector of length > 1. #> Consider formula(paste(x, collapse = \" \")) instead. #> Control measurements detected for level: 999 ## Comparing to model with freely varying e parameter anova(acidiq.free, acidiq.hew) # accepted #> #> 1st model #> fct: Hewlett model #> pmodels: ~~~factor(pct), ~1, ~1, ~I(1/(pct/100)) - 1, ~I(1/(1 - pct/100)) - 1, ~1 #> 2nd model #> fct: LL.4() #> pmodels: ~factor(pct), ~1, ~1, ~factor(pct) - 1 #> #> ANOVA table #> #> ModelDf RSS Df F value p value #> 2nd model 168 0.048100 #> 1st model 164 0.046386 4 1.5151 0.2001 summary(acidiq.hew) #> #> Model fitted: Hewlett mixture (6 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:100 1.3704e+00 1.1184e-01 12.2531 < 2.2e-16 *** #> b:83 1.7757e+00 1.5964e-01 11.1227 < 2.2e-16 *** #> b:67 2.1808e+00 2.0685e-01 10.5430 < 2.2e-16 *** #> b:50 2.2925e+00 2.3345e-01 9.8198 < 2.2e-16 *** #> b:33 2.3154e+00 2.6237e-01 8.8252 1.352e-15 *** #> b:17 2.4666e+00 2.5919e-01 9.5167 < 2.2e-16 *** #> b:0 2.3347e+00 2.6714e-01 8.7397 2.266e-15 *** #> c:(Intercept) 3.0042e-02 3.0711e-03 9.7820 < 2.2e-16 *** #> d:(Intercept) 3.0176e-01 2.5825e-03 116.8512 < 2.2e-16 *** #> e:I(1/(pct/100)) 3.1683e+02 1.3191e+01 24.0197 < 2.2e-16 *** #> f:I(1/(1 - pct/100)) 3.3710e+02 1.1814e+01 28.5339 < 2.2e-16 *** #> g:(Intercept) 2.8063e-01 6.9489e-02 4.0385 8.164e-05 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.01692075 (168 degrees of freedom) ## Plotting isobole based on the Hewlett model isobole(acidiq.free, acidiq.hew, xlim = c(0, 400), ylim = c(0, 450)) # good fit"},{"path":"https://hreinwald.github.io/drc/reference/aconiazide.html","id":null,"dir":"Reference","previous_headings":"","what":"Weight change in rats after exposure to a medical drug — aconiazide","title":"Weight change in rats after exposure to a medical drug — aconiazide","text":"4 dose levels weight change 6 monts reported 14 rats exposed antituberculosis drug, aconiazide.","code":""},{"path":"https://hreinwald.github.io/drc/reference/aconiazide.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Weight change in rats after exposure to a medical drug — aconiazide","text":"","code":"data(aconiazide)"},{"path":"https://hreinwald.github.io/drc/reference/aconiazide.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Weight change in rats after exposure to a medical drug — aconiazide","text":"data frame 55 observations following 2 variables. dose numeric vector weightChange numeric vector giving weight change (g) 6 months exposure","code":""},{"path":"https://hreinwald.github.io/drc/reference/aconiazide.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Weight change in rats after exposure to a medical drug — aconiazide","text":"Beland, F. . Dooley, K. L. Hansen, E. B. Sheldon, W. G. (1995). Six-month toxicity comparison antituberculosis drugs aconiazide isoniazid fischer 344 rats. Journal American College Toxicology, 14(4):328–342.","code":""},{"path":"https://hreinwald.github.io/drc/reference/aconiazide.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Weight change in rats after exposure to a medical drug — aconiazide","text":"","code":"library(drc) ## Displaying the data head(aconiazide) #> weightChange dose #> 1 366.0 0 #> 2 326.6 0 #> 3 355.0 0 #> 4 353.8 0 #> 5 354.4 0 #> 6 349.8 0 ## Fitting a four-parameter log-logistic model aconiazide.m1 <- drm(weightChange ~ dose, data = aconiazide, fct = LL.4()) summary(aconiazide.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 1.11216 0.45229 2.4589 0.01737 * #> c:(Intercept) -46.62703 821.99546 -0.0567 0.95499 #> d:(Intercept) 360.39895 4.96987 72.5168 < 2e-16 *** #> e:(Intercept) 1106.80577 3076.84642 0.3597 0.72054 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 18.72333 (51 degrees of freedom) ## Plotting the fitted curve plot(aconiazide.m1, xlab = \"Dose\", ylab = \"Weight change (g)\")"},{"path":"https://hreinwald.github.io/drc/reference/acute.inh.html","id":null,"dir":"Reference","previous_headings":"","what":"Acute inhalation — acute.inh","title":"Acute inhalation — acute.inh","text":"Data acute inhalation toxicity test. several dose levels, total number subjects number dead subjects recorded.","code":""},{"path":"https://hreinwald.github.io/drc/reference/acute.inh.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Acute inhalation — acute.inh","text":"","code":"data(acute.inh)"},{"path":"https://hreinwald.github.io/drc/reference/acute.inh.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Acute inhalation — acute.inh","text":"data frame 6 observations following 3 variables. dose numeric vector total numeric vector num.dead numeric vector","code":""},{"path":"https://hreinwald.github.io/drc/reference/acute.inh.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Acute inhalation — acute.inh","text":"","code":"library(drc) ## Displaying the data head(acute.inh) #> dose total num.dead #> 1 422 5 0 #> 2 744 5 1 #> 3 948 5 3 #> 4 2069 5 5 ## Fitting a two-parameter log-logistic model for binomial response acute.inh.m1 <- drm(num.dead/total ~ dose, weights = total, data = acute.inh, fct = LL.2(), type = \"binomial\") summary(acute.inh.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) -7.9301 5.0812 -1.5607 0.1186 #> e:(Intercept) 895.2982 83.5547 10.7151 <2e-16 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## Plotting the fitted curve plot(acute.inh.m1, xlab = \"Dose\", ylab = \"Proportion dead\")"},{"path":"https://hreinwald.github.io/drc/reference/algae.html","id":null,"dir":"Reference","previous_headings":"","what":"Volume of algae as function of increasing concentrations of a herbicide — algae","title":"Volume of algae as function of increasing concentrations of a herbicide — algae","text":"Dataset experiment exploring effect increasing concentrations herbicide volume treated algae.","code":""},{"path":"https://hreinwald.github.io/drc/reference/algae.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Volume of algae as function of increasing concentrations of a herbicide — algae","text":"","code":"data(algae)"},{"path":"https://hreinwald.github.io/drc/reference/algae.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Volume of algae as function of increasing concentrations of a herbicide — algae","text":"data frame 14 observations following 2 variables. conc numeric vector concentrations. vol numeric vector response values, relative change volume.","code":""},{"path":"https://hreinwald.github.io/drc/reference/algae.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Volume of algae as function of increasing concentrations of a herbicide — algae","text":"datasets requires cubic root transformation order stabilise variance.","code":""},{"path":"https://hreinwald.github.io/drc/reference/algae.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Volume of algae as function of increasing concentrations of a herbicide — algae","text":"Meister, R. van den Brink, P. (2000) Analysis Laboratory Toxicity Experiments, Chapter 4 Statistics Ecotoxicology, Editor: T. Sparks, New York: John Wiley & Sons, (pp. 114–116).","code":""},{"path":"https://hreinwald.github.io/drc/reference/algae.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Volume of algae as function of increasing concentrations of a herbicide — algae","text":"","code":"library(drc) algae.m1 <- drm(vol~conc, data=algae, fct=LL.3()) summary(algae.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 1.36244 0.16352 8.3321 4.428e-06 *** #> d:(Intercept) 104.85893 2.57750 40.6825 2.403e-13 *** #> e:(Intercept) 6.04062 0.69519 8.6892 2.952e-06 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 3.911178 (11 degrees of freedom) algae.m2 <- boxcox(algae.m1) summary(algae.m2) #> #> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 1.51428 0.10648 14.2207 1.996e-08 *** #> d:(Intercept) 103.65175 3.96547 26.1386 2.977e-11 *** #> e:(Intercept) 6.41710 0.73892 8.6845 2.968e-06 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.7137765 (11 degrees of freedom) #> #> Non-normality/heterogeneity adjustment through Box-Cox transformation #> #> Estimated lambda: 0.5 #> Confidence interval for lambda: [0.294,0.676] #>"},{"path":"https://hreinwald.github.io/drc/reference/anova.drc.html","id":null,"dir":"Reference","previous_headings":"","what":"ANOVA Model Comparison for Dose-Response Models — anova.drc","title":"ANOVA Model Comparison for Dose-Response Models — anova.drc","text":"Compares two nested dose-response model fits using likelihood-ratio test (binomial data) F-test (continuous data). Two drc objects must provided. lack--fit test single model, use modelFit instead.","code":""},{"path":"https://hreinwald.github.io/drc/reference/anova.drc.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"ANOVA Model Comparison for Dose-Response Models — anova.drc","text":"","code":"# S3 method for class 'drc' anova(object, ..., details = TRUE, test = NULL)"},{"path":"https://hreinwald.github.io/drc/reference/anova.drc.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"ANOVA Model Comparison for Dose-Response Models — anova.drc","text":"object object class ‘drc’. ... second object class ‘drc’ compare object. Exactly two models must supplied; passing single model result error directing user modelFit. details logical indicating whether details models compared displayed. Default TRUE (details displayed). test character string specifying test statistic applied. continuous data default \"F\" (F-test); binomial data default \"Chisq\" (likelihood-ratio test). Use \"Chisq\" force likelihood-ratio test continuous data.","code":""},{"path":"https://hreinwald.github.io/drc/reference/anova.drc.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"ANOVA Model Comparison for Dose-Response Models — anova.drc","text":"object class ‘anova’ (inheriting data.frame) columns model degrees freedom, residual sum squares (log-likelihood), difference degrees freedom, test statistic, p-value.","code":""},{"path":"https://hreinwald.github.io/drc/reference/anova.drc.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"ANOVA Model Comparison for Dose-Response Models — anova.drc","text":"Two drc objects must specified. function performs test reduction larger smaller model. makes statistical sense models nested, : one model submodel model. continuous data F-test used default. binomial data likelihood-ratio (chi-square) test used default. single model passed, function raises error. assess fit single dose-response model (lack--fit test comparing model general ANOVA model), use modelFit instead.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/anova.drc.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"ANOVA Model Comparison for Dose-Response Models — anova.drc","text":"Christian Ritz, Hannes Reinwald","code":""},{"path":"https://hreinwald.github.io/drc/reference/anova.drc.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"ANOVA Model Comparison for Dose-Response Models — anova.drc","text":"","code":"## Comparing two nested models (two-model comparison) ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) ryegrass.m2 <- drm(rootl ~ conc, data = ryegrass, fct = W1.3()) anova(ryegrass.m2, ryegrass.m1) #> #> 1st model #> fct: W1.3() #> 2nd model #> fct: W1.4() #> #> ANOVA table #> #> ModelDf RSS Df F value p value #> 1st model 21 8.9520 #> 2nd model 20 6.0242 1 9.7205 0.0054 anova(ryegrass.m2, ryegrass.m1, details = FALSE) # without details #> ANOVA table #> #> ModelDf RSS Df F value p value #> 1st model 21 8.9520 #> 2nd model 20 6.0242 1 9.7205 0.0054 ## For a lack-of-fit test on a single model, use modelFit(): modelFit(ryegrass.m1) #> Lack-of-fit test #> #> ModelDf RSS Df F value p value #> ANOVA 17 5.1799 #> DRC model 20 6.0242 3 0.9236 0.4506"},{"path":"https://hreinwald.github.io/drc/reference/anova.drclist.html","id":null,"dir":"Reference","previous_headings":"","what":"ANOVA for list of drc objects — anova.drclist","title":"ANOVA for list of drc objects — anova.drclist","text":"ANOVA list drc objects","code":""},{"path":"https://hreinwald.github.io/drc/reference/anova.drclist.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"ANOVA for list of drc objects — anova.drclist","text":"","code":"# S3 method for class 'drclist' anova(object, ..., details = TRUE, test = NULL)"},{"path":"https://hreinwald.github.io/drc/reference/AR.2.html","id":null,"dir":"Reference","previous_headings":"","what":"Two-parameter asymptotic regression model — AR.2","title":"Two-parameter asymptotic regression model — AR.2","text":"two-parameter asymptotic regression model b fixed 1 lower limit fixed 0. model given equation $$f(x) = d \\cdot (1 - \\exp(-x / e))$$","code":""},{"path":"https://hreinwald.github.io/drc/reference/AR.2.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Two-parameter asymptotic regression model — AR.2","text":"","code":"AR.2(fixed = c(NA, NA), names = c(\"d\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/AR.2.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Two-parameter asymptotic regression model — AR.2","text":"fixed numeric vector length 2, specifying fixed parameters (use NA parameters estimated). names character vector length 2 giving names parameters (default c(\"d\", \"e\")). ... additional arguments passed weibull2, notably method (character string: \"1\" (default), \"2\", \"3\", \"4\") selects self-starter method obtaining starting values. See weibull2 details.","code":""},{"path":"https://hreinwald.github.io/drc/reference/AR.2.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Two-parameter asymptotic regression model — AR.2","text":"list class \"Weibull-2\" returned weibull2.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/AR.2.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Two-parameter asymptotic regression model — AR.2","text":"","code":"ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = AR.2())"},{"path":"https://hreinwald.github.io/drc/reference/AR.3.html","id":null,"dir":"Reference","previous_headings":"","what":"Three-parameter shifted asymptotic regression model — AR.3","title":"Three-parameter shifted asymptotic regression model — AR.3","text":"three-parameter asymptotic regression model b fixed 1. model given equation $$f(x) = c + (d - c)(1 - \\exp(-x / e))$$","code":""},{"path":"https://hreinwald.github.io/drc/reference/AR.3.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Three-parameter shifted asymptotic regression model — AR.3","text":"","code":"AR.3(fixed = c(NA, NA, NA), names = c(\"c\", \"d\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/AR.3.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Three-parameter shifted asymptotic regression model — AR.3","text":"fixed numeric vector length 3, specifying fixed parameters (use NA parameters estimated). names character vector length 3 giving names parameters (default c(\"c\", \"d\", \"e\")). ... additional arguments passed weibull2, notably method (character string: \"1\" (default), \"2\", \"3\", \"4\") selects self-starter method obtaining starting values. See weibull2 details.","code":""},{"path":"https://hreinwald.github.io/drc/reference/AR.3.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Three-parameter shifted asymptotic regression model — AR.3","text":"list class \"Weibull-2\" returned weibull2.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/AR.3.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Three-parameter shifted asymptotic regression model — AR.3","text":"","code":"ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = AR.3())"},{"path":"https://hreinwald.github.io/drc/reference/arandaordaz.html","id":null,"dir":"Reference","previous_headings":"","what":"Asymptotic Regression Model — arandaordaz","title":"Asymptotic Regression Model — arandaordaz","text":"base function asymptotic regression model, providing mean function self starter three-parameter model.","code":""},{"path":"https://hreinwald.github.io/drc/reference/arandaordaz.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Asymptotic Regression Model — arandaordaz","text":"","code":"arandaordaz(fixed = c(NA, NA, NA), names = c(\"a\", \"b\", \"c\"), fctName, fctText)"},{"path":"https://hreinwald.github.io/drc/reference/arandaordaz.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Asymptotic Regression Model — arandaordaz","text":"fixed numeric vector. Specifies parameters fixed value fixed. Use NA parameters fixed. Must length 3. names character vector length 3 giving names parameters (contain \":\"). fctName optional character string used internally convenience functions. Defaults \"arandaordaz\" provided. fctText optional character string used internally convenience functions. Defaults \"Asymptotic regression\" provided.","code":""},{"path":"https://hreinwald.github.io/drc/reference/arandaordaz.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Asymptotic Regression Model — arandaordaz","text":"list class drcMean following components: fct mean function taking arguments dose parm. ssfct Self-starter function generating initial parameter estimates data. names Character vector non-fixed parameter names. deriv1 Reserved first derivative slot (currently NULL). deriv2 Reserved second derivative slot (currently NULL). derivx Reserved derivative--respect--x slot (currently NULL). edfct Function calculating effective dose (ED) values derivatives. inversion Inverse mean function back-calculating dose response. name Character string identifying model function name. text Character string human-readable model description. noParm Integer giving number non-fixed parameters.","code":""},{"path":"https://hreinwald.github.io/drc/reference/arandaordaz.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Asymptotic Regression Model — arandaordaz","text":"asymptotic regression model three-parameter model mean function: $$f(x) = c + (d-c)(1-\\exp(-x/e))$$ parameter \\(c\\) lower limit (\\(x=0\\)), \\(d\\) upper limit, \\(e>0\\) determines steepness increase.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/arandaordaz.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Asymptotic Regression Model — arandaordaz","text":"Christian Ritz, Hannes Reinwald","code":""},{"path":"https://hreinwald.github.io/drc/reference/arbovirus.html","id":null,"dir":"Reference","previous_headings":"","what":"arbovirus — arbovirus","title":"arbovirus — arbovirus","text":"Data dose-response experiment arbovirus involving two treatment groups (FP SP). dose level, total number subjects numbers dead defective subjects recorded.","code":""},{"path":"https://hreinwald.github.io/drc/reference/arbovirus.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"arbovirus — arbovirus","text":"","code":"data(arbovirus)"},{"path":"https://hreinwald.github.io/drc/reference/arbovirus.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"arbovirus — arbovirus","text":"data frame 9 observations following 5 variables. dose numeric vector total numeric vector dead numeric vector def numeric vector trt categorical vector","code":""},{"path":"https://hreinwald.github.io/drc/reference/arbovirus.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"arbovirus — arbovirus","text":"","code":"library(drc) ## Displaying the data head(arbovirus) #> dose total dead def trt #> 1 3 17 3 1 FP #> 2 18 19 4 1 FP #> 3 30 19 8 2 FP #> 4 90 20 17 1 FP #> 5 3 19 1 0 T #> 6 20 19 2 0 T ## Fitting a two-parameter log-logistic model for binomial response arbovirus.m1 <- drm(dead/total ~ dose, trt, weights = total, data = arbovirus, fct = LL.2(), type = \"binomial\") summary(arbovirus.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:FP -1.0219e+00 2.8425e-01 -3.5949 0.0003245 *** #> b:T -2.8993e-01 7.1182e-02 -4.0731 4.638e-05 *** #> e:FP 3.2617e+01 8.6014e+00 3.7921 0.0001494 *** #> e:T 4.1896e+04 3.6484e+04 1.1483 0.2508315 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## Plotting the fitted curves plot(arbovirus.m1, xlab = \"Dose\", ylab = \"Proportion dead\")"},{"path":"https://hreinwald.github.io/drc/reference/auxins.html","id":null,"dir":"Reference","previous_headings":"","what":"Effect of technical grade and commercially formulated auxin herbicides — auxins","title":"Effect of technical grade and commercially formulated auxin herbicides — auxins","text":"MCPA, 2,4-D, mecorprop dichorlprop applied either technical grades materials commercial formulations. experimental unit consisted five 1-week old seedlings grown together pot nutrient solution 14 days.","code":""},{"path":"https://hreinwald.github.io/drc/reference/auxins.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Effect of technical grade and commercially formulated auxin herbicides — auxins","text":"","code":"data(auxins)"},{"path":"https://hreinwald.github.io/drc/reference/auxins.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Effect of technical grade and commercially formulated auxin herbicides — auxins","text":"data frame 150 observations following 5 variables. dryweight numeric vector dose numeric vector replicate factor 3 levels herbicide factor 5 levels formulation factor 2 levels","code":""},{"path":"https://hreinwald.github.io/drc/reference/auxins.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Effect of technical grade and commercially formulated auxin herbicides — auxins","text":"Data parts larger joint action experiment various herbicides. eight herbicide preparations naturally grouped four pairs (herbicide:formulation) + control, pair herbicides active ingredients different formulation constituents, assumed biologically inert. data consist 150 observations dry weights, observation weight five plants grown pot. eight herbicide preparations essentially mode action plant; act like plant auxins, plant regulators affect cell enlongation essential metabolic pathways. One objects experiment test response functions identical except multiplicative factor dose. necessary, sufficient, condition similar mode action herbicides.","code":""},{"path":"https://hreinwald.github.io/drc/reference/auxins.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Effect of technical grade and commercially formulated auxin herbicides — auxins","text":"Streibig, J. C. (1987). Joint action root-absorbed mixtures auxin herbicides Sinapis alba L. barley (Hordeum vulgare L.) Weed Research, 27, 337–347.","code":""},{"path":"https://hreinwald.github.io/drc/reference/auxins.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Effect of technical grade and commercially formulated auxin herbicides — auxins","text":"Rudemo, M., Ruppert, D., Streibig, J. C. (1989). Random-Effect Models Nonlinear Regression Applications Bioassay. Biometrics, 45, 349–362.","code":""},{"path":"https://hreinwald.github.io/drc/reference/auxins.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Effect of technical grade and commercially formulated auxin herbicides — auxins","text":"","code":"library(drc) ## Displaying the data head(auxins) #> dryweight dose replicate herbicide formulation #> 1 1.51 0.000 1 control control #> 2 1.43 0.000 1 control control #> 3 0.05 1.000 1 MCPA tech #> 4 0.06 0.500 1 MCPA tech #> 5 0.15 0.250 1 MCPA tech #> 6 0.40 0.125 1 MCPA tech ## Fitting a four-parameter log-logistic model with different curves per herbicide auxins.m1 <- drm(dryweight ~ dose, herbicide, data = auxins, fct = LL.4()) #> Control measurements detected for level: control summary(auxins.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:MCPA 2.0706241 0.3893031 5.3188 4.260e-07 *** #> b:24-D 2.5445569 0.7248661 3.5104 0.000610 *** #> b:mecorprop 2.1805520 0.6672103 3.2682 0.001375 ** #> b:dichorlprop 1.3931656 0.6406655 2.1746 0.031419 * #> c:MCPA 0.0476642 0.0481999 0.9889 0.324501 #> c:24-D 0.0267124 0.0545256 0.4899 0.625002 #> c:mecorprop 0.0714663 0.0669183 1.0680 0.287458 #> c:dichorlprop -0.0207450 0.3280620 -0.0632 0.949674 #> d:MCPA 1.2724266 0.0599127 21.2380 < 2.2e-16 *** #> d:24-D 1.1472951 0.0877739 13.0710 < 2.2e-16 *** #> d:mecorprop 1.2462095 0.1058526 11.7731 < 2.2e-16 *** #> d:dichorlprop 1.2117312 0.1012559 11.9670 < 2.2e-16 *** #> e:MCPA 0.0710631 0.0076089 9.3394 3.620e-16 *** #> e:24-D 0.1275807 0.0147148 8.6702 1.246e-14 *** #> e:mecorprop 0.1218997 0.0156858 7.7714 1.815e-12 *** #> e:dichorlprop 0.3391236 0.1391753 2.4367 0.016136 * #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.1535001 (134 degrees of freedom) ## Plotting the fitted curves plot(auxins.m1, xlab = \"Dose\", ylab = \"Dry weight\")"},{"path":"https://hreinwald.github.io/drc/reference/backfit.html","id":null,"dir":"Reference","previous_headings":"","what":"Calculation of backfit values from a fitted dose-response model — backfit","title":"Calculation of backfit values from a fitted dose-response model — backfit","text":"inverse regression backfitted dose values calculated mean response per dose.","code":""},{"path":"https://hreinwald.github.io/drc/reference/backfit.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Calculation of backfit values from a fitted dose-response model — backfit","text":"","code":"backfit(drcObject)"},{"path":"https://hreinwald.github.io/drc/reference/backfit.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Calculation of backfit values from a fitted dose-response model — backfit","text":"drcObject object class 'drc'.","code":""},{"path":"https://hreinwald.github.io/drc/reference/backfit.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Calculation of backfit values from a fitted dose-response model — backfit","text":"Two columns original dose values corresponding backfitted values using fitted dose-response model. extreme dose values (e.g., high dose) backfitted values may well-defined.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/backfit.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Calculation of backfit values from a fitted dose-response model — backfit","text":"Christian Ritz suggestion Keld Sorensen.","code":""},{"path":"https://hreinwald.github.io/drc/reference/backfit.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Calculation of backfit values from a fitted dose-response model — backfit","text":"","code":"ryegrass.LL.4 <- drm(rootl~conc, data=ryegrass, fct=LL.4()) backfit(ryegrass.LL.4) #> Warning: NaNs produced #> Warning: Non-positive variance estimate; SE set to NA. #> Warning: Non-positive variance estimate; SE set to NA. #> dose Estimate #> [1,] 0.00 0.5500692 #> [2,] 0.94 0.7743783 #> [3,] 1.88 1.8744292 #> [4,] 3.75 3.7830500 #> [5,] 7.50 7.0811832 #> [6,] 15.00 10.1667582 #> [7,] 30.00 Inf"},{"path":"https://hreinwald.github.io/drc/reference/barley.html","id":null,"dir":"Reference","previous_headings":"","what":"Barley — barley","title":"Barley — barley","text":"Data dose-response experiment measuring weight barley (Hordeum vulgare) different dose levels substance.","code":""},{"path":"https://hreinwald.github.io/drc/reference/barley.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Barley — barley","text":"","code":"data(barley)"},{"path":"https://hreinwald.github.io/drc/reference/barley.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Barley — barley","text":"data frame 18 observations following 2 variables. Dose numeric vector weight numeric vector","code":""},{"path":"https://hreinwald.github.io/drc/reference/barley.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Barley — barley","text":"","code":"library(drc) ## Displaying the data head(barley) #> Dose weight #> 1 0.00000 57.2 #> 2 0.00000 49.8 #> 3 21.09375 62.2 #> 4 21.09375 30.6 #> 5 42.18750 40.9 #> 6 42.18750 70.9 ## Fitting a four-parameter log-logistic model barley.m1 <- drm(weight ~ Dose, data = barley, fct = LL.4()) summary(barley.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 9.7084 42.9166 0.2262 0.82430 #> c:(Intercept) 11.1275 3.7803 2.9435 0.01068 * #> d:(Intercept) 52.0478 3.2487 16.0212 2.123e-10 *** #> e:(Intercept) 286.2600 209.6374 1.3655 0.19364 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 9.241941 (14 degrees of freedom) ## Plotting the fitted curve plot(barley.m1, xlab = \"Dose\", ylab = \"Weight\")"},{"path":"https://hreinwald.github.io/drc/reference/baro5.html","id":null,"dir":"Reference","previous_headings":"","what":"The Baroreflex Five-Parameter Dose-Response Model — baro5","title":"The Baroreflex Five-Parameter Dose-Response Model — baro5","text":"baro5 provides five-parameter baroreflex model function, allowing specification various parameter constraints. model accommodates asymmetric dose-response curves.","code":""},{"path":"https://hreinwald.github.io/drc/reference/baro5.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"The Baroreflex Five-Parameter Dose-Response Model — baro5","text":"","code":"baro5( fixed = c(NA, NA, NA, NA, NA), names = c(\"b1\", \"b2\", \"c\", \"d\", \"e\"), method = c(\"1\", \"2\", \"3\", \"4\"), ssfct = NULL )"},{"path":"https://hreinwald.github.io/drc/reference/baro5.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"The Baroreflex Five-Parameter Dose-Response Model — baro5","text":"fixed numeric vector. Specifies parameters fixed value fixed. NAs parameters fixed. names vector character strings giving names parameters (contain \":\"). order : b1, b2, c, d, e. method character string indicating self starter function use. ssfct self starter function used.","code":""},{"path":"https://hreinwald.github.io/drc/reference/baro5.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"The Baroreflex Five-Parameter Dose-Response Model — baro5","text":"list containing nonlinear model function, self starter function, parameter names.","code":""},{"path":"https://hreinwald.github.io/drc/reference/baro5.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"The Baroreflex Five-Parameter Dose-Response Model — baro5","text":"five-parameter function given : $$y = c + \\frac{d-c}{1+f\\exp(b1(\\log(x)-\\log(e))) + (1-f)\\exp(b2(\\log(x)-\\log(e)))}$$ $$f = 1/(1 + \\exp((2b1 b2/|b1+b2|)(\\log(x)-\\log(e))))$$ difference b1 b2 nonzero, function asymmetric.","code":""},{"path":"https://hreinwald.github.io/drc/reference/baro5.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"The Baroreflex Five-Parameter Dose-Response Model — baro5","text":"Ricketts, J. H. Head, G. . (1999) five-parameter logistic equation investigating asymmetry curvature baroreflex studies. . J. Physiol. (Regulatory Integrative Comp. Physiol. 46), 277, 441–454.","code":""},{"path":"https://hreinwald.github.io/drc/reference/baro5.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"The Baroreflex Five-Parameter Dose-Response Model — baro5","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/BC.4.html","id":null,"dir":"Reference","previous_headings":"","what":"Four-parameter Brain-Cousens hormesis model — BC.4","title":"Four-parameter Brain-Cousens hormesis model — BC.4","text":"BC.4 provides Brain-Cousens modified log-logistic model lower limit fixed 0.","code":""},{"path":"https://hreinwald.github.io/drc/reference/BC.4.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Four-parameter Brain-Cousens hormesis model — BC.4","text":"","code":"BC.4(fixed = c(NA, NA, NA, NA), names = c(\"b\", \"d\", \"e\", \"f\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/BC.4.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Four-parameter Brain-Cousens hormesis model — BC.4","text":"fixed numeric vector length 4 specifying fixed parameters (NAs free parameters). names vector character strings giving names parameters. ... additional arguments passed braincousens.","code":""},{"path":"https://hreinwald.github.io/drc/reference/BC.4.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Four-parameter Brain-Cousens hormesis model — BC.4","text":"list (see braincousens).","code":""},{"path":"https://hreinwald.github.io/drc/reference/BC.4.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Four-parameter Brain-Cousens hormesis model — BC.4","text":"van Ewijk, P. H. Hoekstra, J. . (1993) Calculation EC50 Confidence Interval Subtoxic Stimulus Present, Ecotoxicology Environmental Safety, 25, 25–32.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/BC.4.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Four-parameter Brain-Cousens hormesis model — BC.4","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/BC.4.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Four-parameter Brain-Cousens hormesis model — BC.4","text":"","code":"lettuce.bcm2 <- drm(weight ~ conc, data = lettuce, fct = BC.4()) summary(lettuce.bcm2) #> #> Model fitted: Brain-Cousens (hormesis) with lower limit fixed at 0 (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 1.282812 0.049346 25.9964 1.632e-10 *** #> d:(Intercept) 0.967302 0.077123 12.5423 1.926e-07 *** #> e:(Intercept) 0.847633 0.436093 1.9437 0.08059 . #> f:(Intercept) 1.620703 0.979711 1.6543 0.12908 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.1117922 (10 degrees of freedom) ED(lettuce.bcm2, c(50)) #> #> Estimated effective doses #> #> Estimate Std. Error #> e:50 35.023 15.427"},{"path":"https://hreinwald.github.io/drc/reference/BC.5.html","id":null,"dir":"Reference","previous_headings":"","what":"Five-parameter Brain-Cousens hormesis model — BC.5","title":"Five-parameter Brain-Cousens hormesis model — BC.5","text":"BC.5 provides full five-parameter Brain-Cousens modified log-logistic model describing hormesis.","code":""},{"path":"https://hreinwald.github.io/drc/reference/BC.5.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Five-parameter Brain-Cousens hormesis model — BC.5","text":"","code":"BC.5(fixed = c(NA, NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\", \"f\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/BC.5.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Five-parameter Brain-Cousens hormesis model — BC.5","text":"fixed numeric vector length 5 specifying fixed parameters (NAs free parameters). names vector character strings giving names parameters. ... additional arguments passed braincousens.","code":""},{"path":"https://hreinwald.github.io/drc/reference/BC.5.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Five-parameter Brain-Cousens hormesis model — BC.5","text":"list (see braincousens).","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/BC.5.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Five-parameter Brain-Cousens hormesis model — BC.5","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/BC.5.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Five-parameter Brain-Cousens hormesis model — BC.5","text":"","code":"lettuce.bcm1 <- drm(weight ~ conc, data = lettuce, fct = BC.5()) modelFit(lettuce.bcm1) #> Lack-of-fit test #> #> ModelDf RSS Df F value p value #> ANOVA 7 0.088237 #> DRC model 9 0.118842 2 1.2140 0.3527 plot(lettuce.bcm1)"},{"path":"https://hreinwald.github.io/drc/reference/bcl3.html","id":null,"dir":"Reference","previous_headings":"","what":"Alias for BC.4 — bcl3","title":"Alias for BC.4 — bcl3","text":"bcl3 alias BC.4.","code":""},{"path":"https://hreinwald.github.io/drc/reference/bcl3.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Alias for BC.4 — bcl3","text":"","code":"bcl3(fixed = c(NA, NA, NA, NA), names = c(\"b\", \"d\", \"e\", \"f\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/bcl3.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Alias for BC.4 — bcl3","text":"fixed numeric vector length 4 specifying fixed parameters (NAs free parameters). names vector character strings giving names parameters. ... additional arguments passed braincousens.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/bcl4.html","id":null,"dir":"Reference","previous_headings":"","what":"Alias for BC.5 — bcl4","title":"Alias for BC.5 — bcl4","text":"bcl4 alias BC.5.","code":""},{"path":"https://hreinwald.github.io/drc/reference/bcl4.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Alias for BC.5 — bcl4","text":"","code":"bcl4(fixed = c(NA, NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\", \"f\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/bcl4.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Alias for BC.5 — bcl4","text":"fixed numeric vector length 5 specifying fixed parameters (NAs free parameters). names vector character strings giving names parameters. ... additional arguments passed braincousens.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/bees.html","id":null,"dir":"Reference","previous_headings":"","what":"bees — bees","title":"bees — bees","text":"Data binary mixture experiment involves multiple single-dose factorial designs insecticide imidacloprid combined 7 pesticides turn.","code":""},{"path":"https://hreinwald.github.io/drc/reference/bees.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"bees — bees","text":"","code":"data(bees)"},{"path":"https://hreinwald.github.io/drc/reference/bees.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"bees — bees","text":"data frame 66 observations following 5 variables. mixture Indicator single-dose experiment (control) treat Treatment combination treatments rep Replication number (3 replicates per group) dead0h Number dead bees initially dead48h Number dead bees 48 hours","code":""},{"path":"https://hreinwald.github.io/drc/reference/bees.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"bees — bees","text":"Imidacloprid widely used insecticide. recent study potential synergistic effects mortality honey bees exposed insectide binary mixtures seven pesticides different classes: acephate, λ-cyhalothrin, oxamyl, tetraconazole, sulfoxaflor, glyphosate, clothianidin investigated. Bees reared cages (25 insects per cage), three cages per treatment group, exposed mixture treatments 48h. Mortality 48h response.","code":""},{"path":"https://hreinwald.github.io/drc/reference/bees.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"bees — bees","text":"Data retrieved PLoS ONE repository.","code":""},{"path":"https://hreinwald.github.io/drc/reference/bees.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"bees — bees","text":"Zhu YC, Yao J, Adamczyk J Luttrell R, Synergistic toxicity physiological impact imidacloprid alone binary mixtures seven representative pesticides honey bee (Apis mellifera). PLoS ONE 12: e0176837 (2017). https://doi.org/10.1371/journal.pone.0176837","code":""},{"path":"https://hreinwald.github.io/drc/reference/bees.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"bees — bees","text":"","code":"library(drc) ## Displaying the data head(bees) #> mixture treat rep dead0h dead48h #> 1 CK-1 H2O 1 0 0 #> 2 CK-2 H2O 2 2 2 #> 3 CK-3 H2O 3 5 5 #> 4 AdvBra Advi274B 1 2 5 #> 5 AdvBra Advi274B 2 0 6 #> 6 AdvBra Advi274B 3 0 3 ## Summarizing mortality by treatment aggregate(dead48h ~ treat, data = bees, FUN = mean) #> treat dead48h #> 1 Adv274BL 4.666667 #> 2 Advi274B 4.666667 #> 3 Advi274D 4.666667 #> 4 Advi274K 4.666667 #> 5 Advi274R 4.666667 #> 6 Advi274T 4.666667 #> 7 Advi274V 4.666667 #> 8 AdviBela 8.000000 #> 9 AdviBrack 15.000000 #> 10 AdviDoma 10.666667 #> 11 AdviKara 5.666667 #> 12 AdviRoun 4.666667 #> 13 AdviTran 9.333333 #> 14 AdviVyda 15.000000 #> 15 Belay40 4.333333 #> 16 Brack91 9.333333 #> 17 Doma2500 2.666667 #> 18 H2O 2.333333 #> 19 Karat273 1.000000 #> 20 Roun2500 0.000000 #> 21 Trans117 2.000000 #> 22 Vydat162 6.666667"},{"path":"https://hreinwald.github.io/drc/reference/blackgrass.html","id":null,"dir":"Reference","previous_headings":"","what":"Seedling Emergence of Blackgrass (Alopecurus myosuroides) — blackgrass","title":"Seedling Emergence of Blackgrass (Alopecurus myosuroides) — blackgrass","text":"Seedling emergence herbicide susceptible (S) resistant (R) Alopecurus myosuroides reponse sowing depth suboptimal temperature regimes (10/5C) optimal temperature regimes (17/10C).","code":""},{"path":"https://hreinwald.github.io/drc/reference/blackgrass.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Seedling Emergence of Blackgrass (Alopecurus myosuroides) — blackgrass","text":"","code":"data(\"blackgrass\")"},{"path":"https://hreinwald.github.io/drc/reference/blackgrass.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Seedling Emergence of Blackgrass (Alopecurus myosuroides) — blackgrass","text":"data frame 2752 observations following 12 variables. Exp numeric vector Temp numeric vector Popu numeric vector Bio factor two levels Depth numeric vector Rep numeric vector Start.Day numeric vector End.Day numeric vector Ger numeric vector Accum.Ger numeric vector TotalSeed numeric vector Pot numeric vector","code":""},{"path":"https://hreinwald.github.io/drc/reference/blackgrass.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Seedling Emergence of Blackgrass (Alopecurus myosuroides) — blackgrass","text":"Keshtkar, E., Mathiassen, S. K., Beffa, R., Kudsk, P. (2017). Seed Germination Seedling Emergence Blackgrass (Alopecurus myosuroides) Affected Non-Target-Site Herbicide Resistance. Weed Science, 65, 732-742. https://doi.org/10.1017/wsc.2017.44","code":""},{"path":"https://hreinwald.github.io/drc/reference/blackgrass.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Seedling Emergence of Blackgrass (Alopecurus myosuroides) — blackgrass","text":"","code":"library(drc) ## Displaying the data head(blackgrass) #> Exp Temp Popu Bio Depth Rep Start.Day End.Day Ger Accum.Ger TotalSeed Pot #> 1 1 10 914 S 0 1 0 360 0 0 36 3 #> 2 1 10 914 S 0 1 360 376 0 0 36 3 #> 3 1 10 914 S 0 1 376 384 0 0 36 3 #> 4 1 10 914 S 0 1 384 400 0 0 36 3 #> 5 1 10 914 S 0 1 400 408 0 0 36 3 #> 6 1 10 914 S 0 1 408 424 0 0 36 3 ## Summarizing seedling emergence across treatments aggregate(Accum.Ger ~ Temp + Bio, data = blackgrass, FUN = max) #> Temp Bio Accum.Ger #> 1 10 R 33 #> 2 17 R 29 #> 3 10 S 36 #> 4 17 S 30"},{"path":"https://hreinwald.github.io/drc/reference/boxcox.drc.html","id":null,"dir":"Reference","previous_headings":"","what":"Transform-both-sides Box-Cox transformation — boxcox.drc","title":"Transform-both-sides Box-Cox transformation — boxcox.drc","text":"Finds optimal Box-Cox transformation non-linear regression.","code":""},{"path":"https://hreinwald.github.io/drc/reference/boxcox.drc.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Transform-both-sides Box-Cox transformation — boxcox.drc","text":"","code":"# S3 method for class 'drc' boxcox( object, lambda = seq(-2, 2, by = 0.25), plotit = TRUE, bcAdd = 0, method = c(\"ml\", \"anova\"), level = 0.95, eps = 1/50, xlab = expression(lambda), ylab = \"log-Likelihood\", ... )"},{"path":"https://hreinwald.github.io/drc/reference/boxcox.drc.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Transform-both-sides Box-Cox transformation — boxcox.drc","text":"object object class drc. lambda numeric vector lambda values; default (-2, 2) steps 0.25. plotit logical controls whether result plotted. bcAdd numeric value specifying constant added sides prior Box-Cox transformation. default 0. method character string specifying estimation method lambda: maximum likelihood ANOVA-based (optimal lambda inherited general ANOVA model fit). level numeric value: confidence level required. eps numeric value: tolerance lambda = 0; defaults 0.02. xlab character string: label x axis, defaults \"lambda\". ylab character string: label y axis, defaults \"log-likelihood\". ... additional graphical parameters.","code":""},{"path":"https://hreinwald.github.io/drc/reference/boxcox.drc.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Transform-both-sides Box-Cox transformation — boxcox.drc","text":"object class \"drc\" (returned invisibly). plotit = TRUE plot loglik vs lambda shown indicating confidence interval (default 95%) optimal lambda value.","code":""},{"path":"https://hreinwald.github.io/drc/reference/boxcox.drc.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Transform-both-sides Box-Cox transformation — boxcox.drc","text":"optimal lambda value determined using profile likelihood approach: lambda value dose-response regression model fitted lambda value (corresponding model fit) resulting largest value log likelihood function chosen.","code":""},{"path":"https://hreinwald.github.io/drc/reference/boxcox.drc.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Transform-both-sides Box-Cox transformation — boxcox.drc","text":"Carroll, R. J. Ruppert, D. (1988) Transformation Weighting Regression, New York: Chapman Hall (Chapter 4).","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/boxcox.drc.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Transform-both-sides Box-Cox transformation — boxcox.drc","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/boxcox.drc.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Transform-both-sides Box-Cox transformation — boxcox.drc","text":"","code":"## Fitting log-logistic model without transformation ryegrass.m1 <- drm(ryegrass, fct = LL.4()) summary(ryegrass.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 2.98222 0.46506 6.4125 2.960e-06 *** #> c:(Intercept) 0.48141 0.21219 2.2688 0.03451 * #> d:(Intercept) 7.79296 0.18857 41.3272 < 2.2e-16 *** #> e:(Intercept) 3.05795 0.18573 16.4644 4.268e-13 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.5196256 (20 degrees of freedom) ## Fitting the same model with the optimal Box-Cox transformation ryegrass.m2 <- boxcox(ryegrass.m1) summary(ryegrass.m2) #> #> Model fitted: Log-logistic (ED50 as parameter) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 2.61839 0.39151 6.6880 1.649e-06 *** #> c:(Intercept) 0.39083 0.10429 3.7474 0.001269 ** #> d:(Intercept) 7.86633 0.29558 26.6136 < 2.2e-16 *** #> e:(Intercept) 3.01662 0.21005 14.3612 5.354e-12 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.2962958 (20 degrees of freedom) #> #> Non-normality/heterogeneity adjustment through Box-Cox transformation #> #> Estimated lambda: 0.5 #> Confidence interval for lambda: [0.269,0.949] #>"},{"path":"https://hreinwald.github.io/drc/reference/braincousens.html","id":null,"dir":"Reference","previous_headings":"","what":"The Brain-Cousens hormesis models — braincousens","title":"The Brain-Cousens hormesis models — braincousens","text":"braincousens provides general way specifying Brain-Cousens' modified log-logistic model describing hormesis, various constraints parameters.","code":""},{"path":"https://hreinwald.github.io/drc/reference/braincousens.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"The Brain-Cousens hormesis models — braincousens","text":"","code":"braincousens( fixed = c(NA, NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\", \"f\"), method = c(\"1\", \"2\", \"3\", \"4\"), ssfct = NULL, fctName, fctText )"},{"path":"https://hreinwald.github.io/drc/reference/braincousens.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"The Brain-Cousens hormesis models — braincousens","text":"fixed numeric vector. Specifies parameters fixed value fixed. NAs parameters fixed. names vector character strings giving names parameters (contain \":\"). order parameters : b, c, d, e, f. method character string indicating self starter function use. ssfct self starter function used. fctName optional character string used internally convenience functions. fctText optional character string used internally convenience functions.","code":""},{"path":"https://hreinwald.github.io/drc/reference/braincousens.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"The Brain-Cousens hormesis models — braincousens","text":"list containing non-linear function, self starter function, parameter names additional model specific objects.","code":""},{"path":"https://hreinwald.github.io/drc/reference/braincousens.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"The Brain-Cousens hormesis models — braincousens","text":"Brain-Cousens model given expression $$f(x) = c + \\frac{d-c+fx}{1+\\exp(b(\\log(x)-\\log(e)))}$$ five-parameter model.","code":""},{"path":"https://hreinwald.github.io/drc/reference/braincousens.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"The Brain-Cousens hormesis models — braincousens","text":"Brain, P. Cousens, R. (1989) equation describe dose responses stimulation growth low doses, Weed Research, 29, 93–96.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/braincousens.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"The Brain-Cousens hormesis models — braincousens","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/braincousens.ssf.html","id":null,"dir":"Reference","previous_headings":"","what":"Self-starter for Brain-Cousens model — braincousens.ssf","title":"Self-starter for Brain-Cousens model — braincousens.ssf","text":"Self-starter Brain-Cousens model","code":""},{"path":"https://hreinwald.github.io/drc/reference/braincousens.ssf.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Self-starter for Brain-Cousens model — braincousens.ssf","text":"","code":"braincousens.ssf(method = c(\"1\", \"2\", \"3\", \"4\"), fixed, useFixed = FALSE)"},{"path":"https://hreinwald.github.io/drc/reference/bread.drc.html","id":null,"dir":"Reference","previous_headings":"","what":"Bread for the sandwich estimator — bread.drc","title":"Bread for the sandwich estimator — bread.drc","text":"Computes \"bread\" (unscaled hessian) sandwich estimator variance-covariance matrix objects class 'drc'.","code":""},{"path":"https://hreinwald.github.io/drc/reference/bread.drc.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Bread for the sandwich estimator — bread.drc","text":"","code":"# S3 method for class 'drc' bread(x, ...)"},{"path":"https://hreinwald.github.io/drc/reference/bread.drc.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Bread for the sandwich estimator — bread.drc","text":"x object class drc. ... additional arguments. moment none supported.","code":""},{"path":"https://hreinwald.github.io/drc/reference/bread.drc.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Bread for the sandwich estimator — bread.drc","text":"unscaled hessian matrix.","code":""},{"path":"https://hreinwald.github.io/drc/reference/bread.drc.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Bread for the sandwich estimator — bread.drc","text":"details provided Zeileis (2006).","code":""},{"path":"https://hreinwald.github.io/drc/reference/bread.drc.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Bread for the sandwich estimator — bread.drc","text":"Zeileis, . (2006) Object-oriented Computation Sandwich Estimators, J. Statist. Software, 16, Issue 9.","code":""},{"path":"https://hreinwald.github.io/drc/reference/bread.drc.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Bread for the sandwich estimator — bread.drc","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/broccoli.html","id":null,"dir":"Reference","previous_headings":"","what":"The Effects of Drought Stress on Leaf Development in a Brassica oleracea population — broccoli","title":"The Effects of Drought Stress on Leaf Development in a Brassica oleracea population — broccoli","text":"effect drought stress Brassica oleracea investigated, selecting drought stress resistant population different DH genotypes. study carried 48 DH lines developed F1 plants cross rapid cycling chinese kale (Brassica oleracea var. alboglabra (L.H. Bailey) Musil) broccoli (Brassica oleracea var. italica Plenck). 2 stress treatments (watered watered control) randomly assigned 4 plants per genotype (2 per treatment) resulting 192 plants total. genotypes 5, 17, 31, 48, additional 12 plants (6 per treatment) included completely randomized design, results total 240 plants. plant length youngest leaf beginning experiment measured daily period 16 days. additional 12 plants 4 genotypes leaf water potential measured secondary endpoint (omitted ); due destructive measurements dropouts occur.","code":""},{"path":"https://hreinwald.github.io/drc/reference/broccoli.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"The Effects of Drought Stress on Leaf Development in a Brassica oleracea population — broccoli","text":"","code":"data(broccoli)"},{"path":"https://hreinwald.github.io/drc/reference/broccoli.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"The Effects of Drought Stress on Leaf Development in a Brassica oleracea population — broccoli","text":"data frame 3689 observations following 5 variables. LeafLength Length youngest leaf [cm] ID Plant identifier 240 plants Stress Drought stress treatment 2 levels (control/drought) Genotype Genotype ID 48 levels Day Day repeated measurement (1,2,...,16)","code":""},{"path":"https://hreinwald.github.io/drc/reference/broccoli.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"The Effects of Drought Stress on Leaf Development in a Brassica oleracea population — broccoli","text":"Uptmoor, R.; Osei-Kwarteng, M.; Guertler, S. & Stuetzel, H. Modeling Effects Drought Stress Leaf Development Brassica oleracea Doubled Haploid Population Using Two-phase Linear Functions. Journal American Society Horticultural Science, 2009, 134, 543-552.","code":""},{"path":"https://hreinwald.github.io/drc/reference/broccoli.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"The Effects of Drought Stress on Leaf Development in a Brassica oleracea population — broccoli","text":"","code":"data(broccoli) ## Display the structure of the data head(broccoli) #> LeafLength ID Stress Genotype Day #> 1 1.4 38 control 17 1 #> 2 1.2 62 control 17 1 #> 3 2.5 35 control 17 1 #> 4 1.8 91 control 17 1 #> 5 1.7 76 control 17 1 #> 6 1.4 108 control 17 1 ## Fit a five-parameter log-logistic model per stress treatment broccoli.m1 <- drm(LeafLength ~ Day, curveid = Stress, data = broccoli, fct = LL.5()) summary(broccoli.m1) #> #> Model fitted: Generalized log-logistic (ED50 as parameter) (5 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:control -3.52214 0.70944 -4.9647 7.195e-07 *** #> b:drought -4.55117 0.93359 -4.8749 1.134e-06 *** #> c:control 1.95443 0.28161 6.9402 4.608e-12 *** #> c:drought 2.05815 0.35835 5.7435 1.003e-08 *** #> d:control 14.72586 0.40596 36.2743 < 2.2e-16 *** #> d:drought 10.88808 0.14244 76.4397 < 2.2e-16 *** #> e:control 9.30461 0.87822 10.5949 < 2.2e-16 *** #> e:drought 7.91145 0.68137 11.6112 < 2.2e-16 *** #> f:control 0.43850 0.15151 2.8942 0.003824 ** #> f:drought 0.29038 0.10546 2.7534 0.005926 ** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 1.693158 (3679 degrees of freedom) plot(broccoli.m1, main = \"Broccoli leaf growth by stress treatment\")"},{"path":"https://hreinwald.github.io/drc/reference/C.dubia.html","id":null,"dir":"Reference","previous_headings":"","what":"Offsprings resulting from a toxicity test — C.dubia","title":"Offsprings resulting from a toxicity test — C.dubia","text":"Results chronic reproduction toxicity test seven different concentrations waste water. response number offspring produced water flea Ceriodaphnia dubia.","code":""},{"path":"https://hreinwald.github.io/drc/reference/C.dubia.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Offsprings resulting from a toxicity test — C.dubia","text":"","code":"data(C.dubia)"},{"path":"https://hreinwald.github.io/drc/reference/C.dubia.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Offsprings resulting from a toxicity test — C.dubia","text":"data frame 50 observations following 2 variables. conc numeric vector giving waste water percentage number numeric vector","code":""},{"path":"https://hreinwald.github.io/drc/reference/C.dubia.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Offsprings resulting from a toxicity test — C.dubia","text":". J. Bailer J. T. Oris (1997). Estimating inhibition concentrations different response scales using generalized linear models. Environmental Toxicology Chemistry, 16:1554–1559.","code":""},{"path":"https://hreinwald.github.io/drc/reference/C.dubia.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Offsprings resulting from a toxicity test — C.dubia","text":"","code":"library(drc) ## Displaying the data head(C.dubia) #> conc number #> 1 0 27 #> 2 0 30 #> 3 0 29 #> 4 0 31 #> 5 0 16 #> 6 0 15 ## Fitting a three-parameter log-logistic model C.dubia.m1 <- drm(number ~ conc, data = C.dubia, fct = LL.3()) summary(C.dubia.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 16.1372 61.8281 0.2610 0.7952 #> d:(Intercept) 28.7500 1.1123 25.8464 < 2.2e-16 *** #> e:(Intercept) 11.9536 2.0608 5.8004 5.39e-07 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 7.03479 (47 degrees of freedom) ## Plotting fitted curve together with the original data plot(C.dubia.m1, xlab = \"Concentration (%)\", ylab = \"Number of offspring\")"},{"path":"https://hreinwald.github.io/drc/reference/CadmiumDaphnia.html","id":null,"dir":"Reference","previous_headings":"","what":"Cadmium Daphnia Data — CadmiumDaphnia","title":"Cadmium Daphnia Data — CadmiumDaphnia","text":"Data acute toxicity test exposing Daphnia cadmium time. endpoint measured mortality (number dead organisms) dose time point.","code":""},{"path":"https://hreinwald.github.io/drc/reference/CadmiumDaphnia.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Cadmium Daphnia Data — CadmiumDaphnia","text":"","code":"data(CadmiumDaphnia)"},{"path":"https://hreinwald.github.io/drc/reference/CadmiumDaphnia.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Cadmium Daphnia Data — CadmiumDaphnia","text":"data frame 58 observations following 6 variables. Dose numeric vector dose values Time numeric vector Total numeric vector Start numeric vector End numeric vector Dead numeric vector","code":""},{"path":"https://hreinwald.github.io/drc/reference/CadmiumDaphnia.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Cadmium Daphnia Data — CadmiumDaphnia","text":"","code":"library(drc) ## Displaying the data head(CadmiumDaphnia) #> Dose Time Total Start End Dead #> 1 0.0 2 50 0 2 0 #> 2 0.0 4 50 2 4 0 #> 3 0.0 7 50 4 7 0 #> 4 0.0 9 50 7 9 0 #> 5 0.0 11 50 9 11 0 #> 6 0.0 14 50 11 14 0 ## Fitting a two-parameter log-logistic model for binomial response at a single time point CadmiumDaphnia.sub <- CadmiumDaphnia[CadmiumDaphnia$Time == 7, ] CadmiumDaphnia.m1 <- drm(Dead/Total ~ as.numeric(as.character(Dose)), weights = Total, data = CadmiumDaphnia.sub, fct = LL.2(), type = \"binomial\") summary(CadmiumDaphnia.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) -1.00362 0.21675 -4.6303 3.651e-06 *** #> e:(Intercept) 132.42840 51.34644 2.5791 0.009905 ** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## Plotting the fitted curve plot(CadmiumDaphnia.m1, xlab = \"Cadmium dose\", ylab = \"Proportion dead\")"},{"path":"https://hreinwald.github.io/drc/reference/carbendazim.html","id":null,"dir":"Reference","previous_headings":"","what":"Damage of lymphocyte cells — carbendazim","title":"Damage of lymphocyte cells — carbendazim","text":"13 dose levels number damaged lymphocyte cells reported. dose level consisted total 2000 cells.","code":""},{"path":"https://hreinwald.github.io/drc/reference/carbendazim.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Damage of lymphocyte cells — carbendazim","text":"","code":"data(carbendazim)"},{"path":"https://hreinwald.github.io/drc/reference/carbendazim.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Damage of lymphocyte cells — carbendazim","text":"data frame 13 observations following 3 variables. dose numeric vector total numeric vector damage numeric vector","code":""},{"path":"https://hreinwald.github.io/drc/reference/carbendazim.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Damage of lymphocyte cells — carbendazim","text":"Bentley, K. S. Kirkland, D. Murphy, M. Marshall, R. (2000). Evaluation thresholds benomyl- carbendazim-induced aneuploidy cultured human lymphocytes using fluorescence situ hybridization, Mutation Research/Genetic Toxicology Environmental Mutagenesis, 464, 41–51.","code":""},{"path":"https://hreinwald.github.io/drc/reference/carbendazim.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Damage of lymphocyte cells — carbendazim","text":"","code":"library(drc) ## Displaying the data head(carbendazim) #> dose total damage #> 1 0 2000 16 #> 2 300 2000 20 #> 3 400 2000 24 #> 4 500 2000 9 #> 5 600 2000 19 #> 6 700 2000 34 ## Fitting a two-parameter log-logistic model for binomial response carbendazim.m1 <- drm(damage/total ~ dose, weights = total, data = carbendazim, fct = LL.2(), type = \"binomial\") summary(carbendazim.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) -1.4379 0.1072 -13.4127 < 2.2e-16 *** #> e:(Intercept) 10994.2466 1982.6612 5.5452 2.936e-08 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## Plotting the fitted curve plot(carbendazim.m1, xlab = \"Dose\", ylab = \"Proportion damaged\")"},{"path":"https://hreinwald.github.io/drc/reference/cedergreen.html","id":null,"dir":"Reference","previous_headings":"","what":"Cedergreen-Ritz-Streibig Model — cedergreen","title":"Cedergreen-Ritz-Streibig Model — cedergreen","text":"Provides Cedergreen-Ritz-Streibig function, five-parameter model describing dose-response curves exhibit hormesis (stimulatory beneficial effect low doses). function generates model object suitable use non-linear regression functions like drm.","code":""},{"path":"https://hreinwald.github.io/drc/reference/cedergreen.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Cedergreen-Ritz-Streibig Model — cedergreen","text":"","code":"cedergreen( fixed = c(NA, NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\", \"f\"), method = c(\"loglinear\", \"anke\", \"method3\", \"normolle\"), ssfct = NULL, alpha, fctName, fctText )"},{"path":"https://hreinwald.github.io/drc/reference/cedergreen.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Cedergreen-Ritz-Streibig Model — cedergreen","text":"fixed numeric vector length 5 specifying parameters held fixed estimation. order c(b, c, d, e, f). Use NA parameters estimated. default estimate parameters. names character vector length 5 providing names parameters. default c(\"b\", \"c\", \"d\", \"e\", \"f\"). method character string specifying method self-starter function use finding initial parameter values. Options \"loglinear\", \"anke\", \"method3\", \"normolle\". used ssfct NULL. ssfct custom self-starter function. NULL (default), self-starter automatically generated calling cedergreen.ssf specified method, fixed, alpha arguments. alpha mandatory numeric value specifying fixed shape parameter \\(\\alpha\\). function stop provided. fctName optional character string name function object. fctText optional character string providing descriptive text model.","code":""},{"path":"https://hreinwald.github.io/drc/reference/cedergreen.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Cedergreen-Ritz-Streibig Model — cedergreen","text":"list class mllogistic, containing model function (fct), self-starter function (ssfct), parameter names (names), components required use modeling functions like drm.","code":""},{"path":"https://hreinwald.github.io/drc/reference/cedergreen.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Cedergreen-Ritz-Streibig Model — cedergreen","text":"Cedergreen-Ritz-Streibig model defined following equation: $$f(x) = c + \\frac{d - c + f \\exp(-1/x^{\\alpha})}{1 + \\exp(b(\\log(x) - \\log(e)))}$$ parameter \\(f\\) determines size hormetic effect (stimulation). \\(f=0\\), model simplifies standard four-parameter log-logistic model. parameter \\(\\alpha\\) shape parameter must specified user.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/cedergreen.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Cedergreen-Ritz-Streibig Model — cedergreen","text":"Christian Ritz, Hannes Reinwald","code":""},{"path":"https://hreinwald.github.io/drc/reference/cedergreen.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Cedergreen-Ritz-Streibig Model — cedergreen","text":"","code":"dose <- c(0, 0.1, 0.5, 1, 5, 10, 20) response <- c(100, 102, 95, 80, 40, 25, 20) my_data <- data.frame(dose = dose, response = response) model_fit <- drm(response ~ dose, data = my_data, fct = cedergreen(alpha = 0.5)) summary(model_fit) #> #> Model fitted: Cedergreen-Ritz-Streibig (5 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 1.1619 0.2153 5.3965 0.0326651 * #> c:(Intercept) 13.5774 4.5892 2.9585 0.0977776 . #> d:(Intercept) 101.4210 2.0399 49.7190 0.0004043 *** #> e:(Intercept) 1.3820 1.1363 1.2162 0.3479717 #> f:(Intercept) 72.5388 126.6937 0.5726 0.6247324 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 2.513311 (2 degrees of freedom)"},{"path":"https://hreinwald.github.io/drc/reference/cedergreen.ssf.html","id":null,"dir":"Reference","previous_headings":"","what":"Self-starter for the Cedergreen-Ritz-Streibig Dose-Response Model — cedergreen.ssf","title":"Self-starter for the Cedergreen-Ritz-Streibig Dose-Response Model — cedergreen.ssf","text":"self-starting function Cedergreen-Ritz-Streibig model, used find initial parameter estimates non-linear regression (e.g., nls drc).","code":""},{"path":"https://hreinwald.github.io/drc/reference/cedergreen.ssf.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Self-starter for the Cedergreen-Ritz-Streibig Dose-Response Model — cedergreen.ssf","text":"","code":"cedergreen.ssf( method = c(\"loglinear\", \"anke\", \"method3\", \"normolle\"), fixed, alpha, useFixed = FALSE )"},{"path":"https://hreinwald.github.io/drc/reference/cedergreen.ssf.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Self-starter for the Cedergreen-Ritz-Streibig Dose-Response Model — cedergreen.ssf","text":"method character string specifying method estimating initial 'b' 'e' parameters. Using descriptive names preferred. fixed numeric vector fixed parameter values, NA parameters need estimated. required order c(b, c, d, e, f). alpha numeric value alpha parameter, treated known constant estimation initial parameters. useFixed logical value. TRUE, function use non-NA values provided fixed argument fixed parameters estimate others.","code":""},{"path":"https://hreinwald.github.io/drc/reference/cedergreen.ssf.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Self-starter for the Cedergreen-Ritz-Streibig Dose-Response Model — cedergreen.ssf","text":"numeric vector initial parameter estimates model parameters specified fixed.","code":""},{"path":"https://hreinwald.github.io/drc/reference/cedergreen.ssf.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Self-starter for the Cedergreen-Ritz-Streibig Dose-Response Model — cedergreen.ssf","text":"function closure returns another function. returned function takes data frame calculates initial values model parameters (b, c, d, e, f). self-starter relies several helper functions (e.g., findcd, findbe1, findbe2, findbe3) must available calling environment.","code":""},{"path":"https://hreinwald.github.io/drc/reference/cedergreen_edfct.html","id":null,"dir":"Reference","previous_headings":"","what":"Calculate Effective Dose for the Cedergreen-Ritz Hormesis Model — cedergreen_edfct","title":"Calculate Effective Dose for the Cedergreen-Ritz Hormesis Model — cedergreen_edfct","text":"internal helper function calculate effective dose (ED) derivatives Cedergreen-Ritz five-parameter hormesis model. uses uniroot find dose given response level.","code":""},{"path":"https://hreinwald.github.io/drc/reference/cedergreen_edfct.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Calculate Effective Dose for the Cedergreen-Ritz Hormesis Model — cedergreen_edfct","text":"","code":"cedergreen_edfct( parm, all_params, not_fixed, alpha, respl, reference, type, lower = 1e-04, upper = 10000 )"},{"path":"https://hreinwald.github.io/drc/reference/cedergreen_edfct.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Calculate Effective Dose for the Cedergreen-Ritz Hormesis Model — cedergreen_edfct","text":"parm numeric vector non-fixed model parameters. all_params numeric vector template model parameters (b,c,d,e,f). not_fixed logical integer vector indicating non-fixed parameters. alpha numeric value hormesis model's alpha shape parameter. respl response level calculate dose (e.g., 50 ED50). reference character string (\"control\" \"absolute\") calculating response. type character string specifying type ED calculation. lower lower bound dose interval root-finding search. upper upper bound dose interval root-finding search.","code":""},{"path":"https://hreinwald.github.io/drc/reference/cedergreen_edfct.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Calculate Effective Dose for the Cedergreen-Ritz Hormesis Model — cedergreen_edfct","text":"list containing calculated effective dose vector partial derivatives respect non-fixed parameters.","code":""},{"path":"https://hreinwald.github.io/drc/reference/cedergreen_edfct.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Calculate Effective Dose for the Cedergreen-Ritz Hormesis Model — cedergreen_edfct","text":"Hannes Reinwald","code":""},{"path":"https://hreinwald.github.io/drc/reference/cedergreen_maxfct.html","id":null,"dir":"Reference","previous_headings":"","what":"Find the Dose and Response at Maximum Hormesis — cedergreen_maxfct","title":"Find the Dose and Response at Maximum Hormesis — cedergreen_maxfct","text":"function finds dose elicits maximum hormetic (stimulatory) response Cedergreen-Ritz model response value dose.","code":""},{"path":"https://hreinwald.github.io/drc/reference/cedergreen_maxfct.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Find the Dose and Response at Maximum Hormesis — cedergreen_maxfct","text":"","code":"cedergreen_maxfct( all_params, alpha, lower = 1e-06, upper = 1000, .optimize_fn = stats::optimize )"},{"path":"https://hreinwald.github.io/drc/reference/cedergreen_maxfct.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Find the Dose and Response at Maximum Hormesis — cedergreen_maxfct","text":"all_params named list model parameters (b, c, d, e, f). alpha hormesis alpha shape parameter. lower lower bound dose interval search maximum. upper upper bound dose interval search maximum.","code":""},{"path":"https://hreinwald.github.io/drc/reference/cedergreen_maxfct.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Find the Dose and Response at Maximum Hormesis — cedergreen_maxfct","text":"numeric vector containing two values: dose maximum response, maximum response value . Returns c(NA, NA) failure.","code":""},{"path":"https://hreinwald.github.io/drc/reference/cedergreen_maxfct.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Find the Dose and Response at Maximum Hormesis — cedergreen_maxfct","text":"Hannes Reinwald","code":""},{"path":"https://hreinwald.github.io/drc/reference/chickweed.html","id":null,"dir":"Reference","previous_headings":"","what":"Germination of common chickweed (Stellaria media) — chickweed","title":"Germination of common chickweed (Stellaria media) — chickweed","text":"Germination data tests chickweed seeds chlorsulfuron resistant sensitive biotypes","code":""},{"path":"https://hreinwald.github.io/drc/reference/chickweed.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Germination of common chickweed (Stellaria media) — chickweed","text":"","code":"data(chickweed)"},{"path":"https://hreinwald.github.io/drc/reference/chickweed.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Germination of common chickweed (Stellaria media) — chickweed","text":"data frame 35 observations following 3 variables. start numeric vector left endpoints monitoring intervals end numeric vector right endpoints monitoring intervals count numeric vector number seeds germinated interval start end time numeric vector non-zero left endpoints monitoring intervals (often used recording practice)","code":""},{"path":"https://hreinwald.github.io/drc/reference/chickweed.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Germination of common chickweed (Stellaria media) — chickweed","text":"germination tests chickweed seeds chlorsulfuron resistant sensitive biotypes central Zealand done petri dishes (diameter: 9.0cm) dark growth cabinet temperature 5 degrees Celsius. seeds incubated 24 hours 0.3% solution potassium nitrate order imbibe seeds prior test. total 200 seeds placed filter plate. initialization tests, number germinated seeds recorded removed 34 consecutive inspection times. Definition germinated seed breakthrough seed testa radicle. Chickweed known dormant seeds therefore expect 100% germination. means upper limit proportion germinated incorporated parameter model, adequately reflects experimental design well expectations resulting outcome.","code":""},{"path":"https://hreinwald.github.io/drc/reference/chickweed.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Germination of common chickweed (Stellaria media) — chickweed","text":"Data kindly provided Lisa Borggaard (formerly Faculty Life Sciences, University Copenhagen).","code":""},{"path":"https://hreinwald.github.io/drc/reference/chickweed.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Germination of common chickweed (Stellaria media) — chickweed","text":"Ritz, C., Pipper, C. B. Streibig, J. C. (2013) Analysis germination data agricultural experiments, Europ. J. Agronomy, 45, 1–6.","code":""},{"path":"https://hreinwald.github.io/drc/reference/chickweed.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Germination of common chickweed (Stellaria media) — chickweed","text":"","code":"library(drc) ## Incorrect analysis using a logistic regression model ## (treating event times as binomial data) ## The argument \"type\" specifies that binomial data are supplied chickweed.m0a <- drm(count/200 ~ time, weights = rep(200, 34), data = chickweed0, fct = LL.3(), type = \"binomial\") summary(chickweed.m0a) # showing a summmary of the model fit (including parameter estimates) #> #> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) -15.715465 1.954346 -8.0413 8.886e-16 *** #> d:(Intercept) 0.207812 0.011541 18.0070 < 2.2e-16 *** #> e:(Intercept) 198.161626 2.965343 66.8259 < 2.2e-16 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## Incorrect analysis based on nonlinear regression ## LL.3() refers to the three-parameter log-logistic model ## As the argument \"type\" is not specified it is assumed that the data type ## is continuous and nonlinear regression based on least squares estimation is carried out chickweed.m0b <- drm(count/200 ~ time, data = chickweed0, fct = LL.3()) summary(chickweed.m0b) # showing a summmary of the model fit (including parameter estimates) #> #> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) -27.1427205 1.1960927 -22.693 < 2.2e-16 *** #> d:(Intercept) 0.1972877 0.0012527 157.490 < 2.2e-16 *** #> e:(Intercept) 195.8040859 0.3479695 562.705 < 2.2e-16 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.003417113 (31 degrees of freedom) ## How to re-arrange the data for fitting the event-time model ## (only for illustration of the steps needed for converting a dataset, ## but in this case not needed as both datasets are already provided in \"drc\") #chickweed <- data.frame(start = c(0, chickweed0$time), end = c(chickweed0$time, Inf)) #chickweed$count <- c(0, diff(chickweed0$count), 200 - tail(chickweed0$count, 1)) #head(chickweed) # showing top 6 lines of the dataset #tail(chickweed) # showing bottom 6 lines ## Fitting the event-time model (by specifying the argument type explicitly) chickweed.m1 <- drm(count~start+end, data = chickweed, fct = LL.3(), type = \"event\") summary(chickweed.m1) # showing a summmary of the model fit (including parameter estimates) #> #> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) -20.76747 2.94423 -7.0536 1.743e-12 *** #> d:(Intercept) 0.20011 0.02830 7.0711 1.537e-12 *** #> e:(Intercept) 196.05308 2.50570 78.2427 < 2.2e-16 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## Summary output with robust standard errors ## library(lmtest) ## library(sandwich) ## coeftest(chickweed.m1, vcov = sandwich) ## Calculating t10, t50, t90 for the distribution of viable seeds ED(chickweed.m1, c(10, 50, 90)) #> #> Estimated effective doses #> #> Estimate Std. Error #> e:10 176.3700 3.4930 #> e:50 196.0531 2.5057 #> e:90 217.9328 4.2730 ## Plotting data and fitted regression curve plot(chickweed.m1, xlab = \"Time (hours)\", ylab = \"Proportion germinated\", xlim=c(0, 340), ylim=c(0, 0.25), log=\"\", lwd=2, cex=1.2) ## Adding the fitted curve obtained using nonlinear regression plot(chickweed.m0b, add = TRUE, lty = 2, xlim=c(0, 340), ylim=c(0, 0.25), log=\"\", lwd=2, cex=1.2) # Note: the event-time model has slightly better fit at the upper limit ## Enhancing the plot (to look like in the reference paper) abline(h = 0.20011, lty = 3, lwd = 2) text(-15, 0.21, \"Upper limit: d\", pos = 4, cex = 1.5) segments(0,0.1,196,0.1, lty = 3, lwd = 2) segments(196,0.1, 196, -0.1, lty = 3, lwd = 2) text(200, -0.004, expression(paste(\"50% germination: \", t[50])), pos = 4, cex = 1.5) abline(a = 0.20011/2-0.20011*20.77/4, b = 0.20011*20.77/4/196, lty = 3, lwd = 2) #text(200, 0.1, expression(paste(\"Slope: \", b*(-d/(4*t[50])))), pos = 4, cex = 1.5) text(200, 0.1, expression(\"Slope: b\" %.% \"constant\"), pos = 4, cex = 1.5) points(196, 0.1, cex = 2, pch = 0) ## Adding confidence intervals ## Predictions from the event-time model #coefVec <- coef(chickweed.m1) #names(coefVec) <- c(\"b\",\"d\",\"e\") # #predFct <- function(tival) #{ # as.numeric(deltaMethod(coefVec, paste(\"d/(1+exp(b*(log(\",tival,\")-log(e))))\"), # vcov(chickweed.m1))) #} #predFctv <- Vectorize(predFct, \"tival\") # #etpred <- t(predFctv(0:340)) #lines(0:340, etpred[,1]-1.96*etpred[,2], lty=1, lwd=2, col=\"darkgray\") #lines(0:340, etpred[,1]+1.96*etpred[,2], lty=1, lwd=2, col=\"darkgray\") # ### Predictions from the nonlinear regression model #nrpred <- predict(chickweed.m0b, data.frame(time=0:340), interval=\"confidence\") #lines(0:340, nrpred[,2], lty=2, lwd=2, col=\"darkgray\") #lines(0:340, nrpred[,3], lty=2, lwd=2, col=\"darkgray\")"},{"path":"https://hreinwald.github.io/drc/reference/chlorac.html","id":null,"dir":"Reference","previous_headings":"","what":"chlorac — chlorac","title":"chlorac — chlorac","text":"Data acute toxicity test organisms exposed different concentrations chloroacetaldehyde. number dead subjects total recorded concentration.","code":""},{"path":"https://hreinwald.github.io/drc/reference/chlorac.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"chlorac — chlorac","text":"","code":"data(chlorac)"},{"path":"https://hreinwald.github.io/drc/reference/chlorac.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"chlorac — chlorac","text":"data frame 6 observations following 3 variables. conc numeric vector total numeric vector num.dead numeric vector","code":""},{"path":"https://hreinwald.github.io/drc/reference/chlorac.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"chlorac — chlorac","text":"","code":"library(drc) ## Displaying the data head(chlorac) #> conc total num.dead #> 1 0 40 3 #> 2 10 40 5 #> 3 20 40 6 #> 4 40 40 38 #> 5 80 40 40 #> 6 160 40 40 ## Fitting a two-parameter log-logistic model for binomial response chlorac.m1 <- drm(num.dead/total ~ conc, weights = total, data = chlorac, fct = LL.2(), type = \"binomial\") summary(chlorac.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) -3.8861 0.5787 -6.7152 1.878e-11 *** #> e:(Intercept) 24.1102 1.6173 14.9082 < 2.2e-16 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## Plotting the fitted curve plot(chlorac.m1, xlab = \"Concentration\", ylab = \"Proportion dead\")"},{"path":"https://hreinwald.github.io/drc/reference/chlordan.html","id":null,"dir":"Reference","previous_headings":"","what":"Chlordan — chlordan","title":"Chlordan — chlordan","text":"Data chronic toxicity test measuring reproduction Daphnia exposed different concentrations chlordane two time points. response measured number offspring (repro) per replicate.","code":""},{"path":"https://hreinwald.github.io/drc/reference/chlordan.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Chlordan — chlordan","text":"","code":"data(chlordan)"},{"path":"https://hreinwald.github.io/drc/reference/chlordan.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Chlordan — chlordan","text":"data frame 60 observations following 5 variables. replicate numeric vector conc numeric vector repro numeric vector time numeric vector","code":""},{"path":"https://hreinwald.github.io/drc/reference/chlordan.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Chlordan — chlordan","text":"","code":"library(drc) ## Displaying the data head(chlordan) #> replicate conc repro time #> 1 1 0.00 125 21.0 #> 2 1 0.18 89 21.0 #> 3 1 0.73 90 21.0 #> 4 1 1.82 42 21.0 #> 5 1 2.90 29 21.0 #> 6 1 7.00 10 11.5 ## Fitting a three-parameter log-logistic model chlordan.m1 <- drm(repro ~ conc, data = chlordan, fct = LL.3()) summary(chlordan.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 1.00663 0.14921 6.7463 8.414e-09 *** #> d:(Intercept) 115.12320 5.05139 22.7904 < 2.2e-16 *** #> e:(Intercept) 1.55178 0.24368 6.3681 3.565e-08 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 16.86007 (57 degrees of freedom) ## Plotting the fitted curve plot(chlordan.m1, xlab = \"Concentration\", ylab = \"Reproduction\")"},{"path":"https://hreinwald.github.io/drc/reference/CIcomp.html","id":null,"dir":"Reference","previous_headings":"","what":"Classical combination index for effective doses — CIcomp","title":"Classical combination index for effective doses — CIcomp","text":"Calculates classical combination index effective doses binary mixture experiments.","code":""},{"path":"https://hreinwald.github.io/drc/reference/CIcomp.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Classical combination index for effective doses — CIcomp","text":"","code":"CIcomp(mixProp, modelList, EDvec)"},{"path":"https://hreinwald.github.io/drc/reference/CIcomp.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Classical combination index for effective doses — CIcomp","text":"mixProp numeric value 0 1 specifying mixture proportion/ratio. modelList list containing 3 model fits using drm: mixture model fit first, followed 2 pure substance model fits. EDvec numeric vector effect levels (percentages 0 100).","code":""},{"path":"https://hreinwald.github.io/drc/reference/CIcomp.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Classical combination index for effective doses — CIcomp","text":"matrix one row per ED value. Columns contain estimated combination indices, standard errors 95% confidence intervals, p-value testing CI=1, estimated ED values mixture data assuming concentration addition (CA) corresponding standard errors.","code":""},{"path":"https://hreinwald.github.io/drc/reference/CIcomp.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Classical combination index for effective doses — CIcomp","text":"Martin-Betancor, K. Ritz, C. Fernandez-Pinas, F. Leganes, F. Rodea-Palomares, . (2015) Defining additivity framework mixture research inducible whole-cell biosensors, Scientific Reports 17200.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/CIcomp.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Classical combination index for effective doses — CIcomp","text":"Christian Ritz Ismael Rodea-Palomares","code":""},{"path":"https://hreinwald.github.io/drc/reference/CIcomp.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Classical combination index for effective doses — CIcomp","text":"","code":"## Fitting marginal models for the 2 pure substances acidiq.0 <- drm(rgr ~ dose, data = subset(acidiq, pct == 999 | pct == 0), fct = LL.4()) acidiq.100 <- drm(rgr ~ dose, data = subset(acidiq, pct == 999 | pct == 100), fct = LL.4()) ## Fitting model for single mixture with ratio 17:83 acidiq.17 <- drm(rgr ~ dose, data = subset(acidiq, pct == 17 | pct == 0), fct = LL.4()) ## Calculation of combination indices based on ED10, ED20, ED50 CIcomp(0.17, list(acidiq.17, acidiq.0, acidiq.100), c(10, 20, 50)) #> combInd SE lowCI highCI CAdiffp ED.CA SE.CA #> 10 1.7180152 0.31407144 1.1024352 2.333595 0.02224534 76.91373 11.85583 #> 20 1.3421604 0.16702874 1.0147841 1.669537 0.04050985 140.38385 14.47436 #> 50 0.9035949 0.08440138 0.7381682 1.069022 0.25336168 382.44378 32.11935 #> ED.mix SE.mix #> 10 132.1390 12.98677 #> 20 188.4176 13.13050 #> 50 345.5742 14.12771"},{"path":"https://hreinwald.github.io/drc/reference/CIcompX.html","id":null,"dir":"Reference","previous_headings":"","what":"Calculation of combination index for binary mixtures — CIcompX","title":"Calculation of combination index for binary mixtures — CIcompX","text":"single mixture data, combination indices effective doses well effects may calculated. extended version CIcomp.","code":""},{"path":"https://hreinwald.github.io/drc/reference/CIcompX.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Calculation of combination index for binary mixtures — CIcompX","text":"","code":"CIcompX(mixProp, modelList, EDvec, EDonly = FALSE)"},{"path":"https://hreinwald.github.io/drc/reference/CIcompX.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Calculation of combination index for binary mixtures — CIcompX","text":"mixProp numeric value 0 1 specifying mixture proportion/ratio. modelList list containing 3 model fits using drm: mixture model fit first, followed 2 pure substance model fits. EDvec numeric vector effect levels (percentages 0 100). EDonly logical. TRUE, combination indices effective doses calculated.","code":""},{"path":"https://hreinwald.github.io/drc/reference/CIcompX.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Calculation of combination index for binary mixtures — CIcompX","text":"list components Effx, Effy (unless EDonly = TRUE), CAx, CAy (unless EDonly = TRUE), EDvec.","code":""},{"path":"https://hreinwald.github.io/drc/reference/CIcompX.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Calculation of combination index for binary mixtures — CIcompX","text":"Martin-Betancor, K. Ritz, C. Fernandez-Pinas, F. Leganes, F. Rodea-Palomares, . (2015) Defining additivity framework mixture research inducible whole-cell biosensors, Scientific Reports 17200.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/CIcompX.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Calculation of combination index for binary mixtures — CIcompX","text":"Christian Ritz Ismael Rodea-Palomares","code":""},{"path":"https://hreinwald.github.io/drc/reference/coef.drc.html","id":null,"dir":"Reference","previous_headings":"","what":"Extract Model Coefficients — coef.drc","title":"Extract Model Coefficients — coef.drc","text":"Extract parameter estimates.","code":""},{"path":"https://hreinwald.github.io/drc/reference/coef.drc.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Extract Model Coefficients — coef.drc","text":"","code":"# S3 method for class 'drc' coef(object, ...)"},{"path":"https://hreinwald.github.io/drc/reference/coef.drc.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Extract Model Coefficients — coef.drc","text":"object object class 'drc'. ... additional arguments.","code":""},{"path":"https://hreinwald.github.io/drc/reference/coef.drc.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Extract Model Coefficients — coef.drc","text":"vector parameter coefficients extracted model object object.","code":""},{"path":"https://hreinwald.github.io/drc/reference/coef.drc.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Extract Model Coefficients — coef.drc","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/coef.drc.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Extract Model Coefficients — coef.drc","text":"","code":"## Fitting a four-parameter log-logistic model ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) coef(ryegrass.m1) #> b:(Intercept) c:(Intercept) d:(Intercept) e:(Intercept) #> 2.9822191 0.4814132 7.7929583 3.0579550"},{"path":"https://hreinwald.github.io/drc/reference/commatFct.html","id":null,"dir":"Reference","previous_headings":"","what":"Construct contrast matrix — commatFct","title":"Construct contrast matrix — commatFct","text":"Construct contrast matrix","code":""},{"path":"https://hreinwald.github.io/drc/reference/commatFct.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Construct contrast matrix — commatFct","text":"","code":"commatFct(object, compMatch)"},{"path":"https://hreinwald.github.io/drc/reference/comped.html","id":null,"dir":"Reference","previous_headings":"","what":"Comparison of effective dose values — comped","title":"Comparison of effective dose values — comped","text":"Comparison pair effective dose values independent experiments estimates standard errors reported.","code":""},{"path":"https://hreinwald.github.io/drc/reference/comped.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Comparison of effective dose values — comped","text":"","code":"comped( est, se, log = TRUE, interval = TRUE, operator = c(\"-\", \"/\"), level = 0.95, df = NULL )"},{"path":"https://hreinwald.github.io/drc/reference/comped.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Comparison of effective dose values — comped","text":"est numeric vector length 2 containing two estimated ED values. se numeric vector length 2 containing two standard errors. log logical indicating whether estimates standard errors log scale. interval logical indicating whether confidence interval returned. operator character string taking one two values \"-\" (default) \"/\" corresponding comparison based difference ratio. level numeric value giving confidence level. df numeric value specifying degrees freedom percentile used confidence interval (optional). default confidence interval relies normal distribution.","code":""},{"path":"https://hreinwald.github.io/drc/reference/comped.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Comparison of effective dose values — comped","text":"matrix estimated difference ratio associated standard error resulting confidence interval (unless requested).","code":""},{"path":"https://hreinwald.github.io/drc/reference/comped.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Comparison of effective dose values — comped","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/comped.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Comparison of effective dose values — comped","text":"","code":"## Comparing ED50 values as a ratio comped(c(28.396, 65.573), c(1.875, 5.619), log = FALSE, operator = \"/\") #> #> Estimated ratio of effective doses #> #> Estimate Std. Error Lower Upper #> [1,] 0.433044 0.046847 0.341226 0.5249 ## Comparing ED50 values as a difference comped(c(28.396, 65.573), c(1.875, 5.619), log = FALSE, operator = \"-\") #> #> Estimated difference of effective doses #> #> Estimate Std. Error Lower Upper #> [1,] -37.1770 5.9236 -48.7870 -25.567"},{"path":"https://hreinwald.github.io/drc/reference/compParm.html","id":null,"dir":"Reference","previous_headings":"","what":"Comparison of parameters — compParm","title":"Comparison of parameters — compParm","text":"Compare parameters different assays, either means ratios differences.","code":""},{"path":"https://hreinwald.github.io/drc/reference/compParm.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Comparison of parameters — compParm","text":"","code":"compParm( object, strVal, operator = \"/\", vcov. = vcov, od = FALSE, pool = TRUE, display = TRUE )"},{"path":"https://hreinwald.github.io/drc/reference/compParm.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Comparison of parameters — compParm","text":"object object class 'drc'. strVal name parameter compare. operator character. equal \"/\" (default) parameter ratios compared. equal \"-\" parameter differences compared. vcov. function providing variance-covariance matrix. vcov default, sandwich also option (obtaining robust standard errors). od logical. TRUE adjustment -dispersion used. pool logical. TRUE curves pooled. Otherwise . argument works models independently fitted curves specified drm. display logical. TRUE results displayed. Otherwise (useful simulations).","code":""},{"path":"https://hreinwald.github.io/drc/reference/compParm.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Comparison of parameters — compParm","text":"matrix columns containing estimates, estimated standard errors, values t-statistics p-values null hypothesis ratio equals 1 difference equals 0 (depending operator argument).","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/compParm.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Comparison of parameters — compParm","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/compParm.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Comparison of parameters — compParm","text":"","code":"spinach.m1 <- drm(SLOPE~DOSE, CURVE, data = spinach, fct = LL.4(names = c(\"b\", \"lower\", \"upper\", \"ed50\"))) ## Calculating ratios of parameter estimates for \"ed50\" compParm(spinach.m1, \"ed50\") #> #> Comparison of parameter 'ed50' #> #> Estimate Std. Error t-value p-value #> 1/2 1.89836 0.71185 1.2620 0.210398 #> 1/3 1.30730 0.55416 0.5545 0.580668 #> 1/4 9.09638 2.46866 3.2797 0.001508 ** #> 1/5 8.51523 2.33645 3.2165 0.001836 ** #> 2/3 0.68865 0.29081 -1.0706 0.287360 #> 2/4 4.79171 1.28835 2.9431 0.004189 ** #> 2/5 4.48557 1.21960 2.8580 0.005361 ** #> 3/4 6.95813 2.32206 2.5659 0.012045 * #> 3/5 6.51359 2.18960 2.5181 0.013674 * #> 4/5 0.93611 0.07814 -0.8176 0.415868 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## Calculating differences between parameter estimates for \"ed50\" compParm(spinach.m1, \"ed50\", \"-\") #> #> Comparison of parameter 'ed50' #> #> Estimate Std. Error t-value p-value #> 1-2 0.849425 0.539400 1.5748 0.119027 #> 1-3 0.421932 0.658506 0.6407 0.523414 #> 1-4 1.597629 0.478341 3.3399 0.001246 ** #> 1-5 1.584161 0.478432 3.3112 0.001365 ** #> 2-3 -0.427493 0.516885 -0.8271 0.410521 #> 2-4 0.748204 0.249701 2.9964 0.003580 ** #> 2-5 0.734736 0.249876 2.9404 0.004221 ** #> 3-4 1.175696 0.452799 2.5965 0.011095 * #> 3-5 1.162229 0.452896 2.5662 0.012034 * #> 4-5 -0.013467 0.017174 -0.7842 0.435128 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1"},{"path":"https://hreinwald.github.io/drc/reference/confint.basic.html","id":null,"dir":"Reference","previous_headings":"","what":"Basic Confidence Interval Calculation — confint.basic","title":"Basic Confidence Interval Calculation — confint.basic","text":"internal helper function constructs confidence interval matrix matrix parameter estimates standard errors. t-distribution quantile used continuous response models; standard normal quantile used response types (binomial, event, Poisson, negbin1, negbin2).","code":""},{"path":"https://hreinwald.github.io/drc/reference/confint.basic.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Basic Confidence Interval Calculation — confint.basic","text":"","code":"# S3 method for class 'basic' confint(estMat, level, intType, dfres, formatting = TRUE)"},{"path":"https://hreinwald.github.io/drc/reference/confint.basic.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Basic Confidence Interval Calculation — confint.basic","text":"estMat numeric matrix two columns: first column contains parameter estimates second column contains standard errors. level confidence level required (e.g., 0.95 95% intervals). intType character string specifying response type model. One \"binomial\", \"continuous\", \"event\", \"Poisson\", \"negbin1\", \"negbin2\". Determines whether normal t-distribution quantile used. \"continuous\" models t-distribution dfres degrees freedom used; types use standard normal. dfres residual degrees freedom. used intType = \"continuous\". formatting Logical. TRUE (default), row column names added returned matrix.","code":""},{"path":"https://hreinwald.github.io/drc/reference/confint.basic.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Basic Confidence Interval Calculation — confint.basic","text":"numeric matrix two columns giving lower upper confidence limits parameter.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/confint.drc.html","id":null,"dir":"Reference","previous_headings":"","what":"Confidence Intervals for Model Parameters — confint.drc","title":"Confidence Intervals for Model Parameters — confint.drc","text":"Computes confidence intervals one parameters fitted dose-response model class \"drc\". Confidence intervals constructed using either t-distribution (continuous response models) standard normal distribution (response types).","code":""},{"path":"https://hreinwald.github.io/drc/reference/confint.drc.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Confidence Intervals for Model Parameters — confint.drc","text":"","code":"# S3 method for class 'drc' confint(object, parm, level = 0.95, pool = TRUE, ...)"},{"path":"https://hreinwald.github.io/drc/reference/confint.drc.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Confidence Intervals for Model Parameters — confint.drc","text":"object fitted model object class \"drc\". parm specification parameters given confidence intervals, either vector indices vector parameter name strings. missing, parameters considered. level confidence level required. Defaults 0.95. pool Logical. TRUE (default), curves pooled. Otherwise . argument works models independently fitted curves specified drm(). ... Additional arguments methods. Currently used.","code":""},{"path":"https://hreinwald.github.io/drc/reference/confint.drc.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Confidence Intervals for Model Parameters — confint.drc","text":"numeric matrix two columns giving lower upper confidence limits parameter. Columns labelled \\(\\frac{(1 - \\text{level})}{2} \\times 100\\%\\) \\(\\left(1 - \\frac{(1 - \\text{level})}{2}\\right) \\times 100\\%\\) (default 2.5 % 97.5 %).","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/confint.drc.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Confidence Intervals for Model Parameters — confint.drc","text":"Christian Ritz, Hannes Reinwald","code":""},{"path":"https://hreinwald.github.io/drc/reference/confint.drc.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Confidence Intervals for Model Parameters — confint.drc","text":"","code":"## Fitting a four-parameter log-logistic model ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) ## Confidence intervals for all parameters confint(ryegrass.m1) #> 2.5 % 97.5 % #> b:(Intercept) 2.01211606 3.9523221 #> c:(Intercept) 0.03878752 0.9240389 #> d:(Intercept) 7.39961398 8.1863026 #> e:(Intercept) 2.67052621 3.4453837 ## Confidence interval for a single parameter confint(ryegrass.m1, \"e\") #> 2.5 % 97.5 % #> e:(Intercept) 2.670526 3.445384"},{"path":"https://hreinwald.github.io/drc/reference/cooks.distance.drc.html","id":null,"dir":"Reference","previous_headings":"","what":"Cook's distance for nonlinear dose-response models — cooks.distance.drc","title":"Cook's distance for nonlinear dose-response models — cooks.distance.drc","text":"Cook's distance values provided nonlinear dose-response model fits using formulas linear regression based corresponding approximate quantities available nonlinear models.","code":""},{"path":"https://hreinwald.github.io/drc/reference/cooks.distance.drc.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Cook's distance for nonlinear dose-response models — cooks.distance.drc","text":"","code":"# S3 method for class 'drc' cooks.distance(model, ...)"},{"path":"https://hreinwald.github.io/drc/reference/cooks.distance.drc.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Cook's distance for nonlinear dose-response models — cooks.distance.drc","text":"model object class 'drc'. ... additional arguments (used).","code":""},{"path":"https://hreinwald.github.io/drc/reference/cooks.distance.drc.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Cook's distance for nonlinear dose-response models — cooks.distance.drc","text":"vector Cook's distance values, one value per observation.","code":""},{"path":"https://hreinwald.github.io/drc/reference/cooks.distance.drc.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Cook's distance for nonlinear dose-response models — cooks.distance.drc","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/cooks.distance.drc.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Cook's distance for nonlinear dose-response models — cooks.distance.drc","text":"","code":"ryegrass.LL.4 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) cooks.distance(ryegrass.LL.4) #> 1 2 3 4 5 6 #> 7.453159e-03 7.044772e-03 4.714696e-02 4.844894e-02 2.870894e-02 4.723940e-03 #> 7 8 9 10 11 12 #> 6.453374e-02 4.817127e-02 3.034449e-03 1.086166e-01 1.026316e-03 1.159960e-01 #> 13 14 15 16 17 18 #> 6.500257e-01 1.505664e-02 6.990776e-01 8.318727e-03 1.370597e-03 1.649069e-03 #> 19 20 21 22 23 24 #> 3.231490e-03 6.070437e-05 1.244105e-02 1.159916e-02 1.468742e-02 4.949825e-04"},{"path":"https://hreinwald.github.io/drc/reference/createsifct.html","id":null,"dir":"Reference","previous_headings":"","what":"Create selectivity index function — createsifct","title":"Create selectivity index function — createsifct","text":"Create selectivity index function","code":""},{"path":"https://hreinwald.github.io/drc/reference/createsifct.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Create selectivity index function — createsifct","text":"","code":"createsifct(edfct, logBase = NULL, fls = FALSE, indexMat, lenCoef)"},{"path":"https://hreinwald.github.io/drc/reference/CRS.4a.html","id":null,"dir":"Reference","previous_headings":"","what":"Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 1 (Deprecated) — CRS.4a","title":"Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 1 (Deprecated) — CRS.4a","text":"function deprecated version 3.3.0. Please use CRS.5() instead, provides general flexible interface. four-parameter Cedergreen-Ritz-Streibig (CRS) hormesis model lower asymptote (c) fixed 0 alpha parameter controlling steepness hormetic component fixed 1. four free parameters b, d, e, f.","code":""},{"path":"https://hreinwald.github.io/drc/reference/CRS.4a.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 1 (Deprecated) — CRS.4a","text":"","code":"CRS.4a(names = c(\"b\", \"c\", \"d\", \"e\", \"f\"), fixed = c(NA, 0, NA, NA, NA), ...)"},{"path":"https://hreinwald.github.io/drc/reference/CRS.4a.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 1 (Deprecated) — CRS.4a","text":"names character vector length 5 specifying names model parameters following order: b Hill slope (steepness dose-response curve). c Lower asymptote (fixed 0 via fixed argument). d Upper asymptote. e Effective dose producing response midway c d (ED50). f Hormesis parameter controlling magnitude stimulatory effect low doses. Defaults c(\"b\", \"c\", \"d\", \"e\", \"f\"). fixed numeric vector length 5 specifying fixed (non-estimated) parameter values. Use NA parameters estimated freely. Defaults c(NA, 0, NA, NA, NA), fixes lower asymptote c 0. ... Additional arguments passed cedergreen().","code":""},{"path":"https://hreinwald.github.io/drc/reference/CRS.4a.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 1 (Deprecated) — CRS.4a","text":"list class \"drcMean\" returned cedergreen(), containing model definition including mean function, gradient, parameter names, fixed values. object intended use fct argument drm().","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/CRS.4a.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 1 (Deprecated) — CRS.4a","text":"Christian Ritz, Hannes Reinwald","code":""},{"path":"https://hreinwald.github.io/drc/reference/CRS.4a.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 1 (Deprecated) — CRS.4a","text":"","code":"# NOTE: CRS.4a() is deprecated. Use CRS.5() instead. # The example below is retained for backward compatibility illustration only. lettuce.crsm1 <- drm( lettuce[, c(2, 1)], fct = CRS.4a() ) summary(lettuce.crsm1) #> #> Model fitted: Cedergreen-Ritz-Streibig with lower limit 0 (alpha=1) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 7.7892e-01 2.5343e-01 3.0735 0.01177 * #> d:(Intercept) 1.1091e+00 7.8336e-02 14.1586 6.081e-08 *** #> e:(Intercept) 2.8572e+01 3.1328e+01 0.9120 0.38322 #> f:(Intercept) 5.5833e-04 4.1209e-01 0.0014 0.99895 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.155635 (10 degrees of freedom) ED(lettuce.crsm1, c(50)) #> #> Estimated effective doses #> #> Estimate Std. Error #> e:50 28.608 11.751 # Recommended replacement: fct_spec <- CRS.5(alpha_type = \"a\", fixed = c(NA, 0, NA, NA, NA)) lettuce.crs5 <- drm(lettuce[, c(2, 1)], fct = fct_spec) summary(lettuce.crs5) #> #> Model fitted: Cedergreen-Ritz-Streibig (alpha=1) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 7.7892e-01 2.5343e-01 3.0735 0.01177 * #> d:(Intercept) 1.1091e+00 7.8336e-02 14.1586 6.081e-08 *** #> e:(Intercept) 2.8572e+01 3.1328e+01 0.9120 0.38322 #> f:(Intercept) 5.5833e-04 4.1209e-01 0.0014 0.99895 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.155635 (10 degrees of freedom) ED(lettuce.crs5, c(50)) #> #> Estimated effective doses #> #> Estimate Std. Error #> e:50 28.608 11.751"},{"path":"https://hreinwald.github.io/drc/reference/CRS.4b.html","id":null,"dir":"Reference","previous_headings":"","what":"Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 0.5 (Deprecated) — CRS.4b","title":"Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 0.5 (Deprecated) — CRS.4b","text":"function deprecated version 3.3.0. Please use CRS.5() instead, provides general flexible interface. four-parameter Cedergreen-Ritz-Streibig (CRS) hormesis model lower asymptote (c) fixed 0 alpha parameter controlling steepness hormetic component fixed 0.5. four free parameters b, d, e, f.","code":""},{"path":"https://hreinwald.github.io/drc/reference/CRS.4b.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 0.5 (Deprecated) — CRS.4b","text":"","code":"CRS.4b(names = c(\"b\", \"c\", \"d\", \"e\", \"f\"), fixed = c(NA, 0, NA, NA, NA), ...)"},{"path":"https://hreinwald.github.io/drc/reference/CRS.4b.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 0.5 (Deprecated) — CRS.4b","text":"names character vector length 5 specifying names model parameters following order: b Hill slope (steepness dose-response curve). c Lower asymptote (fixed 0 via fixed argument). d Upper asymptote. e Effective dose producing response midway c d (ED50). f Hormesis parameter controlling magnitude stimulatory effect low doses. Defaults c(\"b\", \"c\", \"d\", \"e\", \"f\"). fixed numeric vector length 5 specifying fixed (non-estimated) parameter values. Use NA parameters estimated freely. Defaults c(NA, 0, NA, NA, NA), fixes lower asymptote c 0. ... Additional arguments passed cedergreen().","code":""},{"path":"https://hreinwald.github.io/drc/reference/CRS.4b.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 0.5 (Deprecated) — CRS.4b","text":"list class \"drcMean\" returned cedergreen(), containing model definition including mean function, gradient, parameter names, fixed values. object intended use fct argument drm().","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/CRS.4b.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 0.5 (Deprecated) — CRS.4b","text":"Christian Ritz, Hannes Reinwald","code":""},{"path":"https://hreinwald.github.io/drc/reference/CRS.4b.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 0.5 (Deprecated) — CRS.4b","text":"","code":"# NOTE: CRS.4b() is deprecated. Use CRS.5() instead. # The example below is retained for backward compatibility illustration only. lettuce.crsm2 <- drm( lettuce[, c(2, 1)], fct = CRS.4b() ) summary(lettuce.crsm2) #> #> Model fitted: Cedergreen-Ritz-Streibig with lower limit 0 (alpha=0.5) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 0.569426 0.068538 8.3081 8.444e-06 *** #> d:(Intercept) 1.008915 0.094919 10.6292 9.061e-07 *** #> e:(Intercept) 0.642290 1.533937 0.4187 0.6843 #> f:(Intercept) 4.446933 5.821389 0.7639 0.4626 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.1345066 (10 degrees of freedom) ED(lettuce.crsm2, c(50)) #> #> Estimated effective doses #> #> Estimate Std. Error #> e:50 26.1252 8.6286 # Recommended replacement: fct_spec <- CRS.5(alpha_type = \"b\", fixed = c(NA, 0, NA, NA, NA)) lettuce.crs5 <- drm(lettuce[, c(2, 1)], fct = fct_spec) summary(lettuce.crs5) #> #> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.5) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 0.569426 0.068538 8.3081 8.444e-06 *** #> d:(Intercept) 1.008915 0.094919 10.6292 9.061e-07 *** #> e:(Intercept) 0.642290 1.533937 0.4187 0.6843 #> f:(Intercept) 4.446933 5.821389 0.7639 0.4626 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.1345066 (10 degrees of freedom) ED(lettuce.crs5, c(50)) #> #> Estimated effective doses #> #> Estimate Std. Error #> e:50 26.1252 8.6286"},{"path":"https://hreinwald.github.io/drc/reference/CRS.4c.html","id":null,"dir":"Reference","previous_headings":"","what":"Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 0.25 (Deprecated) — CRS.4c","title":"Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 0.25 (Deprecated) — CRS.4c","text":"function deprecated version 3.3.0. Please use CRS.5() instead, provides general flexible interface. four-parameter Cedergreen-Ritz-Streibig (CRS) hormesis model lower asymptote (c) fixed 0 alpha parameter controlling steepness hormetic component fixed 0.25. four free parameters b, d, e, f.","code":""},{"path":"https://hreinwald.github.io/drc/reference/CRS.4c.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 0.25 (Deprecated) — CRS.4c","text":"","code":"CRS.4c(names = c(\"b\", \"c\", \"d\", \"e\", \"f\"), fixed = c(NA, 0, NA, NA, NA), ...)"},{"path":"https://hreinwald.github.io/drc/reference/CRS.4c.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 0.25 (Deprecated) — CRS.4c","text":"names character vector length 5 specifying names model parameters following order: b Hill slope (steepness dose-response curve). c Lower asymptote (fixed 0 via fixed argument). d Upper asymptote. e Effective dose producing response midway c d (ED50). f Hormesis parameter controlling magnitude stimulatory effect low doses. Defaults c(\"b\", \"c\", \"d\", \"e\", \"f\"). fixed numeric vector length 5 specifying fixed (non-estimated) parameter values. Use NA parameters estimated freely. Defaults c(NA, 0, NA, NA, NA), fixes lower asymptote c 0. ... Additional arguments passed cedergreen().","code":""},{"path":"https://hreinwald.github.io/drc/reference/CRS.4c.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 0.25 (Deprecated) — CRS.4c","text":"list class \"drcMean\" returned cedergreen(), containing model definition including mean function, gradient, parameter names, fixed values. object intended use fct argument drm().","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/CRS.4c.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 0.25 (Deprecated) — CRS.4c","text":"Christian Ritz, Hannes Reinwald","code":""},{"path":"https://hreinwald.github.io/drc/reference/CRS.4c.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 0.25 (Deprecated) — CRS.4c","text":"","code":"# NOTE: CRS.4c() is deprecated. Use CRS.5() instead. # The example below is retained for backward compatibility illustration only. lettuce.crsm3 <- drm( lettuce[, c(2, 1)], fct = CRS.4c() ) summary(lettuce.crsm3) #> #> Model fitted: Cedergreen-Ritz-Streibig with lower limit 0 (alpha=0.25) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 0.488440 0.133643 3.6548 0.004427 ** #> d:(Intercept) 0.973666 0.086883 11.2066 5.544e-07 *** #> e:(Intercept) 1.314657 3.614266 0.3637 0.723624 #> f:(Intercept) 2.998547 3.626210 0.8269 0.427579 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.123575 (10 degrees of freedom) ED(lettuce.crsm3, c(50)) #> #> Estimated effective doses #> #> Estimate Std. Error #> e:50 37.033 15.437 # Recommended replacement: fct_spec <- CRS.5(alpha_type = \"c\", fixed = c(NA, 0, NA, NA, NA)) lettuce.crs5 <- drm(lettuce[, c(2, 1)], fct = fct_spec) summary(lettuce.crs5) #> #> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.25) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 0.488440 0.133643 3.6548 0.004427 ** #> d:(Intercept) 0.973666 0.086883 11.2066 5.544e-07 *** #> e:(Intercept) 1.314657 3.614266 0.3637 0.723624 #> f:(Intercept) 2.998547 3.626210 0.8269 0.427579 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.123575 (10 degrees of freedom) ED(lettuce.crs5, c(50)) #> #> Estimated effective doses #> #> Estimate Std. Error #> e:50 37.033 15.437"},{"path":"https://hreinwald.github.io/drc/reference/CRS.5.html","id":null,"dir":"Reference","previous_headings":"","what":"Wrapper for 5-parameter Cedergreen-Ritz-Streibig Model — CRS.5","title":"Wrapper for 5-parameter Cedergreen-Ritz-Streibig Model — CRS.5","text":"convenience wrapper drc::cedergreen function, preset 5-parameter model. provides flexible handling alpha parameter.","code":""},{"path":"https://hreinwald.github.io/drc/reference/CRS.5.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Wrapper for 5-parameter Cedergreen-Ritz-Streibig Model — CRS.5","text":"","code":"CRS.5( names = c(\"b\", \"c\", \"d\", \"e\", \"f\"), fixed = c(NA, NA, NA, NA, NA), alpha_type = \"a\", fctName = NULL, fctText = NULL, ... )"},{"path":"https://hreinwald.github.io/drc/reference/CRS.5.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Wrapper for 5-parameter Cedergreen-Ritz-Streibig Model — CRS.5","text":"names character vector length 5 specifying names model parameters. Default c(\"b\", \"c\", \"d\", \"e\", \"f\"). fixed numeric vector length 5. Use NA parameters estimated numeric value parameters fixed. Default NA. alpha_type character numeric value. Can one '' (alpha=1), 'b' (alpha=0.5), 'c' (alpha=0.25), specific numeric value alpha. fctName optional character string name model function. NULL (default), name generated automatically. fctText optional character string describing model. NULL (default), description generated automatically. ... Additional arguments passed drc::cedergreen, data.","code":""},{"path":"https://hreinwald.github.io/drc/reference/CRS.5.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Wrapper for 5-parameter Cedergreen-Ritz-Streibig Model — CRS.5","text":"drc model object class cedergreen. underlying drc::cedergreen call fails, issues warning returns NULL.","code":""},{"path":"https://hreinwald.github.io/drc/reference/CRS.5.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Wrapper for 5-parameter Cedergreen-Ritz-Streibig Model — CRS.5","text":"function simplifies creation 5-parameter Cedergreen-Ritz-Streibig model setting sensible defaults parameter names. allows alpha parameter specified either predefined character shortcut ('', 'b', 'c') direct numeric value. default function runs alpha=1, corresponds CRS.4a model. Setting alpha=0.5 corresponds CRS.4b model, alpha=0.25 corresponds CRS.4c model. default, parameters set estimated (.e., fixed NA), users can specify parameters held constant estimation. self-starter function automatically generated based specified method fixed parameters, ensuring initial values appropriately calculated model fitting process. function automatically generates model name (fctName) description (fctText) unless explicitly provided user.","code":""},{"path":"https://hreinwald.github.io/drc/reference/CRS.5.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Wrapper for 5-parameter Cedergreen-Ritz-Streibig Model — CRS.5","text":"Hannes Reinwald","code":""},{"path":"https://hreinwald.github.io/drc/reference/CRS.5.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Wrapper for 5-parameter Cedergreen-Ritz-Streibig Model — CRS.5","text":"","code":"# Create a CRS.5 model specification crs_model_a <- CRS.5() # Fix the lower limit to 0 and use a custom numeric alpha crs_model_custom <- CRS.5( fixed = c(NA, 0, NA, NA, NA), alpha_type = 0.75 )"},{"path":"https://hreinwald.github.io/drc/reference/CRS.5a.html","id":null,"dir":"Reference","previous_headings":"","what":"Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 1 (Deprecated) — CRS.5a","title":"Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 1 (Deprecated) — CRS.5a","text":"function deprecated version 3.3.0. Please use CRS.5() instead, provides general flexible interface. five-parameter Cedergreen-Ritz-Streibig (CRS) hormesis model alpha parameter controlling steepness hormetic component fixed 1. five parameters b, c, d, e, f freely estimated.","code":""},{"path":"https://hreinwald.github.io/drc/reference/CRS.5a.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 1 (Deprecated) — CRS.5a","text":"","code":"CRS.5a(names = c(\"b\", \"c\", \"d\", \"e\", \"f\"), fixed = c(NA, NA, NA, NA, NA), ...)"},{"path":"https://hreinwald.github.io/drc/reference/CRS.5a.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 1 (Deprecated) — CRS.5a","text":"names character vector length 5 specifying names model parameters following order: b Hill slope (steepness dose-response curve). c Lower asymptote (freely estimated). d Upper asymptote. e Effective dose producing response midway c d (ED50). f Hormesis parameter controlling magnitude stimulatory effect low doses. Defaults c(\"b\", \"c\", \"d\", \"e\", \"f\"). fixed numeric vector length 5 specifying fixed (non-estimated) parameter values. Use NA parameters estimated freely. Defaults c(NA, NA, NA, NA, NA), meaning five parameters freely estimated. ... Additional arguments passed cedergreen().","code":""},{"path":"https://hreinwald.github.io/drc/reference/CRS.5a.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 1 (Deprecated) — CRS.5a","text":"list class \"drcMean\" returned cedergreen(), containing model definition including mean function, gradient, parameter names, fixed values. object intended use fct argument drm().","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/CRS.5a.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 1 (Deprecated) — CRS.5a","text":"Christian Ritz, Hannes Reinwald","code":""},{"path":"https://hreinwald.github.io/drc/reference/CRS.5a.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 1 (Deprecated) — CRS.5a","text":"","code":"# NOTE: CRS.5a() is deprecated. Use CRS.5() instead. # The example below is retained for backward compatibility illustration only. lettuce.m1 <- drm( lettuce[, c(2, 1)], fct = CRS.5a() ) summary(lettuce.m1) #> #> Model fitted: Cedergreen-Ritz-Streibig (alpha=1) (5 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 1.334173 0.358675 3.7197 0.004773 ** #> c:(Intercept) 0.447962 0.080700 5.5510 0.000356 *** #> d:(Intercept) 1.035658 0.077323 13.3940 3.004e-07 *** #> e:(Intercept) 1.337869 1.185153 1.1289 0.288148 #> f:(Intercept) 1.993259 2.017541 0.9880 0.348985 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.1305067 (9 degrees of freedom) ED(lettuce.m1, c(50)) #> #> Estimated effective doses #> #> Estimate Std. Error #> e:50 5.5439 1.9480 # Recommended replacement: lettuce.crs5 <- drm( lettuce[, c(2, 1)], fct = CRS.5(alpha_type = \"a\") ) summary(lettuce.crs5) #> #> Model fitted: Cedergreen-Ritz-Streibig (alpha=1) (5 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 1.334173 0.358675 3.7197 0.004773 ** #> c:(Intercept) 0.447962 0.080700 5.5510 0.000356 *** #> d:(Intercept) 1.035658 0.077323 13.3940 3.004e-07 *** #> e:(Intercept) 1.337869 1.185153 1.1289 0.288148 #> f:(Intercept) 1.993259 2.017541 0.9880 0.348985 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.1305067 (9 degrees of freedom) ED(lettuce.crs5, c(50)) #> #> Estimated effective doses #> #> Estimate Std. Error #> e:50 5.5439 1.9480"},{"path":"https://hreinwald.github.io/drc/reference/CRS.5b.html","id":null,"dir":"Reference","previous_headings":"","what":"Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 0.5 (Deprecated) — CRS.5b","title":"Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 0.5 (Deprecated) — CRS.5b","text":"function deprecated version 3.3.0. Please use CRS.5() instead, provides general flexible interface. five-parameter Cedergreen-Ritz-Streibig (CRS) hormesis model alpha parameter controlling steepness hormetic component fixed 0.5. five parameters b, c, d, e, f freely estimated.","code":""},{"path":"https://hreinwald.github.io/drc/reference/CRS.5b.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 0.5 (Deprecated) — CRS.5b","text":"","code":"CRS.5b(names = c(\"b\", \"c\", \"d\", \"e\", \"f\"), fixed = c(NA, NA, NA, NA, NA), ...)"},{"path":"https://hreinwald.github.io/drc/reference/CRS.5b.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 0.5 (Deprecated) — CRS.5b","text":"names character vector length 5 specifying names model parameters following order: b Hill slope (steepness dose-response curve). c Lower asymptote (freely estimated). d Upper asymptote. e Effective dose producing response midway c d (ED50). f Hormesis parameter controlling magnitude stimulatory effect low doses. Defaults c(\"b\", \"c\", \"d\", \"e\", \"f\"). fixed numeric vector length 5 specifying fixed (non-estimated) parameter values. Use NA parameters estimated freely. Defaults c(NA, NA, NA, NA, NA), meaning five parameters freely estimated. ... Additional arguments passed cedergreen().","code":""},{"path":"https://hreinwald.github.io/drc/reference/CRS.5b.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 0.5 (Deprecated) — CRS.5b","text":"list class \"drcMean\" returned cedergreen(), containing model definition including mean function, gradient, parameter names, fixed values. object intended use fct argument drm().","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/CRS.5b.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 0.5 (Deprecated) — CRS.5b","text":"Christian Ritz, Hannes Reinwald","code":""},{"path":"https://hreinwald.github.io/drc/reference/CRS.5b.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 0.5 (Deprecated) — CRS.5b","text":"","code":"# NOTE: CRS.5b() is deprecated. Use CRS.5() instead. # The example below is retained for backward compatibility illustration only. lettuce.m2 <- drm( lettuce[, c(2, 1)], fct = CRS.5b() ) summary(lettuce.m2) #> #> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.5) (5 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 0.806096 0.537800 1.4989 0.1681 #> c:(Intercept) 0.316586 0.199024 1.5907 0.1461 #> d:(Intercept) 0.971581 0.081936 11.8577 8.523e-07 *** #> e:(Intercept) 0.814111 2.969068 0.2742 0.7901 #> f:(Intercept) 3.288976 8.216399 0.4003 0.6983 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.1167711 (9 degrees of freedom) ED(lettuce.m2, c(50)) #> #> Estimated effective doses #> #> Estimate Std. Error #> e:50 11.550 8.603 # Recommended replacement: lettuce.crs5 <- drm( lettuce[, c(2, 1)], fct = CRS.5(alpha_type = \"b\") ) summary(lettuce.crs5) #> #> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.5) (5 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 0.806096 0.537800 1.4989 0.1681 #> c:(Intercept) 0.316586 0.199024 1.5907 0.1461 #> d:(Intercept) 0.971581 0.081936 11.8577 8.523e-07 *** #> e:(Intercept) 0.814111 2.969068 0.2742 0.7901 #> f:(Intercept) 3.288976 8.216399 0.4003 0.6983 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.1167711 (9 degrees of freedom) ED(lettuce.crs5, c(50)) #> #> Estimated effective doses #> #> Estimate Std. Error #> e:50 11.550 8.603"},{"path":"https://hreinwald.github.io/drc/reference/CRS.5c.html","id":null,"dir":"Reference","previous_headings":"","what":"Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 0.25 (Deprecated) — CRS.5c","title":"Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 0.25 (Deprecated) — CRS.5c","text":"function deprecated version 3.3.0. Please use CRS.5() instead, provides general flexible interface. five-parameter Cedergreen-Ritz-Streibig (CRS) hormesis model alpha parameter controlling steepness hormetic component fixed 0.25. five parameters b, c, d, e, f freely estimated.","code":""},{"path":"https://hreinwald.github.io/drc/reference/CRS.5c.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 0.25 (Deprecated) — CRS.5c","text":"","code":"CRS.5c(names = c(\"b\", \"c\", \"d\", \"e\", \"f\"), fixed = c(NA, NA, NA, NA, NA), ...)"},{"path":"https://hreinwald.github.io/drc/reference/CRS.5c.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 0.25 (Deprecated) — CRS.5c","text":"names character vector length 5 specifying names model parameters following order: b Hill slope (steepness dose-response curve). c Lower asymptote (freely estimated). d Upper asymptote. e Effective dose producing response midway c d (ED50). f Hormesis parameter controlling magnitude stimulatory effect low doses. Defaults c(\"b\", \"c\", \"d\", \"e\", \"f\"). fixed numeric vector length 5 specifying fixed (non-estimated) parameter values. Use NA parameters estimated freely. Defaults c(NA, NA, NA, NA, NA), meaning five parameters freely estimated. ... Additional arguments passed cedergreen().","code":""},{"path":"https://hreinwald.github.io/drc/reference/CRS.5c.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 0.25 (Deprecated) — CRS.5c","text":"list class \"drcMean\" returned cedergreen(), containing model definition including mean function, gradient, parameter names, fixed values. object intended use fct argument drm().","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/CRS.5c.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 0.25 (Deprecated) — CRS.5c","text":"Christian Ritz, Hannes Reinwald","code":""},{"path":"https://hreinwald.github.io/drc/reference/CRS.5c.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 0.25 (Deprecated) — CRS.5c","text":"","code":"# NOTE: CRS.5c() is deprecated. Use CRS.5() instead. # The example below is retained for backward compatibility illustration only. lettuce.m3 <- drm( lettuce[, c(2, 1)], fct = CRS.5c() ) summary(lettuce.m3) #> #> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.25) (5 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 0.981945 0.559334 1.7556 0.11305 #> c:(Intercept) 0.336670 0.182883 1.8409 0.09877 . #> d:(Intercept) 0.969845 0.088261 10.9883 1.624e-06 *** #> e:(Intercept) 3.883893 2.462313 1.5773 0.14917 #> f:(Intercept) 1.027934 0.766823 1.3405 0.21293 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.1256841 (9 degrees of freedom) ED(lettuce.m3, c(50)) #> #> Estimated effective doses #> #> Estimate Std. Error #> e:50 11.4243 8.7214 # Recommended replacement: lettuce.crs5 <- drm( lettuce[, c(2, 1)], fct = CRS.5(alpha_type = \"c\") ) summary(lettuce.crs5) #> #> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.25) (5 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 0.981945 0.559334 1.7556 0.11305 #> c:(Intercept) 0.336670 0.182883 1.8409 0.09877 . #> d:(Intercept) 0.969845 0.088261 10.9883 1.624e-06 *** #> e:(Intercept) 3.883893 2.462313 1.5773 0.14917 #> f:(Intercept) 1.027934 0.766823 1.3405 0.21293 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.1256841 (9 degrees of freedom) ED(lettuce.crs5, c(50)) #> #> Estimated effective doses #> #> Estimate Std. Error #> e:50 11.4243 8.7214"},{"path":"https://hreinwald.github.io/drc/reference/CRS.6.html","id":null,"dir":"Reference","previous_headings":"","what":"Generalised Cedergreen-Ritz-Streibig Model for Hormesis — CRS.6","title":"Generalised Cedergreen-Ritz-Streibig Model for Hormesis — CRS.6","text":"six-parameter extension Cedergreen-Ritz-Streibig model describing hormesis, alpha parameter estimated rather fixed.","code":""},{"path":"https://hreinwald.github.io/drc/reference/CRS.6.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Generalised Cedergreen-Ritz-Streibig Model for Hormesis — CRS.6","text":"","code":"CRS.6( fixed = c(NA, NA, NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\", \"f\", \"g\"), method = c(\"1\", \"2\", \"3\", \"4\"), ssfct = NULL )"},{"path":"https://hreinwald.github.io/drc/reference/CRS.6.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Generalised Cedergreen-Ritz-Streibig Model for Hormesis — CRS.6","text":"fixed numeric vector. Specifies parameters fixed value fixed. NAs parameters fixed. names vector character strings giving names parameters (contain \":\"). method character string indicating self starter function use. ssfct self starter function used (optional).","code":""},{"path":"https://hreinwald.github.io/drc/reference/CRS.6.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Generalised Cedergreen-Ritz-Streibig Model for Hormesis — CRS.6","text":"list containing nonlinear model function, self starter function, parameter names.","code":""},{"path":"https://hreinwald.github.io/drc/reference/CRS.6.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Generalised Cedergreen-Ritz-Streibig Model for Hormesis — CRS.6","text":"model function : $$f(x) = c + \\frac{d-c+f \\exp(-1/x^g)}{1+\\exp(b(\\log(x)-\\log(e)))}$$ generalises five-parameter CRS.5a model estimating alpha exponent (parameter \\(g\\)) instead fixing .","code":""},{"path":"https://hreinwald.github.io/drc/reference/CRS.6.html","id":"note","dir":"Reference","previous_headings":"","what":"Note","title":"Generalised Cedergreen-Ritz-Streibig Model for Hormesis — CRS.6","text":"function use drm.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/CRS.6.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Generalised Cedergreen-Ritz-Streibig Model for Hormesis — CRS.6","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/ctb.html","id":null,"dir":"Reference","previous_headings":"","what":"CellTiter-Blue Cell Viability Assay Data — ctb","title":"CellTiter-Blue Cell Viability Assay Data — ctb","text":"Neurotoxicity test using CellTiter-Blue Cell Viability Assay SH-SY5Y cells increasing concentrations acrylamide.","code":""},{"path":"https://hreinwald.github.io/drc/reference/ctb.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"CellTiter-Blue Cell Viability Assay Data — ctb","text":"","code":"data(ctb)"},{"path":"https://hreinwald.github.io/drc/reference/ctb.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"CellTiter-Blue Cell Viability Assay Data — ctb","text":"data frame 647 observations following 5 variables. well well ID 96 well plate conc 12 concentrations acrylamide, ranging 0-500mM fluorescence measured fluorescence adding resazurin reagent wells day integer denoting 3 different days plate factor 7 levels representing plate ID","code":""},{"path":"https://hreinwald.github.io/drc/reference/ctb.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"CellTiter-Blue Cell Viability Assay Data — ctb","text":"Frimat, JP, Sisnaiske, J, Subbiah, S, Menne, H, Godoy, P, Lampen, P, Leist, M, Franzke, J, Hengstler, JG, van Thriel, C, West, J. network formation assay: spatially standardized neurite outgrowth analytical display neurotoxicity screening. Lab Chip 2010; 10:701-709.","code":""},{"path":"https://hreinwald.github.io/drc/reference/ctb.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"CellTiter-Blue Cell Viability Assay Data — ctb","text":"","code":"data(ctb) ctb$day <- as.factor(ctb$day) ## Fit a four-parameter log-logistic model ctb.m1 <- drm(fluorescence ~ conc, data = ctb, fct = LL.4()) summary(ctb.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 1.38280 0.18094 7.6423 7.777e-14 *** #> c:(Intercept) -5.87847 62.69971 -0.0938 0.9253 #> d:(Intercept) 2018.73268 36.19882 55.7679 < 2.2e-16 *** #> e:(Intercept) 5.40830 0.65619 8.2420 9.203e-16 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 625.4192 (643 degrees of freedom) plot(ctb.m1, main = \"CTB dose-response\")"},{"path":"https://hreinwald.github.io/drc/reference/Cyp17.html","id":null,"dir":"Reference","previous_headings":"","what":"Cyp17 expression data — Cyp17","title":"Cyp17 expression data — Cyp17","text":"Observed Cyp17 gene expression measured several dose levels across multiple experimental runs. CYP17 key enzyme steroid hormone biosynthesis, changes expression can indicate endocrine-disrupting effects.","code":""},{"path":"https://hreinwald.github.io/drc/reference/Cyp17.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Cyp17 expression data — Cyp17","text":"","code":"data(Cyp17)"},{"path":"https://hreinwald.github.io/drc/reference/Cyp17.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Cyp17 expression data — Cyp17","text":"data frame 63 observations following 3 variables. run ID 3 different runs dose 5 dose levels (0, 0.1, 10, 100, 500) expression observed expression","code":""},{"path":"https://hreinwald.github.io/drc/reference/Cyp17.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Cyp17 expression data — Cyp17","text":"","code":"data(Cyp17) ## Display the structure of the data head(Cyp17) #> run dose expression #> 1 1 500 0.04934222 #> 2 1 500 0.05863851 #> 3 1 500 0.07518652 #> 4 1 100 0.05492933 #> 5 1 100 0.03329362 #> 6 1 100 0.01662889 ## Log-transform the expression values Cyp17$logexpression <- log(Cyp17$expression) + 5 ## Fit a four-parameter log-logistic model (ignoring run effects) Cyp17.m1 <- drm(logexpression ~ dose, data = Cyp17, fct = LL.4()) summary(Cyp17.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) -0.57006 0.50017 -1.1397 0.25901 #> c:(Intercept) 1.07498 0.10396 10.3403 7.168e-15 *** #> d:(Intercept) 2.30249 1.35392 1.7006 0.09428 . #> e:(Intercept) 332.97197 1269.60417 0.2623 0.79403 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.5299562 (59 degrees of freedom) plot(Cyp17.m1, main = \"Cyp17 dose-response\")"},{"path":"https://hreinwald.github.io/drc/reference/Daphnia.html","id":null,"dir":"Reference","previous_headings":"","what":"Daphnia — Daphnia","title":"Daphnia — Daphnia","text":"Data binary mixture experiment based fixed-ratio design involving 5 rays: 2 rays pesticides prochloraz alpha-cypermethrin 3 mixture rays corresponding virtual mixture proportions 25:75, 50:50, 75:25.","code":""},{"path":"https://hreinwald.github.io/drc/reference/Daphnia.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Daphnia — Daphnia","text":"","code":"data(Daphnia)"},{"path":"https://hreinwald.github.io/drc/reference/Daphnia.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Daphnia — Daphnia","text":"data frame 140 observations following 6 variables. dose.Dose alpha-cypermethrin (mu g/L) dose.p Dose prochloraz (mu g/L) dose Total dose mixture (mu g/L) mix.frac Mixture fraction total Total number Daphnia immob48 Number immobile Daphnia 48 hours","code":""},{"path":"https://hreinwald.github.io/drc/reference/Daphnia.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Daphnia — Daphnia","text":"Synergistic antagonistic effects binary mixtures number fungicides pyrethroid insecticide alpha-cypermethrin investigated using standard test system. data specific binary mixture prochloraz alpha-cypermethrin provided. Data obtained Daphnia acute immobilisation test test organisms divided groups five, placed containers, exposed dose (either mixture dose dose one two pesticides), followed 48h.","code":""},{"path":"https://hreinwald.github.io/drc/reference/Daphnia.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Daphnia — Daphnia","text":"Data kindly provided N. Cedergreen.","code":""},{"path":"https://hreinwald.github.io/drc/reference/Daphnia.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Daphnia — Daphnia","text":"Noergaard KB Cedergreen N, Pesticide cocktails can interact synergistically aquatic crustaceans. Environ Sci Pollut Res 17: 957-967 (2010). https://doi.org/10.1007/s11356-009-0284-4","code":""},{"path":"https://hreinwald.github.io/drc/reference/Daphnia.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Daphnia — Daphnia","text":"","code":"library(drc) ## Displaying the data head(Daphnia) #> dose.a dose.p dose mix.frac total immob48 #> 1 1.50 0 1.50 0 5 5 #> 2 1.50 0 1.50 0 5 5 #> 3 1.50 0 1.50 0 5 4 #> 4 1.50 0 1.50 0 5 5 #> 5 0.75 0 0.75 0 5 5 #> 6 0.75 0 0.75 0 5 5 ## Fitting a two-parameter log-logistic model for binomial response ## using mix.frac to model each mixture ray individually Daphnia.m1 <- drm(immob48/total ~ dose, mix.frac, weights = total, data = Daphnia, fct = LL.2(), type = \"binomial\") summary(Daphnia.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:0 -2.08226 0.35213 -5.9134 3.351e-09 *** #> b:0.75 -7.47956 1.79255 -4.1726 3.012e-05 *** #> b:0.5 -3.22760 0.60334 -5.3495 8.818e-08 *** #> b:0.25 -3.00588 0.57382 -5.2384 1.620e-07 *** #> b:1 -3.61417 0.72249 -5.0024 5.662e-07 *** #> e:0 0.29705 0.03489 8.5139 < 2.2e-16 *** #> e:0.75 98.81146 8.13182 12.1512 < 2.2e-16 *** #> e:0.5 123.96886 12.82359 9.6672 < 2.2e-16 *** #> e:0.25 280.08032 30.42243 9.2064 < 2.2e-16 *** #> e:1 4941.86142 477.42984 10.3510 < 2.2e-16 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## Plotting the fitted curves for each mixture fraction plot(Daphnia.m1, xlab = \"Total dose (mu g/L)\", ylab = \"Proportion immobile\", ylim = c(0, 1), legendPos = c(3, 0.9))"},{"path":"https://hreinwald.github.io/drc/reference/daphnids.html","id":null,"dir":"Reference","previous_headings":"","what":"Daphnia test — daphnids","title":"Daphnia test — daphnids","text":"number immobile daphnids –contrast mobile daphnids– total 20 daphnids counted several concentrations toxic substance.","code":""},{"path":"https://hreinwald.github.io/drc/reference/daphnids.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Daphnia test — daphnids","text":"","code":"data(daphnids)"},{"path":"https://hreinwald.github.io/drc/reference/daphnids.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Daphnia test — daphnids","text":"data frame 16 observations following 4 variables. dose numeric vector numeric vector total numeric vector time factor levels 24h 48h","code":""},{"path":"https://hreinwald.github.io/drc/reference/daphnids.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Daphnia test — daphnids","text":"daphnids counted 24h later 48h.","code":""},{"path":"https://hreinwald.github.io/drc/reference/daphnids.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Daphnia test — daphnids","text":"Nina Cedergreen, Faculty Life Sciences, University Copenhagen, Denmark.","code":""},{"path":"https://hreinwald.github.io/drc/reference/daphnids.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Daphnia test — daphnids","text":"","code":"library(drc) ## Fitting a model with different parameters ## for different curves daphnids.m1 <- drm( data = daphnids, no/total~dose, curveid = time, weights = total, fct = LL.2(), type = \"binomial\" ) ## plot models plot(daphnids.m1, ylim = c(0, 1), xlab = \"Dose (µg/L)\", ylab = \"Proportion of daphnids affected\", main = \"Model with different parameters for different curves\") ## Goodness-of-fit test modelFit(daphnids.m1) #> Goodness-of-fit test #> #> Df Chisq value p value #> #> DRC model 12 13.873 0.3089 ## Summary of the data summary(daphnids.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:24h -1.17384 0.22236 -5.2791 1.298e-07 *** #> b:48h -1.84968 0.27922 -6.6244 3.488e-11 *** #> e:24h 5134.03344 1056.74197 4.8584 1.184e-06 *** #> e:48h 1509.06539 187.76008 8.0372 9.037e-16 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## Fitting a model with a common intercept parameter daphnids.m2 <- drm(no/total~dose, curveid = time, weights = total, data = daphnids, fct = LL.2(), type = \"binomial\", pmodels = list(~1, ~time)) ## plot models plot(daphnids.m2, ylim = c(0, 1), xlab = \"Dose (µg/L)\", ylab = \"Proportion of daphnids affected\", main = \"Models with common intercept parameter\") ## Goodness-of-fit test modelFit(daphnids.m2) #> Goodness-of-fit test #> #> Df Chisq value p value #> #> DRC model 13 17.63 0.1721 ## Summary of the data summary(daphnids.m2) #> #> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) -1.49926 0.17345 -8.6436 < 2.2e-16 *** #> e:(Intercept) 4614.39264 708.09425 6.5166 7.190e-11 *** #> e:time48h -3122.47346 741.26254 -4.2124 2.527e-05 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1"},{"path":"https://hreinwald.github.io/drc/reference/decontaminants.html","id":null,"dir":"Reference","previous_headings":"","what":"Performance of decontaminants used in the culturing of a micro-organism — decontaminants","title":"Performance of decontaminants used in the culturing of a micro-organism — decontaminants","text":"two decontaminants 1-hexadecylpyridium chloride oxalic acid used. Additionally control group (coded concentration 0 included oxalic acid).","code":""},{"path":"https://hreinwald.github.io/drc/reference/decontaminants.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Performance of decontaminants used in the culturing of a micro-organism — decontaminants","text":"","code":"data(\"decontaminants\")"},{"path":"https://hreinwald.github.io/drc/reference/decontaminants.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Performance of decontaminants used in the culturing of a micro-organism — decontaminants","text":"data frame 128 observations following 3 variables. conc numeric vector percentage weight per volume count numeric vector numbers M. bovis colonies stationarity group factor levels hpc oxalic decontaminants used","code":""},{"path":"https://hreinwald.github.io/drc/reference/decontaminants.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Performance of decontaminants used in the culturing of a micro-organism — decontaminants","text":"data examplify Wadley's problem: counts maximum number known. data analyzed Trajstman (1989) using three-parameter logistic model re-analyzed Morgan Smith (1992) using three-parameter Weibull type II model. cases authors adjusted overdispersion (different ways). seems Morgan Smith (1992) fitted separate models two decontaminants using control group model fits. example joint model fitted control group used determine shared upper limit concentration 0.","code":""},{"path":"https://hreinwald.github.io/drc/reference/decontaminants.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Performance of decontaminants used in the culturing of a micro-organism — decontaminants","text":"Trajstman, . C. (1989) Indices Comparing Decontaminants Data Come Dose-Response Survival Contamination Experiments, Applied Statistics, 38, 481–494.","code":""},{"path":"https://hreinwald.github.io/drc/reference/decontaminants.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Performance of decontaminants used in the culturing of a micro-organism — decontaminants","text":"Morgan, B. J. T. Smith, D. M. (1992) Note Wadley's Problem Overdispersion, Applied Statistics, 41, 349–354.","code":""},{"path":"https://hreinwald.github.io/drc/reference/decontaminants.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Performance of decontaminants used in the culturing of a micro-organism — decontaminants","text":"","code":"library(drc) ## Wadley's problem using a three-parameter log-logistic model decon.LL.3.1 <- drm(count~conc, group, data = decontaminants, fct = LL.3(), type = \"Poisson\", pmodels = list(~group, ~1, ~group)) summary(decon.LL.3.1) #> #> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 1.271354 0.085497 14.8701 < 2.2e-16 *** #> b:groupoxalic -0.749995 0.096745 -7.7523 9.065e-15 *** #> d:(Intercept) 48.949356 1.162320 42.1135 < 2.2e-16 *** #> e:(Intercept) 0.161718 0.011732 13.7844 < 2.2e-16 *** #> e:groupoxalic 0.346414 0.109110 3.1749 0.001499 ** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 plot(decon.LL.3.1) ## Same model fit in another parameterization (no intercepts) decon.LL.3.2 <- drm(count~conc, group, data = decontaminants, fct=LL.3(), type = \"Poisson\", pmodels = list(~group-1, ~1, ~group-1)) summary(decon.LL.3.2) #> #> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:grouphpc 1.271766 0.085523 14.8705 < 2.2e-16 *** #> b:groupoxalic 0.521354 0.059869 8.7083 < 2.2e-16 *** #> d:(Intercept) 48.953173 1.162656 42.1046 < 2.2e-16 *** #> e:grouphpc 0.161766 0.011737 13.7825 < 2.2e-16 *** #> e:groupoxalic 0.507902 0.113149 4.4888 7.162e-06 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1"},{"path":"https://hreinwald.github.io/drc/reference/deguelin.html","id":null,"dir":"Reference","previous_headings":"","what":"Deguelin applied to chrysanthemum aphis — deguelin","title":"Deguelin applied to chrysanthemum aphis — deguelin","text":"Quantal assay data experiment insectide deguelin applied Macrosiphoniella sanborni.","code":""},{"path":"https://hreinwald.github.io/drc/reference/deguelin.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Deguelin applied to chrysanthemum aphis — deguelin","text":"","code":"data(deguelin)"},{"path":"https://hreinwald.github.io/drc/reference/deguelin.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Deguelin applied to chrysanthemum aphis — deguelin","text":"data frame 6 observations following 4 variables. dose numeric vector doses applied log10dose numeric vector logarithm-transformed doses r numeric vector contained number dead insects n numeric vector contained total number insects","code":""},{"path":"https://hreinwald.github.io/drc/reference/deguelin.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Deguelin applied to chrysanthemum aphis — deguelin","text":"log-logistic model provides inadequate fit. dataset used Nottingham Birch (2000) illustrate semiparametric approach dose-response modelling.","code":""},{"path":"https://hreinwald.github.io/drc/reference/deguelin.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Deguelin applied to chrysanthemum aphis — deguelin","text":"Morgan, B. J. T. (1992) Analysis Quantal Response Data, London: Chapman & Hall/CRC (Table 3.9, p. 117).","code":""},{"path":"https://hreinwald.github.io/drc/reference/deguelin.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Deguelin applied to chrysanthemum aphis — deguelin","text":"Notttingham, Q. J. Birch, J. B. (2000) semiparametric approach analysing dose-response data, Statist. Med., 19, 389–404.","code":""},{"path":"https://hreinwald.github.io/drc/reference/deguelin.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Deguelin applied to chrysanthemum aphis — deguelin","text":"","code":"library(drc) ## Log-logistic fit deguelin.m1 <- drm(r/n~dose, weights=n, data=deguelin, fct=LL.2(), type=\"binomial\") modelFit(deguelin.m1) #> Goodness-of-fit test #> #> Df Chisq value p value #> #> DRC model 4 13.375 0.0096 summary(deguelin.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) -1.93709 0.22390 -8.6514 < 2.2e-16 *** #> e:(Intercept) 9.95219 0.92186 10.7958 < 2.2e-16 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## Loess fit deguelin.m2 <- loess(r/n~dose, data=deguelin, degree=1) ## Plot of data with fits superimposed plot(deguelin.m1, ylim=c(0.2,1)) lines(1:60, predict(deguelin.m2, newdata=data.frame(dose=1:60)), col = 2, lty = 2) lines(1:60, 0.95*predict(deguelin.m2, newdata=data.frame(dose=1:60))+0.05*predict(deguelin.m1, newdata=data.frame(dose=1:60), se = FALSE), col = 3, lty=3)"},{"path":"https://hreinwald.github.io/drc/reference/divAtInf.html","id":null,"dir":"Reference","previous_headings":"","what":"Helper functions for x*log(x) calculations — divAtInf","title":"Helper functions for x*log(x) calculations — divAtInf","text":"Helper functions x*log(x) calculations","code":""},{"path":"https://hreinwald.github.io/drc/reference/divAtInf.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Helper functions for x*log(x) calculations — divAtInf","text":"","code":"divAtInf(x, y)"},{"path":"https://hreinwald.github.io/drc/reference/dot-onAttach.html","id":null,"dir":"Reference","previous_headings":"","what":"Package attach hook — .onAttach","title":"Package attach hook — .onAttach","text":"Package attach hook","code":""},{"path":"https://hreinwald.github.io/drc/reference/dot-onAttach.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Package attach hook — .onAttach","text":"","code":".onAttach(libname, pkgname)"},{"path":"https://hreinwald.github.io/drc/reference/drc-package.html","id":null,"dir":"Reference","previous_headings":"","what":"drc: Analysis of Dose-Response Data — drc-package","title":"drc: Analysis of Dose-Response Data — drc-package","text":"Analysis dose-response data made available suite flexible versatile model fitting -fitting functions.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/drc-package.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"drc: Analysis of Dose-Response Data — drc-package","text":"Maintainer: Hannes Reinwald hannes.reinwald@bayer.com Authors: Christian Ritz ritz@bioassay.dk Jens C. Streibig streibig@bioassay.dk","code":""},{"path":"https://hreinwald.github.io/drc/reference/drm.html","id":null,"dir":"Reference","previous_headings":"","what":"Fitting dose-response models — drm","title":"Fitting dose-response models — drm","text":"general model fitting function analysis various types dose-response data.","code":""},{"path":"https://hreinwald.github.io/drc/reference/drm.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Fitting dose-response models — drm","text":"","code":"drm( formula, curveid, pmodels, weights, data = NULL, subset, fct, type = c(\"continuous\", \"binomial\", \"Poisson\", \"negbin1\", \"negbin2\", \"event\", \"ssd\"), bcVal = NULL, bcAdd = 0, start, na.action = na.omit, robust = \"mean\", logDose = NULL, control = drmc(), lowerl = NULL, upperl = NULL, separate = FALSE, pshifts = NULL, varcov = NULL )"},{"path":"https://hreinwald.github.io/drc/reference/drm.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Fitting dose-response models — drm","text":"formula symbolic description model fit. Either form response ~ dose data frame response values first column dose values second column. curveid numeric vector factor containing grouping data. pmodels data frame many columns parameters non-linear function. list containing formula parameter nonlinear function. weights numeric vector containing weights. continuous/quantitative responses, inverse weights multiplied inside squared errors (weights unit response). binomial responses weights provide information total number binary observations used obtain response. data optional data frame containing variables model. subset optional vector specifying subset observations used fitting process. fct list three elements specifying non-linear function, accompanying self starter function, names parameters non-linear function , optionally, first second derivatives well information used calculation ED values. Use getMeanFunctions full list. type character string specifying distribution data. default \"continuous\", corresponding normal distribution. choices include \"binomial\", \"Poisson\", \"negbin1\", \"negbin2\", \"event\", \"ssd\". bcVal numeric value specifying lambda parameter used Box-Cox transformation. bcAdd numeric value specifying constant added sides prior Box-Cox transformation. default 0. start optional numeric vector containing starting values mean parameters model. Overrules self starter function. na.action function treating missing values (NAs). Default na.omit. robust character string specifying rho function robust estimation. Default non-robust least squares estimation (\"mean\"). Available robust methods : \"median\", \"lms\", \"lts\", \"trimmed\", \"winsor\", \"tukey\". logDose numeric value NULL. log dose values provided base logarithm specified (e.g., exp(1) natural logarithm, 10 base 10). control list arguments controlling constrained optimisation, maximum iterations, relative tolerance, warnings. See drmc. lowerl numeric vector lower limits parameters model (default corresponds minus infinity parameters). upperl numeric vector upper limits parameters model (default corresponds plus infinity parameters). separate logical value indicating whether curves fit separately (independent ). pshifts matrix constants added matrix parameters. Default shift parameters. varcov optional user-defined known variance-covariance matrix responses. Default identity matrix (NULL), corresponding independent response values common standard deviation estimated data.","code":""},{"path":"https://hreinwald.github.io/drc/reference/drm.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Fitting dose-response models — drm","text":"object (S3) class \"drc\".","code":""},{"path":"https://hreinwald.github.io/drc/reference/drm.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Fitting dose-response models — drm","text":"function relies optim minimisation negative log likelihood function. continuous response reduces least squares estimation. Response values assumed mutually independent unless varcov specified. robust estimation MAD (median absolute deviance) used estimate residual variance. Setting lowerl /upperl automatically invokes constrained optimisation. Control arguments may specified using drmc.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/drm.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Fitting dose-response models — drm","text":"Christian Ritz, Jens C. Streibig Hannes Reinwald","code":""},{"path":"https://hreinwald.github.io/drc/reference/drm.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Fitting dose-response models — drm","text":"","code":"## Fitting a four-parameter log-logistic model to the ryegrass data model <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) summary(model) #> #> Model fitted: Log-logistic (ED50 as parameter) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 2.98222 0.46506 6.4125 2.960e-06 *** #> c:(Intercept) 0.48141 0.21219 2.2688 0.03451 * #> d:(Intercept) 7.79296 0.18857 41.3272 < 2.2e-16 *** #> e:(Intercept) 3.05795 0.18573 16.4644 4.268e-13 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.5196256 (20 degrees of freedom)"},{"path":"https://hreinwald.github.io/drc/reference/drmc.html","id":null,"dir":"Reference","previous_headings":"","what":"Sets control arguments — drmc","title":"Sets control arguments — drmc","text":"Set control arguments control argument function drm.","code":""},{"path":"https://hreinwald.github.io/drc/reference/drmc.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Sets control arguments — drmc","text":"","code":"drmc( constr = FALSE, errorm = TRUE, maxIt = 500, method = \"BFGS\", noMessage = FALSE, relTol = 1e-10, rmNA = FALSE, useD = FALSE, trace = FALSE, otrace = FALSE, warnVal = -1, dscaleThres = 1e-15, rscaleThres = 1e-15, conCheck = TRUE )"},{"path":"https://hreinwald.github.io/drc/reference/drmc.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Sets control arguments — drmc","text":"constr logical. TRUE optimisation constrained, yielding non-negative parameters. errorm logical specifying whether failed convergence drm result error warning. maxIt numeric. maximum number iterations optimisation procedure. method character string. method used optimisation procedure. See optim available methods. noMessage logical, specifying whether messages displayed. relTol numeric. relative tolerance optimisation procedure. tighter tolerance (smaller value) improves cross-platform reproducibility results ensuring optimiser converges closer true optimum regardless platform-specific floating-point behaviour. Default 1e-10. rmNA logical. NAs removed sum squares used estimation? Default FALSE (removed). useD logical. TRUE derivatives used estimation (available). trace logical. TRUE trace optim displayed. otrace logical. TRUE error messages optimisation displayed. warnVal numeric. equal 0 warnings stored displayed end. See ‘warn’ options. default results suppression warnings. dscaleThres numeric value specifying threshold dose scaling. rscaleThres numeric value specifying threshold response scaling. conCheck logical, switching /handling control measurements.","code":""},{"path":"https://hreinwald.github.io/drc/reference/drmc.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Sets control arguments — drmc","text":"list components corresponding arguments.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/drmc.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Sets control arguments — drmc","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/drmc.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Sets control arguments — drmc","text":"","code":"## Displaying the default settings drmc() #> $constr #> [1] FALSE #> #> $errorm #> [1] TRUE #> #> $maxIt #> [1] 500 #> #> $method #> [1] \"BFGS\" #> #> $noMessage #> [1] FALSE #> #> $relTol #> [1] 1e-07 #> #> $rmNA #> [1] FALSE #> #> $useD #> [1] FALSE #> #> $trace #> [1] FALSE #> #> $otrace #> [1] FALSE #> #> $warnVal #> [1] -1 #> #> $dscaleThres #> [1] 1e-15 #> #> $rscaleThres #> [1] 1e-15 #> #> $conCheck #> [1] TRUE #> ## Using the 'method' argument model1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) model2 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4(), control = drmc(method = \"Nelder-Mead\"))"},{"path":"https://hreinwald.github.io/drc/reference/drmConvertParm.html","id":null,"dir":"Reference","previous_headings":"","what":"Convert parameter vectors to matrices — drmConvertParm","title":"Convert parameter vectors to matrices — drmConvertParm","text":"Convert parameter vectors matrices","code":""},{"path":"https://hreinwald.github.io/drc/reference/drmConvertParm.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Convert parameter vectors to matrices — drmConvertParm","text":"","code":"drmConvertParm(startVec, startMat, factor1, colList)"},{"path":"https://hreinwald.github.io/drc/reference/drmEMbinomial.html","id":null,"dir":"Reference","previous_headings":"","what":"EM algorithm for binomial response — drmEMbinomial","title":"EM algorithm for binomial response — drmEMbinomial","text":"EM algorithm binomial response","code":""},{"path":"https://hreinwald.github.io/drc/reference/drmEMbinomial.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"EM algorithm for binomial response — drmEMbinomial","text":"","code":"drmEMbinomial( dose, resp, multCurves, startVec, robustFct, weights, rmNA, zeroTol = 1e-12, doseScaling = 1, respScaling = 1 )"},{"path":"https://hreinwald.github.io/drc/reference/drmEMls.html","id":null,"dir":"Reference","previous_headings":"","what":"EM algorithm for least squares — drmEMls","title":"EM algorithm for least squares — drmEMls","text":"EM algorithm least squares","code":""},{"path":"https://hreinwald.github.io/drc/reference/drmEMls.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"EM algorithm for least squares — drmEMls","text":"","code":"drmEMls( dose, resp, multCurves, startVec, robustFct, weights, rmNA, dmf = NULL, doseScaling = 1, respScaling = 1, varcov = NULL )"},{"path":"https://hreinwald.github.io/drc/reference/drmLOFbinomial.html","id":null,"dir":"Reference","previous_headings":"","what":"Lack-of-fit test for binomial response — drmLOFbinomial","title":"Lack-of-fit test for binomial response — drmLOFbinomial","text":"Lack--fit test binomial response","code":""},{"path":"https://hreinwald.github.io/drc/reference/drmLOFbinomial.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Lack-of-fit test for binomial response — drmLOFbinomial","text":"","code":"drmLOFbinomial()"},{"path":"https://hreinwald.github.io/drc/reference/drmLOFeventtime.html","id":null,"dir":"Reference","previous_headings":"","what":"EM algorithm for event time data — drmLOFeventtime","title":"EM algorithm for event time data — drmLOFeventtime","text":"EM algorithm event time data","code":""},{"path":"https://hreinwald.github.io/drc/reference/drmLOFeventtime.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"EM algorithm for event time data — drmLOFeventtime","text":"","code":"drmLOFeventtime()"},{"path":"https://hreinwald.github.io/drc/reference/drmLOFls.html","id":null,"dir":"Reference","previous_headings":"","what":"Lack-of-fit test for least squares — drmLOFls","title":"Lack-of-fit test for least squares — drmLOFls","text":"Lack--fit test least squares","code":""},{"path":"https://hreinwald.github.io/drc/reference/drmLOFls.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Lack-of-fit test for least squares — drmLOFls","text":"","code":"drmLOFls()"},{"path":"https://hreinwald.github.io/drc/reference/drmLOFnegbin.html","id":null,"dir":"Reference","previous_headings":"","what":"EM algorithm for negative binomial — drmLOFnegbin","title":"EM algorithm for negative binomial — drmLOFnegbin","text":"EM algorithm negative binomial","code":""},{"path":"https://hreinwald.github.io/drc/reference/drmLOFnegbin.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"EM algorithm for negative binomial — drmLOFnegbin","text":"","code":"drmLOFnegbin()"},{"path":"https://hreinwald.github.io/drc/reference/drmLOFPoisson.html","id":null,"dir":"Reference","previous_headings":"","what":"EM algorithm for Poisson response — drmLOFPoisson","title":"EM algorithm for Poisson response — drmLOFPoisson","text":"EM algorithm Poisson response","code":""},{"path":"https://hreinwald.github.io/drc/reference/drmLOFPoisson.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"EM algorithm for Poisson response — drmLOFPoisson","text":"","code":"drmLOFPoisson()"},{"path":"https://hreinwald.github.io/drc/reference/drmLOFssd.html","id":null,"dir":"Reference","previous_headings":"","what":"EM algorithm for species sensitivity distribution — drmLOFssd","title":"EM algorithm for species sensitivity distribution — drmLOFssd","text":"EM algorithm species sensitivity distribution","code":""},{"path":"https://hreinwald.github.io/drc/reference/drmLOFssd.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"EM algorithm for species sensitivity distribution — drmLOFssd","text":"","code":"drmLOFssd()"},{"path":"https://hreinwald.github.io/drc/reference/drmLOFstandard.html","id":null,"dir":"Reference","previous_headings":"","what":"Standard EM algorithm — drmLOFstandard","title":"Standard EM algorithm — drmLOFstandard","text":"Standard EM algorithm","code":""},{"path":"https://hreinwald.github.io/drc/reference/drmLOFstandard.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Standard EM algorithm — drmLOFstandard","text":"","code":"drmLOFstandard()"},{"path":"https://hreinwald.github.io/drc/reference/drmOpt.html","id":null,"dir":"Reference","previous_headings":"","what":"Optimisation wrapper for drm — drmOpt","title":"Optimisation wrapper for drm — drmOpt","text":"Optimisation wrapper drm","code":""},{"path":"https://hreinwald.github.io/drc/reference/drmOpt.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Optimisation wrapper for drm — drmOpt","text":"","code":"drmOpt( opfct, opdfct1, startVec, optMethod, constrained, warnVal, upperLimits, lowerLimits, errorMessage, maxIt, relTol, opdfct2 = NULL, parmVec, traceVal, silentVal = TRUE, matchCall )"},{"path":"https://hreinwald.github.io/drc/reference/drmParNames.html","id":null,"dir":"Reference","previous_headings":"","what":"Generate parameter names for drm — drmParNames","title":"Generate parameter names for drm — drmParNames","text":"Generate parameter names drm","code":""},{"path":"https://hreinwald.github.io/drc/reference/drmParNames.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Generate parameter names for drm — drmParNames","text":"","code":"drmParNames( numNames, parNames, collapseList2, repStr1 = \"factor(pmodels[, i])\", repStr2 = \"factor(assayNo)\" )"},{"path":"https://hreinwald.github.io/drc/reference/drmPNsplit.html","id":null,"dir":"Reference","previous_headings":"","what":"Split parameter names — drmPNsplit","title":"Split parameter names — drmPNsplit","text":"Split parameter names","code":""},{"path":"https://hreinwald.github.io/drc/reference/drmPNsplit.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Split parameter names — drmPNsplit","text":"","code":"drmPNsplit(parmVec, sep)"},{"path":"https://hreinwald.github.io/drc/reference/drmRobust.html","id":null,"dir":"Reference","previous_headings":"","what":"Robust estimation functions for drm — drmRobust","title":"Robust estimation functions for drm — drmRobust","text":"Robust estimation functions drm","code":""},{"path":"https://hreinwald.github.io/drc/reference/drmRobust.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Robust estimation functions for drm — drmRobust","text":"","code":"drmRobust(robust, fctCall, lenData, lenPar)"},{"path":"https://hreinwald.github.io/drc/reference/drm_legacy.html","id":null,"dir":"Reference","previous_headings":"","what":"Legacy dose-response model fitting (internal) — drm_legacy","title":"Legacy dose-response model fitting (internal) — drm_legacy","text":"legacy implementation dose-response model fitting function. kept internal reference point case questions errors might occur current drm() implementation.","code":""},{"path":"https://hreinwald.github.io/drc/reference/drm_legacy.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Legacy dose-response model fitting (internal) — drm_legacy","text":"","code":"drm_legacy( formula, curveid, pmodels, weights, data = NULL, subset, fct, type = c(\"continuous\", \"binomial\", \"Poisson\", \"negbin1\", \"negbin2\", \"event\", \"ssd\"), bcVal = NULL, bcAdd = 0, start, na.action = na.omit, robust = \"mean\", logDose = NULL, control = drmc(), lowerl = NULL, upperl = NULL, separate = FALSE, pshifts = NULL, varcov = NULL )"},{"path":"https://hreinwald.github.io/drc/reference/drm_legacy.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Legacy dose-response model fitting (internal) — drm_legacy","text":"formula symbolic description model fit. Either form response ~ dose data frame response values first column dose values second column. curveid numeric vector factor containing grouping data. pmodels data frame many columns parameters non-linear function. list containing formula parameter nonlinear function. weights numeric vector containing weights. continuous/quantitative responses, inverse weights multiplied inside squared errors (weights unit response). binomial responses weights provide information total number binary observations used obtain response. data optional data frame containing variables model. subset optional vector specifying subset observations used fitting process. fct list three elements specifying non-linear function, accompanying self starter function, names parameters non-linear function , optionally, first second derivatives well information used calculation ED values. Use getMeanFunctions full list. type character string specifying distribution data. default \"continuous\", corresponding normal distribution. choices include \"binomial\", \"Poisson\", \"negbin1\", \"negbin2\", \"event\", \"ssd\". bcVal numeric value specifying lambda parameter used Box-Cox transformation. bcAdd numeric value specifying constant added sides prior Box-Cox transformation. default 0. start optional numeric vector containing starting values mean parameters model. Overrules self starter function. na.action function treating missing values (NAs). Default na.omit. robust character string specifying rho function robust estimation. Default non-robust least squares estimation (\"mean\"). Available robust methods : \"median\", \"lms\", \"lts\", \"trimmed\", \"winsor\", \"tukey\". logDose numeric value NULL. log dose values provided base logarithm specified (e.g., exp(1) natural logarithm, 10 base 10). control list arguments controlling constrained optimisation, maximum iterations, relative tolerance, warnings. See drmc. lowerl numeric vector lower limits parameters model (default corresponds minus infinity parameters). upperl numeric vector upper limits parameters model (default corresponds plus infinity parameters). separate logical value indicating whether curves fit separately (independent ). pshifts matrix constants added matrix parameters. Default shift parameters. varcov optional user-defined known variance-covariance matrix responses. Default identity matrix (NULL), corresponding independent response values common standard deviation estimated data.","code":""},{"path":"https://hreinwald.github.io/drc/reference/drm_legacy.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Legacy dose-response model fitting (internal) — drm_legacy","text":"object (S3) class \"drc\".","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/earthworms.html","id":null,"dir":"Reference","previous_headings":"","what":"Earthworm toxicity test — earthworms","title":"Earthworm toxicity test — earthworms","text":"dataset obtained toxicity test using earthworms, contains number earthworms remaining container contaminated toxic substance (disclosed) various doses; number earthworms migrating neighbouring uncontaminated container.","code":""},{"path":"https://hreinwald.github.io/drc/reference/earthworms.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Earthworm toxicity test — earthworms","text":"","code":"data(earthworms)"},{"path":"https://hreinwald.github.io/drc/reference/earthworms.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Earthworm toxicity test — earthworms","text":"data frame 35 observations following 3 variables. dose numeric vector dose values number numeric vector containing counts remaining earthworms container total numeric vector containing total number earthworms put containers","code":""},{"path":"https://hreinwald.github.io/drc/reference/earthworms.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Earthworm toxicity test — earthworms","text":"dose 0 around half earthworms expected two containers. Thus appropriate fit ordinary logistic regression log(dose) explanatory variable data implies upper limit 1 dose 0 fact model utilise observations dose 0 (see example section ).","code":""},{"path":"https://hreinwald.github.io/drc/reference/earthworms.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Earthworm toxicity test — earthworms","text":"dataset kindly provided Nina Cedergreen, Faculty Life Sciences, University Copenhagen, Denmark.","code":""},{"path":"https://hreinwald.github.io/drc/reference/earthworms.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Earthworm toxicity test — earthworms","text":"","code":"library(drc) ## Fitting a logistic regression model earthworms.m1 <- drm(number/total~dose, weights = total, data = earthworms, fct = LL.2(), type = \"binomial\") modelFit(earthworms.m1) # a crude goodness-of-fit test #> Goodness-of-fit test #> #> Df Chisq value p value #> #> DRC model 28 35.236 0.1631 ## Fitting an extended logistic regression model ## where the upper limit is estimated earthworms.m2 <- drm(number/total~dose, weights = total, data = earthworms, fct = LL.3(), type = \"binomial\") modelFit(earthworms.m2) # goodness-of-fit test #> Goodness-of-fit test #> #> Df Chisq value p value #> #> DRC model 32 43.13 0.0905 # improvement not visible in test!!! ## Comparing model1 and model2 ## (Can the first model be reduced to the second model?) anova(earthworms.m1, earthworms.m2) #> #> 1st model #> fct: LL.2() #> 2nd model #> fct: LL.3() #> #> ANOVA-like table #> #> ModelDf Loglik Df LR value p value #> 1st model 2 -347.55 #> 2nd model 3 -36.16 1 622.79 0"},{"path":"https://hreinwald.github.io/drc/reference/echovirus.html","id":null,"dir":"Reference","previous_headings":"","what":"Infections as response to exposure with Echovirus 12 — echovirus","title":"Infections as response to exposure with Echovirus 12 — echovirus","text":"four doses pathogen, Echovirus 12, number exposed infected human volunteers reported.","code":""},{"path":"https://hreinwald.github.io/drc/reference/echovirus.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Infections as response to exposure with Echovirus 12 — echovirus","text":"","code":"data(echovirus)"},{"path":"https://hreinwald.github.io/drc/reference/echovirus.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Infections as response to exposure with Echovirus 12 — echovirus","text":"data frame 4 observations following 3 variables. dose numeric vector reporting dose plague forming units (pfu) total numeric vector infected numeric vector","code":""},{"path":"https://hreinwald.github.io/drc/reference/echovirus.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Infections as response to exposure with Echovirus 12 — echovirus","text":"H. Moon, S. B. Kim, J. J. Chen, N. . George, R. L. Kodell (2013). Model uncertainty model averaging estimation infectious doses microbial pathogens. Risk Analysis, 33(2):220-231.","code":""},{"path":"https://hreinwald.github.io/drc/reference/echovirus.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Infections as response to exposure with Echovirus 12 — echovirus","text":"","code":"library(drc) ## Displaying the data head(echovirus) #> dose total infected #> 1 330 50 15 #> 2 1000 20 9 #> 3 3300 26 19 #> 4 10000 12 12 ## Fitting a two-parameter log-logistic model for binomial response echovirus.m1 <- drm(infected/total ~ dose, weights = total, data = echovirus, fct = LL.2(), type = \"binomial\") summary(echovirus.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) -0.94621 0.20507 -4.6141 3.948e-06 *** #> e:(Intercept) 921.04805 215.00279 4.2839 1.837e-05 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## Plotting the fitted curve plot(echovirus.m1, xlab = \"Dose (pfu)\", ylab = \"Proportion infected\")"},{"path":"https://hreinwald.github.io/drc/reference/ED.drc.html","id":null,"dir":"Reference","previous_headings":"","what":"Estimating effective doses — ED.drc","title":"Estimating effective doses — ED.drc","text":"Default method class drc. ED.drc estimates effective concentrations (EC) effective doses (ED) one specified response levels. Response levels may given relative percentages response range (e.g. ED50 = 50\\ values. function computes point estimates, delta-method standard errors, optional confidence intervals combination curve response level fitted model.","code":""},{"path":"https://hreinwald.github.io/drc/reference/ED.drc.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Estimating effective doses — ED.drc","text":"","code":"# S3 method for class 'drc' ED( object, respLev = c(10, 20, 50), interval = c(\"none\", \"delta\", \"fls\", \"tfls\", \"inv\"), clevel = NULL, level = 0.95, reference = c(\"control\", \"upper\"), type = c(\"relative\", \"absolute\"), lref, uref, bound = TRUE, vcov. = vcov, display = TRUE, logBase = NULL, multcomp = FALSE, intType = \"confidence\", ... )"},{"path":"https://hreinwald.github.io/drc/reference/ED.drc.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Estimating effective doses — ED.drc","text":"object object class drc. respLev numeric vector containing response levels. interval character string specifying type confidence intervals supplied. default \"none\". See Details explanation. clevel character string specifying curve id case estimates specific curve compound requested. default estimates shown curves. level numeric. level confidence intervals. Must single value strictly 0 1. default 0.95. reference character string. upper limit control level reference? type character string. Whether specified response levels absolute relative (default). lref numeric value specifying lower limit serve reference. uref numeric value specifying upper limit serve reference (e.g., 100%). bound logical. Default TRUE, case ED values 0 100% allowed. Set FALSE hormesis models. vcov. function providing variance-covariance matrix, variance-covariance matrix directly. vcov default, sandwich also option obtaining robust standard errors. display logical. TRUE results displayed. Otherwise (useful simulations). logBase numeric. base logarithm case logarithm transformed dose values used. multcomp logical switch output use package multcomp (needs activated first). Default FALSE. intType string specifying type interval use predict method case type confidence interval chosen inverse regression. ... additional arguments passed ED function model.","code":""},{"path":"https://hreinwald.github.io/drc/reference/ED.drc.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Estimating effective doses — ED.drc","text":"invisible matrix containing estimates corresponding estimated standard errors possibly lower upper confidence limits. , alternatively, list elements may plugged directly parm package multcomp (multcomp = TRUE).","code":""},{"path":"https://hreinwald.github.io/drc/reference/ED.drc.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Estimating effective doses — ED.drc","text":"function carries following computational steps: Input validation. Arguments checked correct types ranges (e.g. respLev must numeric, level must (0, 1), relative response levels must lie strictly inside interval (0, 100) bound = TRUE). Model component extraction. model-specific ED function (edfct), parameter matrix (parmMat), index matrix (indexMat) retrieved fitted drc object. variance-covariance matrix obtained vcov., may function (e.g. vcov sandwich::vcovHC) pre-computed matrix. Curve ordering. multiple curves present, sorted alphabetically name, unless names purely numeric, case original order preserved. ED estimation delta-method standard errors. curve requested response level, model-specific edfct called obtain ED point estimate analytical gradient respect model parameters. Standard errors computed via delta method: \\(SE = \\sqrt{g' V g}\\), \\(g\\) gradient vector \\(V\\) relevant sub-matrix variance-covariance matrix. Numerical gradient absolute responses. type = \"absolute\", analytical gradient returned model may miss chain-rule contribution asymptote parameters involved converting absolute relative response levels. case numerical central-difference gradient computed ensure correct standard errors. Log-base back-transformation. logBase specified (indicating dose values log-transformed prior model fitting), ED estimates derivatives back-transformed via \\(ED^* = b^{ED}\\) (\\(b\\) log base) results reported original dose scale. Confidence interval construction. Depending interval: \"delta\" Asymptotic Wald-type intervals using delta method, based normal t-distribution (depending response type). \"fls\" Intervals obtained back-transforming log scale. meaningful model parameterises ED log scale (e.g. llogistic2). \"tfls\" Experimental: intervals obtained transforming log scale, computing Wald intervals , back-transforming. \"inv\" Intervals derived inverse regression via EDinvreg, confidence limits predicted response inverted dose axis. Output. Results returned invisible matrix columns estimate, standard error, (optionally) lower upper confidence limits. multcomp = TRUE, list compatible parm returned instead, enabling multiple-comparison procedures. hormesis models (braincousens cedergreen), additional arguments lower upper may supplied. arguments specify lower upper limits bisection method used find ED values.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/ED.drc.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Estimating effective doses — ED.drc","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/ED.drc.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Estimating effective doses — ED.drc","text":"","code":"## Fitting a 4-parameter log-logistic model ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) ## Calculating EC/ED values ED(ryegrass.m1, c(10, 50, 90)) #> #> Estimated effective doses #> #> Estimate Std. Error #> e:10 1.46371 0.18677 #> e:50 3.05795 0.18573 #> e:90 6.38864 0.84510 ## Displaying 95% confidence intervals using the delta method ED(ryegrass.m1, c(10, 50, 90), interval = \"delta\") #> #> Estimated effective doses #> #> Estimate Std. Error Lower Upper #> e:10 1.46371 0.18677 1.07411 1.85330 #> e:50 3.05795 0.18573 2.67053 3.44538 #> e:90 6.38864 0.84510 4.62580 8.15148 ## Displaying 95% confidence intervals using back-transformation ED(ryegrass.m1, c(10, 50, 90), interval = \"fls\") #> #> Estimated effective doses #> #> Estimate Std. Error Lower Upper #> e:10 4.32195 0.18677 2.92738 6.38085 #> e:50 21.28399 0.18573 14.44757 31.35531 #> e:90 595.04680 0.84510 102.08419 3468.51638 ## Displaying 95% confidence intervals using inverse regression ED(ryegrass.m1, c(10, 50, 90), interval = \"inv\") #> #> Estimated effective doses #> #> Estimate Std. Error Lower Upper #> e:10 1.46371 0.18677 1.14225 1.82253 #> e:50 3.05795 0.18573 2.74905 3.40172 #> e:90 6.38864 0.84510 5.15138 8.19648"},{"path":"https://hreinwald.github.io/drc/reference/ED.html","id":null,"dir":"Reference","previous_headings":"","what":"Estimating effective doses — ED","title":"Estimating effective doses — ED","text":"S3 generic function dispatches appropriate method estimating effective concentrations (EC) effective doses (ED) specified response levels. objects class drc, default method ED.drc called.","code":""},{"path":"https://hreinwald.github.io/drc/reference/ED.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Estimating effective doses — ED","text":"","code":"ED(object, ...)"},{"path":"https://hreinwald.github.io/drc/reference/ED.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Estimating effective doses — ED","text":"object object class drc. ... additional arguments passed method.","code":""},{"path":"https://hreinwald.github.io/drc/reference/ED.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Estimating effective doses — ED","text":"See ED.drc details return value.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/ED.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Estimating effective doses — ED","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/ED.lin.html","id":null,"dir":"Reference","previous_headings":"","what":"ED calculation for linear models — ED.lin","title":"ED calculation for linear models — ED.lin","text":"ED calculation linear models","code":""},{"path":"https://hreinwald.github.io/drc/reference/ED.lin.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"ED calculation for linear models — ED.lin","text":"","code":"# S3 method for class 'lin' ED(object, respLev, ...)"},{"path":"https://hreinwald.github.io/drc/reference/EDcomp.html","id":null,"dir":"Reference","previous_headings":"","what":"Comparison of relative potencies between dose-response curves — EDcomp","title":"Comparison of relative potencies between dose-response curves — EDcomp","text":"Relative potencies (also called selectivity indices) arbitrary doses compared fitted dose-response curves.","code":""},{"path":"https://hreinwald.github.io/drc/reference/EDcomp.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Comparison of relative potencies between dose-response curves — EDcomp","text":"","code":"EDcomp( object, percVec, percMat = NULL, compMatch = NULL, od = FALSE, vcov. = vcov, reverse = FALSE, interval = c(\"none\", \"delta\", \"fieller\", \"fls\"), level = ifelse(!(interval == \"none\"), 0.95, NULL), reference = c(\"control\", \"upper\"), type = c(\"relative\", \"absolute\"), display = TRUE, pool = TRUE, logBase = NULL, multcomp = FALSE, ... )"},{"path":"https://hreinwald.github.io/drc/reference/EDcomp.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Comparison of relative potencies between dose-response curves — EDcomp","text":"object object class 'drc'. percVec numeric vector dosage values. percMat matrix 2 columns providing pairs indices percVec compared. default pairs compared. compMatch optional character vector names assays compared. specified comparisons supplied. od logical. TRUE adjustment -dispersion used. argument makes difference binomial data. vcov. function providing variance-covariance matrix. vcov default, sandwich also option (obtaining robust standard errors). reverse logical. TRUE order comparison two curves reversed. interval character string specifying type confidence intervals supplied. default \"none\". Use \"delta\" asymptotics-based confidence intervals, \"fieller\" confidence intervals based Fieller's theorem, \"fls\" confidence intervals back-transformed logarithm scale. level numeric. level confidence intervals. Default 0.95. reference character string. upper limit control level reference? type character string specifying whether absolute relative response levels supplied. display logical. TRUE results displayed. Otherwise (useful simulations). pool logical. TRUE curves pooled. Otherwise . argument works models independently fitted curves specified drm. logBase numeric. base logarithm case logarithm transformed dose values used. multcomp logical switch output use package multcomp. Default FALSE. ... additional arguments passed function calculations.","code":""},{"path":"https://hreinwald.github.io/drc/reference/EDcomp.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Comparison of relative potencies between dose-response curves — EDcomp","text":"invisible matrix containing estimates corresponding estimated standard errors possibly lower upper confidence limits. , alternatively, list elements may plugged directly parm package multcomp (multcomp TRUE).","code":""},{"path":"https://hreinwald.github.io/drc/reference/EDcomp.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Comparison of relative potencies between dose-response curves — EDcomp","text":"Fieller's theorem incorporated using formulas provided Kotz Johnson (1983) Finney (1978). objects class 'braincousens' 'mlogistic' additional argument may 'upper' argument 'interval' argument specifying limits bisection method.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/EDcomp.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Comparison of relative potencies between dose-response curves — EDcomp","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/EDcomp.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Comparison of relative potencies between dose-response curves — EDcomp","text":"","code":"spinach.LL.4 <- drm(SLOPE~DOSE, CURVE, data = spinach, fct = LL.4()) EDcomp(spinach.LL.4, c(50, 50)) #> #> Estimated ratios of effect doses #> #> Estimate Std. Error t-value p-value #> 1/2:50/50 1.8983586 0.7118489 1.2620074 0.2103980 #> 1/3:50/50 1.3073016 0.5541592 0.5545367 0.5806678 #> 1/4:50/50 9.0963785 2.4686586 3.2796671 0.0015076 #> 1/5:50/50 8.5152294 2.3364483 3.2165186 0.0018362 #> 2/3:50/50 0.6886484 0.2908078 -1.0706439 0.2873603 #> 2/4:50/50 4.7917071 1.2883525 2.9430664 0.0041886 #> 2/5:50/50 4.4855747 1.2196032 2.8579579 0.0053607 #> 3/4:50/50 6.9581332 2.3220591 2.5658835 0.0120448 #> 3/5:50/50 6.5135923 2.1896041 2.5180773 0.0136744 #> 4/5:50/50 0.9361120 0.0781402 -0.8176069 0.4158677 EDcomp(spinach.LL.4, c(10, 50)) #> #> Estimated ratios of effect doses #> #> Estimate Std. Error t-value p-value #> 1/2:10/50 2.7644e-02 1.5249e-02 -6.3765e+01 7.3799e-74 #> 1/3:10/50 1.9037e-02 1.1155e-02 -8.7939e+01 1.5155e-85 #> 1/4:10/50 1.3246e-01 6.4530e-02 -1.3444e+01 4.7570e-23 #> 1/5:10/50 1.2400e-01 6.0615e-02 -1.4452e+01 6.4822e-25 #> 2/3:10/50 4.4298e-02 3.7850e-02 -2.5250e+01 1.4449e-41 #> 2/4:10/50 3.0823e-01 2.4349e-01 -2.8411e+00 5.6264e-03 #> 2/5:10/50 2.8854e-01 2.2823e-01 -3.1173e+00 2.4906e-03 #> 3/4:10/50 2.7742e-01 1.5001e-01 -4.8170e+00 6.2889e-06 #> 3/5:10/50 2.5969e-01 1.4081e-01 -5.2573e+00 1.0722e-06 #> 4/5:10/50 2.8449e-01 3.7366e-02 -1.9148e+01 7.0761e-33 EDcomp(spinach.LL.4, c(10, 50), reverse = TRUE) #> #> Estimated ratios of effect doses #> #> Estimate Std. Error t-value p-value #> 2/1:50/10 3.6174e+01 1.9955e+01 1.7627e+00 8.1542e-02 #> 3/1:50/10 5.2530e+01 3.0781e+01 1.6741e+00 9.7792e-02 #> 4/1:50/10 7.5494e+00 3.6778e+00 1.7808e+00 7.8519e-02 #> 5/1:50/10 8.0646e+00 3.9423e+00 1.7920e+00 7.6691e-02 #> 3/2:50/10 2.2575e+01 1.9289e+01 1.1185e+00 2.6650e-01 #> 4/2:50/10 3.2443e+00 2.5629e+00 8.7570e-01 3.8366e-01 #> 5/2:50/10 3.4658e+00 2.7414e+00 8.9945e-01 3.7095e-01 #> 4/3:50/10 3.6047e+00 1.9491e+00 1.3363e+00 1.8501e-01 #> 5/3:50/10 3.8507e+00 2.0880e+00 1.3653e+00 1.7576e-01 #> 5/4:50/10 3.5150e+00 4.6168e-01 5.4476e+00 4.8856e-07"},{"path":"https://hreinwald.github.io/drc/reference/EDhelper.html","id":null,"dir":"Reference","previous_headings":"","what":"Helper function for ED calculations — EDhelper","title":"Helper function for ED calculations — EDhelper","text":"Helper function ED calculations","code":""},{"path":"https://hreinwald.github.io/drc/reference/EDhelper.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Helper function for ED calculations — EDhelper","text":"","code":"EDhelper(parmVec, respl, reference, typeCalc, cond = TRUE)"},{"path":"https://hreinwald.github.io/drc/reference/EDinvreg.html","id":null,"dir":"Reference","previous_headings":"","what":"Inverse regression for ED estimation — EDinvreg","title":"Inverse regression for ED estimation — EDinvreg","text":"Inverse regression ED estimation","code":""},{"path":"https://hreinwald.github.io/drc/reference/EDinvreg.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Inverse regression for ED estimation — EDinvreg","text":"","code":"EDinvreg( object, respLev, catLev = NA, intType = \"confidence\", level, type, extFactor = 10 )"},{"path":"https://hreinwald.github.io/drc/reference/ED_robust.html","id":null,"dir":"Reference","previous_headings":"","what":"Robust Calculation of Effective Doses (ED) — ED_robust","title":"Robust Calculation of Effective Doses (ED) — ED_robust","text":"function serves robust wrapper drc::ED. calculates effective doses (EDs) multiple specified response levels. primary feature ability gracefully handle cases ED value mathematically estimable model (e.g., requested response outside model's asymptotes). Instead throwing error, returns row NA values specific response level, ensuring overall analysis can proceed.","code":""},{"path":"https://hreinwald.github.io/drc/reference/ED_robust.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Robust Calculation of Effective Doses (ED) — ED_robust","text":"","code":"ED_robust( mod, respLev = c(10, 20, 50), interval = get_ed_interval(mod$fct$name, small_n = TRUE), CI_level = 0.95, verbose = FALSE, ... )"},{"path":"https://hreinwald.github.io/drc/reference/ED_robust.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Robust Calculation of Effective Doses (ED) — ED_robust","text":"mod object class 'drc', representing fitted dose-response model. respLev numeric vector specifying response levels calculate ED values (e.g., c(10, 50) ED10 ED50). interval character string specifying method calculating confidence intervals. Defaults output get_ed_interval(). Common options include \"delta\", \"tfls\", \"buckland\". CI_level numeric value 0 1 indicating confidence level intervals (e.g., 0.95 95% CI). verbose logical value. TRUE, function print status messages calculation progress errors encountered response level. Default FALSE. ... Additional arguments passed directly drc::ED.","code":""},{"path":"https://hreinwald.github.io/drc/reference/ED_robust.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Robust Calculation of Effective Doses (ED) — ED_robust","text":"data.table row corresponds requested response level. table includes ED estimate, standard error, confidence interval (Lower, Upper), metadata calculation (confidence level, method, model name, EC level). Rows non-estimable EDs populated NA.","code":""},{"path":"https://hreinwald.github.io/drc/reference/ED_robust.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Robust Calculation of Effective Doses (ED) — ED_robust","text":"Hannes Reinwald","code":""},{"path":"https://hreinwald.github.io/drc/reference/ED_robust.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Robust Calculation of Effective Doses (ED) — ED_robust","text":"","code":"data(lettuce) m <- drm(weight ~ conc, data = lettuce, fct = BC.4()) ED_robust(m, respLev = c(10, 50), CI_level = 0.95) #> Estimate stderr Lower Upper confint_level confint_method #> #> 1: 4.457785 1.674585 1.930237 10.29503 0.95 tfls #> 2: 35.022556 15.426732 13.125303 93.45151 0.95 tfls #> model EC #> #> 1: BC.4:b-d-e-f 10 #> 2: BC.4:b-d-e-f 50"},{"path":"https://hreinwald.github.io/drc/reference/Eryngium.sparganophyllum.html","id":null,"dir":"Reference","previous_headings":"","what":"Germination of Eryngium sparganophyllum — Eryngium.sparganophyllum","title":"Germination of Eryngium sparganophyllum — Eryngium.sparganophyllum","text":"Germination data experiments investigating effect different concentration gibberellic acid germination Eryngium sparganophyllum seeds. Two datasets provided: one resembling data entered first place (\"Eryngium.sparganophyllum0\") one formatted ready--use statistical analysis (\"Eryngium.sparganophyllum\")","code":""},{"path":"https://hreinwald.github.io/drc/reference/Eryngium.sparganophyllum.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Germination of Eryngium sparganophyllum — Eryngium.sparganophyllum","text":"","code":"Eryngium.sparganophyllum"},{"path":"https://hreinwald.github.io/drc/reference/Eryngium.sparganophyllum.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Germination of Eryngium sparganophyllum — Eryngium.sparganophyllum","text":"data frame 583 observations following variables. Treat factor 15 levels denoting concentration gibberellic acid (ppm) Type factor two levels denoting type treatment (gibberellic acid temperature) Day numeric vector recording time (days) since beginning experiment Germ numeric vector counts germinated seeds Start numeric vector starting time points monitoring intervals End numeric vector ending time points monitoring intervals Germinated numeric vector counts germinated seeds given interval Rep numeric vector corresponding replicated sub-experiments; unique enumeration dataset \"Eryngium.sparganophyllum\"","code":""},{"path":"https://hreinwald.github.io/drc/reference/Eryngium.sparganophyllum.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Germination of Eryngium sparganophyllum — Eryngium.sparganophyllum","text":"Wolkis, D., Blackwell, S., Kaninaualiʻi Villanueva, S. (2020). Conservation seed physiology ciénega endemic, Eryngium sparganophyllum (Apiaceae). Conservation Physiology, 8, coaa017. https://doi.org/10.1093/conphys/coaa017","code":""},{"path":"https://hreinwald.github.io/drc/reference/Eryngium.sparganophyllum.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Germination of Eryngium sparganophyllum — Eryngium.sparganophyllum","text":"","code":"library(drc) ## Displaying the data head(Eryngium.sparganophyllum) #> Day Treat Type Rep Start End Germinated #> 1 2 GA3.0 GA3 GA3.GA3-0.1 0 2 0 #> 2 2 GA3.0 GA3 GA3.GA3-0.1 2 4 0 #> 3 4 GA3.0 GA3 GA3.GA3-0.1 4 7 0 #> 4 7 GA3.0 GA3 GA3.GA3-0.1 7 9 1 #> 5 9 GA3.0 GA3 GA3.GA3-0.1 9 11 1 #> 6 11 GA3.0 GA3 GA3.GA3-0.1 11 14 0 ## Fitting an event-time model for germination Eryngium.m1 <- drm(Germinated ~ Start + End, data = Eryngium.sparganophyllum, fct = LL.3(), type = \"event\") #> Warning: longer object length is not a multiple of shorter object length #> Warning: longer object length is not a multiple of shorter object length #> Warning: data length [1166] is not a sub-multiple or multiple of the number of rows [14] #> Warning: longer object length is not a multiple of shorter object length #> Warning: longer object length is not a multiple of shorter object length summary(Eryngium.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) -2.715614 0.126975 -21.387 < 2.2e-16 *** #> d:(Intercept) 0.663221 0.018812 35.254 < 2.2e-16 *** #> e:(Intercept) 6.698683 0.215910 31.025 < 2.2e-16 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## Plotting the fitted germination curve plot(Eryngium.m1, xlab = \"Time (days)\", ylab = \"Proportion germinated\", log = \"\")"},{"path":"https://hreinwald.github.io/drc/reference/estfun.drc.html","id":null,"dir":"Reference","previous_headings":"","what":"Estimating function for the sandwich estimator — estfun.drc","title":"Estimating function for the sandwich estimator — estfun.drc","text":"Evaluates estimating function (\"meat\") sandwich estimator variance-covariance matrix objects class 'drc'.","code":""},{"path":"https://hreinwald.github.io/drc/reference/estfun.drc.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Estimating function for the sandwich estimator — estfun.drc","text":"","code":"# S3 method for class 'drc' estfun(x, ...)"},{"path":"https://hreinwald.github.io/drc/reference/estfun.drc.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Estimating function for the sandwich estimator — estfun.drc","text":"x object class drc. ... additional arguments. moment none supported.","code":""},{"path":"https://hreinwald.github.io/drc/reference/estfun.drc.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Estimating function for the sandwich estimator — estfun.drc","text":"estimating function evaluated data parameter estimates. default clustering assumed, corresponding robust standard errors independence.","code":""},{"path":"https://hreinwald.github.io/drc/reference/estfun.drc.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Estimating function for the sandwich estimator — estfun.drc","text":"details provided Zeileis (2006).","code":""},{"path":"https://hreinwald.github.io/drc/reference/estfun.drc.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Estimating function for the sandwich estimator — estfun.drc","text":"Zeileis, . (2006) Object-oriented Computation Sandwich Estimators, J. Statist. Software, 16, Issue 9.","code":""},{"path":"https://hreinwald.github.io/drc/reference/estfun.drc.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Estimating function for the sandwich estimator — estfun.drc","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/estfun.drc.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Estimating function for the sandwich estimator — estfun.drc","text":"","code":"## The lines below requires that the packages ## 'lmtest' and 'sandwich' are installed # library(lmtest) # library(sandwich) # ryegrass.m1<-drm(rootl ~ conc, data = ryegrass, fct = LL.4()) # Standard summary output # coeftest(ryegrass.m1) # Output with robust standard errors # coeftest(ryegrass.m1, vcov = sandwich)"},{"path":"https://hreinwald.github.io/drc/reference/etmotc.html","id":null,"dir":"Reference","previous_headings":"","what":"Effect of erythromycin on mixed sewage microorganisms — etmotc","title":"Effect of erythromycin on mixed sewage microorganisms — etmotc","text":"Relative growth rate biomass mixed sewage microorganisms (per hour) function increasing concentrations antibiotic erythromycin (mg/l).","code":""},{"path":"https://hreinwald.github.io/drc/reference/etmotc.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Effect of erythromycin on mixed sewage microorganisms — etmotc","text":"","code":"data(etmotc)"},{"path":"https://hreinwald.github.io/drc/reference/etmotc.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Effect of erythromycin on mixed sewage microorganisms — etmotc","text":"data frame 57 observations following 4 variables. cell numeric vector dose1 numeric vector pct1 numeric vector rgr1 numeric vector","code":""},{"path":"https://hreinwald.github.io/drc/reference/etmotc.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Effect of erythromycin on mixed sewage microorganisms — etmotc","text":"Data stem experiment investigating effect pharmaceuticals, used human veterinary medicine released aquatic environment waste water manure used fertilising agricultural land. experiment constitutes typical dose-response situation. dose concentration antibiotic erythromycin (mg/l), antibiotic can used persons animals showing allergy penicillin, measured response relative growth rate biomass mixed sewage microorganisms (per hour), measured turbidity two hours exposure means spectrophotometer. experiment designed way eight replicates assigned control (dose 0), replicates assigned 7 non-zero doses. details found Christensen et al (2006).","code":""},{"path":"https://hreinwald.github.io/drc/reference/etmotc.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Effect of erythromycin on mixed sewage microorganisms — etmotc","text":"Christensen, . M. Ingerslev, F. Baun, . 2006 Ecotoxicity mixtures antibiotics used aquacultures, Environmental Toxicology Chemistry, 25, 2208–2215.","code":""},{"path":"https://hreinwald.github.io/drc/reference/etmotc.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Effect of erythromycin on mixed sewage microorganisms — etmotc","text":"","code":"library(drc) etmotc.m1<-drm(rgr1~dose1, data=etmotc[1:15,], fct=LL.4()) plot(etmotc.m1) modelFit(etmotc.m1) #> Lack-of-fit test #> #> ModelDf RSS Df F value p value #> ANOVA 7 5.413e-05 #> DRC model 11 5.978e-04 4 17.5773 0.0009 summary(etmotc.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 0.9365452 0.0680380 13.7650 2.806e-08 *** #> c:(Intercept) 0.2225885 0.0199342 11.1662 2.430e-07 *** #> d:(Intercept) 0.6496673 0.0025117 258.6611 < 2.2e-16 *** #> e:(Intercept) 11.6675539 1.6207593 7.1988 1.755e-05 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.007371964 (11 degrees of freedom) etmotc.m2<-drm(rgr1~dose1, data=etmotc[1:15,], fct=W2.4()) plot(etmotc.m2, add = TRUE) modelFit(etmotc.m2) #> Lack-of-fit test #> #> ModelDf RSS Df F value p value #> ANOVA 7 5.4128e-05 #> DRC model 11 1.5608e-04 4 3.2960 0.0807 summary(etmotc.m2) #> #> Model fitted: Weibull (type 2) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) -0.4585014 0.0270713 -16.9368 3.154e-09 *** #> c:(Intercept) 0.1105817 0.0253882 4.3556 0.001145 ** #> d:(Intercept) 0.6484347 0.0012874 503.6837 < 2.2e-16 *** #> e:(Intercept) 9.8112667 1.1944769 8.2139 5.079e-06 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.003766782 (11 degrees of freedom) etmotc.m3<-drm(rgr1~dose1, data=etmotc[1:15,], fct=W2.3()) plot(etmotc.m3, add = TRUE) modelFit(etmotc.m3) #> Lack-of-fit test #> #> ModelDf RSS Df F value p value #> ANOVA 7 5.4128e-05 #> DRC model 12 3.0527e-04 5 6.4955 0.0146 summary(etmotc.m3) #> #> Model fitted: Weibull (type 2) with lower limit at 0 (3 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) -0.3748065 0.0079192 -47.329 5.252e-15 *** #> d:(Intercept) 0.6491863 0.0017073 380.232 < 2.2e-16 *** #> e:(Intercept) 16.3999632 0.5104155 32.131 5.217e-13 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.005043693 (12 degrees of freedom)"},{"path":"https://hreinwald.github.io/drc/reference/EXD.2.html","id":null,"dir":"Reference","previous_headings":"","what":"Two-parameter exponential decay model — EXD.2","title":"Two-parameter exponential decay model — EXD.2","text":"two-parameter exponential decay model slope parameter b fixed 1 lower limit fixed 0.","code":""},{"path":"https://hreinwald.github.io/drc/reference/EXD.2.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Two-parameter exponential decay model — EXD.2","text":"","code":"EXD.2(fixed = c(NA, NA), names = c(\"d\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/EXD.2.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Two-parameter exponential decay model — EXD.2","text":"fixed numeric vector length 2. Specifies parameters fixed value. Use NA parameters fixed. names character vector length 2 giving names parameters. default c(\"d\", \"e\"). ... additional arguments passed weibull1, notably method (character string: \"1\" (default), \"2\", \"3\", \"4\") selects self-starter method obtaining starting values. See weibull1 details.","code":""},{"path":"https://hreinwald.github.io/drc/reference/EXD.2.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Two-parameter exponential decay model — EXD.2","text":"list class Weibull-1 containing nonlinear function, self starter function, parameter names.","code":""},{"path":"https://hreinwald.github.io/drc/reference/EXD.2.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Two-parameter exponential decay model — EXD.2","text":"model given expression $$f(x) = d \\exp(-x/e)$$ special case Weibull type 1 model (weibull1) slope fixed 1 lower limit fixed 0.","code":""},{"path":"https://hreinwald.github.io/drc/reference/EXD.2.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Two-parameter exponential decay model — EXD.2","text":"Seber, G. . F. Wild, C. J. (1989) Nonlinear Regression, New York: Wiley & Sons (pp. 338–339).","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/EXD.2.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Two-parameter exponential decay model — EXD.2","text":"","code":"ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = EXD.2())"},{"path":"https://hreinwald.github.io/drc/reference/EXD.3.html","id":null,"dir":"Reference","previous_headings":"","what":"Three-parameter exponential decay model — EXD.3","title":"Three-parameter exponential decay model — EXD.3","text":"three-parameter exponential decay model slope parameter b fixed 1.","code":""},{"path":"https://hreinwald.github.io/drc/reference/EXD.3.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Three-parameter exponential decay model — EXD.3","text":"","code":"EXD.3(fixed = c(NA, NA, NA), names = c(\"c\", \"d\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/EXD.3.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Three-parameter exponential decay model — EXD.3","text":"fixed numeric vector length 3. Specifies parameters fixed value. Use NA parameters fixed. names character vector length 3 giving names parameters. default c(\"c\", \"d\", \"e\"). ... additional arguments passed weibull1, notably method (character string: \"1\" (default), \"2\", \"3\", \"4\") selects self-starter method obtaining starting values. See weibull1 details.","code":""},{"path":"https://hreinwald.github.io/drc/reference/EXD.3.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Three-parameter exponential decay model — EXD.3","text":"list class Weibull-1 containing nonlinear function, self starter function, parameter names.","code":""},{"path":"https://hreinwald.github.io/drc/reference/EXD.3.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Three-parameter exponential decay model — EXD.3","text":"model given expression $$f(x) = c + (d - c) \\exp(-x/e)$$ special case Weibull type 1 model (weibull1) slope fixed 1.","code":""},{"path":"https://hreinwald.github.io/drc/reference/EXD.3.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Three-parameter exponential decay model — EXD.3","text":"Seber, G. . F. Wild, C. J. (1989) Nonlinear Regression, New York: Wiley & Sons (pp. 338–339).","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/EXD.3.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Three-parameter exponential decay model — EXD.3","text":"","code":"ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = EXD.3())"},{"path":"https://hreinwald.github.io/drc/reference/fieller.html","id":null,"dir":"Reference","previous_headings":"","what":"Fieller's confidence interval — fieller","title":"Fieller's confidence interval — fieller","text":"Fieller's confidence interval","code":""},{"path":"https://hreinwald.github.io/drc/reference/fieller.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Fieller's confidence interval — fieller","text":"","code":"fieller(mu, df, vcMat, level = 0.95, finney = FALSE, resVar)"},{"path":"https://hreinwald.github.io/drc/reference/findbe1.html","id":null,"dir":"Reference","previous_headings":"","what":"Find initial parameter estimates — findbe1","title":"Find initial parameter estimates — findbe1","text":"Find initial parameter estimates","code":""},{"path":"https://hreinwald.github.io/drc/reference/findbe1.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Find initial parameter estimates — findbe1","text":"","code":"findbe1(doseTr, respTr, sgnb = 1, back = exp)"},{"path":"https://hreinwald.github.io/drc/reference/findcd.html","id":null,"dir":"Reference","previous_headings":"","what":"Find c and d parameters — findcd","title":"Find c and d parameters — findcd","text":"Find c d parameters","code":""},{"path":"https://hreinwald.github.io/drc/reference/findcd.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Find c and d parameters — findcd","text":"","code":"findcd(x, y, scaleInc = 0.001)"},{"path":"https://hreinwald.github.io/drc/reference/finney71.html","id":null,"dir":"Reference","previous_headings":"","what":"Example from Finney (1971) — finney71","title":"Example from Finney (1971) — finney71","text":"six concentrations insecticide number insects affected (total number insects) recorded.","code":""},{"path":"https://hreinwald.github.io/drc/reference/finney71.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Example from Finney (1971) — finney71","text":"","code":"data(finney71)"},{"path":"https://hreinwald.github.io/drc/reference/finney71.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Example from Finney (1971) — finney71","text":"data frame 6 observations following 3 variables. dose numeric vector total numeric vector affected numeric vector","code":""},{"path":"https://hreinwald.github.io/drc/reference/finney71.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Example from Finney (1971) — finney71","text":"Finney, D. J. (1971) Probit Analysis, Cambridge: Cambridge University Press.","code":""},{"path":"https://hreinwald.github.io/drc/reference/finney71.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Example from Finney (1971) — finney71","text":"","code":"library(drc) ## Model with ED50 as a parameter finney71.m1 <- drm(affected/total ~ dose, weights = total, data = finney71, fct = LL.2(), type = \"binomial\") summary(finney71.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) -3.10363 0.38773 -8.0047 1.154e-15 *** #> e:(Intercept) 4.82890 0.24958 19.3485 < 2.2e-16 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 plot(finney71.m1, broken = TRUE, bp = 0.1, lwd = 2) ED(finney71.m1, c(10, 20, 50), interval = \"delta\", reference = \"control\") #> #> Estimated effective doses #> #> Estimate Std. Error Lower Upper #> e:10 2.37896 0.25164 1.88576 2.87217 #> e:20 3.08932 0.24372 2.61163 3.56700 #> e:50 4.82890 0.24958 4.33974 5.31806 ## Model fitted with 'glm' #fitl.glm <- glm(cbind(affected, total-affected) ~ log(dose), #family=binomial(link = logit), data=finney71[finney71$dose != 0, ]) #summary(fitl.glm) # p-value almost agree for the b parameter # #xp <- dose.p(fitl.glm, p=c(0.50, 0.90, 0.95)) # from MASS #xp.ci <- xp + attr(xp, \"SE\") %*% matrix(qnorm(1 - 0.05/2)*c(-1,1), nrow=1) #zp.est <- exp(cbind(xp.ci[,1],xp,xp.ci[,2])) #dimnames(zp.est)[[2]] <- c(\"zp.lcl\",\"zp\",\"zp.ucl\") #zp.est # not far from above results with 'ED' ## Model with log(ED50) as a parameter finney71.m2 <- drm(affected/total ~ dose, weights = total, data = finney71, fct = LL2.2(), type = \"binomial\") ## Confidence intervals based on back-transformation ## complete agreement with results based on 'glm' ED(finney71.m2, c(10, 20, 50), interval = \"fls\", reference = \"control\") #> #> Estimated effective doses #> #> Estimate Std. Error Lower Upper #> e:10 2.378930 0.105781 1.933486 2.926996 #> e:20 3.089292 0.078893 2.646700 3.605896 #> e:50 4.828919 0.051685 4.363709 5.343725"},{"path":"https://hreinwald.github.io/drc/reference/fitted.drc.html","id":null,"dir":"Reference","previous_headings":"","what":"Extract fitted values from model — fitted.drc","title":"Extract fitted values from model — fitted.drc","text":"Extracts fitted values object class 'drc'.","code":""},{"path":"https://hreinwald.github.io/drc/reference/fitted.drc.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Extract fitted values from model — fitted.drc","text":"","code":"# S3 method for class 'drc' fitted(object, ...)"},{"path":"https://hreinwald.github.io/drc/reference/fitted.drc.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Extract fitted values from model — fitted.drc","text":"object object class 'drc'. ... additional arguments.","code":""},{"path":"https://hreinwald.github.io/drc/reference/fitted.drc.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Extract fitted values from model — fitted.drc","text":"Fitted values extracted object.","code":""},{"path":"https://hreinwald.github.io/drc/reference/fitted.drc.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Extract fitted values from model — fitted.drc","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/fitted.drc.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Extract fitted values from model — fitted.drc","text":"","code":"ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) plot(fitted(ryegrass.m1), residuals(ryegrass.m1)) # a residual plot"},{"path":"https://hreinwald.github.io/drc/reference/fluoranthene.html","id":null,"dir":"Reference","previous_headings":"","what":"Death of fathead minnow larvae after exposure to fluoranthene — fluoranthene","title":"Death of fathead minnow larvae after exposure to fluoranthene — fluoranthene","text":"Fathead minnow larvae exposed fluoranthene, polycyclic aromatic hydrocarbon, two different algal densities resulting different levels ambient ultraviolet radiation. Number dead larvaes reported.","code":""},{"path":"https://hreinwald.github.io/drc/reference/fluoranthene.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Death of fathead minnow larvae after exposure to fluoranthene — fluoranthene","text":"","code":"data(fluoranthene)"},{"path":"https://hreinwald.github.io/drc/reference/fluoranthene.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Death of fathead minnow larvae after exposure to fluoranthene — fluoranthene","text":"data frame 24 observations following 4 variables. algalconc numeric vector conc numeric vector totalnum numeric vector mortality numeric vector","code":""},{"path":"https://hreinwald.github.io/drc/reference/fluoranthene.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Death of fathead minnow larvae after exposure to fluoranthene — fluoranthene","text":"M. W. Wheeler, R. M. Park, . J. Bailer (2006). Comparing median lethal concentration values using confidence interval overlap ratio tests. Environmental Toxicology Chemistry, 25:1441–1444.","code":""},{"path":"https://hreinwald.github.io/drc/reference/fluoranthene.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Death of fathead minnow larvae after exposure to fluoranthene — fluoranthene","text":"","code":"library(drc) ## Displaying the data head(fluoranthene) #> algalconc conc mortality totalnum #> 1 0.7 5 0 23 #> 2 0.7 5 0 19 #> 3 0.7 5 0 20 #> 4 1.5 5 0 22 #> 5 1.5 5 0 25 #> 6 1.5 5 0 24 ## Fitting a two-parameter log-logistic model for binomial response ## with different curves per algal concentration fluoranthene.m1 <- drm(mortality/totalnum ~ conc, algalconc, weights = totalnum, data = fluoranthene, fct = LL.2(), type = \"binomial\") summary(fluoranthene.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:0.7 -4.61836 0.53249 -8.6731 < 2.2e-16 *** #> b:1.5 -5.14932 0.64726 -7.9556 1.78e-15 *** #> e:0.7 15.24767 0.73337 20.7914 < 2.2e-16 *** #> e:1.5 17.88383 0.77174 23.1735 < 2.2e-16 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## Plotting the fitted curves plot(fluoranthene.m1, xlab = \"Fluoranthene concentration\", ylab = \"Proportion dead\")"},{"path":"https://hreinwald.github.io/drc/reference/FPL.4.html","id":null,"dir":"Reference","previous_headings":"","what":"Four-parameter fractional polynomial-logistic model — FPL.4","title":"Four-parameter fractional polynomial-logistic model — FPL.4","text":"Convenience function four-parameter fractional polynomial-logistic model.","code":""},{"path":"https://hreinwald.github.io/drc/reference/FPL.4.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Four-parameter fractional polynomial-logistic model — FPL.4","text":"","code":"FPL.4(p1, p2, fixed = c(NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/FPL.4.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Four-parameter fractional polynomial-logistic model — FPL.4","text":"p1 numeric denoting negative power log(dose+1) fractional polynomial. p2 numeric denoting positive power log(dose+1) fractional polynomial. fixed numeric vector length 4 specifying fixed parameters (NAs free parameters). names character vector parameter names. ... additional arguments passed fplogistic.","code":""},{"path":"https://hreinwald.github.io/drc/reference/FPL.4.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Four-parameter fractional polynomial-logistic model — FPL.4","text":"list (see fplogistic).","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/fplogistic.html","id":null,"dir":"Reference","previous_headings":"","what":"Fractional polynomial-logistic dose-response model — fplogistic","title":"Fractional polynomial-logistic dose-response model — fplogistic","text":"Model function specifying dose-response models combination logistic model appropriate class fractional polynomials.","code":""},{"path":"https://hreinwald.github.io/drc/reference/fplogistic.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Fractional polynomial-logistic dose-response model — fplogistic","text":"","code":"fplogistic( p1, p2, fixed = c(NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\"), method = c(\"1\", \"2\", \"3\", \"4\"), ssfct = NULL, fctName, fctText )"},{"path":"https://hreinwald.github.io/drc/reference/fplogistic.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Fractional polynomial-logistic dose-response model — fplogistic","text":"p1 numeric denoting negative power log(dose+1) fractional polynomial. p2 numeric denoting positive power log(dose+1) fractional polynomial. fixed numeric vector. Specifies parameters fixed value fixed. NAs parameters fixed. names vector character strings giving names parameters (contain \":\"). order parameters : b, c, d, e. method character string indicating self starter function use. ssfct self starter function used. fctName optional character string used internally convenience functions. fctText optional character string used internally convenience functions.","code":""},{"path":"https://hreinwald.github.io/drc/reference/fplogistic.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Fractional polynomial-logistic dose-response model — fplogistic","text":"list containing nonlinear function, self starter function parameter names.","code":""},{"path":"https://hreinwald.github.io/drc/reference/fplogistic.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Fractional polynomial-logistic dose-response model — fplogistic","text":"fractional polynomial dose-response models introduced Namata et al. (2008) implemented using logistic model base.","code":""},{"path":"https://hreinwald.github.io/drc/reference/fplogistic.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Fractional polynomial-logistic dose-response model — fplogistic","text":"Namata, Harriet Aerts, Marc Faes, Christel Teunis, Peter (2008) Model Averaging Microbial Risk Assessment Using Fractional Polynomials, Risk Analysis 28, 891–905.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/fplogistic.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Fractional polynomial-logistic dose-response model — fplogistic","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/G.2.html","id":null,"dir":"Reference","previous_headings":"","what":"Two-parameter Gompertz model — G.2","title":"Two-parameter Gompertz model — G.2","text":"Convenience function Gompertz model lower limit fixed 0 upper limit fixed.","code":""},{"path":"https://hreinwald.github.io/drc/reference/G.2.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Two-parameter Gompertz model — G.2","text":"","code":"G.2(upper = 1, fixed = c(NA, NA), names = c(\"b\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/G.2.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Two-parameter Gompertz model — G.2","text":"upper numeric specifying fixed upper horizontal asymptote. Default 1. fixed numeric vector length 2 specifying fixed parameters (NAs free parameters). names character vector parameter names. ... additional arguments passed gompertz.","code":""},{"path":"https://hreinwald.github.io/drc/reference/G.2.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Two-parameter Gompertz model — G.2","text":"list (see gompertz).","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/G.3.html","id":null,"dir":"Reference","previous_headings":"","what":"Three-parameter Gompertz model — G.3","title":"Three-parameter Gompertz model — G.3","text":"Convenience function Gompertz model lower limit fixed 0.","code":""},{"path":"https://hreinwald.github.io/drc/reference/G.3.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Three-parameter Gompertz model — G.3","text":"","code":"G.3(fixed = c(NA, NA, NA), names = c(\"b\", \"d\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/G.3.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Three-parameter Gompertz model — G.3","text":"fixed numeric vector length 3 specifying fixed parameters (NAs free parameters). names character vector parameter names. ... additional arguments passed gompertz.","code":""},{"path":"https://hreinwald.github.io/drc/reference/G.3.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Three-parameter Gompertz model — G.3","text":"list (see gompertz).","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/G.3u.html","id":null,"dir":"Reference","previous_headings":"","what":"Three-parameter Gompertz model with upper limit fixed — G.3u","title":"Three-parameter Gompertz model with upper limit fixed — G.3u","text":"Convenience function Gompertz model upper limit fixed.","code":""},{"path":"https://hreinwald.github.io/drc/reference/G.3u.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Three-parameter Gompertz model with upper limit fixed — G.3u","text":"","code":"G.3u(upper = 1, fixed = c(NA, NA, NA), names = c(\"b\", \"c\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/G.3u.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Three-parameter Gompertz model with upper limit fixed — G.3u","text":"upper numeric specifying fixed upper horizontal asymptote. Default 1. fixed numeric vector length 3 specifying fixed parameters (NAs free parameters). names character vector parameter names. ... additional arguments passed gompertz.","code":""},{"path":"https://hreinwald.github.io/drc/reference/G.3u.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Three-parameter Gompertz model with upper limit fixed — G.3u","text":"list (see gompertz).","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/G.4.html","id":null,"dir":"Reference","previous_headings":"","what":"Four-parameter Gompertz model — G.4","title":"Four-parameter Gompertz model — G.4","text":"Convenience function full four-parameter Gompertz model.","code":""},{"path":"https://hreinwald.github.io/drc/reference/G.4.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Four-parameter Gompertz model — G.4","text":"","code":"G.4(fixed = c(NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/G.4.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Four-parameter Gompertz model — G.4","text":"fixed numeric vector length 4 specifying fixed parameters (NAs free parameters). names character vector parameter names. ... additional arguments passed gompertz.","code":""},{"path":"https://hreinwald.github.io/drc/reference/G.4.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Four-parameter Gompertz model — G.4","text":"list (see gompertz).","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/G.aparine.html","id":null,"dir":"Reference","previous_headings":"","what":"Herbicide applied to Galium aparine — G.aparine","title":"Herbicide applied to Galium aparine — G.aparine","text":"Small plants Galium aparine, growing pots green house, sprayed technical grade phenmidipham herbicide either alone mixture ester oleic acid. plants allowed grow green house 14 days herbicide treatment. dry matter measured per pot.","code":""},{"path":"https://hreinwald.github.io/drc/reference/G.aparine.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Herbicide applied to Galium aparine — G.aparine","text":"","code":"data(G.aparine)"},{"path":"https://hreinwald.github.io/drc/reference/G.aparine.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Herbicide applied to Galium aparine — G.aparine","text":"data frame 240 observations following 3 variables. dose numeric vector dose value (g/ha) drymatter numeric vector dry matter weights (mg/pot) treatment numeric vector giving grouping: 0: control, 1,2: herbicide formulations","code":""},{"path":"https://hreinwald.github.io/drc/reference/G.aparine.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Herbicide applied to Galium aparine — G.aparine","text":"Cabanne, F., Gaudry, J. C. Streibig, J. C. (1999) Influence alkyl oleates efficacy phenmedipham applied acetone:water solution Galium aparine, Weed Research, 39, 57–67.","code":""},{"path":"https://hreinwald.github.io/drc/reference/G.aparine.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Herbicide applied to Galium aparine — G.aparine","text":"","code":"library(drc) ## Fitting a model with a common control (so a single upper limit: \"1\") G.aparine.m1 <- drm(drymatter ~ dose, treatment, data = G.aparine, pmodels = data.frame(treatment, treatment, 1, treatment), fct = LL.4()) ## Visual inspection of fit plot(G.aparine.m1, broken = TRUE) ## Lack of fit test modelFit(G.aparine.m1) #> Lack-of-fit test #> #> ModelDf RSS Df F value p value #> ANOVA 219 2601788 #> DRC model 233 2891677 14 1.7429 0.0490 ## Summary output summary(G.aparine.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:1 1.61291 0.33330 4.8392 2.372e-06 *** #> b:2 1.75100 0.20392 8.5869 1.311e-15 *** #> c:1 509.50367 23.25885 21.9058 < 2.2e-16 *** #> c:2 151.91840 26.00899 5.8410 1.734e-08 *** #> d:(Intercept) 984.88779 12.63335 77.9594 < 2.2e-16 *** #> e:1 50.80009 7.87851 6.4479 6.467e-10 *** #> e:2 93.44626 8.11091 11.5211 < 2.2e-16 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 111.403 (233 degrees of freedom) ## Predicted values with se and confidence intervals #predict(G.aparine.m1, interval = \"confidence\") # long output ## Calculating the relative potency EDcomp(G.aparine.m1, c(50,50)) #> #> Estimated ratios of effect doses #> #> Estimate Std. Error t-value p-value #> 1/2:50/50 5.4363e-01 9.3972e-02 -4.8565e+00 2.1923e-06 ## Showing the relative potency as a ## function of the response level relpot(G.aparine.m1) relpot(G.aparine.m1, interval = \"delta\") # appears constant! ## Response level in percent relpot(G.aparine.m1, scale = \"percent\") ## Fitting a reduced model (with a common slope parameter) G.aparine.m2 <- drm(drymatter ~ dose, treatment, data = G.aparine, pmodels = data.frame(1, treatment, 1, treatment), fct = LL.4()) anova(G.aparine.m2, G.aparine.m1) #> #> 1st model #> fct: LL.4() #> pmodels: 1, treatment, 1, treatment #> 2nd model #> fct: LL.4() #> pmodels: treatment, treatment, 1, treatment #> #> ANOVA table #> #> ModelDf RSS Df F value p value #> 1st model 234 2893283 #> 2nd model 233 2891677 1 0.1294 0.7193 ## Showing the relative potency relpot(G.aparine.m2) ## Fitting the same model in a different parameterisation G.aparine.m3 <- drm(drymatter ~ dose, treatment, data = G.aparine, pmodels = data.frame(treatment, treatment, 1, treatment), fct = LL2.4()) EDcomp(G.aparine.m3, c(50, 50), logBase = exp(1)) #> #> Estimated ratios of effect doses #> #> Estimate Std. Error t-value p-value #> 1/2:50/50 5.4362e-01 9.3970e-02 -4.8567e+00 2.1904e-06"},{"path":"https://hreinwald.github.io/drc/reference/gammadr.html","id":null,"dir":"Reference","previous_headings":"","what":"Gamma Dose-Response Model — gammadr","title":"Gamma Dose-Response Model — gammadr","text":"four-parameter dose-response model derived cumulative distribution function gamma distribution. suitable increasing dose-response data.","code":""},{"path":"https://hreinwald.github.io/drc/reference/gammadr.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Gamma Dose-Response Model — gammadr","text":"","code":"gammadr( fixed = c(NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\"), fctName, fctText )"},{"path":"https://hreinwald.github.io/drc/reference/gammadr.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Gamma Dose-Response Model — gammadr","text":"fixed numeric vector specifying parameters fixed value fixed. NAs used parameters fixed. names vector character strings giving names parameters (contain \":\"). default reasonable. fctName optional character string used internally convenience functions. fctText optional character string used internally convenience functions.","code":""},{"path":"https://hreinwald.github.io/drc/reference/gammadr.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Gamma Dose-Response Model — gammadr","text":"list containing nonlinear function, self starter function, parameter names.","code":""},{"path":"https://hreinwald.github.io/drc/reference/gammadr.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Gamma Dose-Response Model — gammadr","text":"Following Wheeler Bailer (2009) model function : $$f(x) = c + (d-c) \\cdot \\mathrm{pgamma}(b \\cdot x, e, 1)$$","code":""},{"path":"https://hreinwald.github.io/drc/reference/gammadr.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Gamma Dose-Response Model — gammadr","text":"Wheeler, M. W., Bailer, . J. (2009) Comparing model averaging model selection strategies benchmark dose estimation, Environmental Ecological Statistics, 16, 37–51.","code":""},{"path":"https://hreinwald.github.io/drc/reference/gammadr.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Gamma Dose-Response Model — gammadr","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/gaussian.html","id":null,"dir":"Reference","previous_headings":"","what":"Normal (Gaussian) biphasic dose-response model — gaussian","title":"Normal (Gaussian) biphasic dose-response model — gaussian","text":"Model function fitting symmetric skewed bell-shaped/biphasic dose-response patterns using Gaussian (normal distribution) model.","code":""},{"path":"https://hreinwald.github.io/drc/reference/gaussian.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Normal (Gaussian) biphasic dose-response model — gaussian","text":"","code":"gaussian( fixed = c(NA, NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\", \"f\"), method = c(\"1\", \"2\", \"3\", \"4\"), ssfct = NULL, fctName, fctText, loge = FALSE )"},{"path":"https://hreinwald.github.io/drc/reference/gaussian.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Normal (Gaussian) biphasic dose-response model — gaussian","text":"fixed numeric vector. Specifies parameters fixed value fixed. NAs parameters fixed. names vector character strings giving names parameters (contain \":\"). order parameters : b, c, d, e, f. method character string indicating self starter function use. ssfct self starter function used. fctName optional character string used internally convenience functions. fctText optional character string used internally convenience functions. loge logical indicating whether e log(e) parameter model. default e model parameter.","code":""},{"path":"https://hreinwald.github.io/drc/reference/gaussian.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Normal (Gaussian) biphasic dose-response model — gaussian","text":"value returned list containing nonlinear function, self starter function parameter names.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/gaussian.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Normal (Gaussian) biphasic dose-response model — gaussian","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/gaussian.ssf.html","id":null,"dir":"Reference","previous_headings":"","what":"Self-starter for Gaussian model — gaussian.ssf","title":"Self-starter for Gaussian model — gaussian.ssf","text":"Self-starter Gaussian model","code":""},{"path":"https://hreinwald.github.io/drc/reference/gaussian.ssf.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Self-starter for Gaussian model — gaussian.ssf","text":"","code":"gaussian.ssf( method = c(\"1\", \"2\", \"3\", \"4\"), fixed, logg = FALSE, useFixed = FALSE )"},{"path":"https://hreinwald.github.io/drc/reference/germination.html","id":null,"dir":"Reference","previous_headings":"","what":"Germination of three crops — germination","title":"Germination of three crops — germination","text":"Germination data obtained experiments involving three species mungbean, rice, wheat, opposed different temperatures 10 40 degrees Celsius. Experiments lasted 18 days.","code":""},{"path":"https://hreinwald.github.io/drc/reference/germination.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Germination of three crops — germination","text":"","code":"data(germination)"},{"path":"https://hreinwald.github.io/drc/reference/germination.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Germination of three crops — germination","text":"data frame 192 observations following 5 variables. temp numeric vector temperatures seeds exposed species factor levels mungbean rice wheat start numeric vector left endpoints monitoring intervals end numeric vector right endpoints monitoring intervals germinated numeric vector giving numbers seeds germinated","code":""},{"path":"https://hreinwald.github.io/drc/reference/germination.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Germination of three crops — germination","text":"three species mungbean, rice, wheat, total 20 seeds uniformly distributed filter paper petri dish (diameter: 9.0cm) placed dark climate cabinets different temperatures (10, 16, 22, 28, 34, 40 degrees Celsius). temperatures applied species. germinated seeds counted removed petri dish daily basis 18 days (seeds germinated). n experiment also assume upper limit proportion germinated parameter estimated data. Moreover, assume different combinations species temperature may lead different germination curves respect slope, time required 50% germination, upper limit.","code":""},{"path":"https://hreinwald.github.io/drc/reference/germination.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Germination of three crops — germination","text":"Ritz, C., Pipper, C. B. Streibig, J. C. (2013) Analysis germination data agricultural experiments, Europ. J. Agronomy, 45, 1–6.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/germination.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Germination of three crops — germination","text":"","code":"library(drc) ## Fitting two-parameter log-logistic curves to each combination of species and temperature ## (upper limit fixed at 1) ## Note: Rows 24 and 62 are omitted from the dataset (all mungbean seeds germinated ## and thus no right-censoring in this case) ## germLL.2 <- drm(germinated ~ start + end, species:factor(temp), ## data = germination[c(1:23, 25:61, 63:192), ], fct = LL.2(), type = \"event\") ## plot(germLL.2, ylim=c(0, 1.5), legendPos=c(2.5,1.5)) # plotting the fitted curves and the data ## summary(germLL.2) # showing the parameter estimates ## Fitting two-parameter log-logistic curves to each combination of species and temperature ## Note: the argument \"start\" may be used for providing sensible initial ## parameter values for estimation procedure (is needed occasionally) ## (initial values were obtained from the model fit germLL.2) ## Note also: the argument \"upper\" ensures that the upper limit cannot exceed 1 ## (however, no restrictions are imposed on the two remaining parameters ## (as indicated by an infinite value) ## germLL.3 <- drm(germinated~start+end, species:factor(temp), ## data = germination[c(1:23, 25:61, 63:192), ], fct = LL.3(), type = \"event\", ## start = c(coef(germLL.2)[1:13], rep(0.7,13), coef(germLL.2)[14:26]), ## upper = c(rep(Inf, 13), rep(1, 13), rep(Inf, 13))) ## Plotting the fitted curves and the data ## plot(germLL.3, ylim = c(0, 1.5), legendPos = c(2.5,1.5)) ## Showing the parameter estimates ## summary(germLL.3) ## Showing the parameter estimates with robust standard errors ## library(lmtest) ## coeftest(germLL.3, vcov = sandwich) ## Calculating t50 with associated standard errors ## ED(germLL.3, 50) ## Calculating t10, t20, t50 with 95% confidence intervals ## ED(germLL.3, c(10, 20, 50), interval = \"delta\") ## Comparing t50 between combinations by means of approximate t-tests ## compParm(germLL.3, \"e\", \"-\") ## Making plots of fitted regression curves for each species ## Plot for mungbean #plot(germLL.3, log=\"\", ylim=c(0, 1), xlim=c(0, 20), #level=c(\"mungbean:10\", \"mungbean:16\"), #lty=2:3, lwd = 1.5, #xlab=\"Time (days)\", #ylab=\"Proportion germinated\", #main=\"Mungbean\", #legendPos=c(3, 1.05), legendText=c(expression(10*degree), expression(16*degree))) ## Plot for rice #plot(germLL.3, log=\"\", ylim=c(0, 1), xlim=c(0, 20), #level=c(\"rice:16\", \"rice:22\", \"rice:28\", \"rice:34\", \"rice:40\"), #lty=2:6, lwd = 1.5, #xlab=\"Time (days)\", #ylab=\"Proportion germinated\", #main=\"Rice\", #pch=2:6, #legendPos=c(3, 1.05), legendText=c(expression(16*degree), expression(22*degree), #expression(28*degree), expression(34*degree), expression(40*degree))) ## Plot for wheat #plot(germLL.3, log=\"\", ylim=c(0, 1), xlim=c(0, 20), #level=c(\"wheat:10\", \"wheat:16\", \"wheat:22\", \"wheat:28\", \"wheat:34\", \"wheat:40\"), #lty=c(\"dashed\",\"dotted\",\"dotdash\",\"longdash\",\"twodash\",\"232A\"), lwd = 1.5, #xlab=\"Time (days)\", #ylab=\"Proportion germinated\", #main=\"Wheat\", #legendPos=c(3, 1.05), #legendText=c(expression(10*degree), expression(16*degree), expression(22*degree), #expression(28*degree), expression(34*degree), expression(40*degree)))"},{"path":"https://hreinwald.github.io/drc/reference/getInitial.html","id":null,"dir":"Reference","previous_headings":"","what":"Showing starting values used — getInitial","title":"Showing starting values used — getInitial","text":"Returns starting values model parameters used fitting dose-response model.","code":""},{"path":"https://hreinwald.github.io/drc/reference/getInitial.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Showing starting values used — getInitial","text":"","code":"getInitial(object)"},{"path":"https://hreinwald.github.io/drc/reference/getInitial.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Showing starting values used — getInitial","text":"object object class 'drc'.","code":""},{"path":"https://hreinwald.github.io/drc/reference/getInitial.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Showing starting values used — getInitial","text":"vector starting values model parameters used initialize estimation procedure.","code":""},{"path":"https://hreinwald.github.io/drc/reference/getInitial.html","id":"note","dir":"Reference","previous_headings":"","what":"Note","title":"Showing starting values used — getInitial","text":"function masking standard function stats package.","code":""},{"path":"https://hreinwald.github.io/drc/reference/getInitial.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Showing starting values used — getInitial","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/getMeanFunctions.html","id":null,"dir":"Reference","previous_headings":"","what":"Display available dose-response models — getMeanFunctions","title":"Display available dose-response models — getMeanFunctions","text":"Display information available, built-dose-response models. arguments noParm fname can combined.","code":""},{"path":"https://hreinwald.github.io/drc/reference/getMeanFunctions.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Display available dose-response models — getMeanFunctions","text":"","code":"getMeanFunctions(noParm = NA, fname = NULL, flist = NULL, display = TRUE)"},{"path":"https://hreinwald.github.io/drc/reference/getMeanFunctions.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Display available dose-response models — getMeanFunctions","text":"noParm numeric specifying number parameters models displayed. default (NA) results display models, regardless number parameters. fname character string vector character strings specifying short name(s) models displayed (need match exactly). flist list built-functions displayed. display logical indicating whether requested models displayed R console.","code":""},{"path":"https://hreinwald.github.io/drc/reference/getMeanFunctions.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Display available dose-response models — getMeanFunctions","text":"invisible list functions list strings brief function descriptions.","code":""},{"path":"https://hreinwald.github.io/drc/reference/getMeanFunctions.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Display available dose-response models — getMeanFunctions","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/getMeanFunctions.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Display available dose-response models — getMeanFunctions","text":"","code":"## Listing all functions getMeanFunctions() #> Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 #> (2 parameters) #> In 'drc': LL.2 #> #> Log-logistic (ED50 as parameter) with lower limit at 0 #> (3 parameters) #> In 'drc': LL.3 #> #> Log-logistic (ED50 as parameter) with upper limit at 1 #> (3 parameters) #> In 'drc': LL.3u #> #> Log-logistic (ED50 as parameter) #> (4 parameters) #> In 'drc': LL.4 #> #> Generalized log-logistic (ED50 as parameter) #> (5 parameters) #> In 'drc': LL.5 #> #> Weibull (type 1) with lower limit at 0 and upper limit at 1 #> (2 parameters) #> In 'drc': W1.2 #> #> Weibull (type 1) with lower limit at 0 #> (3 parameters) #> In 'drc': W1.3 #> #> Weibull (type 1) #> (4 parameters) #> In 'drc': W1.4 #> #> Weibull (type 2) with lower limit at 0 and upper limit at 1 #> (2 parameters) #> In 'drc': W2.2 #> #> Weibull (type 2) with lower limit at 0 #> (3 parameters) #> In 'drc': W2.3 #> #> Weibull (type 2) #> (4 parameters) #> In 'drc': W2.4 #> #> Brain-Cousens (hormesis) with lower limit fixed at 0 #> (4 parameters) #> In 'drc': BC.4 #> #> Brain-Cousens (hormesis) #> (5 parameters) #> In 'drc': BC.5 #> #> Log-logistic (log(ED50) as parameter) with lower limit at 0 and upper limit at 1 #> (2 parameters) #> In 'drc': LL2.2 #> #> Log-logistic (log(ED50) as parameter) with lower limit at 0 #> (3 parameters) #> In 'drc': LL2.3 #> #> Log-logistic (log(ED50) as parameter) with upper limit at 1 #> (3 parameters) #> In 'drc': LL2.3u #> #> Log-logistic (log(ED50) as parameter) #> (4 parameters) #> In 'drc': LL2.4 #> #> Generalised log-logistic (log(ED50) as parameter) #> (5 parameters) #> In 'drc': LL2.5 #> #> Asymptotic regression with lower limit at 0 #> (2 parameters) #> In 'drc': AR.2 #> #> Shifted asymptotic regression #> (3 parameters) #> In 'drc': AR.3 #> #> Michaelis-Menten #> (2 parameters) #> In 'drc': MM.2 #> #> Shifted Michaelis-Menten #> (3 parameters) #> In 'drc': MM.3 #> ## Listing all functions with 4 parameters getMeanFunctions(4) #> Log-logistic (ED50 as parameter) #> (4 parameters) #> In 'drc': LL.4 #> #> Weibull (type 1) #> (4 parameters) #> In 'drc': W1.4 #> #> Weibull (type 2) #> (4 parameters) #> In 'drc': W2.4 #> #> Brain-Cousens (hormesis) with lower limit fixed at 0 #> (4 parameters) #> In 'drc': BC.4 #> #> Log-logistic (log(ED50) as parameter) #> (4 parameters) #> In 'drc': LL2.4 #> ## Listing all (log-)logistic functions getMeanFunctions(fname = \"L\") ## Listing all three-parameter (log-)logistic or Weibull functions getMeanFunctions(3, fname = c(\"LL\", \"W\"))"},{"path":"https://hreinwald.github.io/drc/reference/get_ed_interval.html","id":null,"dir":"Reference","previous_headings":"","what":"Select Appropriate Confidence Interval Method for a drc Model — get_ed_interval","title":"Select Appropriate Confidence Interval Method for a drc Model — get_ed_interval","text":"function determines recommended confidence interval calculation method ('type' argument drc::ED) based model family 'drc' object.","code":""},{"path":"https://hreinwald.github.io/drc/reference/get_ed_interval.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Select Appropriate Confidence Interval Method for a drc Model — get_ed_interval","text":"","code":"get_ed_interval( model, small_n = TRUE, fls_pattern = \"^LL|^LN|^BC|^CRS\", verbose = FALSE )"},{"path":"https://hreinwald.github.io/drc/reference/get_ed_interval.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Select Appropriate Confidence Interval Method for a drc Model — get_ed_interval","text":"model drc model object character string specifying model name (e.g., \"LL.4\"). small_n logical value. TRUE, t-distribution-based Fieller's method (\"tfls\") used small samples applicable models. FALSE, normal-distribution-based method (\"fls\") used. Defaults TRUE. fls_pattern regular expression character string. pattern used identify model families \"fls\" \"tfls\" method appropriate. default covers standard log-logistic, log-normal, Brain-Cousens, Cedergreen-Ritz-Streibig models. verbose logical value. TRUE, message printed function resorts default choice model type explicitly matched. Defaults TRUE.","code":""},{"path":"https://hreinwald.github.io/drc/reference/get_ed_interval.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Select Appropriate Confidence Interval Method for a drc Model — get_ed_interval","text":"character string: \"tfls\", \"fls\", \"delta\", representing recommended interval type use drc::ED().","code":""},{"path":"https://hreinwald.github.io/drc/reference/get_ed_interval.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Select Appropriate Confidence Interval Method for a drc Model — get_ed_interval","text":"Hannes Reinwald","code":""},{"path":"https://hreinwald.github.io/drc/reference/get_ed_interval.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Select Appropriate Confidence Interval Method for a drc Model — get_ed_interval","text":"","code":"ryegrass_model <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) drc:::get_ed_interval(ryegrass_model) #> [1] \"tfls\" drc:::get_ed_interval(\"LL.4\") #> [1] \"tfls\" drc:::get_ed_interval(\"W1.4\") #> [1] \"delta\""},{"path":"https://hreinwald.github.io/drc/reference/GiantKelp.html","id":null,"dir":"Reference","previous_headings":"","what":"Measurements of germination tubes for Giant Kelp — GiantKelp","title":"Measurements of germination tubes for Giant Kelp — GiantKelp","text":"Giant kelp, Macrocystis pyrifera, exposed 8 different concentrations copper response measured length germination tube.","code":""},{"path":"https://hreinwald.github.io/drc/reference/GiantKelp.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Measurements of germination tubes for Giant Kelp — GiantKelp","text":"","code":"data(GiantKelp)"},{"path":"https://hreinwald.github.io/drc/reference/GiantKelp.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Measurements of germination tubes for Giant Kelp — GiantKelp","text":"data frame 39 observations following 2 variables. dose numeric vector tubeLength numeric vector giving length germination tube (mm)","code":""},{"path":"https://hreinwald.github.io/drc/reference/GiantKelp.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Measurements of germination tubes for Giant Kelp — GiantKelp","text":"G. . Chapman, D. L. Denton, J. M. Lazorchak (1995). Short-term methods estimating chronic toxicity effluents receiving waters west coast marine estuarine organisms.","code":""},{"path":"https://hreinwald.github.io/drc/reference/GiantKelp.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Measurements of germination tubes for Giant Kelp — GiantKelp","text":"","code":"library(drc) ## Displaying the data head(GiantKelp) #> tubeLength dose #> 1 19.58 0.0 #> 2 18.75 0.0 #> 3 19.14 0.0 #> 4 16.50 0.0 #> 5 17.93 0.0 #> 6 18.26 5.6 ## Fitting a four-parameter log-logistic model GiantKelp.m1 <- drm(tubeLength ~ dose, data = GiantKelp, fct = LL.4()) summary(GiantKelp.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 1.19476 0.45955 2.5999 0.01357 * #> c:(Intercept) 4.46327 3.46849 1.2868 0.20661 #> d:(Intercept) 18.08505 0.77922 23.2090 < 2e-16 *** #> e:(Intercept) 53.86481 25.46202 2.1155 0.04158 * #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 1.688897 (35 degrees of freedom) ## Plotting the fitted curve plot(GiantKelp.m1, xlab = \"Copper concentration\", ylab = \"Tube length (mm)\")"},{"path":"https://hreinwald.github.io/drc/reference/glymet.html","id":null,"dir":"Reference","previous_headings":"","what":"Glyphosate and metsulfuron-methyl tested on algae. — glymet","title":"Glyphosate and metsulfuron-methyl tested on algae. — glymet","text":"dataset 7 mixtures, 8 dilutions, two replicates 5 common control controls. Four observations missing, giving total 113 observations.","code":""},{"path":"https://hreinwald.github.io/drc/reference/glymet.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Glyphosate and metsulfuron-methyl tested on algae. — glymet","text":"","code":"data(glymet)"},{"path":"https://hreinwald.github.io/drc/reference/glymet.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Glyphosate and metsulfuron-methyl tested on algae. — glymet","text":"data frame 113 observations following 3 variables. dose numeric vector dose values pct numeric vector denoting grouping according mixtures percentages rgr numeric vector response values (relative growth rates)","code":""},{"path":"https://hreinwald.github.io/drc/reference/glymet.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Glyphosate and metsulfuron-methyl tested on algae. — glymet","text":"dataset analysed Soerensen et al (2007). concentration addition model can entertained dataset.","code":""},{"path":"https://hreinwald.github.io/drc/reference/glymet.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Glyphosate and metsulfuron-methyl tested on algae. — glymet","text":"dataset kindly provided Nina Cedergreen, Department Agricultural Sciences, Royal Veterinary Agricultural University, Denmark.","code":""},{"path":"https://hreinwald.github.io/drc/reference/glymet.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Glyphosate and metsulfuron-methyl tested on algae. — glymet","text":"Soerensen, H. Cedergreen, N. Skovgaard, . M. Streibig, J. C. (2007) isobole-based statistical model test synergism/antagonism binary mixture toxicity experiments, Environmental Ecological Statistics, 14, 383–397.","code":""},{"path":"https://hreinwald.github.io/drc/reference/glymet.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Glyphosate and metsulfuron-methyl tested on algae. — glymet","text":"","code":"library(drc) ## Fitting the model with freely varying ED50 values glymet.free <- drm(rgr~dose, pct, data = glymet, fct = LL.3(), pmodels = list(~factor(pct) , ~1, ~factor(pct))) #> Control measurements detected for level: 999 ## Lack-of-fit test modelFit(glymet.free) # acceptable #> Lack-of-fit test #> #> ModelDf RSS Df F value p value #> ANOVA 57 0.65695 #> DRC model 98 1.35177 41 1.4704 0.0885 summary(glymet.free) #> #> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:100 1.6452e+00 2.0683e-01 7.9547 3.169e-12 *** #> b:83 1.8276e+00 2.3584e-01 7.7492 8.663e-12 *** #> b:67 1.0654e+00 1.1840e-01 8.9983 1.812e-14 *** #> b:50 1.2324e+00 1.4031e-01 8.7834 5.262e-14 *** #> b:33 1.3676e+00 1.6478e-01 8.2992 5.809e-13 *** #> b:17 1.0100e+00 1.2156e-01 8.3090 5.534e-13 *** #> b:0 7.1041e-01 9.2251e-02 7.7008 1.097e-11 *** #> d:(Intercept) 1.6191e+00 2.5370e-02 63.8198 < 2.2e-16 *** #> e:100 1.3332e+05 1.1477e+04 11.6158 < 2.2e-16 *** #> e:83 1.6102e+05 1.3111e+04 12.2806 < 2.2e-16 *** #> e:67 1.6150e+05 1.8071e+04 8.9375 2.443e-14 *** #> e:50 1.4098e+05 1.4342e+04 9.8302 3.634e-16 *** #> e:33 1.2494e+05 1.1922e+04 10.4800 < 2.2e-16 *** #> e:17 1.7018e+05 1.9524e+04 8.7164 7.336e-14 *** #> e:0 1.2814e+05 1.8568e+04 6.9011 5.140e-10 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.1174459 (98 degrees of freedom) ## Plotting isobole structure isobole(glymet.free, exchange=0.01) ## Fitting the concentration addition model glymet.ca <- mixture(glymet.free, model = \"CA\") #> Warning: Using formula(x) is deprecated when x is a character vector of length > 1. #> Consider formula(paste(x, collapse = \" \")) instead. #> Control measurements detected for level: 999 ## Comparing to model with freely varying e parameter anova(glymet.ca, glymet.free) # borderline accepted #> #> 1st model #> fct: CA model #> pmodels: ~~~factor(pct), ~1, ~I(1/(pct/100)) - 1, ~I(1/(1 - pct/100)) - 1 #> 2nd model #> fct: LL.3() #> pmodels: ~factor(pct), ~1, ~factor(pct) #> #> ANOVA table #> #> ModelDf RSS Df F value p value #> 1st model 103 1.4865 #> 2nd model 98 1.3518 5 1.9532 0.0924 ## Plotting isobole based on concentration addition isobole(glymet.free, glymet.ca, exchange = 0.01) # acceptable fit ## Fitting the Hewlett model glymet.hew <- mixture(glymet.free, model = \"Hewlett\") #> Warning: Using formula(x) is deprecated when x is a character vector of length > 1. #> Consider formula(paste(x, collapse = \" \")) instead. #> Control measurements detected for level: 999 ### Comparing to model with freely varying e parameter anova(glymet.ca, glymet.hew) #> #> 1st model #> fct: CA model #> pmodels: ~~~factor(pct), ~1, ~I(1/(pct/100)) - 1, ~I(1/(1 - pct/100)) - 1 #> 2nd model #> fct: Hewlett model #> pmodels: ~~~factor(pct), ~1, ~I(1/(pct/100)) - 1, ~I(1/(1 - pct/100)) - 1, ~1 #> #> ANOVA table #> #> ModelDf RSS Df F value p value #> 1st model 103 1.4865 #> 2nd model 102 1.4730 1 0.9360 0.3356 # borderline accepted # the Hewlett model offers no improvement over concentration addition ## Plotting isobole based on the Hewlett model isobole(glymet.free, glymet.hew, exchange = 0.01) # no improvement over concentration addition"},{"path":"https://hreinwald.github.io/drc/reference/gompertz.html","id":null,"dir":"Reference","previous_headings":"","what":"Gompertz dose-response or growth curve model — gompertz","title":"Gompertz dose-response or growth curve model — gompertz","text":"Provides general way specifying mean function decreasing increasing Gompertz dose-response growth curve models.","code":""},{"path":"https://hreinwald.github.io/drc/reference/gompertz.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Gompertz dose-response or growth curve model — gompertz","text":"","code":"gompertz( fixed = c(NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\"), method = c(\"1\", \"2\", \"3\", \"4\"), ssfct = NULL, fctName, fctText )"},{"path":"https://hreinwald.github.io/drc/reference/gompertz.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Gompertz dose-response or growth curve model — gompertz","text":"fixed numeric vector. Specifies parameters fixed value fixed. NAs parameters fixed. names vector character strings giving names parameters (contain \":\"). order parameters : b, c, d, e. method character string indicating self starter function use. ssfct self starter function used. fctName optional character string used internally convenience functions. fctText optional character string used internally convenience functions.","code":""},{"path":"https://hreinwald.github.io/drc/reference/gompertz.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Gompertz dose-response or growth curve model — gompertz","text":"list containing non-linear function, self starter function parameter names.","code":""},{"path":"https://hreinwald.github.io/drc/reference/gompertz.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Gompertz dose-response or growth curve model — gompertz","text":"Gompertz model given mean function $$f(x) = c + (d-c)(\\exp(-\\exp(b(x-e))))$$ \\(b<0\\) mean function increasing; decreasing \\(b>0\\).","code":""},{"path":"https://hreinwald.github.io/drc/reference/gompertz.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Gompertz dose-response or growth curve model — gompertz","text":"Seber, G. . F. Wild, C. J. (1989) Nonlinear Regression, New York: Wiley & Sons (p. 331).","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/gompertz.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Gompertz dose-response or growth curve model — gompertz","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/gompertz.ssf.html","id":null,"dir":"Reference","previous_headings":"","what":"Self-starter for Gompertz model — gompertz.ssf","title":"Self-starter for Gompertz model — gompertz.ssf","text":"Self-starter Gompertz model","code":""},{"path":"https://hreinwald.github.io/drc/reference/gompertz.ssf.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Self-starter for Gompertz model — gompertz.ssf","text":"","code":"gompertz.ssf(method = c(\"1\", \"2\", \"3\", \"4\"), fixed, useFixed = FALSE)"},{"path":"https://hreinwald.github.io/drc/reference/gompertzd.html","id":null,"dir":"Reference","previous_headings":"","what":"Derivative of the Gompertz function — gompertzd","title":"Derivative of the Gompertz function — gompertzd","text":"gompertzd provides way specifying derivative Gompertz function dose-response model.","code":""},{"path":"https://hreinwald.github.io/drc/reference/gompertzd.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Derivative of the Gompertz function — gompertzd","text":"","code":"gompertzd(fixed = c(NA, NA), names = c(\"a\", \"b\"))"},{"path":"https://hreinwald.github.io/drc/reference/gompertzd.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Derivative of the Gompertz function — gompertzd","text":"fixed numeric vector. Specifies parameters fixed value fixed. NAs parameters fixed. names vector character strings giving names parameters (contain \":\"). default (notice order): , b.","code":""},{"path":"https://hreinwald.github.io/drc/reference/gompertzd.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Derivative of the Gompertz function — gompertzd","text":"list containing model function, self starter function parameter names.","code":""},{"path":"https://hreinwald.github.io/drc/reference/gompertzd.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Derivative of the Gompertz function — gompertzd","text":"derivative Gompertz function defined $$f(x) = \\exp(bx-/b(\\exp(bx)-1))$$ \\(>0\\) \\(b\\) 0, function decreasing, equaling \\(\\) \\(x=0\\) approaching 0 plus infinity.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/gompertzd.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Derivative of the Gompertz function — gompertzd","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/guthion.html","id":null,"dir":"Reference","previous_headings":"","what":"guthion — guthion","title":"guthion — guthion","text":"Data acute toxicity test insecticide guthion (azinphos-methyl). dose level two treatment groups, numbers alive, moribund, dead subjects recorded.","code":""},{"path":"https://hreinwald.github.io/drc/reference/guthion.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"guthion — guthion","text":"","code":"data(guthion)"},{"path":"https://hreinwald.github.io/drc/reference/guthion.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"guthion — guthion","text":"data frame 6 observations following 6 variables. trt categorial vector dose numeric vector alive numeric vector moribund numeric vector dead numeric vector total numeric vector","code":""},{"path":"https://hreinwald.github.io/drc/reference/guthion.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"guthion — guthion","text":"","code":"library(drc) ## Displaying the data head(guthion) #> trt dose alive moribund dead total #> 1 S 20.0 44 1 5 50 #> 2 S 35.0 28 1 21 50 #> 3 S 45.0 8 7 35 50 #> 4 T 1.0 37 1 12 50 #> 5 T 1.5 20 2 28 50 #> 6 T 2.0 8 6 36 50 ## Fitting a two-parameter log-logistic model for binomial response guthion.m1 <- drm(dead/total ~ dose, trt, weights = total, data = guthion, fct = LL.2(), type = \"binomial\") summary(guthion.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:S -3.768548 0.712361 -5.2902 1.222e-07 *** #> b:T -3.051117 0.656853 -4.6451 3.400e-06 *** #> e:S 36.891558 1.887823 19.5418 < 2.2e-16 *** #> e:T 1.432554 0.083677 17.1201 < 2.2e-16 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## Plotting the fitted curves plot(guthion.m1, xlab = \"Dose\", ylab = \"Proportion dead\", ylim = c(0, 1))"},{"path":"https://hreinwald.github.io/drc/reference/H.virescens.html","id":null,"dir":"Reference","previous_headings":"","what":"Mortality of tobacco budworms — H.virescens","title":"Mortality of tobacco budworms — H.virescens","text":"three days, moths tobacco budworm (Heliothis virescens) exposed doses pyrethroid trans-cypermethrin.","code":""},{"path":"https://hreinwald.github.io/drc/reference/H.virescens.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Mortality of tobacco budworms — H.virescens","text":"","code":"data(H.virescens)"},{"path":"https://hreinwald.github.io/drc/reference/H.virescens.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Mortality of tobacco budworms — H.virescens","text":"data frame 12 observations following 4 variables. dose numeric vector dose values (\\(\\mu g\\)) numdead numeric vector dead knocked-moths total numeric vector total number moths sex factor levels F M denoting grouping according sex","code":""},{"path":"https://hreinwald.github.io/drc/reference/H.virescens.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Mortality of tobacco budworms — H.virescens","text":"Venables Ripley (2002), data analysed using logistic regression base-2 logarithm dose explanatory variable.","code":""},{"path":"https://hreinwald.github.io/drc/reference/H.virescens.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Mortality of tobacco budworms — H.virescens","text":"Venables, W. N. Ripley, B. D (2002) Modern Applied Statistics S, New York: Springer (fourth edition).","code":""},{"path":"https://hreinwald.github.io/drc/reference/H.virescens.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Mortality of tobacco budworms — H.virescens","text":"","code":"library(drc) ## Fitting dose-response model (log-logistic with common slope) Hv.m1 <- drm(numdead/total~dose, sex, weights = total, data = H.virescens, fct = LL.2(), pmodels = list(~ 1, ~ sex - 1), type = \"binomial\") summary(Hv.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) -1.53537 0.18911 -8.1189 4.573e-16 *** #> e:sexF 9.60556 1.52990 6.2786 3.417e-10 *** #> e:sexM 4.69001 0.73465 6.3840 1.725e-10 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## Fitting the same model as in Venables and Riply (2002) Hv.m2 <- glm(cbind(numdead, total-numdead) ~ sex + I(log2(dose)) - 1, data = H.virescens, family = binomial) ## Comparing the fits logLik(Hv.m1) #> 'log Lik.' -18.43373 (df=3) logLik(Hv.m2) #> 'log Lik.' -18.43373 (df=3) ## Estimated ED values (matching those given in MASS) ED(Hv.m1, c(25, 50, 75)) #> #> Estimated effective doses #> #> Estimate Std. Error #> e:F:25 4.69645 0.81353 #> e:F:50 9.60556 1.52990 #> e:F:75 19.64607 3.74120 #> e:M:25 2.29309 0.41882 #> e:M:50 4.69001 0.73465 #> e:M:75 9.59239 1.69565"},{"path":"https://hreinwald.github.io/drc/reference/hatvalues.drc.html","id":null,"dir":"Reference","previous_headings":"","what":"Model diagnostics for nonlinear dose-response models — hatvalues.drc","title":"Model diagnostics for nonlinear dose-response models — hatvalues.drc","text":"Hat values (leverage values) provided nonlinear dose-response model fits using formulas linear regression based corresponding approximate quantities available nonlinear models.","code":""},{"path":"https://hreinwald.github.io/drc/reference/hatvalues.drc.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Model diagnostics for nonlinear dose-response models — hatvalues.drc","text":"","code":"# S3 method for class 'drc' hatvalues(model, ...)"},{"path":"https://hreinwald.github.io/drc/reference/hatvalues.drc.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Model diagnostics for nonlinear dose-response models — hatvalues.drc","text":"model object class 'drc'. ... additional arguments (used).","code":""},{"path":"https://hreinwald.github.io/drc/reference/hatvalues.drc.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Model diagnostics for nonlinear dose-response models — hatvalues.drc","text":"vector leverage values (hat values), one value per observation.","code":""},{"path":"https://hreinwald.github.io/drc/reference/hatvalues.drc.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Model diagnostics for nonlinear dose-response models — hatvalues.drc","text":"Hat values calculated using formula given Cook et al. (1986) McCullagh Nelder (1989). output values can assessed way linear regression.","code":""},{"path":"https://hreinwald.github.io/drc/reference/hatvalues.drc.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Model diagnostics for nonlinear dose-response models — hatvalues.drc","text":"Cook, R. D. Tsai, C.-L. Wei, B. C. (1986) Bias Nonlinear Regression, Biometrika 73, 615–623. McCullagh, P. Nelder, J. . (1989) Generalized Linear Models, Second edition, Chapman & Hall/CRC.","code":""},{"path":"https://hreinwald.github.io/drc/reference/hatvalues.drc.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Model diagnostics for nonlinear dose-response models — hatvalues.drc","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/hatvalues.drc.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Model diagnostics for nonlinear dose-response models — hatvalues.drc","text":"","code":"ryegrass.LL.4 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) hatvalues(ryegrass.LL.4) #> 1 2 3 4 5 6 7 #> 0.13332342 0.13332342 0.13332342 0.13332342 0.13332342 0.13332342 0.09539668 #> 8 9 10 11 12 13 14 #> 0.09539668 0.09539668 0.27948291 0.27948291 0.27948291 0.28191831 0.28191831 #> 15 16 17 18 19 20 21 #> 0.28191831 0.12467564 0.12467564 0.12467564 0.12949336 0.12949336 0.12949336 #> 22 23 24 #> 0.15571960 0.15571960 0.15571960"},{"path":"https://hreinwald.github.io/drc/reference/heartrate.html","id":null,"dir":"Reference","previous_headings":"","what":"Heart rate baroreflexes for rabbits — heartrate","title":"Heart rate baroreflexes for rabbits — heartrate","text":"dataset contains measurements mean arterial pressure (mmHG) heart rate (b/min) baroreflex curve.","code":""},{"path":"https://hreinwald.github.io/drc/reference/heartrate.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Heart rate baroreflexes for rabbits — heartrate","text":"","code":"data(heartrate)"},{"path":"https://hreinwald.github.io/drc/reference/heartrate.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Heart rate baroreflexes for rabbits — heartrate","text":"data frame 18 observations following 2 variables. pressure numeric vector containing measurements arterial pressure. rate numeric vector containing measurements heart rate.","code":""},{"path":"https://hreinwald.github.io/drc/reference/heartrate.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Heart rate baroreflexes for rabbits — heartrate","text":"dataset example asymmetric dose-response curve, easily handled using log-logistic Weibull models.","code":""},{"path":"https://hreinwald.github.io/drc/reference/heartrate.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Heart rate baroreflexes for rabbits — heartrate","text":"Ricketts, J. H. Head, G. . (1999) five-parameter logistic equation investigating asymmetry curvature baroreflex studies, . J. Physiol. (Regulatory Integrative Comp. Physiol. 46), 277, 441–454.","code":""},{"path":"https://hreinwald.github.io/drc/reference/heartrate.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Heart rate baroreflexes for rabbits — heartrate","text":"","code":"library(drc) ## Fitting the baro5 model heartrate.m1 <- drm(rate~pressure, data=heartrate, fct=baro5()) plot(heartrate.m1) coef(heartrate.m1) #> b1:(Intercept) b2:(Intercept) c:(Intercept) d:(Intercept) e:(Intercept) #> 11.07984 46.67492 150.33588 351.29613 75.59392 #Output: #b1:(Intercept) b2:(Intercept) c:(Intercept) d:(Intercept) e:(Intercept) # 11.07984 46.67492 150.33588 351.29613 75.59392 ## Inserting the estimated baro5 model function in deriv() baro5Derivative <- deriv(~ 150.33588 + ((351.29613 - 150.33588)/ (1 + (1/(1 + exp((2 * 11.07984 * 46.67492/(11.07984 + 46.67492)) * (log(x) - log(75.59392 ))))) * (exp(11.07984 * (log(x) - log(75.59392)))) + (1 - (1/(1 + exp((2 * 11.07984 * 46.67492/(11.07984 + 46.67492)) * (log(x) - log(75.59392 )))))) * (exp(46.67492 * (log(x) - log(75.59392 )))))), \"x\", function(x){}) ## Plotting the derivative #pressureVector <- 50:100 pressureVector <- seq(50, 100, length.out=300) derivativeVector <- attr(baro5Derivative(pressureVector), \"gradient\") plot(pressureVector, derivativeVector, type = \"l\") ## Finding the minimum pressureVector[which.min(derivativeVector)] #> [1] 76.92308"},{"path":"https://hreinwald.github.io/drc/reference/hewlett.html","id":null,"dir":"Reference","previous_headings":"","what":"Hewlett Mixture Model — hewlett","title":"Hewlett Mixture Model — hewlett","text":"Provides Hewlett model describing joint action two compounds binary mixture experiments. Used internally mixture.","code":""},{"path":"https://hreinwald.github.io/drc/reference/hewlett.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Hewlett Mixture Model — hewlett","text":"","code":"hewlett( fixed = c(NA, NA, NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\", \"f\", \"g\"), method = c(\"1\", \"2\", \"3\", \"4\"), ssfct = NULL, eps = 1e-10 )"},{"path":"https://hreinwald.github.io/drc/reference/hewlett.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Hewlett Mixture Model — hewlett","text":"fixed numeric vector. Specifies parameters fixed value fixed. NAs parameters fixed. names vector character strings giving names parameters (contain \":\"). method character string indicating self starter function use. ssfct self starter function used (optional). eps numeric tolerance handling zero dose values.","code":""},{"path":"https://hreinwald.github.io/drc/reference/hewlett.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Hewlett Mixture Model — hewlett","text":"list containing nonlinear model function, self starter function, parameter names.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/hewlett.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Hewlett Mixture Model — hewlett","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/idrm.html","id":null,"dir":"Reference","previous_headings":"","what":"Interactive dose-response modelling — idrm","title":"Interactive dose-response modelling — idrm","text":"Interactive dose-response modelling","code":""},{"path":"https://hreinwald.github.io/drc/reference/idrm.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Interactive dose-response modelling — idrm","text":"","code":"idrm(x, y, curveid, weights, fct, type, control)"},{"path":"https://hreinwald.github.io/drc/reference/isobole.html","id":null,"dir":"Reference","previous_headings":"","what":"Creating isobolograms — isobole","title":"Creating isobolograms — isobole","text":"isobole displays isobole based EC/ED50 estimates log-logistic model. Additionally isoboles determined concentration addition model, Hewlett's model Voelund's model can added plot.","code":""},{"path":"https://hreinwald.github.io/drc/reference/isobole.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Creating isobolograms — isobole","text":"","code":"isobole( object1, object2, exchange = 1, cifactor = 2, ename = \"e\", xaxis = \"100\", xlab, ylab, xlim, ylim, ... )"},{"path":"https://hreinwald.github.io/drc/reference/isobole.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Creating isobolograms — isobole","text":"object1 object class 'drc' EC/ED50 parameters vary freely. object2 object class 'drc' EC/ED50 parameters vary according Hewlett's model. exchange numeric. exchange rate two substances. cifactor numeric. factor used confidence intervals. Default 2, 1 used publications. ename character string. name EC/ED50 variable. xaxis character string. mixture \"0:100\" \"100:0\" x axis? xlab optional label x axis. ylab optional label y axis. xlim numeric vector length two, containing lower upper limit x axis. ylim numeric vector length two, containing lower upper limit y axis. ... Additional graphical parameters.","code":""},{"path":"https://hreinwald.github.io/drc/reference/isobole.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Creating isobolograms — isobole","text":"value returned. used side effect: isobologram shown.","code":""},{"path":"https://hreinwald.github.io/drc/reference/isobole.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Creating isobolograms — isobole","text":"model fits supplied first optionally second argument obtained using mixture drm.","code":""},{"path":"https://hreinwald.github.io/drc/reference/isobole.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Creating isobolograms — isobole","text":"Ritz, C. Streibig, J. C. (2014) additivity synergism - modelling perspective Synergy, 1, 22–29.","code":""},{"path":"https://hreinwald.github.io/drc/reference/isobole.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Creating isobolograms — isobole","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/L.3.html","id":null,"dir":"Reference","previous_headings":"","what":"Three-parameter logistic model — L.3","title":"Three-parameter logistic model — L.3","text":"three-parameter logistic model lower limit fixed 0, given $$f(x) = \\frac{d}{1 + \\exp(b(x - e))}$$","code":""},{"path":"https://hreinwald.github.io/drc/reference/L.3.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Three-parameter logistic model — L.3","text":"","code":"L.3(fixed = c(NA, NA, NA), names = c(\"b\", \"d\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/L.3.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Three-parameter logistic model — L.3","text":"fixed numeric vector length 3. Specifies parameters fixed value fixed. NA indicates corresponding parameter fixed. names character vector length 3 giving names parameters (b, d, e). Default c(\"b\", \"d\", \"e\"). ... additional arguments passed logistic.","code":""},{"path":"https://hreinwald.github.io/drc/reference/L.3.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Three-parameter logistic model — L.3","text":"list class \"Boltzmann\" containing nonlinear function, self starter function, parameter names.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/L.3.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Three-parameter logistic model — L.3","text":"","code":"ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = L.3())"},{"path":"https://hreinwald.github.io/drc/reference/L.4.html","id":null,"dir":"Reference","previous_headings":"","what":"Four-parameter logistic model — L.4","title":"Four-parameter logistic model — L.4","text":"four-parameter logistic model (symmetric, f = 1), given $$f(x) = c + \\frac{d - c}{1 + \\exp(b(x - e))}$$","code":""},{"path":"https://hreinwald.github.io/drc/reference/L.4.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Four-parameter logistic model — L.4","text":"","code":"L.4(fixed = c(NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/L.4.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Four-parameter logistic model — L.4","text":"fixed numeric vector length 4. Specifies parameters fixed value fixed. NA indicates corresponding parameter fixed. names character vector length 4 giving names parameters (b, c, d, e). Default c(\"b\", \"c\", \"d\", \"e\"). ... additional arguments passed logistic.","code":""},{"path":"https://hreinwald.github.io/drc/reference/L.4.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Four-parameter logistic model — L.4","text":"list class \"Boltzmann\" containing nonlinear function, self starter function, parameter names.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/L.4.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Four-parameter logistic model — L.4","text":"","code":"ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = L.4())"},{"path":"https://hreinwald.github.io/drc/reference/L.5.html","id":null,"dir":"Reference","previous_headings":"","what":"Five-parameter generalized logistic model — L.5","title":"Five-parameter generalized logistic model — L.5","text":"five-parameter generalized logistic model (asymmetric f != 1), given $$f(x) = c + \\frac{d - c}{(1 + \\exp(b(x - e)))^f}$$","code":""},{"path":"https://hreinwald.github.io/drc/reference/L.5.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Five-parameter generalized logistic model — L.5","text":"","code":"L.5(fixed = c(NA, NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\", \"f\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/L.5.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Five-parameter generalized logistic model — L.5","text":"fixed numeric vector length 5. Specifies parameters fixed value fixed. NA indicates corresponding parameter fixed. names character vector length 5 giving names parameters (b, c, d, e, f). Default c(\"b\", \"c\", \"d\", \"e\", \"f\"). ... additional arguments passed logistic.","code":""},{"path":"https://hreinwald.github.io/drc/reference/L.5.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Five-parameter generalized logistic model — L.5","text":"list class \"Boltzmann\" containing nonlinear function, self starter function, parameter names.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/L.5.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Five-parameter generalized logistic model — L.5","text":"","code":"ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = L.5())"},{"path":"https://hreinwald.github.io/drc/reference/leaflength.html","id":null,"dir":"Reference","previous_headings":"","what":"Leaf length of barley — leaflength","title":"Leaf length of barley — leaflength","text":"experiment barley grown hydroponic solution herbicide.","code":""},{"path":"https://hreinwald.github.io/drc/reference/leaflength.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Leaf length of barley — leaflength","text":"","code":"data(leaflength)"},{"path":"https://hreinwald.github.io/drc/reference/leaflength.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Leaf length of barley — leaflength","text":"data frame 42 observations following 2 variables. Dose numeric vector DW numeric vector","code":""},{"path":"https://hreinwald.github.io/drc/reference/leaflength.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Leaf length of barley — leaflength","text":"dataset exhibits large hormetical effect.","code":""},{"path":"https://hreinwald.github.io/drc/reference/leaflength.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Leaf length of barley — leaflength","text":"Nina Cedergreen, Royal Veterinary Agricultural University, Denmark.","code":""},{"path":"https://hreinwald.github.io/drc/reference/leaflength.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Leaf length of barley — leaflength","text":"","code":"library(drc) ## Fitting a hormesis model leaflength.crs4c1 <- drm(DW ~ Dose, data = leaflength, fct = CRS.4c()) plot(fitted(leaflength.crs4c1), residuals(leaflength.crs4c1)) leaflength.crs4c2 <- boxcox(drm(DW ~ Dose, data = leaflength, fct = CRS.4c()), method = \"anova\", plotit = FALSE) summary(leaflength.crs4c2) #> #> Model fitted: Cedergreen-Ritz-Streibig with lower limit 0 (alpha=0.25) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 0.489758 0.030686 15.9603 < 2.2e-16 *** #> d:(Intercept) 10.020054 1.590491 6.3000 2.209e-07 *** #> e:(Intercept) 0.019138 0.028983 0.6603 0.5130 #> f:(Intercept) 381.722590 234.463424 1.6281 0.1118 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 1.188513 (38 degrees of freedom) #> #> Non-normality/heterogeneity adjustment through Box-Cox transformation #> #> Estimated lambda: 0.5 #> Confidence interval for lambda: [0.420,0.785] #> ## Plottinf fitted curve and original data plot(leaflength.crs4c2, broken = TRUE, conLevel = 0.001, type = \"all\", legend = FALSE, ylab = \"Produced leaf length (cm)\", xlab = \"Metsulfuron-methyl (mg/l)\", main = \"Hormesis: leaf length of barley\") #> Warning: \"conLevel\" is not a graphical parameter #> Warning: \"conLevel\" is not a graphical parameter #> Warning: \"conLevel\" is not a graphical parameter #> Warning: \"conLevel\" is not a graphical parameter #> Warning: \"conLevel\" is not a graphical parameter"},{"path":"https://hreinwald.github.io/drc/reference/leaveOneOut.html","id":null,"dir":"Reference","previous_headings":"","what":"Model-robust dose-response modelling — leaveOneOut","title":"Model-robust dose-response modelling — leaveOneOut","text":"Model-robust dose-response modelling","code":""},{"path":"https://hreinwald.github.io/drc/reference/leaveOneOut.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Model-robust dose-response modelling — leaveOneOut","text":"","code":"leaveOneOut(object1, object2, dose, dataSet, resp, fixedEnd)"},{"path":"https://hreinwald.github.io/drc/reference/lemna.html","id":null,"dir":"Reference","previous_headings":"","what":"Lemna — lemna","title":"Lemna — lemna","text":"Data dose-response experiment aquatic plant Lemna minor (duckweed). response measured frond number (count) different concentrations test substance.","code":""},{"path":"https://hreinwald.github.io/drc/reference/lemna.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Lemna — lemna","text":"","code":"data(lemna)"},{"path":"https://hreinwald.github.io/drc/reference/lemna.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Lemna — lemna","text":"data frame 44 observations following 2 variables. conc numeric vector containing concentration. frond.num numeric vector containing response (count).","code":""},{"path":"https://hreinwald.github.io/drc/reference/lemna.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Lemna — lemna","text":"","code":"library(drc) ## Displaying the data head(lemna) #> conc frond.num #> 1 0 70 #> 2 0 66 #> 3 0 61 #> 4 0 65 #> 5 0 65 #> 6 0 61 ## Fitting a four-parameter log-logistic model lemna.m1 <- drm(frond.num ~ conc, data = lemna, fct = LL.4()) summary(lemna.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 0.80378 0.13342 6.0246 4.364e-07 *** #> c:(Intercept) 25.12544 4.10027 6.1278 3.125e-07 *** #> d:(Intercept) 65.67420 1.09101 60.1957 < 2.2e-16 *** #> e:(Intercept) 10.05380 3.20991 3.1321 0.003241 ** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 3.240232 (40 degrees of freedom) ## Plotting the fitted curve plot(lemna.m1, xlab = \"Concentration\", ylab = \"Frond number\")"},{"path":"https://hreinwald.github.io/drc/reference/lepidium.html","id":null,"dir":"Reference","previous_headings":"","what":"Dose-response profile of degradation of agrochemical using lepidium — lepidium","title":"Dose-response profile of degradation of agrochemical using lepidium — lepidium","text":"Estimation degradation profile agrochemical based soil samples depth 0-10cm calibration experiment.","code":""},{"path":"https://hreinwald.github.io/drc/reference/lepidium.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Dose-response profile of degradation of agrochemical using lepidium — lepidium","text":"","code":"data(lepidium)"},{"path":"https://hreinwald.github.io/drc/reference/lepidium.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Dose-response profile of degradation of agrochemical using lepidium — lepidium","text":"data frame 42 observations following 2 variables. conc numeric vector concentrations (g/ha) weight numeric vector plant weight (g) 3 weeks' growth","code":""},{"path":"https://hreinwald.github.io/drc/reference/lepidium.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Dose-response profile of degradation of agrochemical using lepidium — lepidium","text":"experiment seven concentrations six replicates per concentration. Lepidium rather robust responds high concentrations.","code":""},{"path":"https://hreinwald.github.io/drc/reference/lepidium.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Dose-response profile of degradation of agrochemical using lepidium — lepidium","text":"Racine-Poon, . (1988) Bayesian Approach Nonlinear Calibration Problems, J. . Statist. Ass., 83, 650–656.","code":""},{"path":"https://hreinwald.github.io/drc/reference/lepidium.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Dose-response profile of degradation of agrochemical using lepidium — lepidium","text":"","code":"library(drc) lepidium.m1 <- drm(weight~conc, data=lepidium, fct = LL.4()) modelFit(lepidium.m1) #> Lack-of-fit test #> #> ModelDf RSS Df F value p value #> ANOVA 35 14.187 #> DRC model 38 14.449 3 0.2159 0.8847 plot(lepidium.m1, type = \"all\", log = \"\")"},{"path":"https://hreinwald.github.io/drc/reference/lettuce.html","id":null,"dir":"Reference","previous_headings":"","what":"Hormesis in lettuce plants — lettuce","title":"Hormesis in lettuce plants — lettuce","text":"Data experiment isobutylalcohol dissolved nutrient solution lettuce (Lactuca sativa) plants grown. plant biomass shoot determined af 21 days.","code":""},{"path":"https://hreinwald.github.io/drc/reference/lettuce.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Hormesis in lettuce plants — lettuce","text":"","code":"data(lettuce)"},{"path":"https://hreinwald.github.io/drc/reference/lettuce.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Hormesis in lettuce plants — lettuce","text":"data frame 14 observations following 2 variables. conc numeric vector concentrations isobutylalcohol (mg/l) weight numeric vector biomass shoot (g)","code":""},{"path":"https://hreinwald.github.io/drc/reference/lettuce.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Hormesis in lettuce plants — lettuce","text":"data set illustrates hormesis, presence subtoxic stimulus low concentrations.","code":""},{"path":"https://hreinwald.github.io/drc/reference/lettuce.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Hormesis in lettuce plants — lettuce","text":"van Ewijk, P. H. Hoekstra, J. . (1993) Calculation EC50 Confidence Interval Subtoxic Stimulus Present, ECOTOXICOLOGY ENVIRONMENTAL SAFETY, 25, 25–32.","code":""},{"path":"https://hreinwald.github.io/drc/reference/lettuce.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Hormesis in lettuce plants — lettuce","text":"van Ewijk, P. H. Hoekstra, J. . (1994) Curvature Measures Confidence Intervals Linear Logistic Model, Appl. Statist., 43, 477–487.","code":""},{"path":"https://hreinwald.github.io/drc/reference/lettuce.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Hormesis in lettuce plants — lettuce","text":"","code":"library(drc) ## Look at data lettuce #> conc weight #> 1 0.00 1.126 #> 2 0.00 0.833 #> 3 0.32 1.096 #> 4 0.32 1.106 #> 5 1.00 1.163 #> 6 1.00 1.336 #> 7 3.20 0.985 #> 8 3.20 0.754 #> 9 10.00 0.716 #> 10 10.00 0.683 #> 11 32.00 0.560 #> 12 32.00 0.488 #> 13 100.00 0.375 #> 14 100.00 0.344 ## Monotonous dose-response model lettuce.m1 <- drm(weight~conc, data=lettuce, fct=LL.3()) plot(lettuce.m1, broken = TRUE) ## Model fit in van Ewijk and Hoekstra (1994) lettuce.m2 <- drm(weight~conc, data=lettuce, fct=BC.4()) modelFit(lettuce.m2) #> Lack-of-fit test #> #> ModelDf RSS Df F value p value #> ANOVA 7 0.088237 #> DRC model 10 0.124975 3 0.9715 0.4582 plot(lettuce.m2, add = TRUE, broken = TRUE, type = \"none\", lty = 2) ## Hormesis effect only slightly significant summary(lettuce.m2) #> #> Model fitted: Brain-Cousens (hormesis) with lower limit fixed at 0 (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 1.282812 0.049346 25.9964 1.632e-10 *** #> d:(Intercept) 0.967302 0.077123 12.5423 1.926e-07 *** #> e:(Intercept) 0.847633 0.436093 1.9437 0.08059 . #> f:(Intercept) 1.620703 0.979711 1.6543 0.12908 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.1117922 (10 degrees of freedom) ## Hormesis effect highly significant ## compare with t-test for the \"f\" parameter in the summary output) anova(lettuce.m1, lettuce.m2) #> #> 1st model #> fct: LL.3() #> 2nd model #> fct: BC.4() #> #> ANOVA table #> #> ModelDf RSS Df F value p value #> 1st model 11 0.24222 #> 2nd model 10 0.12498 1 9.3817 0.0120"},{"path":"https://hreinwald.github.io/drc/reference/lgaussian.html","id":null,"dir":"Reference","previous_headings":"","what":"Log-normal (log-Gaussian) biphasic dose-response model — lgaussian","title":"Log-normal (log-Gaussian) biphasic dose-response model — lgaussian","text":"Model function fitting symmetric skewed bell-shaped/biphasic dose-response patterns using log-Gaussian model. log-transformed variant gaussian model.","code":""},{"path":"https://hreinwald.github.io/drc/reference/lgaussian.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Log-normal (log-Gaussian) biphasic dose-response model — lgaussian","text":"","code":"lgaussian( fixed = c(NA, NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\", \"f\"), method = c(\"1\", \"2\", \"3\", \"4\"), ssfct = NULL, fctName, fctText, loge = FALSE )"},{"path":"https://hreinwald.github.io/drc/reference/lgaussian.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Log-normal (log-Gaussian) biphasic dose-response model — lgaussian","text":"fixed numeric vector. Specifies parameters fixed value fixed. NAs parameters fixed. names vector character strings giving names parameters (contain \":\"). order parameters : b, c, d, e, f. method character string indicating self starter function use. ssfct self starter function used. fctName optional character string used internally convenience functions. fctText optional character string used internally convenience functions. loge logical indicating whether e log(e) parameter model. default e model parameter.","code":""},{"path":"https://hreinwald.github.io/drc/reference/lgaussian.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Log-normal (log-Gaussian) biphasic dose-response model — lgaussian","text":"value returned list containing nonlinear function, self starter function parameter names.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/lgaussian.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Log-normal (log-Gaussian) biphasic dose-response model — lgaussian","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/lin.test.html","id":null,"dir":"Reference","previous_headings":"","what":"Lack-of-fit test for the mean structure based on cumulated residuals — lin.test","title":"Lack-of-fit test for the mean structure based on cumulated residuals — lin.test","text":"function provides lack--fit test mean structure based cumulated residuals model fit.","code":""},{"path":"https://hreinwald.github.io/drc/reference/lin.test.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Lack-of-fit test for the mean structure based on cumulated residuals — lin.test","text":"","code":"lin.test( object, noksSim = 20, seed = 20070325, plotit = TRUE, log = \"\", bp = 0.01, xlab, ylab, ylim, ... )"},{"path":"https://hreinwald.github.io/drc/reference/lin.test.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Lack-of-fit test for the mean structure based on cumulated residuals — lin.test","text":"object object class 'drc'. noksSim numeric specifying number simulations used obtain p-value. seed numeric specifying seed value random number generator. plotit logical indicating whether observed cumulated residual process plotted. Default plot process. log character string contain \"x\" x axis logarithmic, \"y\" y axis logarithmic \"xy\" \"yx\" axes logarithmic. empty string \"\" yields original axes. bp numeric value specifying break point dose zero. xlab character string specifying optional label x axis. ylab character string specifying optional label y axis. ylim numeric vector length two, containing lower upper limit y axis. ... additional arguments passed basic plot method.","code":""},{"path":"https://hreinwald.github.io/drc/reference/lin.test.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Lack-of-fit test for the mean structure based on cumulated residuals — lin.test","text":"p-value test null hypothesis mean structure appropriate. Ritz Martinussen (2009) provide details.","code":""},{"path":"https://hreinwald.github.io/drc/reference/lin.test.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Lack-of-fit test for the mean structure based on cumulated residuals — lin.test","text":"function provides graphical model checking mean structure dose-response model. graphical display supplemented p-value based supremum-type test. test applicable even cases data non-normal exhibit variance heterogeneity.","code":""},{"path":"https://hreinwald.github.io/drc/reference/lin.test.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Lack-of-fit test for the mean structure based on cumulated residuals — lin.test","text":"Ritz, C Martinussen, T. (2009) Lack--fit tests assessing mean structures continuous dose-response data, Submitted manuscript","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/lin.test.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Lack-of-fit test for the mean structure based on cumulated residuals — lin.test","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/lin.test.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Lack-of-fit test for the mean structure based on cumulated residuals — lin.test","text":"","code":"## Fitting a log-logistic model to the dataset 'etmotc' etmotc.m1<-drm(rgr1~dose1, data=etmotc[1:15,], fct=LL.4()) ## Test based on cumulated residuals lin.test(etmotc.m1, 1000) #> [1] 0.074"},{"path":"https://hreinwald.github.io/drc/reference/liver.tumor.html","id":null,"dir":"Reference","previous_headings":"","what":"Liver tumor incidence — liver.tumor","title":"Liver tumor incidence — liver.tumor","text":"Liver tumor incidence female Sprague-Dawley rats exposed chemical like 2,3,7,8-tetrachlorodibenzo-pdioxin (TCDD).","code":""},{"path":"https://hreinwald.github.io/drc/reference/liver.tumor.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Liver tumor incidence — liver.tumor","text":"","code":"data(liver.tumor)"},{"path":"https://hreinwald.github.io/drc/reference/liver.tumor.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Liver tumor incidence — liver.tumor","text":"data frame 6 observations following 3 variables. conc numeric vector reporting concentration TCDD (ng/kg) total numeric vector incidence numeric vector","code":""},{"path":"https://hreinwald.github.io/drc/reference/liver.tumor.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Liver tumor incidence — liver.tumor","text":"National Toxicology Program. NTP technical report toxicology carcinogenesis studies 2,3,7,8-tetrachlorodibenzo-p-dioxin (tcdd) (CAS . 1746-01-6) female Harlan Sprague-Dawley rats (gavage studies). National Toxicology Program technical report series, (521):4–232, apr 2006.","code":""},{"path":"https://hreinwald.github.io/drc/reference/liver.tumor.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Liver tumor incidence — liver.tumor","text":"","code":"library(drc) ## Displaying the data head(liver.tumor) #> conc total incidence #> 1 0.00 49 0 #> 2 2.56 48 0 #> 3 5.69 46 0 #> 4 9.79 50 0 #> 5 16.57 49 1 #> 6 29.70 53 13 ## Fitting a two-parameter log-logistic model for binomial response liver.tumor.m1 <- drm(incidence/total ~ conc, weights = total, data = liver.tumor, fct = LL.2(), type = \"binomial\") summary(liver.tumor.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) -4.9750 1.6897 -2.9443 0.003237 ** #> e:(Intercept) 37.1774 4.1838 8.8859 < 2.2e-16 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## Plotting the fitted curve plot(liver.tumor.m1, xlab = \"Concentration of TCDD (ng/kg)\", ylab = \"Tumor incidence\")"},{"path":"https://hreinwald.github.io/drc/reference/LL.2.html","id":null,"dir":"Reference","previous_headings":"","what":"Two-parameter log-logistic function — LL.2","title":"Two-parameter log-logistic function — LL.2","text":"two-parameter log-logistic function lower limit fixed 0 upper limit fixed (default 1), primarily use binomial/quantal dose-response data.","code":""},{"path":"https://hreinwald.github.io/drc/reference/LL.2.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Two-parameter log-logistic function — LL.2","text":"","code":"LL.2(upper = 1, fixed = c(NA, NA), names = c(\"b\", \"e\"), ...) l2(upper = 1, fixed = c(NA, NA), names = c(\"b\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/LL.2.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Two-parameter log-logistic function — LL.2","text":"upper numeric value, fixed upper limit (default 1). fixed numeric vector length 2, specifying fixed parameters (use NA non-fixed parameters). names character vector length 2, specifying names parameters (default: b, e). ... additional arguments llogistic.","code":""},{"path":"https://hreinwald.github.io/drc/reference/LL.2.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Two-parameter log-logistic function — LL.2","text":"See llogistic.","code":""},{"path":"https://hreinwald.github.io/drc/reference/LL.2.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Two-parameter log-logistic function — LL.2","text":"two-parameter log-logistic function given expression $$f(x) = \\frac{upper}{1+\\exp(b(\\log(x)-\\log(e)))}$$","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/LL.2.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Two-parameter log-logistic function — LL.2","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/LL.2.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Two-parameter log-logistic function — LL.2","text":"","code":"earthworms.m1 <- drm(number/total~dose, weights=total, data = earthworms, fct = LL.2(), type = \"binomial\")"},{"path":"https://hreinwald.github.io/drc/reference/LL.3.html","id":null,"dir":"Reference","previous_headings":"","what":"Three-parameter log-logistic function — LL.3","title":"Three-parameter log-logistic function — LL.3","text":"three-parameter log-logistic function lower limit fixed 0.","code":""},{"path":"https://hreinwald.github.io/drc/reference/LL.3.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Three-parameter log-logistic function — LL.3","text":"","code":"LL.3(fixed = c(NA, NA, NA), names = c(\"b\", \"d\", \"e\"), ...) l3(fixed = c(NA, NA, NA), names = c(\"b\", \"d\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/LL.3.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Three-parameter log-logistic function — LL.3","text":"fixed numeric vector length 3, specifying fixed parameters (use NA non-fixed parameters). names character vector length 3, specifying names parameters (default: b, d, e). ... additional arguments llogistic.","code":""},{"path":"https://hreinwald.github.io/drc/reference/LL.3.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Three-parameter log-logistic function — LL.3","text":"See llogistic.","code":""},{"path":"https://hreinwald.github.io/drc/reference/LL.3.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Three-parameter log-logistic function — LL.3","text":"three-parameter log-logistic function given expression $$f(x) = \\frac{d}{1+\\exp(b(\\log(x)-\\log(e)))}$$","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/LL.3.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Three-parameter log-logistic function — LL.3","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/LL.3.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Three-parameter log-logistic function — LL.3","text":"","code":"ryegrass.model1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.3())"},{"path":"https://hreinwald.github.io/drc/reference/LL.3u.html","id":null,"dir":"Reference","previous_headings":"","what":"Three-parameter log-logistic function with upper limit fixed — LL.3u","title":"Three-parameter log-logistic function with upper limit fixed — LL.3u","text":"three-parameter log-logistic function upper limit fixed (default 1), primarily use binomial/quantal dose-response data.","code":""},{"path":"https://hreinwald.github.io/drc/reference/LL.3u.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Three-parameter log-logistic function with upper limit fixed — LL.3u","text":"","code":"LL.3u(upper = 1, fixed = c(NA, NA, NA), names = c(\"b\", \"c\", \"e\"), ...) l3u(upper = 1, fixed = c(NA, NA, NA), names = c(\"b\", \"c\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/LL.3u.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Three-parameter log-logistic function with upper limit fixed — LL.3u","text":"upper numeric value, fixed upper limit (default 1). fixed numeric vector length 3, specifying fixed parameters (use NA non-fixed parameters). names character vector length 3, specifying names parameters (default: b, c, e). ... additional arguments llogistic.","code":""},{"path":"https://hreinwald.github.io/drc/reference/LL.3u.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Three-parameter log-logistic function with upper limit fixed — LL.3u","text":"See llogistic.","code":""},{"path":"https://hreinwald.github.io/drc/reference/LL.3u.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Three-parameter log-logistic function with upper limit fixed — LL.3u","text":"three-parameter log-logistic function upper limit fixed given $$f(x) = c + \\frac{upper-c}{1+\\exp(b(\\log(x)-\\log(e)))}$$","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/LL.3u.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Three-parameter log-logistic function with upper limit fixed — LL.3u","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/LL.4.html","id":null,"dir":"Reference","previous_headings":"","what":"Four-parameter log-logistic function — LL.4","title":"Four-parameter log-logistic function — LL.4","text":"four-parameter log-logistic function.","code":""},{"path":"https://hreinwald.github.io/drc/reference/LL.4.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Four-parameter log-logistic function — LL.4","text":"","code":"LL.4(fixed = c(NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\"), ...) l4(fixed = c(NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/LL.4.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Four-parameter log-logistic function — LL.4","text":"fixed numeric vector length 4, specifying fixed parameters (use NA non-fixed parameters). names character vector length 4, specifying names parameters (default: b, c, d, e). ... additional arguments llogistic.","code":""},{"path":"https://hreinwald.github.io/drc/reference/LL.4.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Four-parameter log-logistic function — LL.4","text":"See llogistic.","code":""},{"path":"https://hreinwald.github.io/drc/reference/LL.4.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Four-parameter log-logistic function — LL.4","text":"four-parameter log-logistic function given expression $$f(x) = c + \\frac{d-c}{1+\\exp(b(\\log(x)-\\log(e)))}$$","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/LL.4.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Four-parameter log-logistic function — LL.4","text":"Christian Ritz Jens C. Streibig","code":""},{"path":"https://hreinwald.github.io/drc/reference/LL.4.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Four-parameter log-logistic function — LL.4","text":"","code":"spinach.m1 <- drm(SLOPE~DOSE, CURVE, data = spinach, fct = LL.4())"},{"path":"https://hreinwald.github.io/drc/reference/LL.5.html","id":null,"dir":"Reference","previous_headings":"","what":"Five-parameter log-logistic function — LL.5","title":"Five-parameter log-logistic function — LL.5","text":"five-parameter (generalized) log-logistic function. function asymmetric f differs 1.","code":""},{"path":"https://hreinwald.github.io/drc/reference/LL.5.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Five-parameter log-logistic function — LL.5","text":"","code":"LL.5(fixed = c(NA, NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\", \"f\"), ...) l5(fixed = c(NA, NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\", \"f\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/LL.5.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Five-parameter log-logistic function — LL.5","text":"fixed numeric vector length 5, specifying fixed parameters (use NA non-fixed parameters). names character vector length 5, specifying names parameters (default: b, c, d, e, f). ... additional arguments llogistic.","code":""},{"path":"https://hreinwald.github.io/drc/reference/LL.5.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Five-parameter log-logistic function — LL.5","text":"See llogistic.","code":""},{"path":"https://hreinwald.github.io/drc/reference/LL.5.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Five-parameter log-logistic function — LL.5","text":"five-parameter log-logistic function given expression $$f(x) = c + \\frac{d-c}{(1+\\exp(b(\\log(x)-\\log(e))))^f}$$","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/LL.5.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Five-parameter log-logistic function — LL.5","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/LL.5.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Five-parameter log-logistic function — LL.5","text":"","code":"ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.5())"},{"path":"https://hreinwald.github.io/drc/reference/LL2.2.html","id":null,"dir":"Reference","previous_headings":"","what":"Two-Parameter Log-Logistic Model with log(ED50) as Parameter — LL2.2","title":"Two-Parameter Log-Logistic Model with log(ED50) as Parameter — LL2.2","text":"two-parameter log-logistic model lower limit fixed 0 upper limit fixed specified value (default 1). estimated parameters slope b log(ED50) e.","code":""},{"path":"https://hreinwald.github.io/drc/reference/LL2.2.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Two-Parameter Log-Logistic Model with log(ED50) as Parameter — LL2.2","text":"","code":"LL2.2(upper = 1, fixed = c(NA, NA), names = c(\"b\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/LL2.2.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Two-Parameter Log-Logistic Model with log(ED50) as Parameter — LL2.2","text":"upper numeric value giving fixed upper limit. Defaults 1. fixed numeric vector length 2. Specifies parameters fixed value. Use NA parameters estimated. names character vector length 2 giving names parameters b e. ... additional arguments passed llogistic2.","code":""},{"path":"https://hreinwald.github.io/drc/reference/LL2.2.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Two-Parameter Log-Logistic Model with log(ED50) as Parameter — LL2.2","text":"list class \"llogistic\" nonlinear function, self-starter, related components.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/LL2.2.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Two-Parameter Log-Logistic Model with log(ED50) as Parameter — LL2.2","text":"","code":"earthworms.m1 <- drm(number/total ~ dose, weights = total, data = earthworms, fct = LL2.2(), type = \"binomial\")"},{"path":"https://hreinwald.github.io/drc/reference/LL2.3.html","id":null,"dir":"Reference","previous_headings":"","what":"Three-Parameter Log-Logistic Model with log(ED50) and Lower Limit at 0 — LL2.3","title":"Three-Parameter Log-Logistic Model with log(ED50) and Lower Limit at 0 — LL2.3","text":"three-parameter log-logistic model lower limit fixed 0. estimated parameters slope b, upper limit d, log(ED50) e.","code":""},{"path":"https://hreinwald.github.io/drc/reference/LL2.3.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Three-Parameter Log-Logistic Model with log(ED50) and Lower Limit at 0 — LL2.3","text":"","code":"LL2.3(fixed = c(NA, NA, NA), names = c(\"b\", \"d\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/LL2.3.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Three-Parameter Log-Logistic Model with log(ED50) and Lower Limit at 0 — LL2.3","text":"fixed numeric vector length 3. Specifies parameters fixed value. Use NA parameters estimated. names character vector length 3 giving names parameters b, d, e. ... additional arguments passed llogistic2.","code":""},{"path":"https://hreinwald.github.io/drc/reference/LL2.3.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Three-Parameter Log-Logistic Model with log(ED50) and Lower Limit at 0 — LL2.3","text":"list class \"llogistic\" nonlinear function, self-starter, related components.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/LL2.3.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Three-Parameter Log-Logistic Model with log(ED50) and Lower Limit at 0 — LL2.3","text":"","code":"ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL2.3())"},{"path":"https://hreinwald.github.io/drc/reference/LL2.3u.html","id":null,"dir":"Reference","previous_headings":"","what":"Three-Parameter Log-Logistic Model with log(ED50) and Fixed Upper Limit — LL2.3u","title":"Three-Parameter Log-Logistic Model with log(ED50) and Fixed Upper Limit — LL2.3u","text":"three-parameter log-logistic model upper limit fixed specified value (default 1). estimated parameters slope b, lower limit c, log(ED50) e.","code":""},{"path":"https://hreinwald.github.io/drc/reference/LL2.3u.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Three-Parameter Log-Logistic Model with log(ED50) and Fixed Upper Limit — LL2.3u","text":"","code":"LL2.3u(upper = 1, fixed = c(NA, NA, NA), names = c(\"b\", \"c\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/LL2.3u.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Three-Parameter Log-Logistic Model with log(ED50) and Fixed Upper Limit — LL2.3u","text":"upper numeric value giving fixed upper limit. Defaults 1. fixed numeric vector length 3. Specifies parameters fixed value. Use NA parameters estimated. names character vector length 3 giving names parameters b, c, e. ... additional arguments passed llogistic2.","code":""},{"path":"https://hreinwald.github.io/drc/reference/LL2.3u.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Three-Parameter Log-Logistic Model with log(ED50) and Fixed Upper Limit — LL2.3u","text":"list class \"llogistic\" nonlinear function, self-starter, related components.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/LL2.4.html","id":null,"dir":"Reference","previous_headings":"","what":"Four-Parameter Log-Logistic Model with log(ED50) as Parameter — LL2.4","title":"Four-Parameter Log-Logistic Model with log(ED50) as Parameter — LL2.4","text":"four-parameter log-logistic model ED50 parameterised log scale. asymmetry parameter f fixed 1. estimated parameters slope b, lower limit c, upper limit d, log(ED50) e.","code":""},{"path":"https://hreinwald.github.io/drc/reference/LL2.4.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Four-Parameter Log-Logistic Model with log(ED50) as Parameter — LL2.4","text":"","code":"LL2.4(fixed = c(NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/LL2.4.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Four-Parameter Log-Logistic Model with log(ED50) as Parameter — LL2.4","text":"fixed numeric vector length 4. Specifies parameters fixed value. Use NA parameters estimated. names character vector length 4 giving names parameters b, c, d, e. ... additional arguments passed llogistic2.","code":""},{"path":"https://hreinwald.github.io/drc/reference/LL2.4.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Four-Parameter Log-Logistic Model with log(ED50) as Parameter — LL2.4","text":"list class \"llogistic\" nonlinear function, self-starter, related components.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/LL2.4.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Four-Parameter Log-Logistic Model with log(ED50) as Parameter — LL2.4","text":"","code":"spinach.m1 <- drm(SLOPE ~ DOSE, CURVE, data = spinach, fct = LL2.4())"},{"path":"https://hreinwald.github.io/drc/reference/LL2.5.html","id":null,"dir":"Reference","previous_headings":"","what":"Five-Parameter Generalised Log-Logistic Model with log(ED50) as Parameter — LL2.5","title":"Five-Parameter Generalised Log-Logistic Model with log(ED50) as Parameter — LL2.5","text":"five-parameter generalised log-logistic model ED50 parameterised log scale. five parameters (b, c, d, e, f) estimated.","code":""},{"path":"https://hreinwald.github.io/drc/reference/LL2.5.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Five-Parameter Generalised Log-Logistic Model with log(ED50) as Parameter — LL2.5","text":"","code":"LL2.5(fixed = c(NA, NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\", \"f\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/LL2.5.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Five-Parameter Generalised Log-Logistic Model with log(ED50) as Parameter — LL2.5","text":"fixed numeric vector length 5. Specifies parameters fixed value. Use NA parameters estimated. names character vector length 5 giving names parameters b, c, d, e, f. ... additional arguments passed llogistic2.","code":""},{"path":"https://hreinwald.github.io/drc/reference/LL2.5.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Five-Parameter Generalised Log-Logistic Model with log(ED50) as Parameter — LL2.5","text":"list class \"llogistic\" nonlinear function, self-starter, related components.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/LL2.5.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Five-Parameter Generalised Log-Logistic Model with log(ED50) as Parameter — LL2.5","text":"","code":"ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL2.5())"},{"path":"https://hreinwald.github.io/drc/reference/llogistic.html","id":null,"dir":"Reference","previous_headings":"","what":"The log-logistic function — llogistic","title":"The log-logistic function — llogistic","text":"general way specifying log-logistic models various constraints parameters.","code":""},{"path":"https://hreinwald.github.io/drc/reference/llogistic.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"The log-logistic function — llogistic","text":"","code":"llogistic( fixed = c(NA, NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\", \"f\"), method = c(\"1\", \"2\", \"3\", \"4\"), ssfct = NULL, fctName, fctText )"},{"path":"https://hreinwald.github.io/drc/reference/llogistic.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"The log-logistic function — llogistic","text":"fixed numeric vector length 5, specifying fixed parameters (use NA non-fixed parameters). names character vector length 5, specifying names parameters: b, c, d, e, f. method character string indicating self starter function use. ssfct self starter function used. fctName optional character string used internally. fctText optional character string used internally.","code":""},{"path":"https://hreinwald.github.io/drc/reference/llogistic.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"The log-logistic function — llogistic","text":"list containing nonlinear function, self starter function, parameter names.","code":""},{"path":"https://hreinwald.github.io/drc/reference/llogistic.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"The log-logistic function — llogistic","text":"five-parameter log-logistic function given expression $$f(x) = c + \\frac{d-c}{(1+\\exp(b(\\log(x)-\\log(e))))^f}$$","code":""},{"path":"https://hreinwald.github.io/drc/reference/llogistic.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"The log-logistic function — llogistic","text":"Finney, D. J. (1979). Seber, G. . F. Wild, C. J. (1989).","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/llogistic.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"The log-logistic function — llogistic","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/llogistic.ssf.html","id":null,"dir":"Reference","previous_headings":"","what":"Self-starter for log-logistic model — llogistic.ssf","title":"Self-starter for log-logistic model — llogistic.ssf","text":"Self-starter log-logistic model","code":""},{"path":"https://hreinwald.github.io/drc/reference/llogistic.ssf.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Self-starter for log-logistic model — llogistic.ssf","text":"","code":"llogistic.ssf(method = c(\"1\", \"2\", \"3\", \"4\"), fixed, useFixed = FALSE)"},{"path":"https://hreinwald.github.io/drc/reference/llogistic2.html","id":null,"dir":"Reference","previous_headings":"","what":"Five-Parameter Log-Logistic Model with log(ED50) as Parameter — llogistic2","title":"Five-Parameter Log-Logistic Model with log(ED50) as Parameter — llogistic2","text":"five-parameter log-logistic model ED50 parameterised log scale. mean function : $$f(x) = c + \\frac{d - c}{(1 + \\exp(b(\\log(x) - e)))^f}$$ e logarithm ED50 (exponentiated).","code":""},{"path":"https://hreinwald.github.io/drc/reference/llogistic2.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Five-Parameter Log-Logistic Model with log(ED50) as Parameter — llogistic2","text":"","code":"llogistic2( fixed = c(NA, NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\", \"f\"), ss = c(\"1\", \"2\", \"3\"), ssfct = NULL, fctName, fctText )"},{"path":"https://hreinwald.github.io/drc/reference/llogistic2.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Five-Parameter Log-Logistic Model with log(ED50) as Parameter — llogistic2","text":"fixed numeric vector length 5. Specifies parameters fixed value. Use NA parameters estimated. names character vector length 5 giving names parameters b, c, d, e, f. ss character string indicating self-starter version use. One \"1\" (default), \"2\", \"3\". ssfct optional self-starter function. provided, overrides built-self-starter selected ss. fctName optional character string specifying name function. fctText optional character string providing short description function.","code":""},{"path":"https://hreinwald.github.io/drc/reference/llogistic2.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Five-Parameter Log-Logistic Model with log(ED50) as Parameter — llogistic2","text":"list class \"llogistic\" containing nonlinear function, self-starter function, parameter names, related helper functions.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/llogistic2.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Five-Parameter Log-Logistic Model with log(ED50) as Parameter — llogistic2","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/LN.2.html","id":null,"dir":"Reference","previous_headings":"","what":"Two-parameter log-normal dose-response model — LN.2","title":"Two-parameter log-normal dose-response model — LN.2","text":"LN.2 convenience function log-normal model lower limit fixed 0 upper limit fixed (default 1), corresponding classic probit model.","code":""},{"path":"https://hreinwald.github.io/drc/reference/LN.2.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Two-parameter log-normal dose-response model — LN.2","text":"","code":"LN.2(upper = 1, fixed = c(NA, NA), names = c(\"b\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/LN.2.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Two-parameter log-normal dose-response model — LN.2","text":"upper numeric specifying fixed upper horizontal asymptote. Default 1. fixed numeric vector length 2 specifying fixed parameters (NAs free parameters). names character vector parameter names. ... additional arguments passed lnormal.","code":""},{"path":"https://hreinwald.github.io/drc/reference/LN.2.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Two-parameter log-normal dose-response model — LN.2","text":"list (see lnormal).","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/LN.3.html","id":null,"dir":"Reference","previous_headings":"","what":"Three-parameter log-normal dose-response model — LN.3","title":"Three-parameter log-normal dose-response model — LN.3","text":"LN.3 convenience function log-normal model lower limit fixed 0.","code":""},{"path":"https://hreinwald.github.io/drc/reference/LN.3.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Three-parameter log-normal dose-response model — LN.3","text":"","code":"LN.3(fixed = c(NA, NA, NA), names = c(\"b\", \"d\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/LN.3.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Three-parameter log-normal dose-response model — LN.3","text":"fixed numeric vector length 3 specifying fixed parameters (NAs free parameters). names character vector parameter names. ... additional arguments passed lnormal.","code":""},{"path":"https://hreinwald.github.io/drc/reference/LN.3.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Three-parameter log-normal dose-response model — LN.3","text":"list (see lnormal).","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/LN.3u.html","id":null,"dir":"Reference","previous_headings":"","what":"Three-parameter log-normal model with upper limit fixed — LN.3u","title":"Three-parameter log-normal model with upper limit fixed — LN.3u","text":"LN.3u convenience function log-normal model upper limit fixed (default 1).","code":""},{"path":"https://hreinwald.github.io/drc/reference/LN.3u.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Three-parameter log-normal model with upper limit fixed — LN.3u","text":"","code":"LN.3u(upper = 1, fixed = c(NA, NA, NA), names = c(\"b\", \"c\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/LN.3u.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Three-parameter log-normal model with upper limit fixed — LN.3u","text":"upper numeric specifying fixed upper horizontal asymptote. Default 1. fixed numeric vector length 3 specifying fixed parameters (NAs free parameters). names character vector parameter names. ... additional arguments passed lnormal.","code":""},{"path":"https://hreinwald.github.io/drc/reference/LN.3u.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Three-parameter log-normal model with upper limit fixed — LN.3u","text":"list (see lnormal).","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/LN.4.html","id":null,"dir":"Reference","previous_headings":"","what":"Four-parameter log-normal dose-response model — LN.4","title":"Four-parameter log-normal dose-response model — LN.4","text":"LN.4 convenience function full four-parameter log-normal model.","code":""},{"path":"https://hreinwald.github.io/drc/reference/LN.4.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Four-parameter log-normal dose-response model — LN.4","text":"","code":"LN.4(fixed = c(NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/LN.4.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Four-parameter log-normal dose-response model — LN.4","text":"fixed numeric vector length 4 specifying fixed parameters (NAs free parameters). names character vector parameter names. ... additional arguments passed lnormal.","code":""},{"path":"https://hreinwald.github.io/drc/reference/LN.4.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Four-parameter log-normal dose-response model — LN.4","text":"list (see lnormal).","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/lnormal.html","id":null,"dir":"Reference","previous_headings":"","what":"Log-normal dose-response model — lnormal","title":"Log-normal dose-response model — lnormal","text":"lnormal provides general framework specifying mean function decreasing increasing log-normal dose-response model.","code":""},{"path":"https://hreinwald.github.io/drc/reference/lnormal.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Log-normal dose-response model — lnormal","text":"","code":"lnormal( fixed = c(NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\"), method = c(\"1\", \"2\", \"3\", \"4\"), ssfct = NULL, fctName, fctText, loge = FALSE )"},{"path":"https://hreinwald.github.io/drc/reference/lnormal.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Log-normal dose-response model — lnormal","text":"fixed numeric vector. Specifies parameters fixed value fixed. NAs parameters fixed. names vector character strings giving names parameters (contain \":\"). order parameters : b, c, d, e. method character string indicating self starter function use. ssfct self starter function used. fctName optional character string used internally convenience functions. fctText optional character string used internally convenience functions. loge logical indicating whether ED50 log(ED50) parameter model. default ED50 model parameter.","code":""},{"path":"https://hreinwald.github.io/drc/reference/lnormal.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Log-normal dose-response model — lnormal","text":"list containing non-linear function, self starter function parameter names.","code":""},{"path":"https://hreinwald.github.io/drc/reference/lnormal.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Log-normal dose-response model — lnormal","text":"case log(ED50) parameter model, mean function : $$f(x) = c + (d-c)(\\Phi(b(\\log(x)-e)))$$ case ED50 parameter: $$f(x) = c + (d-c)(\\Phi(b(\\log(x)-\\log(e))))$$ \\(c=0\\) \\(d=1\\), model reduces classic probit model.","code":""},{"path":"https://hreinwald.github.io/drc/reference/lnormal.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Log-normal dose-response model — lnormal","text":"Finney, D. J. (1971) Probit analysis, London: Cambridge University Press. Bruce, R. D. Versteeg, D. J. (1992) statistical procedure modeling continuous toxicity data, Environ. Toxicol. Chem., 11, 1485–1494.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/lnormal.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Log-normal dose-response model — lnormal","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/lnormal.ssf.html","id":null,"dir":"Reference","previous_headings":"","what":"Self-starter for log-normal model — lnormal.ssf","title":"Self-starter for log-normal model — lnormal.ssf","text":"Self-starter log-normal model","code":""},{"path":"https://hreinwald.github.io/drc/reference/lnormal.ssf.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Self-starter for log-normal model — lnormal.ssf","text":"","code":"lnormal.ssf(method = c(\"1\", \"2\", \"3\", \"4\"), fixed, loge, useFixed = FALSE)"},{"path":"https://hreinwald.github.io/drc/reference/logistic.html","id":null,"dir":"Reference","previous_headings":"","what":"The general asymmetric five-parameter logistic model — logistic","title":"The general asymmetric five-parameter logistic model — logistic","text":"five-parameter logistic model given expression $$f(x) = c + \\frac{d - c}{(1 + \\exp(b(x - e)))^f}$$","code":""},{"path":"https://hreinwald.github.io/drc/reference/logistic.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"The general asymmetric five-parameter logistic model — logistic","text":"","code":"logistic( fixed = c(NA, NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\", \"f\"), method = c(\"1\", \"2\", \"3\", \"4\"), ssfct = NULL, fctName, fctText )"},{"path":"https://hreinwald.github.io/drc/reference/logistic.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"The general asymmetric five-parameter logistic model — logistic","text":"fixed numeric vector length 5. Specifies parameters fixed value fixed. NA indicates corresponding parameter fixed. names character vector length 5 giving names parameters (b, c, d, e, f). Default c(\"b\", \"c\", \"d\", \"e\", \"f\"). method character string indicating self starter function use (\"1\", \"2\", \"3\", \"4\"). ssfct self starter function used. NULL (default), built-self starter selected via method. fctName optional character string used internally overwrite function name. fctText optional character string used internally overwrite description text.","code":""},{"path":"https://hreinwald.github.io/drc/reference/logistic.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"The general asymmetric five-parameter logistic model — logistic","text":"list class \"Boltzmann\" containing nonlinear function, self starter function, parameter names.","code":""},{"path":"https://hreinwald.github.io/drc/reference/logistic.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"The general asymmetric five-parameter logistic model — logistic","text":"model differs log-logistic uses x directly rather log(x). sometimes referred Boltzmann model.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/logistic.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"The general asymmetric five-parameter logistic model — logistic","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/logistic.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"The general asymmetric five-parameter logistic model — logistic","text":"","code":"ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = L.4())"},{"path":"https://hreinwald.github.io/drc/reference/logistic.ssf.html","id":null,"dir":"Reference","previous_headings":"","what":"Self-starter for logistic model — logistic.ssf","title":"Self-starter for logistic model — logistic.ssf","text":"Self-starter logistic model","code":""},{"path":"https://hreinwald.github.io/drc/reference/logistic.ssf.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Self-starter for logistic model — logistic.ssf","text":"","code":"logistic.ssf(method = c(\"1\", \"2\", \"3\", \"4\"), fixed, useFixed = FALSE)"},{"path":"https://hreinwald.github.io/drc/reference/logLik.drc.html","id":null,"dir":"Reference","previous_headings":"","what":"Extracting the log likelihood — logLik.drc","title":"Extracting the log likelihood — logLik.drc","text":"logLik extracts value log likelihood function evaluated parameter estimates.","code":""},{"path":"https://hreinwald.github.io/drc/reference/logLik.drc.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Extracting the log likelihood — logLik.drc","text":"","code":"# S3 method for class 'drc' logLik(object, ...)"},{"path":"https://hreinwald.github.io/drc/reference/logLik.drc.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Extracting the log likelihood — logLik.drc","text":"object object class 'drc'. ... additional arguments.","code":""},{"path":"https://hreinwald.github.io/drc/reference/logLik.drc.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Extracting the log likelihood — logLik.drc","text":"evaluated log likelihood numeric value corresponding degrees freedom well number observations attributes.","code":""},{"path":"https://hreinwald.github.io/drc/reference/logLik.drc.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Extracting the log likelihood — logLik.drc","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/logLik.drc.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Extracting the log likelihood — logLik.drc","text":"","code":"## Fitting a four-parameter log-logistic model ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) logLik(ryegrass.m1) #> 'log Lik.' -16.15514 (df=5)"},{"path":"https://hreinwald.github.io/drc/reference/lowFixed.html","id":null,"dir":"Reference","previous_headings":"","what":"Construct Text for Model with Fixed Lower Limit — lowFixed","title":"Construct Text for Model with Fixed Lower Limit — lowFixed","text":"Helper function appends lower limit information model description string.","code":""},{"path":"https://hreinwald.github.io/drc/reference/lowFixed.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Construct Text for Model with Fixed Lower Limit — lowFixed","text":"","code":"lowFixed(modelStr)"},{"path":"https://hreinwald.github.io/drc/reference/lowFixed.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Construct Text for Model with Fixed Lower Limit — lowFixed","text":"modelStr character string base model description.","code":""},{"path":"https://hreinwald.github.io/drc/reference/lowFixed.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Construct Text for Model with Fixed Lower Limit — lowFixed","text":"character string describing model fixed lower limit.","code":""},{"path":"https://hreinwald.github.io/drc/reference/lowupFixed.html","id":null,"dir":"Reference","previous_headings":"","what":"Construct Text for Model with Fixed Lower and Upper Limits — lowupFixed","title":"Construct Text for Model with Fixed Lower and Upper Limits — lowupFixed","text":"Helper function appends lower upper limit information model description string.","code":""},{"path":"https://hreinwald.github.io/drc/reference/lowupFixed.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Construct Text for Model with Fixed Lower and Upper Limits — lowupFixed","text":"","code":"lowupFixed(modelStr, upper)"},{"path":"https://hreinwald.github.io/drc/reference/lowupFixed.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Construct Text for Model with Fixed Lower and Upper Limits — lowupFixed","text":"modelStr character string base model description. upper numeric value fixed upper limit.","code":""},{"path":"https://hreinwald.github.io/drc/reference/lowupFixed.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Construct Text for Model with Fixed Lower and Upper Limits — lowupFixed","text":"character string describing model fixed limits.","code":""},{"path":"https://hreinwald.github.io/drc/reference/M.bahia.html","id":null,"dir":"Reference","previous_headings":"","what":"Effect of an effluent on the growth of mysid shrimp — M.bahia","title":"Effect of an effluent on the growth of mysid shrimp — M.bahia","text":"Juvenile mysid shrimp (Mysidopsis bahia) exposed 32% effluent 7-day survival growth test. average weight per treatment replicate surviving organisms measured.","code":""},{"path":"https://hreinwald.github.io/drc/reference/M.bahia.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Effect of an effluent on the growth of mysid shrimp — M.bahia","text":"","code":"data(M.bahia)"},{"path":"https://hreinwald.github.io/drc/reference/M.bahia.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Effect of an effluent on the growth of mysid shrimp — M.bahia","text":"data frame 40 observations following 2 variables. conc numeric vector effluent concentrations (%) dryweight numeric vector average dry weights (mg)","code":""},{"path":"https://hreinwald.github.io/drc/reference/M.bahia.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Effect of an effluent on the growth of mysid shrimp — M.bahia","text":"data analysed Bruce Versteeg (1992) using log-normal dose-response model (using logarithm base 10). 32% complete mortality, justifies using model lower asymptote 0 assumed.","code":""},{"path":"https://hreinwald.github.io/drc/reference/M.bahia.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Effect of an effluent on the growth of mysid shrimp — M.bahia","text":"Bruce, R. D. Versteeg, D. J. (1992) statistical procedure modeling continuous toxicity data, Environ. Toxicol. Chem., 11, 1485–1494.","code":""},{"path":"https://hreinwald.github.io/drc/reference/M.bahia.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Effect of an effluent on the growth of mysid shrimp — M.bahia","text":"","code":"library(drc) M.bahia.m1 <- drm(dryweight~conc, data=M.bahia, fct=LN.3()) ## Variation increasing plot(fitted(M.bahia.m1), residuals(M.bahia.m1)) ## Using transform-both-sides approach M.bahia.m2 <- boxcox(M.bahia.m1, method = \"anova\") summary(M.bahia.m2) # logarithm transformation #> #> Model fitted: Log-normal with lower limit at 0 (3 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) -0.444809 0.056065 -7.9338 1.679e-09 *** #> d:(Intercept) 0.671979 0.043185 15.5603 < 2.2e-16 *** #> e:(Intercept) 3.905716 0.883294 4.4218 8.278e-05 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.2271316 (37 degrees of freedom) #> #> Non-normality/heterogeneity adjustment through Box-Cox transformation #> #> Estimated lambda: -0.182 #> Confidence interval for lambda: [-0.697, 0.371] #> ## Variation roughly constant, but still not a great fit plot(fitted(M.bahia.m2), residuals(M.bahia.m2)) ## Visual comparison of fits plot(M.bahia.m1, type=\"all\", broken=TRUE) plot(M.bahia.m2, add=TRUE, type=\"none\", broken=TRUE, lty=2) ED(M.bahia.m2, c(10,20,50), ci=\"fls\") #> #> Estimated effective doses #> #> Estimate Std. Error #> e:10 0.21900 0.11667 #> e:20 0.58881 0.24576 #> e:50 3.90572 0.88329 ## A better fit M.bahia.m3 <- boxcox(update(M.bahia.m1, fct = LN.4()), method = \"anova\") #plot(fitted(M.bahia.m3), residuals(M.bahia.m3)) plot(M.bahia.m3, add=TRUE, type=\"none\", broken=TRUE, lty=3, col=2) ED(M.bahia.m3, c(10,20,50), ci=\"fls\") #> #> Estimated effective doses #> #> Estimate Std. Error #> e:10 0.95677 0.18697 #> e:20 1.17193 0.19303 #> e:50 1.72756 0.19818"},{"path":"https://hreinwald.github.io/drc/reference/maED.html","id":null,"dir":"Reference","previous_headings":"","what":"Estimation of ED values using model-averaging — maED","title":"Estimation of ED values using model-averaging — maED","text":"Estimates confidence intervals ED values estimated using model-averaging.","code":""},{"path":"https://hreinwald.github.io/drc/reference/maED.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Estimation of ED values using model-averaging — maED","text":"","code":"maED( object, fctList = NULL, respLev = c(10, 20, 50), interval = c(\"none\", \"buckland\", \"kang\"), linreg = FALSE, clevel = NULL, level = 0.95, type = c(\"relative\", \"absolute\"), display = TRUE, na.rm = FALSE, extended = FALSE )"},{"path":"https://hreinwald.github.io/drc/reference/maED.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Estimation of ED values using model-averaging — maED","text":"object object class drc. fctList list non-linear functions compared. respLev numeric vector containing response levels. interval character string specifying type confidence intervals supplied. default \"none\". choices \"buckland\" \"kang\" explained Details section. linreg logical indicating whether additionally simple linear regression model fitted. clevel character string specifying curve id case estimates specific curve compound requested. default estimates shown curves. level numeric. confidence level. Must single value strictly 0 1. default 0.95. type character string. Whether specified response levels absolute relative (default). display logical. TRUE results displayed. Otherwise (useful simulations). na.rm logical indicating whether NA values occurring model fitting excluded subsequent calculations. extended logical specifying whether extended output (including fit summaries) returned.","code":""},{"path":"https://hreinwald.github.io/drc/reference/maED.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Estimation of ED values using model-averaging — maED","text":"extended = FALSE, matrix two columns containing model-averaged estimates corresponding estimated standard errors , optionally, lower upper confidence limits. extended = TRUE, list components: estimates Matrix model-averaged ED estimates intervals. fits Matrix per-model ED estimates AIC-based weights.","code":""},{"path":"https://hreinwald.github.io/drc/reference/maED.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Estimation of ED values using model-averaging — maED","text":"Model-averaging individual estimates carried described Buckland et al. (1997) Kang et al. (2000) using AIC-based weights. two approaches differ w.r.t. calculation confidence intervals: Buckland et al. (1997) provide approximate variance formula assumption perfectly correlated estimates (, confidence intervals tend wide). Kang et al. (2000) use model weights calculate confidence limits weighted means confidence limits individual fits.","code":""},{"path":"https://hreinwald.github.io/drc/reference/maED.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Estimation of ED values using model-averaging — maED","text":"Buckland, S. T. Burnham, K. P. Augustin, N. H. (1997) Model Selection: Integral Part Inference, Biometrics 53, 603–618. Kang, Seung-Ho Kodell, Ralph L. Chen, James J. (2000) Incorporating Model Uncertainties along Data Uncertainties Microbial Risk Assessment, Regulatory Toxicology Pharmacology 32, 68–72.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/maED.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Estimation of ED values using model-averaging — maED","text":"Christian Ritz, Hannes Reinwald","code":""},{"path":"https://hreinwald.github.io/drc/reference/maED.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Estimation of ED values using model-averaging — maED","text":"","code":"## Fitting an example dose-response model ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) ## Model-averaging with default settings (no confidence intervals) maED( ryegrass.m1, list(LL.5(), LN.4(), W1.4(), W2.4(), FPL.4(-1, 1), FPL.4(-2, 3), FPL.4(-0.5, 0.5)), c(10, 50, 90) ) #> ED10 ED50 ED90 Weight #> LL.4 1.463706 3.057955 6.388640 0.14047308 #> LL.5 1.560325 3.023549 7.729713 0.06816147 #> LN.4 1.489188 3.044673 6.224889 0.12248817 #> W1.4 1.405979 3.088964 5.101022 0.03782468 #> W2.4 1.628278 2.996913 7.805803 0.17886712 #> FPL.4(-1,1) 1.540346 3.038790 7.086271 0.18043370 #> FPL.4(-2,3) 1.507055 3.063612 5.836831 0.08869758 #> FPL.4(-0.5,0.5) 1.531613 3.047967 7.204860 0.18305421 #> #> Estimate #> e:10 1.530770 #> e:50 3.039453 #> e:90 6.891117 ## Model-averaging with Buckland confidence intervals maED( ryegrass.m1, list(LL.5(), LN.4(), W1.4(), W2.4()), c(10, 50, 90), interval = \"buckland\" ) #> ED10 ED50 ED90 Weight #> LL.4 1.463706 3.057955 6.388640 0.25642453 #> LL.5 1.560325 3.023549 7.729713 0.12442435 #> LN.4 1.489188 3.044673 6.224889 0.22359424 #> W1.4 1.405979 3.088964 5.101022 0.06904651 #> W2.4 1.628278 2.996913 7.805803 0.32651037 #> #> Estimate Std. Error Lower Upper #> e:10 1.531174 0.1977800 1.143532 1.918816 #> e:50 3.032914 0.1945023 2.651697 3.414132 #> e:90 6.892701 1.5391238 3.876074 9.909329 ## Model-averaging with Kang confidence intervals maED( ryegrass.m1, list(LL.5(), LN.4(), W1.4(), W2.4()), c(10, 50, 90), interval = \"kang\" ) #> ED10 ED50 ED90 Weight #> LL.4 1.463706 3.057955 6.388640 0.25642453 #> LL.5 1.560325 3.023549 7.729713 0.12442435 #> LN.4 1.489188 3.044673 6.224889 0.22359424 #> W1.4 1.405979 3.088964 5.101022 0.06904651 #> W2.4 1.628278 2.996913 7.805803 0.32651037 #> #> Estimate Std. Error Lower Upper #> e:10 1.531174 0.1977800 1.155988 1.906360 #> e:50 3.032914 0.1945023 2.631988 3.433841 #> e:90 6.892701 1.5391238 4.241165 9.544238"},{"path":"https://hreinwald.github.io/drc/reference/maED_robust.html","id":null,"dir":"Reference","previous_headings":"","what":"Robust Calculation of Model-Averaged Effective Doses — maED_robust","title":"Robust Calculation of Model-Averaged Effective Doses — maED_robust","text":"function serves robust wrapper drc::maED. calculates model-averaged effective doses (EDs) specified response levels. key feature resilience errors; iterates response level individually handles failures gracefully returning NA values level, rather terminating entire operation.","code":""},{"path":"https://hreinwald.github.io/drc/reference/maED_robust.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Robust Calculation of Model-Averaged Effective Doses — maED_robust","text":"","code":"maED_robust( mod, fct_ls = NULL, respLev = c(10, 20, 50), interval = \"buckland\", CI_level = 0.95, verbose = FALSE, ... )"},{"path":"https://hreinwald.github.io/drc/reference/maED_robust.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Robust Calculation of Model-Averaged Effective Doses — maED_robust","text":"mod model object class 'drc', serves base model averaging. fct_ls list alternative dose-response functions (e.g., LL.3(), W1.4()) used model averaging process. list named. respLev numeric vector specifying response levels (percentages) calculate EDs (e.g., c(10, 50) EC10 EC50). interval character string specifying type confidence interval supplied. default \"buckland\". See drc::maED options. CI_level numeric value 0 1 specifying confidence level confidence intervals. Default 0.95. verbose logical value. TRUE, function print status messages calculation progress errors encountered response level. Default FALSE. ... Additional arguments passed underlying drc::maED function.","code":""},{"path":"https://hreinwald.github.io/drc/reference/maED_robust.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Robust Calculation of Model-Averaged Effective Doses — maED_robust","text":"data.frame one row response level specified respLev. columns : Estimate estimated model-averaged effective dose. stderr standard error estimate. Lower lower bound confidence interval. Upper upper bound confidence interval. confint_level confidence level used interval. confint_method method used confidence interval calculation. model character string listing models used averaging. EC response level (percentage). calculation specific response level fails results non-positive estimate, corresponding row contain NA values Estimate, stderr, Lower, Upper.","code":""},{"path":"https://hreinwald.github.io/drc/reference/maED_robust.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Robust Calculation of Model-Averaged Effective Doses — maED_robust","text":"function enhances drc::maED introducing robust calculation loop. iterates element respLev calls drc::maED within tryCatch block. approach isolates failures, preventing error one response level (e.g., EC99 estimated) halting calculation others. Furthermore, successful calculation, function checks resulting 'Estimate' positive. estimate NA, non-positive, tryCatch block catches error, function returns structured row NAs response level, ensuring consistent output format.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/maED_robust.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Robust Calculation of Model-Averaged Effective Doses — maED_robust","text":"Hannes Reinwald","code":""},{"path":"https://hreinwald.github.io/drc/reference/maED_robust.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Robust Calculation of Model-Averaged Effective Doses — maED_robust","text":"","code":"data(lettuce) base_model <- drm(weight ~ conc, data = lettuce, fct = BC.5()) model_list <- list(W2.4 = W2.4()) maED_robust(base_model, fct_ls = model_list, respLev = c(10, 50)) #> Estimate stderr Lower Upper confint_level confint_method #> #> 1: 3.561851 1.610667 0.405001 6.71870 0.95 buckland #> 2: 11.952400 11.849870 -11.272918 35.17772 0.95 buckland #> model EC #> #> 1: BC.5/W2.4 10 #> 2: BC.5/W2.4 50"},{"path":"https://hreinwald.github.io/drc/reference/MAX.html","id":null,"dir":"Reference","previous_headings":"","what":"Maximum mean response — MAX","title":"Maximum mean response — MAX","text":"Estimates maximum mean response dose occurs, using bisection method locate peak fitted dose-response curve. function implemented built-model functions class braincousens cedergreen, capable exhibiting hormesis (.e., non-monotone response stimulatory effect low doses).","code":""},{"path":"https://hreinwald.github.io/drc/reference/MAX.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Maximum mean response — MAX","text":"","code":"MAX(object, lower = 0.001, upper = 1000, pool = TRUE)"},{"path":"https://hreinwald.github.io/drc/reference/MAX.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Maximum mean response — MAX","text":"object object class drc, fitted using drm hormesis model CRS.4c BC.4. lower numeric. Lower bound interval used bisection method search dose maximum response. Must strictly smaller upper set expected dose maximum response. Defaults 1e-3. upper numeric. Upper bound interval used bisection method search dose maximum response. Must strictly larger lower set expected dose maximum response. Defaults 1000. pool logical. TRUE (default), curves pooled computing variance-covariance matrix. Otherwise . argument works models independently fitted curves specified drm. Note: currently variance-covariance matrix retrieved internal consistency standard errors yet reported output.","code":""},{"path":"https://hreinwald.github.io/drc/reference/MAX.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Maximum mean response — MAX","text":"Invisibly returns numeric matrix one row per curve data set two columns: Dose dose maximum mean response occurs, found via bisection within [lower, upper]. Response estimated maximum mean response dose. Row names correspond curve identifiers. computation fails given curve, corresponding row contain NA values warning issued. matrix also printed console via printCoefmat.","code":""},{"path":"https://hreinwald.github.io/drc/reference/MAX.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Maximum mean response — MAX","text":"function numerically locates dose \\(d^*\\) maximises fitted dose-response curve search interval [lower, upper]: $$d^* = \\arg\\max_{d} f(d, \\hat{\\theta})$$ \\(f\\) fitted dose-response function \\(\\hat{\\theta}\\) vector estimated parameters. search performed using bisection approach defined internally model's maxfct component. user's responsibility ensure true maximum lies within [lower, upper]. maximum falls outside interval, function silently return boundary value warning issued.","code":""},{"path":"https://hreinwald.github.io/drc/reference/MAX.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Maximum mean response — MAX","text":"Cedergreen, N., Ritz, C., Streibig, J. C. (2005) Improved empirical models describing hormesis, Environmental Toxicology Chemistry 24, 3166–3172.","code":""},{"path":"https://hreinwald.github.io/drc/reference/MAX.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Maximum mean response — MAX","text":"Christian Ritz. Issues fixed documentation enhanced Hannes Reinwald.","code":""},{"path":"https://hreinwald.github.io/drc/reference/MAX.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Maximum mean response — MAX","text":"","code":"## Fitting a Cedergreen-Ritz-Streibig model lettuce.m1 <- drm(weight ~ conc, data = lettuce, fct = CRS.4c()) ## Finding the maximum mean response and the corresponding dose MAX(lettuce.m1) #> Dose Response #> 1 0.2546 1.1787 ## Custom search interval MAX(lettuce.m1, lower = 1e-5, upper = 500) #> Dose Response #> 1 0.25461 1.1787 ## Capture the result matrix result <- MAX(lettuce.m1) #> Dose Response #> 1 0.2546 1.1787 result[\"Dose\"] #> [1] NA"},{"path":"https://hreinwald.github.io/drc/reference/mdra.html","id":null,"dir":"Reference","previous_headings":"","what":"3T3 mouse fibroblasts and NRU assay — mdra","title":"3T3 mouse fibroblasts and NRU assay — mdra","text":"toxicity sodium valproate tested, using 3T3 mouse fibroblasts neutral red uptake (NRU) assay. 22 different experiments performed independently six laboratories, using eight concentration levels, six replicates 96-well plate. addition, twelve measurements taken solvent control.","code":""},{"path":"https://hreinwald.github.io/drc/reference/mdra.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"3T3 mouse fibroblasts and NRU assay — mdra","text":"","code":"data(\"mdra\")"},{"path":"https://hreinwald.github.io/drc/reference/mdra.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"3T3 mouse fibroblasts and NRU assay — mdra","text":"data frame 1320 observations following 4 variables. LabID factor levels B C D E F ExperimentID factor levels 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 Concentration numeric vector Response numeric vector","code":""},{"path":"https://hreinwald.github.io/drc/reference/mdra.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"3T3 mouse fibroblasts and NRU assay — mdra","text":"http://biostatistics.dkfz.de/download/mdra/MDRA_ExampleData.csv","code":""},{"path":"https://hreinwald.github.io/drc/reference/mdra.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"3T3 mouse fibroblasts and NRU assay — mdra","text":"Clothier, R., Gomez-Lechon, M. J., Kinsner-Ovaskainen, ., Kopp-Schneider, ., O'Connor, J. E., Prieto, P., Stanzel, S. (2013). Comparative analysis eight cytotoxicity assays evaluated within ACuteTox Project. Toxicology vitro, 27(4):1347–1356.","code":""},{"path":"https://hreinwald.github.io/drc/reference/mdra.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"3T3 mouse fibroblasts and NRU assay — mdra","text":"","code":"data(mdra) ## Fit a three-parameter log-logistic model mdra.m1 <- drm(Response ~ Concentration, data = mdra, fct = LL.3()) summary(mdra.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 (3 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 0.87155467 0.05369552 16.231 < 2.2e-16 *** #> d:(Intercept) 1.03125713 0.00904617 113.999 < 2.2e-16 *** #> e:(Intercept) 0.00381995 0.00021312 17.924 < 2.2e-16 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.2333374 (1317 degrees of freedom) plot(mdra.m1, main = \"MDRA dose-response\")"},{"path":"https://hreinwald.github.io/drc/reference/mecter.html","id":null,"dir":"Reference","previous_headings":"","what":"Mechlorprop and terbythylazine tested on Lemna minor — mecter","title":"Mechlorprop and terbythylazine tested on Lemna minor — mecter","text":"Data consist 5 mixture, 6 dilutions, three replicates, 12 common controls; total 102 onservations.","code":""},{"path":"https://hreinwald.github.io/drc/reference/mecter.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Mechlorprop and terbythylazine tested on Lemna minor — mecter","text":"","code":"data(mecter)"},{"path":"https://hreinwald.github.io/drc/reference/mecter.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Mechlorprop and terbythylazine tested on Lemna minor — mecter","text":"data frame 102 observations following 3 variables. dose numeric vector dose values pct numeric vector denoting grouping according mixtures percentages rgr numeric vector response values (relative growth rates)","code":""},{"path":"https://hreinwald.github.io/drc/reference/mecter.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Mechlorprop and terbythylazine tested on Lemna minor — mecter","text":"dataset analysed Soerensen et al (2007). asymmetric Voelund model appropriate, whereas symmetric Hewlett model .","code":""},{"path":"https://hreinwald.github.io/drc/reference/mecter.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Mechlorprop and terbythylazine tested on Lemna minor — mecter","text":"dataset kindly provided Nina Cedergreen, Department Agricultural Sciences, Royal Veterinary Agricultural University, Denmark.","code":""},{"path":"https://hreinwald.github.io/drc/reference/mecter.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Mechlorprop and terbythylazine tested on Lemna minor — mecter","text":"Soerensen, H. Cedergreen, N. Skovgaard, . M. Streibig, J. C. (2007) isobole-based statistical model test synergism/antagonism binary mixture toxicity experiments, Environmental Ecological Statistics, 14, 383–397.","code":""},{"path":"https://hreinwald.github.io/drc/reference/mecter.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Mechlorprop and terbythylazine tested on Lemna minor — mecter","text":"","code":"library(drc) ## Fitting the model with freely varying ED50 values mecter.free <- drm(rgr ~ dose, pct, data = mecter, fct = LL.4(), pmodels = list(~1, ~1, ~1, ~factor(pct) - 1)) #> Control measurements detected for level: 999 ## Lack-of-fit test modelFit(mecter.free) # not really acceptable #> Lack-of-fit test #> #> ModelDf RSS Df F value p value #> ANOVA 71 0.033732 #> DRC model 94 0.063801 23 2.7518 0.0006 summary(mecter.free) #> #> Model fitted: Log-logistic (ED50 as parameter) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 1.1263e+00 1.2130e-01 9.2851 6.153e-15 *** #> c:(Intercept) -4.1327e-02 2.1251e-02 -1.9447 0.0548 . #> d:(Intercept) 3.0006e-01 5.8249e-03 51.5127 < 2.2e-16 *** #> e:100 1.5090e+04 2.4007e+03 6.2856 1.015e-08 *** #> e:75 3.1667e+04 5.2165e+03 6.0705 2.673e-08 *** #> e:50 3.0038e+04 5.0377e+03 5.9627 4.321e-08 *** #> e:25 1.9395e+04 3.2661e+03 5.9382 4.818e-08 *** #> e:0 1.9855e+04 3.5090e+03 5.6583 1.646e-07 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.02605256 (94 degrees of freedom) ## Plotting isobole structure isobole(mecter.free, exchange = 0.02) ## Fitting the concentration addition model mecter.ca <- mixture(mecter.free, model = \"CA\") #> Warning: Using formula(x) is deprecated when x is a character vector of length > 1. #> Consider formula(paste(x, collapse = \" \")) instead. #> Control measurements detected for level: 999 ## Comparing to model with freely varying e parameter anova(mecter.ca, mecter.free) # rejected #> #> 1st model #> fct: CA model #> pmodels: ~~~1, ~1, ~1, ~I(1/(pct/100)) - 1, ~I(1/(1 - pct/100)) - 1 #> 2nd model #> fct: LL.4() #> pmodels: ~1, ~1, ~1, ~factor(pct) - 1 #> #> ANOVA table #> #> ModelDf RSS Df F value p value #> 1st model 97 0.091446 #> 2nd model 94 0.063801 3 13.577 0.000 ## Plotting isobole based on concentration addition isobole(mecter.free, mecter.ca, exchange = 0.02) # poor fit ## Fitting the Hewlett model mecter.hew <- mixture(mecter.free, model = \"Hewlett\") #> Warning: Using formula(x) is deprecated when x is a character vector of length > 1. #> Consider formula(paste(x, collapse = \" \")) instead. #> Control measurements detected for level: 999 ## Comparing to model with freely varying e parameter anova(mecter.hew, mecter.free) # rejected #> #> 1st model #> fct: Hewlett model #> pmodels: ~~~1, ~1, ~1, ~I(1/(pct/100)) - 1, ~I(1/(1 - pct/100)) - 1, ~1 #> 2nd model #> fct: LL.4() #> pmodels: ~1, ~1, ~1, ~factor(pct) - 1 #> #> ANOVA table #> #> ModelDf RSS Df F value p value #> 1st model 96 0.074836 #> 2nd model 94 0.063801 2 8.1286 0.0006 ## Plotting isobole based on the Hewlett model isobole(mecter.free, mecter.hew, exchange = 0.02) # poor fit ## Fitting the Voelund model mecter.voe<-mixture(mecter.free, model = \"Voelund\") #> Warning: Using formula(x) is deprecated when x is a character vector of length > 1. #> Consider formula(paste(x, collapse = \" \")) instead. #> Control measurements detected for level: 999 ## Comparing to model with freely varying e parameter anova(mecter.voe, mecter.free) # accepted #> #> 1st model #> fct: Voelund model #> pmodels: ~~~1, ~1, ~1, ~I(1/(pct/100)) - 1, ~I(1/(1 - pct/100)) - 1, ~1, ~1 #> 2nd model #> fct: LL.4() #> pmodels: ~1, ~1, ~1, ~factor(pct) - 1 #> #> ANOVA table #> #> ModelDf RSS Df F value p value #> 1st model 95 0.065481 #> 2nd model 94 0.063801 1 2.4755 0.1190 ## Plotting isobole based on the Voelund model isobole(mecter.free, mecter.voe, exchange = 0.02) # good fit"},{"path":"https://hreinwald.github.io/drc/reference/metals.html","id":null,"dir":"Reference","previous_headings":"","what":"Data from heavy metal mixture experiments — metals","title":"Data from heavy metal mixture experiments — metals","text":"Data study response cyanobacterial self-luminescent metallothionein-based whole-cell biosensor Synechoccocus elongatus PCC 7942 pBG2120 binary mixtures 6 heavy metals (Zn, Cu, Cd, Ag, Co Hg).","code":""},{"path":"https://hreinwald.github.io/drc/reference/metals.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Data from heavy metal mixture experiments — metals","text":"","code":"data(\"metals\")"},{"path":"https://hreinwald.github.io/drc/reference/metals.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Data from heavy metal mixture experiments — metals","text":"data frame 543 observations following 3 variables. metal factor levels Ag AgCd Cd Co CoAg CoCd Cu CuAg CuCd CuCo CuHg CuZn Hg HgCd HgCo Zn ZnAg ZnCd ZnCo ZnHg conc numeric vector concentrations BIF numeric vector luminescence induction factors","code":""},{"path":"https://hreinwald.github.io/drc/reference/metals.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Data from heavy metal mixture experiments — metals","text":"Data study described Martin-Betancor et al. (2015).","code":""},{"path":"https://hreinwald.github.io/drc/reference/metals.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Data from heavy metal mixture experiments — metals","text":"Martin-Betancor, K. Ritz, C. Fernandez-Pinas, F. Leganes, F. Rodea-Palomares, . (2015) Defining additivity framework mixture research inducible whole-cell biosensors, Scientific Reports 17200.","code":""},{"path":"https://hreinwald.github.io/drc/reference/metals.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Data from heavy metal mixture experiments — metals","text":"","code":"library(drc) ## One example from the paper by Martin-Betancor et al (2015) ## Figure 2 ## Fitting a model for \"Zn\" Zn.lgau <- drm(BIF ~ conc, data = subset(metals, metal == \"Zn\"), fct = lgaussian(), bcVal = 0, bcAdd = 10) ## Plotting data and fitted curve plot(Zn.lgau, log = \"\", type = \"all\", xlab = expression(paste(plain(\"Zn\")^plain(\"2+\"), \" \", mu, \"\", plain(\"M\")))) ## Calculating effective doses ED(Zn.lgau, 50, interval = \"delta\") #> #> Estimated effective doses #> #> Estimate Std. Error Lower Upper #> e:50 3.34241 0.18363 2.96627 3.71855 ED(Zn.lgau, -50, interval = \"delta\", bound = FALSE) #> #> Estimated effective doses #> #> Estimate Std. Error Lower Upper #> e:-50 1.508038 0.082849 1.338329 1.677746 ED(Zn.lgau, 99.999,interval = \"delta\") # approx. for ED0 #> #> Estimated effective doses #> #> Estimate Std. Error Lower Upper #> e:99.999 2.258720 0.058849 2.138173 2.379267 ## Fitting a model for \"Cu\" Cu.lgau <- drm(BIF ~ conc, data = subset(metals, metal == \"Cu\"), fct = lgaussian()) ## Fitting a model for the mixture Cu-Zn CuZn.lgau <- drm(BIF ~ conc, data = subset(metals, metal == \"CuZn\"), fct = lgaussian()) ## Calculating effects needed for the FA-CI plot CuZn.effects <- CIcompX(0.015, list(CuZn.lgau, Cu.lgau, Zn.lgau), c(-5, -10, -20, -30, -40, -50, -60, -70, -80, -90, -99, 99, 90, 80, 70, 60, 50, 40, 30, 20, 10)) ## Reproducing the FA-cI plot shown in Figure 5d plotFACI(CuZn.effects, \"ED\", ylim = c(0.8, 1.6), showPoints = TRUE)"},{"path":"https://hreinwald.github.io/drc/reference/methionine.html","id":null,"dir":"Reference","previous_headings":"","what":"Weight gain for different methionine sources — methionine","title":"Weight gain for different methionine sources — methionine","text":"Data consist average body weight gain chickens treated one two methionine sources DLM HMTBA.","code":""},{"path":"https://hreinwald.github.io/drc/reference/methionine.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Weight gain for different methionine sources — methionine","text":"","code":"data(methionine)"},{"path":"https://hreinwald.github.io/drc/reference/methionine.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Weight gain for different methionine sources — methionine","text":"data frame 9 observations following 3 variables: product factor levels control, DLM MHA denoting treatments dose numeric vector methionine dose gain numeric vector average body weight gain","code":""},{"path":"https://hreinwald.github.io/drc/reference/methionine.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Weight gain for different methionine sources — methionine","text":"dataset contains common control measurement two treatments.","code":""},{"path":"https://hreinwald.github.io/drc/reference/methionine.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Weight gain for different methionine sources — methionine","text":"Kratzer. D. D. Littell, R. C. (2006) Appropriate Statistical Methods Compare Dose Responses Methionine Sources, Poultry Science, 85, 947–954.","code":""},{"path":"https://hreinwald.github.io/drc/reference/methionine.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Weight gain for different methionine sources — methionine","text":"","code":"library(drc) ## Fitting model with constraint on one parameter met.ar.m1 <- drm(gain~dose, product, data = methionine, fct = AR.3(), pmodels = list(~1, ~factor(product), ~factor(product)), upperl = c(Inf, Inf, 1700, Inf, Inf)) #> Control measurements detected for level: control plot(met.ar.m1, xlim=c(0,0.3), ylim=c(1450, 1800)) abline(h=1700, lty=1) summary(met.ar.m1) #> #> Model fitted: Shifted asymptotic regression (3 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> c:(Intercept) 1.4483e+03 2.1249e+01 68.1582 2.776e-07 *** #> d:DLM 1.6887e+03 1.9221e+01 87.8589 1.006e-07 *** #> d:MHA 1.7000e+03 2.0773e+01 81.8359 1.336e-07 *** #> e:DLM 4.4217e-02 1.4050e-02 3.1472 0.03461 * #> e:MHA 5.9462e-02 1.4529e-02 4.0925 0.01494 * #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 22.32469 (4 degrees of freedom)"},{"path":"https://hreinwald.github.io/drc/reference/mixture.html","id":null,"dir":"Reference","previous_headings":"","what":"Fitting binary mixture models — mixture","title":"Fitting binary mixture models — mixture","text":"mixture fits concentration addition, Hewlett Voelund model data binary mixture toxicity experiments.","code":""},{"path":"https://hreinwald.github.io/drc/reference/mixture.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Fitting binary mixture models — mixture","text":"","code":"mixture( object, model = c(\"CA\", \"Hewlett\", \"Voelund\"), start, startm, control = drmc() )"},{"path":"https://hreinwald.github.io/drc/reference/mixture.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Fitting binary mixture models — mixture","text":"object object class 'drc' corresponding model freely varying EC50 values. model character string. can \"CA\", \"Hewlett\" \"Voelund\". start optional numeric vector supplying starting values parameters mixture model. startm optional numeric vector supplying lambda parameter Hewlett model eta parameters (two parameters) Voelund model. control list arguments controlling constrained optimisation (zero boundary), maximum number iteration optimisation, relative tolerance optimisation, warnings issued optimisation.","code":""},{"path":"https://hreinwald.github.io/drc/reference/mixture.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Fitting binary mixture models — mixture","text":"object class 'drc' additional components.","code":""},{"path":"https://hreinwald.github.io/drc/reference/mixture.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Fitting binary mixture models — mixture","text":"function wrapper drm, implementing models described Soerensen et al. (2007). See paper discussion merits different models. Currently log-logistic models available. Application Box-Cox transformation yet available.","code":""},{"path":"https://hreinwald.github.io/drc/reference/mixture.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Fitting binary mixture models — mixture","text":"Ritz, C. Streibig, J. C. (2014) additivity synergism - modelling perspective Synergy, 1, 22–29.","code":""},{"path":"https://hreinwald.github.io/drc/reference/mixture.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Fitting binary mixture models — mixture","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/ml3a.html","id":null,"dir":"Reference","previous_headings":"","what":"Alias for CRS.4a (Deprecated) — ml3a","title":"Alias for CRS.4a (Deprecated) — ml3a","text":"function deprecated alias CRS.4a(), deprecated version 3.3.0. Please use CRS.5() instead, provides general flexible interface.","code":""},{"path":"https://hreinwald.github.io/drc/reference/ml3a.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Alias for CRS.4a (Deprecated) — ml3a","text":"","code":"ml3a(names = c(\"b\", \"c\", \"d\", \"e\", \"f\"), fixed = c(NA, 0, NA, NA, NA), ...)"},{"path":"https://hreinwald.github.io/drc/reference/ml3a.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Alias for CRS.4a (Deprecated) — ml3a","text":"names character vector length 5 specifying names model parameters following order: b Hill slope (steepness dose-response curve). c Lower asymptote (fixed 0 via fixed argument). d Upper asymptote. e Effective dose producing response midway c d (ED50). f Hormesis parameter controlling magnitude stimulatory effect low doses. Defaults c(\"b\", \"c\", \"d\", \"e\", \"f\"). fixed numeric vector length 5 specifying fixed (non-estimated) parameter values. Use NA parameters estimated freely. Defaults c(NA, 0, NA, NA, NA), fixes lower asymptote c 0. ... Additional arguments passed cedergreen().","code":""},{"path":"https://hreinwald.github.io/drc/reference/ml3a.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Alias for CRS.4a (Deprecated) — ml3a","text":"list class \"drcMean\" returned cedergreen(), containing model definition including mean function, gradient, parameter names, fixed values. object intended use fct argument drm().","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/ml3a.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Alias for CRS.4a (Deprecated) — ml3a","text":"Christian Ritz, Hannes Reinwald","code":""},{"path":"https://hreinwald.github.io/drc/reference/ml3a.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Alias for CRS.4a (Deprecated) — ml3a","text":"","code":"# NOTE: ml3a() is a deprecated alias for CRS.4a(). Use CRS.5() instead. # The example below is retained for backward compatibility illustration only. lettuce.crsm1 <- drm( lettuce[, c(2, 1)], fct = ml3a() ) summary(lettuce.crsm1) #> #> Model fitted: Cedergreen-Ritz-Streibig with lower limit 0 (alpha=1) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 7.7892e-01 2.5343e-01 3.0735 0.01177 * #> d:(Intercept) 1.1091e+00 7.8336e-02 14.1586 6.081e-08 *** #> e:(Intercept) 2.8572e+01 3.1328e+01 0.9120 0.38322 #> f:(Intercept) 5.5833e-04 4.1209e-01 0.0014 0.99895 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.155635 (10 degrees of freedom) ED(lettuce.crsm1, c(50)) #> #> Estimated effective doses #> #> Estimate Std. Error #> e:50 28.608 11.751 # Recommended replacement: fct_spec <- CRS.5(alpha_type = \"a\", fixed = c(NA, 0, NA, NA, NA)) lettuce.crs5 <- drm(lettuce[, c(2, 1)], fct = fct_spec) summary(lettuce.crs5) #> #> Model fitted: Cedergreen-Ritz-Streibig (alpha=1) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 7.7892e-01 2.5343e-01 3.0735 0.01177 * #> d:(Intercept) 1.1091e+00 7.8336e-02 14.1586 6.081e-08 *** #> e:(Intercept) 2.8572e+01 3.1328e+01 0.9120 0.38322 #> f:(Intercept) 5.5833e-04 4.1209e-01 0.0014 0.99895 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.155635 (10 degrees of freedom) ED(lettuce.crs5, c(50)) #> #> Estimated effective doses #> #> Estimate Std. Error #> e:50 28.608 11.751"},{"path":"https://hreinwald.github.io/drc/reference/ml3b.html","id":null,"dir":"Reference","previous_headings":"","what":"Alias for CRS.4b (Deprecated) — ml3b","title":"Alias for CRS.4b (Deprecated) — ml3b","text":"function deprecated alias CRS.4b(), deprecated version 3.3.0. Please use CRS.5() instead, provides general flexible interface.","code":""},{"path":"https://hreinwald.github.io/drc/reference/ml3b.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Alias for CRS.4b (Deprecated) — ml3b","text":"","code":"ml3b(names = c(\"b\", \"c\", \"d\", \"e\", \"f\"), fixed = c(NA, 0, NA, NA, NA), ...)"},{"path":"https://hreinwald.github.io/drc/reference/ml3b.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Alias for CRS.4b (Deprecated) — ml3b","text":"names character vector length 5 specifying names model parameters following order: b Hill slope (steepness dose-response curve). c Lower asymptote (fixed 0 via fixed argument). d Upper asymptote. e Effective dose producing response midway c d (ED50). f Hormesis parameter controlling magnitude stimulatory effect low doses. Defaults c(\"b\", \"c\", \"d\", \"e\", \"f\"). fixed numeric vector length 5 specifying fixed (non-estimated) parameter values. Use NA parameters estimated freely. Defaults c(NA, 0, NA, NA, NA), fixes lower asymptote c 0. ... Additional arguments passed cedergreen().","code":""},{"path":"https://hreinwald.github.io/drc/reference/ml3b.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Alias for CRS.4b (Deprecated) — ml3b","text":"list class \"drcMean\" returned cedergreen(), containing model definition including mean function, gradient, parameter names, fixed values. object intended use fct argument drm().","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/ml3b.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Alias for CRS.4b (Deprecated) — ml3b","text":"Christian Ritz, Hannes Reinwald","code":""},{"path":"https://hreinwald.github.io/drc/reference/ml3b.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Alias for CRS.4b (Deprecated) — ml3b","text":"","code":"# NOTE: ml3b() is a deprecated alias for CRS.4b(). Use CRS.5() instead. # The example below is retained for backward compatibility illustration only. lettuce.crsm2 <- drm( lettuce[, c(2, 1)], fct = ml3b() ) summary(lettuce.crsm2) #> #> Model fitted: Cedergreen-Ritz-Streibig with lower limit 0 (alpha=0.5) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 0.569426 0.068538 8.3081 8.444e-06 *** #> d:(Intercept) 1.008915 0.094919 10.6292 9.061e-07 *** #> e:(Intercept) 0.642290 1.533937 0.4187 0.6843 #> f:(Intercept) 4.446933 5.821389 0.7639 0.4626 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.1345066 (10 degrees of freedom) ED(lettuce.crsm2, c(50)) #> #> Estimated effective doses #> #> Estimate Std. Error #> e:50 26.1252 8.6286 # Recommended replacement: fct_spec <- CRS.5(alpha_type = \"b\", fixed = c(NA, 0, NA, NA, NA)) lettuce.crs5 <- drm(lettuce[, c(2, 1)], fct = fct_spec) summary(lettuce.crs5) #> #> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.5) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 0.569426 0.068538 8.3081 8.444e-06 *** #> d:(Intercept) 1.008915 0.094919 10.6292 9.061e-07 *** #> e:(Intercept) 0.642290 1.533937 0.4187 0.6843 #> f:(Intercept) 4.446933 5.821389 0.7639 0.4626 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.1345066 (10 degrees of freedom) ED(lettuce.crs5, c(50)) #> #> Estimated effective doses #> #> Estimate Std. Error #> e:50 26.1252 8.6286"},{"path":"https://hreinwald.github.io/drc/reference/ml3c.html","id":null,"dir":"Reference","previous_headings":"","what":"Alias for CRS.4c (Deprecated) — ml3c","title":"Alias for CRS.4c (Deprecated) — ml3c","text":"function deprecated alias CRS.4c(), deprecated version 3.3.0. Please use CRS.5() instead, provides general flexible interface.","code":""},{"path":"https://hreinwald.github.io/drc/reference/ml3c.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Alias for CRS.4c (Deprecated) — ml3c","text":"","code":"ml3c(names = c(\"b\", \"c\", \"d\", \"e\", \"f\"), fixed = c(NA, 0, NA, NA, NA), ...)"},{"path":"https://hreinwald.github.io/drc/reference/ml3c.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Alias for CRS.4c (Deprecated) — ml3c","text":"names character vector length 5 specifying names model parameters following order: b Hill slope (steepness dose-response curve). c Lower asymptote (fixed 0 via fixed argument). d Upper asymptote. e Effective dose producing response midway c d (ED50). f Hormesis parameter controlling magnitude stimulatory effect low doses. Defaults c(\"b\", \"c\", \"d\", \"e\", \"f\"). fixed numeric vector length 5 specifying fixed (non-estimated) parameter values. Use NA parameters estimated freely. Defaults c(NA, 0, NA, NA, NA), fixes lower asymptote c 0. ... Additional arguments passed cedergreen().","code":""},{"path":"https://hreinwald.github.io/drc/reference/ml3c.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Alias for CRS.4c (Deprecated) — ml3c","text":"list class \"drcMean\" returned cedergreen(), containing model definition including mean function, gradient, parameter names, fixed values. object intended use fct argument drm().","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/ml3c.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Alias for CRS.4c (Deprecated) — ml3c","text":"Christian Ritz, Hannes Reinwald","code":""},{"path":"https://hreinwald.github.io/drc/reference/ml3c.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Alias for CRS.4c (Deprecated) — ml3c","text":"","code":"# NOTE: ml3c() is a deprecated alias for CRS.4c(). Use CRS.5() instead. # The example below is retained for backward compatibility illustration only. lettuce.crsm3 <- drm( lettuce[, c(2, 1)], fct = ml3c() ) summary(lettuce.crsm3) #> #> Model fitted: Cedergreen-Ritz-Streibig with lower limit 0 (alpha=0.25) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 0.488440 0.133643 3.6548 0.004427 ** #> d:(Intercept) 0.973666 0.086883 11.2066 5.544e-07 *** #> e:(Intercept) 1.314657 3.614266 0.3637 0.723624 #> f:(Intercept) 2.998547 3.626210 0.8269 0.427579 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.123575 (10 degrees of freedom) ED(lettuce.crsm3, c(50)) #> #> Estimated effective doses #> #> Estimate Std. Error #> e:50 37.033 15.437 # Recommended replacement: fct_spec <- CRS.5(alpha_type = \"c\", fixed = c(NA, 0, NA, NA, NA)) lettuce.crs5 <- drm(lettuce[, c(2, 1)], fct = fct_spec) summary(lettuce.crs5) #> #> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.25) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 0.488440 0.133643 3.6548 0.004427 ** #> d:(Intercept) 0.973666 0.086883 11.2066 5.544e-07 *** #> e:(Intercept) 1.314657 3.614266 0.3637 0.723624 #> f:(Intercept) 2.998547 3.626210 0.8269 0.427579 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.123575 (10 degrees of freedom) ED(lettuce.crs5, c(50)) #> #> Estimated effective doses #> #> Estimate Std. Error #> e:50 37.033 15.437"},{"path":"https://hreinwald.github.io/drc/reference/ml4a.html","id":null,"dir":"Reference","previous_headings":"","what":"Alias for CRS.5a (Deprecated) — ml4a","title":"Alias for CRS.5a (Deprecated) — ml4a","text":"function deprecated alias CRS.5a(), deprecated version 3.3.0. Please use CRS.5() instead, provides general flexible interface.","code":""},{"path":"https://hreinwald.github.io/drc/reference/ml4a.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Alias for CRS.5a (Deprecated) — ml4a","text":"","code":"ml4a(names = c(\"b\", \"c\", \"d\", \"e\", \"f\"), fixed = c(NA, NA, NA, NA, NA), ...)"},{"path":"https://hreinwald.github.io/drc/reference/ml4a.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Alias for CRS.5a (Deprecated) — ml4a","text":"names character vector length 5 specifying names model parameters following order: b Hill slope (steepness dose-response curve). c Lower asymptote (freely estimated). d Upper asymptote. e Effective dose producing response midway c d (ED50). f Hormesis parameter controlling magnitude stimulatory effect low doses. Defaults c(\"b\", \"c\", \"d\", \"e\", \"f\"). fixed numeric vector length 5 specifying fixed (non-estimated) parameter values. Use NA parameters estimated freely. Defaults c(NA, NA, NA, NA, NA), meaning five parameters freely estimated. ... Additional arguments passed cedergreen().","code":""},{"path":"https://hreinwald.github.io/drc/reference/ml4a.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Alias for CRS.5a (Deprecated) — ml4a","text":"list class \"drcMean\" returned cedergreen(), containing model definition including mean function, gradient, parameter names, fixed values. object intended use fct argument drm().","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/ml4a.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Alias for CRS.5a (Deprecated) — ml4a","text":"Christian Ritz, Hannes Reinwald","code":""},{"path":"https://hreinwald.github.io/drc/reference/ml4a.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Alias for CRS.5a (Deprecated) — ml4a","text":"","code":"# NOTE: ml4a() is a deprecated alias for CRS.5a(). Use CRS.5() instead. # The example below is retained for backward compatibility illustration only. lettuce.m1 <- drm( lettuce[, c(2, 1)], fct = ml4a() ) summary(lettuce.m1) #> #> Model fitted: Cedergreen-Ritz-Streibig (alpha=1) (5 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 1.334173 0.358675 3.7197 0.004773 ** #> c:(Intercept) 0.447962 0.080700 5.5510 0.000356 *** #> d:(Intercept) 1.035658 0.077323 13.3940 3.004e-07 *** #> e:(Intercept) 1.337869 1.185153 1.1289 0.288148 #> f:(Intercept) 1.993259 2.017541 0.9880 0.348985 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.1305067 (9 degrees of freedom) ED(lettuce.m1, c(50)) #> #> Estimated effective doses #> #> Estimate Std. Error #> e:50 5.5439 1.9480 # Recommended replacement: lettuce.crs5 <- drm( lettuce[, c(2, 1)], fct = CRS.5(alpha_type = \"a\") ) summary(lettuce.crs5) #> #> Model fitted: Cedergreen-Ritz-Streibig (alpha=1) (5 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 1.334173 0.358675 3.7197 0.004773 ** #> c:(Intercept) 0.447962 0.080700 5.5510 0.000356 *** #> d:(Intercept) 1.035658 0.077323 13.3940 3.004e-07 *** #> e:(Intercept) 1.337869 1.185153 1.1289 0.288148 #> f:(Intercept) 1.993259 2.017541 0.9880 0.348985 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.1305067 (9 degrees of freedom) ED(lettuce.crs5, c(50)) #> #> Estimated effective doses #> #> Estimate Std. Error #> e:50 5.5439 1.9480"},{"path":"https://hreinwald.github.io/drc/reference/ml4b.html","id":null,"dir":"Reference","previous_headings":"","what":"Alias for CRS.5b (Deprecated) — ml4b","title":"Alias for CRS.5b (Deprecated) — ml4b","text":"function deprecated alias CRS.5b(), deprecated version 3.3.0. Please use CRS.5() instead, provides general flexible interface.","code":""},{"path":"https://hreinwald.github.io/drc/reference/ml4b.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Alias for CRS.5b (Deprecated) — ml4b","text":"","code":"ml4b(names = c(\"b\", \"c\", \"d\", \"e\", \"f\"), fixed = c(NA, NA, NA, NA, NA), ...)"},{"path":"https://hreinwald.github.io/drc/reference/ml4b.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Alias for CRS.5b (Deprecated) — ml4b","text":"names character vector length 5 specifying names model parameters following order: b Hill slope (steepness dose-response curve). c Lower asymptote (freely estimated). d Upper asymptote. e Effective dose producing response midway c d (ED50). f Hormesis parameter controlling magnitude stimulatory effect low doses. Defaults c(\"b\", \"c\", \"d\", \"e\", \"f\"). fixed numeric vector length 5 specifying fixed (non-estimated) parameter values. Use NA parameters estimated freely. Defaults c(NA, NA, NA, NA, NA), meaning five parameters freely estimated. ... Additional arguments passed cedergreen().","code":""},{"path":"https://hreinwald.github.io/drc/reference/ml4b.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Alias for CRS.5b (Deprecated) — ml4b","text":"list class \"drcMean\" returned cedergreen(), containing model definition including mean function, gradient, parameter names, fixed values. object intended use fct argument drm().","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/ml4b.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Alias for CRS.5b (Deprecated) — ml4b","text":"Christian Ritz, Hannes Reinwald","code":""},{"path":"https://hreinwald.github.io/drc/reference/ml4b.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Alias for CRS.5b (Deprecated) — ml4b","text":"","code":"# NOTE: ml4b() is a deprecated alias for CRS.5b(). Use CRS.5() instead. # The example below is retained for backward compatibility illustration only. lettuce.m2 <- drm( lettuce[, c(2, 1)], fct = ml4b() ) summary(lettuce.m2) #> #> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.5) (5 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 0.806096 0.537800 1.4989 0.1681 #> c:(Intercept) 0.316586 0.199024 1.5907 0.1461 #> d:(Intercept) 0.971581 0.081936 11.8577 8.523e-07 *** #> e:(Intercept) 0.814111 2.969068 0.2742 0.7901 #> f:(Intercept) 3.288976 8.216399 0.4003 0.6983 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.1167711 (9 degrees of freedom) ED(lettuce.m2, c(50)) #> #> Estimated effective doses #> #> Estimate Std. Error #> e:50 11.550 8.603 # Recommended replacement: lettuce.crs5 <- drm( lettuce[, c(2, 1)], fct = CRS.5(alpha_type = \"b\") ) summary(lettuce.crs5) #> #> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.5) (5 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 0.806096 0.537800 1.4989 0.1681 #> c:(Intercept) 0.316586 0.199024 1.5907 0.1461 #> d:(Intercept) 0.971581 0.081936 11.8577 8.523e-07 *** #> e:(Intercept) 0.814111 2.969068 0.2742 0.7901 #> f:(Intercept) 3.288976 8.216399 0.4003 0.6983 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.1167711 (9 degrees of freedom) ED(lettuce.crs5, c(50)) #> #> Estimated effective doses #> #> Estimate Std. Error #> e:50 11.550 8.603"},{"path":"https://hreinwald.github.io/drc/reference/ml4c.html","id":null,"dir":"Reference","previous_headings":"","what":"Alias for CRS.5c (Deprecated) — ml4c","title":"Alias for CRS.5c (Deprecated) — ml4c","text":"function deprecated alias CRS.5c(), deprecated version 3.3.0. Please use CRS.5() instead, provides general flexible interface.","code":""},{"path":"https://hreinwald.github.io/drc/reference/ml4c.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Alias for CRS.5c (Deprecated) — ml4c","text":"","code":"ml4c(names = c(\"b\", \"c\", \"d\", \"e\", \"f\"), fixed = c(NA, NA, NA, NA, NA), ...)"},{"path":"https://hreinwald.github.io/drc/reference/ml4c.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Alias for CRS.5c (Deprecated) — ml4c","text":"names character vector length 5 specifying names model parameters following order: b Hill slope (steepness dose-response curve). c Lower asymptote (freely estimated). d Upper asymptote. e Effective dose producing response midway c d (ED50). f Hormesis parameter controlling magnitude stimulatory effect low doses. Defaults c(\"b\", \"c\", \"d\", \"e\", \"f\"). fixed numeric vector length 5 specifying fixed (non-estimated) parameter values. Use NA parameters estimated freely. Defaults c(NA, NA, NA, NA, NA), meaning five parameters freely estimated. ... Additional arguments passed cedergreen().","code":""},{"path":"https://hreinwald.github.io/drc/reference/ml4c.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Alias for CRS.5c (Deprecated) — ml4c","text":"list class \"drcMean\" returned cedergreen(), containing model definition including mean function, gradient, parameter names, fixed values. object intended use fct argument drm().","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/ml4c.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Alias for CRS.5c (Deprecated) — ml4c","text":"Christian Ritz, Hannes Reinwald","code":""},{"path":"https://hreinwald.github.io/drc/reference/ml4c.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Alias for CRS.5c (Deprecated) — ml4c","text":"","code":"# NOTE: ml4c() is a deprecated alias for CRS.5c(). Use CRS.5() instead. # The example below is retained for backward compatibility illustration only. lettuce.m3 <- drm( lettuce[, c(2, 1)], fct = ml4c() ) summary(lettuce.m3) #> #> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.25) (5 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 0.981945 0.559334 1.7556 0.11305 #> c:(Intercept) 0.336670 0.182883 1.8409 0.09877 . #> d:(Intercept) 0.969845 0.088261 10.9883 1.624e-06 *** #> e:(Intercept) 3.883893 2.462313 1.5773 0.14917 #> f:(Intercept) 1.027934 0.766823 1.3405 0.21293 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.1256841 (9 degrees of freedom) ED(lettuce.m3, c(50)) #> #> Estimated effective doses #> #> Estimate Std. Error #> e:50 11.4243 8.7214 # Recommended replacement: lettuce.crs5 <- drm( lettuce[, c(2, 1)], fct = CRS.5(alpha_type = \"c\") ) summary(lettuce.crs5) #> #> Model fitted: Cedergreen-Ritz-Streibig (alpha=0.25) (5 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 0.981945 0.559334 1.7556 0.11305 #> c:(Intercept) 0.336670 0.182883 1.8409 0.09877 . #> d:(Intercept) 0.969845 0.088261 10.9883 1.624e-06 *** #> e:(Intercept) 3.883893 2.462313 1.5773 0.14917 #> f:(Intercept) 1.027934 0.766823 1.3405 0.21293 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.1256841 (9 degrees of freedom) ED(lettuce.crs5, c(50)) #> #> Estimated effective doses #> #> Estimate Std. Error #> e:50 11.4243 8.7214"},{"path":"https://hreinwald.github.io/drc/reference/MM.2.html","id":null,"dir":"Reference","previous_headings":"","what":"Two-parameter Michaelis-Menten function — MM.2","title":"Two-parameter Michaelis-Menten function — MM.2","text":"two-parameter Michaelis-Menten function b fixed -1, c 0, f 1. Commonly used enzyme kinetics weed density studies.","code":""},{"path":"https://hreinwald.github.io/drc/reference/MM.2.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Two-parameter Michaelis-Menten function — MM.2","text":"","code":"MM.2(fixed = c(NA, NA), names = c(\"d\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/MM.2.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Two-parameter Michaelis-Menten function — MM.2","text":"fixed numeric vector length 2, specifying fixed parameters (use NA non-fixed parameters). names character vector length 2, specifying names parameters (default: d, e). ... additional arguments llogistic.","code":""},{"path":"https://hreinwald.github.io/drc/reference/MM.2.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Two-parameter Michaelis-Menten function — MM.2","text":"See llogistic.","code":""},{"path":"https://hreinwald.github.io/drc/reference/MM.2.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Two-parameter Michaelis-Menten function — MM.2","text":"two-parameter Michaelis-Menten function $$f(x) = \\frac{d \\cdot x}{e + x}$$ equivalent \\(d/(1+(e/x))\\).","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/MM.2.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Two-parameter Michaelis-Menten function — MM.2","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/MM.2.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Two-parameter Michaelis-Menten function — MM.2","text":"","code":"met.mm.m1 <- drm(gain~dose, product, data = methionine, fct = MM.2()) #> Control measurements detected for level: control"},{"path":"https://hreinwald.github.io/drc/reference/MM.3.html","id":null,"dir":"Reference","previous_headings":"","what":"Three-parameter Michaelis-Menten function — MM.3","title":"Three-parameter Michaelis-Menten function — MM.3","text":"three-parameter (shifted) Michaelis-Menten function b fixed -1 f 1.","code":""},{"path":"https://hreinwald.github.io/drc/reference/MM.3.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Three-parameter Michaelis-Menten function — MM.3","text":"","code":"MM.3(fixed = c(NA, NA, NA), names = c(\"c\", \"d\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/MM.3.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Three-parameter Michaelis-Menten function — MM.3","text":"fixed numeric vector length 3, specifying fixed parameters (use NA non-fixed parameters). names character vector length 3, specifying names parameters (default: c, d, e). ... additional arguments llogistic.","code":""},{"path":"https://hreinwald.github.io/drc/reference/MM.3.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Three-parameter Michaelis-Menten function — MM.3","text":"See llogistic.","code":""},{"path":"https://hreinwald.github.io/drc/reference/MM.3.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Three-parameter Michaelis-Menten function — MM.3","text":"three-parameter Michaelis-Menten function $$f(x) = c + \\frac{d-c}{1+(e/x)}$$","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/MM.3.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Three-parameter Michaelis-Menten function — MM.3","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/MM.3.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Three-parameter Michaelis-Menten function — MM.3","text":"","code":"met.mm.m1 <- drm(gain~dose, product, data = methionine, fct = MM.3()) #> Control measurements detected for level: control"},{"path":"https://hreinwald.github.io/drc/reference/modelFit.html","id":null,"dir":"Reference","previous_headings":"","what":"Assessing the model fit — modelFit","title":"Assessing the model fit — modelFit","text":"Checking fit dose-response model means formal significance tests.","code":""},{"path":"https://hreinwald.github.io/drc/reference/modelFit.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Assessing the model fit — modelFit","text":"","code":"modelFit(object, test = NULL, method = c(\"gof\", \"cum\"))"},{"path":"https://hreinwald.github.io/drc/reference/modelFit.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Assessing the model fit — modelFit","text":"object object class 'drc'. test character string defining test method apply. method character string specifying method used assessing model fit.","code":""},{"path":"https://hreinwald.github.io/drc/reference/modelFit.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Assessing the model fit — modelFit","text":"object class 'anova' displayed much way ordinary ANOVA table.","code":""},{"path":"https://hreinwald.github.io/drc/reference/modelFit.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Assessing the model fit — modelFit","text":"Currently two methods available. continuous data classical lack--fit test applied (Bates Watts, 1988). test compares dose-response model general ANOVA model using approximate F-test. quantal data crude goodness--fit test based Pearson's statistic used. None tests powerful. significant test result alarming non-significant one.","code":""},{"path":"https://hreinwald.github.io/drc/reference/modelFit.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Assessing the model fit — modelFit","text":"Bates, D. M. Watts, D. G. (1988) Nonlinear Regression Analysis Applications, New York: Wiley & Sons (pp. 103–104).","code":""},{"path":"https://hreinwald.github.io/drc/reference/modelFit.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Assessing the model fit — modelFit","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/modelFit.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Assessing the model fit — modelFit","text":"","code":"## Comparing the four-parameter log-logistic model ## to a one-way ANOVA model using an approximate F test ## in other words applying a lack-of-fit test ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) modelFit(ryegrass.m1) #> Lack-of-fit test #> #> ModelDf RSS Df F value p value #> ANOVA 17 5.1799 #> DRC model 20 6.0242 3 0.9236 0.4506"},{"path":"https://hreinwald.github.io/drc/reference/modelFunction.html","id":null,"dir":"Reference","previous_headings":"","what":"Create model evaluation function — modelFunction","title":"Create model evaluation function — modelFunction","text":"Create model evaluation function","code":""},{"path":"https://hreinwald.github.io/drc/reference/modelFunction.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Create model evaluation function — modelFunction","text":"","code":"modelFunction( dose, parm2mat, drcFct, cm, assayNoOld, upperPos, retFct, doseScaling, respScaling, isFinite, pshifts = NULL )"},{"path":"https://hreinwald.github.io/drc/reference/mr.test.html","id":null,"dir":"Reference","previous_headings":"","what":"Mizon-Richard test for dose-response models — mr.test","title":"Mizon-Richard test for dose-response models — mr.test","text":"function provides lack--fit test mean structure based Mizon-Richard test compared specific alternative model.","code":""},{"path":"https://hreinwald.github.io/drc/reference/mr.test.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Mizon-Richard test for dose-response models — mr.test","text":"","code":"mr.test(object1, object2, object, x, var.equal = TRUE, component = 1)"},{"path":"https://hreinwald.github.io/drc/reference/mr.test.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Mizon-Richard test for dose-response models — mr.test","text":"object1 object class 'drc' (null model). object2 object class 'drc' (alternative model). object object class 'drc' (fitted model alternative). x numeric vector dose values. var.equal logical indicating whether equal variances can assumed across doses. component numeric vector specifying component(s) parameter vector use test.","code":""},{"path":"https://hreinwald.github.io/drc/reference/mr.test.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Mizon-Richard test for dose-response models — mr.test","text":"p-value test null hypothesis chosen mean structure appropriate compared alternative mean structure provided (see Ritz Martinussen (2011) detailed explanation).","code":""},{"path":"https://hreinwald.github.io/drc/reference/mr.test.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Mizon-Richard test for dose-response models — mr.test","text":"function provides p-value indicating whether mean structure appropriate. test applicable even cases data non-normal exhibit variance heterogeneity.","code":""},{"path":"https://hreinwald.github.io/drc/reference/mr.test.html","id":"note","dir":"Reference","previous_headings":"","what":"Note","title":"Mizon-Richard test for dose-response models — mr.test","text":"functionality still experimental: Currently, null alternative models hardcoded! future function working null alternative models specified user.","code":""},{"path":"https://hreinwald.github.io/drc/reference/mr.test.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Mizon-Richard test for dose-response models — mr.test","text":"Ritz, C Martinussen, T. (2011) Lack--fit tests assessing mean structures continuous dose-response data, Environmental Ecological Statistics, 18, 349–366","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/mr.test.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Mizon-Richard test for dose-response models — mr.test","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/mr.test.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Mizon-Richard test for dose-response models — mr.test","text":"","code":"## Fitting log-logistic and Weibull models ## The Weibull model is the alternative etmotc.m1<-drm(rgr1~dose1, data=etmotc[1:15,], fct=LL.4()) etmotc.m2 <- update(etmotc.m1, fct=W1.4()) ## Fitting the fitted model (using the alternative model) etmotc.m3 <- drm(fitted(etmotc.m1)~dose1, data=etmotc[1:15,], fct=W1.4()) ## Handling missing values xVec <- etmotc[1:15,]$dose1 xVec[1:8] <- 1e-10 # avoiding 0's ## Obtaining the Mizon-Richard test mr.test(etmotc.m1, etmotc.m2, etmotc.m3, xVec, var.equal = FALSE) #> Statistic p-value Difference SE #> -1.65084985 0.09876924 -0.01936982 0.01173324"},{"path":"https://hreinwald.github.io/drc/reference/mselect.html","id":null,"dir":"Reference","previous_headings":"","what":"Dose-response model selection — mselect","title":"Dose-response model selection — mselect","text":"Model selection comparison different models using following criteria: log likelihood value, Akaike's information criterion (AIC), estimated residual standard error p-value lack--fit test.","code":""},{"path":"https://hreinwald.github.io/drc/reference/mselect.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Dose-response model selection — mselect","text":"","code":"mselect( object, fctList = NULL, nested = FALSE, sorted = c(\"IC\", \"Res var\", \"Lack of fit\", \"no\"), linreg = FALSE, icfct = AIC )"},{"path":"https://hreinwald.github.io/drc/reference/mselect.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Dose-response model selection — mselect","text":"object object class 'drc'. fctList list dose-response functions compared. nested logical. TRUE results F tests adjacent models (fctList). sensible nested models. sorted character string determining according criterion model fits ranked. linreg logical indicating whether additionally polynomial regression models (linear, quadratic, cubic models) fitted. icfct function supplying information criterion used. AIC BIC two options.","code":""},{"path":"https://hreinwald.github.io/drc/reference/mselect.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Dose-response model selection — mselect","text":"matrix one row model one column criterion.","code":""},{"path":"https://hreinwald.github.io/drc/reference/mselect.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Dose-response model selection — mselect","text":"Akaike's information criterion residual standard error: smaller better lack--fit test (one-way ANOVA model): larger (p-value) better. Note residual standard error available continuous dose-response data. Log likelihood values used comparison unless models nested.","code":""},{"path":"https://hreinwald.github.io/drc/reference/mselect.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Dose-response model selection — mselect","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/mselect.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Dose-response model selection — mselect","text":"","code":"### Example with continuous/quantitative data ## Fitting initial four-parameter log-logistic model ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) ## Model selection mselect(ryegrass.m1, list(LL.3(), LL.5(), W1.3(), W1.4(), W2.4(), baro5())) #> logLik IC Lack of fit Res var #> W2.4 -15.91352 41.82703 0.94507131 0.2646283 #> LL.4 -16.15514 42.31029 0.86648304 0.2700107 #> baro5 -15.86422 43.72844 0.86239408 0.2774141 #> LL.5 -15.87828 43.75656 0.85384758 0.2777393 #> W1.4 -17.46720 44.93439 0.45056762 0.3012075 #> LL.3 -18.60413 45.20827 0.35316787 0.3153724 #> W1.3 -22.22047 52.44094 0.04379149 0.4262881 ## Model selection including linear, quadratic, and cubic regression models mselect(ryegrass.m1, list(LL.3(), LL.5(), W1.3(), W1.4(), W2.4(), baro5()), linreg = TRUE) #> logLik IC Lack of fit Res var #> W2.4 -15.91352 41.82703 0.94507131 0.2646283 #> LL.4 -16.15514 42.31029 0.86648304 0.2700107 #> baro5 -15.86422 43.72844 0.86239408 0.2774141 #> LL.5 -15.87828 43.75656 0.85384758 0.2777393 #> W1.4 -17.46720 44.93439 0.45056762 0.3012075 #> LL.3 -18.60413 45.20827 0.35316787 0.3153724 #> W1.3 -22.22047 52.44094 0.04379149 0.4262881 #> Cubic -25.53428 61.06856 NA 0.5899609 #> Quad -35.11558 78.23116 NA 1.2485122 #> Lin -50.47554 106.95109 NA 4.2863247 ## Comparing nested models mselect(ryegrass.m1, list(LL.5()), nested = TRUE) #> logLik IC Lack of fit Res var Nested F test #> LL.4 -16.15514 42.31029 0.8664830 0.2700107 NA #> LL.5 -15.87828 43.75656 0.8538476 0.2777393 0.5134602"},{"path":"https://hreinwald.github.io/drc/reference/multi2.html","id":null,"dir":"Reference","previous_headings":"","what":"Multistage Dose-Response Model with Quadratic Terms — multi2","title":"Multistage Dose-Response Model with Quadratic Terms — multi2","text":"five-parameter multistage dose-response model useful describing complex dose-response patterns.","code":""},{"path":"https://hreinwald.github.io/drc/reference/multi2.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Multistage Dose-Response Model with Quadratic Terms — multi2","text":"","code":"multi2( fixed = c(NA, NA, NA, NA, NA), names = c(\"b1\", \"b2\", \"b3\", \"c\", \"d\"), ssfct = NULL, fctName, fctText )"},{"path":"https://hreinwald.github.io/drc/reference/multi2.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Multistage Dose-Response Model with Quadratic Terms — multi2","text":"fixed numeric vector specifying parameters fixed value fixed. NAs used parameters fixed. names vector character strings giving names parameters (contain \":\"). default reasonable. ssfct self starter function used. fctName optional character string used internally convenience functions. fctText optional character string used internally convenience functions.","code":""},{"path":"https://hreinwald.github.io/drc/reference/multi2.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Multistage Dose-Response Model with Quadratic Terms — multi2","text":"list containing nonlinear function, self starter function, parameter names.","code":""},{"path":"https://hreinwald.github.io/drc/reference/multi2.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Multistage Dose-Response Model with Quadratic Terms — multi2","text":"multistage model function quadratic terms : $$f(x) = c + (d-c)\\exp(-b1 - b2 x - b3 x^2)$$ x denotes dose logarithm-transformed dose.","code":""},{"path":"https://hreinwald.github.io/drc/reference/multi2.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Multistage Dose-Response Model with Quadratic Terms — multi2","text":"Wheeler, M. W., Bailer, . J. (2009) Comparing model averaging model selection strategies benchmark dose estimation, Environmental Ecological Statistics, 16, 37–51.","code":""},{"path":"https://hreinwald.github.io/drc/reference/multi2.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Multistage Dose-Response Model with Quadratic Terms — multi2","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/nasturtium.html","id":null,"dir":"Reference","previous_headings":"","what":"Dose-response profile of degradation of agrochemical using nasturtium — nasturtium","title":"Dose-response profile of degradation of agrochemical using nasturtium — nasturtium","text":"Estimation degradation profile agrochemical based soil samples depth 0-10cm calibration experiment.","code":""},{"path":"https://hreinwald.github.io/drc/reference/nasturtium.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Dose-response profile of degradation of agrochemical using nasturtium — nasturtium","text":"","code":"data(nasturtium)"},{"path":"https://hreinwald.github.io/drc/reference/nasturtium.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Dose-response profile of degradation of agrochemical using nasturtium — nasturtium","text":"data frame 42 observations following 2 variables. conc numeric vector concentrations (g/ha) wt numeric vector plant weight (mg) 3 weeks' growth rep numeric vector replicates","code":""},{"path":"https://hreinwald.github.io/drc/reference/nasturtium.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Dose-response profile of degradation of agrochemical using nasturtium — nasturtium","text":"experiment seven concentrations six replicates per concentration. Nasturtium sensitive weight reduces noticeable low concentrations. Racine-Poon (1988) suggests using three-parameter log-logistic model.","code":""},{"path":"https://hreinwald.github.io/drc/reference/nasturtium.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Dose-response profile of degradation of agrochemical using nasturtium — nasturtium","text":"Racine-Poon, . (1988) Bayesian Approach Nonlinear Calibration Problems, J. . Statist. Ass., 83, 650–656.","code":""},{"path":"https://hreinwald.github.io/drc/reference/nasturtium.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Dose-response profile of degradation of agrochemical using nasturtium — nasturtium","text":"","code":"library(drc) nasturtium.m1 <- drm(wt~conc, data=nasturtium, fct = LL.3()) modelFit(nasturtium.m1) #> Lack-of-fit test #> #> ModelDf RSS Df F value p value #> ANOVA 35 104464 #> DRC model 39 120387 4 1.3337 0.2768 plot(nasturtium.m1, type = \"all\", log = \"\", xlab = \"Concentration (g/ha)\", ylab = \"Weight (mg)\")"},{"path":"https://hreinwald.github.io/drc/reference/NEC.2.html","id":null,"dir":"Reference","previous_headings":"","what":"Two-parameter NEC model — NEC.2","title":"Two-parameter NEC model — NEC.2","text":"Convenience function NEC model lower limit fixed 0 upper limit fixed.","code":""},{"path":"https://hreinwald.github.io/drc/reference/NEC.2.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Two-parameter NEC model — NEC.2","text":"","code":"NEC.2(upper = 1, fixed = c(NA, NA), names = c(\"b\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/NEC.2.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Two-parameter NEC model — NEC.2","text":"upper numeric value. fixed upper limit model. Default 1. fixed numeric vector length 2 specifying fixed parameters (NAs free parameters). names character vector parameter names. ... additional arguments passed NEC.","code":""},{"path":"https://hreinwald.github.io/drc/reference/NEC.2.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Two-parameter NEC model — NEC.2","text":"list (see NEC).","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/NEC.3.html","id":null,"dir":"Reference","previous_headings":"","what":"Three-parameter NEC model — NEC.3","title":"Three-parameter NEC model — NEC.3","text":"Convenience function NEC model lower limit fixed 0.","code":""},{"path":"https://hreinwald.github.io/drc/reference/NEC.3.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Three-parameter NEC model — NEC.3","text":"","code":"NEC.3(fixed = c(NA, NA, NA), names = c(\"b\", \"d\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/NEC.3.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Three-parameter NEC model — NEC.3","text":"fixed numeric vector length 3 specifying fixed parameters (NAs free parameters). names character vector parameter names. ... additional arguments passed NEC.","code":""},{"path":"https://hreinwald.github.io/drc/reference/NEC.3.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Three-parameter NEC model — NEC.3","text":"list (see NEC).","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/NEC.4.html","id":null,"dir":"Reference","previous_headings":"","what":"Four-parameter NEC model — NEC.4","title":"Four-parameter NEC model — NEC.4","text":"Convenience function full four-parameter NEC model.","code":""},{"path":"https://hreinwald.github.io/drc/reference/NEC.4.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Four-parameter NEC model — NEC.4","text":"","code":"NEC.4(fixed = c(NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/NEC.4.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Four-parameter NEC model — NEC.4","text":"fixed numeric vector length 4 specifying fixed parameters (NAs free parameters). names character vector parameter names. ... additional arguments passed NEC.","code":""},{"path":"https://hreinwald.github.io/drc/reference/NEC.4.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Four-parameter NEC model — NEC.4","text":"list (see NEC).","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/NEC.html","id":null,"dir":"Reference","previous_headings":"","what":"No Effect Concentration (NEC) dose-response model — NEC","title":"No Effect Concentration (NEC) dose-response model — NEC","text":"NEC model dose-response model threshold response assumed constant equal control response. proposed alternative classical NOEC regression-based EC/ED approach.","code":""},{"path":"https://hreinwald.github.io/drc/reference/NEC.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"No Effect Concentration (NEC) dose-response model — NEC","text":"","code":"NEC(fixed = c(NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\"), fctName, fctText)"},{"path":"https://hreinwald.github.io/drc/reference/NEC.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"No Effect Concentration (NEC) dose-response model — NEC","text":"fixed numeric vector specifying parameters fixed value fixed. NAs used parameters fixed. names vector character strings giving names parameters (contain \":\"). default reasonable (see 'Usage'). fctName optional character string used internally convenience functions. fctText optional character string used internally convenience functions.","code":""},{"path":"https://hreinwald.github.io/drc/reference/NEC.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"No Effect Concentration (NEC) dose-response model — NEC","text":"list containing nonlinear function, self starter function parameter names.","code":""},{"path":"https://hreinwald.github.io/drc/reference/NEC.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"No Effect Concentration (NEC) dose-response model — NEC","text":"NEC model function proposed Pires et al (2002) : $$f(x) = c + (d-c)\\exp(-b(x-e)(x-e))$$ \\((x-e)\\) indicator function equal 0 \\(x<=e\\) 1 \\(x>e\\).","code":""},{"path":"https://hreinwald.github.io/drc/reference/NEC.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"No Effect Concentration (NEC) dose-response model — NEC","text":"Pires, . M., Branco, J. ., Picado, ., Mendonca, E. (2002) Models estimation 'effect concentration', Environmetrics, 13, 15–27.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/NEC.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"No Effect Concentration (NEC) dose-response model — NEC","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/NEC.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"No Effect Concentration (NEC) dose-response model — NEC","text":"","code":"nec.m1 <- drm(rootl ~ conc, data = ryegrass, fct = NEC.4()) summary(nec.m1) #> #> Model fitted: NEC (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 3.16938 393.27265 0.0081 0.993650 #> c:(Intercept) 0.67201 0.23463 2.8641 0.009592 ** #> d:(Intercept) 7.39666 0.20260 36.5091 < 2.2e-16 *** #> e:(Intercept) 3.41729 41.27705 0.0828 0.934842 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.7017905 (20 degrees of freedom) plot(nec.m1)"},{"path":"https://hreinwald.github.io/drc/reference/neill.test.html","id":null,"dir":"Reference","previous_headings":"","what":"Neill's lack-of-fit test for dose-response models — neill.test","title":"Neill's lack-of-fit test for dose-response models — neill.test","text":"neill.test provides lack--fit test non-linear regression models. applicable cases replicates (case reduces standard lack--fit test ANOVA model) cases replicates, though grouping provided.","code":""},{"path":"https://hreinwald.github.io/drc/reference/neill.test.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Neill's lack-of-fit test for dose-response models — neill.test","text":"","code":"neill.test( object, grouping, method = c(\"c-finest\", \"finest\", \"percentiles\"), breakp = NULL, display = TRUE )"},{"path":"https://hreinwald.github.io/drc/reference/neill.test.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Neill's lack-of-fit test for dose-response models — neill.test","text":"object object class 'drc' 'nls'. grouping character numeric vector provides grouping dose values. method character string specifying method used generate grouping dose values. breakp numeric vector break points generating dose intervals form grouping. display logical. TRUE results displayed. Otherwise (useful simulations).","code":""},{"path":"https://hreinwald.github.io/drc/reference/neill.test.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Neill's lack-of-fit test for dose-response models — neill.test","text":"function returns object class anova displayed using print.anova.","code":""},{"path":"https://hreinwald.github.io/drc/reference/neill.test.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Neill's lack-of-fit test for dose-response models — neill.test","text":"functions use methods df.residual residuals data component object (determining number observations).","code":""},{"path":"https://hreinwald.github.io/drc/reference/neill.test.html","id":"note","dir":"Reference","previous_headings":"","what":"Note","title":"Neill's lack-of-fit test for dose-response models — neill.test","text":"clustering technique employed determine grouping used cases replicates. ceiling(n/2) clusters otherwise observations used test. end need clusters parameters model.","code":""},{"path":"https://hreinwald.github.io/drc/reference/neill.test.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Neill's lack-of-fit test for dose-response models — neill.test","text":"Neill, J. W. (1988) Testing lack fit nonlinear regression, Ann. Statist., 16, 733–740","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/neill.test.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Neill's lack-of-fit test for dose-response models — neill.test","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/neill.test.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Neill's lack-of-fit test for dose-response models — neill.test","text":"","code":"### Example with 'drc' object ## Lack-of-fit test against ANOVA ryegrass.m1 <-drm(rootl~conc, data = ryegrass, fct = LL.4()) modelFit(ryegrass.m1) #> Lack-of-fit test #> #> ModelDf RSS Df F value p value #> ANOVA 17 5.1799 #> DRC model 20 5.4002 3 0.2411 0.8665 ## The same test using 'neill.test' neill.test(ryegrass.m1, ryegrass$conc) #> Grouping used #> #> 0 0.94 1.88 3.75 7.5 15 30 #> 6 3 3 3 3 3 3 #> #> Neill's lack-of-fit test #> #> F value p value #> 0.2411 0.8665 ## Generating a grouping neill.test(ryegrass.m1, method=\"c-finest\") #> Grouping used #> #> 1 2 3 4 5 6 7 #> 6 3 3 3 3 3 3 #> #> Neill's lack-of-fit test #> #> F value p value #> 0.2411 0.8665 neill.test(ryegrass.m1, method=\"finest\") #> Grouping used #> #> 1 2 3 4 5 6 7 8 9 10 11 12 #> 2 2 2 2 2 2 2 2 2 2 2 2 #> #> Neill's lack-of-fit test #> #> F value p value #> 1.0625 0.4462 neill.test(ryegrass.m1, method=\"perc\") #> Grouping used #> #> (-Inf,0] (0,1.88] (1.88,3.75] (3.75,15] (15, Inf] #> 6 6 3 6 3 #> #> Neill's lack-of-fit test #> #> F value p value #> 0.7545 0.3959"},{"path":"https://hreinwald.github.io/drc/reference/nfa.html","id":null,"dir":"Reference","previous_headings":"","what":"Network Formation Assay Data — nfa","title":"Network Formation Assay Data — nfa","text":"Neurotoxicity test using network formation assay studying inhibition network formation acrylamide exposure.","code":""},{"path":"https://hreinwald.github.io/drc/reference/nfa.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Network Formation Assay Data — nfa","text":"","code":"data(nfa)"},{"path":"https://hreinwald.github.io/drc/reference/nfa.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Network Formation Assay Data — nfa","text":"data frame 45 observations following 4 variables. chip chip ID conc 7 concentrations acrylamide, ranging 0-5mM experiment factor levels 1 2 denoting two consecutive experiments response Number connections [%]","code":""},{"path":"https://hreinwald.github.io/drc/reference/nfa.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Network Formation Assay Data — nfa","text":"Frimat, JP, Sisnaiske, J, Subbiah, S, Menne, H, Godoy, P, Lampen, P, Leist, M, Franzke, J, Hengstler, JG, van Thriel, C, West, J. network formation assay: spatially standardized neurite outgrowth analytical display neurotoxicity screening. Lab Chip 2010; 10:701-709.","code":""},{"path":"https://hreinwald.github.io/drc/reference/nfa.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Network Formation Assay Data — nfa","text":"","code":"data(nfa) ## Fit a four-parameter log-logistic model nfa.m1 <- drm(response ~ conc, data = nfa, fct = LL.4()) summary(nfa.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 1.828165 0.429684 4.2547 0.0001184 *** #> c:(Intercept) -3.879086 5.620773 -0.6901 0.4939982 #> d:(Intercept) 88.533870 2.366218 37.4158 < 2.2e-16 *** #> e:(Intercept) 0.730916 0.086889 8.4121 1.813e-10 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 9.591243 (41 degrees of freedom) plot(nfa.m1, main = \"NFA dose-response\")"},{"path":"https://hreinwald.github.io/drc/reference/nicotine.html","id":null,"dir":"Reference","previous_headings":"","what":"nicotine — nicotine","title":"nicotine — nicotine","text":"Data acute toxicity test nicotine. several concentrations, total number subjects number dead subjects recorded.","code":""},{"path":"https://hreinwald.github.io/drc/reference/nicotine.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"nicotine — nicotine","text":"","code":"data(nicotine)"},{"path":"https://hreinwald.github.io/drc/reference/nicotine.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"nicotine — nicotine","text":"data frame 12 observations following 3 variables. conc numeric vector total numeric vector num.dead numeric vector","code":""},{"path":"https://hreinwald.github.io/drc/reference/nicotine.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"nicotine — nicotine","text":"","code":"library(drc) ## Displaying the data head(nicotine) #> conc total num.dead #> 1 0.0000 45 3 #> 2 0.0025 50 5 #> 3 0.0050 46 4 #> 4 0.0100 50 3 #> 5 0.0200 46 11 #> 6 0.0300 46 20 ## Fitting a two-parameter log-logistic model for binomial response nicotine.m1 <- drm(num.dead/total ~ conc, weights = total, data = nicotine, fct = LL.2(), type = \"binomial\") summary(nicotine.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) -1.7590301 0.1470173 -11.965 < 2.2e-16 *** #> e:(Intercept) 0.0288876 0.0021099 13.691 < 2.2e-16 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## Plotting the fitted curve plot(nicotine.m1, xlab = \"Concentration\", ylab = \"Proportion dead\", ylim = c(0, 1))"},{"path":"https://hreinwald.github.io/drc/reference/noEffect.html","id":null,"dir":"Reference","previous_headings":"","what":"Testing if there is a dose effect at all — noEffect","title":"Testing if there is a dose effect at all — noEffect","text":"significance test provided comparison dose-response model considered simple linear regression model slope 0 (horizontal regression line corresponding dose effect).","code":""},{"path":"https://hreinwald.github.io/drc/reference/noEffect.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Testing if there is a dose effect at all — noEffect","text":"","code":"noEffect(object)"},{"path":"https://hreinwald.github.io/drc/reference/noEffect.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Testing if there is a dose effect at all — noEffect","text":"object object class 'drc'.","code":""},{"path":"https://hreinwald.github.io/drc/reference/noEffect.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Testing if there is a dose effect at all — noEffect","text":"likelihood ratio test statistic corresponding degrees freedom p-value reported.","code":""},{"path":"https://hreinwald.github.io/drc/reference/noEffect.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Testing if there is a dose effect at all — noEffect","text":"Perhaps useful screening purposes.","code":""},{"path":"https://hreinwald.github.io/drc/reference/noEffect.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Testing if there is a dose effect at all — noEffect","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/noEffect.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Testing if there is a dose effect at all — noEffect","text":"","code":"ryegrass.LL.4 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) noEffect(ryegrass.LL.4) #> Chi-square test Df p-value #> 91.87776 3.00000 0.00000 # p-value < 0.0001: there is a highly significant dose effect!"},{"path":"https://hreinwald.github.io/drc/reference/O.mykiss.html","id":null,"dir":"Reference","previous_headings":"","what":"Test data from a 21 day fish test — O.mykiss","title":"Test data from a 21 day fish test — O.mykiss","text":"Test data 21 day fish test following guidelines OECD GL204, using test organism Rainbow trout Oncorhynchus mykiss.","code":""},{"path":"https://hreinwald.github.io/drc/reference/O.mykiss.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Test data from a 21 day fish test — O.mykiss","text":"","code":"data(O.mykiss)"},{"path":"https://hreinwald.github.io/drc/reference/O.mykiss.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Test data from a 21 day fish test — O.mykiss","text":"data frame 70 observations following 2 variables. conc numeric vector concentrations (mg/l) weight numeric vector wet weights (g)","code":""},{"path":"https://hreinwald.github.io/drc/reference/O.mykiss.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Test data from a 21 day fish test — O.mykiss","text":"Weights measured 28 days.","code":""},{"path":"https://hreinwald.github.io/drc/reference/O.mykiss.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Test data from a 21 day fish test — O.mykiss","text":"Organisation Economic Co-operation Development (OECD) (2006) CURRENT APPROACHES STATISTICAL ANALYSIS ECOTOXICITY DATA: GUIDANCE APPLICATION - ANNEXES, Paris (p. 65).","code":""},{"path":"https://hreinwald.github.io/drc/reference/O.mykiss.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Test data from a 21 day fish test — O.mykiss","text":"Organisation Economic Co-operation Development (OECD) (2006) CURRENT APPROACHES STATISTICAL ANALYSIS ECOTOXICITY DATA: GUIDANCE APPLICATION - ANNEXES, Paris (pp. 80–85).","code":""},{"path":"https://hreinwald.github.io/drc/reference/O.mykiss.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Test data from a 21 day fish test — O.mykiss","text":"","code":"library(drc) head(O.mykiss) #> conc weight #> 1 0 2.8 #> 2 0 3.0 #> 3 0 2.7 #> 4 0 3.9 #> 5 0 3.1 #> 6 0 1.8 ## Fitting exponential model O.mykiss.m1 <- drm(weight ~ conc, data = O.mykiss, fct = EXD.2(), na.action = na.omit) modelFit(O.mykiss.m1) #> Lack-of-fit test #> #> ModelDf RSS Df F value p value #> ANOVA 54 17.620 #> DRC model 59 18.492 5 0.5351 0.7488 summary(O.mykiss.m1) #> #> Model fitted: Exponential decay with lower limit at 0 (2 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> d:(Intercept) 2.846794 0.092526 30.7674 < 2.2e-16 *** #> e:(Intercept) 111.738614 33.196876 3.3659 0.001347 ** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.5598508 (59 degrees of freedom) ## Fitting same model with transform-both-sides approach O.mykiss.m2 <- boxcox(O.mykiss.m1 , method = \"anova\") summary(O.mykiss.m2) #> #> Model fitted: Exponential decay with lower limit at 0 (2 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> d:(Intercept) 2.841793 0.094431 30.0937 < 2.2e-16 *** #> e:(Intercept) 104.115039 28.024151 3.7152 0.000453 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.4246342 (59 degrees of freedom) #> #> Non-normality/heterogeneity adjustment through Box-Cox transformation #> #> Estimated lambda: 0.707 #> Confidence interval for lambda: [-0.0109, 1.5368] #> # no need for a transformation ## Plotting the fit plot(O.mykiss.m1, type = \"all\", xlim = c(0, 500), ylim = c(0,4), xlab = \"Concentration (mg/l)\", ylab = \"Weight (g)\", broken = TRUE)"},{"path":"https://hreinwald.github.io/drc/reference/P.promelas.html","id":null,"dir":"Reference","previous_headings":"","what":"Effect of sodium pentachlorophenate on growth of fathead minnow — P.promelas","title":"Effect of sodium pentachlorophenate on growth of fathead minnow — P.promelas","text":"Fathead minnows (Pimephales promelas) exposed sodium pentachlorophenate concentrations ranging 32 512 micro g/L 7-day larval survival growth test. average dry weight measured.","code":""},{"path":"https://hreinwald.github.io/drc/reference/P.promelas.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Effect of sodium pentachlorophenate on growth of fathead minnow — P.promelas","text":"","code":"data(P.promelas)"},{"path":"https://hreinwald.github.io/drc/reference/P.promelas.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Effect of sodium pentachlorophenate on growth of fathead minnow — P.promelas","text":"data frame 24 observations following 2 variables. conc numeric vector sodium pentachlorophenate concentrations (micro g/L). dryweight numeric vector dry weights (mg)","code":""},{"path":"https://hreinwald.github.io/drc/reference/P.promelas.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Effect of sodium pentachlorophenate on growth of fathead minnow — P.promelas","text":"data analysed Bruce Versteeg (1992) using log-normal dose-response model (using logarithm base 10).","code":""},{"path":"https://hreinwald.github.io/drc/reference/P.promelas.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Effect of sodium pentachlorophenate on growth of fathead minnow — P.promelas","text":"Bruce, R. D. Versteeg, D. J. (1992) statistical procedure modeling continuous toxicity data, Environ. Toxicol. Chem., 11, 1485–1494.","code":""},{"path":"https://hreinwald.github.io/drc/reference/P.promelas.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Effect of sodium pentachlorophenate on growth of fathead minnow — P.promelas","text":"","code":"library(drc) ## Model with ED50 on log scale as parameter p.prom.m1<-drm(dryweight~conc, data=P.promelas, fct=LN.3()) plot(fitted(p.prom.m1), residuals(p.prom.m1)) plot(p.prom.m1, type=\"all\", broken=TRUE, xlim=c(0,1000)) summary(p.prom.m1) #> #> Model fitted: Log-normal with lower limit at 0 (3 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) -0.571777 0.187101 -3.0560 0.006001 ** #> d:(Intercept) 0.704855 0.025553 27.5845 < 2.2e-16 *** #> e:(Intercept) 1145.654281 392.624568 2.9179 0.008223 ** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.05467719 (21 degrees of freedom) ED(p.prom.m1, c(10,20,50), interval=\"delta\") #> #> Estimated effective doses #> #> Estimate Std. Error Lower Upper #> e:10 121.8002 59.4612 -1.8561 245.4565 #> e:20 262.9046 72.2694 112.6121 413.1970 #> e:50 1145.6543 392.6246 329.1468 1962.1618 ## Model with ED50 as parameter p.prom.m2<-drm(dryweight~conc, data=P.promelas, fct=LN.3(loge=TRUE)) summary(p.prom.m2) #> #> Model fitted: Log-normal with lower limit at 0 (3 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) -0.571671 0.187187 -3.054 0.006028 ** #> d:(Intercept) 0.704852 0.025555 27.581 < 2.2e-16 *** #> e:(Intercept) 7.044103 0.343117 20.530 2.221e-15 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.05467719 (21 degrees of freedom) ED(p.prom.m2, c(10,20,50), interval=\"fls\") #> #> Estimated effective doses #> #> Estimate Std. Error Lower Upper #> e:10 121.79469 0.48838 44.11055 336.29021 #> e:20 262.93031 0.27492 148.43715 465.73480 #> e:50 1146.08015 0.34312 561.46613 2339.41042"},{"path":"https://hreinwald.github.io/drc/reference/pickParm.html","id":null,"dir":"Reference","previous_headings":"","what":"Pick parameters from model — pickParm","title":"Pick parameters from model — pickParm","text":"Pick parameters model","code":""},{"path":"https://hreinwald.github.io/drc/reference/pickParm.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Pick parameters from model — pickParm","text":"","code":"pickParm(parmVec, indexVec, parmNo)"},{"path":"https://hreinwald.github.io/drc/reference/plot.drc.html","id":null,"dir":"Reference","previous_headings":"","what":"Plotting fitted dose-response curves — plot.drc","title":"Plotting fitted dose-response curves — plot.drc","text":"plot displays fitted curves observations plot window, distinguishing curves different plot symbols line types.","code":""},{"path":"https://hreinwald.github.io/drc/reference/plot.drc.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Plotting fitted dose-response curves — plot.drc","text":"","code":"# S3 method for class 'drc' plot( x, ..., add = FALSE, level = NULL, type = c(\"average\", \"all\", \"bars\", \"none\", \"obs\", \"confidence\"), broken = FALSE, bp, bcontrol = NULL, conName = NULL, axes = TRUE, gridsize = 100, log = \"x\", xtsty, xttrim = TRUE, xt = NULL, xtlab = NULL, xlab, xlim, yt = NULL, ytlab = NULL, ylab, ylim, cex, cex.axis = 1, col = FALSE, errbar.col = NULL, errbar.lwd = NULL, lty, pch, legend, legendText, legendPos, cex.legend = 1, normal = FALSE, normRef = 1, confidence.level = 0.95 )"},{"path":"https://hreinwald.github.io/drc/reference/plot.drc.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Plotting fitted dose-response curves — plot.drc","text":"x object class 'drc'. ... additional graphical arguments. instance, use lwd=2 lwd=3 increase width plot symbols. add logical. TRUE add already existing plot. level vector character strings. plot curves specified names. type character string specifying plot data. Options : \"average\" (averages fitted curve(s); default), \"none\" (fitted curve(s)), \"obs\" (data points), \"\" (data points fitted curve(s)), \"bars\" (averages fitted curve(s) model-based standard errors), \"confidence\" (confidence bands fitted curve(s)). broken logical. TRUE x axis broken provided axis logarithmic (using functionality CRAN package 'plotrix'). bp numeric value specifying break point dose zero. default base-10 value corresponding rounded value minimum log10 values positive dose values. works logarithmic dose axes. bcontrol list components factor, style width controlling appearance break (broken TRUE). conName character string. Name x axis dose zero. Default \"0\". axes logical indicating whether axes drawn plot. gridsize numeric. Number points grid used plotting fitted curves. log character string contains \"x\" x axis logarithmic, \"y\" y axis logarithmic \"xy\" \"yx\" axes logarithmic. default \"x\". empty string \"\" yields original axes. xtsty character string specifying dose axis style arrangement tick marks. default logarithmic axis base 10 tick marks shown (\"base10\"). Otherwise sensible equidistantly located tick marks shown (\"standard\"). xttrim logical specifying number tick marks trimmed case many tick marks initially determined. xt numeric vector containing positions tick marks x axis. xtlab vector containing tick marks x axis. xlab optional label x axis. xlim numeric vector length two, containing lower upper limit x axis. yt numeric vector containing positions tick marks y axis. ytlab vector containing tick marks y axis. ylab optional label y axis. ylim numeric vector length two, containing lower upper limit y axis. cex numeric numeric vector specifying size plotting symbols text (see par details). cex.axis numeric value specifying magnification used axis annotation relative current setting cex. col either logical vector colours. TRUE default colours used. FALSE (default) colours used. errbar.col colour(s) error bars using type = \"bars\". NULL (default), error bars match curve colours specified col. Use errbar.col = \"black\" restore previous behaviour black error bars. errbar.lwd line width(s) error bars using type = \"bars\". NULL (default), error bars inherit line width specified lwd (via ...). lwd also specified, default graphical parameter par(\"lwd\") used. lty numeric vector specifying line types. pch vector plotting characters symbols (see points). legend logical. TRUE legend displayed. legendText character string vector character strings specifying legend text. legendPos numeric vector length 2 giving position legend. cex.legend numeric specifying legend text size. normal logical. TRUE plot normalized data fitted curves shown (see Weimer et al. (2012) details). normRef numeric specifying reference normalization (default 1). confidence.level confidence level error bars. Defaults 0.95.","code":""},{"path":"https://hreinwald.github.io/drc/reference/plot.drc.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Plotting fitted dose-response curves — plot.drc","text":"invisible data frame values used plotting fitted curves. first column contains dose values, following columns (one curve) contain fitted response values.","code":""},{"path":"https://hreinwald.github.io/drc/reference/plot.drc.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Plotting fitted dose-response curves — plot.drc","text":"use xlim allows changing range x axis, extrapolating fitted dose-response curves. Note changing range x axis may also entail change range y axis. Sometimes may useful extend upper limit y axis (using ylim) order fit legend plot. See colors available colours. Suitable labels automatically provided. arguments broken bcontrol rely function axis.break arguments style brw package plotrix. model-based standard errors used error bars calculated fitted value plus/minus estimated error times 1-(alpha/2) quantile t distribution degrees freedom equal residual degrees freedom model (using standard normal distribution case binomial Poisson data), alpha = 1 - confidence.level. standard errors obtained using predict method arguments interval = \"confidence\" level = confidence.level.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/plot.drc.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Plotting fitted dose-response curves — plot.drc","text":"Christian Ritz Jens C. Streibig. Contributions Xiaoyan Wang Greg Warnes.","code":""},{"path":"https://hreinwald.github.io/drc/reference/plot.drc.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Plotting fitted dose-response curves — plot.drc","text":"","code":"## Fitting models to be plotted below ryegrass.m1 <- drm(rootl~conc, data = ryegrass, fct = LL.4()) ryegrass.m2 <- drm(rootl~conc, data = ryegrass, fct = LL.3()) ## Plotting observations and fitted curve for the first model plot(ryegrass.m1, broken = TRUE) ## Adding fitted curve for the second model plot(ryegrass.m2, broken = TRUE, add = TRUE, type = \"none\", col = 2, lty = 2) ## Add confidence region for the first model plot(ryegrass.m1, broken = TRUE, type=\"confidence\", add=TRUE) ## Fitting model with multiple curves spinach.m1 <- drm(SLOPE~DOSE, CURVE, data = spinach, fct = LL.4()) ## Plot with default colours plot(spinach.m1, col = TRUE, main = \"Default colours\")"},{"path":"https://hreinwald.github.io/drc/reference/plotFACI.html","id":null,"dir":"Reference","previous_headings":"","what":"Plot combination index as a function of fraction affected — plotFACI","title":"Plot combination index as a function of fraction affected — plotFACI","text":"Visualizes combination index CIcompX function fraction affected.","code":""},{"path":"https://hreinwald.github.io/drc/reference/plotFACI.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Plot combination index as a function of fraction affected — plotFACI","text":"","code":"plotFACI( effList, indAxis = c(\"ED\", \"EF\"), caRef = TRUE, showPoints = FALSE, add = FALSE, ylim, ... )"},{"path":"https://hreinwald.github.io/drc/reference/plotFACI.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Plot combination index as a function of fraction affected — plotFACI","text":"effList list returned CIcompX. indAxis character string. Either \"ED\" effective doses \"EF\" effects. caRef logical. TRUE (default), reference line concentration addition drawn. showPoints logical. TRUE, estimated combination indices plotted points. add logical. TRUE, plot added existing plot. ylim numeric vector length 2 giving range y axis. ... additional graphical arguments.","code":""},{"path":"https://hreinwald.github.io/drc/reference/plotFACI.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Plot combination index as a function of fraction affected — plotFACI","text":"Invisibly returns plot matrix combination index values.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/plotFACI.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Plot combination index as a function of fraction affected — plotFACI","text":"Christian Ritz Ismael Rodea-Palomares","code":""},{"path":"https://hreinwald.github.io/drc/reference/PR.html","id":null,"dir":"Reference","previous_headings":"","what":"Expected or predicted response — PR","title":"Expected or predicted response — PR","text":"Returns expected predicted response specified dose values. convenience function easy access predicted values.","code":""},{"path":"https://hreinwald.github.io/drc/reference/PR.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Expected or predicted response — PR","text":"","code":"PR(object, xVec, ...)"},{"path":"https://hreinwald.github.io/drc/reference/PR.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Expected or predicted response — PR","text":"object object class drc obtained fitting dose-response model. xVec numeric vector dose values. ... additional arguments passed predict.drc.","code":""},{"path":"https://hreinwald.github.io/drc/reference/PR.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Expected or predicted response — PR","text":"numeric vector predicted values possibly matrix predicted values corresponding standard errors.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/PR.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Expected or predicted response — PR","text":"Christian Ritz suggestion Andrew Kniss.","code":""},{"path":"https://hreinwald.github.io/drc/reference/PR.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Expected or predicted response — PR","text":"","code":"ryegrass.m1 <- drm(ryegrass, fct = LL.4()) PR(ryegrass.m1, c(5, 10)) #> 5 10 #> 1.8523337 0.6888809"},{"path":"https://hreinwald.github.io/drc/reference/predict.drc.html","id":null,"dir":"Reference","previous_headings":"","what":"Prediction — predict.drc","title":"Prediction — predict.drc","text":"Predicted values models class 'drc'.","code":""},{"path":"https://hreinwald.github.io/drc/reference/predict.drc.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Prediction — predict.drc","text":"","code":"# S3 method for class 'drc' predict( object, newdata, se.fit = FALSE, interval = c(\"none\", \"confidence\", \"prediction\", \"ssd\"), level = 0.95, na.action = na.pass, od = FALSE, vcov. = vcov, ssdSEfct = NULL, constrain = TRUE, checkND = TRUE, ... )"},{"path":"https://hreinwald.github.io/drc/reference/predict.drc.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Prediction — predict.drc","text":"object object class 'drc'. newdata optional data frame look variables predict. omitted, fitted values used. se.fit logical. TRUE standard errors required. interval character string. Type interval calculation: \"none\", \"confidence\", \"prediction\", \"ssd\". level tolerance/confidence level. na.action function determining done missing values newdata. default predict NA. od logical. TRUE adjustment -dispersion used. vcov. function providing variance-covariance matrix. vcov default, sandwich also option (obtaining robust standard errors). ssdSEfct specifies function interpolating standard errors observed standard errors. default linear interpolation log-log scale (back-transformed). constrain logical. TRUE (default) predicted values truncated within meaningful limits, .e., 0 , possibly, 1. checkND logical indicating whether names newdata data frame match names original data frame used fitting model. Default TRUE. ... arguments passed methods.","code":""},{"path":"https://hreinwald.github.io/drc/reference/predict.drc.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Prediction — predict.drc","text":"matrix many rows dose values provided newdata original dataset (case newdata specified) , , 4 columns containing fitted values, standard errors, lower upper limits confidence/prediction intervals.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/predict.drc.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Prediction — predict.drc","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/predict.drc.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Prediction — predict.drc","text":"","code":"## Fitting a model spinach.model1 <- drm(SLOPE~DOSE, CURVE, data = spinach, fct = LL.4()) ## Predicting values at dose=2 (with standard errors) predict(spinach.model1, data.frame(dose=2, CURVE=c(\"1\", \"2\", \"3\")), se.fit = TRUE) #> Prediction SE #> [1,] 0.9048476 0.02496135 #> [2,] 0.4208307 0.02924987 #> [3,] 0.5581673 0.03067170 ## Getting confidence intervals predict(spinach.model1, data.frame(dose=2, CURVE=c(\"1\", \"2\", \"3\")), interval = \"confidence\") #> Prediction Lower Upper #> [1,] 0.9048476 0.8552178 0.9544775 #> [2,] 0.4208307 0.3626741 0.4789873 #> [3,] 0.5581673 0.4971838 0.6191509 ## Getting prediction intervals predict(spinach.model1, data.frame(dose=2, CURVE=c(\"1\", \"2\", \"3\")), interval = \"prediction\") #> Prediction Lower Upper #> [1,] 0.9048476 0.7504590 1.0592363 #> [2,] 0.4208307 0.2634937 0.5781677 #> [3,] 0.5581673 0.3997636 0.7165710"},{"path":"https://hreinwald.github.io/drc/reference/print.drc.html","id":null,"dir":"Reference","previous_headings":"","what":"Printing key features — print.drc","title":"Printing key features — print.drc","text":"print displays brief information object class 'drc'.","code":""},{"path":"https://hreinwald.github.io/drc/reference/print.drc.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Printing key features — print.drc","text":"","code":"# S3 method for class 'drc' print(x, ..., digits = max(3, getOption(\"digits\") - 3))"},{"path":"https://hreinwald.github.io/drc/reference/print.drc.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Printing key features — print.drc","text":"x object class 'drc'. ... additional arguments. digits integer giving number digits parameter coefficients. Default 3.","code":""},{"path":"https://hreinwald.github.io/drc/reference/print.drc.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Printing key features — print.drc","text":"object returned invisibly.","code":""},{"path":"https://hreinwald.github.io/drc/reference/print.drc.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Printing key features — print.drc","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/print.drc.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Printing key features — print.drc","text":"","code":"## Fitting a four-parameter log-logistic model ryegrass.m1 <- drm(rootl ~conc, data = ryegrass, fct = LL.4()) ## Displaying the model fit print(ryegrass.m1) #> #> A 'drc' model. #> #> Call: #> drm(formula = rootl ~ conc, data = ryegrass, fct = LL.4()) #> #> Coefficients: #> b:(Intercept) c:(Intercept) d:(Intercept) e:(Intercept) #> 2.9822 0.4814 7.7930 3.0580 #> ryegrass.m1 # gives the same output as the previous line #> #> A 'drc' model. #> #> Call: #> drm(formula = rootl ~ conc, data = ryegrass, fct = LL.4()) #> #> Coefficients: #> b:(Intercept) c:(Intercept) d:(Intercept) e:(Intercept) #> 2.9822 0.4814 7.7930 3.0580 #>"},{"path":"https://hreinwald.github.io/drc/reference/print.summary.drc.html","id":null,"dir":"Reference","previous_headings":"","what":"Printing summary of non-linear model fits — print.summary.drc","title":"Printing summary of non-linear model fits — print.summary.drc","text":"method produces formatted output summary statistics: parameter estimates, estimated standard errors, z-test statistics corresponding p-values.","code":""},{"path":"https://hreinwald.github.io/drc/reference/print.summary.drc.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Printing summary of non-linear model fits — print.summary.drc","text":"","code":"# S3 method for class 'summary.drc' print(x, ...)"},{"path":"https://hreinwald.github.io/drc/reference/print.summary.drc.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Printing summary of non-linear model fits — print.summary.drc","text":"x object class 'drc'. ... additional arguments.","code":""},{"path":"https://hreinwald.github.io/drc/reference/print.summary.drc.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Printing summary of non-linear model fits — print.summary.drc","text":"object (argument x) returned invisibly.","code":""},{"path":"https://hreinwald.github.io/drc/reference/print.summary.drc.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Printing summary of non-linear model fits — print.summary.drc","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/print.summary.drc.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Printing summary of non-linear model fits — print.summary.drc","text":"","code":"ryegrass.m1 <- drm(rootl~conc, data=ryegrass, fct= LL.4()) summary(ryegrass.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 2.98222 0.46506 6.4125 2.960e-06 *** #> c:(Intercept) 0.48141 0.21219 2.2688 0.03451 * #> d:(Intercept) 7.79296 0.18857 41.3272 < 2.2e-16 *** #> e:(Intercept) 3.05795 0.18573 16.4644 4.268e-13 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.5196256 (20 degrees of freedom)"},{"path":"https://hreinwald.github.io/drc/reference/rdrm.html","id":null,"dir":"Reference","previous_headings":"","what":"Simulating a dose-response curve — rdrm","title":"Simulating a dose-response curve — rdrm","text":"Simulation dose-response curve user-specified dose values error distribution.","code":""},{"path":"https://hreinwald.github.io/drc/reference/rdrm.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Simulating a dose-response curve — rdrm","text":"","code":"rdrm( nosim, fct, mpar, xerror, xpar = 1, yerror = \"rnorm\", ypar = c(0, 1), onlyY = FALSE )"},{"path":"https://hreinwald.github.io/drc/reference/rdrm.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Simulating a dose-response curve — rdrm","text":"nosim numeric. number simulated curves returned. fct list. built-function package drc list similar components. mpar numeric. model parameters supplied fct. xerror numeric character. distribution dose values. xpar numeric vector supplying parameter values defining distribution dose values. xerror distribution remember number dose values also part argument (first argument). yerror numeric character. error distribution response values. ypar numeric vector supplying parameter values defining error distribution response values. onlyY logical. TRUE response values returned (useful simulations). Otherwise dose values response values (binomial data also weights) returned.","code":""},{"path":"https://hreinwald.github.io/drc/reference/rdrm.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Simulating a dose-response curve — rdrm","text":"list 3 components (depending value onlyY argument).","code":""},{"path":"https://hreinwald.github.io/drc/reference/rdrm.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Simulating a dose-response curve — rdrm","text":"distribution dose values can either fixed set dose values (numeric vector) used repeatedly creating curves distribution specified character string resulting varying dose values curve curve. error distribution response values can continuous distribution like rnorm rgamma. Alternatively can binomial distribution rbinom.","code":""},{"path":"https://hreinwald.github.io/drc/reference/rdrm.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Simulating a dose-response curve — rdrm","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/rdrm.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Simulating a dose-response curve — rdrm","text":"","code":"## Simulating normally distributed dose-response data ## Model fit to simulate from ryegrass.m1 <- drm(rootl~conc, data = ryegrass, fct = LL.4()) ## 10 random dose-response curves based on the model fit sim10a <- rdrm(10, LL.4(), coef(ryegrass.m1), xerror = ryegrass$conc) sim10a #> $x #> [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] #> [1,] 0 0 0 0 0 0 0.94 0.94 0.94 1.88 1.88 1.88 3.75 #> [2,] 0 0 0 0 0 0 0.94 0.94 0.94 1.88 1.88 1.88 3.75 #> [3,] 0 0 0 0 0 0 0.94 0.94 0.94 1.88 1.88 1.88 3.75 #> [4,] 0 0 0 0 0 0 0.94 0.94 0.94 1.88 1.88 1.88 3.75 #> [5,] 0 0 0 0 0 0 0.94 0.94 0.94 1.88 1.88 1.88 3.75 #> [6,] 0 0 0 0 0 0 0.94 0.94 0.94 1.88 1.88 1.88 3.75 #> [7,] 0 0 0 0 0 0 0.94 0.94 0.94 1.88 1.88 1.88 3.75 #> [8,] 0 0 0 0 0 0 0.94 0.94 0.94 1.88 1.88 1.88 3.75 #> [9,] 0 0 0 0 0 0 0.94 0.94 0.94 1.88 1.88 1.88 3.75 #> [10,] 0 0 0 0 0 0 0.94 0.94 0.94 1.88 1.88 1.88 3.75 #> [,14] [,15] [,16] [,17] [,18] [,19] [,20] [,21] [,22] [,23] [,24] #> [1,] 3.75 3.75 7.5 7.5 7.5 15 15 15 30 30 30 #> [2,] 3.75 3.75 7.5 7.5 7.5 15 15 15 30 30 30 #> [3,] 3.75 3.75 7.5 7.5 7.5 15 15 15 30 30 30 #> [4,] 3.75 3.75 7.5 7.5 7.5 15 15 15 30 30 30 #> [5,] 3.75 3.75 7.5 7.5 7.5 15 15 15 30 30 30 #> [6,] 3.75 3.75 7.5 7.5 7.5 15 15 15 30 30 30 #> [7,] 3.75 3.75 7.5 7.5 7.5 15 15 15 30 30 30 #> [8,] 3.75 3.75 7.5 7.5 7.5 15 15 15 30 30 30 #> [9,] 3.75 3.75 7.5 7.5 7.5 15 15 15 30 30 30 #> [10,] 3.75 3.75 7.5 7.5 7.5 15 15 15 30 30 30 #> #> $y #> [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] #> [1,] 8.066417 7.161786 7.222872 7.433376 7.642343 7.093628 7.923545 8.284291 #> [2,] 7.505974 6.078136 6.503759 9.352759 8.065649 6.720029 5.781844 9.058972 #> [3,] 8.327354 8.645831 8.467516 6.698238 7.510698 7.972966 6.409988 8.056339 #> [4,] 9.096690 7.312124 7.864879 8.735890 7.560072 7.266967 6.735318 7.963788 #> [5,] 7.258083 7.368628 7.055604 7.881555 9.301122 7.410662 8.285907 5.714209 #> [6,] 8.925786 8.569848 8.836314 6.614582 6.187379 9.516748 7.477650 7.078747 #> [7,] 7.756834 7.929422 8.581864 7.078809 7.346530 8.146883 9.577975 6.928401 #> [8,] 6.745958 7.191619 7.892295 8.153598 7.667378 8.120790 7.654978 5.718323 #> [9,] 6.821557 7.894365 8.438348 7.674455 6.469690 6.945612 9.229277 8.995717 #> [10,] 6.432471 6.722794 8.476714 7.572785 7.125783 9.020141 8.071111 6.930408 #> [,9] [,10] [,11] [,12] [,13] [,14] [,15] #> [1,] 7.682404 5.945141 7.216933 6.672380 3.534480 3.682829 2.271530 #> [2,] 7.918867 7.208031 5.846323 6.933062 2.748299 2.012915 4.586617 #> [3,] 7.368475 5.145932 7.872643 7.086995 2.439913 4.865038 3.591403 #> [4,] 7.136487 4.542725 5.603221 7.256139 3.473104 2.556701 2.730241 #> [5,] 7.198957 5.342127 7.880616 5.818385 4.857711 3.314165 3.127980 #> [6,] 7.839711 5.641550 4.678501 6.531467 4.267781 2.426996 3.342862 #> [7,] 9.595229 4.304123 6.371873 6.219813 3.506707 1.541592 2.231613 #> [8,] 6.915723 6.990295 9.310118 7.827924 3.052878 2.193345 2.968142 #> [9,] 8.450324 4.982754 7.405585 5.090363 3.405927 3.903577 2.018578 #> [10,] 8.549147 5.522101 7.072001 7.075904 3.291795 3.194503 3.627527 #> [,16] [,17] [,18] [,19] [,20] [,21] #> [1,] -0.140879059 0.9380080 0.8254205 1.0379614 0.7350702 1.45249011 #> [2,] 0.191662263 0.4805241 1.1798748 1.1113034 1.1001285 0.35779707 #> [3,] 1.240025609 -0.4437699 1.7199829 1.0841137 -1.1948623 1.45354148 #> [4,] 0.187723805 -0.7442005 0.4908456 -0.1032920 0.4326651 1.23307403 #> [5,] -0.917179274 2.0086702 0.3563959 0.5159329 -0.0761879 -1.53666510 #> [6,] 2.007846286 1.3812106 1.1360886 1.2690461 1.2988363 1.29623123 #> [7,] 1.187094786 0.5637970 2.4621087 -0.5056758 -0.1282062 1.85899709 #> [8,] 0.610012833 0.7283811 0.4562212 1.9244428 1.1058905 1.56657138 #> [9,] 2.431699280 1.4385857 3.1617329 1.3540638 0.3321539 1.58547389 #> [10,] 0.008404434 1.3859897 0.9772450 -0.3431308 -0.4085134 0.03729916 #> [,22] [,23] [,24] #> [1,] -0.4207740 1.16833992 -0.1482707 #> [2,] 1.3377319 -1.38459417 0.1999361 #> [3,] 1.1004658 0.63946903 1.6297087 #> [4,] 0.1653214 0.84414207 -0.1439696 #> [5,] 0.9388422 1.83629562 1.9284379 #> [6,] 0.2781959 -0.04695046 -0.5979337 #> [7,] 0.9842609 -0.02732443 1.7252574 #> [8,] -1.2229484 1.57082584 0.4368156 #> [9,] 0.4443086 -0.01412220 2.4056532 #> [10,] -0.4591859 -1.80289191 0.1164907 #> ## Simulating binomial dose-response data ## Model fit to simulate from deguelin.m1 <- drm(r/n~dose, weights=n, data=deguelin, fct=LL.2(), type=\"binomial\") ## 10 random dose-response curves sim10b <- rdrm(10, LL.2(), coef(deguelin.m1), deguelin$dose, yerror=\"rbinom\", ypar=deguelin$n) sim10b #> $x #> [,1] [,2] [,3] [,4] [,5] [,6] #> [1,] 5.128614 10 20.41738 30.19952 40.73803 50.11872 #> [2,] 5.128614 10 20.41738 30.19952 40.73803 50.11872 #> [3,] 5.128614 10 20.41738 30.19952 40.73803 50.11872 #> [4,] 5.128614 10 20.41738 30.19952 40.73803 50.11872 #> [5,] 5.128614 10 20.41738 30.19952 40.73803 50.11872 #> [6,] 5.128614 10 20.41738 30.19952 40.73803 50.11872 #> [7,] 5.128614 10 20.41738 30.19952 40.73803 50.11872 #> [8,] 5.128614 10 20.41738 30.19952 40.73803 50.11872 #> [9,] 5.128614 10 20.41738 30.19952 40.73803 50.11872 #> [10,] 5.128614 10 20.41738 30.19952 40.73803 50.11872 #> #> $w #> [,1] [,2] [,3] [,4] [,5] [,6] #> [1,] 49 48 48 49 50 48 #> [2,] 49 48 48 49 50 48 #> [3,] 49 48 48 49 50 48 #> [4,] 49 48 48 49 50 48 #> [5,] 49 48 48 49 50 48 #> [6,] 49 48 48 49 50 48 #> [7,] 49 48 48 49 50 48 #> [8,] 49 48 48 49 50 48 #> [9,] 49 48 48 49 50 48 #> [10,] 49 48 48 49 50 48 #> #> $y #> [,1] [,2] [,3] [,4] [,5] [,6] #> [1,] 9 29 39 42 48 44 #> [2,] 14 24 40 44 48 48 #> [3,] 13 24 39 41 45 45 #> [4,] 12 19 39 44 43 43 #> [5,] 5 28 36 43 42 42 #> [6,] 11 25 45 38 47 47 #> [7,] 9 20 41 40 49 47 #> [8,] 9 25 38 43 48 45 #> [9,] 11 30 38 46 47 46 #> [10,] 11 20 36 44 48 44 #>"},{"path":"https://hreinwald.github.io/drc/reference/red.fescue.html","id":null,"dir":"Reference","previous_headings":"","what":"Red fescue — red.fescue","title":"Red fescue — red.fescue","text":"Data dose-response experiment red fescue (Festuca rubra). Biomass measured different dose levels two time points (day 0 day 16).","code":""},{"path":"https://hreinwald.github.io/drc/reference/red.fescue.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Red fescue — red.fescue","text":"","code":"data(red.fescue)"},{"path":"https://hreinwald.github.io/drc/reference/red.fescue.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Red fescue — red.fescue","text":"data frame 26 observations following 3 variables. dose numeric vector day numeric vector biomass numeric vector","code":""},{"path":"https://hreinwald.github.io/drc/reference/red.fescue.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Red fescue — red.fescue","text":"","code":"library(drc) ## Displaying the data head(red.fescue) #> dose day biomass #> 1 0 0 45.0 #> 2 0 0 69.0 #> 3 0 16 137.0 #> 4 0 16 102.0 #> 5 0 16 101.4 #> 6 87 16 139.7 ## Fitting a four-parameter log-logistic model with separate curves per day red.fescue.m1 <- drm(biomass ~ dose, day, data = red.fescue, fct = LL.4()) #> Control measurements detected for level: 0 summary(red.fescue.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 2.2098 1.0445 2.1156 0.04594 * #> c:(Intercept) 26.2056 12.0292 2.1785 0.04037 * #> d:(Intercept) 109.0601 8.6786 12.5666 1.631e-11 *** #> e:(Intercept) 456.5766 185.6060 2.4599 0.02222 * #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 25.21797 (22 degrees of freedom) ## Plotting the fitted curves plot(red.fescue.m1, xlab = \"Dose\", ylab = \"Biomass\")"},{"path":"https://hreinwald.github.io/drc/reference/relpot.html","id":null,"dir":"Reference","previous_headings":"","what":"Relative potency function — relpot","title":"Relative potency function — relpot","text":"Calculates optionally plots relative potency function response level two curves dose-response model, using EDcomp underlying comparisons.","code":""},{"path":"https://hreinwald.github.io/drc/reference/relpot.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Relative potency function — relpot","text":"","code":"relpot( object, plotit = TRUE, compMatch = NULL, percVec = NULL, interval = \"none\", type = c(\"relative\", \"absolute\"), scale = c(\"original\", \"percent\", \"unconstrained\"), ... )"},{"path":"https://hreinwald.github.io/drc/reference/relpot.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Relative potency function — relpot","text":"object object class 'drc'. plotit logical. TRUE (default), plot relative potency response level produced. compMatch numeric vector length 2 specifying two curves compare. percVec numeric vector response levels evaluate relative potency. NULL, suitable range determined automatically. interval character string specifying confidence interval type. Default \"none\". type character string. Either \"relative\" (default) \"absolute\" response levels. scale character string. One \"original\" (default), \"percent\", \"unconstrained\". ... additional graphical arguments passed plot.","code":""},{"path":"https://hreinwald.github.io/drc/reference/relpot.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Relative potency function — relpot","text":"invisible list components x, y (relative potency values), percVec.","code":""},{"path":"https://hreinwald.github.io/drc/reference/relpot.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Relative potency function — relpot","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/repChar.html","id":null,"dir":"Reference","previous_headings":"","what":"Replace characters in strings — repChar","title":"Replace characters in strings — repChar","text":"Replace characters strings","code":""},{"path":"https://hreinwald.github.io/drc/reference/repChar.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Replace characters in strings — repChar","text":"","code":"repChar(str, names, fixed, keep)"},{"path":"https://hreinwald.github.io/drc/reference/residuals.drc.html","id":null,"dir":"Reference","previous_headings":"","what":"Extracting residuals from the fitted dose-response model — residuals.drc","title":"Extracting residuals from the fitted dose-response model — residuals.drc","text":"residuals extracts different types residuals object class 'drc'.","code":""},{"path":"https://hreinwald.github.io/drc/reference/residuals.drc.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Extracting residuals from the fitted dose-response model — residuals.drc","text":"","code":"# S3 method for class 'drc' residuals( object, typeRes = c(\"working\", \"standardised\", \"studentised\"), trScale = TRUE, ... )"},{"path":"https://hreinwald.github.io/drc/reference/residuals.drc.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Extracting residuals from the fitted dose-response model — residuals.drc","text":"object object class 'drc'. typeRes character string specifying type residual returned: raw/working residuals, residuals standardised using estimated residual standard error, studentised residuals based H matrix partial derivatives model function. trScale logical value indicating whether return residuals transformed scale (case Box-Cox transformation applied). ... additional arguments.","code":""},{"path":"https://hreinwald.github.io/drc/reference/residuals.drc.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Extracting residuals from the fitted dose-response model — residuals.drc","text":"raw (also called working) residuals kind scaled residuals extracted object.","code":""},{"path":"https://hreinwald.github.io/drc/reference/residuals.drc.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Extracting residuals from the fitted dose-response model — residuals.drc","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/residuals.drc.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Extracting residuals from the fitted dose-response model — residuals.drc","text":"","code":"## Fitting a four-parameter log-logistic model ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) ## Displaying the residual plot (raw residuals) plot(fitted(ryegrass.m1), residuals(ryegrass.m1)) ## Using the standardised residuals plot(fitted(ryegrass.m1), residuals(ryegrass.m1, typeRes = \"standard\"))"},{"path":"https://hreinwald.github.io/drc/reference/resPrint.html","id":null,"dir":"Reference","previous_headings":"","what":"Print residual information — resPrint","title":"Print residual information — resPrint","text":"Print residual information","code":""},{"path":"https://hreinwald.github.io/drc/reference/resPrint.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Print residual information — resPrint","text":"","code":"resPrint(resMat, headerText, interval, intervalLabel, display)"},{"path":"https://hreinwald.github.io/drc/reference/RScompetition.html","id":null,"dir":"Reference","previous_headings":"","what":"Competition between two biotypes — RScompetition","title":"Competition between two biotypes — RScompetition","text":"assess competitive ability two biotypes Lolium rigidum, one resistant glyphosate sensitive wild type, density resistant sensitive biotypes counted germination.","code":""},{"path":"https://hreinwald.github.io/drc/reference/RScompetition.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Competition between two biotypes — RScompetition","text":"","code":"data(RScompetition)"},{"path":"https://hreinwald.github.io/drc/reference/RScompetition.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Competition between two biotypes — RScompetition","text":"data frame 49 observations following 3 variables. z numeric vector densities resistant biotype (plants/m2) x numeric vector densities sensitive biotype (plants/m2) biomass numeric vector biomass weight (g/plant)","code":""},{"path":"https://hreinwald.github.io/drc/reference/RScompetition.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Competition between two biotypes — RScompetition","text":"hyperbolic model (Jensen, 1993) describing data reasonably well.","code":""},{"path":"https://hreinwald.github.io/drc/reference/RScompetition.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Competition between two biotypes — RScompetition","text":"dataset Pedersen et al (2007).","code":""},{"path":"https://hreinwald.github.io/drc/reference/RScompetition.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Competition between two biotypes — RScompetition","text":"Jensen, J. E. (1993) Fitness herbicide-resistant weed biotypes described competition models, Proceedings 8th EWRS Symposium, 14-16 June, Braunschweig, Germany, 1, 25–32. Pedersen, B. P. Neve, P. Andreasen, C. Powles, S. (2007) Ecological fitness glyphosate resistant Lolium rigidum population: Growth seed production along competition gradient, Basic Applied Ecology, 8, 258–268.","code":""},{"path":"https://hreinwald.github.io/drc/reference/RScompetition.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Competition between two biotypes — RScompetition","text":"","code":"library(drc) ## Displaying the data head(RScompetition) #> z x biomass #> 1 8 8 7.72500 #> 2 8 16 3.47500 #> 3 7 32 3.86875 #> 4 8 61 1.94918 #> 5 16 8 3.10000 #> 6 16 16 2.91250 ## Plotting biomass as a function of sensitive biotype density plot(biomass ~ x, data = RScompetition, xlab = \"Density of sensitive biotype\", ylab = \"Biomass (g/plant)\")"},{"path":"https://hreinwald.github.io/drc/reference/rse.html","id":null,"dir":"Reference","previous_headings":"","what":"Residual standard error — rse","title":"Residual standard error — rse","text":"Residual standard error","code":""},{"path":"https://hreinwald.github.io/drc/reference/rse.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Residual standard error — rse","text":"","code":"rse(object, resvar = FALSE)"},{"path":"https://hreinwald.github.io/drc/reference/Rsq.html","id":null,"dir":"Reference","previous_headings":"","what":"R-squared for dose-response models — Rsq","title":"R-squared for dose-response models — Rsq","text":"Calculates displays R-squared values fitted dose-response model. models multiple curves, per-curve total R-squared values returned.","code":""},{"path":"https://hreinwald.github.io/drc/reference/Rsq.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"R-squared for dose-response models — Rsq","text":"","code":"Rsq(object)"},{"path":"https://hreinwald.github.io/drc/reference/Rsq.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"R-squared for dose-response models — Rsq","text":"object object class 'drc'.","code":""},{"path":"https://hreinwald.github.io/drc/reference/Rsq.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"R-squared for dose-response models — Rsq","text":"Invisibly returns matrix R-squared values. single-curve models, 1x1 matrix. multi-curve models, includes per-curve values total R-squared.","code":""},{"path":"https://hreinwald.github.io/drc/reference/Rsq.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"R-squared for dose-response models — Rsq","text":"R-squared computed \\(1 - RSS / TSS\\) RSS residual sum squares (obtained via rss()) TSS total sum squares.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/Rsq.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"R-squared for dose-response models — Rsq","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/rss.html","id":null,"dir":"Reference","previous_headings":"","what":"Residual sum of squares for dose-response models — rss","title":"Residual sum of squares for dose-response models — rss","text":"Calculates displays residual sum squares (RSS) fitted dose-response model. models multiple curves, per-curve total RSS values returned.","code":""},{"path":"https://hreinwald.github.io/drc/reference/rss.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Residual sum of squares for dose-response models — rss","text":"","code":"rss(object, print = TRUE)"},{"path":"https://hreinwald.github.io/drc/reference/rss.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Residual sum of squares for dose-response models — rss","text":"object object class 'drc'. print logical. TRUE (default), RSS values printed.","code":""},{"path":"https://hreinwald.github.io/drc/reference/rss.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Residual sum of squares for dose-response models — rss","text":"Invisibly returns matrix RSS values. single-curve models, 1x1 matrix. multi-curve models, includes per-curve values total RSS.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/rss.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Residual sum of squares for dose-response models — rss","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/ryegrass.html","id":null,"dir":"Reference","previous_headings":"","what":"Effect of ferulic acid on growth of ryegrass — ryegrass","title":"Effect of ferulic acid on growth of ryegrass — ryegrass","text":"single dose-response curve.","code":""},{"path":"https://hreinwald.github.io/drc/reference/ryegrass.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Effect of ferulic acid on growth of ryegrass — ryegrass","text":"","code":"data(ryegrass)"},{"path":"https://hreinwald.github.io/drc/reference/ryegrass.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Effect of ferulic acid on growth of ryegrass — ryegrass","text":"data frame 24 observations following 2 variables. rootl numeric vector root lengths conc numeric vector concentrations ferulic acid","code":""},{"path":"https://hreinwald.github.io/drc/reference/ryegrass.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Effect of ferulic acid on growth of ryegrass — ryegrass","text":"data part study investigate joint action phenolic acids root growth inhibition perennial ryegrass (Lolium perenne L). conc concentration ferulic acid mM, rootl root length perennial ryegrass measured cm.","code":""},{"path":"https://hreinwald.github.io/drc/reference/ryegrass.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Effect of ferulic acid on growth of ryegrass — ryegrass","text":"Inderjit J. C. Streibig, M. Olofsdotter (2002) Joint action phenolic acid mixtures significance allelopathy research, Physiologia Plantarum, 114, 422–428, 2002.","code":""},{"path":"https://hreinwald.github.io/drc/reference/ryegrass.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Effect of ferulic acid on growth of ryegrass — ryegrass","text":"","code":"library(drc) ## Displaying the data set ryegrass #> rootl conc #> 1 7.5800000 0.00 #> 2 8.0000000 0.00 #> 3 8.3285714 0.00 #> 4 7.2500000 0.00 #> 5 7.3750000 0.00 #> 6 7.9625000 0.00 #> 7 8.3555556 0.94 #> 8 6.9142857 0.94 #> 9 7.7500000 0.94 #> 10 6.8714286 1.88 #> 11 6.4500000 1.88 #> 12 5.9222222 1.88 #> 13 1.9250000 3.75 #> 14 2.8857143 3.75 #> 15 4.2333333 3.75 #> 16 1.1875000 7.50 #> 17 0.8571429 7.50 #> 18 1.0571429 7.50 #> 19 0.6875000 15.00 #> 20 0.5250000 15.00 #> 21 0.8250000 15.00 #> 22 0.2500000 30.00 #> 23 0.2200000 30.00 #> 24 0.4400000 30.00 ## Fitting a four-parameter Weibull model (type 2) ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W2.4()) ## Displaying a summary of the model fit summary(ryegrass.m1) #> #> Model fitted: Weibull (type 2) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) -1.96791 0.29070 -6.7696 1.389e-06 *** #> c:(Intercept) 0.32459 0.24902 1.3035 0.2072 #> d:(Intercept) 7.72630 0.17339 44.5594 < 2.2e-16 *** #> e:(Intercept) 2.48765 0.14781 16.8304 2.829e-13 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.5144203 (20 degrees of freedom) ## Plotting the fitted curve together with the original data plot(ryegrass.m1) ## Fitting a four-parameter Weibull model (type 1) ryegrass.m2 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) plot(ryegrass.m2) ## Fitting a four-parameter log-logistic model ## with user-defined parameter names ryegrass.m3 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4(names = c(\"Slope\", \"Lower Limit\", \"Upper Limit\", \"ED50\"))) summary(ryegrass.m3) #> #> Model fitted: Log-logistic (ED50 as parameter) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> Slope:(Intercept) 2.98222 0.46506 6.4125 2.960e-06 *** #> Lower Limit:(Intercept) 0.48141 0.21219 2.2688 0.03451 * #> Upper Limit:(Intercept) 7.79296 0.18857 41.3272 < 2.2e-16 *** #> ED50:(Intercept) 3.05795 0.18573 16.4644 4.268e-13 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.5196256 (20 degrees of freedom) ## Comparing log-logistic and Weibull models ## (Figure 2 in Ritz (2009)) ryegrass.m0 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) ryegrass.m2 <- drm(rootl ~ conc, data = ryegrass, fct = W2.4()) plot(ryegrass.m0, broken=TRUE, xlab=\"Dose (mM)\", ylab=\"Root length (cm)\", lwd=2, cex=1.2, cex.axis=1.2, cex.lab=1.2) plot(ryegrass.m1, add=TRUE, broken=TRUE, lty=2, lwd=2) plot(ryegrass.m2, add=TRUE, broken=TRUE, lty=3, lwd=2) arrows(3, 7.5, 1.4, 7.5, 0.15, lwd=2) text(3,7.5, \"Weibull-2\", pos=4, cex=1.2) arrows(2.5, 0.9, 5.7, 0.9, 0.15, lwd=2) text(3,0.9, \"Weibull-1\", pos=2, cex=1.2)"},{"path":"https://hreinwald.github.io/drc/reference/ryegrass2.html","id":null,"dir":"Reference","previous_headings":"","what":"Ryegrass — ryegrass2","title":"Ryegrass — ryegrass2","text":"Data dose-response experiment ryegrass (Lolium sp.). Biomass measured different dose levels two time points.","code":""},{"path":"https://hreinwald.github.io/drc/reference/ryegrass2.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Ryegrass — ryegrass2","text":"","code":"data(ryegrass2)"},{"path":"https://hreinwald.github.io/drc/reference/ryegrass2.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Ryegrass — ryegrass2","text":"data frame 27 observations following 3 variables. dose numeric vector biomass numeric vector day categorial vector","code":""},{"path":"https://hreinwald.github.io/drc/reference/ryegrass2.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Ryegrass — ryegrass2","text":"","code":"library(drc) ## Displaying the data head(ryegrass2) #> dose biomass day #> 1 0 77.5 0 #> 2 0 78.0 0 #> 3 0 75.0 0 #> 4 0 214.4 15 #> 5 0 215.4 15 #> 6 0 227.5 15 ## Fitting a four-parameter log-logistic model with separate curves per day ryegrass2.m1 <- drm(biomass ~ dose, day, data = ryegrass2, fct = LL.4()) #> Control measurements detected for level: 0 summary(ryegrass2.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 2.9412 2.4262 1.2123 0.237709 #> c:(Intercept) 82.7372 21.4655 3.8544 0.000807 *** #> d:(Intercept) 179.8062 12.4500 14.4423 5.046e-13 *** #> e:(Intercept) 13.6913 6.2483 2.1912 0.038827 * #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 44.3814 (23 degrees of freedom) ## Plotting the fitted curves plot(ryegrass2.m1, xlab = \"Dose\", ylab = \"Biomass\")"},{"path":"https://hreinwald.github.io/drc/reference/S.alba.comp.html","id":null,"dir":"Reference","previous_headings":"","what":"Potency of two herbicides — S.alba.comp","title":"Potency of two herbicides — S.alba.comp","text":"Data experiment, comparing potency two herbicides glyphosate bentazone white mustard Sinapis alba.","code":""},{"path":"https://hreinwald.github.io/drc/reference/S.alba.comp.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Potency of two herbicides — S.alba.comp","text":"","code":"data(S.alba.comp)"},{"path":"https://hreinwald.github.io/drc/reference/S.alba.comp.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Potency of two herbicides — S.alba.comp","text":"data frame 141 observations following 8 variables. exp factor levels ben1, ben2, gly1, gly2 indicating experiment observation belongs . herbicide factor levels Bentazone Glyphosate (two herbicides applied). dose numeric vector containing dose g/ha. drymatter numeric vector containing response (dry matter g/pot). Tf numeric vector . area numeric vector . Fo numeric vector . Fm numeric vector .","code":""},{"path":"https://hreinwald.github.io/drc/reference/S.alba.comp.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Potency of two herbicides — S.alba.comp","text":"lower upper limits two herbicides can assumed identical, whereas slopes ED50 values different (log-logistic model).","code":""},{"path":"https://hreinwald.github.io/drc/reference/S.alba.comp.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Potency of two herbicides — S.alba.comp","text":"Christensen, M. G. Teicher, H. B., Streibig, J. C. (2003) Linking fluorescence induction curve biomass herbicide screening, Pest Management Science, 59, 1303–1310.","code":""},{"path":"https://hreinwald.github.io/drc/reference/S.alba.comp.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Potency of two herbicides — S.alba.comp","text":"","code":"library(drc) ## Displaying the data head(S.alba.comp) #> exp herbicide dose drymatter Tf area Fo Fm #> 1 ben1 bentazone 0 4.1 200 31200 278 1662 #> 2 ben1 bentazone 0 3.4 230 30600 278 1670 #> 3 ben1 bentazone 0 2.6 210 27400 299 1646 #> 4 ben1 bentazone 0 3.5 260 34600 288 1715 #> 5 ben1 bentazone 0 4.3 200 31000 272 1651 #> 6 ben1 bentazone 0 4.2 240 31400 286 1681 ## Fitting a four-parameter log-logistic model with common upper and lower limits S.alba.comp.m1 <- drm(drymatter ~ dose, herbicide, data = S.alba.comp, fct = LL.4(), pmodels = list(~herbicide, ~1, ~1, ~herbicide)) summary(S.alba.comp.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 5.036275 2.100683 2.3974 0.01788 * #> b:herbicideglyphosate -3.682298 2.062582 -1.7853 0.07646 . #> c:(Intercept) 0.734059 0.081999 8.9520 2.432e-15 *** #> d:(Intercept) 3.962500 0.079820 49.6428 < 2.2e-16 *** #> e:(Intercept) 21.060041 1.286127 16.3748 < 2.2e-16 *** #> e:herbicideglyphosate 27.165817 5.568005 4.8789 2.958e-06 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.495335 (135 degrees of freedom) ## Plotting the fitted curves plot(S.alba.comp.m1, xlab = \"Dose (g/ha)\", ylab = \"Dry matter (g/pot)\")"},{"path":"https://hreinwald.github.io/drc/reference/S.alba.html","id":null,"dir":"Reference","previous_headings":"","what":"Potency of two herbicides — S.alba","title":"Potency of two herbicides — S.alba","text":"Data experiment, comparing potency two herbicides glyphosate bentazone white mustard Sinapis alba.","code":""},{"path":"https://hreinwald.github.io/drc/reference/S.alba.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Potency of two herbicides — S.alba","text":"","code":"data(S.alba)"},{"path":"https://hreinwald.github.io/drc/reference/S.alba.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Potency of two herbicides — S.alba","text":"data frame 68 observations following 3 variables. Dose numeric vector containing dose g/ha. Herbicide factor levels Bentazone Glyphosate (two herbicides applied). DryMatter numeric vector containing response (dry matter g/pot).","code":""},{"path":"https://hreinwald.github.io/drc/reference/S.alba.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Potency of two herbicides — S.alba","text":"lower upper limits two herbicides can assumed identical, whereas slopes ED50 values different (log-logistic model).","code":""},{"path":"https://hreinwald.github.io/drc/reference/S.alba.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Potency of two herbicides — S.alba","text":"Christensen, M. G. Teicher, H. B., Streibig, J. C. (2003) Linking fluorescence induction curve biomass herbicide screening, Pest Management Science, 59, 1303–1310.","code":""},{"path":"https://hreinwald.github.io/drc/reference/S.alba.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Potency of two herbicides — S.alba","text":"","code":"library(drc) ## Fitting a log-logistic model with ## common lower and upper limits S.alba.LL.4.1 <- drm(DryMatter~Dose, Herbicide, data=S.alba, fct = LL.4(), pmodels=data.frame(Herbicide,1,1,Herbicide)) summary(S.alba.LL.4.1) #> #> Model fitted: Log-logistic (ED50 as parameter) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:Bentazone 5.046141 1.040135 4.8514 8.616e-06 *** #> b:Glyphosate 2.390218 0.495959 4.8194 9.684e-06 *** #> c:(Intercept) 0.716559 0.089245 8.0291 3.523e-11 *** #> d:(Intercept) 3.854861 0.076255 50.5519 < 2.2e-16 *** #> e:Bentazone 28.632355 2.038098 14.0486 < 2.2e-16 *** #> e:Glyphosate 66.890545 5.968819 11.2067 < 2.2e-16 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.3705151 (62 degrees of freedom) ## Applying the optimal transform-both-sides Box-Cox transformation ## (using the initial model fit) S.alba.LL.4.2 <- boxcox(S.alba.LL.4.1, method = \"anova\") summary(S.alba.LL.4.2) #> #> Model fitted: Log-logistic (ED50 as parameter) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:Bentazone 4.838636 0.927240 5.2183 2.216e-06 *** #> b:Glyphosate 1.944311 0.236471 8.2222 1.630e-11 *** #> c:(Intercept) 0.682591 0.028768 23.7270 < 2.2e-16 *** #> d:(Intercept) 3.862611 0.106186 36.3760 < 2.2e-16 *** #> e:Bentazone 28.396147 1.874598 15.1479 < 2.2e-16 *** #> e:Glyphosate 65.573335 5.618945 11.6700 < 2.2e-16 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.1558947 (62 degrees of freedom) #> #> Non-normality/heterogeneity adjustment through Box-Cox transformation #> #> Estimated lambda: 0.101 #> Confidence interval for lambda: [-0.126, 0.331] #> ## Plotting fitted regression curves together with the data plot(S.alba.LL.4.2)"},{"path":"https://hreinwald.github.io/drc/reference/S.capricornutum.html","id":null,"dir":"Reference","previous_headings":"","what":"Effect of cadmium on growth of green alga — S.capricornutum","title":"Effect of cadmium on growth of green alga — S.capricornutum","text":"Green alga (Selenastrum capricornutum) exposed cadmium chloride concentrations ranging 5 80 micro g/L geometric progression 4-day population growth test.","code":""},{"path":"https://hreinwald.github.io/drc/reference/S.capricornutum.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Effect of cadmium on growth of green alga — S.capricornutum","text":"","code":"data(S.capricornutum)"},{"path":"https://hreinwald.github.io/drc/reference/S.capricornutum.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Effect of cadmium on growth of green alga — S.capricornutum","text":"data frame 18 observations following 2 variables. conc numeric vector cadmium chloride concentrations (micro g/L) count numeric vector algal counts (10000 x cells /ml)","code":""},{"path":"https://hreinwald.github.io/drc/reference/S.capricornutum.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Effect of cadmium on growth of green alga — S.capricornutum","text":"data analysed Bruce Versteeg (1992) using log-normal dose-response model (using logarithm base 10).","code":""},{"path":"https://hreinwald.github.io/drc/reference/S.capricornutum.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Effect of cadmium on growth of green alga — S.capricornutum","text":"Bruce, R. D. Versteeg, D. J. (1992) statistical procedure modeling continuous toxicity data, Environ. Toxicol. Chem., 11, 1485–1494.","code":""},{"path":"https://hreinwald.github.io/drc/reference/S.capricornutum.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Effect of cadmium on growth of green alga — S.capricornutum","text":"","code":"library(drc) ## Fitting 3-parameter log-normal model s.cap.m1 <- drm(count ~ conc, data = S.capricornutum, fct = LN.3()) ## Residual plot plot(fitted(s.cap.m1), residuals(s.cap.m1)) ## Fitting model with transform-both-sides approach s.cap.m2 <- boxcox(s.cap.m1, method = \"anova\") summary(s.cap.m2) #> #> Model fitted: Log-normal with lower limit at 0 (3 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) -1.000982 0.044845 -22.321 6.394e-13 *** #> d:(Intercept) 132.079098 7.554011 17.485 2.191e-11 *** #> e:(Intercept) 12.428164 1.100916 11.289 9.915e-09 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.1551479 (15 degrees of freedom) #> #> Non-normality/heterogeneity adjustment through Box-Cox transformation #> #> Estimated lambda: 0.0606 #> Confidence interval for lambda: [-0.220, 0.414] #> ## Residual plot after transformation (looks better) plot(fitted(s.cap.m2), residuals(s.cap.m2)) ## Calculating ED values on log scale ED(s.cap.m2, c(10, 20, 50), interval=\"delta\") #> #> Estimated effective doses #> #> Estimate Std. Error Lower Upper #> e:10 3.45448 0.49164 2.40656 4.50239 #> e:20 5.36110 0.66213 3.94980 6.77241 #> e:50 12.42816 1.10092 10.08162 14.77471 ## Fitting model with ED50 as parameter ## (for comparison) s.cap.m3 <- drm(count ~ conc, data = S.capricornutum, fct = LN.3(loge=TRUE)) s.cap.m4 <- boxcox(s.cap.m3, method = \"anova\") summary(s.cap.m4) #> #> Model fitted: Log-normal with lower limit at 0 (3 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) -1.000991 0.044846 -22.320 6.395e-13 *** #> d:(Intercept) 132.078306 7.553934 17.485 2.191e-11 *** #> e:(Intercept) 2.519975 0.088583 28.448 1.821e-14 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.1551479 (15 degrees of freedom) #> #> Non-normality/heterogeneity adjustment through Box-Cox transformation #> #> Estimated lambda: 0.0606 #> Confidence interval for lambda: [-0.220, 0.414] #> ED(s.cap.m4, c(10, 20, 50), interval = \"fls\") #> #> Estimated effective doses #> #> Estimate Std. Error Lower Upper #> e:10 3.454549 0.142322 2.550630 4.678808 #> e:20 5.361195 0.123508 4.120343 6.975731 #> e:50 12.428289 0.088583 10.289930 15.011022"},{"path":"https://hreinwald.github.io/drc/reference/searchdrc.html","id":null,"dir":"Reference","previous_headings":"","what":"Search through a range of initial parameter values to obtain convergence — searchdrc","title":"Search through a range of initial parameter values to obtain convergence — searchdrc","text":"searchdrc provides facility searching range initial values single parameter order obtain convergence non-linear estimation procedure used dose-response curve fitting.","code":""},{"path":"https://hreinwald.github.io/drc/reference/searchdrc.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Search through a range of initial parameter values to obtain convergence — searchdrc","text":"","code":"searchdrc(object, which, range, len = 50, verbose = FALSE)"},{"path":"https://hreinwald.github.io/drc/reference/searchdrc.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Search through a range of initial parameter values to obtain convergence — searchdrc","text":"object object class 'drc', must valid $start $parNames fields populated. typically object model failed converge still constructed initial parameter values. character string containing parameter name without curve suffix (e.g., \"b\" \"b:1\"). Must exactly match one parameter names model object. range numeric vector exactly length 2 specifying interval endpoints c(lower, upper) search range. two endpoints must different. len positive integer (minimum 2). maximum number evenly spaced starting values try within range. search stops early soon convergence achieved, actual number attempts may less len. Defaults 50. verbose logical. TRUE, prints progress messages indicating starting value currently tried. Defaults FALSE.","code":""},{"path":"https://hreinwald.github.io/drc/reference/searchdrc.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Search through a range of initial parameter values to obtain convergence — searchdrc","text":"convergence achieved, returns fitted model object class 'drc', corresponding first starting value search grid led successful fit. starting value leads convergence, function throws error.","code":""},{"path":"https://hreinwald.github.io/drc/reference/searchdrc.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Search through a range of initial parameter values to obtain convergence — searchdrc","text":"function iterates len evenly spaced values within specified range, using starting value chosen parameter. search stops soon first successful model fit found. need identify parameter likely cause problems estimation procedure. Parameter names provided without curve suffix. example, use \"b\" rather \"b:1\". function internally matches parameter using pattern \"^<>:\" full parameter names stored model object.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/searchdrc.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Search through a range of initial parameter values to obtain convergence — searchdrc","text":"Christian Ritz, Hannes Reinwald.","code":""},{"path":"https://hreinwald.github.io/drc/reference/searchdrc.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Search through a range of initial parameter values to obtain convergence — searchdrc","text":"","code":"if (FALSE) { # \\dontrun{ library(drc) # Fit an initial model (which may fail to converge) myModel <- drm(response ~ dose, data = myData, fct = LL.4()) # Search over a range of starting values for the slope parameter \"b\" myModelFixed <- searchdrc(myModel, which = \"b\", range = c(-5, 5), len = 100) # With progress messages enabled myModelFixed <- searchdrc(myModel, which = \"b\", range = c(-5, 5), len = 100, verbose = TRUE) } # }"},{"path":"https://hreinwald.github.io/drc/reference/secalonic.html","id":null,"dir":"Reference","previous_headings":"","what":"Root length measurements — secalonic","title":"Root length measurements — secalonic","text":"Data stem experiment assessing inhibitory effect secalonic acids plant growth.","code":""},{"path":"https://hreinwald.github.io/drc/reference/secalonic.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Root length measurements — secalonic","text":"","code":"data(secalonic)"},{"path":"https://hreinwald.github.io/drc/reference/secalonic.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Root length measurements — secalonic","text":"data frame 7 observations following 2 variables: dose numeric vector containing dose values (mM) rootl numeric vector containing root lengths (cm)","code":""},{"path":"https://hreinwald.github.io/drc/reference/secalonic.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Root length measurements — secalonic","text":"dose root length average three measurements.","code":""},{"path":"https://hreinwald.github.io/drc/reference/secalonic.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Root length measurements — secalonic","text":"Gong, X. Zeng, R. Luo, S. Yong, C. Zheng, Q. (2004) Two new secalonic acids Aspergillus Japonicus allelopathic effects higher plants, Proceedings International Symposium Allelopathy Research Application, 27-29 April, Shanshui, Guangdong, China (Editors: R. Zeng S. Luo), 209–217. Ritz, C (2009) Towards unified approach dose-response modeling ecotoxicology appear Environ Toxicol Chem.","code":""},{"path":"https://hreinwald.github.io/drc/reference/secalonic.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Root length measurements — secalonic","text":"","code":"library(drc) ## Fitting a four-parameter log-logistic model secalonic.m1 <- drm(rootl ~ dose, data = secalonic, fct = LL.4()) summary(secalonic.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 2.6542086 0.6962333 3.8122 0.0317398 * #> c:(Intercept) 0.0917852 0.3747246 0.2449 0.8223012 #> d:(Intercept) 5.5297495 0.2010300 27.5071 0.0001055 *** #> e:(Intercept) 0.0803547 0.0078829 10.1935 0.0020121 ** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.2957497 (3 degrees of freedom) ## Fitting a three-parameter log-logistic model ## lower limit fixed at 0 secalonic.m2 <- drm(rootl ~ dose, data = secalonic, fct = LL.3()) summary(secalonic.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 2.6542086 0.6962333 3.8122 0.0317398 * #> c:(Intercept) 0.0917852 0.3747246 0.2449 0.8223012 #> d:(Intercept) 5.5297495 0.2010300 27.5071 0.0001055 *** #> e:(Intercept) 0.0803547 0.0078829 10.1935 0.0020121 ** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.2957497 (3 degrees of freedom) ## Comparing logistic and log-logistic models ## (Figure 1 in Ritz (2009)) secalonic.LL4 <- drm(rootl ~ dose, data = secalonic, fct = LL.4()) secalonic.L4 <- drm(rootl ~ dose, data = secalonic, fct = L.4()) plot(secalonic.LL4, broken=TRUE, ylim=c(0,7), xlab=\"Dose (mM)\", ylab=\"Root length (cm)\", cex=1.2, cex.axis=1.2, cex.lab=1.2, lwd=2) plot(secalonic.L4, broken=TRUE, ylim=c(0,7), add=TRUE, type=\"none\", lty=2, lwd=2) abline(h=coef(secalonic.L4)[3], lty=3, lwd=2)"},{"path":"https://hreinwald.github.io/drc/reference/selenium.html","id":null,"dir":"Reference","previous_headings":"","what":"Data from toxicology experiments with selenium — selenium","title":"Data from toxicology experiments with selenium — selenium","text":"Comparison toxicity four types selenium means dose-response analysis","code":""},{"path":"https://hreinwald.github.io/drc/reference/selenium.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Data from toxicology experiments with selenium — selenium","text":"","code":"data(selenium)"},{"path":"https://hreinwald.github.io/drc/reference/selenium.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Data from toxicology experiments with selenium — selenium","text":"data frame 25 observations following 4 variables. type numeric vector indicating form selenium applied conc numeric vector (total) selenium concentrations total numeric vector containing total number flies dead numeric vector containing number dead flies","code":""},{"path":"https://hreinwald.github.io/drc/reference/selenium.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Data from toxicology experiments with selenium — selenium","text":"experiment described details Jeske et al. (2009).","code":""},{"path":"https://hreinwald.github.io/drc/reference/selenium.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Data from toxicology experiments with selenium — selenium","text":"Jeske, D. R., Xu, H. K., Blessinger, T., Jensen, P. Trumble, J. (2009) Testing Equality EC50 Values Presence Unequal Slopes Application Toxicity Selenium Types, Journal Agricultural, Biological, Environmental Statistics, 14, 469–483","code":""},{"path":"https://hreinwald.github.io/drc/reference/selenium.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Data from toxicology experiments with selenium — selenium","text":"","code":"library(drc) ## Analysis similar to what is proposed in Jeske et al (2009) ## but simply using existing functionality in \"drc\" ## Fitting the two-parameter log-logistic model with unequal ED50 and slope sel.m1 <- drm(dead/total~conc, type, weights=total, data=selenium, fct=LL.2(), type=\"binomial\") #sel.m1b <- drm(dead/total~conc, type, weights=total, data=selenium, fct=LN.2(), # type=\"binomial\", start=c(1,1,1,1,50,50,50,50)) plot(sel.m1, ylim = c(0, 1.3)) summary(sel.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:1 -1.50353 0.15547 -9.6706 < 2.2e-16 *** #> b:2 -0.84323 0.13911 -6.0617 1.347e-09 *** #> b:3 -2.16354 0.13824 -15.6504 < 2.2e-16 *** #> b:4 -1.45303 0.16861 -8.6179 < 2.2e-16 *** #> e:1 252.25555 13.82683 18.2439 < 2.2e-16 *** #> e:2 378.46048 39.37070 9.6127 < 2.2e-16 *** #> e:3 119.71320 5.90536 20.2719 < 2.2e-16 *** #> e:4 88.80529 8.61614 10.3069 < 2.2e-16 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## Testing for equality of slopes sel.m2 <- drm(dead/total~conc, type, weights=total, data=selenium, fct=LL.2(), type=\"binomial\", pmodels=list(~1, ~factor(type)-1)) sel.m2b <- drm(dead/total~conc, type, weights=total, data=selenium, fct=LN.2(), type=\"binomial\", pmodels=list(~1, ~factor(type)-1)) plot(sel.m2, ylim = c(0, 1.3)) summary(sel.m2) #> #> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) -1.590121 0.069452 -22.895 < 2.2e-16 *** #> e:factor(type)1 253.442530 13.109512 19.333 < 2.2e-16 *** #> e:factor(type)2 331.625839 16.855683 19.674 < 2.2e-16 *** #> e:factor(type)3 114.793108 6.760525 16.980 < 2.2e-16 *** #> e:factor(type)4 84.970604 6.173312 13.764 < 2.2e-16 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 anova(sel.m2, sel.m1) # 48.654 #> #> 1st model #> fct: LL.2() #> pmodels: ~1, ~factor(type) - 1 #> 2nd model #> fct: LL.2() #> pmodels: type (for all parameters) #> #> ANOVA-like table #> #> ModelDf Loglik Df LR value p value #> 1st model 5 -400.54 #> 2nd model 8 -376.21 3 48.654 0 #anova(sel.m2b, sel.m1b) # close to the value 48.46 reported in the paper ## Testing for equality of ED50 sel.m3<-drm(dead/total~conc, type, weights=total, data=selenium, fct=LL.2(), type=\"binomial\", pmodels=list(~factor(type)-1, ~1)) #sel.m3b<-drm(dead/total~conc, type, weights=total, data=selenium, fct=LN.2(), # type=\"binomial\", pmodels=list(~factor(type)-1, ~1), start=c(1,1,1,1,50)) plot(sel.m3, ylim = c(0, 1.3)) summary(sel.m3) #> #> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:factor(type)1 -0.603492 0.100467 -6.0069 1.892e-09 *** #> b:factor(type)2 -0.058099 0.082599 -0.7034 0.4818 #> b:factor(type)3 -2.177597 0.137733 -15.8102 < 2.2e-16 *** #> b:factor(type)4 -1.095290 0.102328 -10.7037 < 2.2e-16 *** #> e:(Intercept) 126.512287 6.854739 18.4562 < 2.2e-16 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 anova(sel.m3, sel.m1) # 123.56 #> #> 1st model #> fct: LL.2() #> pmodels: ~factor(type) - 1, ~1 #> 2nd model #> fct: LL.2() #> pmodels: type (for all parameters) #> #> ANOVA-like table #> #> ModelDf Loglik Df LR value p value #> 1st model 5 -437.99 #> 2nd model 8 -376.21 3 123.56 0 #anova(sel.m3b, sel.m1b) # not too far from the value 138.45 reported in the paper # (note that the estimation procedure is not exactly the same) # (and we use the log-logistic model instead of the log-normal model)"},{"path":"https://hreinwald.github.io/drc/reference/siInner.html","id":null,"dir":"Reference","previous_headings":"","what":"Inner function for selectivity index — siInner","title":"Inner function for selectivity index — siInner","text":"Inner function selectivity index","code":""},{"path":"https://hreinwald.github.io/drc/reference/siInner.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Inner function for selectivity index — siInner","text":"","code":"siInner( indPair, pVec, compMatch, object, indexMat, parmMat, varMat, level, reference, type, sifct, interval, degfree, logBase )"},{"path":"https://hreinwald.github.io/drc/reference/simDR.html","id":null,"dir":"Reference","previous_headings":"","what":"Simulating ED values under various scenarios — simDR","title":"Simulating ED values under various scenarios — simDR","text":"Simulating ED values given model given dose values.","code":""},{"path":"https://hreinwald.github.io/drc/reference/simDR.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Simulating ED values under various scenarios — simDR","text":"","code":"simDR( mpar, sigma, fct, noSim = 1000, conc, edVec = c(10, 50), seedVal = 20070723 )"},{"path":"https://hreinwald.github.io/drc/reference/simDR.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Simulating ED values under various scenarios — simDR","text":"mpar numeric vector model parameters. sigma numeric specifying residual standard deviation. fct list supplying chosen dose-response mean function (e.g., LL.4()). noSim numeric giving number simulations. Defaults 1000. conc numeric vector concentration/dose values. Must contain least 5 values. edVec numeric vector ED levels estimate simulation. Defaults c(10, 50). seedVal numeric giving seed used initialise random number generator. Defaults 20070723.","code":""},{"path":"https://hreinwald.github.io/drc/reference/simDR.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Simulating ED values under various scenarios — simDR","text":"Invisibly returns list one element: se 3D array dimensions (length(conc) - 4) x 6 x length(edVec) containing empirical standard deviations estimated ED values. Rows correspond number concentration levels used (starting 5). Columns correspond number replicates per concentration (1 6). third dimension corresponds ED level edVec. array values also printed console execution.","code":""},{"path":"https://hreinwald.github.io/drc/reference/simDR.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Simulating ED values under various scenarios — simDR","text":"arguments mpar sigma typically obtained previous model fit. dose-response models assuming normally distributed errors can used.","code":""},{"path":"https://hreinwald.github.io/drc/reference/simDR.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Simulating ED values under various scenarios — simDR","text":"Christian Ritz, Hannes Reinwald","code":""},{"path":"https://hreinwald.github.io/drc/reference/simDR.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Simulating ED values under various scenarios — simDR","text":"","code":"ryegrass.m1 <- drm(ryegrass, fct = LL.4()) simDR( mpar = coef(ryegrass.m1), sigma = sqrt(summary(ryegrass.m1)$resVar), fct = LL.4(), noSim = 2, conc = c(1.88, 3.75, 7.50, 0.94, 15, 0.47, 30, 0.23, 60), seedVal = 20070723 ) #> Concentrations used: 1.88 3.75 7.5 0.94 15 0.47 30 0.23 60 #> #> ED value considered: 10 #> Conc. no.\\Replicates: #> 1 2 3 4 5 6 #> 5 1.7937943 0.70676461 0.7070331 0.74477323 0.0314240 0.47265995 #> 6 0.7715370 0.07489298 0.1991687 0.50345455 0.0274019 0.26133303 #> 7 0.6766681 0.43816932 0.3241948 0.57191204 0.4956274 0.02968537 #> 8 0.5276024 0.20800084 0.2113615 0.05549555 0.2561400 0.28737212 #> 9 0.1800602 0.76739811 0.5514185 0.11201042 0.4834278 0.46828149 #> #> #> ED value considered: 50 #> Conc. no.\\Replicates: #> 1 2 3 4 5 6 #> 5 0.6998346 1.32865730 0.49266733 0.4490645 0.1069289 0.6018208 #> 6 6.7983515 0.39097416 0.09645987 0.5823232 0.4309704 0.4252761 #> 7 0.9155897 0.03037852 0.46647071 0.2017280 0.3129933 0.3744331 #> 8 0.3950825 0.16439311 0.21879117 0.0803034 0.2577441 0.2953281 #> 9 0.3519176 1.19098825 0.34427430 0.1302080 0.4812865 0.2009490 #> #>"},{"path":"https://hreinwald.github.io/drc/reference/simFct.html","id":null,"dir":"Reference","previous_headings":"","what":"Simulation of dose-response data and ED estimation — simFct","title":"Simulation of dose-response data and ED estimation — simFct","text":"Simulates dose-response datasets using parametric non-parametric methods estimates effective doses (ED values) simulated dataset. Useful assessing performance ED estimation methods via Monte Carlo simulation.","code":""},{"path":"https://hreinwald.github.io/drc/reference/simFct.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Simulation of dose-response data and ED estimation — simFct","text":"","code":"simFct( noSim, edVal = c(10, 20, 50), type = c(\"non-parametric\", \"parametric\"), response = c(\"bin\", \"con\"), fct = LL.2(), coefVec, method = c(\"sp\", \"p\", \"np\"), doseVec, nVec, pVec, rVec, resVar, pfct = fct, reference = NULL, span = NA, minmax = \"response\", lower = NULL, upper = NULL, seedVal = 200810201 )"},{"path":"https://hreinwald.github.io/drc/reference/simFct.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Simulation of dose-response data and ED estimation — simFct","text":"noSim integer. Number simulations run. edVal numeric vector ED levels estimate (default c(10, 20, 50)). type character string. Either \"non-parametric\" \"parametric\" simulation. response character string. Either \"bin\" (binomial) \"con\" (continuous) response. fct dose-response function used simulation (default LL.2()). coefVec numeric vector model coefficients parametric simulation. method character string. Estimation method: \"sp\" (semi-parametric), \"p\" (parametric), \"np\" (non-parametric). doseVec numeric vector dose values. nVec numeric vector sample sizes per dose (binomial response). pVec numeric vector expected response probabilities (non-parametric simulation). rVec numeric vector responses. resVar numeric. Residual variance (continuous response). pfct dose-response function used fitting (defaults fct). reference character string specifying reference ED estimation. span numeric. Smoothing parameter local regression. NA uses default. minmax character string. Type min/max calculation. Default \"response\". lower numeric. Lower bounds optimization. upper numeric. Upper bounds optimization. seedVal integer. Random seed reproducibility (default 200810201).","code":""},{"path":"https://hreinwald.github.io/drc/reference/simFct.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Simulation of dose-response data and ED estimation — simFct","text":"list components edArray (array ED estimates), mixVec, edVal, aicVec, spanVec.","code":""},{"path":"https://hreinwald.github.io/drc/reference/simFct.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Simulation of dose-response data and ED estimation — simFct","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/spinach.html","id":null,"dir":"Reference","previous_headings":"","what":"Inhibition of photosynthesis — spinach","title":"Inhibition of photosynthesis — spinach","text":"Data experiment investigating inhibition photosynthesis response two synthetic photosystem II inhibitors, herbicides diuron bentazon. specifically, effect oxygen consumption thylakoid membranes (chloroplasts) spinach measured incubation synthetic inhibitors 5 assays, resulting 5 dose-response curves.","code":""},{"path":"https://hreinwald.github.io/drc/reference/spinach.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Inhibition of photosynthesis — spinach","text":"","code":"data(spinach)"},{"path":"https://hreinwald.github.io/drc/reference/spinach.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Inhibition of photosynthesis — spinach","text":"data frame 105 observations following four variables: CURVE numeric vector specifying assay curve (total 5 independent assays used experiment). HERBICIDE character vector specifying herbicide applied: bentazon diuron. DOSE numeric vector giving herbicide concentration muMol. SLOPE numeric vector measured response: oxygen consumption thylakoid membranes.","code":""},{"path":"https://hreinwald.github.io/drc/reference/spinach.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Inhibition of photosynthesis — spinach","text":"experiment described details Streibig (1998).","code":""},{"path":"https://hreinwald.github.io/drc/reference/spinach.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Inhibition of photosynthesis — spinach","text":"Streibig, J. C. (1998) Joint action natural synthetic photosystem II inhibitors, Pesticide Science, 55, 137–146.","code":""},{"path":"https://hreinwald.github.io/drc/reference/spinach.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Inhibition of photosynthesis — spinach","text":"","code":"library(drc) ## Displaying the first rows in the dataset head(spinach) #> CURVE HERBICIDE DOSE SLOPE #> 1 1 bentazon 0.00 1.81295 #> 2 1 bentazon 0.00 1.86704 #> 3 1 bentazon 0.00 1.95606 #> 4 1 bentazon 0.62 1.39073 #> 5 1 bentazon 0.62 1.15721 #> 6 1 bentazon 0.62 1.06126 ## Fitting a four-parameter log-logistic model with separate curves per herbicide spinach.m1 <- drm(SLOPE ~ DOSE, HERBICIDE, data = spinach, fct = LL.4()) summary(spinach.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:bentazon 0.508817 0.161880 3.1432 0.002218 ** #> b:diuron 1.750572 0.334200 5.2381 9.433e-07 *** #> c:bentazon 0.033202 0.159736 0.2079 0.835779 #> c:diuron 0.036149 0.080884 0.4469 0.655925 #> d:bentazon 1.298217 0.067350 19.2757 < 2.2e-16 *** #> d:diuron 1.979936 0.055804 35.4799 < 2.2e-16 *** #> e:bentazon 1.599804 1.000457 1.5991 0.113057 #> e:diuron 0.203161 0.022802 8.9098 3.022e-14 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.2022188 (97 degrees of freedom) ## Plotting the fitted curves plot(spinach.m1, xlab = \"Dose (muMol)\", ylab = \"Oxygen consumption (slope)\")"},{"path":"https://hreinwald.github.io/drc/reference/splitInd.html","id":null,"dir":"Reference","previous_headings":"","what":"Split index vectors into shared and unique components — splitInd","title":"Split index vectors into shared and unique components — splitInd","text":"Split index vectors shared unique components","code":""},{"path":"https://hreinwald.github.io/drc/reference/splitInd.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Split index vectors into shared and unique components — splitInd","text":"","code":"splitInd(ind1, ind2)"},{"path":"https://hreinwald.github.io/drc/reference/summary.drc.html","id":null,"dir":"Reference","previous_headings":"","what":"Summarising non-linear model fits — summary.drc","title":"Summarising non-linear model fits — summary.drc","text":"summary compiles comprehensive summary objects class 'drc'.","code":""},{"path":"https://hreinwald.github.io/drc/reference/summary.drc.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Summarising non-linear model fits — summary.drc","text":"","code":"# S3 method for class 'drc' summary(object, od = FALSE, pool = TRUE, ...)"},{"path":"https://hreinwald.github.io/drc/reference/summary.drc.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Summarising non-linear model fits — summary.drc","text":"object object class 'drc'. od logical. TRUE adjustment -dispersion used. pool logical. TRUE curves pooled. Otherwise . argument works models independently fitted curves specified drm. ... additional arguments.","code":""},{"path":"https://hreinwald.github.io/drc/reference/summary.drc.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Summarising non-linear model fits — summary.drc","text":"list summary statistics includes parameter estimates estimated standard errors.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/summary.drc.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Summarising non-linear model fits — summary.drc","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/summary.drc.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Summarising non-linear model fits — summary.drc","text":"","code":"ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) summary(ryegrass.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 2.98222 0.46506 6.4125 2.960e-06 *** #> c:(Intercept) 0.48141 0.21219 2.2688 0.03451 * #> d:(Intercept) 7.79296 0.18857 41.3272 < 2.2e-16 *** #> e:(Intercept) 3.05795 0.18573 16.4644 4.268e-13 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.5196256 (20 degrees of freedom)"},{"path":"https://hreinwald.github.io/drc/reference/TCDD.html","id":null,"dir":"Reference","previous_headings":"","what":"Liver tumor incidence — TCDD","title":"Liver tumor incidence — TCDD","text":"Liver tumor incidence Sprague-Dawley rats exposed chemical like 2,3,7,8-tetrachlorodibenzo-pdioxin (TCDD).","code":""},{"path":"https://hreinwald.github.io/drc/reference/TCDD.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Liver tumor incidence — TCDD","text":"","code":"data(TCDD)"},{"path":"https://hreinwald.github.io/drc/reference/TCDD.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Liver tumor incidence — TCDD","text":"data frame 6 observations following 3 variables. conc numeric vector reporting concentration TCDD (ng/kg) total numeric vector incidence numeric vector","code":""},{"path":"https://hreinwald.github.io/drc/reference/TCDD.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Liver tumor incidence — TCDD","text":"R. Kociba, D. Keyes, J. Beyer, R. Carreon, C. Wade, D. Dittenber, R. Kalnins, L. Frauson, C. Park, S. Barnard, R. Hummel, C. Humiston (1978). Results two-year chronic toxicity oncogenicity study 2,3,7,8-tetrachlorodibenzo-p-dioxin rats. Toxicology Applied Pharmacology, 46(2):279–303.","code":""},{"path":"https://hreinwald.github.io/drc/reference/TCDD.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Liver tumor incidence — TCDD","text":"","code":"library(drc) ## Displaying the data head(TCDD) #> conc total incidence #> 1 0.00 86 2 #> 2 1.55 50 1 #> 3 7.15 50 9 #> 4 38.56 45 14 ## Fitting a two-parameter log-logistic model for binomial response TCDD.m1 <- drm(incidence/total ~ conc, weights = total, data = TCDD, fct = LL.2(), type = \"binomial\") summary(TCDD.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) with lower limit at 0 and upper limit at 1 (2 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) -0.73196 0.20589 -3.5551 0.0003778 *** #> e:(Intercept) 96.49945 58.87278 1.6391 0.1011886 #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## Plotting the fitted curve plot(TCDD.m1, xlab = \"Concentration of TCDD (ng/kg)\", ylab = \"Tumor incidence\")"},{"path":"https://hreinwald.github.io/drc/reference/terbuthylazin.html","id":null,"dir":"Reference","previous_headings":"","what":"The effect of terbuthylazin on growth rate — terbuthylazin","title":"The effect of terbuthylazin on growth rate — terbuthylazin","text":"Test effect terbuthylazin Lemna minor, performed aseptic culture according OECD-guidelines.","code":""},{"path":"https://hreinwald.github.io/drc/reference/terbuthylazin.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"The effect of terbuthylazin on growth rate — terbuthylazin","text":"","code":"data(terbuthylazin)"},{"path":"https://hreinwald.github.io/drc/reference/terbuthylazin.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"The effect of terbuthylazin on growth rate — terbuthylazin","text":"data frame 30 observations following 2 variables. dose numeric vector dose values. rgr numeric vector relative growth rates.","code":""},{"path":"https://hreinwald.github.io/drc/reference/terbuthylazin.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"The effect of terbuthylazin on growth rate — terbuthylazin","text":"Dose $$\\mu l^{-1}$$ rgr relative growth rate Lemna.","code":""},{"path":"https://hreinwald.github.io/drc/reference/terbuthylazin.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"The effect of terbuthylazin on growth rate — terbuthylazin","text":"Cedergreen N. (2004). Unpublished bioassay data.","code":""},{"path":"https://hreinwald.github.io/drc/reference/terbuthylazin.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"The effect of terbuthylazin on growth rate — terbuthylazin","text":"","code":"library(drc) ## displaying first 6 rows of the data set head(terbuthylazin) #> dose rgr #> 1 0 0.3017731 #> 2 0 0.2760291 #> 3 0 0.3145257 #> 4 0 0.2663174 #> 5 0 0.2871303 #> 6 0 0.3805772 ## Fitting log-logistic model terbuthylazin.m1 <- drm(rgr~dose, data = terbuthylazin, fct = LL.4()) summary(terbuthylazin.m1) #> #> Model fitted: Log-logistic (ED50 as parameter) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 1.2474e+00 2.3543e-01 5.2984 1.532e-05 *** #> c:(Intercept) 8.0293e-04 2.4913e-02 0.0322 0.9745 #> d:(Intercept) 3.0695e-01 9.6088e-03 31.9441 < 2.2e-16 *** #> e:(Intercept) 1.8914e+02 3.7726e+01 5.0136 3.242e-05 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.02699266 (26 degrees of freedom) ## Fitting log-logistic model ## with Box-Cox transformation terbuthylazin.m2 <- boxcox(terbuthylazin.m1, method = \"anova\") summary(terbuthylazin.m2) #> #> Model fitted: Log-logistic (ED50 as parameter) (4 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b:(Intercept) 1.3226e+00 2.3707e-01 5.5788 7.346e-06 *** #> c:(Intercept) 5.6549e-03 1.5383e-02 0.3676 0.7161 #> d:(Intercept) 3.0520e-01 1.1147e-02 27.3785 < 2.2e-16 *** #> e:(Intercept) 1.8290e+02 2.6858e+01 6.8098 3.153e-07 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.04562085 (26 degrees of freedom) #> #> Non-normality/heterogeneity adjustment through Box-Cox transformation #> #> Estimated lambda: 0.707 #> Confidence interval for lambda: [0.439,1.016] #>"},{"path":"https://hreinwald.github.io/drc/reference/threephase.html","id":null,"dir":"Reference","previous_headings":"","what":"Three-Phase Dose-Response Model — threephase","title":"Three-Phase Dose-Response Model — threephase","text":"ten-parameter dose-response model combining three log-logistic components, extending two-phase model (twophase) describing even complex dose-response patterns.","code":""},{"path":"https://hreinwald.github.io/drc/reference/threephase.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Three-Phase Dose-Response Model — threephase","text":"","code":"threephase( fixed = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), names = c(\"b1\", \"c1\", \"d1\", \"e1\", \"b2\", \"d2\", \"e2\", \"b3\", \"d3\", \"e3\"), fctName, fctText )"},{"path":"https://hreinwald.github.io/drc/reference/threephase.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Three-Phase Dose-Response Model — threephase","text":"fixed numeric vector specifying parameters fixed value fixed. NAs used parameters fixed. names vector character strings giving names parameters (contain \":\"). default reasonable. fctName optional character string used internally convenience functions. fctText optional character string used internally convenience functions.","code":""},{"path":"https://hreinwald.github.io/drc/reference/threephase.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Three-Phase Dose-Response Model — threephase","text":"list containing nonlinear function, self starter function, parameter names.","code":""},{"path":"https://hreinwald.github.io/drc/reference/threephase.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Three-Phase Dose-Response Model — threephase","text":"model function sum four-parameter log-logistic model two three-parameter log-logistic models: $$f(x) = \\mathrm{LL.4}(x; b1, c1, d1, e1) + \\mathrm{LL.3}(x; b2, d2, e2) + \\mathrm{LL.3}(x; b3, d3, e3)$$","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/threephase.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Three-Phase Dose-Response Model — threephase","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/twophase.html","id":null,"dir":"Reference","previous_headings":"","what":"Two-Phase Dose-Response Model — twophase","title":"Two-Phase Dose-Response Model — twophase","text":"seven-parameter dose-response model combining two log-logistic components, useful describing complex dose-response patterns.","code":""},{"path":"https://hreinwald.github.io/drc/reference/twophase.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Two-Phase Dose-Response Model — twophase","text":"","code":"twophase( fixed = c(NA, NA, NA, NA, NA, NA, NA), names = c(\"b1\", \"c1\", \"d1\", \"e1\", \"b2\", \"d2\", \"e2\"), fctName, fctText )"},{"path":"https://hreinwald.github.io/drc/reference/twophase.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Two-Phase Dose-Response Model — twophase","text":"fixed numeric vector specifying parameters fixed value fixed. NAs used parameters fixed. names vector character strings giving names parameters (contain \":\"). default reasonable. fctName optional character string used internally convenience functions. fctText optional character string used internally convenience functions.","code":""},{"path":"https://hreinwald.github.io/drc/reference/twophase.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Two-Phase Dose-Response Model — twophase","text":"list containing nonlinear function, self starter function, parameter names.","code":""},{"path":"https://hreinwald.github.io/drc/reference/twophase.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Two-Phase Dose-Response Model — twophase","text":"Following Groot et al (1996) two-phase model function : $$f(x) = c + \\frac{d1-c}{1+\\exp(b1(\\log(x)-\\log(e1)))} + \\frac{d2}{1+\\exp(b2(\\log(x)-\\log(e2)))}$$ two phases, parameters interpretation ordinary log-logistic model.","code":""},{"path":"https://hreinwald.github.io/drc/reference/twophase.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Two-Phase Dose-Response Model — twophase","text":"Groot, J. C. J., Cone, J. W., Williams, B. ., Debersaques, F. M. ., Lantinga, E. . (1996) Multiphasic analysis gas production kinetics vitro fermentation ruminant feeds, Animal Feed Science Technology, 64, 77–89.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/twophase.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Two-Phase Dose-Response Model — twophase","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/ucedergreen.html","id":null,"dir":"Reference","previous_headings":"","what":"U-shaped Cedergreen-Ritz-Streibig model — ucedergreen","title":"U-shaped Cedergreen-Ritz-Streibig model — ucedergreen","text":"ucedergreen provides general way specifying Cedergreen-Ritz-Streibig modified log-logistic model describing u-shaped hormesis, various constraints parameters.","code":""},{"path":"https://hreinwald.github.io/drc/reference/ucedergreen.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"U-shaped Cedergreen-Ritz-Streibig model — ucedergreen","text":"","code":"ucedergreen( fixed = c(NA, NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\", \"f\"), method = c(\"loglinear\", \"anke\", \"method3\", \"normolle\"), ssfct = NULL, alpha, fctName, fctText )"},{"path":"https://hreinwald.github.io/drc/reference/ucedergreen.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"U-shaped Cedergreen-Ritz-Streibig model — ucedergreen","text":"fixed numeric vector length 5 specifying parameters held fixed estimation. order c(b, c, d, e, f). Use NA parameters estimated. default estimate parameters. names character vector length 5 providing names parameters. default c(\"b\", \"c\", \"d\", \"e\", \"f\"). method character string specifying method self-starter function use finding initial parameter values. Options \"loglinear\", \"anke\", \"method3\", \"normolle\". used ssfct NULL. ssfct custom self-starter function. NULL (default), self-starter automatically generated calling cedergreen.ssf specified method, fixed, alpha arguments. alpha mandatory numeric value specifying fixed shape parameter \\(\\alpha\\). function stop provided. fctName optional character string name function object. fctText optional character string providing descriptive text model.","code":""},{"path":"https://hreinwald.github.io/drc/reference/ucedergreen.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"U-shaped Cedergreen-Ritz-Streibig model — ucedergreen","text":"list class \"UCRS\", containing model function (fct), self-starter function (ssfct), parameter names (names), components required use modeling functions like drm.","code":""},{"path":"https://hreinwald.github.io/drc/reference/ucedergreen.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"U-shaped Cedergreen-Ritz-Streibig model — ucedergreen","text":"u-shaped model given expression $$f(x) = c + d - \\frac{d-c+f \\exp(-1/x^{\\alpha})}{1+\\exp(b(\\log(x)-\\log(e)))}$$","code":""},{"path":"https://hreinwald.github.io/drc/reference/ucedergreen.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"U-shaped Cedergreen-Ritz-Streibig model — ucedergreen","text":"Cedergreen, N. Ritz, C. Streibig, J. C. (2005) Improved empirical models describing hormesis, Environmental Toxicology Chemistry 24, 3166–3172.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/ucedergreen.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"U-shaped Cedergreen-Ritz-Streibig model — ucedergreen","text":"Christian Ritz, Hannes Reinwald","code":""},{"path":"https://hreinwald.github.io/drc/reference/UCRS.4a.html","id":null,"dir":"Reference","previous_headings":"","what":"U-shaped CRS model with lower limit 0 (alpha=1) — UCRS.4a","title":"U-shaped CRS model with lower limit 0 (alpha=1) — UCRS.4a","text":"Four-parameter u-shaped CRS hormesis model lower limit fixed 0 alpha=1.","code":""},{"path":"https://hreinwald.github.io/drc/reference/UCRS.4a.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"U-shaped CRS model with lower limit 0 (alpha=1) — UCRS.4a","text":"","code":"UCRS.4a(names = c(\"b\", \"d\", \"e\", \"f\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/UCRS.4a.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"U-shaped CRS model with lower limit 0 (alpha=1) — UCRS.4a","text":"names vector character strings giving names parameters. ... additional arguments passed ucedergreen.","code":""},{"path":"https://hreinwald.github.io/drc/reference/UCRS.4a.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"U-shaped CRS model with lower limit 0 (alpha=1) — UCRS.4a","text":"list (see ucedergreen).","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/UCRS.4b.html","id":null,"dir":"Reference","previous_headings":"","what":"U-shaped CRS model with lower limit 0 (alpha=0.5) — UCRS.4b","title":"U-shaped CRS model with lower limit 0 (alpha=0.5) — UCRS.4b","text":"Four-parameter u-shaped CRS hormesis model lower limit fixed 0 alpha=0.5.","code":""},{"path":"https://hreinwald.github.io/drc/reference/UCRS.4b.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"U-shaped CRS model with lower limit 0 (alpha=0.5) — UCRS.4b","text":"","code":"UCRS.4b(names = c(\"b\", \"d\", \"e\", \"f\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/UCRS.4b.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"U-shaped CRS model with lower limit 0 (alpha=0.5) — UCRS.4b","text":"names vector character strings giving names parameters. ... additional arguments passed ucedergreen.","code":""},{"path":"https://hreinwald.github.io/drc/reference/UCRS.4b.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"U-shaped CRS model with lower limit 0 (alpha=0.5) — UCRS.4b","text":"list (see ucedergreen).","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/UCRS.4c.html","id":null,"dir":"Reference","previous_headings":"","what":"U-shaped CRS model with lower limit 0 (alpha=0.25) — UCRS.4c","title":"U-shaped CRS model with lower limit 0 (alpha=0.25) — UCRS.4c","text":"Four-parameter u-shaped CRS hormesis model lower limit fixed 0 alpha=0.25.","code":""},{"path":"https://hreinwald.github.io/drc/reference/UCRS.4c.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"U-shaped CRS model with lower limit 0 (alpha=0.25) — UCRS.4c","text":"","code":"UCRS.4c(names = c(\"b\", \"d\", \"e\", \"f\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/UCRS.4c.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"U-shaped CRS model with lower limit 0 (alpha=0.25) — UCRS.4c","text":"names vector character strings giving names parameters. ... additional arguments passed ucedergreen.","code":""},{"path":"https://hreinwald.github.io/drc/reference/UCRS.4c.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"U-shaped CRS model with lower limit 0 (alpha=0.25) — UCRS.4c","text":"list (see ucedergreen).","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/UCRS.5a.html","id":null,"dir":"Reference","previous_headings":"","what":"U-shaped CRS five-parameter model (alpha=1) — UCRS.5a","title":"U-shaped CRS five-parameter model (alpha=1) — UCRS.5a","text":"Five-parameter u-shaped CRS hormesis model alpha=1.","code":""},{"path":"https://hreinwald.github.io/drc/reference/UCRS.5a.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"U-shaped CRS five-parameter model (alpha=1) — UCRS.5a","text":"","code":"UCRS.5a(names = c(\"b\", \"c\", \"d\", \"e\", \"f\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/UCRS.5a.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"U-shaped CRS five-parameter model (alpha=1) — UCRS.5a","text":"names vector character strings giving names parameters. ... additional arguments passed ucedergreen.","code":""},{"path":"https://hreinwald.github.io/drc/reference/UCRS.5a.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"U-shaped CRS five-parameter model (alpha=1) — UCRS.5a","text":"list (see ucedergreen).","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/UCRS.5b.html","id":null,"dir":"Reference","previous_headings":"","what":"U-shaped CRS five-parameter model (alpha=0.5) — UCRS.5b","title":"U-shaped CRS five-parameter model (alpha=0.5) — UCRS.5b","text":"Five-parameter u-shaped CRS hormesis model alpha=0.5.","code":""},{"path":"https://hreinwald.github.io/drc/reference/UCRS.5b.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"U-shaped CRS five-parameter model (alpha=0.5) — UCRS.5b","text":"","code":"UCRS.5b(names = c(\"b\", \"c\", \"d\", \"e\", \"f\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/UCRS.5b.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"U-shaped CRS five-parameter model (alpha=0.5) — UCRS.5b","text":"names vector character strings giving names parameters. ... additional arguments passed ucedergreen.","code":""},{"path":"https://hreinwald.github.io/drc/reference/UCRS.5b.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"U-shaped CRS five-parameter model (alpha=0.5) — UCRS.5b","text":"list (see ucedergreen).","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/UCRS.5c.html","id":null,"dir":"Reference","previous_headings":"","what":"U-shaped CRS five-parameter model (alpha=0.25) — UCRS.5c","title":"U-shaped CRS five-parameter model (alpha=0.25) — UCRS.5c","text":"Five-parameter u-shaped CRS hormesis model alpha=0.25.","code":""},{"path":"https://hreinwald.github.io/drc/reference/UCRS.5c.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"U-shaped CRS five-parameter model (alpha=0.25) — UCRS.5c","text":"","code":"UCRS.5c(names = c(\"b\", \"c\", \"d\", \"e\", \"f\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/UCRS.5c.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"U-shaped CRS five-parameter model (alpha=0.25) — UCRS.5c","text":"names vector character strings giving names parameters. ... additional arguments passed ucedergreen.","code":""},{"path":"https://hreinwald.github.io/drc/reference/UCRS.5c.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"U-shaped CRS five-parameter model (alpha=0.25) — UCRS.5c","text":"list (see ucedergreen).","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/uml3a.html","id":null,"dir":"Reference","previous_headings":"","what":"Alias for UCRS.4a — uml3a","title":"Alias for UCRS.4a — uml3a","text":"uml3a alias UCRS.4a.","code":""},{"path":"https://hreinwald.github.io/drc/reference/uml3a.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Alias for UCRS.4a — uml3a","text":"","code":"uml3a(names = c(\"b\", \"d\", \"e\", \"f\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/uml3a.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Alias for UCRS.4a — uml3a","text":"names vector character strings giving names parameters. ... additional arguments passed ucedergreen.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/uml3b.html","id":null,"dir":"Reference","previous_headings":"","what":"Alias for UCRS.4b — uml3b","title":"Alias for UCRS.4b — uml3b","text":"uml3b alias UCRS.4b.","code":""},{"path":"https://hreinwald.github.io/drc/reference/uml3b.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Alias for UCRS.4b — uml3b","text":"","code":"uml3b(names = c(\"b\", \"d\", \"e\", \"f\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/uml3b.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Alias for UCRS.4b — uml3b","text":"names vector character strings giving names parameters. ... additional arguments passed ucedergreen.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/uml3c.html","id":null,"dir":"Reference","previous_headings":"","what":"Alias for UCRS.4c — uml3c","title":"Alias for UCRS.4c — uml3c","text":"uml3c alias UCRS.4c.","code":""},{"path":"https://hreinwald.github.io/drc/reference/uml3c.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Alias for UCRS.4c — uml3c","text":"","code":"uml3c(names = c(\"b\", \"d\", \"e\", \"f\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/uml3c.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Alias for UCRS.4c — uml3c","text":"names vector character strings giving names parameters. ... additional arguments passed ucedergreen.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/uml4a.html","id":null,"dir":"Reference","previous_headings":"","what":"Alias for UCRS.5a — uml4a","title":"Alias for UCRS.5a — uml4a","text":"uml4a alias UCRS.5a.","code":""},{"path":"https://hreinwald.github.io/drc/reference/uml4a.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Alias for UCRS.5a — uml4a","text":"","code":"uml4a(names = c(\"b\", \"c\", \"d\", \"e\", \"f\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/uml4a.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Alias for UCRS.5a — uml4a","text":"names vector character strings giving names parameters. ... additional arguments passed ucedergreen.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/uml4b.html","id":null,"dir":"Reference","previous_headings":"","what":"Alias for UCRS.5b — uml4b","title":"Alias for UCRS.5b — uml4b","text":"uml4b alias UCRS.5b.","code":""},{"path":"https://hreinwald.github.io/drc/reference/uml4b.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Alias for UCRS.5b — uml4b","text":"","code":"uml4b(names = c(\"b\", \"c\", \"d\", \"e\", \"f\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/uml4b.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Alias for UCRS.5b — uml4b","text":"names vector character strings giving names parameters. ... additional arguments passed ucedergreen.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/uml4c.html","id":null,"dir":"Reference","previous_headings":"","what":"Alias for UCRS.5c — uml4c","title":"Alias for UCRS.5c — uml4c","text":"uml4c alias UCRS.5c.","code":""},{"path":"https://hreinwald.github.io/drc/reference/uml4c.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Alias for UCRS.5c — uml4c","text":"","code":"uml4c(names = c(\"b\", \"c\", \"d\", \"e\", \"f\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/uml4c.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Alias for UCRS.5c — uml4c","text":"names vector character strings giving names parameters. ... additional arguments passed ucedergreen.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/update.drc.html","id":null,"dir":"Reference","previous_headings":"","what":"Updating and re-fitting a model — update.drc","title":"Updating and re-fitting a model — update.drc","text":"update updates re-fits model basis object class 'drc'.","code":""},{"path":"https://hreinwald.github.io/drc/reference/update.drc.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Updating and re-fitting a model — update.drc","text":"","code":"# S3 method for class 'drc' update(object, ..., evaluate = TRUE)"},{"path":"https://hreinwald.github.io/drc/reference/update.drc.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Updating and re-fitting a model — update.drc","text":"object object class 'drc'. ... arguments alter object. evaluate logical. TRUE model re-fit; otherwise unevaluated call returned.","code":""},{"path":"https://hreinwald.github.io/drc/reference/update.drc.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Updating and re-fitting a model — update.drc","text":"object class 'drc'.","code":""},{"path":"https://hreinwald.github.io/drc/reference/update.drc.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Updating and re-fitting a model — update.drc","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/update.drc.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Updating and re-fitting a model — update.drc","text":"","code":"## Fitting a four-parameter Weibull model model1 <- drm(ryegrass, fct = W1.4()) ## Updating 'model1' by fitting a three-parameter Weibull model instead model2 <- update(model1, fct = W1.3()) anova(model2, model1) #> #> 1st model #> fct: W1.3() #> 2nd model #> fct: W1.4() #> #> ANOVA table #> #> ModelDf RSS Df F value p value #> 1st model 21 8.9520 #> 2nd model 20 6.0242 1 9.7205 0.0054"},{"path":"https://hreinwald.github.io/drc/reference/upFixed.html","id":null,"dir":"Reference","previous_headings":"","what":"Construct Text for Model with Fixed Upper Limit — upFixed","title":"Construct Text for Model with Fixed Upper Limit — upFixed","text":"Helper function appends upper limit information model description string.","code":""},{"path":"https://hreinwald.github.io/drc/reference/upFixed.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Construct Text for Model with Fixed Upper Limit — upFixed","text":"","code":"upFixed(modelStr, upper)"},{"path":"https://hreinwald.github.io/drc/reference/upFixed.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Construct Text for Model with Fixed Upper Limit — upFixed","text":"modelStr character string base model description. upper numeric value fixed upper limit.","code":""},{"path":"https://hreinwald.github.io/drc/reference/upFixed.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Construct Text for Model with Fixed Upper Limit — upFixed","text":"character string describing model fixed upper limit.","code":""},{"path":"https://hreinwald.github.io/drc/reference/ursa.html","id":null,"dir":"Reference","previous_headings":"","what":"Universal Response Surface Approach (URSA) for Drug Interaction — ursa","title":"Universal Response Surface Approach (URSA) for Drug Interaction — ursa","text":"URSA provides parametric approach modelling joint action several agents. model allows quantification synergistic effects single parameter. model function defined implicitly appropriate equation.","code":""},{"path":"https://hreinwald.github.io/drc/reference/ursa.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Universal Response Surface Approach (URSA) for Drug Interaction — ursa","text":"","code":"ursa( fixed = rep(NA, 7), names = c(\"b1\", \"b2\", \"c\", \"d\", \"e1\", \"e2\", \"f\"), ssfct = NULL )"},{"path":"https://hreinwald.github.io/drc/reference/ursa.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Universal Response Surface Approach (URSA) for Drug Interaction — ursa","text":"fixed numeric vector. Specifies parameters fixed value fixed. NAs parameters fixed. names vector character strings giving names parameters. default reasonable. ssfct self starter function used (optional).","code":""},{"path":"https://hreinwald.github.io/drc/reference/ursa.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Universal Response Surface Approach (URSA) for Drug Interaction — ursa","text":"list containing nonlinear function, self starter function, parameter names.","code":""},{"path":"https://hreinwald.github.io/drc/reference/ursa.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Universal Response Surface Approach (URSA) for Drug Interaction — ursa","text":"Greco, W. R. Park H. S. Rustum, Y. M. (1990) Application New Approach Quantitation Drug Synergism Combination cis-Diamminedichloroplatinum 1-beta-D-Arabinofuranosylcytosine, Cancer Research, 50, 5318–5327. Greco, W. R. Bravo, G. Parsons, J. C. (1995) Search Synergy: Critical Review Response Surface Perspective, Pharmacological Reviews, 47, Issue 2, 331–385.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/ursa.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Universal Response Surface Approach (URSA) for Drug Interaction — ursa","text":"Christian Ritz idea Hugo Ceulemans.","code":""},{"path":"https://hreinwald.github.io/drc/reference/ursa.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Universal Response Surface Approach (URSA) for Drug Interaction — ursa","text":"","code":"d1 <- c(0, 0, 0, 0, 0, 0, 0, 0, 2, 5, 10, 20, 50, 2, 2, 2, 2, 2, 5, 5, 5, 5, 5, 10, 10, 10, 10, 10, 20, 20, 20, 20, 20, 50, 50, 50, 50, 50) d2 <- c(0, 0, 0, 0.2, 0.5, 1, 2, 5, 0, 0, 0, 0, 0, 0.2, 0.5, 1, 2, 5, 0.2, 0.5, 1, 2, 5, 0.2, 0.5, 1, 2, 5, 0.2, 0.5, 1, 2, 5, 0.2, 0.5, 1, 2, 5) effect <- c(106, 99.2, 115, 79.2, 70.1, 49, 21, 3.83, 74.2, 71.5, 48.1, 30.9, 16.3, 76.3, 48.8, 44.5, 15.5, 3.21, 56.7, 47.5, 26.8, 16.9, 3.25, 46.7, 35.6, 21.5, 11.1, 2.94, 24.8, 21.6, 17.3, 7.78, 1.84, 13.6, 11.1, 6.43, 3.34, 0.89) greco <- data.frame(d1, d2, effect) greco.m1 <- drm(effect ~ d1 + d2, data = greco, fct = ursa(fixed = c(NA, NA, 0, NA, NA, NA, NA))) summary(greco.m1) #> #> Model fitted: URSA (6 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> b1:(Intercept) -0.959953 0.098934 -9.7030 4.716e-11 *** #> b2:(Intercept) -1.414817 0.145057 -9.7535 4.160e-11 *** #> d:(Intercept) 103.466985 2.772607 37.3176 < 2.2e-16 *** #> e1:(Intercept) 9.209402 0.959596 9.5972 6.139e-11 *** #> e2:(Intercept) 0.807378 0.072583 11.1236 1.574e-12 *** #> f:(Intercept) 0.480612 0.273154 1.7595 0.08805 . #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 4.727843 (32 degrees of freedom)"},{"path":"https://hreinwald.github.io/drc/reference/vcov.drc.html","id":null,"dir":"Reference","previous_headings":"","what":"Calculating variance-covariance matrix for objects of class 'drc' — vcov.drc","title":"Calculating variance-covariance matrix for objects of class 'drc' — vcov.drc","text":"vcov returns estimated variance-covariance matrix parameters non-linear function.","code":""},{"path":"https://hreinwald.github.io/drc/reference/vcov.drc.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Calculating variance-covariance matrix for objects of class 'drc' — vcov.drc","text":"","code":"# S3 method for class 'drc' vcov(object, ..., corr = FALSE, od = FALSE, pool = TRUE, unscaled = FALSE)"},{"path":"https://hreinwald.github.io/drc/reference/vcov.drc.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Calculating variance-covariance matrix for objects of class 'drc' — vcov.drc","text":"object object class 'drc'. ... additional arguments. corr logical. TRUE correlation matrix returned. od logical. TRUE adjustment -dispersion used. argument makes difference binomial data. pool logical. TRUE curves pooled. Otherwise . argument works models independently fitted curves specified drm. unscaled logical. TRUE unscaled variance-covariance returned. argument makes difference continuous data.","code":""},{"path":"https://hreinwald.github.io/drc/reference/vcov.drc.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Calculating variance-covariance matrix for objects of class 'drc' — vcov.drc","text":"matrix estimated variances covariances.","code":""},{"path":"https://hreinwald.github.io/drc/reference/vcov.drc.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Calculating variance-covariance matrix for objects of class 'drc' — vcov.drc","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/vcov.drc.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Calculating variance-covariance matrix for objects of class 'drc' — vcov.drc","text":"","code":"## Fitting a four-parameter log-logistic model ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) vcov(ryegrass.m1) #> [,1] [,2] [,3] [,4] #> [1,] 0.216282967 0.04601511 -0.03504683 -0.003763692 #> [2,] 0.046015113 0.04502563 -0.00471192 -0.016918440 #> [3,] -0.035046835 -0.00471192 0.03555759 -0.012868772 #> [4,] -0.003763692 -0.01691844 -0.01286877 0.034496126 vcov(ryegrass.m1, corr = TRUE) #> [,1] [,2] [,3] [,4] #> [1,] 1.00000000 0.4662936 -0.3996423 -0.04357304 #> [2,] 0.46629357 1.0000000 -0.1177611 -0.42928455 #> [3,] -0.39964231 -0.1177611 1.0000000 -0.36743943 #> [4,] -0.04357304 -0.4292845 -0.3674394 1.00000000"},{"path":"https://hreinwald.github.io/drc/reference/vec2mat.html","id":null,"dir":"Reference","previous_headings":"","what":"Convert function specification to list — vec2mat","title":"Convert function specification to list — vec2mat","text":"Convert function specification list","code":""},{"path":"https://hreinwald.github.io/drc/reference/vec2mat.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Convert function specification to list — vec2mat","text":"","code":"vec2mat(fct, no)"},{"path":"https://hreinwald.github.io/drc/reference/vinclozolin.html","id":null,"dir":"Reference","previous_headings":"","what":"Vinclozolin from AR in vitro assay — vinclozolin","title":"Vinclozolin from AR in vitro assay — vinclozolin","text":"Dose-response experiment vinclozolin AR reporter gene assay","code":""},{"path":"https://hreinwald.github.io/drc/reference/vinclozolin.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Vinclozolin from AR in vitro assay — vinclozolin","text":"","code":"data(vinclozolin)"},{"path":"https://hreinwald.github.io/drc/reference/vinclozolin.html","id":"format","dir":"Reference","previous_headings":"","what":"Format","title":"Vinclozolin from AR in vitro assay — vinclozolin","text":"data frame 53 observations following 3 variables. exper factor levels 10509 10821 10828 10904 11023 11106 conc numeric vector concentrations vinclozolin effect numeric vector luminescense effects","code":""},{"path":"https://hreinwald.github.io/drc/reference/vinclozolin.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Vinclozolin from AR in vitro assay — vinclozolin","text":"basic dose-response experiment repeated 6 times different days. Chinese Hamster Ovary cells exposed various concentrations vinclozolin 22 hours resulting luminescense effects recorded. Data part mixture experiment reported Nellemann et al (2003).","code":""},{"path":"https://hreinwald.github.io/drc/reference/vinclozolin.html","id":"source","dir":"Reference","previous_headings":"","what":"Source","title":"Vinclozolin from AR in vitro assay — vinclozolin","text":"Nellemann C., Dalgaard M., Lam H.R. Vinggaard .M. (2003) combined effects vinclozolin procymidone deviate expected additivity vitro vivo, Toxicological Sciences, 71, 251–262.","code":""},{"path":"https://hreinwald.github.io/drc/reference/vinclozolin.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Vinclozolin from AR in vitro assay — vinclozolin","text":"","code":"library(drc) vinclozolin.m1 <- drm(effect~conc, exper, data=vinclozolin, fct = LL.3()) plot(vinclozolin.m1, xlim=c(0,50), ylim=c(0,2800), conLevel=1e-4) #> Warning: \"conLevel\" is not a graphical parameter #> Warning: \"conLevel\" is not a graphical parameter #> Warning: \"conLevel\" is not a graphical parameter #> Warning: \"conLevel\" is not a graphical parameter #> Warning: \"conLevel\" is not a graphical parameter #> Warning: \"conLevel\" is not a graphical parameter #> Warning: \"conLevel\" is not a graphical parameter #> Warning: \"conLevel\" is not a graphical parameter #> Warning: \"conLevel\" is not a graphical parameter #> Warning: \"conLevel\" is not a graphical parameter #> Warning: \"conLevel\" is not a graphical parameter #> Warning: \"conLevel\" is not a graphical parameter #> Warning: \"conLevel\" is not a graphical parameter #> Warning: \"conLevel\" is not a graphical parameter #> Warning: \"conLevel\" is not a graphical parameter vinclozolin.m2 <- drm(effect~conc, data=vinclozolin, fct = LL.3()) plot(vinclozolin.m2, xlim=c(0,50), conLevel=1e-4, add=TRUE, type=\"none\", col=\"red\") #> Warning: \"conLevel\" is not a graphical parameter ## Are the ED50 values indetical across experiments? vinclozolin.m3 <- update(vinclozolin.m1, pmodels=data.frame(exper, exper, 1)) anova(vinclozolin.m3, vinclozolin.m1) # No! #> #> 1st model #> fct: LL.3() #> pmodels: exper, exper, 1 #> 2nd model #> fct: LL.3() #> pmodels: exper (for all parameters) #> #> ANOVA table #> #> ModelDf RSS Df F value p value #> 1st model 40 972732 #> 2nd model 35 385169 5 10.678 0.000"},{"path":"https://hreinwald.github.io/drc/reference/voelund.html","id":null,"dir":"Reference","previous_headings":"","what":"Voelund Mixture Model — voelund","title":"Voelund Mixture Model — voelund","text":"Provides Voelund model describing joint action two compounds binary mixture experiments. Used internally mixture.","code":""},{"path":"https://hreinwald.github.io/drc/reference/voelund.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Voelund Mixture Model — voelund","text":"","code":"voelund( fixed = c(NA, NA, NA, NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\", \"f\", \"g\", \"h\"), method = c(\"1\", \"2\", \"3\", \"4\"), ssfct = NULL, eps = 1e-10 )"},{"path":"https://hreinwald.github.io/drc/reference/voelund.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Voelund Mixture Model — voelund","text":"fixed numeric vector. Specifies parameters fixed value fixed. NAs parameters fixed. names vector character strings giving names parameters (contain \":\"). method character string indicating self starter function use. ssfct self starter function used (optional). eps numeric tolerance handling zero dose values.","code":""},{"path":"https://hreinwald.github.io/drc/reference/voelund.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Voelund Mixture Model — voelund","text":"list containing nonlinear model function, self starter function, parameter names.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/voelund.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Voelund Mixture Model — voelund","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/W1.2.html","id":null,"dir":"Reference","previous_headings":"","what":"Two-parameter Weibull type 1 model — W1.2","title":"Two-parameter Weibull type 1 model — W1.2","text":"two-parameter Weibull type 1 model lower limit fixed 0 upper limit fixed specified value (default 1).","code":""},{"path":"https://hreinwald.github.io/drc/reference/W1.2.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Two-parameter Weibull type 1 model — W1.2","text":"","code":"W1.2(upper = 1, fixed = c(NA, NA), names = c(\"b\", \"e\"), ...) w2(upper = 1, fixed = c(NA, NA), names = c(\"b\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/W1.2.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Two-parameter Weibull type 1 model — W1.2","text":"upper numeric value giving fixed upper limit. default 1. fixed numeric vector length 2. Specifies parameters fixed value. Use NA parameters fixed. names character vector length 2 giving names parameters. default c(\"b\", \"e\"). ... additional arguments passed weibull1, notably method (character string: \"1\" (default), \"2\", \"3\", \"4\") selects self-starter method obtaining starting values. See weibull1 details.","code":""},{"path":"https://hreinwald.github.io/drc/reference/W1.2.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Two-parameter Weibull type 1 model — W1.2","text":"list class Weibull-1 containing nonlinear function, self starter function, parameter names.","code":""},{"path":"https://hreinwald.github.io/drc/reference/W1.2.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Two-parameter Weibull type 1 model — W1.2","text":"model given expression $$f(x) = upper \\exp(-\\exp(b(\\log(x) - \\log(e))))$$ mostly used binomial/quantal responses.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/W1.2.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Two-parameter Weibull type 1 model — W1.2","text":"","code":"earthworms.m1 <- drm(number/total ~ dose, weights = total, data = earthworms, fct = W1.2(), type = \"binomial\")"},{"path":"https://hreinwald.github.io/drc/reference/W1.3.html","id":null,"dir":"Reference","previous_headings":"","what":"Three-parameter Weibull type 1 model — W1.3","title":"Three-parameter Weibull type 1 model — W1.3","text":"three-parameter Weibull type 1 model lower limit fixed 0.","code":""},{"path":"https://hreinwald.github.io/drc/reference/W1.3.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Three-parameter Weibull type 1 model — W1.3","text":"","code":"W1.3(fixed = c(NA, NA, NA), names = c(\"b\", \"d\", \"e\"), ...) w3(fixed = c(NA, NA, NA), names = c(\"b\", \"d\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/W1.3.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Three-parameter Weibull type 1 model — W1.3","text":"fixed numeric vector length 3. Specifies parameters fixed value. Use NA parameters fixed. names character vector length 3 giving names parameters. default c(\"b\", \"d\", \"e\"). ... additional arguments passed weibull1, notably method (character string: \"1\" (default), \"2\", \"3\", \"4\") selects self-starter method obtaining starting values. See weibull1 details.","code":""},{"path":"https://hreinwald.github.io/drc/reference/W1.3.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Three-parameter Weibull type 1 model — W1.3","text":"list class Weibull-1 containing nonlinear function, self starter function, parameter names.","code":""},{"path":"https://hreinwald.github.io/drc/reference/W1.3.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Three-parameter Weibull type 1 model — W1.3","text":"model given expression $$f(x) = d \\exp(-\\exp(b(\\log(x) - \\log(e))))$$ special case four-parameter Weibull type 1 model lower limit fixed 0.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/W1.3.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Three-parameter Weibull type 1 model — W1.3","text":"","code":"ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.3())"},{"path":"https://hreinwald.github.io/drc/reference/W1.3u.html","id":null,"dir":"Reference","previous_headings":"","what":"Three-parameter Weibull type 1 model with upper limit fixed — W1.3u","title":"Three-parameter Weibull type 1 model with upper limit fixed — W1.3u","text":"three-parameter Weibull type 1 model upper limit fixed (default 1).","code":""},{"path":"https://hreinwald.github.io/drc/reference/W1.3u.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Three-parameter Weibull type 1 model with upper limit fixed — W1.3u","text":"","code":"W1.3u(upper = 1, fixed = c(NA, NA, NA), names = c(\"b\", \"c\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/W1.3u.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Three-parameter Weibull type 1 model with upper limit fixed — W1.3u","text":"upper numeric value giving fixed upper limit. default 1. fixed numeric vector length 3. Specifies parameters fixed value. Use NA parameters fixed. names character vector length 3 giving names parameters. default c(\"b\", \"c\", \"e\"). ... additional arguments passed weibull1, notably method (character string: \"1\" (default), \"2\", \"3\", \"4\") selects self-starter method obtaining starting values. See weibull1 details.","code":""},{"path":"https://hreinwald.github.io/drc/reference/W1.3u.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Three-parameter Weibull type 1 model with upper limit fixed — W1.3u","text":"list class Weibull-1 containing nonlinear function, self starter function, parameter names.","code":""},{"path":"https://hreinwald.github.io/drc/reference/W1.3u.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Three-parameter Weibull type 1 model with upper limit fixed — W1.3u","text":"model given expression $$f(x) = c + (upper - c) \\exp(-\\exp(b(\\log(x) - \\log(e))))$$ special case four-parameter Weibull type 1 model upper limit fixed specified value.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/W1.4.html","id":null,"dir":"Reference","previous_headings":"","what":"Four-parameter Weibull type 1 model — W1.4","title":"Four-parameter Weibull type 1 model — W1.4","text":"four-parameter Weibull type 1 model.","code":""},{"path":"https://hreinwald.github.io/drc/reference/W1.4.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Four-parameter Weibull type 1 model — W1.4","text":"","code":"W1.4(fixed = c(NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\"), ...) w4(fixed = c(NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/W1.4.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Four-parameter Weibull type 1 model — W1.4","text":"fixed numeric vector length 4. Specifies parameters fixed value. Use NA parameters fixed. names character vector length 4 giving names parameters. default c(\"b\", \"c\", \"d\", \"e\"). ... additional arguments passed weibull1, notably method (character string: \"1\" (default), \"2\", \"3\", \"4\") selects self-starter method obtaining starting values. See weibull1 details.","code":""},{"path":"https://hreinwald.github.io/drc/reference/W1.4.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Four-parameter Weibull type 1 model — W1.4","text":"list class Weibull-1 containing nonlinear function, self starter function, parameter names.","code":""},{"path":"https://hreinwald.github.io/drc/reference/W1.4.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Four-parameter Weibull type 1 model — W1.4","text":"model given expression $$f(x) = c + (d - c) \\exp(-\\exp(b(\\log(x) - \\log(e))))$$","code":""},{"path":"https://hreinwald.github.io/drc/reference/W1.4.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Four-parameter Weibull type 1 model — W1.4","text":"Seber, G. . F. Wild, C. J. (1989) Nonlinear Regression, New York: Wiley & Sons (pp. 338–339). Ritz, C. (2009) Towards unified approach dose-response modeling ecotoxicology. Environ Toxicol Chem, 29, 220–229.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/W1.4.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Four-parameter Weibull type 1 model — W1.4","text":"","code":"terbuthylazin.m1 <- drm(rgr ~ dose, data = terbuthylazin, fct = W1.4())"},{"path":"https://hreinwald.github.io/drc/reference/W2.2.html","id":null,"dir":"Reference","previous_headings":"","what":"Two-parameter Weibull (type 2) model — W2.2","title":"Two-parameter Weibull (type 2) model — W2.2","text":"two-parameter Weibull type 2 model lower limit fixed 0 upper limit fixed specified value. model given equation $$f(x) = \\mathrm{upper} \\cdot (1 - \\exp(-\\exp(b(\\log(x) - \\log(e)))))$$ model primarily intended binomial/quantal responses.","code":""},{"path":"https://hreinwald.github.io/drc/reference/W2.2.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Two-parameter Weibull (type 2) model — W2.2","text":"","code":"W2.2(upper = 1, fixed = c(NA, NA), names = c(\"b\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/W2.2.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Two-parameter Weibull (type 2) model — W2.2","text":"upper numeric value giving fixed upper limit (default 1). fixed numeric vector length 2, specifying fixed parameters (use NA parameters estimated). names character vector length 2 giving names parameters (default c(\"b\", \"e\")). ... additional arguments passed weibull2, notably method (character string: \"1\" (default), \"2\", \"3\", \"4\") selects self-starter method obtaining starting values. See weibull2 details.","code":""},{"path":"https://hreinwald.github.io/drc/reference/W2.2.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Two-parameter Weibull (type 2) model — W2.2","text":"list class \"Weibull-2\" returned weibull2.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/W2.2.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Two-parameter Weibull (type 2) model — W2.2","text":"","code":"earthworms.m1 <- drm(number/total ~ dose, weights = total, data = earthworms, fct = W2.2(), type = \"binomial\")"},{"path":"https://hreinwald.github.io/drc/reference/W2.3.html","id":null,"dir":"Reference","previous_headings":"","what":"Three-parameter Weibull (type 2) model — W2.3","title":"Three-parameter Weibull (type 2) model — W2.3","text":"three-parameter Weibull type 2 model lower limit fixed 0. model given equation $$f(x) = d \\cdot (1 - \\exp(-\\exp(b(\\log(x) - \\log(e)))))$$","code":""},{"path":"https://hreinwald.github.io/drc/reference/W2.3.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Three-parameter Weibull (type 2) model — W2.3","text":"","code":"W2.3(fixed = c(NA, NA, NA), names = c(\"b\", \"d\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/W2.3.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Three-parameter Weibull (type 2) model — W2.3","text":"fixed numeric vector length 3, specifying fixed parameters (use NA parameters estimated). names character vector length 3 giving names parameters (default c(\"b\", \"d\", \"e\")). ... additional arguments passed weibull2, notably method (character string: \"1\" (default), \"2\", \"3\", \"4\") selects self-starter method obtaining starting values. See weibull2 details.","code":""},{"path":"https://hreinwald.github.io/drc/reference/W2.3.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Three-parameter Weibull (type 2) model — W2.3","text":"list class \"Weibull-2\" returned weibull2.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/W2.3.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Three-parameter Weibull (type 2) model — W2.3","text":"","code":"ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W2.3())"},{"path":"https://hreinwald.github.io/drc/reference/W2.3u.html","id":null,"dir":"Reference","previous_headings":"","what":"Three-parameter Weibull (type 2) model with upper limit fixed — W2.3u","title":"Three-parameter Weibull (type 2) model with upper limit fixed — W2.3u","text":"three-parameter Weibull type 2 model upper limit fixed specified value. model given equation $$f(x) = c + (\\mathrm{upper} - c)(1 - \\exp(-\\exp(b(\\log(x) - \\log(e)))))$$","code":""},{"path":"https://hreinwald.github.io/drc/reference/W2.3u.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Three-parameter Weibull (type 2) model with upper limit fixed — W2.3u","text":"","code":"W2.3u(upper = 1, fixed = c(NA, NA, NA), names = c(\"b\", \"c\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/W2.3u.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Three-parameter Weibull (type 2) model with upper limit fixed — W2.3u","text":"upper numeric value giving fixed upper limit (default 1). fixed numeric vector length 3, specifying fixed parameters (use NA parameters estimated). names character vector length 3 giving names parameters (default c(\"b\", \"c\", \"e\")). ... additional arguments passed weibull2, notably method (character string: \"1\" (default), \"2\", \"3\", \"4\") selects self-starter method obtaining starting values. See weibull2 details.","code":""},{"path":"https://hreinwald.github.io/drc/reference/W2.3u.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Three-parameter Weibull (type 2) model with upper limit fixed — W2.3u","text":"list class \"Weibull-2\" returned weibull2.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/W2.4.html","id":null,"dir":"Reference","previous_headings":"","what":"Four-parameter Weibull (type 2) model — W2.4","title":"Four-parameter Weibull (type 2) model — W2.4","text":"four-parameter Weibull type 2 model. model given equation $$f(x) = c + (d - c)(1 - \\exp(-\\exp(b(\\log(x) - \\log(e)))))$$","code":""},{"path":"https://hreinwald.github.io/drc/reference/W2.4.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Four-parameter Weibull (type 2) model — W2.4","text":"","code":"W2.4(fixed = c(NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/W2.4.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Four-parameter Weibull (type 2) model — W2.4","text":"fixed numeric vector length 4, specifying fixed parameters (use NA parameters estimated). names character vector length 4 giving names parameters (default c(\"b\", \"c\", \"d\", \"e\")). ... additional arguments passed weibull2, notably method (character string: \"1\" (default), \"2\", \"3\", \"4\") selects self-starter method obtaining starting values. See weibull2 details.","code":""},{"path":"https://hreinwald.github.io/drc/reference/W2.4.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Four-parameter Weibull (type 2) model — W2.4","text":"list class \"Weibull-2\" returned weibull2.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/W2.4.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Four-parameter Weibull (type 2) model — W2.4","text":"","code":"terbuthylazin.m1 <- drm(rgr ~ dose, data = terbuthylazin, fct = W2.4())"},{"path":"https://hreinwald.github.io/drc/reference/W2x.3.html","id":null,"dir":"Reference","previous_headings":"","what":"Three-parameter Weibull type 2 model with lag time — W2x.3","title":"Three-parameter Weibull type 2 model with lag time — W2x.3","text":"three-parameter Weibull type 2 model lag time, b fixed 1 c fixed 0. convenience wrapper around weibull2x.","code":""},{"path":"https://hreinwald.github.io/drc/reference/W2x.3.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Three-parameter Weibull type 2 model with lag time — W2x.3","text":"","code":"W2x.3(fixed = c(NA, NA, NA), names = c(\"d\", \"e\", \"t0\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/W2x.3.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Three-parameter Weibull type 2 model with lag time — W2x.3","text":"fixed numeric vector length 3. Specifies parameters fixed value. Use NA parameters estimated (default c(NA, NA, NA)). names character vector length 3 giving names parameters (default c(\"d\", \"e\", \"t0\")). ... additional arguments passed weibull2x.","code":""},{"path":"https://hreinwald.github.io/drc/reference/W2x.3.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Three-parameter Weibull type 2 model with lag time — W2x.3","text":"list class \"Weibull-2\" containing nonlinear function, self starter function, parameter names.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/W2x.3.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Three-parameter Weibull type 2 model with lag time — W2x.3","text":"","code":"spinach.m1 <- drm(SLOPE ~ DOSE, data = spinach, fct = W2x.3()) summary(spinach.m1) #> #> Model fitted: Weibull (type 2) with lower limit at 0 (3 parms) #> #> Parameter estimates: #> #> Estimate Std. Error t-value p-value #> d:(Intercept) 0.827617 0.067677 12.229 < 2.2e-16 *** #> e:(Intercept) 0.008972 NaN NaN NaN #> t0:(Intercept) -0.135527 NaN NaN NaN #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> Residual standard error: #> #> 0.6934874 (102 degrees of freedom)"},{"path":"https://hreinwald.github.io/drc/reference/W2x.4.html","id":null,"dir":"Reference","previous_headings":"","what":"Four-parameter Weibull type 2 model with lag time — W2x.4","title":"Four-parameter Weibull type 2 model with lag time — W2x.4","text":"four-parameter Weibull type 2 model lag time, b fixed 1. convenience wrapper around weibull2x.","code":""},{"path":"https://hreinwald.github.io/drc/reference/W2x.4.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Four-parameter Weibull type 2 model with lag time — W2x.4","text":"","code":"W2x.4(fixed = c(NA, NA, NA, NA), names = c(\"c\", \"d\", \"e\", \"t0\"), ...)"},{"path":"https://hreinwald.github.io/drc/reference/W2x.4.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Four-parameter Weibull type 2 model with lag time — W2x.4","text":"fixed numeric vector length 4. Specifies parameters fixed value. Use NA parameters estimated (default c(NA, NA, NA, NA)). names character vector length 4 giving names parameters (default c(\"c\", \"d\", \"e\", \"t0\")). ... additional arguments passed weibull2x.","code":""},{"path":"https://hreinwald.github.io/drc/reference/W2x.4.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Four-parameter Weibull type 2 model with lag time — W2x.4","text":"list class \"Weibull-2\" containing nonlinear function, self starter function, parameter names.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/W2x.4.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Four-parameter Weibull type 2 model with lag time — W2x.4","text":"","code":"ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W2x.4()) #> Warning: NaNs produced #> Warning: NaNs produced"},{"path":"https://hreinwald.github.io/drc/reference/weibull1.html","id":null,"dir":"Reference","previous_headings":"","what":"The four-parameter Weibull type 1 model — weibull1","title":"The four-parameter Weibull type 1 model — weibull1","text":"general Weibull type 1 model fitting dose-response data.","code":""},{"path":"https://hreinwald.github.io/drc/reference/weibull1.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"The four-parameter Weibull type 1 model — weibull1","text":"","code":"weibull1( fixed = c(NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\"), method = c(\"1\", \"2\", \"3\", \"4\"), ssfct = NULL, fctName, fctText )"},{"path":"https://hreinwald.github.io/drc/reference/weibull1.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"The four-parameter Weibull type 1 model — weibull1","text":"fixed numeric vector length 4. Specifies parameters fixed value. Use NA parameters fixed. names character vector length 4 giving names parameters b, c, d, e. method character string indicating self starter function use obtaining starting values (\"1\" (default), \"2\", \"3\", \"4\"). See Details. ssfct self starter function used. NULL (default), built-self starter used. fctName optional character string used internally function name. fctText optional character string used internally function text description.","code":""},{"path":"https://hreinwald.github.io/drc/reference/weibull1.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"The four-parameter Weibull type 1 model — weibull1","text":"list class Weibull-1 containing nonlinear function, self starter function, parameter names.","code":""},{"path":"https://hreinwald.github.io/drc/reference/weibull1.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"The four-parameter Weibull type 1 model — weibull1","text":"four-parameter Weibull type 1 model given expression $$f(x) = c + (d - c) \\exp(-\\exp(b(\\log(x) - \\log(e))))$$ model sometimes also called Gompertz model. method argument determines starting values parameters b e estimated (starting values c d always based range response values). Four methods available: \"1\" (default) Linear regression transformed data. Applies log-log transformation response log transformation dose, fits linear regression estimate starting values b e. \"2\" Anke's procedure. Estimates e finding dose response crosses midpoint c d, estimates b median back-calculated values. \"3\" Stepwise approach. Identifies mean response crosses midpoint c d uses corresponding dose starting value e. starting value b based sign slope point. \"4\" Normolle's procedure. Uses mean dose range initial estimate e, estimates b e using median-based back-calculations.","code":""},{"path":"https://hreinwald.github.io/drc/reference/weibull1.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"The four-parameter Weibull type 1 model — weibull1","text":"Seber, G. . F. Wild, C. J. (1989) Nonlinear Regression, New York: Wiley & Sons (pp. 338–339).","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/weibull1.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"The four-parameter Weibull type 1 model — weibull1","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/weibull1.ssf.html","id":null,"dir":"Reference","previous_headings":"","what":"Self-starter for Weibull type 1 model — weibull1.ssf","title":"Self-starter for Weibull type 1 model — weibull1.ssf","text":"Self-starter Weibull type 1 model","code":""},{"path":"https://hreinwald.github.io/drc/reference/weibull1.ssf.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Self-starter for Weibull type 1 model — weibull1.ssf","text":"","code":"weibull1.ssf(method = c(\"1\", \"2\", \"3\", \"4\"), fixed, useFixed = FALSE)"},{"path":"https://hreinwald.github.io/drc/reference/weibull2.html","id":null,"dir":"Reference","previous_headings":"","what":"The four-parameter Weibull (type 2) model — weibull2","title":"The four-parameter Weibull (type 2) model — weibull2","text":"Provides general framework four-parameter Weibull type 2 model given equation $$f(x) = c + (d - c)(1 - \\exp(-\\exp(b(\\log(x) - \\log(e)))))$$","code":""},{"path":"https://hreinwald.github.io/drc/reference/weibull2.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"The four-parameter Weibull (type 2) model — weibull2","text":"","code":"weibull2( fixed = c(NA, NA, NA, NA), names = c(\"b\", \"c\", \"d\", \"e\"), method = c(\"1\", \"2\", \"3\", \"4\"), ssfct = NULL, fctName, fctText )"},{"path":"https://hreinwald.github.io/drc/reference/weibull2.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"The four-parameter Weibull (type 2) model — weibull2","text":"fixed numeric vector length 4, specifying fixed parameters (use NA parameters estimated). names character vector length 4 giving names parameters (default c(\"b\", \"c\", \"d\", \"e\")). method character string indicating self starter method use obtaining starting values. One \"1\" (default), \"2\", \"3\", \"4\". See Details. ssfct self starter function. NULL (default), built-self starter used based method. fctName optional character string used internally function name. fctText optional character string used internally function description.","code":""},{"path":"https://hreinwald.github.io/drc/reference/weibull2.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"The four-parameter Weibull (type 2) model — weibull2","text":"list containing nonlinear function, self starter function, parameter names. list class \"Weibull-2\".","code":""},{"path":"https://hreinwald.github.io/drc/reference/weibull2.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"The four-parameter Weibull (type 2) model — weibull2","text":"method argument determines starting values parameters b e estimated (starting values c d always based range response values). Four methods available: \"1\" (default) Linear regression transformed data. Applies complementary log-log transformation response log transformation dose, fits linear regression estimate starting values b e. \"2\" Anke's procedure. Estimates e finding dose response crosses midpoint c d, estimates b median back-calculated values. \"3\" Stepwise approach. Identifies mean response crosses midpoint c d uses corresponding dose starting value e. starting value b based sign slope point. \"4\" Normolle's procedure. Uses mean dose range initial estimate e, estimates b e using median-based back-calculations.","code":""},{"path":"https://hreinwald.github.io/drc/reference/weibull2.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"The four-parameter Weibull (type 2) model — weibull2","text":"Seber, G. . F. Wild, C. J. (1989) Nonlinear Regression, New York: Wiley & Sons (pp. 338–339).","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/weibull2.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"The four-parameter Weibull (type 2) model — weibull2","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/weibull2.ssf.html","id":null,"dir":"Reference","previous_headings":"","what":"Self-starter for Weibull type 2 model — weibull2.ssf","title":"Self-starter for Weibull type 2 model — weibull2.ssf","text":"Self-starter Weibull type 2 model","code":""},{"path":"https://hreinwald.github.io/drc/reference/weibull2.ssf.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Self-starter for Weibull type 2 model — weibull2.ssf","text":"","code":"weibull2.ssf(method = c(\"1\", \"2\", \"3\", \"4\"), fixed, useFixed = FALSE)"},{"path":"https://hreinwald.github.io/drc/reference/weibull2x.html","id":null,"dir":"Reference","previous_headings":"","what":"Five-parameter Weibull type 2 model with lag time — weibull2x","title":"Five-parameter Weibull type 2 model with lag time — weibull2x","text":"five-parameter Weibull type 2 model extended lag time parameter t0. model given expression $$f(x) = c + (d - c)(1 - \\exp(-\\exp(b(\\log(x - t0) - \\log(e)))))$$ \\(x > t0\\) \\(f(x) = c\\) otherwise.","code":""},{"path":"https://hreinwald.github.io/drc/reference/weibull2x.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Five-parameter Weibull type 2 model with lag time — weibull2x","text":"","code":"weibull2x( fixed = rep(NA, 5), names = c(\"b\", \"c\", \"d\", \"e\", \"t0\"), method = c(\"1\", \"2\", \"3\", \"4\"), ssfct = NULL, fctName, fctText )"},{"path":"https://hreinwald.github.io/drc/reference/weibull2x.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Five-parameter Weibull type 2 model with lag time — weibull2x","text":"fixed numeric vector length 5. Specifies parameters fixed value. Use NA parameters estimated (default rep(NA, 5)). names character vector length 5 giving names parameters (default c(\"b\", \"c\", \"d\", \"e\", \"t0\")). method character string indicating self starter method use. One \"1\", \"2\", \"3\", \"4\". ssfct self starter function. NULL (default), built-self starter used. fctName optional character string specifying function name (used internally). fctText optional character string specifying function description (used internally).","code":""},{"path":"https://hreinwald.github.io/drc/reference/weibull2x.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Five-parameter Weibull type 2 model with lag time — weibull2x","text":"list class \"Weibull-2\" containing nonlinear function, self starter function, parameter names.","code":""},{"path":"https://hreinwald.github.io/drc/reference/weibull2x.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Five-parameter Weibull type 2 model with lag time — weibull2x","text":"lag time parameter t0 fixed.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/reference/weibull2x.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Five-parameter Weibull type 2 model with lag time — weibull2x","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/yieldLoss.html","id":null,"dir":"Reference","previous_headings":"","what":"Calculating yield loss parameters — yieldLoss","title":"Calculating yield loss parameters — yieldLoss","text":"Calculation parameters re-parameterization Michaelis-Menten model commonly used assess yield loss (rectangular hyperbola model).","code":""},{"path":"https://hreinwald.github.io/drc/reference/yieldLoss.html","id":"ref-usage","dir":"Reference","previous_headings":"","what":"Usage","title":"Calculating yield loss parameters — yieldLoss","text":"","code":"yieldLoss(object, interval = c(\"none\", \"as\"), level = 0.95, display = TRUE)"},{"path":"https://hreinwald.github.io/drc/reference/yieldLoss.html","id":"arguments","dir":"Reference","previous_headings":"","what":"Arguments","title":"Calculating yield loss parameters — yieldLoss","text":"object object class 'drc'. interval character string specifying type confidence intervals. default \"none\". Use \"\" asymptotically-based confidence intervals. level numeric. level confidence intervals. default 0.95. display logical. TRUE results displayed. Otherwise (useful simulations).","code":""},{"path":"https://hreinwald.github.io/drc/reference/yieldLoss.html","id":"value","dir":"Reference","previous_headings":"","what":"Value","title":"Calculating yield loss parameters — yieldLoss","text":"two parameters, matrix two columns, containing estimates corresponding estimated standard errors possibly lower upper confidence limits.","code":""},{"path":"https://hreinwald.github.io/drc/reference/yieldLoss.html","id":"details","dir":"Reference","previous_headings":"","what":"Details","title":"Calculating yield loss parameters — yieldLoss","text":"rectangular hyperbola model reparameterization Michaelis-Menten terms parameters \\(\\) \\(\\): $$Y_L = \\frac{Id}{1+Id/}$$ \\(d\\) denotes weed density \\(Y_L\\) resulting yield loss.","code":""},{"path":"https://hreinwald.github.io/drc/reference/yieldLoss.html","id":"note","dir":"Reference","previous_headings":"","what":"Note","title":"Calculating yield loss parameters — yieldLoss","text":"function use model fits based Michaelis-Menten models.","code":""},{"path":"https://hreinwald.github.io/drc/reference/yieldLoss.html","id":"references","dir":"Reference","previous_headings":"","what":"References","title":"Calculating yield loss parameters — yieldLoss","text":"Cousens, R. (1985). simple model relating yield loss weed density, Ann. Appl. Biol., 107, 239–252.","code":""},{"path":"https://hreinwald.github.io/drc/reference/yieldLoss.html","id":"author","dir":"Reference","previous_headings":"","what":"Author","title":"Calculating yield loss parameters — yieldLoss","text":"Christian Ritz","code":""},{"path":"https://hreinwald.github.io/drc/reference/yieldLoss.html","id":"ref-examples","dir":"Reference","previous_headings":"","what":"Examples","title":"Calculating yield loss parameters — yieldLoss","text":"","code":"## Fitting Michaelis-Menten model met.mm.m1 <- drm(gain~dose, product, data = methionine, fct = MM.3(), pmodels = list(~1, ~factor(product), ~factor(product))) #> Control measurements detected for level: control ## Yield loss parameters with standard errors yieldLoss(met.mm.m1) #> #> Estimated A parameters #> #> Estimate Std. Error #> DLM 1736.141 18.922 #> MHA 1868.517 43.930 #> #> #> Estimated I parameters #> #> Estimate Std. Error #> DLM 44578.0 11225.6 #> MHA 16827.3 3942.7 ## Also showing confidence intervals yieldLoss(met.mm.m1, \"as\") #> #> Estimated A parameters #> #> Estimate Std. Error Lower Upper #> DLM 1736.141 18.922 1683.606 1788.676 #> MHA 1868.517 43.930 1746.547 1990.487 #> #> #> Estimated I parameters #> #> Estimate Std. Error Lower Upper #> DLM 44578.0 11225.6 13410.7 75745.2 #> MHA 16827.3 3942.7 5880.7 27773.8"},{"path":[]},{"path":"https://hreinwald.github.io/drc/news/index.html","id":"new-features-3-3-2","dir":"Changelog","previous_headings":"","what":"New Features","title":"drc 3.3.2","text":"Enhanced plot.drc(): added errbar.lwd parameter independent control error bar line width type = \"bars\" plots. NULL (default), error bars inherit line width lwd argument fall back par(\"lwd\").","code":""},{"path":"https://hreinwald.github.io/drc/news/index.html","id":"bug-fixes-3-3-2","dir":"Changelog","previous_headings":"","what":"Bug Fixes","title":"drc 3.3.2","text":"Fixed update.drc() fall back stored data (object$origData) call$data resolved calling frame, enabling use update() inside lapply(), purrr::map(), functional programming contexts. Fixed vcDisc() validate inverse Hessian non-negative variances returning, preventing invalid variance-covariance matrices propagating downstream.","code":""},{"path":"https://hreinwald.github.io/drc/news/index.html","id":"changes-3-3-2","dir":"Changelog","previous_headings":"","what":"Changes","title":"drc 3.3.2","text":"Tightened default relTol drmc() 1e-7 1e-10 improved cross-platform reproducibility optimization results. Added comparative analysis vignette (comparative-analysis.Rmd) documenting differences hreinwald/drc original DoseResponse/drc package. Added “Articles” section pkgdown navigation _pkgdown.yml categorized guides technical reports. Fixed flaky maED tests depended platform-specific convergence behavior. Added test suites boxcox.drc (functional programming context), update.drc (data resolution fallback), vcDisc (singular Hessian handling).","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/news/index.html","id":"new-features-3-3-1","dir":"Changelog","previous_headings":"","what":"New Features","title":"drc 3.3.1","text":"Enhanced plot.drc(): error bars type = \"bars\" plots now match curve colors default. Added errbar.col parameter allow manual control error bar colors. Set errbar.col = \"black\" restore previous behavior black error bars.","code":""},{"path":"https://hreinwald.github.io/drc/news/index.html","id":"bug-fixes-3-3-1","dir":"Changelog","previous_headings":"","what":"Bug Fixes","title":"drc 3.3.1","text":"Fixed summary() crash binomial drm models Hessian singular (DoseResponse/drc#36): vcDisc now uses robust fallback chain (matching vcCont) instead bare solve() call. inversion fails, warning emitted standard errors reported NA. Fixed logistic() model ED calculation type=\"absolute\": edfct function now correctly handles absolute--relative conversion without applying incorrect p-swap EDhelper(). logistic model opposite b-sign convention log-logistic (b < 0 means increasing, decreasing), EDhelper’s p-swap b < 0 incorrectly swap ED values. fix uses inline absolute--relative conversion (p = 100·(d−respl)/(d−c)) absolute type p = respl directly relative type. Fixed model-level edfct derivatives absolute ED type braincousens(), fplogistic(), llogistic(), llogistic2(), lnormal(), weibull1(), weibull2(): type = \"absolute\", gradient functions previously set ∂ED/∂c ∂ED/∂d 0, incorrect absolute--relative conversion makes p function c d. chain rule requires non-zero partials. Now compute ∂ED/∂c ∂ED/∂d via central differences closure captures chain-rule contribution full ED computation path.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/news/index.html","id":"new-features-3-3-0-03","dir":"Changelog","previous_headings":"","what":"New Features","title":"drc 3.3.0.03","text":"Enhanced plot.drc(): error bars type = \"bars\" plots now match curve colors default. Added errbar.col parameter allow manual control error bar colors. Set errbar.col = \"black\" restore previous behavior black error bars.","code":""},{"path":"https://hreinwald.github.io/drc/news/index.html","id":"bug-fixes-3-3-0-03","dir":"Changelog","previous_headings":"","what":"Bug Fixes","title":"drc 3.3.0.03","text":"Fixed predict() “incorrect number dimensions” error models many fixed parameters (e.g., EXD.3(fixed = c(lower, upper, NA))): one parameter estimated, indexMat fitted model object vector rather matrix, causing predict.drc() fail computing standard errors confidence intervals. Ensured indexMat always coerced matrix column subsetting.","code":""},{"path":"https://hreinwald.github.io/drc/news/index.html","id":"changes-3-3-0-03","dir":"Changelog","previous_headings":"","what":"Changes","title":"drc 3.3.0.03","text":"Updated package version date DESCRIPTION website documentation 3.3.0.03. Updated logo path README.md point man/figures/logo.png consistency package structure. Added favicon manifest links HTML documentation files improved branding browser integration. Added package website (https://hreinwald.github.io/drc) primary URL DESCRIPTION file better discoverability. Added rss() function reference index _pkgdown.yml. Added logo image dose-response workflow vignette updated vignette date. Simplified labeling effective dose (ED) estimates workflow vignette outputs clarity, removing e:1: prefix. Updated model comparison output vignette include additional columns precise values.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/news/index.html","id":"new-features-3-3-0-02","dir":"Changelog","previous_headings":"","what":"New Features","title":"drc 3.3.0.02","text":"Added rss() function computing residual sum squares fitted drc model. Refactored Rsq() reuse rss() internally; functions now exported.","code":""},{"path":"https://hreinwald.github.io/drc/news/index.html","id":"bug-fixes-3-3-0-02","dir":"Changelog","previous_headings":"","what":"Bug Fixes","title":"drc 3.3.0.02","text":"Fixed ED() exponential decay models (EXD.2, EXD.3, AR.2, AR.3, W1.x, W2.x) two fixed parameters: one parameter estimated (1×1 variance-covariance matrix), function previously failed “incorrect number dimensions” errors. Enhanced ED.drc defensively coerce scalar/vector vcov inputs proper matrices always strip names gradients consistent matrix algebra. fix now allows retrieving ED values exponential decay models two fixed parameters, previously impossible. Fixed gradient handling ED() ensure model-specific derivative functions always return unnamed numeric vectors, preventing dimension errors delta-method standard error calculations. Fixed boundary detection bugs MAX(): used unname() named return values cedergreen models compared correctly unnamed lower/upper scalars, added tolerance boundary check since numerical optimizers return values near exactly boundaries. Fixed PR() dropping ... arguments single-curve models. Fixed 17 issues ucedergreen() function: missing +c term model formula, edfct signature mismatch drc framework, undefined xlogx function call deriv1, missing match.arg() validation method, vectorized | operators scalar () guards, missing useFixed flag computation, maxfct signature mismatch unsafe parameter indexing, broken self-starter ignoring alpha/method/useFixed, missing fctName/fctText parameters, deriv1 excluded return list, documentation issues. Fixed SE calculation absolute type ED(): model-specific edfct gradient functions treated asymptote parameters constants type=\"absolute\", missing chain-rule contribution absToRel conversion underestimating standard error. Now uses numerical central differences improved adaptive step size. Added internal helpers .centralDiffGradient(), .safeConfintBasic(), .computeSE() make SE computation robust: .computeSE() guards non-positive-definite variance-covariance matrix slices (returning NA instead erroring), .safeConfintBasic() validates residual degrees freedom calling confint.basic(), falling back z-distribution df.residual() returns invalid value. Fixed inverted otrace/silentVal logic drmOpt() otrace=TRUE incorrectly caused silent=TRUE try(optim()), suppressing error messages instead displaying . Fixed searchdrc() regex error convergence failure behavior. Fixed citation URL: reordered URLs DESCRIPTION citation('drc') returns GitHub repository URL instead r-project.org. Fixed ED() “incorrect number dimensions” error models estimated parameters (e.g., EXD.3 fixed c d): ensured indexMat always treated matrix column subsetting. Fixed ED() returning NaN warning LL.5 models ill-conditioned parameters: added validity check return Inf (indicating EC50 outside valid range) instead NaN exp(-tempVal/parmVec[5]) - 1 non-positive. Also fixed NaN handling check condition prevent “missing value TRUE/FALSE needed” errors backfit() functions. Fixed additional robustness issues ED() / ED.drc: loop now always iterates curves response levels, filtering clevel computation rather ; invMatList grown dynamically avoid NULL holes; curve label construction uses single structured object explicit match display fields; variance-covariance matrix slices always use drop = FALSE remain matrices. Fixed mselect() missing two closing braces caused parse error function sourced directly. Fixed ED.lin.R bugs: removed duplicate -block (dead code evaluated condition twice), removed stray debug print() statement, added missing parameterNames = c(\"b0\", \"b1\", \"b2\") argument deltaMethod() call quadratic models (omission caused incorrect parameter mapping wrong confidence intervals). Fixed CRS.4b() display text: fctText incorrectly showed \"alpha=\" instead \"alpha=0.5\". Fixed gammadr() first-derivative (deriv1) calculation: gradient respect dose parameter incorrectly used parmMat[, 1] (rate parameter) dose required, producing wrong gradient values. Fixed maED() model-averaging: models whose ED estimates non-finite (Inf NaN) now detected excluded weighted average (warning naming model offending values); models returned try-error fitting also excluded. candidate models excluded, function returns NA estimates instead 0 NaN. Added warning noEffect() degrees freedom difference ≤ 0, clarifying likelihood ratio test may meaningful dose-response model additional parameters compared null model (e.g., parameters fixed).","code":""},{"path":"https://hreinwald.github.io/drc/news/index.html","id":"changes-3-3-0-02","dir":"Changelog","previous_headings":"","what":"Changes","title":"drc 3.3.0.02","text":"Added NEWS.md version control log. Reformatted legacy news file properly formatted NEWS.md categorized sections. Improved documentation Weibull starting value method parameter across weibull1(), weibull2(), wrapper functions (W1.2, W1.3, W1.4, W2.2, W2.3, W2.4, AR.2, AR.3, EXD.2, EXD.3). Enhanced roxygen2 documentation ED ED.drc functions improved parameter descriptions examples. Added comprehensive test suites anova.drclist,summary.drc, print.summary.drc, noEffect, searchdrc, backfit, getInitial, drmEMeventtime, repChar, rdrm, gompertzd, MAX(), PR() functions. Added comprehensive test suites llogistic/LL.x models, weibull1/W1.x/EXD.x models, logistic.ssf, gammadr, EDcomp, mselect, drmOpt, modelFunction, modelFit, anova.drclist, rss, ED.lin. Large-scale dead code removal across 70+ R source files: removed commented-function implementations, stray print() debug statements, old code paths, (FALSE){...} blocks. logic changes; roxygen2 documentation meaningful explanatory comments preserved. Removed dead code iband.R associated references. Removed unused inst/citation file, superseded CITATION.cff repository root. Deleted build_pkgdown.R build script. Added PLoS ONE 2015 article CRC Press 2019 book references CITATION.cff. Updated installation instructions README documentation. Added magic Suggests DESCRIPTION test dependency.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/news/index.html","id":"new-features-3-3-0-01","dir":"Changelog","previous_headings":"","what":"New Features","title":"drc 3.3.0.01","text":"Created comprehensive vignettes: dose-response-workflow.Rmd providing complete tutorial dose-response analysis, nec-models.Rmd documenting Effect Concentration modeling NEC.2/NEC.3/NEC.4 function variants. Set pkgdown website infrastructure: added _pkgdown.yml Bootstrap 5 configuration, created build_pkgdown.R script build automation, documented pkgdown build process README, generated pkgdown documentation site. Added computationally robust (stable) wrapper functions new ED_robust.R module: ED_robust() calculating ED values proper error handling returns NA instead failing ED value estimable, maED_robust() model-averaged ED estimation graceful error handling, get_ed_interval() recommending appropriate confidence interval methods based model type. Added comprehensive test suite covering ED calculations, predictions, plotting, residuals, model selection, utility functions. Added drm_name() helper function ED_robust.R. Enhanced package startup message citations developer credits. Added drm_legacy() internal reference function preserving original drm() implementation. Added testthat infrastructure tests verifying drm() output matches drm_legacy() output across continuous, binomial, Poisson, negative binomial data types. Added comprehensive anova tests.","code":""},{"path":"https://hreinwald.github.io/drc/news/index.html","id":"bug-fixes-3-3-0-01","dir":"Changelog","previous_headings":"","what":"Bug Fixes","title":"drc 3.3.0.01","text":"Fixed vignette build removing vignettes .Rbuildignore correcting incorrect mselect() usage examples. Fixed Rd comment warning escaping %*% operator documentation. Fixed devtools::check() errors warnings: added roxygen2 @keywords lifecycle deprecation notices deprecated CRS functions, expanded dataset documentation files examples, added missing dataset aliases, fixed Weibull model documentation. Fixed division--zero Rsq() absToRel(). Removed dead scaleEst() stub function. Fixed inherits() bug mselect.R. Added edge case handling modelFit.R. Added input validation comped() compParm(). Fixed unsafe global state modification via options(warn), incorrect compParm od/pool handling, residuals division zero. Fixed NaN warning summary.drc robust estimation methods (metric trimming, Winsorizing, Tukey’s biweight). Improved predict.drc vcov.drc resolve 23 test failures. Fixed mselect() always compute Lack fit p-values models, nested=TRUE. Fixed bug anova.drclist negative non-finite F statistics produced NaN p-values; negative F statistics now return p-value 1 non-finite F statistics return NA. Fixed duplicate aliases unstated dependencies examples. Fixed package dependency warnings: added data.table dplyr Imports, updated NAMESPACE required imports. Fixed S3 method consistency issues changed confint.basic roxygen tag @exportS3Method @export. Fixed escaped LaTeX special characters roxygen2 documentation Rd files. Fixed escaped percent signs roxygen docs causing Rd parse warnings.","code":""},{"path":"https://hreinwald.github.io/drc/news/index.html","id":"changes-3-3-0-01","dir":"Changelog","previous_headings":"","what":"Changes","title":"drc 3.3.0.01","text":"Added vignette access information README. Completed comprehensive roxygen2 documentation audit: added missing @param tags, removed dontrun/donttest wrappers enable automated example testing, fixed broken examples across documentation files. Enhanced dataset documentation: improved descriptions fixed typos dataset .Rd files, added examples sections dataset .Rd files missing . Improved confint.drc robustness: added stop() fallback switch() confint.basic() handle unknown intType values gracefully instead returning silent NULL. Removed @export confint.basic() internal helpers part public API. Enhanced roxygen2 documentation CRS.5, convenience functions, ED_robust improved argument descriptions. Updated DESCRIPTION: added Hannes Reinwald maintainer co-author, updated package version 3.3.0.01. Removed external drcData package dependency; example datasets now bundled directly package data/ directory. Added .Rd documentation files bundled datasets. Renamed internal variables clarity: ndRows nRows predict.drc, posIdx validVar summary.drc. Added test coverage documentation. Renamed 33 R source files lowercase .r uppercase .R extensions consistency. Updated .Rd documentation files reference new file names. Added GNU General Public License version 2 file updated license version GPL-2 GPL-2.0 DESCRIPTION. Added Hannes Reinwald author DESCRIPTION file. Updated README revised installation instructions bug report link. Migrated package documentation roxygen2-generated Rd files. Regenerated NAMESPACE via roxygen2. Added @exportS3Method tags S3 methods confint.drc.R mrdrm.r. Updated package version format 3.3-0 3.3.0. Lowered minimum R version requirement 4.0.0.","code":""},{"path":"https://hreinwald.github.io/drc/news/index.html","id":"breaking-changes-3-3-0-01","dir":"Changelog","previous_headings":"","what":"Breaking Changes","title":"drc 3.3.0.01","text":"Removed deprecated developmental cedergreen2 function.","code":""},{"path":[]},{"path":"https://hreinwald.github.io/drc/news/index.html","id":"new-features-3-3-0","dir":"Changelog","previous_headings":"","what":"New Features","title":"drc 3.3.0","text":"Added new CRS.5 wrapper function CRS.6 six-parameter model alpha exponent estimated rather fixed.","code":""},{"path":"https://hreinwald.github.io/drc/news/index.html","id":"bug-fixes-3-3-0","dir":"Changelog","previous_headings":"","what":"Bug Fixes","title":"drc 3.3.0","text":"Fixed bug stop() call using separate curves control measurements inside (!noMessage) block, meaning silently skipped messages suppressed. Fixed bug noEffect.R Poisson null model incorrectly referenced resp instead using response vector fitted object.","code":""},{"path":"https://hreinwald.github.io/drc/news/index.html","id":"changes-3-3-0","dir":"Changelog","previous_headings":"","what":"Changes","title":"drc 3.3.0","text":"Refactored Cedergreen-Ritz-Streibig hormesis model: extracted edfct maxfct standalone helper functions (cedergreen_edfct, cedergreen_maxfct), refactored self-starter function, improved documentation. Cleaned drm() function removing approximately 900 lines commented-dead code, debug print statements, old experimental implementations. Removed unused variable isfi redundant variable lenData (identical numObs). Removed dead loop pmodelsList2 never execute. Added roxygen2 documentation headers R source files across package. Fixed typos source code manual pages: ‘insted’ ‘instead’ gaussian.r lgaussian.R, duplicate parameter name ‘e1’ ‘e2’ ursa.r, ‘contain’ ‘contents’ EDcomp.R, ‘mising’ ‘missing’ ‘reponses’ ‘responses’ drm.Rd, ‘reponse’ ‘response’ CRS.5a.Rd. Updated DESCRIPTION file: added Encoding field (UTF-8), fixed Authors@R use proper person() format, removed deprecated Maintainer LazyLoad fields, added missing Imports (graphics, utils), updated URLs HTTP HTTPS. Comprehensive repository cleanup code quality improvements. Removed obsolete configuration files (.travis.yml, drc.Rproj, _pkgdown.yml, README.Rmd) redundant reference files (_gitignore, _Rbuildignore). Removed /tests directory containing outdated development artifacts testing value. Updated .gitignore .Rbuildignore standard R/RStudio settings. Rewrote README.md comprehensive documentation including quick-start examples, available models, key functions, supported data types. Removed debug print() statements drmEMstandard.R findbe.r. Removed dead code block (commented-experimental code wrapped (FALSE)) drmEMstandard.R llogistic.ssf.R. Replaced unsafe eval(parse(text=...)) calls match.fun() .call() rdrm.r. Improved options() handling searchdrc.R saving restoring original warn setting using .exit(add=TRUE).","code":""},{"path":"https://hreinwald.github.io/drc/news/index.html","id":"deprecated-3-3-0","dir":"Changelog","previous_headings":"","what":"Deprecated","title":"drc 3.3.0","text":"Deprecated old CRS function names (CRS.4a, CRS.4b, CRS.4c, CRS.5a, CRS.5b, CRS.5c) lifecycle notices favor new wrappers.","code":""}] diff --git a/docs/site.webmanifest b/docs/site.webmanifest new file mode 100644 index 00000000..4ebda26b --- /dev/null +++ b/docs/site.webmanifest @@ -0,0 +1,21 @@ +{ + "name": "", + "short_name": "", + "icons": [ + { + "src": "/web-app-manifest-192x192.png", + "sizes": "192x192", + "type": "image/png", + "purpose": "maskable" + }, + { + "src": "/web-app-manifest-512x512.png", + "sizes": "512x512", + "type": "image/png", + "purpose": "maskable" + } + ], + "theme_color": "#ffffff", + "background_color": "#ffffff", + "display": "standalone" +} \ No newline at end of file diff --git a/docs/sitemap.xml b/docs/sitemap.xml new file mode 100644 index 00000000..6bd30b5d --- /dev/null +++ b/docs/sitemap.xml @@ -0,0 +1,278 @@ + +https://hreinwald.github.io/drc/404.html +https://hreinwald.github.io/drc/articles/dose-response-workflow.html +https://hreinwald.github.io/drc/articles/index.html +https://hreinwald.github.io/drc/articles/nec-models.html +https://hreinwald.github.io/drc/articles/package-version-comparative-analysis.html +https://hreinwald.github.io/drc/authors.html +https://hreinwald.github.io/drc/index.html +https://hreinwald.github.io/drc/LICENSE-text.html +https://hreinwald.github.io/drc/news/index.html +https://hreinwald.github.io/drc/reference/absToRel.html +https://hreinwald.github.io/drc/reference/acidiq.html +https://hreinwald.github.io/drc/reference/aconiazide.html +https://hreinwald.github.io/drc/reference/acute.inh.html +https://hreinwald.github.io/drc/reference/algae.html +https://hreinwald.github.io/drc/reference/anova.drc.html +https://hreinwald.github.io/drc/reference/anova.drclist.html +https://hreinwald.github.io/drc/reference/AR.2.html +https://hreinwald.github.io/drc/reference/AR.3.html +https://hreinwald.github.io/drc/reference/arandaordaz.html +https://hreinwald.github.io/drc/reference/arbovirus.html +https://hreinwald.github.io/drc/reference/auxins.html +https://hreinwald.github.io/drc/reference/backfit.html +https://hreinwald.github.io/drc/reference/barley.html +https://hreinwald.github.io/drc/reference/baro5.html +https://hreinwald.github.io/drc/reference/BC.4.html +https://hreinwald.github.io/drc/reference/BC.5.html +https://hreinwald.github.io/drc/reference/bcl3.html +https://hreinwald.github.io/drc/reference/bcl4.html +https://hreinwald.github.io/drc/reference/bees.html +https://hreinwald.github.io/drc/reference/blackgrass.html +https://hreinwald.github.io/drc/reference/boxcox.drc.html +https://hreinwald.github.io/drc/reference/braincousens.html +https://hreinwald.github.io/drc/reference/braincousens.ssf.html +https://hreinwald.github.io/drc/reference/bread.drc.html +https://hreinwald.github.io/drc/reference/broccoli.html +https://hreinwald.github.io/drc/reference/C.dubia.html +https://hreinwald.github.io/drc/reference/CadmiumDaphnia.html +https://hreinwald.github.io/drc/reference/carbendazim.html +https://hreinwald.github.io/drc/reference/cedergreen.html +https://hreinwald.github.io/drc/reference/cedergreen.ssf.html +https://hreinwald.github.io/drc/reference/cedergreen_edfct.html +https://hreinwald.github.io/drc/reference/cedergreen_maxfct.html +https://hreinwald.github.io/drc/reference/chickweed.html +https://hreinwald.github.io/drc/reference/chlorac.html +https://hreinwald.github.io/drc/reference/chlordan.html +https://hreinwald.github.io/drc/reference/CIcomp.html +https://hreinwald.github.io/drc/reference/CIcompX.html +https://hreinwald.github.io/drc/reference/coef.drc.html +https://hreinwald.github.io/drc/reference/commatFct.html +https://hreinwald.github.io/drc/reference/comped.html +https://hreinwald.github.io/drc/reference/compParm.html +https://hreinwald.github.io/drc/reference/confint.basic.html +https://hreinwald.github.io/drc/reference/confint.drc.html +https://hreinwald.github.io/drc/reference/cooks.distance.drc.html +https://hreinwald.github.io/drc/reference/createsifct.html +https://hreinwald.github.io/drc/reference/CRS.4a.html +https://hreinwald.github.io/drc/reference/CRS.4b.html +https://hreinwald.github.io/drc/reference/CRS.4c.html +https://hreinwald.github.io/drc/reference/CRS.5.html +https://hreinwald.github.io/drc/reference/CRS.5a.html +https://hreinwald.github.io/drc/reference/CRS.5b.html +https://hreinwald.github.io/drc/reference/CRS.5c.html +https://hreinwald.github.io/drc/reference/CRS.6.html +https://hreinwald.github.io/drc/reference/ctb.html +https://hreinwald.github.io/drc/reference/Cyp17.html +https://hreinwald.github.io/drc/reference/Daphnia.html +https://hreinwald.github.io/drc/reference/daphnids.html +https://hreinwald.github.io/drc/reference/decontaminants.html +https://hreinwald.github.io/drc/reference/deguelin.html +https://hreinwald.github.io/drc/reference/divAtInf.html +https://hreinwald.github.io/drc/reference/dot-onAttach.html +https://hreinwald.github.io/drc/reference/drc-package.html +https://hreinwald.github.io/drc/reference/drm.html +https://hreinwald.github.io/drc/reference/drmc.html +https://hreinwald.github.io/drc/reference/drmConvertParm.html +https://hreinwald.github.io/drc/reference/drmEMbinomial.html +https://hreinwald.github.io/drc/reference/drmEMls.html +https://hreinwald.github.io/drc/reference/drmLOFbinomial.html +https://hreinwald.github.io/drc/reference/drmLOFeventtime.html +https://hreinwald.github.io/drc/reference/drmLOFls.html +https://hreinwald.github.io/drc/reference/drmLOFnegbin.html +https://hreinwald.github.io/drc/reference/drmLOFPoisson.html +https://hreinwald.github.io/drc/reference/drmLOFssd.html +https://hreinwald.github.io/drc/reference/drmLOFstandard.html +https://hreinwald.github.io/drc/reference/drmOpt.html +https://hreinwald.github.io/drc/reference/drmParNames.html +https://hreinwald.github.io/drc/reference/drmPNsplit.html +https://hreinwald.github.io/drc/reference/drmRobust.html +https://hreinwald.github.io/drc/reference/drm_legacy.html +https://hreinwald.github.io/drc/reference/earthworms.html +https://hreinwald.github.io/drc/reference/echovirus.html +https://hreinwald.github.io/drc/reference/ED.drc.html +https://hreinwald.github.io/drc/reference/ED.html +https://hreinwald.github.io/drc/reference/ED.lin.html +https://hreinwald.github.io/drc/reference/EDcomp.html +https://hreinwald.github.io/drc/reference/EDhelper.html +https://hreinwald.github.io/drc/reference/EDinvreg.html +https://hreinwald.github.io/drc/reference/ED_robust.html +https://hreinwald.github.io/drc/reference/Eryngium.sparganophyllum.html +https://hreinwald.github.io/drc/reference/estfun.drc.html +https://hreinwald.github.io/drc/reference/etmotc.html +https://hreinwald.github.io/drc/reference/EXD.2.html +https://hreinwald.github.io/drc/reference/EXD.3.html +https://hreinwald.github.io/drc/reference/fieller.html +https://hreinwald.github.io/drc/reference/findbe1.html +https://hreinwald.github.io/drc/reference/findcd.html +https://hreinwald.github.io/drc/reference/finney71.html +https://hreinwald.github.io/drc/reference/fitted.drc.html +https://hreinwald.github.io/drc/reference/fluoranthene.html +https://hreinwald.github.io/drc/reference/FPL.4.html +https://hreinwald.github.io/drc/reference/fplogistic.html +https://hreinwald.github.io/drc/reference/G.2.html +https://hreinwald.github.io/drc/reference/G.3.html +https://hreinwald.github.io/drc/reference/G.3u.html +https://hreinwald.github.io/drc/reference/G.4.html +https://hreinwald.github.io/drc/reference/G.aparine.html +https://hreinwald.github.io/drc/reference/gammadr.html +https://hreinwald.github.io/drc/reference/gaussian.html +https://hreinwald.github.io/drc/reference/gaussian.ssf.html +https://hreinwald.github.io/drc/reference/germination.html +https://hreinwald.github.io/drc/reference/getInitial.html +https://hreinwald.github.io/drc/reference/getMeanFunctions.html +https://hreinwald.github.io/drc/reference/get_ed_interval.html +https://hreinwald.github.io/drc/reference/GiantKelp.html +https://hreinwald.github.io/drc/reference/glymet.html +https://hreinwald.github.io/drc/reference/gompertz.html +https://hreinwald.github.io/drc/reference/gompertz.ssf.html +https://hreinwald.github.io/drc/reference/gompertzd.html +https://hreinwald.github.io/drc/reference/guthion.html +https://hreinwald.github.io/drc/reference/H.virescens.html +https://hreinwald.github.io/drc/reference/hatvalues.drc.html +https://hreinwald.github.io/drc/reference/heartrate.html +https://hreinwald.github.io/drc/reference/hewlett.html +https://hreinwald.github.io/drc/reference/idrm.html +https://hreinwald.github.io/drc/reference/index.html +https://hreinwald.github.io/drc/reference/isobole.html +https://hreinwald.github.io/drc/reference/L.3.html +https://hreinwald.github.io/drc/reference/L.4.html +https://hreinwald.github.io/drc/reference/L.5.html +https://hreinwald.github.io/drc/reference/leaflength.html +https://hreinwald.github.io/drc/reference/leaveOneOut.html +https://hreinwald.github.io/drc/reference/lemna.html +https://hreinwald.github.io/drc/reference/lepidium.html +https://hreinwald.github.io/drc/reference/lettuce.html +https://hreinwald.github.io/drc/reference/lgaussian.html +https://hreinwald.github.io/drc/reference/lin.test.html +https://hreinwald.github.io/drc/reference/liver.tumor.html +https://hreinwald.github.io/drc/reference/LL.2.html +https://hreinwald.github.io/drc/reference/LL.3.html +https://hreinwald.github.io/drc/reference/LL.3u.html +https://hreinwald.github.io/drc/reference/LL.4.html +https://hreinwald.github.io/drc/reference/LL.5.html +https://hreinwald.github.io/drc/reference/LL2.2.html +https://hreinwald.github.io/drc/reference/LL2.3.html +https://hreinwald.github.io/drc/reference/LL2.3u.html +https://hreinwald.github.io/drc/reference/LL2.4.html +https://hreinwald.github.io/drc/reference/LL2.5.html +https://hreinwald.github.io/drc/reference/llogistic.html +https://hreinwald.github.io/drc/reference/llogistic.ssf.html +https://hreinwald.github.io/drc/reference/llogistic2.html +https://hreinwald.github.io/drc/reference/LN.2.html +https://hreinwald.github.io/drc/reference/LN.3.html +https://hreinwald.github.io/drc/reference/LN.3u.html +https://hreinwald.github.io/drc/reference/LN.4.html +https://hreinwald.github.io/drc/reference/lnormal.html +https://hreinwald.github.io/drc/reference/lnormal.ssf.html +https://hreinwald.github.io/drc/reference/logistic.html +https://hreinwald.github.io/drc/reference/logistic.ssf.html +https://hreinwald.github.io/drc/reference/logLik.drc.html +https://hreinwald.github.io/drc/reference/lowFixed.html +https://hreinwald.github.io/drc/reference/lowupFixed.html +https://hreinwald.github.io/drc/reference/M.bahia.html +https://hreinwald.github.io/drc/reference/maED.html +https://hreinwald.github.io/drc/reference/maED_robust.html +https://hreinwald.github.io/drc/reference/MAX.html +https://hreinwald.github.io/drc/reference/mdra.html +https://hreinwald.github.io/drc/reference/mecter.html +https://hreinwald.github.io/drc/reference/metals.html +https://hreinwald.github.io/drc/reference/methionine.html +https://hreinwald.github.io/drc/reference/mixture.html +https://hreinwald.github.io/drc/reference/ml3a.html +https://hreinwald.github.io/drc/reference/ml3b.html +https://hreinwald.github.io/drc/reference/ml3c.html +https://hreinwald.github.io/drc/reference/ml4a.html +https://hreinwald.github.io/drc/reference/ml4b.html +https://hreinwald.github.io/drc/reference/ml4c.html +https://hreinwald.github.io/drc/reference/MM.2.html +https://hreinwald.github.io/drc/reference/MM.3.html +https://hreinwald.github.io/drc/reference/modelFit.html +https://hreinwald.github.io/drc/reference/modelFunction.html +https://hreinwald.github.io/drc/reference/mr.test.html +https://hreinwald.github.io/drc/reference/mselect.html +https://hreinwald.github.io/drc/reference/multi2.html +https://hreinwald.github.io/drc/reference/nasturtium.html +https://hreinwald.github.io/drc/reference/NEC.2.html +https://hreinwald.github.io/drc/reference/NEC.3.html +https://hreinwald.github.io/drc/reference/NEC.4.html +https://hreinwald.github.io/drc/reference/NEC.html +https://hreinwald.github.io/drc/reference/neill.test.html +https://hreinwald.github.io/drc/reference/nfa.html +https://hreinwald.github.io/drc/reference/nicotine.html +https://hreinwald.github.io/drc/reference/noEffect.html +https://hreinwald.github.io/drc/reference/O.mykiss.html +https://hreinwald.github.io/drc/reference/P.promelas.html +https://hreinwald.github.io/drc/reference/pickParm.html +https://hreinwald.github.io/drc/reference/plot.drc.html +https://hreinwald.github.io/drc/reference/plotFACI.html +https://hreinwald.github.io/drc/reference/PR.html +https://hreinwald.github.io/drc/reference/predict.drc.html +https://hreinwald.github.io/drc/reference/print.drc.html +https://hreinwald.github.io/drc/reference/print.summary.drc.html +https://hreinwald.github.io/drc/reference/rdrm.html +https://hreinwald.github.io/drc/reference/red.fescue.html +https://hreinwald.github.io/drc/reference/relpot.html +https://hreinwald.github.io/drc/reference/repChar.html +https://hreinwald.github.io/drc/reference/residuals.drc.html +https://hreinwald.github.io/drc/reference/resPrint.html +https://hreinwald.github.io/drc/reference/RScompetition.html +https://hreinwald.github.io/drc/reference/rse.html +https://hreinwald.github.io/drc/reference/Rsq.html +https://hreinwald.github.io/drc/reference/rss.html +https://hreinwald.github.io/drc/reference/ryegrass.html +https://hreinwald.github.io/drc/reference/ryegrass2.html +https://hreinwald.github.io/drc/reference/S.alba.comp.html +https://hreinwald.github.io/drc/reference/S.alba.html +https://hreinwald.github.io/drc/reference/S.capricornutum.html +https://hreinwald.github.io/drc/reference/searchdrc.html +https://hreinwald.github.io/drc/reference/secalonic.html +https://hreinwald.github.io/drc/reference/selenium.html +https://hreinwald.github.io/drc/reference/siInner.html +https://hreinwald.github.io/drc/reference/simDR.html +https://hreinwald.github.io/drc/reference/simFct.html +https://hreinwald.github.io/drc/reference/spinach.html +https://hreinwald.github.io/drc/reference/splitInd.html +https://hreinwald.github.io/drc/reference/summary.drc.html +https://hreinwald.github.io/drc/reference/TCDD.html +https://hreinwald.github.io/drc/reference/terbuthylazin.html +https://hreinwald.github.io/drc/reference/threephase.html +https://hreinwald.github.io/drc/reference/twophase.html +https://hreinwald.github.io/drc/reference/ucedergreen.html +https://hreinwald.github.io/drc/reference/UCRS.4a.html +https://hreinwald.github.io/drc/reference/UCRS.4b.html +https://hreinwald.github.io/drc/reference/UCRS.4c.html +https://hreinwald.github.io/drc/reference/UCRS.5a.html +https://hreinwald.github.io/drc/reference/UCRS.5b.html +https://hreinwald.github.io/drc/reference/UCRS.5c.html +https://hreinwald.github.io/drc/reference/uml3a.html +https://hreinwald.github.io/drc/reference/uml3b.html +https://hreinwald.github.io/drc/reference/uml3c.html +https://hreinwald.github.io/drc/reference/uml4a.html +https://hreinwald.github.io/drc/reference/uml4b.html +https://hreinwald.github.io/drc/reference/uml4c.html +https://hreinwald.github.io/drc/reference/update.drc.html +https://hreinwald.github.io/drc/reference/upFixed.html +https://hreinwald.github.io/drc/reference/ursa.html +https://hreinwald.github.io/drc/reference/vcov.drc.html +https://hreinwald.github.io/drc/reference/vec2mat.html +https://hreinwald.github.io/drc/reference/vinclozolin.html +https://hreinwald.github.io/drc/reference/voelund.html +https://hreinwald.github.io/drc/reference/W1.2.html +https://hreinwald.github.io/drc/reference/W1.3.html +https://hreinwald.github.io/drc/reference/W1.3u.html +https://hreinwald.github.io/drc/reference/W1.4.html +https://hreinwald.github.io/drc/reference/W2.2.html +https://hreinwald.github.io/drc/reference/W2.3.html +https://hreinwald.github.io/drc/reference/W2.3u.html +https://hreinwald.github.io/drc/reference/W2.4.html +https://hreinwald.github.io/drc/reference/W2x.3.html +https://hreinwald.github.io/drc/reference/W2x.4.html +https://hreinwald.github.io/drc/reference/weibull1.html +https://hreinwald.github.io/drc/reference/weibull1.ssf.html +https://hreinwald.github.io/drc/reference/weibull2.html +https://hreinwald.github.io/drc/reference/weibull2.ssf.html +https://hreinwald.github.io/drc/reference/weibull2x.html +https://hreinwald.github.io/drc/reference/yieldLoss.html + + diff --git a/docs/web-app-manifest-192x192.png b/docs/web-app-manifest-192x192.png new file mode 100644 index 00000000..7cd9dc32 Binary files /dev/null and b/docs/web-app-manifest-192x192.png differ diff --git a/docs/web-app-manifest-512x512.png b/docs/web-app-manifest-512x512.png new file mode 100644 index 00000000..5699716e Binary files /dev/null and b/docs/web-app-manifest-512x512.png differ diff --git a/drc.Rproj b/drc.Rproj deleted file mode 100644 index 21a4da08..00000000 --- a/drc.Rproj +++ /dev/null @@ -1,17 +0,0 @@ -Version: 1.0 - -RestoreWorkspace: Default -SaveWorkspace: Default -AlwaysSaveHistory: Default - -EnableCodeIndexing: Yes -UseSpacesForTab: Yes -NumSpacesForTab: 2 -Encoding: UTF-8 - -RnwWeave: Sweave -LaTeX: pdfLaTeX - -BuildType: Package -PackageUseDevtools: Yes -PackageInstallArgs: --no-multiarch --with-keep.source diff --git a/inst/citation b/inst/citation deleted file mode 100644 index a93bd47d..00000000 --- a/inst/citation +++ /dev/null @@ -1,13 +0,0 @@ -citHeader("To cite the package 'drc' in publications:") - -citEntry(entry = "Book", - title = "Dose-Response Analysis Using R", - author = personList(as.person("C. Ritz"), as.person("S. M. Jensen"), as.person("D. Gerhard"), as.person("J. C. Streibig")), - publisher = "CRC Press", - year = 2019, - - textVersion = - paste("Ritz, C., Jensen, S. M., Gerhard, D., Streibig, J. C. (2019)", - "Dose-Response Analysis Using R", - "CRC Press") -) diff --git a/man/AR.2.Rd b/man/AR.2.Rd new file mode 100644 index 00000000..605c50a1 --- /dev/null +++ b/man/AR.2.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/weibull2.R +\name{AR.2} +\alias{AR.2} +\title{Two-parameter asymptotic regression model} +\usage{ +AR.2(fixed = c(NA, NA), names = c("d", "e"), ...) +} +\arguments{ +\item{fixed}{numeric vector of length 2, specifying fixed parameters (use \code{NA} for +parameters that should be estimated).} + +\item{names}{character vector of length 2 giving the names of the parameters +(default \code{c("d", "e")}).} + +\item{...}{additional arguments passed to \code{\link{weibull2}}, most +notably \code{method} (a character string: \code{"1"} (default), +\code{"2"}, \code{"3"}, or \code{"4"}) which selects the self-starter +method for obtaining starting values. See \code{\link{weibull2}} for +details.} +} +\value{ +A list of class \code{"Weibull-2"} as returned by \code{\link{weibull2}}. +} +\description{ +A two-parameter asymptotic regression model where \code{b} is fixed at 1 and +the lower limit is fixed at 0. The model is given by the equation +\deqn{f(x) = d \cdot (1 - \exp(-x / e))} +} +\examples{ +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = AR.2()) + +} +\seealso{ +\code{\link{AR.3}}, \code{\link{weibull2}}, \code{\link{EXD.2}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/AR.3.Rd b/man/AR.3.Rd new file mode 100644 index 00000000..9d251fa5 --- /dev/null +++ b/man/AR.3.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/weibull2.R +\name{AR.3} +\alias{AR.3} +\title{Three-parameter shifted asymptotic regression model} +\usage{ +AR.3(fixed = c(NA, NA, NA), names = c("c", "d", "e"), ...) +} +\arguments{ +\item{fixed}{numeric vector of length 3, specifying fixed parameters (use \code{NA} for +parameters that should be estimated).} + +\item{names}{character vector of length 3 giving the names of the parameters +(default \code{c("c", "d", "e")}).} + +\item{...}{additional arguments passed to \code{\link{weibull2}}, most +notably \code{method} (a character string: \code{"1"} (default), +\code{"2"}, \code{"3"}, or \code{"4"}) which selects the self-starter +method for obtaining starting values. See \code{\link{weibull2}} for +details.} +} +\value{ +A list of class \code{"Weibull-2"} as returned by \code{\link{weibull2}}. +} +\description{ +A three-parameter asymptotic regression model where \code{b} is fixed at 1. +The model is given by the equation +\deqn{f(x) = c + (d - c)(1 - \exp(-x / e))} +} +\examples{ +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = AR.3()) + +} +\seealso{ +\code{\link{AR.2}}, \code{\link{weibull2}}, \code{\link{EXD.3}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/AR.Rd b/man/AR.Rd deleted file mode 100644 index 31f0686c..00000000 --- a/man/AR.Rd +++ /dev/null @@ -1,78 +0,0 @@ -\name{AR} - -\alias{AR.2} -\alias{AR.3} - -\title{Asymptotic regression model} - -\description{ - Providing the mean function and the corresponding self starter function for the asymptotic regression model. -} - -\usage{ - AR.2(fixed = c(NA, NA), names = c("d", "e"), ...) - - AR.3(fixed = c(NA, NA, NA), names = c("c", "d", "e"), ...) -} - -\arguments{ - \item{fixed}{numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.} - \item{names}{vector of character strings giving the names of the parameters (should not contain ":").} - \item{...}{additional arguments to be passed from the convenience functions.} -} - -\details{ - The asymptotic regression model is a three-parameter model with mean function: - - \deqn{ f(x) = c + (d-c)(1-\exp(-x/e))} - - The parameter \eqn{c} is the lower limit (at \eqn{x=0}), the parameter \eqn{d} is the upper limit - and the parameter \eqn{e>0} is determining the steepness of the increase as \eqn{x}. -} - -\value{ - A list of class \code{drcMean}, containing the mean function, the self starter function, - the parameter names and other components such as derivatives and a function for calculating ED values. -} - -%\references{ ~put references to the literature/web site here ~ } - -\author{Christian Ritz} - -\note{ - The functions are for use with the function \code{\link{drm}}. -} - -\seealso{ - A very similar, but monotonously decreasing model is the exponential decay model: - \code{\link{EXD.2}} and \code{\link{EXD.3}}. -} - -\examples{ - -## First model -met.as.m1<-drm(gain ~ dose, product, data = methionine, fct = AR.3(), -pmodels = list(~1, ~factor(product), ~factor(product))) -plot(met.as.m1, log = "", ylim = c(1450, 1800)) -summary(met.as.m1) - -## Calculating bioefficacy: approach 1 -coef(met.as.m1)[5] / coef(met.as.m1)[4] * 100 - -## Calculating bioefficacy: approach 2 -EDcomp(met.as.m1, c(50,50)) - -## Simplified models -met.as.m2<-drm(gain ~ dose, product, data = methionine, fct = AR.3(), -pmodels = list(~1, ~1, ~factor(product))) -anova(met.as.m2, met.as.m1) # simplification not possible - -met.as.m3 <- drm(gain ~ dose, product, data = methionine, fct = AR.3(), -pmodels = list(~1, ~factor(product), ~1)) -anova(met.as.m3, met.as.m1) # simplification not possible - -} -\keyword{models} -\keyword{nonlinear} - diff --git a/man/BC.4.Rd b/man/BC.4.Rd new file mode 100644 index 00000000..55082611 --- /dev/null +++ b/man/BC.4.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/braincousens.R +\name{BC.4} +\alias{BC.4} +\title{Four-parameter Brain-Cousens hormesis model} +\usage{ +BC.4(fixed = c(NA, NA, NA, NA), names = c("b", "d", "e", "f"), ...) +} +\arguments{ +\item{fixed}{numeric vector of length 4 specifying fixed parameters (NAs for free parameters).} + +\item{names}{a vector of character strings giving the names of the parameters.} + +\item{...}{additional arguments passed to \code{\link{braincousens}}.} +} +\value{ +A list (see \code{\link{braincousens}}). +} +\description{ +\code{BC.4} provides the Brain-Cousens modified log-logistic model with the lower limit fixed at 0. +} +\examples{ +lettuce.bcm2 <- drm(weight ~ conc, data = lettuce, fct = BC.4()) +summary(lettuce.bcm2) +ED(lettuce.bcm2, c(50)) + +} +\references{ +van Ewijk, P. H. and Hoekstra, J. A. (1993) +Calculation of the EC50 and its Confidence Interval When Subtoxic Stimulus Is Present, +\emph{Ecotoxicology and Environmental Safety}, \bold{25}, 25--32. +} +\seealso{ +\code{\link{braincousens}}, \code{\link{BC.5}} +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/BC.5.Rd b/man/BC.5.Rd new file mode 100644 index 00000000..2afbaa55 --- /dev/null +++ b/man/BC.5.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/braincousens.R +\name{BC.5} +\alias{BC.5} +\title{Five-parameter Brain-Cousens hormesis model} +\usage{ +BC.5(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...) +} +\arguments{ +\item{fixed}{numeric vector of length 5 specifying fixed parameters (NAs for free parameters).} + +\item{names}{a vector of character strings giving the names of the parameters.} + +\item{...}{additional arguments passed to \code{\link{braincousens}}.} +} +\value{ +A list (see \code{\link{braincousens}}). +} +\description{ +\code{BC.5} provides the full five-parameter Brain-Cousens modified log-logistic model +for describing hormesis. +} +\examples{ +lettuce.bcm1 <- drm(weight ~ conc, data = lettuce, fct = BC.5()) +modelFit(lettuce.bcm1) +plot(lettuce.bcm1) + +} +\seealso{ +\code{\link{braincousens}}, \code{\link{BC.4}} +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/BC.Rd b/man/BC.Rd deleted file mode 100644 index 9ed45e72..00000000 --- a/man/BC.Rd +++ /dev/null @@ -1,108 +0,0 @@ -\name{BC.5} - -\alias{BC.5} -\alias{bcl4} - -\alias{BC.4} -\alias{bcl3} - -\title{The Brain-Cousens hormesis models} - -\description{ - 'BC.4' and 'BC.5' provide the Brain-Cousens modified log-logistic models for describing u-shaped hormesis. -} - -\usage{ - BC.5(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...) - - BC.4(fixed = c(NA, NA, NA, NA), names = c("b", "d", "e", "f"), ...) -} - -\arguments{ - \item{fixed}{numeric vector specifying which parameters are fixed and at which values they are fixed. - NAs designate parameters that are not fixed.} - \item{names}{a vector of character strings giving the names of the parameters.} - \item{...}{additional arguments to be passed from the convenience functions.} -} - -\details{ - The model function for the Brain-Cousens model (Brain and Cousens, 1989) is - - \deqn{ f(x, b,c,d,e,f) = c + \frac{d-c+fx}{1+\exp(b(\log(x)-\log(e)))}}, - - and it is a five-parameter model, obtained by extending the four-parameter log-logistic model (\code{\link{LL.4}} - to take into account inverse u-shaped hormesis effects. - - The parameters have the following interpretations - \itemize{ - \item \eqn{b}: Not direct interpretation - \item \eqn{c}: Lower horizontal asymptote - \item \eqn{d}: Upper horizontal asymptote - \item \eqn{e}: Not direct interpretation - \item \eqn{f}: Size of the hormesis effect: the larger the value the larger is the hormesis effect. \eqn{f=0} - corresponds to no hormesis effect and the resulting model is the four-parameter log-logistic model. - This parameter should be positive in order for the model to make sense. - } - - Fixing the lower limit at 0 yields the four-parameter model - - \deqn{ f(x) = 0 + \frac{d-0+fx}{1+\exp(b(\log(x)-\log(e)))}} - - used by van Ewijk and Hoekstra (1993). -} - -\value{ - See \code{\link{braincousens}}. -} - -\references{ - Brain, P. and Cousens, R. (1989) An equation to describe dose responses - where there is stimulation of growth at low doses, - \emph{Weed Research}, \bold{29}, 93--96. - - van Ewijk, P. H. and Hoekstra, J. A. (1993) - Calculation of the EC50 and its Confidence Interval When Subtoxic Stimulus Is Present, - \emph{Ecotoxicology and Environmental Safety}, \bold{25}, 25--32. -} - -\author{Christian Ritz} - -\note{This function is for use with the function \code{\link{drm}}.} - -\seealso{ - More details are found for the general model function \code{\link{braincousens}}. -} - -\examples{ - -## Fitting the data in van Ewijk and Hoekstra (1993) -lettuce.bcm1 <- drm(weight ~ conc, data = lettuce, fct=BC.5()) -modelFit(lettuce.bcm1) -plot(lettuce.bcm1) - -lettuce.bcm2 <- drm(weight ~conc, data = lettuce, fct=BC.4()) -summary(lettuce.bcm2) -ED(lettuce.bcm2, c(50)) -# compare the parameter estimate and -# its estimated standard error -# to the values in the paper by -# van Ewijk and Hoekstra (1993) - - -## Brain-Cousens model with the constraint b>3 -ryegrass.bcm1 <- drm(rootl ~conc, data = ryegrass, fct = BC.5(), -lower = c(3, -Inf, -Inf, -Inf, -Inf), control = drmc(constr=TRUE)) - -summary(ryegrass.bcm1) - -## Brain-Cousens model with the constraint f>0 -## (no effect as the estimate of f is positive anyway) -ryegrass.bcm2 <- drm(rootl ~conc, data = ryegrass, fct = BC.5(), -lower = c(-Inf, -Inf, -Inf, -Inf, 0), control = drmc(constr=TRUE)) - -summary(ryegrass.bcm2) - -} - -\keyword{models} -\keyword{nonlinear} diff --git a/man/C.dubia.Rd b/man/C.dubia.Rd new file mode 100644 index 00000000..a34c44fa --- /dev/null +++ b/man/C.dubia.Rd @@ -0,0 +1,42 @@ +\name{C.dubia} + +\alias{C.dubia} + +\docType{data} + +\title{Offsprings resulting from a toxicity test} + +\description{ +Results from a chronic reproduction toxicity test with seven different concentrations of waste water. The response was the number of offspring produced by the water flea \emph{Ceriodaphnia dubia}. +} + +\usage{data(C.dubia)} + +\format{ + A data frame with 50 observations of the following 2 variables. + \describe{ + \item{\code{conc}}{a numeric vector giving waste water in percentage} + \item{\code{number}}{a numeric vector} + } +} + +\source{ +A. J. Bailer and J. T. Oris (1997). Estimating inhibition concentrations for different response scales +using generalized linear models. Environmental Toxicology and Chemistry, \bold{16}:1554--1559. +} + + +\examples{ +library(drc) + +## Displaying the data +head(C.dubia) + +## Fitting a three-parameter log-logistic model +C.dubia.m1 <- drm(number ~ conc, data = C.dubia, fct = LL.3()) +summary(C.dubia.m1) + +## Plotting fitted curve together with the original data +plot(C.dubia.m1, xlab = "Concentration (\%)", ylab = "Number of offspring") +} +\keyword{datasets} diff --git a/man/CIcomp.Rd b/man/CIcomp.Rd new file mode 100644 index 00000000..fa5feb9a --- /dev/null +++ b/man/CIcomp.Rd @@ -0,0 +1,51 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/CIcompX.R +\name{CIcomp} +\alias{CIcomp} +\title{Classical combination index for effective doses} +\usage{ +CIcomp(mixProp, modelList, EDvec) +} +\arguments{ +\item{mixProp}{a numeric value between 0 and 1 specifying the mixture proportion/ratio.} + +\item{modelList}{a list containing 3 model fits using \code{\link{drm}}: the mixture model fit +first, followed by the 2 pure substance model fits.} + +\item{EDvec}{a numeric vector of effect levels (percentages between 0 and 100).} +} +\value{ +A matrix with one row per ED value. Columns contain estimated combination indices, +their standard errors and 95\% confidence intervals, p-value for testing CI=1, estimated +ED values for the mixture data and assuming concentration addition (CA) with corresponding +standard errors. +} +\description{ +Calculates the classical combination index for effective doses in binary mixture experiments. +} +\examples{ +## Fitting marginal models for the 2 pure substances +acidiq.0 <- drm(rgr ~ dose, data = subset(acidiq, pct == 999 | pct == 0), fct = LL.4()) +acidiq.100 <- drm(rgr ~ dose, data = subset(acidiq, pct == 999 | pct == 100), fct = LL.4()) + +## Fitting model for single mixture with ratio 17:83 +acidiq.17 <- drm(rgr ~ dose, data = subset(acidiq, pct == 17 | pct == 0), fct = LL.4()) + +## Calculation of combination indices based on ED10, ED20, ED50 +CIcomp(0.17, list(acidiq.17, acidiq.0, acidiq.100), c(10, 20, 50)) + +} +\references{ +Martin-Betancor, K. and Ritz, C. and Fernandez-Pinas, F. and Leganes, F. and +Rodea-Palomares, I. (2015) Defining an additivity framework for mixture research in +inducible whole-cell biosensors, \emph{Scientific Reports} \bold{17200}. +} +\seealso{ +\code{\link{CIcompX}}, \code{\link{plotFACI}}, \code{\link{mixture}} +} +\author{ +Christian Ritz and Ismael Rodea-Palomares +} +\concept{antagonism mixture synergy} +\keyword{models} +\keyword{nonlinear} diff --git a/man/CIcompX.Rd b/man/CIcompX.Rd index b7837159..847f5c3d 100644 --- a/man/CIcompX.Rd +++ b/man/CIcompX.Rd @@ -1,107 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/CIcompX.R \name{CIcompX} \alias{CIcompX} -\alias{CIcomp} -\alias{plotFACI} - -\title{ -Calculation of combination index for binary mixtures -} - -\description{ -For single mixture data combination indices for effective doses as well as effects may be calculated and visualized. -} - +\title{Calculation of combination index for binary mixtures} \usage{ -CIcomp(mixProp, modelList, EDvec) - CIcompX(mixProp, modelList, EDvec, EDonly = FALSE) - -plotFACI(effList, indAxis = c("ED", "EF"), caRef = TRUE, -showPoints = FALSE, add = FALSE, ylim, ...) - } - \arguments{ +\item{mixProp}{a numeric value between 0 and 1 specifying the mixture proportion/ratio.} - \item{mixProp}{a numeric value between 0 and 1 specifying the mixture proportion/ratio for - the single mixture considered.} +\item{modelList}{a list containing 3 model fits using \code{\link{drm}}: the mixture model fit +first, followed by the 2 pure substance model fits.} - \item{modelList}{a list contained 3 models fits using \code{\link{drm}} with the model fit - for single mixture ratio being the first element, followed by the 2 model fits of the pure - substances.} - - \item{EDvec}{ a vector of numeric values between 0 and 100 (percentages) coresponding to the - effect levels of interest.} - - \item{EDonly}{a logical value indicating whether or not only combination indices for - effective doses should be calculated.} - - \item{effList}{a list returned by \code{\link{CIcompX}}.} - - \item{indAxis}{a character indicating whether effective doses ("ED") or effects - ("EF") should be plotted.} - - \item{caRef}{a logical value indicating whether or not a reference line for concentration - addition should be drawn.} - - \item{showPoints}{A logical value indicating whether or not estimated combination indices - should be plotted.} - - \item{add}{a logical value specifying if the plot should be added to the existing plot.} - - \item{ylim}{a numeric vector of length 2 giving the range for the y axis.} - - \item{...}{additional graphical arguments.} -} +\item{EDvec}{a numeric vector of effect levels (percentages between 0 and 100).} -\details{ -\code{\link{CIcomp}} calculates the classical combination index for effective doses whereas \code{\link{CIcompX}} calculates the combination index also for effects as proposed by -Martin-Betancor et al. (2015); for details and examples using "drc" see the supplementary material of this paper. The function \code{\link{plotFACI}} may be used to visualize the -calculated combination index as a function of the fraction affected. +\item{EDonly}{logical. If TRUE, only combination indices for effective doses are calculated.} } - \value{ -\code{\link{CIcomp}} returns a matrix which one row per ED value. Columns contain -estimated combination indices, their standard errors and 95\% confidence intervals, -p-value for testing CI=1, estimated ED values for the mixture data and assuming -concentration addition (CA) with corresponding standard errors. - -\code{\link{CIcompX}} returns similar output both for effective doses and effects (as a -list of matrices). +A list with components \code{Effx}, \code{Effy} (unless \code{EDonly = TRUE}), +\code{CAx}, \code{CAy} (unless \code{EDonly = TRUE}), and \code{EDvec}. } - -\references{ -Martin-Betancor, K. and Ritz, C. and Fernandez-Pinas, F. and Leganes, F. and Rodea-Palomares, I. (2015) -Defining an additivity framework for mixture research in inducible whole-cell biosensors, -\emph{Scientific Reports} -\bold{17200}. +\description{ +For single mixture data, combination indices for effective doses as well as effects +may be calculated. This is an extended version of \code{\link{CIcomp}}. } - -\author{ -Christian Ritz and Ismael Rodea-Palomares +\references{ +Martin-Betancor, K. and Ritz, C. and Fernandez-Pinas, F. and Leganes, F. and +Rodea-Palomares, I. (2015) Defining an additivity framework for mixture research in +inducible whole-cell biosensors, \emph{Scientific Reports} \bold{17200}. } - -%\note{} - \seealso{ -See \code{\link{mixture}} for simultaneous modelling of several mixture ratios, but only at the ED50 level. - +\code{\link{CIcomp}}, \code{\link{plotFACI}}, \code{\link{mixture}} } - -\examples{ -## Fitting marginal models for the 2 pure substances -acidiq.0 <- drm(rgr ~ dose, data = subset(acidiq, pct == 999 | pct == 0), fct = LL.4()) -acidiq.100 <- drm(rgr ~ dose, data = subset(acidiq, pct == 999 | pct == 100), fct = LL.4()) - -## Fitting model for single mixture with ratio 17:83 -acidiq.17 <- drm(rgr ~ dose, data = subset(acidiq, pct == 17 | pct == 0), fct = LL.4()) - -## Calculation of combination indices based on ED10, ED20, ED50 -CIcomp(0.17, list(acidiq.17, acidiq.0, acidiq.100), c(10, 20, 50)) -## CI>1 significantly for ED10 and ED20, but not so for ED50 - +\author{ +Christian Ritz and Ismael Rodea-Palomares } +\concept{antagonism mixture synergy} \keyword{models} \keyword{nonlinear} - -\concept{antagonism mixture synergy} diff --git a/man/CRS.4a.Rd b/man/CRS.4a.Rd index 5cf7b34a..cd1fa375 100644 --- a/man/CRS.4a.Rd +++ b/man/CRS.4a.Rd @@ -1,94 +1,75 @@ -\name{CRS.4a} - -\alias{CRS.4a} -\alias{CRS.4b} -\alias{CRS.4c} - -\alias{ml3a} -\alias{ml3b} -\alias{ml3c} - -\alias{UCRS.4a} -\alias{UCRS.4b} -\alias{UCRS.4c} - -\alias{uml3a} -\alias{uml3b} -\alias{uml3c} - -\title{The Cedergreen-Ritz-Streibig model} - -\description{ - 'CRS.4a', 'CRS.4b' and 'CRS.4c' provide the Cedergreen-Ritz-Streibig modified log-logistic model - for describing hormesis with the lower limit equal to 0. - - 'UCRS.4a', 'UCRS.4b' and 'UCRS.4c' provide the Cedergreen-Ritz-Streibig modified log-logistic model - for describing u-shaped hormesis with the lower limit equal to 0. -} - -\usage{ - CRS.4a(names = c("b", "d", "e", "f"), ...) - - UCRS.4a(names = c("b", "d", "e", "f"), ...) -} - -\arguments{ - \item{names}{a vector of character strings giving the names of the parameters. - The default is reasonable (see above).} - \item{...}{additional arguments to be passed from the convenience functions.} -} - -\details{ - The model is given by the expression - \deqn{ f(x) = 0 + \frac{d-0+f \exp(-1/x)}{1+\exp(b(\log(x)-\log(e)))}} - which is a five-parameter model. - - It is a modification of the four-parameter logistic curve to take hormesis into account. - - The u-shaped model is given by the expression - \deqn{ f(x) = 0 + d - \frac{d-0+f \exp(-1/x^{\alpha})}{1+\exp(b(\log(x)-\log(e)))}} - - The a,b,c models are obtained by setting alpha equal to 1, 0.5 and 0.25, respectively. -} - -\value{ - See \code{\link{cedergreen}}. -} - -\references{ - See the reference under \code{\link{cedergreen}}. -} - -\author{Christian Ritz} - -\note{ - This function is for use with the function \code{\link{drm}}. -} - -\seealso{ - Similar functions are \code{\link{CRS.5a}} and \code{\link{UCRS.5a}}, - but with an extra parameter for the lower limit.} - -\examples{ - -## Fitting modified logistic models -lettuce.crsm1 <- drm(lettuce[,c(2,1)], fct=CRS.4a()) -summary(lettuce.crsm1) -ED(lettuce.crsm1, c(50)) - -## Need to explicitly specify that the upper limit -## is the reference in order to get ED10 and ED90 right -ED(lettuce.crsm1, c(10, 50, 90), reference = "upper") - -lettuce.crsm2 <- drm(lettuce[,c(2,1)], fct=CRS.4b()) -summary(lettuce.crsm2) -ED(lettuce.crsm2, c(50)) - -lettuce.crsm3 <- drm(lettuce[,c(2,1)], fct=CRS.4c()) -summary(lettuce.crsm3) -ED(lettuce.crsm3, c(50)) - -} - -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cedergreen.R +\name{CRS.4a} +\alias{CRS.4a} +\title{Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 1 +(Deprecated)} +\usage{ +CRS.4a(names = c("b", "c", "d", "e", "f"), fixed = c(NA, 0, NA, NA, NA), ...) +} +\arguments{ +\item{names}{A character vector of length 5 specifying the names of the model +parameters in the following order: +\describe{ +\item{\code{b}}{Hill slope (steepness of the dose-response curve).} +\item{\code{c}}{Lower asymptote (fixed at 0 via the \code{fixed} argument).} +\item{\code{d}}{Upper asymptote.} +\item{\code{e}}{Effective dose producing a response midway between \code{c} and \code{d} +(ED50).} +\item{\code{f}}{Hormesis parameter controlling the magnitude of the stimulatory +effect at low doses.} +} +Defaults to \code{c("b", "c", "d", "e", "f")}.} + +\item{fixed}{A numeric vector of length 5 specifying fixed (non-estimated) +parameter values. Use \code{NA} for parameters that should be estimated freely. +Defaults to \code{c(NA, 0, NA, NA, NA)}, which fixes the lower asymptote \code{c} +at 0.} + +\item{...}{Additional arguments passed to \code{\link[=cedergreen]{cedergreen()}}.} +} +\value{ +A list of class \code{"drcMean"} as returned by \code{\link[=cedergreen]{cedergreen()}}, containing +the model definition including the mean function, its gradient, parameter +names, and fixed values. This object is intended for use as the \code{fct} +argument in \code{\link[=drm]{drm()}}. +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} + +This function is deprecated as of version 3.3.0. Please use \code{\link[=CRS.5]{CRS.5()}} instead, +which provides a more general and flexible interface. + +A four-parameter Cedergreen-Ritz-Streibig (CRS) hormesis model where the lower +asymptote (\code{c}) is fixed at 0 and the alpha parameter controlling the steepness +of the hormetic component is fixed at 1. The four free parameters are \code{b}, \code{d}, +\code{e}, and \code{f}. +} +\examples{ +# NOTE: CRS.4a() is deprecated. Use CRS.5() instead. +# The example below is retained for backward compatibility illustration only. + +lettuce.crsm1 <- drm( lettuce[, c(2, 1)], fct = CRS.4a() ) +summary(lettuce.crsm1) +ED(lettuce.crsm1, c(50)) + +# Recommended replacement: +fct_spec <- CRS.5(alpha_type = "a", fixed = c(NA, 0, NA, NA, NA)) +lettuce.crs5 <- drm(lettuce[, c(2, 1)], fct = fct_spec) +summary(lettuce.crs5) +ED(lettuce.crs5, c(50)) + +} +\seealso{ +\itemize{ +\item \code{\link[=CRS.5]{CRS.5()}} — the recommended replacement for this deprecated function. +\item \code{\link[=cedergreen]{cedergreen()}} — the underlying model constructor. +\item \code{\link[=CRS.5a]{CRS.5a()}} — the five-parameter CRS model with alpha = 1. +\item \code{\link[=UCRS.4a]{UCRS.4a()}} — the unconstrained four-parameter CRS model with alpha = 1. +} +} +\author{ +Christian Ritz, Hannes Reinwald +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/CRS.4b.Rd b/man/CRS.4b.Rd new file mode 100644 index 00000000..f16b17fb --- /dev/null +++ b/man/CRS.4b.Rd @@ -0,0 +1,75 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cedergreen.R +\name{CRS.4b} +\alias{CRS.4b} +\title{Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 0.5 +(Deprecated)} +\usage{ +CRS.4b(names = c("b", "c", "d", "e", "f"), fixed = c(NA, 0, NA, NA, NA), ...) +} +\arguments{ +\item{names}{A character vector of length 5 specifying the names of the model +parameters in the following order: +\describe{ +\item{\code{b}}{Hill slope (steepness of the dose-response curve).} +\item{\code{c}}{Lower asymptote (fixed at 0 via the \code{fixed} argument).} +\item{\code{d}}{Upper asymptote.} +\item{\code{e}}{Effective dose producing a response midway between \code{c} and \code{d} +(ED50).} +\item{\code{f}}{Hormesis parameter controlling the magnitude of the stimulatory +effect at low doses.} +} +Defaults to \code{c("b", "c", "d", "e", "f")}.} + +\item{fixed}{A numeric vector of length 5 specifying fixed (non-estimated) +parameter values. Use \code{NA} for parameters that should be estimated freely. +Defaults to \code{c(NA, 0, NA, NA, NA)}, which fixes the lower asymptote \code{c} +at 0.} + +\item{...}{Additional arguments passed to \code{\link[=cedergreen]{cedergreen()}}.} +} +\value{ +A list of class \code{"drcMean"} as returned by \code{\link[=cedergreen]{cedergreen()}}, containing +the model definition including the mean function, its gradient, parameter +names, and fixed values. This object is intended for use as the \code{fct} +argument in \code{\link[=drm]{drm()}}. +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} + +This function is deprecated as of version 3.3.0. Please use \code{\link[=CRS.5]{CRS.5()}} instead, +which provides a more general and flexible interface. + +A four-parameter Cedergreen-Ritz-Streibig (CRS) hormesis model where the lower +asymptote (\code{c}) is fixed at 0 and the alpha parameter controlling the steepness +of the hormetic component is fixed at 0.5. The four free parameters are \code{b}, \code{d}, +\code{e}, and \code{f}. +} +\examples{ +# NOTE: CRS.4b() is deprecated. Use CRS.5() instead. +# The example below is retained for backward compatibility illustration only. + +lettuce.crsm2 <- drm( lettuce[, c(2, 1)], fct = CRS.4b() ) +summary(lettuce.crsm2) +ED(lettuce.crsm2, c(50)) + +# Recommended replacement: +fct_spec <- CRS.5(alpha_type = "b", fixed = c(NA, 0, NA, NA, NA)) +lettuce.crs5 <- drm(lettuce[, c(2, 1)], fct = fct_spec) +summary(lettuce.crs5) +ED(lettuce.crs5, c(50)) + +} +\seealso{ +\itemize{ +\item \code{\link[=CRS.5]{CRS.5()}} — the recommended replacement for this deprecated function. +\item \code{\link[=cedergreen]{cedergreen()}} — the underlying model constructor. +\item \code{\link[=CRS.4a]{CRS.4a()}} — the four-parameter CRS model with lower limit fixed at 0 and alpha = 1. +\item \code{\link[=CRS.5b]{CRS.5b()}} — the five-parameter CRS model with alpha = 0.5. +} +} +\author{ +Christian Ritz, Hannes Reinwald +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/CRS.4c.Rd b/man/CRS.4c.Rd new file mode 100644 index 00000000..7a755cd3 --- /dev/null +++ b/man/CRS.4c.Rd @@ -0,0 +1,75 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cedergreen.R +\name{CRS.4c} +\alias{CRS.4c} +\title{Cedergreen-Ritz-Streibig Model with Lower Limit Fixed at 0 and Alpha = 0.25 +(Deprecated)} +\usage{ +CRS.4c(names = c("b", "c", "d", "e", "f"), fixed = c(NA, 0, NA, NA, NA), ...) +} +\arguments{ +\item{names}{A character vector of length 5 specifying the names of the model +parameters in the following order: +\describe{ +\item{\code{b}}{Hill slope (steepness of the dose-response curve).} +\item{\code{c}}{Lower asymptote (fixed at 0 via the \code{fixed} argument).} +\item{\code{d}}{Upper asymptote.} +\item{\code{e}}{Effective dose producing a response midway between \code{c} and \code{d} +(ED50).} +\item{\code{f}}{Hormesis parameter controlling the magnitude of the stimulatory +effect at low doses.} +} +Defaults to \code{c("b", "c", "d", "e", "f")}.} + +\item{fixed}{A numeric vector of length 5 specifying fixed (non-estimated) +parameter values. Use \code{NA} for parameters that should be estimated freely. +Defaults to \code{c(NA, 0, NA, NA, NA)}, which fixes the lower asymptote \code{c} +at 0.} + +\item{...}{Additional arguments passed to \code{\link[=cedergreen]{cedergreen()}}.} +} +\value{ +A list of class \code{"drcMean"} as returned by \code{\link[=cedergreen]{cedergreen()}}, containing +the model definition including the mean function, its gradient, parameter +names, and fixed values. This object is intended for use as the \code{fct} +argument in \code{\link[=drm]{drm()}}. +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} + +This function is deprecated as of version 3.3.0. Please use \code{\link[=CRS.5]{CRS.5()}} instead, +which provides a more general and flexible interface. + +A four-parameter Cedergreen-Ritz-Streibig (CRS) hormesis model where the lower +asymptote (\code{c}) is fixed at 0 and the alpha parameter controlling the steepness +of the hormetic component is fixed at 0.25. The four free parameters are \code{b}, \code{d}, +\code{e}, and \code{f}. +} +\examples{ +# NOTE: CRS.4c() is deprecated. Use CRS.5() instead. +# The example below is retained for backward compatibility illustration only. + +lettuce.crsm3 <- drm( lettuce[, c(2, 1)], fct = CRS.4c() ) +summary(lettuce.crsm3) +ED(lettuce.crsm3, c(50)) + +# Recommended replacement: +fct_spec <- CRS.5(alpha_type = "c", fixed = c(NA, 0, NA, NA, NA)) +lettuce.crs5 <- drm(lettuce[, c(2, 1)], fct = fct_spec) +summary(lettuce.crs5) +ED(lettuce.crs5, c(50)) + +} +\seealso{ +\itemize{ +\item \code{\link[=CRS.5]{CRS.5()}} — the recommended replacement for this deprecated function. +\item \code{\link[=cedergreen]{cedergreen()}} — the underlying model constructor. +\item \code{\link[=CRS.4a]{CRS.4a()}} — the four-parameter CRS model with lower limit fixed at 0 and alpha = 1. +\item \code{\link[=CRS.5c]{CRS.5c()}} — the five-parameter CRS model with alpha = 0.25. +} +} +\author{ +Christian Ritz, Hannes Reinwald +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/CRS.5.Rd b/man/CRS.5.Rd new file mode 100644 index 00000000..79cf6f01 --- /dev/null +++ b/man/CRS.5.Rd @@ -0,0 +1,73 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cedergreen.R +\name{CRS.5} +\alias{CRS.5} +\title{Wrapper for 5-parameter Cedergreen-Ritz-Streibig Model} +\usage{ +CRS.5( + names = c("b", "c", "d", "e", "f"), + fixed = c(NA, NA, NA, NA, NA), + alpha_type = "a", + fctName = NULL, + fctText = NULL, + ... +) +} +\arguments{ +\item{names}{A character vector of length 5 specifying the names of the model +parameters. Default is \code{c("b", "c", "d", "e", "f")}.} + +\item{fixed}{A numeric vector of length 5. Use \code{NA} for parameters to be +estimated and a numeric value for parameters to be fixed. Default is all +\code{NA}.} + +\item{alpha_type}{A character or a numeric value. Can be one of 'a' (alpha=1), +'b' (alpha=0.5), 'c' (alpha=0.25), or a specific numeric value for alpha.} + +\item{fctName}{An optional character string to name the model function. If +\code{NULL} (the default), a name is generated automatically.} + +\item{fctText}{An optional character string describing the model. If +\code{NULL} (the default), a description is generated automatically.} + +\item{...}{Additional arguments to be passed to \code{drc::cedergreen}, such +as \code{data}.} +} +\value{ +A \code{drc} model object of class \code{cedergreen}. If the underlying +\code{drc::cedergreen} call fails, it issues a warning and returns \code{NULL}. +} +\description{ +A convenience wrapper for the \code{drc::cedergreen} function, preset for a +5-parameter model. It provides flexible handling for the alpha parameter. +} +\details{ +This function simplifies the creation of a 5-parameter Cedergreen-Ritz-Streibig +model by setting sensible defaults for the parameter names. It allows the +alpha parameter to be specified either by a predefined character shortcut +('a', 'b', 'c') or by a direct numeric value. + +By default the function runs with \code{alpha=1}, which corresponds to the \code{CRS.4a} model. +Setting \code{alpha=0.5} corresponds to the \code{CRS.4b} model, and \code{alpha=0.25} corresponds to the \code{CRS.4c} model. + +By default, all parameters are set to be estimated (i.e., \code{fixed} is all \code{NA}), +but users can specify any parameters to be held constant during estimation. +The self-starter function is automatically generated based on the specified method and +fixed parameters, ensuring that initial values are appropriately calculated for the model fitting process. + +The function automatically generates a model name (\code{fctName}) and description +(\code{fctText}) unless they are explicitly provided by the user. +} +\examples{ +# Create a CRS.5 model specification +crs_model_a <- CRS.5() + +# Fix the lower limit to 0 and use a custom numeric alpha +crs_model_custom <- CRS.5( + fixed = c(NA, 0, NA, NA, NA), alpha_type = 0.75 +) + +} +\author{ +Hannes Reinwald +} diff --git a/man/CRS.5a.Rd b/man/CRS.5a.Rd index d912ce9d..f39558e5 100644 --- a/man/CRS.5a.Rd +++ b/man/CRS.5a.Rd @@ -1,105 +1,73 @@ -\name{CRS.5a} - -\alias{CRS.5a} -\alias{CRS.5b} -\alias{CRS.5c} - -\alias{ml4a} -\alias{ml4b} -\alias{ml4c} - -\alias{UCRS.5a} -\alias{UCRS.5b} -\alias{UCRS.5c} - -\alias{uml4a} -\alias{uml4b} -\alias{uml4c} - - -\title{Cedergreen-Ritz-Streibig dose-reponse model for describing hormesis} - -\description{ - 'CRS.5a', 'CRS.5b' and 'CRS.5c' provide the Cedergreen-Ritz-Streibig modified log-logistic model for describing - (inverse u-shaped or j-shaped) hormesis. - - 'UCRS.5a', 'UCRS.5b' and 'UCRS.5c' provide the Cedergreen-Ritz-Streibig modified log-logistic model for - describing u-shaped hormesis. -} - -\usage{ - CRS.5a(names = c("b", "c", "d", "e", "f"), ...) - - UCRS.5a(names = c("b", "c", "d", "e", "f"), ...) -} - -\arguments{ - \item{names}{a vector of character strings giving the names of the parameters.} - \item{...}{additional arguments to be passed from the convenience functions.} -} - -\details{ - The model function for inverse u-shaped hormetic patterns is - - \deqn{ f(x) = c + \frac{d-c+f \exp(-1/x^{\alpha})}{1+\exp(b(\log(x)-\log(e)))}}, - - which is a five-parameter model. It is a modification of the four-parameter log-logistic curve - to take hormesis into account. - - The parameters have the following interpretations - \itemize{ - \item \eqn{b}: Not direct interpretation - \item \eqn{c}: Lower horizontal asymptote - \item \eqn{d}: Upper horizontal asymptote - \item \eqn{e}: Not direct interpretation - \item \eqn{f}: Size of the hormesis effect: the larger the value the larger is the hormesis effect. \eqn{f=0} - corresponds to no hormesis effect and the resulting model is the four-parameter log-logistic model. - This parameter should be positive in order for the model to make sense. - } - - The model function for u-shaped hormetic patterns is - \deqn{ f(x) = c + d - \frac{d-c+f \exp(-1/x^{\alpha})}{1+\exp(b(\log(x)-\log(e)))}} - - This model also simplifies to the four-parameter log-logistic model in case \eqn{f=0} (in a slightly - different parameterization as compared to the one used in \code{\link{LL.4}}). - - The models denoted a,b,c are obtained by fixing the alpha parameter at 1, 0.5 and 0.25, respectively. -} - -\value{ - See \code{\link{cedergreen}}. -} - -\references{ - See the reference under \code{\link{cedergreen}}. -} - -\author{Christian Ritz} - -\note{ - This function is for use with the function \code{\link{drm}}. -} - -\seealso{ - Similar functions are \code{\link{CRS.4a}} and \code{\link{UCRS.4a}}, but with the - lower limit (the parameter \eqn{c}) fixed at 0 (one parameter less to be estimated). -} - -\examples{ - -## Modified logistic model -lettuce.m1 <- drm(lettuce[,c(2,1)], fct=CRS.5a()) -summary(lettuce.m1) -ED(lettuce.m1, c(50)) - -lettuce.m2 <- drm(lettuce[,c(2,1)], fct=CRS.5b()) -summary(lettuce.m2) -ED(lettuce.m2, c(50)) - -lettuce.m3 <- drm(lettuce[,c(2,1)], fct=CRS.5c()) -summary(lettuce.m3) -ED(lettuce.m3, c(50)) - -} -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cedergreen.R +\name{CRS.5a} +\alias{CRS.5a} +\title{Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 1 +(Deprecated)} +\usage{ +CRS.5a(names = c("b", "c", "d", "e", "f"), fixed = c(NA, NA, NA, NA, NA), ...) +} +\arguments{ +\item{names}{A character vector of length 5 specifying the names of the model +parameters in the following order: +\describe{ +\item{\code{b}}{Hill slope (steepness of the dose-response curve).} +\item{\code{c}}{Lower asymptote (freely estimated).} +\item{\code{d}}{Upper asymptote.} +\item{\code{e}}{Effective dose producing a response midway between \code{c} and \code{d} +(ED50).} +\item{\code{f}}{Hormesis parameter controlling the magnitude of the stimulatory +effect at low doses.} +} +Defaults to \code{c("b", "c", "d", "e", "f")}.} + +\item{fixed}{A numeric vector of length 5 specifying fixed (non-estimated) +parameter values. Use \code{NA} for parameters that should be estimated freely. +Defaults to \code{c(NA, NA, NA, NA, NA)}, meaning all five parameters are +freely estimated.} + +\item{...}{Additional arguments passed to \code{\link[=cedergreen]{cedergreen()}}.} +} +\value{ +A list of class \code{"drcMean"} as returned by \code{\link[=cedergreen]{cedergreen()}}, containing +the model definition including the mean function, its gradient, parameter +names, and fixed values. This object is intended for use as the \code{fct} +argument in \code{\link[=drm]{drm()}}. +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} + +This function is deprecated as of version 3.3.0. Please use \code{\link[=CRS.5]{CRS.5()}} instead, +which provides a more general and flexible interface. + +A five-parameter Cedergreen-Ritz-Streibig (CRS) hormesis model where the alpha +parameter controlling the steepness of the hormetic component is fixed at 1. +All five parameters \code{b}, \code{c}, \code{d}, \code{e}, and \code{f} are freely estimated. +} +\examples{ +# NOTE: CRS.5a() is deprecated. Use CRS.5() instead. +# The example below is retained for backward compatibility illustration only. + +lettuce.m1 <- drm( lettuce[, c(2, 1)], fct = CRS.5a() ) +summary(lettuce.m1) +ED(lettuce.m1, c(50)) + +# Recommended replacement: +lettuce.crs5 <- drm( lettuce[, c(2, 1)], fct = CRS.5(alpha_type = "a") ) +summary(lettuce.crs5) +ED(lettuce.crs5, c(50)) + +} +\seealso{ +\itemize{ +\item \code{\link[=CRS.5]{CRS.5()}} — the recommended replacement for this deprecated function. +\item \code{\link[=cedergreen]{cedergreen()}} — the underlying model constructor. +\item \code{\link[=CRS.4a]{CRS.4a()}} — the four-parameter CRS model with lower limit fixed at 0 and alpha = 1. +\item \code{\link[=UCRS.5a]{UCRS.5a()}} — the unconstrained five-parameter CRS model with alpha = 1. +} +} +\author{ +Christian Ritz, Hannes Reinwald +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/CRS.5b.Rd b/man/CRS.5b.Rd new file mode 100644 index 00000000..977c9a17 --- /dev/null +++ b/man/CRS.5b.Rd @@ -0,0 +1,73 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cedergreen.R +\name{CRS.5b} +\alias{CRS.5b} +\title{Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 0.5 +(Deprecated)} +\usage{ +CRS.5b(names = c("b", "c", "d", "e", "f"), fixed = c(NA, NA, NA, NA, NA), ...) +} +\arguments{ +\item{names}{A character vector of length 5 specifying the names of the model +parameters in the following order: +\describe{ +\item{\code{b}}{Hill slope (steepness of the dose-response curve).} +\item{\code{c}}{Lower asymptote (freely estimated).} +\item{\code{d}}{Upper asymptote.} +\item{\code{e}}{Effective dose producing a response midway between \code{c} and \code{d} +(ED50).} +\item{\code{f}}{Hormesis parameter controlling the magnitude of the stimulatory +effect at low doses.} +} +Defaults to \code{c("b", "c", "d", "e", "f")}.} + +\item{fixed}{A numeric vector of length 5 specifying fixed (non-estimated) +parameter values. Use \code{NA} for parameters that should be estimated freely. +Defaults to \code{c(NA, NA, NA, NA, NA)}, meaning all five parameters are +freely estimated.} + +\item{...}{Additional arguments passed to \code{\link[=cedergreen]{cedergreen()}}.} +} +\value{ +A list of class \code{"drcMean"} as returned by \code{\link[=cedergreen]{cedergreen()}}, containing +the model definition including the mean function, its gradient, parameter +names, and fixed values. This object is intended for use as the \code{fct} +argument in \code{\link[=drm]{drm()}}. +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} + +This function is deprecated as of version 3.3.0. Please use \code{\link[=CRS.5]{CRS.5()}} instead, +which provides a more general and flexible interface. + +A five-parameter Cedergreen-Ritz-Streibig (CRS) hormesis model where the alpha +parameter controlling the steepness of the hormetic component is fixed at 0.5. +All five parameters \code{b}, \code{c}, \code{d}, \code{e}, and \code{f} are freely estimated. +} +\examples{ +# NOTE: CRS.5b() is deprecated. Use CRS.5() instead. +# The example below is retained for backward compatibility illustration only. + +lettuce.m2 <- drm( lettuce[, c(2, 1)], fct = CRS.5b() ) +summary(lettuce.m2) +ED(lettuce.m2, c(50)) + +# Recommended replacement: +lettuce.crs5 <- drm( lettuce[, c(2, 1)], fct = CRS.5(alpha_type = "b") ) +summary(lettuce.crs5) +ED(lettuce.crs5, c(50)) + +} +\seealso{ +\itemize{ +\item \code{\link[=CRS.5]{CRS.5()}} — the recommended replacement for this deprecated function. +\item \code{\link[=cedergreen]{cedergreen()}} — the underlying model constructor. +\item \code{\link[=CRS.4b]{CRS.4b()}} — the four-parameter CRS model with lower limit fixed at 0 and alpha = 0.5. +\item \code{\link[=CRS.5a]{CRS.5a()}} — the five-parameter CRS model with alpha = 1. +} +} +\author{ +Christian Ritz, Hannes Reinwald +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/CRS.5c.Rd b/man/CRS.5c.Rd new file mode 100644 index 00000000..66d15c7c --- /dev/null +++ b/man/CRS.5c.Rd @@ -0,0 +1,73 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cedergreen.R +\name{CRS.5c} +\alias{CRS.5c} +\title{Cedergreen-Ritz-Streibig Five-Parameter Model with Alpha = 0.25 +(Deprecated)} +\usage{ +CRS.5c(names = c("b", "c", "d", "e", "f"), fixed = c(NA, NA, NA, NA, NA), ...) +} +\arguments{ +\item{names}{A character vector of length 5 specifying the names of the model +parameters in the following order: +\describe{ +\item{\code{b}}{Hill slope (steepness of the dose-response curve).} +\item{\code{c}}{Lower asymptote (freely estimated).} +\item{\code{d}}{Upper asymptote.} +\item{\code{e}}{Effective dose producing a response midway between \code{c} and \code{d} +(ED50).} +\item{\code{f}}{Hormesis parameter controlling the magnitude of the stimulatory +effect at low doses.} +} +Defaults to \code{c("b", "c", "d", "e", "f")}.} + +\item{fixed}{A numeric vector of length 5 specifying fixed (non-estimated) +parameter values. Use \code{NA} for parameters that should be estimated freely. +Defaults to \code{c(NA, NA, NA, NA, NA)}, meaning all five parameters are +freely estimated.} + +\item{...}{Additional arguments passed to \code{\link[=cedergreen]{cedergreen()}}.} +} +\value{ +A list of class \code{"drcMean"} as returned by \code{\link[=cedergreen]{cedergreen()}}, containing +the model definition including the mean function, its gradient, parameter +names, and fixed values. This object is intended for use as the \code{fct} +argument in \code{\link[=drm]{drm()}}. +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} + +This function is deprecated as of version 3.3.0. Please use \code{\link[=CRS.5]{CRS.5()}} instead, +which provides a more general and flexible interface. + +A five-parameter Cedergreen-Ritz-Streibig (CRS) hormesis model where the alpha +parameter controlling the steepness of the hormetic component is fixed at 0.25. +All five parameters \code{b}, \code{c}, \code{d}, \code{e}, and \code{f} are freely estimated. +} +\examples{ +# NOTE: CRS.5c() is deprecated. Use CRS.5() instead. +# The example below is retained for backward compatibility illustration only. + +lettuce.m3 <- drm( lettuce[, c(2, 1)], fct = CRS.5c() ) +summary(lettuce.m3) +ED(lettuce.m3, c(50)) + +# Recommended replacement: +lettuce.crs5 <- drm( lettuce[, c(2, 1)], fct = CRS.5(alpha_type = "c") ) +summary(lettuce.crs5) +ED(lettuce.crs5, c(50)) + +} +\seealso{ +\itemize{ +\item \code{\link[=CRS.5]{CRS.5()}} — the recommended replacement for this deprecated function. +\item \code{\link[=cedergreen]{cedergreen()}} — the underlying model constructor. +\item \code{\link[=CRS.4c]{CRS.4c()}} — the four-parameter CRS model with lower limit fixed at 0 and alpha = 0.25. +\item \code{\link[=CRS.5b]{CRS.5b()}} — the five-parameter CRS model with alpha = 0.5. +} +} +\author{ +Christian Ritz, Hannes Reinwald +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/CRS.6.Rd b/man/CRS.6.Rd new file mode 100644 index 00000000..9c1d65ca --- /dev/null +++ b/man/CRS.6.Rd @@ -0,0 +1,51 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/CRS.6.R +\name{CRS.6} +\alias{CRS.6} +\title{Generalised Cedergreen-Ritz-Streibig Model for Hormesis} +\usage{ +CRS.6( + fixed = c(NA, NA, NA, NA, NA, NA), + names = c("b", "c", "d", "e", "f", "g"), + method = c("1", "2", "3", "4"), + ssfct = NULL +) +} +\arguments{ +\item{fixed}{numeric vector. Specifies which parameters are fixed and at what value +they are fixed. NAs for parameters that are not fixed.} + +\item{names}{a vector of character strings giving the names of the parameters +(should not contain ":").} + +\item{method}{character string indicating the self starter function to use.} + +\item{ssfct}{a self starter function to be used (optional).} +} +\value{ +A list containing the nonlinear model function, the self starter function, +and the parameter names. +} +\description{ +A six-parameter extension of the Cedergreen-Ritz-Streibig model for +describing hormesis, where the alpha parameter is estimated rather than fixed. +} +\details{ +The model function is: + +\deqn{f(x) = c + \frac{d-c+f \exp(-1/x^g)}{1+\exp(b(\log(x)-\log(e)))}} + +This generalises the five-parameter \code{\link{CRS.5a}} model by estimating +the alpha exponent (parameter \eqn{g}) instead of fixing it. +} +\note{ +This function is for use with \code{\link{drm}}. +} +\seealso{ +\code{\link{CRS.5a}}, \code{\link{cedergreen}} +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/CadmiumDaphnia.Rd b/man/CadmiumDaphnia.Rd new file mode 100644 index 00000000..948b7a75 --- /dev/null +++ b/man/CadmiumDaphnia.Rd @@ -0,0 +1,42 @@ +\name{CadmiumDaphnia} + +\alias{CadmiumDaphnia} + +\docType{data} + +\title{Cadmium Daphnia Data} + +\description{ + Data from an acute toxicity test exposing \emph{Daphnia} to cadmium over time. The endpoint measured was mortality (number of dead organisms) at each dose and time point. +} + +\usage{data(CadmiumDaphnia)} + +\format{ + A data frame with 58 observations on the following 6 variables. + \describe{ + \item{\code{Dose}}{a numeric vector of dose values} + \item{\code{Time}}{a numeric vector} + \item{\code{Total}}{a numeric vector} + \item{\code{Start}}{a numeric vector} + \item{\code{End}}{a numeric vector} + \item{\code{Dead}}{a numeric vector} + } +} + +\examples{ +library(drc) + +## Displaying the data +head(CadmiumDaphnia) + +## Fitting a two-parameter log-logistic model for binomial response at a single time point +CadmiumDaphnia.sub <- CadmiumDaphnia[CadmiumDaphnia$Time == 7, ] +CadmiumDaphnia.m1 <- drm(Dead/Total ~ as.numeric(as.character(Dose)), weights = Total, +data = CadmiumDaphnia.sub, fct = LL.2(), type = "binomial") +summary(CadmiumDaphnia.m1) + +## Plotting the fitted curve +plot(CadmiumDaphnia.m1, xlab = "Cadmium dose", ylab = "Proportion dead") +} +\keyword{datasets} diff --git a/man/Cyp17.Rd b/man/Cyp17.Rd new file mode 100644 index 00000000..ad47d013 --- /dev/null +++ b/man/Cyp17.Rd @@ -0,0 +1,34 @@ +\name{Cyp17} +\alias{Cyp17} +\docType{data} +\title{Cyp17 expression data} +\description{Observed Cyp17 gene expression measured at several dose levels across multiple experimental runs. CYP17 is a key enzyme in steroid hormone biosynthesis, and changes in its expression can indicate endocrine-disrupting effects.} +\usage{data(Cyp17)} +\format{ + A data frame with 63 observations on the following 3 variables. + \describe{ + \item{\code{run}}{ID of 3 different runs} + \item{\code{dose}}{5 dose levels (0, 0.1, 10, 100, 500)} + \item{\code{expression}}{observed expression} + } +} + + +\examples{ +data(Cyp17) + +## Display the structure of the data +head(Cyp17) + +## Log-transform the expression values +Cyp17$logexpression <- log(Cyp17$expression) + 5 + +## Fit a four-parameter log-logistic model (ignoring run effects) +Cyp17.m1 <- drm(logexpression ~ dose, data = Cyp17, fct = LL.4()) +summary(Cyp17.m1) +plot(Cyp17.m1, main = "Cyp17 dose-response") +} + + + +\keyword{datasets} diff --git a/man/Daphnia.Rd b/man/Daphnia.Rd new file mode 100644 index 00000000..25fabc0b --- /dev/null +++ b/man/Daphnia.Rd @@ -0,0 +1,57 @@ +\name{Daphnia} + +\alias{Daphnia} + +\docType{data} + +\title{Daphnia} + +\description{ +Data are from a binary mixture experiment that was based on a fixed-ratio design involving 5 rays: the 2 rays for the pesticides prochloraz and alpha-cypermethrin and 3 mixture rays corresponding to virtual mixture proportions of 25:75, 50:50, and 75:25. +} + +\usage{data(Daphnia)} + +\format{ + A data frame with 140 observations on the following 6 variables. + \describe{ + \item{\code{dose.a}}{Dose of alpha-cypermethrin (mu g/L)} + \item{\code{dose.p}}{Dose of prochloraz (mu g/L)} + \item{\code{dose}}{Total dose in the mixture (mu g/L)} + \item{\code{mix.frac}}{Mixture fraction} + \item{\code{total}}{Total number of Daphnia} + \item{\code{immob48}}{Number of immobile Daphnia after 48 hours} + } +} + +\details{ +Synergistic and antagonistic effects of binary mixtures between a number of fungicides and the pyrethroid insecticide alpha-cypermethrin were investigated using a standard test system. Only data for the specific binary mixture of prochloraz and alpha-cypermethrin are provided. Data were obtained from a Daphnia acute immobilisation test where the test organisms were divided into groups of five, placed in containers, exposed to a dose (either a mixture dose or a dose from one of the two pesticides), and followed for 48h. +} + +\source{ +Data were kindly provided by N. Cedergreen. +} + +\references{ +Noergaard KB and Cedergreen N, Pesticide cocktails can interact synergistically on aquatic crustaceans. Environ Sci Pollut Res 17: 957-967 (2010). https://doi.org/10.1007/s11356-009-0284-4 + } + +\examples{ +library(drc) + +## Displaying the data +head(Daphnia) + +## Fitting a two-parameter log-logistic model for binomial response +## using mix.frac to model each mixture ray individually +Daphnia.m1 <- drm(immob48/total ~ dose, mix.frac, weights = total, +data = Daphnia, fct = LL.2(), type = "binomial") +summary(Daphnia.m1) + +## Plotting the fitted curves for each mixture fraction +plot(Daphnia.m1, xlab = "Total dose (mu g/L)", ylab = "Proportion immobile", +ylim = c(0, 1), legendPos = c(3, 0.9)) +} + +\keyword{datasets} + diff --git a/man/ED.Rd b/man/ED.Rd new file mode 100644 index 00000000..55a9e648 --- /dev/null +++ b/man/ED.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ED.drc.R +\name{ED} +\alias{ED} +\title{Estimating effective doses} +\usage{ +ED(object, ...) +} +\arguments{ +\item{object}{an object of class \code{drc}.} + +\item{...}{additional arguments passed to the method.} +} +\value{ +See \code{\link{ED.drc}} for details on the return value. +} +\description{ +S3 generic function that dispatches to the appropriate method for estimating +effective concentrations (EC) or effective doses (ED) at specified response +levels. For objects of class \code{drc}, the default method +\code{\link{ED.drc}} is called. +} +\seealso{ +\code{\link{ED.drc}} for the default method, \code{\link{EDcomp}} for estimating differences and ratios of ED +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/ED.drc.Rd b/man/ED.drc.Rd index 141b0104..6bcc0d30 100644 --- a/man/ED.drc.Rd +++ b/man/ED.drc.Rd @@ -1,123 +1,192 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ED.drc.R \name{ED.drc} - -\alias{ED} \alias{ED.drc} - \title{Estimating effective doses} - -\description{ - - \code{ED} estimates effective concentration or doses for one or more specified absolute or relative response levels. -} - \usage{ - \method{ED}{drc}(object, respLev, interval = c("none", "delta", "fls", "tfls", "inv"), - clevel = NULL, level = ifelse(!(interval == "none"), 0.95, NULL), - reference = c("control", "upper"), type = c("relative", "absolute"), lref, uref, - bound = TRUE, vcov. = vcov, display = TRUE, logBase = NULL, - multcomp = FALSE, intType = "confidence", ...) +\method{ED}{drc}( + object, + respLev = c(10, 20, 50), + interval = c("none", "delta", "fls", "tfls", "inv"), + clevel = NULL, + level = 0.95, + reference = c("control", "upper"), + type = c("relative", "absolute"), + lref, + uref, + bound = TRUE, + vcov. = vcov, + display = TRUE, + logBase = NULL, + multcomp = FALSE, + intType = "confidence", + ... +) } - \arguments{ - \item{object}{an object of class 'drc'.} - \item{respLev}{a numeric vector containing the response levels.} - \item{interval}{character string specifying the type of confidence intervals to be supplied. The default is "none". - See Details below for more explanation.} - \item{clevel}{character string specifying the curve id in case on estimates for a specific curve or compound is requested. By default estimates - are shown for all curves.} - \item{level}{numeric. The level for the confidence intervals. The default is 0.95.} - \item{reference}{character string. Is the upper limit or the control level the reference?} - \item{type}{character string. Whether the specified response levels are absolute or relative (default).} - \item{lref}{numeric value specifying the lower limit to serve as reference.} - \item{uref}{numeric value specifying the upper limit to serve as reference (e.g., 100\%).} - \item{bound}{logical. If TRUE only ED values between 0 and 100\% are allowed. FALSE is useful for hormesis models.} - \item{vcov.}{function providing the variance-covariance matrix or a variance-covariance matrix. \code{\link{vcov}} is the default, - but \code{sandwich} is also an option (for obtaining robust standard errors).} - \item{display}{logical. If TRUE results are displayed. Otherwise they are not (useful in simulations).} - \item{logBase}{numeric. The base of the logarithm in case logarithm transformed dose values are used.} - \item{multcomp}{logical to switch on output for use with the package multcomp (which needs to be activated first). Default is FALSE (corresponding to the original output).} - \item{intType}{string specifying the type of interval to use with the predict method in case the type of confidence - interval chosen with the argument "type" is "inverse regression."} - \item{...}{see the details section below.} -} +\item{object}{an object of class \code{drc}.} -\details{ - There are several options for calculating confidence intervals through the argument \code{interval}. The option "delta" results in asymptotical Wald-type confidence intervals (using the delta method and the normal or t-distribution depending on the type of response). The option "fls" produces (possibly skewed) confidence intervals through back-transformation from the logarithm scale (only meaningful in case the parameter in the model is log(ED50) as for the \code{\link{llogistic2}}) models. The option "tfls" is for transforming back and forth from log scale (experimental). The option "inv" results in confidence intervals obtained through inverse regression. - - For hormesis models (\code{\link{braincousens}} and \code{\link{cedergreen}}), the additional - arguments \code{lower} and \code{upper} may be supplied. These arguments specify the lower and upper limits - of the bisection method used to find the ED values. The lower and upper limits need to be smaller/larger - than the EDx level to be calculated. The default limits are 0.001 and 1000 for \code{braincousens} and - 0.0001 and 10000 for \code{cedergreen} and \code{\link{ucedergreen}}, but this may need to be modified - (for \code{\link{cedergreen}} the upper limit may need to be increased and for \code{\link{ucedergreen}} - the lower limit may need to be increased). Note that the lower limit should not be set to 0 (use instead - something like 1e-3, 1e-6, ...). -} +\item{respLev}{a numeric vector containing the response levels.} -\value{ - An invisible matrix containing the shown matrix with two or more columns, containing the estimates - and the corresponding estimated standard errors and possibly lower and upper confidence limits. - Or, alternatively, a list with elements that may be plugged directly into \code{parm} - in the package \emph{multcomp} (in case the argument \code{multcomp} is TRUE). -} +\item{interval}{character string specifying the type of confidence intervals +to be supplied. The default is \code{"none"}. See Details below for more +explanation.} -%\references{ ~put references to the literature/web site here ~ } -\author{Christian Ritz} +\item{clevel}{character string specifying the curve id in case estimates for +a specific curve or compound are requested. By default estimates are shown +for all curves.} -%\note{This function is only implemented for the built-in functions of class 'braincousens', 'gompertz', 'logistic' and 'mlogistic'.} +\item{level}{numeric. The level for the confidence intervals. Must be a +single value strictly between 0 and 1. The default is \code{0.95}.} -\seealso{ - \code{\link{backfit}}, \code{\link{isobole}}, and \code{\link{maED}} use \code{\link{ED}} for specific calculations involving estimated ED values. +\item{reference}{character string. Is the upper limit or the control level +the reference?} - The related function \code{\link{EDcomp}} may be used for estimating differences and ratios of ED values, - whereas \code{\link{compParm}} may be used to compare other model parameters. -} +\item{type}{character string. Whether the specified response levels are +absolute or relative (default).} -\examples{ +\item{lref}{numeric value specifying the lower limit to serve as reference.} -## Fitting 4-parameter log-logistic model -ryegrass.m1 <- drm(ryegrass, fct = LL.4()) +\item{uref}{numeric value specifying the upper limit to serve as reference +(e.g., 100\%).} -## Calculating EC/ED values -ED(ryegrass.m1, c(10, 50, 90)) -## first column: the estimates of ED10, ED50 and ED90 -## second column: the corresponding estimated standard errors +\item{bound}{logical. Default is \code{TRUE}, in which case only ED values +between 0 and 100\% are allowed. Set to \code{FALSE} for hormesis models.} -### How to use the argument 'ci' +\item{vcov.}{function providing the variance-covariance matrix, or a +variance-covariance matrix directly. \code{\link{vcov}} is the default, +but \code{sandwich} is also an option for obtaining robust standard errors.} -## Also displaying 95% confidence intervals -ED(ryegrass.m1, c(10, 50, 90), interval = "delta") +\item{display}{logical. If \code{TRUE} results are displayed. Otherwise they +are not (useful in simulations).} -## Comparing delta method and back-transformed -## confidence intervals for ED values +\item{logBase}{numeric. The base of the logarithm in case logarithm +transformed dose values are used.} -## Fitting 4-parameter log-logistic -## in different parameterisation (using LL2.4) -ryegrass.m2 <- drm(ryegrass, fct = LL2.4()) +\item{multcomp}{logical to switch on output for use with the package +\pkg{multcomp} (which needs to be activated first). Default is +\code{FALSE}.} -ED(ryegrass.m1, c(10, 50, 90), interval = "fls") -ED(ryegrass.m2, c(10, 50, 90), interval = "delta") +\item{intType}{string specifying the type of interval to use with the +predict method in case the type of confidence interval chosen is inverse +regression.} +\item{...}{additional arguments passed to the ED function in the model.} +} +\value{ +An invisible matrix containing the estimates and the corresponding +estimated standard errors and possibly lower and upper confidence limits. +Or, alternatively, a list with elements that may be plugged directly into +\code{parm} in the package \pkg{multcomp} (when \code{multcomp = TRUE}). +} +\description{ +Default method for class \code{drc}. \code{ED.drc} estimates effective +concentrations (EC) or effective doses (ED) for one or more specified +response levels. Response levels may be given as relative percentages of +the response range (e.g. ED50 = 50\\% effect) or as absolute response +values. The function computes point estimates, delta-method standard +errors, and optional confidence intervals for each combination of curve and +response level in the fitted model. +} +\details{ +The function carries out the following computational steps: + +\enumerate{ +\item \strong{Input validation.} +Arguments are checked for correct types and ranges (e.g. \code{respLev} +must be numeric, \code{level} must be in (0, 1), and relative response +levels must lie strictly inside the interval (0, 100) when +\code{bound = TRUE}). + +\item \strong{Model component extraction.} +The model-specific ED function (\code{edfct}), parameter matrix +(\code{parmMat}), and index matrix (\code{indexMat}) are retrieved from +the fitted \code{drc} object. The variance-covariance matrix is +obtained from \code{vcov.}, which may be a function (e.g. +\code{\link{vcov}} or \code{sandwich::vcovHC}) or a pre-computed matrix. + +\item \strong{Curve ordering.} +When multiple curves are present, they are sorted alphabetically by +name, unless the names are purely numeric, in which case the original +order is preserved. + +\item \strong{ED estimation and delta-method standard errors.} +For each curve and each requested response level, the model-specific +\code{edfct} is called to obtain the ED point estimate and its +analytical gradient with respect to the model parameters. Standard +errors are then computed via the delta method: +\eqn{SE = \sqrt{g' V g}}{SE = sqrt(g' V g)}, where \eqn{g} is the +gradient vector and \eqn{V} is the relevant sub-matrix of the +variance-covariance matrix. + +\item \strong{Numerical gradient for absolute responses.} +When \code{type = "absolute"}, the analytical gradient returned by the +model may miss the chain-rule contribution from the asymptote parameters +involved in converting absolute to relative response levels. In that +case a numerical central-difference gradient is computed to ensure +correct standard errors. + +\item \strong{Log-base back-transformation.} +If \code{logBase} is specified (indicating that dose values were +log-transformed prior to model fitting), the ED estimates and their +derivatives are back-transformed via \eqn{ED^* = b^{ED}}{ED* = b^ED} +(where \eqn{b} is the log base) so that results are reported on the +original dose scale. + +\item \strong{Confidence interval construction.} +Depending on \code{interval}: +\describe{ +\item{\code{"delta"}}{Asymptotic Wald-type intervals using the delta +method, based on the normal or t-distribution (depending on the +response type).} +\item{\code{"fls"}}{Intervals obtained by back-transforming from the +log scale. Only meaningful when the model parameterises the ED on +the log scale (e.g. \code{\link{llogistic2}}).} +\item{\code{"tfls"}}{Experimental: intervals obtained by transforming +to the log scale, computing Wald intervals there, then +back-transforming.} +\item{\code{"inv"}}{Intervals derived from inverse regression via +\code{\link[=EDinvreg]{EDinvreg}}, where confidence limits on the +predicted response are inverted to the dose axis.} +} -### How to use the argument 'bound' +\item \strong{Output.} +Results are returned as an invisible matrix with columns for the +estimate, standard error, and (optionally) lower and upper confidence +limits. When \code{multcomp = TRUE}, a list compatible with +\code{\link[multcomp]{parm}} is returned instead, enabling +multiple-comparison procedures. +} -## Fitting the Brain-Cousens model -lettuce.m1 <- drm(weight ~ conc, -data = lettuce, fct = BC.4()) +For hormesis models (\code{\link{braincousens}} and +\code{\link{cedergreen}}), the additional arguments \code{lower} and +\code{upper} may be supplied. These arguments specify the lower and upper +limits of the bisection method used to find the ED values. +} +\examples{ +## Fitting a 4-parameter log-logistic model +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) -### Calculating ED[-10] +## Calculating EC/ED values +ED(ryegrass.m1, c(10, 50, 90)) -# This does not work -#ED(lettuce.m1, -10) +## Displaying 95\% confidence intervals using the delta method +ED(ryegrass.m1, c(10, 50, 90), interval = "delta") -## Now it does work -ED(lettuce.m1, -10, bound = FALSE) # works -ED(lettuce.m1, -20, bound = FALSE) # works +## Displaying 95\% confidence intervals using back-transformation +ED(ryegrass.m1, c(10, 50, 90), interval = "fls") -## The following does not work for another reason: ED[-30] does not exist -#ED(lettuce.m1, -30, bound = FALSE) +## Displaying 95\% confidence intervals using inverse regression +ED(ryegrass.m1, c(10, 50, 90), interval = "inv") } - +\seealso{ +\code{\link{EDcomp}} for estimating differences and ratios of ED +values, \code{\link{compParm}} for comparing other model parameters, and +\code{\link{backfit}}. +} +\author{ +Christian Ritz +} \keyword{models} \keyword{nonlinear} diff --git a/man/ED.lin.Rd b/man/ED.lin.Rd new file mode 100644 index 00000000..d3e14dcd --- /dev/null +++ b/man/ED.lin.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ED.lin.R +\name{ED.lin} +\alias{ED.lin} +\title{ED calculation for linear models} +\usage{ +\method{ED}{lin}(object, respLev, ...) +} +\description{ +ED calculation for linear models +} +\keyword{internal} diff --git a/man/ED_robust.Rd b/man/ED_robust.Rd new file mode 100644 index 00000000..23a6fcc7 --- /dev/null +++ b/man/ED_robust.Rd @@ -0,0 +1,58 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ED_robust.R +\name{ED_robust} +\alias{ED_robust} +\title{Robust Calculation of Effective Doses (ED)} +\usage{ +ED_robust( + mod, + respLev = c(10, 20, 50), + interval = get_ed_interval(mod$fct$name, small_n = TRUE), + CI_level = 0.95, + verbose = FALSE, + ... +) +} +\arguments{ +\item{mod}{An object of class 'drc', representing the fitted dose-response model.} + +\item{respLev}{A numeric vector specifying the response levels for which to +calculate ED values (e.g., \code{c(10, 50)} for ED10 and ED50).} + +\item{interval}{A character string specifying the method for calculating +confidence intervals. Defaults to the output of \code{get_ed_interval()}. +Common options include "delta", "tfls", or "buckland".} + +\item{CI_level}{A numeric value between 0 and 1 indicating the confidence +level for the intervals (e.g., 0.95 for a 95\% CI).} + +\item{verbose}{A logical value. If \code{TRUE}, the function will print status +messages about the calculation progress and any errors encountered for each +response level. Default is \code{FALSE}.} + +\item{...}{Additional arguments to be passed directly to \code{drc::ED}.} +} +\value{ +A \code{data.table} where each row corresponds to a requested response level. +The table includes the ED estimate, standard error, confidence interval +(Lower, Upper), and metadata about the calculation (confidence level, method, +model name, and EC level). Rows for non-estimable EDs are populated with \code{NA}. +} +\description{ +This function serves as a robust wrapper for \code{drc::ED}. It calculates +effective doses (EDs) for multiple specified response levels. Its primary +feature is the ability to gracefully handle cases where an ED value is not +mathematically estimable from the model (e.g., the requested response is +outside the model's asymptotes). Instead of throwing an error, it returns a +row of \code{NA} values for that specific response level, ensuring the overall +analysis can proceed. +} +\examples{ +data(lettuce) +m <- drm(weight ~ conc, data = lettuce, fct = BC.4()) +ED_robust(m, respLev = c(10, 50), CI_level = 0.95) + +} +\author{ +Hannes Reinwald +} diff --git a/man/EDcomp.Rd b/man/EDcomp.Rd index ea24b8b2..8eeb4036 100644 --- a/man/EDcomp.Rd +++ b/man/EDcomp.Rd @@ -1,154 +1,99 @@ -\name{EDcomp} - -\alias{EDcomp} -\alias{relpot} - -\title{Comparison of relative potencies between dose-response curves} - -\description{ - Relative potencies (also called selectivity indices) for arbitrary doses are compared between - fitted dose-response curves. -} - -\usage{ - EDcomp(object, percVec, percMat = NULL, compMatch = NULL, od = FALSE, vcov. = vcov, - reverse = FALSE, - interval = c("none", "delta", "fieller", "fls"), - level = ifelse(!(interval == "none"), 0.95, NULL), - reference = c("control", "upper"), - type = c("relative", "absolute"), - display = TRUE, pool = TRUE, logBase = NULL, - multcomp = FALSE, ...) - - relpot(object, plotit = TRUE, compMatch = NULL, percVec = NULL, interval = "none", - type = c("relative", "absolute"), - scale = c("original", "percent", "unconstrained"), ...) -} - -\arguments{ - \item{object}{an object of class 'drc'.} - \item{percVec}{a numeric vector of dosage values.} - \item{percMat}{a matrix with 2 columns providing the pairs of indices \code{percVec} to be compared. - By default all pairs are compared.} - \item{compMatch}{an optional character vector of names of assays to be compared. If not specified all comparisons are supplied.} - \item{od}{logical. If TRUE adjustment for over-dispersion is used. This argument only makes a difference for - binomial data.} - \item{vcov.}{function providing the variance-covariance matrix. \code{\link{vcov}} is the default, - but \code{sandwich} is also an option (for obtaining robust standard errors).} - \item{reverse}{logical. If TRUE the order of comparison of two curves is reversed.} - \item{interval}{character string specifying the type of confidence intervals to be supplied. The default is "none". - Use "delta" for asymptotics-based confidence intervals (using the delta method and the t-distribution). - Use "fieller" for confidence intervals based on Fieller's theorem (with help from the delta method). - Use "fls" for confidence interval back-transformed from logarithm scale (in case the parameter in the model fit is - log(ED50) as is the case for the \code{\link{logistic}} or \code{\link{llogistic2}} models); currently - the argument \code{logBase} then also needs to be specified.} - \item{level}{numeric. The level for the confidence intervals. Default is 0.95.} - \item{reference}{character string. Is the upper limit or the control level the reference?} - \item{type}{character string specifying whether absolute or relative response levels are supplied.} - \item{logBase}{numeric. The base of the logarithm in case logarithm transformed dose values are used.} - \item{display}{logical. If TRUE results are displayed. Otherwise they are not (useful in simulations).} - \item{pool}{logical. If TRUE curves are pooled. Otherwise they are not. This argument only works for models with - independently fitted curves as specified in \code{\link{drm}}.} - \item{multcomp}{logical to switch on output for use with the package multcomp (which needs to be activated first). Default is FALSE (corresponding to the original output).} - \item{...}{In \code{SI}: additional arguments to the function doing the calculations. - For instance the upper limit for the bisection method - needs to be larger than the ED values used in the required relative pontency. - In \code{relpot}: additional graphical parameters.} - \item{plotit}{logical. If TRUE the relative potencies are plotted as a function of the response level.} - \item{scale}{character string indicating the scale to be used on the x axis: original or percent response level - (only having an effect for type="relative").} -} - -\details{ - The function \code{relpot} is a convenience function, which is useful for assessing how the relative potency - changes as a function of the response level (e.g., for plotting as outlined by Ritz \emph{et al} (2006)). - - Fieller's theorem is incorporated using the formulas provided by Kotz and Johnson (1983) and Finney (1978). - - For objects of class 'braincousens' or 'mlogistic' the additional argument may be the 'upper' argument - or the 'interval' argument. The 'upper' argument specifies the upper limit of the bisection method. - The upper limits needs to be larger than the EDx level to be calculated. The default limit is 1000. - The 'interval' argument should specify a rough interval in which the dose - yielding the maximum hormetical response lies. The default interval is 'c(0.001, 1000)'. - Notice that the lower limit should not be set to 0 (use something like 1e-3, 1e-6, ...). -} - -\value{ - An invisible matrix containing the shown matrix with two or more columns, containing the estimates - and the corresponding estimated standard errors and possibly lower and upper confidence limits. - Or, alternatively, a list with elements that may be plugged directly into \code{parm} - in the package \emph{multcomp} (in case the argument \code{multcomp} is TRUE). -} - -\references{ - Finney, D. J. (1978) \emph{Statistical method in Biological Assay}, London: Charles Griffin House, - 3rd edition (pp. 80--82). - - Kotz, S. and Johnson, N. L. (1983) \emph{Encyclopedia of Statistical Sciences Volume 3}, - New York: Wiley \& Sons (pp. 86--87). - - Ritz, C. and Cedergreen, N. and Jensen, J. E. and Streibig, J. C. (2006) - Relative potency in nonsimilar dose-response curves, \emph{Weed Science}, \bold{54}, 407--412. -} - -\author{Christian Ritz} - -\note{ - This function only works for the following built-in functions available in the package \emph{drc}: - \code{\link{braincousens}}, \code{\link{cedergreen}}, \code{\link{ucedergreen}}, \code{\link{llogistic}}, - and \code{\link{weibull1}}. -} - -\seealso{ - A related function is \code{\link{ED.drc}} (used for calculating effective doses). -} - -\examples{ - -spinach.LL.4 <- drm(SLOPE~DOSE, CURVE, data = spinach, fct = LL.4()) - -EDcomp(spinach.LL.4, c(50,50)) -EDcomp(spinach.LL.4, c(10,50)) -EDcomp(spinach.LL.4, c(10,50), reverse = TRUE) - -## Using the package multcomp -#sires <- SI(spinach.LL.4, c(25, 50, 75)) -#library(multcomp) -#summary(glht(parm(sires[[2]][[1]], sires[[2]][[2]]), rhs = 1)) - -## Comparing specific ratios: 25/25, 50/50, 75/75 -#sires2 <- SI(spinach.LL.4, c(25, 50, 75), matrix(c(1, 1, 2, 2, 3, 3), 3, 2, byrow = TRUE)) -#library(multcomp) -#summary(glht(parm(sires2[[2]][[1]], sires2[[2]][[2]]), rhs = 1)) - - -## Relative potency of two herbicides -m2 <- drm(DryMatter~Dose, Herbicide, -data = S.alba, fct = LL.3()) - -EDcomp(m2, c(50, 50)) -EDcomp(m2, c(50, 50), interval = "delta") -EDcomp(m2, c(50, 50), interval = "fieller") - -## Comparison based on an absolute -## response level - -m3 <- drm(SLOPE~DOSE, CURVE, -data = spinach, fct = LL.4()) - -EDcomp(m3, c(0.5,0.5), compMatch = c(2,4), type = "absolute", interval = "fieller") - -EDcomp(m3, c(55,80), compMatch = c(2,4)) -# same comparison using a relative response level - - -## Relative potency transformed from log scale -m4 <- drm(drymatter~log(dose), treatment, data=G.aparine[-c(1:40), ], -pmodels = data.frame(treatment,treatment,1,treatment), fct = LL2.4()) - -EDcomp(m4, c(50,50), interval = "fls", logBase = exp(1)) - -} - -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/EDcomp.R +\name{EDcomp} +\alias{EDcomp} +\title{Comparison of relative potencies between dose-response curves} +\usage{ +EDcomp( + object, + percVec, + percMat = NULL, + compMatch = NULL, + od = FALSE, + vcov. = vcov, + reverse = FALSE, + interval = c("none", "delta", "fieller", "fls"), + level = ifelse(!(interval == "none"), 0.95, NULL), + reference = c("control", "upper"), + type = c("relative", "absolute"), + display = TRUE, + pool = TRUE, + logBase = NULL, + multcomp = FALSE, + ... +) +} +\arguments{ +\item{object}{an object of class 'drc'.} + +\item{percVec}{a numeric vector of dosage values.} + +\item{percMat}{a matrix with 2 columns providing the pairs of indices of \code{percVec} to be +compared. By default all pairs are compared.} + +\item{compMatch}{an optional character vector of names of assays to be compared. If not specified +all comparisons are supplied.} + +\item{od}{logical. If TRUE adjustment for over-dispersion is used. This argument only makes a +difference for binomial data.} + +\item{vcov.}{function providing the variance-covariance matrix. \code{\link{vcov}} is the default, +but \code{sandwich} is also an option (for obtaining robust standard errors).} + +\item{reverse}{logical. If TRUE the order of comparison of two curves is reversed.} + +\item{interval}{character string specifying the type of confidence intervals to be supplied. +The default is \code{"none"}. Use \code{"delta"} for asymptotics-based confidence intervals, +\code{"fieller"} for confidence intervals based on Fieller's theorem, or \code{"fls"} for +confidence intervals back-transformed from logarithm scale.} + +\item{level}{numeric. The level for the confidence intervals. Default is 0.95.} + +\item{reference}{character string. Is the upper limit or the control level the reference?} + +\item{type}{character string specifying whether absolute or relative response levels are supplied.} + +\item{display}{logical. If TRUE results are displayed. Otherwise they are not (useful in simulations).} + +\item{pool}{logical. If TRUE curves are pooled. Otherwise they are not. This argument only works +for models with independently fitted curves as specified in \code{\link{drm}}.} + +\item{logBase}{numeric. The base of the logarithm in case logarithm transformed dose values are used.} + +\item{multcomp}{logical to switch on output for use with the package \pkg{multcomp}. Default is FALSE.} + +\item{...}{additional arguments passed to the function doing the calculations.} +} +\value{ +An invisible matrix containing the estimates and the corresponding estimated standard +errors and possibly lower and upper confidence limits. Or, alternatively, a list with elements +that may be plugged directly into \code{parm} in the package \pkg{multcomp} (when \code{multcomp} +is TRUE). +} +\description{ +Relative potencies (also called selectivity indices) for arbitrary doses are compared between +fitted dose-response curves. +} +\details{ +Fieller's theorem is incorporated using the formulas provided by Kotz and Johnson (1983) and +Finney (1978). + +For objects of class 'braincousens' or 'mlogistic' the additional argument may be the 'upper' +argument or the 'interval' argument specifying limits for the bisection method. +} +\examples{ +spinach.LL.4 <- drm(SLOPE~DOSE, CURVE, data = spinach, fct = LL.4()) + +EDcomp(spinach.LL.4, c(50, 50)) +EDcomp(spinach.LL.4, c(10, 50)) +EDcomp(spinach.LL.4, c(10, 50), reverse = TRUE) + +} +\seealso{ +\code{\link{ED.drc}} for calculating effective doses. +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/EDhelper.Rd b/man/EDhelper.Rd new file mode 100644 index 00000000..a72462d5 --- /dev/null +++ b/man/EDhelper.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/EDhelper.R +\name{EDhelper} +\alias{EDhelper} +\title{Helper function for ED calculations} +\usage{ +EDhelper(parmVec, respl, reference, typeCalc, cond = TRUE) +} +\description{ +Helper function for ED calculations +} +\keyword{internal} diff --git a/man/EDinvreg.Rd b/man/EDinvreg.Rd new file mode 100644 index 00000000..26686a01 --- /dev/null +++ b/man/EDinvreg.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/EDinvreg.R +\name{EDinvreg} +\alias{EDinvreg} +\title{Inverse regression for ED estimation} +\usage{ +EDinvreg( + object, + respLev, + catLev = NA, + intType = "confidence", + level, + type, + extFactor = 10 +) +} +\description{ +Inverse regression for ED estimation +} +\keyword{internal} diff --git a/man/EXD.2.Rd b/man/EXD.2.Rd new file mode 100644 index 00000000..2fe51753 --- /dev/null +++ b/man/EXD.2.Rd @@ -0,0 +1,51 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/weibull1.R +\name{EXD.2} +\alias{EXD.2} +\title{Two-parameter exponential decay model} +\usage{ +EXD.2(fixed = c(NA, NA), names = c("d", "e"), ...) +} +\arguments{ +\item{fixed}{numeric vector of length 2. Specifies which parameters are +fixed and at what value. Use \code{NA} for parameters that are not fixed.} + +\item{names}{character vector of length 2 giving the names of the +parameters. The default is \code{c("d", "e")}.} + +\item{\dots}{additional arguments passed to \code{\link{weibull1}}, most +notably \code{method} (a character string: \code{"1"} (default), +\code{"2"}, \code{"3"}, or \code{"4"}) which selects the self-starter +method for obtaining starting values. See \code{\link{weibull1}} for +details.} +} +\value{ +A list of class \code{Weibull-1} containing the nonlinear function, +self starter function, and parameter names. +} +\description{ +A two-parameter exponential decay model with the slope parameter \code{b} +fixed at 1 and the lower limit fixed at 0. +} +\details{ +The model is given by the expression +\deqn{f(x) = d \exp(-x/e)} + +This is a special case of the Weibull type 1 model +(\code{\link{weibull1}}) with the slope fixed at 1 and the lower limit +fixed at 0. +} +\examples{ +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = EXD.2()) + +} +\references{ +Seber, G. A. F. and Wild, C. J. (1989) +\emph{Nonlinear Regression}, New York: Wiley & Sons (pp. 338--339). +} +\seealso{ +\code{\link{EXD.3}}, \code{\link{AR.2}}, \code{\link{AR.3}}, +\code{\link{weibull1}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/EXD.3.Rd b/man/EXD.3.Rd new file mode 100644 index 00000000..6178acb4 --- /dev/null +++ b/man/EXD.3.Rd @@ -0,0 +1,50 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/weibull1.R +\name{EXD.3} +\alias{EXD.3} +\title{Three-parameter exponential decay model} +\usage{ +EXD.3(fixed = c(NA, NA, NA), names = c("c", "d", "e"), ...) +} +\arguments{ +\item{fixed}{numeric vector of length 3. Specifies which parameters are +fixed and at what value. Use \code{NA} for parameters that are not fixed.} + +\item{names}{character vector of length 3 giving the names of the +parameters. The default is \code{c("c", "d", "e")}.} + +\item{\dots}{additional arguments passed to \code{\link{weibull1}}, most +notably \code{method} (a character string: \code{"1"} (default), +\code{"2"}, \code{"3"}, or \code{"4"}) which selects the self-starter +method for obtaining starting values. See \code{\link{weibull1}} for +details.} +} +\value{ +A list of class \code{Weibull-1} containing the nonlinear function, +self starter function, and parameter names. +} +\description{ +A three-parameter exponential decay model with the slope parameter \code{b} +fixed at 1. +} +\details{ +The model is given by the expression +\deqn{f(x) = c + (d - c) \exp(-x/e)} + +This is a special case of the Weibull type 1 model +(\code{\link{weibull1}}) with the slope fixed at 1. +} +\examples{ +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = EXD.3()) + +} +\references{ +Seber, G. A. F. and Wild, C. J. (1989) +\emph{Nonlinear Regression}, New York: Wiley & Sons (pp. 338--339). +} +\seealso{ +\code{\link{EXD.2}}, \code{\link{AR.2}}, \code{\link{AR.3}}, +\code{\link{weibull1}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/EXD.Rd b/man/EXD.Rd deleted file mode 100644 index af1397f1..00000000 --- a/man/EXD.Rd +++ /dev/null @@ -1,66 +0,0 @@ -\name{EXD} - -\alias{EXD.2} -\alias{EXD.3} - -\title{Exponential decay model} - -\description{ - Exponential decay model with or without a nonzero lower limit. -} - -\usage{ - EXD.2(fixed = c(NA, NA), names = c("d", "e"), ...) - - EXD.3(fixed = c(NA, NA, NA), names = c("c", "d", "e"), ...) -} - -\arguments{ - \item{fixed}{numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.} - \item{names}{vector of character strings giving the names of the parameters (should not contain ":"). - The default parameter names are: init, plateau, k.} - \item{...}{additional arguments to be passed from the convenience functions.} -} - -\details{ - The exponential decay model is a three-parameter model with mean function: - - \deqn{f(x) = c + (d-c)(\exp(-x/e))} - - The parameter init is the upper limit (attained at \eqn{x=0}), the parameter plateau is the lower limit - reached for x going to infinity and the parameter \eqn{e>0} is determining the steepness of the - decay. The curve is monotonously decreasing in \eqn{x}. -} - -\value{ - A list of class \code{drcMean}, containing the mean function, the self starter function, - the parameter names and other components such as derivatives and a function for calculating ED values. -} - -\references{ - Organisation for Economic Co-operation and Development (OECD) (2006) - \emph{Current approaches in the statistical analysis of ecotoxicity data: A guidance to application - annexes}, - Paris: OECD (p. 80). -} - -\author{Christian Ritz} - -%\note{} - -\seealso{ - Similar models giving exponential increasing curves are \code{\link{AR.2}} and \code{\link{AR.3}}. -} - -\examples{ - -## Fitting an exponential decay model -ryegrass.m1<-drm(rootl~conc, data=ryegrass, fct=EXD.3()) - -plot(ryegrass.m1) - -summary(ryegrass.m1) - -} -\keyword{models} -\keyword{nonlinear} diff --git a/man/Eryngium.sparganophyllum.Rd b/man/Eryngium.sparganophyllum.Rd new file mode 100644 index 00000000..99706203 --- /dev/null +++ b/man/Eryngium.sparganophyllum.Rd @@ -0,0 +1,45 @@ +\name{Eryngium.sparganophyllum} +\alias{Eryngium.sparganophyllum} +\alias{Eryngium.sparganophyllum0} + +\docType{data} + +\title{Germination of Eryngium sparganophyllum} + +\description{Germination data from an experiments investigating the effect of different concentration of gibberellic acid on germination of Eryngium sparganophyllum seeds. Two datasets are provided: one resembling how data are entered in the first place ("Eryngium.sparganophyllum0") and one formatted and ready-to-use for the statistical analysis ("Eryngium.sparganophyllum")} + +\usage{Eryngium.sparganophyllum} + +\format{ + A data frame with 583 observations on the following variables. + \describe{ + \item{\code{Treat}}{a factor with 15 levels denoting the concentration of gibberellic acid (in ppm)} + \item{\code{Type}}{a factor with two levels denoting the type of treatment (gibberellic acid or temperature)} + \item{\code{Day}}{a numeric vector recording time (in days) since the beginning of the experiment} + \item{\code{Germ}}{a numeric vector of counts of germinated seeds} + \item{\code{Start}}{a numeric vector of starting time points of monitoring intervals} + \item{\code{End}}{a numeric vector of ending time points of monitoring intervals} + \item{\code{Germinated}}{a numeric vector of counts of germinated seeds in a given interval} + \item{\code{Rep}}{a numeric vector corresponding to the replicated sub-experiments; it is only a unique enumeration for the dataset "Eryngium.sparganophyllum"} + } +} + +\references{ +Wolkis, D., Blackwell, S., Kaninaualiʻi Villanueva, S. (2020). Conservation seed physiology of the ciénega endemic, Eryngium sparganophyllum (Apiaceae). Conservation Physiology, 8, coaa017. https://doi.org/10.1093/conphys/coaa017 +} + +\examples{ +library(drc) + +## Displaying the data +head(Eryngium.sparganophyllum) + +## Fitting an event-time model for germination +Eryngium.m1 <- drm(Germinated ~ Start + End, data = Eryngium.sparganophyllum, +fct = LL.3(), type = "event") +summary(Eryngium.m1) + +## Plotting the fitted germination curve +plot(Eryngium.m1, xlab = "Time (days)", ylab = "Proportion germinated", log = "") +} +\keyword{datasets} diff --git a/man/FPL.4.Rd b/man/FPL.4.Rd new file mode 100644 index 00000000..65cdf03c --- /dev/null +++ b/man/FPL.4.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fplogistic.R +\name{FPL.4} +\alias{FPL.4} +\title{Four-parameter fractional polynomial-logistic model} +\usage{ +FPL.4(p1, p2, fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) +} +\arguments{ +\item{p1}{numeric denoting the negative power of log(dose+1) in the fractional polynomial.} + +\item{p2}{numeric denoting the positive power of log(dose+1) in the fractional polynomial.} + +\item{fixed}{numeric vector of length 4 specifying fixed parameters (NAs for free parameters).} + +\item{names}{character vector of parameter names.} + +\item{...}{additional arguments passed to \code{\link{fplogistic}}.} +} +\value{ +A list (see \code{\link{fplogistic}}). +} +\description{ +Convenience function for the four-parameter fractional polynomial-logistic model. +} +\seealso{ +\code{\link{fplogistic}}, \code{\link{maED}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/G.2.Rd b/man/G.2.Rd new file mode 100644 index 00000000..9be53a68 --- /dev/null +++ b/man/G.2.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gompertz.R +\name{G.2} +\alias{G.2} +\title{Two-parameter Gompertz model} +\usage{ +G.2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) +} +\arguments{ +\item{upper}{numeric specifying the fixed upper horizontal asymptote. Default is 1.} + +\item{fixed}{numeric vector of length 2 specifying fixed parameters (NAs for free parameters).} + +\item{names}{character vector of parameter names.} + +\item{...}{additional arguments passed to \code{\link{gompertz}}.} +} +\value{ +A list (see \code{\link{gompertz}}). +} +\description{ +Convenience function for the Gompertz model with lower limit fixed at 0 and upper limit fixed. +} +\seealso{ +\code{\link{gompertz}}, \code{\link{G.3}}, \code{\link{G.4}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/G.3.Rd b/man/G.3.Rd new file mode 100644 index 00000000..9ee537f1 --- /dev/null +++ b/man/G.3.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gompertz.R +\name{G.3} +\alias{G.3} +\title{Three-parameter Gompertz model} +\usage{ +G.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) +} +\arguments{ +\item{fixed}{numeric vector of length 3 specifying fixed parameters (NAs for free parameters).} + +\item{names}{character vector of parameter names.} + +\item{...}{additional arguments passed to \code{\link{gompertz}}.} +} +\value{ +A list (see \code{\link{gompertz}}). +} +\description{ +Convenience function for the Gompertz model with the lower limit fixed at 0. +} +\seealso{ +\code{\link{gompertz}}, \code{\link{G.2}}, \code{\link{G.4}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/G.3u.Rd b/man/G.3u.Rd new file mode 100644 index 00000000..1a400e17 --- /dev/null +++ b/man/G.3u.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gompertz.R +\name{G.3u} +\alias{G.3u} +\title{Three-parameter Gompertz model with upper limit fixed} +\usage{ +G.3u(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...) +} +\arguments{ +\item{upper}{numeric specifying the fixed upper horizontal asymptote. Default is 1.} + +\item{fixed}{numeric vector of length 3 specifying fixed parameters (NAs for free parameters).} + +\item{names}{character vector of parameter names.} + +\item{...}{additional arguments passed to \code{\link{gompertz}}.} +} +\value{ +A list (see \code{\link{gompertz}}). +} +\description{ +Convenience function for the Gompertz model with the upper limit fixed. +} +\seealso{ +\code{\link{gompertz}}, \code{\link{G.2}}, \code{\link{G.3}}, \code{\link{G.4}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/G.4.Rd b/man/G.4.Rd new file mode 100644 index 00000000..9fd5e317 --- /dev/null +++ b/man/G.4.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gompertz.R +\name{G.4} +\alias{G.4} +\title{Four-parameter Gompertz model} +\usage{ +G.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) +} +\arguments{ +\item{fixed}{numeric vector of length 4 specifying fixed parameters (NAs for free parameters).} + +\item{names}{character vector of parameter names.} + +\item{...}{additional arguments passed to \code{\link{gompertz}}.} +} +\value{ +A list (see \code{\link{gompertz}}). +} +\description{ +Convenience function for the full four-parameter Gompertz model. +} +\seealso{ +\code{\link{gompertz}}, \code{\link{G.2}}, \code{\link{G.3}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/G.aparine.Rd b/man/G.aparine.Rd new file mode 100644 index 00000000..27cb504a --- /dev/null +++ b/man/G.aparine.Rd @@ -0,0 +1,84 @@ +\name{G.aparine} + +\alias{G.aparine} + +\docType{data} + +\title{Herbicide applied to Galium aparine} + +\description{ + Small plants of \emph{Galium aparine}, growing in pots in a green house, were sprayed with the technical + grade phenmidipham herbicide either alone or in mixture with an ester of oleic acid. + The plants were allowed to grow in the green house for 14 days after herbicide treatment. + Then the dry matter was measured per pot. +} + +\usage{data(G.aparine)} + +\format{ + A data frame with 240 observations on the following 3 variables. + \describe{ + \item{\code{dose}}{a numeric vector of dose value (g/ha)} + \item{\code{drymatter}}{a numeric vector of dry matter weights (mg/pot)} + \item{\code{treatment}}{a numeric vector giving the grouping: 0: control, 1,2: herbicide formulations} + } +} + +%\details{} + +\source{ + Cabanne, F., Gaudry, J. C. and Streibig, J. C. (1999) Influence of alkyl oleates on efficacy + of phenmedipham applied as an acetone:water solution on Galium aparine, + \emph{Weed Research}, \bold{39}, 57--67. +} + +%\references{} + +\examples{ +library(drc) + +## Fitting a model with a common control (so a single upper limit: "1") +G.aparine.m1 <- drm(drymatter ~ dose, treatment, data = G.aparine, +pmodels = data.frame(treatment, treatment, 1, treatment), fct = LL.4()) + +## Visual inspection of fit +plot(G.aparine.m1, broken = TRUE) + +## Lack of fit test +modelFit(G.aparine.m1) + +## Summary output +summary(G.aparine.m1) + +## Predicted values with se and confidence intervals +#predict(G.aparine.m1, interval = "confidence") +# long output + +## Calculating the relative potency +EDcomp(G.aparine.m1, c(50,50)) + +## Showing the relative potency as a +## function of the response level +relpot(G.aparine.m1) +relpot(G.aparine.m1, interval = "delta") +# appears constant! + +## Response level in percent +relpot(G.aparine.m1, scale = "percent") + +## Fitting a reduced model (with a common slope parameter) +G.aparine.m2 <- drm(drymatter ~ dose, treatment, data = G.aparine, +pmodels = data.frame(1, treatment, 1, treatment), fct = LL.4()) + +anova(G.aparine.m2, G.aparine.m1) + +## Showing the relative potency +relpot(G.aparine.m2) + +## Fitting the same model in a different parameterisation +G.aparine.m3 <- drm(drymatter ~ dose, treatment, data = G.aparine, +pmodels = data.frame(treatment, treatment, 1, treatment), fct = LL2.4()) + +EDcomp(G.aparine.m3, c(50, 50), logBase = exp(1)) +} +\keyword{datasets} diff --git a/man/GiantKelp.Rd b/man/GiantKelp.Rd new file mode 100644 index 00000000..b0cf82c5 --- /dev/null +++ b/man/GiantKelp.Rd @@ -0,0 +1,43 @@ +\name{GiantKelp} + +\alias{GiantKelp} + +\docType{data} + +\title{Measurements of germination tubes for Giant Kelp} + +\description{ + Giant kelp, \emph{Macrocystis pyrifera}, was exposed to 8 different concentrations of copper and the response measured was the length of the germination tube. +} + +\usage{data(GiantKelp)} + +\format{ + A data frame with 39 observations of the following 2 variables. + \describe{ + \item{\code{dose}}{a numeric vector} + \item{\code{tubeLength}}{a numeric vector giving the length of the germination tube (mm)} + } +} + +\source{ +G. A. Chapman, D. L. Denton, and J. M. Lazorchak (1995). Short-term methods for estimating +the chronic toxicity of effluents and receiving waters to west coast marine and estuarine +organisms. +} + + +\examples{ +library(drc) + +## Displaying the data +head(GiantKelp) + +## Fitting a four-parameter log-logistic model +GiantKelp.m1 <- drm(tubeLength ~ dose, data = GiantKelp, fct = LL.4()) +summary(GiantKelp.m1) + +## Plotting the fitted curve +plot(GiantKelp.m1, xlab = "Copper concentration", ylab = "Tube length (mm)") +} +\keyword{datasets} diff --git a/man/H.virescens.Rd b/man/H.virescens.Rd new file mode 100644 index 00000000..92405944 --- /dev/null +++ b/man/H.virescens.Rd @@ -0,0 +1,57 @@ +\name{H.virescens} + +\alias{H.virescens} + +\docType{data} + +\title{Mortality of tobacco budworms} + +\description{ + For three days, moths of the tobacco budworm (\emph{Heliothis virescens}) were exposed + to doses of the pyrethroid trans-cypermethrin. +} + +\usage{data(H.virescens)} + +\format{ + A data frame with 12 observations on the following 4 variables. + \describe{ + \item{\code{dose}}{a numeric vector of dose values (\eqn{\mu g})} + \item{\code{numdead}}{a numeric vector of dead or knocked-down moths} + \item{\code{total}}{a numeric vector of total number of moths} + \item{\code{sex}}{a factor with levels \code{F} \code{M} denoting a grouping according to sex} + } +} + +\details{ + In Venables and Ripley (2002), these data are analysed using a logistic regression with base-2 logarithm of dose + as explanatory variable. +} + +\source{ + Venables, W. N. and Ripley, B. D (2002) \emph{Modern Applied Statistics with S}, New York: Springer (fourth edition). +} + +%\references{} + +\examples{ +library(drc) + +## Fitting dose-response model (log-logistic with common slope) +Hv.m1 <- drm(numdead/total~dose, sex, weights = total, data = H.virescens, fct = LL.2(), +pmodels = list(~ 1, ~ sex - 1), type = "binomial") +summary(Hv.m1) + +## Fitting the same model as in Venables and Riply (2002) +Hv.m2 <- glm(cbind(numdead, total-numdead) ~ sex + I(log2(dose)) - 1, data = H.virescens, +family = binomial) + +## Comparing the fits +logLik(Hv.m1) +logLik(Hv.m2) + +## Estimated ED values (matching those given in MASS) +ED(Hv.m1, c(25, 50, 75)) + +} +\keyword{datasets} diff --git a/man/L.3.Rd b/man/L.3.Rd new file mode 100644 index 00000000..99243b25 --- /dev/null +++ b/man/L.3.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/logistic.R +\name{L.3} +\alias{L.3} +\title{Three-parameter logistic model} +\usage{ +L.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) +} +\arguments{ +\item{fixed}{numeric vector of length 3. Specifies which parameters are fixed +and at what value they are fixed. \code{NA} indicates that the corresponding +parameter is not fixed.} + +\item{names}{character vector of length 3 giving the names of the parameters +\code{(b, d, e)}. Default is \code{c("b", "d", "e")}.} + +\item{...}{additional arguments passed to \code{\link{logistic}}.} +} +\value{ +A list of class \code{"Boltzmann"} containing the nonlinear function, +self starter function, and parameter names. +} +\description{ +A three-parameter logistic model with the lower limit fixed at 0, given by +\deqn{f(x) = \frac{d}{1 + \exp(b(x - e))}} +} +\examples{ +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = L.3()) +} +\seealso{ +\code{\link{logistic}}, \code{\link{L.4}}, \code{\link{L.5}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/L.4.Rd b/man/L.4.Rd new file mode 100644 index 00000000..910d23c3 --- /dev/null +++ b/man/L.4.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/logistic.R +\name{L.4} +\alias{L.4} +\title{Four-parameter logistic model} +\usage{ +L.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) +} +\arguments{ +\item{fixed}{numeric vector of length 4. Specifies which parameters are fixed +and at what value they are fixed. \code{NA} indicates that the corresponding +parameter is not fixed.} + +\item{names}{character vector of length 4 giving the names of the parameters +\code{(b, c, d, e)}. Default is \code{c("b", "c", "d", "e")}.} + +\item{...}{additional arguments passed to \code{\link{logistic}}.} +} +\value{ +A list of class \code{"Boltzmann"} containing the nonlinear function, +self starter function, and parameter names. +} +\description{ +A four-parameter logistic model (symmetric, with \code{f = 1}), given by +\deqn{f(x) = c + \frac{d - c}{1 + \exp(b(x - e))}} +} +\examples{ +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = L.4()) +} +\seealso{ +\code{\link{logistic}}, \code{\link{L.3}}, \code{\link{L.5}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/L.5.Rd b/man/L.5.Rd new file mode 100644 index 00000000..6f5341a5 --- /dev/null +++ b/man/L.5.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/logistic.R +\name{L.5} +\alias{L.5} +\title{Five-parameter generalized logistic model} +\usage{ +L.5(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...) +} +\arguments{ +\item{fixed}{numeric vector of length 5. Specifies which parameters are fixed +and at what value they are fixed. \code{NA} indicates that the corresponding +parameter is not fixed.} + +\item{names}{character vector of length 5 giving the names of the parameters +\code{(b, c, d, e, f)}. Default is \code{c("b", "c", "d", "e", "f")}.} + +\item{...}{additional arguments passed to \code{\link{logistic}}.} +} +\value{ +A list of class \code{"Boltzmann"} containing the nonlinear function, +self starter function, and parameter names. +} +\description{ +A five-parameter generalized logistic model (asymmetric when \code{f != 1}), +given by +\deqn{f(x) = c + \frac{d - c}{(1 + \exp(b(x - e)))^f}} +} +\examples{ +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = L.5()) +} +\seealso{ +\code{\link{logistic}}, \code{\link{L.3}}, \code{\link{L.4}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/LL.2.Rd b/man/LL.2.Rd index 90a14853..e53b5ceb 100644 --- a/man/LL.2.Rd +++ b/man/LL.2.Rd @@ -1,71 +1,48 @@ -\name{LL.2} - -\alias{LL.2} -\alias{l2} - -\alias{LL2.2} - -\title{The two-parameter log-logistic function} - -\description{ - 'LL.2' and 'LL2.2' provide the two-parameter log-logistic function where the lower limit is fixed at 0 and the upper limit - is fixed at 1, mostly suitable for binomial/quantal responses. -} - -\usage{ - LL.2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) - - l2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) - - LL2.2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) -} - -\arguments{ - \item{upper}{numeric value. The fixed, upper limit in the model. Default is 1.} - \item{fixed}{numeric vector. Specifies which parameters are fixed and at what value they are fixed. NAs for parameter that are not fixed.} - \item{names}{a vector of character strings giving the names of the parameters. The default is reasonable.} - \item{...}{Additional arguments (see \code{\link{llogistic}}).} -} - -\details{ - The two-parameter log-logistic function is given by the expression - \deqn{ f(x) = \frac{1}{1+\exp(b(\log(x)-\log(e)))}} - - or in another parameterisation - \deqn{ f(x) = \frac{1}{1+\exp(b(\log(x)-e))}} - - The model function is symmetric about the inflection point (\eqn{e}). -} - -\value{ - See \code{\link{llogistic}}. -} - -%\references{ ~put references to the literature/web site here ~ } - -\author{Christian Ritz} - -\note{ - This function is for use with the function \code{\link{drm}}. -} - -\seealso{ - Related functions are \code{\link{LL.3}}, \code{\link{LL.4}}, \code{\link{LL.5}} and the more general - \code{\link{llogistic}}. -} - -\examples{ - -## Fitting a two-parameter logistic model -## to binomial responses (a logit model) -earthworms.m1 <- drm(number/total~dose, weights=total, -data = earthworms, fct = LL.2(), type = "binomial") - -plot(earthworms.m1) # not fitting at the upper limit! - -} - -\keyword{models} -\keyword{nonlinear} - -\concept{Hill logit 2-parameter two-parameter} \ No newline at end of file +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/llogistic.R +\name{LL.2} +\alias{LL.2} +\alias{l2} +\title{Two-parameter log-logistic function} +\usage{ +LL.2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) + +l2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) +} +\arguments{ +\item{upper}{numeric value, the fixed upper limit (default 1).} + +\item{fixed}{numeric vector of length 2, specifying fixed parameters +(use NA for non-fixed parameters).} + +\item{names}{character vector of length 2, specifying the names of the +parameters (default: b, e).} + +\item{...}{additional arguments to \code{\link{llogistic}}.} +} +\value{ +See \code{\link{llogistic}}. +} +\description{ +A two-parameter log-logistic function with lower limit fixed at 0 and +upper limit fixed (default 1), primarily for use with binomial/quantal +dose-response data. +} +\details{ +The two-parameter log-logistic function is given by the expression +\deqn{f(x) = \frac{upper}{1+\exp(b(\log(x)-\log(e)))}} +} +\examples{ +earthworms.m1 <- drm(number/total~dose, weights=total, + data = earthworms, fct = LL.2(), type = "binomial") + +} +\seealso{ +\code{\link{LL.3}}, \code{\link{LL.4}}, \code{\link{LL.5}}, +\code{\link{llogistic}} +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/LL.3.Rd b/man/LL.3.Rd index 46f38c99..9edea6aa 100644 --- a/man/LL.3.Rd +++ b/man/LL.3.Rd @@ -1,111 +1,43 @@ -\name{LL.3} - -\alias{LL.3} -\alias{LL.3u} - -\alias{l3} -\alias{l3u} - -\alias{LL2.3} -\alias{LL2.3u} - -\title{The three-parameter log-logistic function} - -\description{ - 'LL.3' and 'LL2.3' provide the three-parameter log-logistic function where the lower limit is equal to 0. - - 'LL.3u' and 'LL2.3u' provide three-parameter logistic function where the upper limit is equal to 1, mainly - for use with binomial/quantal response. -} - -\usage{ - LL.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) - - LL.3u(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...) - - l3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) - - l3u(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...) - - LL2.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) - - LL2.3u(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...) -} - -\arguments{ - \item{upper}{numeric value. The fixed, upper limit in the model. Default is 1.} - \item{fixed}{numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.} - \item{names}{a vector of character strings giving the names of the parameters. The default is reasonable.} - \item{...}{Additional arguments (see \code{\link{llogistic}}).} -} - -\details{ - The three-parameter log-logistic function with lower limit 0 is - \deqn{ f(x) = 0 + \frac{d-0}{1+\exp(b(\log(x)-\log(e)))}} - - or in another parameterisation - \deqn{ f(x) = 0 + \frac{d-0}{1+\exp(b(\log(x)-e))}} - - The three-parameter log-logistic function with upper limit 1 is - \deqn{ f(x) = c + \frac{1-c}{1+\exp(b(\log(x)-\log(e)))}} - - or in another parameterisation - \deqn{ f(x) = c + \frac{1-c}{1+\exp(b(\log(x)-e))}} - - Both functions are symmetric about the inflection point (\eqn{e}). -} - -\value{ - See \code{\link{llogistic}}. -} - -\references{ - Finney, D. J. (1971) \emph{Probit Analysis}, Cambridge: Cambridge University Press. -} - -\author{Christian Ritz} - -\note{ - This function is for use with the function \code{\link{drm}}. -} - -\seealso{ - Related functions are \code{\link{LL.2}}, \code{\link{LL.4}}, \code{\link{LL.5}} and the more general - \code{\link{llogistic}}. -} - -\examples{ - -## Fitting model with lower limit equal 0 -ryegrass.model1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.3()) -summary(ryegrass.model1) - -## Fitting binomial response -## with non-zero control response - -## Example dataset from Finney (1971) - example 19 -logdose <- c(2.17, 2,1.68,1.08,-Inf,1.79,1.66,1.49,1.17,0.57) -n <- c(142,127,128,126,129,125,117,127,51,132) -r <- c(142,126,115,58,21,125,115,114,40,37) -treatment <- factor(c("w213","w213","w213","w213", -"w214","w214","w214","w214","w214","w214")) -# Note that the control is included in one of the two treatment groups -finney.ex19 <- data.frame(logdose, n, r, treatment) - -## Fitting model where the lower limit is estimated -fe19.model1 <- drm(r/n~logdose, treatment, weights = n, data = finney.ex19, -logDose = 10, fct = LL.3u(), type="binomial", -pmodels = data.frame(treatment, 1, treatment)) - -summary(fe19.model1) -modelFit(fe19.model1) -plot(fe19.model1, ylim = c(0, 1.1), bp = -1, broken = TRUE, legendPos = c(0, 1)) -abline(h = 1, lty = 2) - -} - -\keyword{models} -\keyword{nonlinear} - -\concept{Hill 3-parameter three-parameter} \ No newline at end of file +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/llogistic.R +\name{LL.3} +\alias{LL.3} +\alias{l3} +\title{Three-parameter log-logistic function} +\usage{ +LL.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) + +l3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) +} +\arguments{ +\item{fixed}{numeric vector of length 3, specifying fixed parameters +(use NA for non-fixed parameters).} + +\item{names}{character vector of length 3, specifying the names of the +parameters (default: b, d, e).} + +\item{...}{additional arguments to \code{\link{llogistic}}.} +} +\value{ +See \code{\link{llogistic}}. +} +\description{ +A three-parameter log-logistic function with lower limit fixed at 0. +} +\details{ +The three-parameter log-logistic function is given by the expression +\deqn{f(x) = \frac{d}{1+\exp(b(\log(x)-\log(e)))}} +} +\examples{ +ryegrass.model1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.3()) + +} +\seealso{ +\code{\link{LL.2}}, \code{\link{LL.4}}, \code{\link{LL.5}}, +\code{\link{llogistic}} +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/LL.3u.Rd b/man/LL.3u.Rd new file mode 100644 index 00000000..5aee3947 --- /dev/null +++ b/man/LL.3u.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/llogistic.R +\name{LL.3u} +\alias{LL.3u} +\alias{l3u} +\title{Three-parameter log-logistic function with upper limit fixed} +\usage{ +LL.3u(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...) + +l3u(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...) +} +\arguments{ +\item{upper}{numeric value, the fixed upper limit (default 1).} + +\item{fixed}{numeric vector of length 3, specifying fixed parameters +(use NA for non-fixed parameters).} + +\item{names}{character vector of length 3, specifying the names of the +parameters (default: b, c, e).} + +\item{...}{additional arguments to \code{\link{llogistic}}.} +} +\value{ +See \code{\link{llogistic}}. +} +\description{ +A three-parameter log-logistic function with upper limit fixed (default 1), +primarily for use with binomial/quantal dose-response data. +} +\details{ +The three-parameter log-logistic function with upper limit fixed is given by +\deqn{f(x) = c + \frac{upper-c}{1+\exp(b(\log(x)-\log(e)))}} +} +\seealso{ +\code{\link{LL.2}}, \code{\link{LL.3}}, \code{\link{LL.4}}, +\code{\link{llogistic}} +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/LL.4.Rd b/man/LL.4.Rd index 1c408cb9..f350524c 100644 --- a/man/LL.4.Rd +++ b/man/LL.4.Rd @@ -1,64 +1,42 @@ -\name{LL.4} - -\alias{LL.4} -\alias{l4} - -\alias{LL2.4} - -\title{The four-parameter log-logistic function} - -\description{ - 'LL.4' and 'LL2.4' provide the four-parameter log-logistic function, self starter function, names of the parameters and, optionally, - first and second derivatives for a faster estimation. -} - -\usage{ - LL.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) - - l4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) - - LL2.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) -} - -\arguments{ - \item{fixed}{numeric vector. Specifies which parameters are fixed and at what value they are fixed. NAs for parameter that are not fixed.} - \item{names}{a vector of character strings giving the names of the parameters. The default is reasonable.} - \item{...}{Additional arguments (see \code{\link{llogistic}}).} -} - -\details{ - The four-parameter log-logistic function is given by the expression - \deqn{ f(x) = c + \frac{d-c}{1+\exp(b(\log(x)-\log(e)))}} - - or in another parameterisation (converting the term \eqn{\log(e)} into a parameter) - \deqn{ f(x) = c + \frac{d-c}{1+\exp(b(\log(x)-\tilde{e}))}} - - The function is symmetric about the inflection point (\eqn{e}). -} - -\value{ - See \code{\link{llogistic}}. -} - -\references{ - Seber, G. A. F. and Wild, C. J (1989) \emph{Nonlinear Regression}, New York: Wiley \& Sons (p. 330). -} - -\author{Christian Ritz and Jens C. Streibig} - -\note{This function is for use with the function \code{\link{drm}}.} - -\seealso{Setting \eqn{c=0} yields \code{\link{LL.3}}. See also \code{\link{LL.5}}.} - -\examples{ - -spinach.m1 <- drm(SLOPE~DOSE, CURVE, data = spinach, fct = LL.4()) -spinach.m1 - - -} - -\keyword{models} -\keyword{nonlinear} - -\concept{Hill 4-parameter four-parameter} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/llogistic.R +\name{LL.4} +\alias{LL.4} +\alias{l4} +\title{Four-parameter log-logistic function} +\usage{ +LL.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) + +l4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) +} +\arguments{ +\item{fixed}{numeric vector of length 4, specifying fixed parameters +(use NA for non-fixed parameters).} + +\item{names}{character vector of length 4, specifying the names of the +parameters (default: b, c, d, e).} + +\item{...}{additional arguments to \code{\link{llogistic}}.} +} +\value{ +See \code{\link{llogistic}}. +} +\description{ +A four-parameter log-logistic function. +} +\details{ +The four-parameter log-logistic function is given by the expression +\deqn{f(x) = c + \frac{d-c}{1+\exp(b(\log(x)-\log(e)))}} +} +\examples{ +spinach.m1 <- drm(SLOPE~DOSE, CURVE, data = spinach, fct = LL.4()) + +} +\seealso{ +\code{\link{LL.3}}, \code{\link{LL.5}}, \code{\link{llogistic}} +} +\author{ +Christian Ritz and Jens C. Streibig +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/LL.5.Rd b/man/LL.5.Rd index 74f67147..d825a390 100644 --- a/man/LL.5.Rd +++ b/man/LL.5.Rd @@ -1,62 +1,43 @@ -\name{LL.5} - -\alias{LL.5} -\alias{l5} - -\alias{LL2.5} - -\title{The five-parameter log-logistic function} - -\description{ - 'LL.5' and 'LL2.5' provide the five-parameter log-logistic function, self starter function and names of the parameters. -} - -\usage{ - LL.5(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...) - - l5(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...) - - LL2.5(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...) -} - -\arguments{ - \item{fixed}{numeric vector. Specifies which parameters are fixed and at what value they are fixed. NAs for parameter that are not fixed.} - \item{names}{a vector of character strings giving the names of the parameters. The default is reasonable.} - \item{...}{Additional arguments (see \code{\link{llogistic}}).} -} - -\details{ - The five-parameter logistic function is given by the expression - \deqn{ f(x) = c + \frac{d-c}{(1+\exp(b(\log(x)-\log(e))))^f}} - - or in another parameterisation - \deqn{ f(x) = c + \frac{d-c}{(1+\exp(b(\log(x)-e)))^f}} - - The function is asymmetric for \eqn{f} different from 1. - -} -\value{ - See \code{\link{llogistic}}. -} -\references{ - Finney, D. J. (1979) Bioassay and the Practise of Statistical Inference, - \emph{Int. Statist. Rev.}, \bold{47}, 1--12. -} - -\author{Christian Ritz} - -\note{This function is for use with the function \code{\link{drm}}.} - -\seealso{Related functions are \code{\link{LL.4}} and \code{\link{LL.3}}.} - -\examples{ - -ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.5()) -summary(ryegrass.m1) - -} - -\keyword{models} -\keyword{nonlinear} - -\concept{Hill 5-parameter five-parameter} \ No newline at end of file +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/llogistic.R +\name{LL.5} +\alias{LL.5} +\alias{l5} +\title{Five-parameter log-logistic function} +\usage{ +LL.5(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...) + +l5(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...) +} +\arguments{ +\item{fixed}{numeric vector of length 5, specifying fixed parameters +(use NA for non-fixed parameters).} + +\item{names}{character vector of length 5, specifying the names of the +parameters (default: b, c, d, e, f).} + +\item{...}{additional arguments to \code{\link{llogistic}}.} +} +\value{ +See \code{\link{llogistic}}. +} +\description{ +A five-parameter (generalized) log-logistic function. The function is +asymmetric when f differs from 1. +} +\details{ +The five-parameter log-logistic function is given by the expression +\deqn{f(x) = c + \frac{d-c}{(1+\exp(b(\log(x)-\log(e))))^f}} +} +\examples{ +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.5()) + +} +\seealso{ +\code{\link{LL.3}}, \code{\link{LL.4}}, \code{\link{llogistic}} +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/LL2.2.Rd b/man/LL2.2.Rd new file mode 100644 index 00000000..91a93a70 --- /dev/null +++ b/man/LL2.2.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/llogistic2.R +\name{LL2.2} +\alias{LL2.2} +\title{Two-Parameter Log-Logistic Model with log(ED50) as Parameter} +\usage{ +LL2.2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) +} +\arguments{ +\item{upper}{numeric value giving the fixed upper limit. Defaults to 1.} + +\item{fixed}{numeric vector of length 2. Specifies which parameters are +fixed and at what value. Use \code{NA} for parameters that should be +estimated.} + +\item{names}{character vector of length 2 giving the names of the +parameters \code{b} and \code{e}.} + +\item{\dots}{additional arguments passed to \code{\link{llogistic2}}.} +} +\value{ +A list of class \code{"llogistic"} with the nonlinear function, +self-starter, and related components. +} +\description{ +A two-parameter log-logistic model where the lower limit is fixed at 0 and +the upper limit is fixed at a specified value (default 1). The estimated +parameters are the slope \code{b} and the log(ED50) \code{e}. +} +\examples{ +earthworms.m1 <- drm(number/total ~ dose, weights = total, + data = earthworms, fct = LL2.2(), type = "binomial") + +} +\seealso{ +\code{\link{llogistic2}}, \code{\link{LL2.3}}, \code{\link{LL2.4}}, +\code{\link{LL2.5}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/LL2.3.Rd b/man/LL2.3.Rd new file mode 100644 index 00000000..ecd868ad --- /dev/null +++ b/man/LL2.3.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/llogistic2.R +\name{LL2.3} +\alias{LL2.3} +\title{Three-Parameter Log-Logistic Model with log(ED50) and Lower Limit at 0} +\usage{ +LL2.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) +} +\arguments{ +\item{fixed}{numeric vector of length 3. Specifies which parameters are +fixed and at what value. Use \code{NA} for parameters that should be +estimated.} + +\item{names}{character vector of length 3 giving the names of the +parameters \code{b}, \code{d}, and \code{e}.} + +\item{\dots}{additional arguments passed to \code{\link{llogistic2}}.} +} +\value{ +A list of class \code{"llogistic"} with the nonlinear function, +self-starter, and related components. +} +\description{ +A three-parameter log-logistic model where the lower limit is fixed at 0. +The estimated parameters are the slope \code{b}, the upper limit \code{d}, +and the log(ED50) \code{e}. +} +\examples{ +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL2.3()) + +} +\seealso{ +\code{\link{llogistic2}}, \code{\link{LL2.2}}, \code{\link{LL2.4}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/LL2.3u.Rd b/man/LL2.3u.Rd new file mode 100644 index 00000000..06cde409 --- /dev/null +++ b/man/LL2.3u.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/llogistic2.R +\name{LL2.3u} +\alias{LL2.3u} +\title{Three-Parameter Log-Logistic Model with log(ED50) and Fixed Upper Limit} +\usage{ +LL2.3u(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...) +} +\arguments{ +\item{upper}{numeric value giving the fixed upper limit. Defaults to 1.} + +\item{fixed}{numeric vector of length 3. Specifies which parameters are +fixed and at what value. Use \code{NA} for parameters that should be +estimated.} + +\item{names}{character vector of length 3 giving the names of the +parameters \code{b}, \code{c}, and \code{e}.} + +\item{\dots}{additional arguments passed to \code{\link{llogistic2}}.} +} +\value{ +A list of class \code{"llogistic"} with the nonlinear function, +self-starter, and related components. +} +\description{ +A three-parameter log-logistic model where the upper limit is fixed at a +specified value (default 1). The estimated parameters are the slope \code{b}, +the lower limit \code{c}, and the log(ED50) \code{e}. +} +\seealso{ +\code{\link{llogistic2}}, \code{\link{LL2.2}}, \code{\link{LL2.3}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/LL2.4.Rd b/man/LL2.4.Rd new file mode 100644 index 00000000..4cd2e7d4 --- /dev/null +++ b/man/LL2.4.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/llogistic2.R +\name{LL2.4} +\alias{LL2.4} +\title{Four-Parameter Log-Logistic Model with log(ED50) as Parameter} +\usage{ +LL2.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) +} +\arguments{ +\item{fixed}{numeric vector of length 4. Specifies which parameters are +fixed and at what value. Use \code{NA} for parameters that should be +estimated.} + +\item{names}{character vector of length 4 giving the names of the +parameters \code{b}, \code{c}, \code{d}, and \code{e}.} + +\item{\dots}{additional arguments passed to \code{\link{llogistic2}}.} +} +\value{ +A list of class \code{"llogistic"} with the nonlinear function, +self-starter, and related components. +} +\description{ +A four-parameter log-logistic model where the ED50 is parameterised on the +log scale. The asymmetry parameter \code{f} is fixed at 1. The estimated +parameters are the slope \code{b}, the lower limit \code{c}, the upper +limit \code{d}, and the log(ED50) \code{e}. +} +\examples{ +spinach.m1 <- drm(SLOPE ~ DOSE, CURVE, data = spinach, fct = LL2.4()) + +} +\seealso{ +\code{\link{llogistic2}}, \code{\link{LL2.3}}, \code{\link{LL2.5}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/LL2.5.Rd b/man/LL2.5.Rd new file mode 100644 index 00000000..c85c86be --- /dev/null +++ b/man/LL2.5.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/llogistic2.R +\name{LL2.5} +\alias{LL2.5} +\title{Five-Parameter Generalised Log-Logistic Model with log(ED50) as Parameter} +\usage{ +LL2.5(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...) +} +\arguments{ +\item{fixed}{numeric vector of length 5. Specifies which parameters are +fixed and at what value. Use \code{NA} for parameters that should be +estimated.} + +\item{names}{character vector of length 5 giving the names of the +parameters \code{b}, \code{c}, \code{d}, \code{e}, and \code{f}.} + +\item{\dots}{additional arguments passed to \code{\link{llogistic2}}.} +} +\value{ +A list of class \code{"llogistic"} with the nonlinear function, +self-starter, and related components. +} +\description{ +A five-parameter generalised log-logistic model where the ED50 is +parameterised on the log scale. All five parameters (\code{b}, \code{c}, +\code{d}, \code{e}, \code{f}) are estimated. +} +\examples{ +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL2.5()) + +} +\seealso{ +\code{\link{llogistic2}}, \code{\link{LL2.3}}, \code{\link{LL2.4}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/LN.2.Rd b/man/LN.2.Rd new file mode 100644 index 00000000..2d733b88 --- /dev/null +++ b/man/LN.2.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/lnormal.R +\name{LN.2} +\alias{LN.2} +\title{Two-parameter log-normal dose-response model} +\usage{ +LN.2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) +} +\arguments{ +\item{upper}{numeric specifying the fixed upper horizontal asymptote. Default is 1.} + +\item{fixed}{numeric vector of length 2 specifying fixed parameters (NAs for free parameters).} + +\item{names}{character vector of parameter names.} + +\item{...}{additional arguments passed to \code{\link{lnormal}}.} +} +\value{ +A list (see \code{\link{lnormal}}). +} +\description{ +\code{LN.2} is a convenience function for the log-normal model with lower limit fixed at 0 +and upper limit fixed (default 1), corresponding to the classic probit model. +} +\seealso{ +\code{\link{lnormal}}, \code{\link{LN.3}}, \code{\link{LN.4}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/LN.3.Rd b/man/LN.3.Rd new file mode 100644 index 00000000..23d5d034 --- /dev/null +++ b/man/LN.3.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/lnormal.R +\name{LN.3} +\alias{LN.3} +\title{Three-parameter log-normal dose-response model} +\usage{ +LN.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) +} +\arguments{ +\item{fixed}{numeric vector of length 3 specifying fixed parameters (NAs for free parameters).} + +\item{names}{character vector of parameter names.} + +\item{...}{additional arguments passed to \code{\link{lnormal}}.} +} +\value{ +A list (see \code{\link{lnormal}}). +} +\description{ +\code{LN.3} is a convenience function for the log-normal model with the lower limit fixed at 0. +} +\seealso{ +\code{\link{lnormal}}, \code{\link{LN.2}}, \code{\link{LN.4}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/LN.3u.Rd b/man/LN.3u.Rd new file mode 100644 index 00000000..4f0870bb --- /dev/null +++ b/man/LN.3u.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/lnormal.R +\name{LN.3u} +\alias{LN.3u} +\title{Three-parameter log-normal model with upper limit fixed} +\usage{ +LN.3u(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...) +} +\arguments{ +\item{upper}{numeric specifying the fixed upper horizontal asymptote. Default is 1.} + +\item{fixed}{numeric vector of length 3 specifying fixed parameters (NAs for free parameters).} + +\item{names}{character vector of parameter names.} + +\item{...}{additional arguments passed to \code{\link{lnormal}}.} +} +\value{ +A list (see \code{\link{lnormal}}). +} +\description{ +\code{LN.3u} is a convenience function for the log-normal model with the upper limit fixed (default 1). +} +\seealso{ +\code{\link{lnormal}}, \code{\link{LN.2}}, \code{\link{LN.3}}, \code{\link{LN.4}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/LN.4.Rd b/man/LN.4.Rd new file mode 100644 index 00000000..2a1fc848 --- /dev/null +++ b/man/LN.4.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/lnormal.R +\name{LN.4} +\alias{LN.4} +\title{Four-parameter log-normal dose-response model} +\usage{ +LN.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) +} +\arguments{ +\item{fixed}{numeric vector of length 4 specifying fixed parameters (NAs for free parameters).} + +\item{names}{character vector of parameter names.} + +\item{...}{additional arguments passed to \code{\link{lnormal}}.} +} +\value{ +A list (see \code{\link{lnormal}}). +} +\description{ +\code{LN.4} is a convenience function for the full four-parameter log-normal model. +} +\seealso{ +\code{\link{lnormal}}, \code{\link{LN.2}}, \code{\link{LN.3}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/M.bahia.Rd b/man/M.bahia.Rd new file mode 100644 index 00000000..4fb04418 --- /dev/null +++ b/man/M.bahia.Rd @@ -0,0 +1,67 @@ +\name{M.bahia} + +\alias{M.bahia} + +\docType{data} + +\title{Effect of an effluent on the growth of mysid shrimp} + +\description{ + Juvenile mysid shrimp (\emph{Mysidopsis bahia}) were exposed to up to 32\% effluent + in a 7-day survival and growth test. The average weight per treatment replicate of + surviving organisms was measured. +} + +\usage{data(M.bahia)} + +\format{ + A data frame with 40 observations on the following 2 variables. + \describe{ + \item{\code{conc}}{a numeric vector of effluent concentrations (\%)} + \item{\code{dryweight}}{a numeric vector of average dry weights (mg)} + } +} + +\details{ + The data are analysed in Bruce and Versteeg (1992) using a log-normal + dose-response model (using the logarithm with base 10). + + At 32\% there was complete mortality, and this justifies using a model where a lower asymptote + of 0 is assumed. +} + +\source{ + Bruce, R. D. and Versteeg, D. J. (1992) A statistical procedure for modeling continuous toxicity data, + \emph{Environ. Toxicol. Chem.}, \bold{11}, 1485--1494. +} + +%\references{} + +\examples{ +library(drc) + +M.bahia.m1 <- drm(dryweight~conc, data=M.bahia, fct=LN.3()) + +## Variation increasing +plot(fitted(M.bahia.m1), residuals(M.bahia.m1)) + +## Using transform-both-sides approach +M.bahia.m2 <- boxcox(M.bahia.m1, method = "anova") +summary(M.bahia.m2) # logarithm transformation + +## Variation roughly constant, but still not a great fit +plot(fitted(M.bahia.m2), residuals(M.bahia.m2)) + +## Visual comparison of fits +plot(M.bahia.m1, type="all", broken=TRUE) +plot(M.bahia.m2, add=TRUE, type="none", broken=TRUE, lty=2) + +ED(M.bahia.m2, c(10,20,50), ci="fls") + +## A better fit +M.bahia.m3 <- boxcox(update(M.bahia.m1, fct = LN.4()), method = "anova") +#plot(fitted(M.bahia.m3), residuals(M.bahia.m3)) +plot(M.bahia.m3, add=TRUE, type="none", broken=TRUE, lty=3, col=2) +ED(M.bahia.m3, c(10,20,50), ci="fls") +} +\keyword{datasets} diff --git a/man/MAX.Rd b/man/MAX.Rd index 515fca9b..c5db4bf5 100644 --- a/man/MAX.Rd +++ b/man/MAX.Rd @@ -1,57 +1,87 @@ -\name{MAX} - -\alias{MAX} - -\title{Maximum mean response} - -\description{ - \code{MAX} estimates the maximum mean response and the dose at which it occurs. -} - -\usage{ -MAX(object, lower = 1e-3, upper = 1000, pool = TRUE) -} - -\arguments{ - \item{object}{an object of class 'drc'.} - \item{lower}{numeric. Lower limit for bisection method. Need to be smaller than EDx level to be calculated.} - \item{upper}{numeric. Upper limit for bisection method. Need to be larger than EDx level to be calculated.} - \item{pool}{logical. If TRUE curves are pooled. Otherwise they are not. This argument only works for models with - independently fitted curves as specified in \code{\link{drm}}.} -} - -\details{ - This function is only implemented for the built-in functions of class \code{\link{braincousens}} and - \code{\link{cedergreen}}. - - This function was used for obtaining the results on hormesis effect size reported in Cedergreen et al. (2005). -} - -\value{ - A matrix with one row per curve in the data set and two columns: - one containing the dose at which the maximum occurs - and one containing the corresponding maximum response. -} - -\references{ - Cedergreen, N. and Ritz, C. and Streibig, J. C. (2005) Improved empirical models describing hormesis, - \emph{Environmental Toxicology and Chemistry} \bold{24}, 3166--3172. -} - -\author{Christian Ritz} - -%\note{This function is only implemented for the built-in functions of class 'braincousens' and 'mlogistic'.} - -%\seealso{The related function \code{\link{SI}}.} - -\examples{ - -## Fitting a Cedergreen-Ritz-Streibig model -lettuce.m1 <- drm(weight~conc, data = lettuce, fct = CRS.4c()) - -## Finding maximum average response and the corrresponding dose -MAX(lettuce.m1) - -} -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/max.R +\name{MAX} +\alias{MAX} +\title{Maximum mean response} +\usage{ +MAX(object, lower = 0.001, upper = 1000, pool = TRUE) +} +\arguments{ +\item{object}{an object of class \code{drc}, fitted using \code{\link{drm}} +with a hormesis model such as \code{\link{CRS.4c}} or \code{\link{BC.4}}.} + +\item{lower}{numeric. Lower bound of the interval used by the bisection +method to search for the dose at maximum response. Must be strictly smaller +than \code{upper} and should be set below the expected dose at maximum +response. Defaults to \code{1e-3}.} + +\item{upper}{numeric. Upper bound of the interval used by the bisection +method to search for the dose at maximum response. Must be strictly larger +than \code{lower} and should be set above the expected dose at maximum +response. Defaults to \code{1000}.} + +\item{pool}{logical. If \code{TRUE} (default), curves are pooled when +computing the variance-covariance matrix. Otherwise they are not. This +argument only works for models with independently fitted curves as +specified in \code{\link{drm}}. Note: currently the variance-covariance +matrix is retrieved for internal consistency but standard errors are not +yet reported in the output.} +} +\value{ +Invisibly returns a numeric matrix with one row per curve in the +data set and two columns: +\describe{ +\item{Dose}{The dose at which the maximum mean response occurs, found +via bisection within \code{[lower, upper]}.} +\item{Response}{The estimated maximum mean response at that dose.} +} +Row names correspond to curve identifiers. If the computation fails for a +given curve, the corresponding row will contain \code{NA} values and a +warning is issued. The matrix is also printed to the console via +\code{\link{printCoefmat}}. +} +\description{ +Estimates the maximum mean response and the dose at which it occurs, using a +bisection method to locate the peak of the fitted dose-response curve. This +function is only implemented for the built-in model functions of class +\code{\link{braincousens}} and \code{\link{cedergreen}}, which are capable of +exhibiting hormesis (i.e., a non-monotone response with a stimulatory effect +at low doses). +} +\details{ +The function numerically locates the dose \eqn{d^*} that maximises the fitted +dose-response curve over the search interval \code{[lower, upper]}: +\deqn{d^* = \arg\max_{d} f(d, \hat{\theta})} +where \eqn{f} is the fitted dose-response function and \eqn{\hat{\theta}} is +the vector of estimated parameters. The search is performed using a bisection +approach defined internally by the model's \code{maxfct} component. + +It is the user's responsibility to ensure that the true maximum lies within +\code{[lower, upper]}. If the maximum falls outside this interval, the +function will silently return a boundary value and a warning is issued. +} +\examples{ +## Fitting a Cedergreen-Ritz-Streibig model +lettuce.m1 <- drm(weight ~ conc, data = lettuce, fct = CRS.4c()) + +## Finding the maximum mean response and the corresponding dose +MAX(lettuce.m1) + +## Custom search interval +MAX(lettuce.m1, lower = 1e-5, upper = 500) + +## Capture the result matrix +result <- MAX(lettuce.m1) +result["Dose"] + +} +\references{ +Cedergreen, N., Ritz, C., and Streibig, J. C. (2005) Improved empirical +models describing hormesis, \emph{Environmental Toxicology and Chemistry} +\bold{24}, 3166--3172. +} +\author{ +Christian Ritz. Issues fixed and documentation enhanced by Hannes Reinwald. +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/MM.2.Rd b/man/MM.2.Rd new file mode 100644 index 00000000..b34e1f22 --- /dev/null +++ b/man/MM.2.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/llogistic.R +\name{MM.2} +\alias{MM.2} +\title{Two-parameter Michaelis-Menten function} +\usage{ +MM.2(fixed = c(NA, NA), names = c("d", "e"), ...) +} +\arguments{ +\item{fixed}{numeric vector of length 2, specifying fixed parameters +(use NA for non-fixed parameters).} + +\item{names}{character vector of length 2, specifying the names of the +parameters (default: d, e).} + +\item{...}{additional arguments to \code{\link{llogistic}}.} +} +\value{ +See \code{\link{llogistic}}. +} +\description{ +A two-parameter Michaelis-Menten function where b is fixed at -1, c at 0, +and f at 1. Commonly used for enzyme kinetics and weed density studies. +} +\details{ +The two-parameter Michaelis-Menten function is +\deqn{f(x) = \frac{d \cdot x}{e + x}} +which is equivalent to \eqn{d/(1+(e/x))}. +} +\examples{ +met.mm.m1 <- drm(gain~dose, product, data = methionine, fct = MM.2()) + +} +\seealso{ +\code{\link{MM.3}}, \code{\link{AR.2}}, \code{\link{AR.3}} +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/MM.3.Rd b/man/MM.3.Rd new file mode 100644 index 00000000..5f0e3638 --- /dev/null +++ b/man/MM.3.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/llogistic.R +\name{MM.3} +\alias{MM.3} +\title{Three-parameter Michaelis-Menten function} +\usage{ +MM.3(fixed = c(NA, NA, NA), names = c("c", "d", "e"), ...) +} +\arguments{ +\item{fixed}{numeric vector of length 3, specifying fixed parameters +(use NA for non-fixed parameters).} + +\item{names}{character vector of length 3, specifying the names of the +parameters (default: c, d, e).} + +\item{...}{additional arguments to \code{\link{llogistic}}.} +} +\value{ +See \code{\link{llogistic}}. +} +\description{ +A three-parameter (shifted) Michaelis-Menten function where b is fixed +at -1 and f at 1. +} +\details{ +The three-parameter Michaelis-Menten function is +\deqn{f(x) = c + \frac{d-c}{1+(e/x)}} +} +\examples{ +met.mm.m1 <- drm(gain~dose, product, data = methionine, fct = MM.3()) + +} +\seealso{ +\code{\link{MM.2}}, \code{\link{AR.2}}, \code{\link{AR.3}} +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/MM.Rd b/man/MM.Rd deleted file mode 100644 index ed831a5e..00000000 --- a/man/MM.Rd +++ /dev/null @@ -1,80 +0,0 @@ -\name{MM} - -\alias{MM.2} -\alias{MM.3} - -\title{Michaelis-Menten model} - -\description{ - The functions can be used to fit (shifted) Michaelis-Menten models that are used - for modeling enzyme kinetics, weed densities etc. -} - -\usage{ - MM.2(fixed = c(NA, NA), names = c("d", "e"), ...) - - MM.3(fixed = c(NA, NA, NA), names = c("c", "d", "e"), ...) -} - -\arguments{ - \item{fixed}{numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.} - \item{names}{a vector of character strings giving the names of the parameters (should not contain ":").} - \item{...}{additional arguments from convenience functions to \code{\link{llogistic}}.} -} - -\details{ - The model is defined by the three-parameter model function - - \deqn{f(x, (c, d, e)) = c + \frac{d-c}{1+(e/x)}} - - It is an increasing as a function of the dose \eqn{x}, attaining the lower limit \eqn{c} at dose 0 (\eqn{x=0}) - and the upper limit \eqn{d} for infinitely large doses. The parameter \eqn{e} corresponds to the dose yielding a response - halfway between \eqn{c} and \eqn{d}. - - The common two-parameter Michaelis-Menten model (\code{MM.2}) is obtained by - setting \eqn{c} equal to 0. -} - -\value{ - A list of class \code{drcMean}, containing the mean function, the self starter function, - the parameter names and other components such as derivatives and a function for calculating ED values. -} - -%\references{} - -\author{Christian Ritz} - -\note{ - At the moment the implementation cannot deal with infinite concentrations. -} - -\seealso{Related models are the asymptotic regression models \code{\link{AR.2}} and \code{\link{AR.3}}.} - -\examples{ - -## Fitting Michaelis-Menten model -met.mm.m1 <- drm(gain~dose, product, data=methionine, fct=MM.3(), -pmodels = list(~1, ~factor(product), ~factor(product))) -plot(met.mm.m1, log = "", ylim=c(1450, 1800)) -summary(met.mm.m1) -ED(met.mm.m1, c(10, 50)) - -## Calculating bioefficacy: approach 1 -coef(met.mm.m1)[4] / coef(met.mm.m1)[5] * 100 - -## Calculating bioefficacy: approach 2 -EDcomp(met.mm.m1, c(50,50)) - -## Simplified models -met.mm.m2a <- drm(gain~dose, product, data=methionine, fct=MM.3(), -pmodels = list(~1, ~factor(product), ~1)) -anova(met.mm.m2a, met.mm.m1) # model reduction not possible - -met.mm.m2b <- drm(gain~dose, product, data=methionine, fct=MM.3(), -pmodels = list(~1, ~1, ~factor(product))) -anova(met.mm.m2b, met.mm.m1) # model reduction not possible - -} -\keyword{models} -\keyword{nonlinear} diff --git a/man/NEC.2.Rd b/man/NEC.2.Rd new file mode 100644 index 00000000..e765aad1 --- /dev/null +++ b/man/NEC.2.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/nec.R +\name{NEC.2} +\alias{NEC.2} +\title{Two-parameter NEC model} +\usage{ +NEC.2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) +} +\arguments{ +\item{upper}{numeric value. The fixed upper limit in the model. Default is 1.} + +\item{fixed}{numeric vector of length 2 specifying fixed parameters (NAs for free parameters).} + +\item{names}{character vector of parameter names.} + +\item{...}{additional arguments passed to \code{\link{NEC}}.} +} +\value{ +A list (see \code{\link{NEC}}). +} +\description{ +Convenience function for the NEC model with lower limit fixed at 0 and upper limit fixed. +} +\seealso{ +\code{\link{NEC}}, \code{\link{NEC.3}}, \code{\link{NEC.4}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/NEC.3.Rd b/man/NEC.3.Rd new file mode 100644 index 00000000..59adf519 --- /dev/null +++ b/man/NEC.3.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/nec.R +\name{NEC.3} +\alias{NEC.3} +\title{Three-parameter NEC model} +\usage{ +NEC.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) +} +\arguments{ +\item{fixed}{numeric vector of length 3 specifying fixed parameters (NAs for free parameters).} + +\item{names}{character vector of parameter names.} + +\item{...}{additional arguments passed to \code{\link{NEC}}.} +} +\value{ +A list (see \code{\link{NEC}}). +} +\description{ +Convenience function for the NEC model with the lower limit fixed at 0. +} +\seealso{ +\code{\link{NEC}}, \code{\link{NEC.2}}, \code{\link{NEC.4}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/NEC.4.Rd b/man/NEC.4.Rd new file mode 100644 index 00000000..a22386c2 --- /dev/null +++ b/man/NEC.4.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/nec.R +\name{NEC.4} +\alias{NEC.4} +\title{Four-parameter NEC model} +\usage{ +NEC.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) +} +\arguments{ +\item{fixed}{numeric vector of length 4 specifying fixed parameters (NAs for free parameters).} + +\item{names}{character vector of parameter names.} + +\item{...}{additional arguments passed to \code{\link{NEC}}.} +} +\value{ +A list (see \code{\link{NEC}}). +} +\description{ +Convenience function for the full four-parameter NEC model. +} +\seealso{ +\code{\link{NEC}}, \code{\link{NEC.2}}, \code{\link{NEC.3}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/NEC.Rd b/man/NEC.Rd index e5165966..4e3107ad 100644 --- a/man/NEC.Rd +++ b/man/NEC.Rd @@ -1,88 +1,52 @@ -\name{NEC} - -\Rdversion{1.1} - -\alias{NEC} -\alias{NEC.2} -\alias{NEC.3} -\alias{NEC.4} - -\title{ - Dose-response model for estimation of no effect concentration (NEC). -} - -\description{ - The no effect concentration has been proposed as an alternative to both the classical no observed effect concentration - (NOEC) and the regression-based EC/ED approach. The NEC model is a dose-response model with a threshold below - which the response is assumed constant and equal to the control response. -} - -\usage{ - NEC(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), fctName, fctText) - - NEC.2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) - - NEC.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) - - NEC.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) - -} - -\arguments{ - \item{fixed}{numeric vector specifying which parameters are fixed and at what value they are fixed. - NAs are used for parameters that are not fixed.} - \item{names}{a vector of character strings giving the names of the parameters (should not contain ":"). - The default is reasonable (see under 'Usage').} - \item{fctName}{optional character string used internally by convenience functions.} - \item{fctText}{optional character string used internally by convenience functions.} - \item{upper}{numeric value. The fixed, upper limit in the model. Default is 1.} - \item{...}{additional arguments in \code{\link{NEC}}} -} - - -\details{ - The NEC model function proposed by Pires \emph{et al} (2002) is defined as follows - - \deqn{ f(x) = c + (d-c)\exp(-b(x-e)I(x-e)) + \frac{d2}{1+\exp(b2(\log(x)-\log(e2)))}} - - where \eqn{I(x-e)} is the indicator function. It is equal to 0 for \eqn{x<=e} and equal 1 for \eqn{x>e}. - - In other words: The parameter e in \code{NEC} in "drc" corresponds to the parameter c' in Pires \emph{et al} (2002), - the parameter b in \code{NEC} in "drc" corresponds to the parameter m' in Pires \emph{et al} (2002), the parameter d - in \code{NEC} in "drc" corresponds to the parameter l' in Pires \emph{et al} (2002), and finally the parameter c in - \code{NEC} in "drc" (the lower horizontal limit) is (implictly) fixed at 0 in Pires \emph{et al} (2002) -} - -\value{ - The value returned is a list containing the nonlinear function, the self starter function - and the parameter names. -} -\references{ - - Pires, A. M., Branco, J. A., Picado, A., Mendonca, E. (2002) - Models for the estimation of a 'no effect concentration', - \emph{Environmetrics}, \bold{13}, 15--27. - -} -\author{ - Christian Ritz -} - -%\note{} - -%\seealso{} - -\examples{ - -nec.m1 <- drm(rootl~conc, data=ryegrass, fct=NEC.4()) - -summary(nec.m1) - -plot(nec.m1) - -abline(v=coef(nec.m1)[4], lty=2) # showing the estimated threshold - -} - -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/nec.R +\name{NEC} +\alias{NEC} +\title{No Effect Concentration (NEC) dose-response model} +\usage{ +NEC(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), fctName, fctText) +} +\arguments{ +\item{fixed}{numeric vector specifying which parameters are fixed and at what value they are fixed. +NAs are used for parameters that are not fixed.} + +\item{names}{a vector of character strings giving the names of the parameters (should not contain ":"). +The default is reasonable (see under 'Usage').} + +\item{fctName}{optional character string used internally by convenience functions.} + +\item{fctText}{optional character string used internally by convenience functions.} +} +\value{ +A list containing the nonlinear function, the self starter function +and the parameter names. +} +\description{ +The NEC model is a dose-response model with a threshold below which the response is assumed +constant and equal to the control response. It has been proposed as an alternative to both the +classical NOEC and the regression-based EC/ED approach. +} +\details{ +The NEC model function proposed by Pires et al (2002) is: +\deqn{f(x) = c + (d-c)\exp(-b(x-e)I(x-e))} +where \eqn{I(x-e)} is the indicator function equal to 0 for \eqn{x<=e} and 1 for \eqn{x>e}. +} +\examples{ +nec.m1 <- drm(rootl ~ conc, data = ryegrass, fct = NEC.4()) +summary(nec.m1) +plot(nec.m1) + +} +\references{ +Pires, A. M., Branco, J. A., Picado, A., Mendonca, E. (2002) +Models for the estimation of a 'no effect concentration', +\emph{Environmetrics}, \bold{13}, 15--27. +} +\seealso{ +\code{\link{NEC.2}}, \code{\link{NEC.3}}, \code{\link{NEC.4}}, \code{\link{drm}} +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/O.mykiss.Rd b/man/O.mykiss.Rd new file mode 100644 index 00000000..4661a040 --- /dev/null +++ b/man/O.mykiss.Rd @@ -0,0 +1,59 @@ +\name{O.mykiss} + +\alias{O.mykiss} + +\docType{data} + +\title{Test data from a 21 day fish test} + +\description{ + Test data from a 21 day fish test following the guidelines OECD GL204, + using the test organism Rainbow trout \emph{Oncorhynchus mykiss}. +} + +\usage{data(O.mykiss)} + +\format{ + A data frame with 70 observations on the following 2 variables. + \describe{ + \item{\code{conc}}{a numeric vector of concentrations (mg/l)} + \item{\code{weight}}{a numeric vector of wet weights (g)} + } +} + +\details{ + Weights are measured after 28 days. +} + +\source{ + Organisation for Economic Co-operation and Development (OECD) (2006) + \emph{CURRENT APPROACHES IN THE STATISTICAL ANALYSIS OF ECOTOXICITY DATA: A GUIDANCE TO APPLICATION - ANNEXES}, + Paris (p. 65). +} + +\references{ + Organisation for Economic Co-operation and Development (OECD) (2006) + \emph{CURRENT APPROACHES IN THE STATISTICAL ANALYSIS OF ECOTOXICITY DATA: A GUIDANCE TO APPLICATION - ANNEXES}, + Paris (pp. 80--85). +} + +\examples{ +library(drc) + +head(O.mykiss) + +## Fitting exponential model +O.mykiss.m1 <- drm(weight ~ conc, data = O.mykiss, fct = EXD.2(), na.action = na.omit) +modelFit(O.mykiss.m1) +summary(O.mykiss.m1) + +## Fitting same model with transform-both-sides approach +O.mykiss.m2 <- boxcox(O.mykiss.m1 , method = "anova") +summary(O.mykiss.m2) +# no need for a transformation + +## Plotting the fit +plot(O.mykiss.m1, type = "all", xlim = c(0, 500), ylim = c(0,4), +xlab = "Concentration (mg/l)", ylab = "Weight (g)", broken = TRUE) +} +\keyword{datasets} diff --git a/man/P.promelas.Rd b/man/P.promelas.Rd new file mode 100644 index 00000000..e9477d00 --- /dev/null +++ b/man/P.promelas.Rd @@ -0,0 +1,54 @@ +\name{P.promelas} + +\alias{P.promelas} + +\docType{data} + +\title{Effect of sodium pentachlorophenate on growth of fathead minnow} + +\description{ + Fathead minnows (\emph{Pimephales promelas}) were exposed to sodium pentachlorophenate + concentrations ranging from 32 to 512 micro g/L in a 7-day larval survival and growth test. + The average dry weight was measured. +} + +\usage{data(P.promelas)} + +\format{ + A data frame with 24 observations on the following 2 variables. + \describe{ + \item{\code{conc}}{a numeric vector of sodium pentachlorophenate concentrations (micro g/L).} + \item{\code{dryweight}}{a numeric vector dry weights (mg)} + } +} + +\details{ + The data are analysed in Bruce and Versteeg (1992) using a log-normal + dose-response model (using the logarithm with base 10). +} + +\source{ + Bruce, R. D. and Versteeg, D. J. (1992) A statistical procedure for modeling continuous toxicity data, + \emph{Environ. Toxicol. Chem.}, \bold{11}, 1485--1494. +} + +%\references{} + +\examples{ +library(drc) + +## Model with ED50 on log scale as parameter +p.prom.m1<-drm(dryweight~conc, data=P.promelas, fct=LN.3()) + +plot(fitted(p.prom.m1), residuals(p.prom.m1)) + +plot(p.prom.m1, type="all", broken=TRUE, xlim=c(0,1000)) +summary(p.prom.m1) +ED(p.prom.m1, c(10,20,50), interval="delta") + +## Model with ED50 as parameter +p.prom.m2<-drm(dryweight~conc, data=P.promelas, fct=LN.3(loge=TRUE)) +summary(p.prom.m2) +ED(p.prom.m2, c(10,20,50), interval="fls") +} +\keyword{datasets} diff --git a/man/PR.Rd b/man/PR.Rd index f8e335a5..7bd352de 100644 --- a/man/PR.Rd +++ b/man/PR.Rd @@ -1,54 +1,36 @@ -\name{PR} - -\alias{PR} - -\title{Expected or predicted response} - -\description{ - The function returns the expected or predicted response for specified dose values. -} - -\usage{ - PR(object, xVec, ...) -} - -\arguments{ - \item{object}{object of class \code{drc} obtaining fitting a dose-response model.} - \item{xVec}{numeric vector of dose values.} - \item{\dots}{additional arguments to be supplied to \code{\link[drc]{predict.drc}}. No effect at the moment.} -} - -\details{ - This function is a convenience function for easy access to predicted values. -} - -\value{ - A numeric vector of predicted values or possibly a matrix of predicted values and corresponding standard errors. -} - -%\references{} - -\author{ - Christian Ritz after a suggestion from Andrew Kniss. -} - -%\note{ ~~further notes~~ } - -\seealso{Predictions can also be obtained using \code{\link[drc]{predict.drc}}.} - -\examples{ - -ryegrass.m1 <- drm(ryegrass, fct = LL.4()) -PR(ryegrass.m1, c(5, 10)) - -ryegrass.m2 <- drm(ryegrass, fct = LL2.4()) -PR(ryegrass.m2, c(5, 10)) - -spinach.m1 <- drm(SLOPE~DOSE, CURVE, data=spinach, fct = LL.4()) -PR(spinach.m1, c(5, 10)) - -} -% Add one or more standard keywords, see file 'KEYWORDS' in the -% R documentation directory. -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/pr.R +\name{PR} +\alias{PR} +\title{Expected or predicted response} +\usage{ +PR(object, xVec, ...) +} +\arguments{ +\item{object}{object of class \code{drc} obtained from fitting a dose-response model.} + +\item{xVec}{numeric vector of dose values.} + +\item{...}{additional arguments passed to \code{\link[drc]{predict.drc}}.} +} +\value{ +A numeric vector of predicted values or possibly a matrix of predicted values +and corresponding standard errors. +} +\description{ +Returns the expected or predicted response for specified dose values. This is a +convenience function for easy access to predicted values. +} +\examples{ +ryegrass.m1 <- drm(ryegrass, fct = LL.4()) +PR(ryegrass.m1, c(5, 10)) + +} +\seealso{ +\code{\link[drc]{predict.drc}} +} +\author{ +Christian Ritz after a suggestion from Andrew Kniss. +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/RScompetition.Rd b/man/RScompetition.Rd new file mode 100644 index 00000000..0e9c5da9 --- /dev/null +++ b/man/RScompetition.Rd @@ -0,0 +1,55 @@ +\name{RScompetition} + +\alias{RScompetition} + +\docType{data} + +\title{Competition between two biotypes} + +\description{ + To assess the competitive ability between two biotypes of \emph{Lolium rigidum}, one resistant to glyphosate + and the other a sensitive wild type, the density of resistant and sensitive biotypes was counted after + germination. +} + +\usage{data(RScompetition)} + +\format{ + A data frame with 49 observations on the following 3 variables. + \describe{ + \item{\code{z}}{a numeric vector with densities of the resistant biotype (plants/m2)} + \item{\code{x}}{a numeric vector with densities of the sensitive biotype (plants/m2)} + \item{\code{biomass}}{a numeric vector of biomass weight (g/plant)} + } +} + +\details{ + A hyperbolic model (Jensen, 1993) is describing the data reasonably well. +} + +\source{ + The dataset is from Pedersen et al (2007). +} + +\references{ + Jensen, J. E. (1993) Fitness of herbicide-resistant weed biotypes described by competition models, + \emph{Proceedings of the 8th EWRS Symposium, 14-16 June, Braunschweig, Germany}, + \bold{1}, 25--32. + + Pedersen, B. P. and Neve, P. and Andreasen, C. and Powles, S. (2007) Ecological fitness of a glyphosate + resistant \emph{Lolium rigidum} population: Growth and seed production along a competition gradient, + \emph{Basic and Applied Ecology}, \bold{8}, 258--268. +} + +\examples{ +library(drc) + +## Displaying the data +head(RScompetition) + +## Plotting biomass as a function of sensitive biotype density +plot(biomass ~ x, data = RScompetition, xlab = "Density of sensitive biotype", +ylab = "Biomass (g/plant)") +} + +\keyword{datasets} diff --git a/man/Rsq.Rd b/man/Rsq.Rd new file mode 100644 index 00000000..3ef89688 --- /dev/null +++ b/man/Rsq.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Rsq.R +\name{Rsq} +\alias{Rsq} +\title{R-squared for dose-response models} +\usage{ +Rsq(object) +} +\arguments{ +\item{object}{an object of class 'drc'.} +} +\value{ +Invisibly returns a matrix of R-squared values. For single-curve models, a 1x1 matrix. +For multi-curve models, includes per-curve values and a total R-squared. +} +\description{ +Calculates and displays R-squared values for a fitted dose-response model. For models +with multiple curves, per-curve and total R-squared values are returned. +} +\details{ +R-squared is computed as \eqn{1 - RSS / TSS} where RSS is the residual sum of squares +(obtained via \code{\link[=rss]{rss()}}) and TSS is the total sum of squares. +} +\seealso{ +\code{\link[=rss]{rss()}} for the underlying residual sum of squares. +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/S.alba.Rd b/man/S.alba.Rd new file mode 100644 index 00000000..bed14428 --- /dev/null +++ b/man/S.alba.Rd @@ -0,0 +1,54 @@ +\name{S.alba} + +\alias{S.alba} + +\docType{data} + +\title{Potency of two herbicides} + +\description{ + Data are from an experiment, comparing the potency of the two herbicides glyphosate and bentazone in + white mustard \emph{Sinapis alba}. +} + +\usage{data(S.alba)} + +\format{ + A data frame with 68 observations on the following 3 variables. + \describe{ + \item{\code{Dose}}{a numeric vector containing the dose in g/ha.} + \item{\code{Herbicide}}{a factor with levels \code{Bentazone} \code{Glyphosate} (the two herbicides applied).} + \item{\code{DryMatter}}{a numeric vector containing the response (dry matter in g/pot).} + } +} + +\details{ + The lower and upper limits for the two herbicides can be assumed identical, whereas slopes and ED50 values + are different (in the log-logistic model). +} + +\source{ + Christensen, M. G. and Teicher, H. B., and Streibig, J. C. (2003) Linking fluorescence + induction curve and biomass in herbicide screening, \emph{Pest Management Science}, + \bold{59}, 1303--1310. +} + + +\examples{ +library(drc) + +## Fitting a log-logistic model with +## common lower and upper limits +S.alba.LL.4.1 <- drm(DryMatter~Dose, Herbicide, data=S.alba, fct = LL.4(), +pmodels=data.frame(Herbicide,1,1,Herbicide)) +summary(S.alba.LL.4.1) + +## Applying the optimal transform-both-sides Box-Cox transformation +## (using the initial model fit) +S.alba.LL.4.2 <- boxcox(S.alba.LL.4.1, method = "anova") +summary(S.alba.LL.4.2) + +## Plotting fitted regression curves together with the data +plot(S.alba.LL.4.2) +} +\keyword{datasets} diff --git a/man/S.alba.comp.Rd b/man/S.alba.comp.Rd new file mode 100644 index 00000000..4e2efbc6 --- /dev/null +++ b/man/S.alba.comp.Rd @@ -0,0 +1,56 @@ +\name{S.alba.comp} + +\alias{S.alba.comp} + +\docType{data} + +\title{Potency of two herbicides} + +\description{ + Data are from an experiment, comparing the potency of the two herbicides glyphosate and bentazone in + white mustard \emph{Sinapis alba}. +} + +\usage{data(S.alba.comp)} + +\format{ + A data frame with 141 observations on the following 8 variables. + \describe{ + \item{\code{exp}}{a factor with levels ben1, ben2, gly1, gly2 indicating which experiment each observation belongs to.} + \item{\code{herbicide}}{a factor with levels \code{Bentazone} \code{Glyphosate} (the two herbicides applied).} + \item{\code{dose}}{a numeric vector containing the dose in g/ha.} + \item{\code{drymatter}}{a numeric vector containing the response (dry matter in g/pot).} + \item{\code{Tf}}{a numeric vector .} + \item{\code{area}}{a numeric vector .} + \item{\code{Fo}}{a numeric vector .} + \item{\code{Fm}}{a numeric vector .} + } +} + +\details{ + The lower and upper limits for the two herbicides can be assumed identical, whereas slopes and ED50 values + are different (in the log-logistic model). +} + +\source{ + Christensen, M. G. and Teicher, H. B., and Streibig, J. C. (2003) Linking fluorescence + induction curve and biomass in herbicide screening, \emph{Pest Management Science}, + \bold{59}, 1303--1310. +} + + +\examples{ +library(drc) + +## Displaying the data +head(S.alba.comp) + +## Fitting a four-parameter log-logistic model with common upper and lower limits +S.alba.comp.m1 <- drm(drymatter ~ dose, herbicide, data = S.alba.comp, fct = LL.4(), +pmodels = list(~herbicide, ~1, ~1, ~herbicide)) +summary(S.alba.comp.m1) + +## Plotting the fitted curves +plot(S.alba.comp.m1, xlab = "Dose (g/ha)", ylab = "Dry matter (g/pot)") +} +\keyword{datasets} diff --git a/man/S.capricornutum.Rd b/man/S.capricornutum.Rd new file mode 100644 index 00000000..036b3ed6 --- /dev/null +++ b/man/S.capricornutum.Rd @@ -0,0 +1,62 @@ +\name{S.capricornutum} + +\alias{S.capricornutum} + +\docType{data} + +\title{Effect of cadmium on growth of green alga} + +\description{ + Green alga (\emph{Selenastrum capricornutum}) was exposed to cadmium chloride concentrations + ranging from 5 to 80 micro g/L in geometric progression in 4-day population growth test. +} + +\usage{data(S.capricornutum)} + +\format{ + A data frame with 18 observations on the following 2 variables. + \describe{ + \item{\code{conc}}{a numeric vector of cadmium chloride concentrations (micro g/L)} + \item{\code{count}}{a numeric vector of algal counts (10000 x cells /ml)} + } +} + +\details{ + The data are analysed in Bruce and Versteeg (1992) using a log-normal + dose-response model (using the logarithm with base 10). +} + +\source{ + Bruce, R. D. and Versteeg, D. J. (1992) A statistical procedure for modeling continuous toxicity data, + \emph{Environ. Toxicol. Chem.}, \bold{11}, 1485--1494. +} + +%\references{} + +\examples{ +library(drc) + +## Fitting 3-parameter log-normal model +s.cap.m1 <- drm(count ~ conc, data = S.capricornutum, fct = LN.3()) + +## Residual plot +plot(fitted(s.cap.m1), residuals(s.cap.m1)) + +## Fitting model with transform-both-sides approach +s.cap.m2 <- boxcox(s.cap.m1, method = "anova") +summary(s.cap.m2) + +## Residual plot after transformation (looks better) +plot(fitted(s.cap.m2), residuals(s.cap.m2)) + +## Calculating ED values on log scale +ED(s.cap.m2, c(10, 20, 50), interval="delta") + +## Fitting model with ED50 as parameter +## (for comparison) +s.cap.m3 <- drm(count ~ conc, data = S.capricornutum, fct = LN.3(loge=TRUE)) +s.cap.m4 <- boxcox(s.cap.m3, method = "anova") +summary(s.cap.m4) +ED(s.cap.m4, c(10, 20, 50), interval = "fls") +} +\keyword{datasets} diff --git a/man/TCDD.Rd b/man/TCDD.Rd new file mode 100644 index 00000000..85f7fad7 --- /dev/null +++ b/man/TCDD.Rd @@ -0,0 +1,51 @@ +\name{TCDD} + +\alias{TCDD} + +\docType{data} + +\title{Liver tumor incidence} + +\description{ + Liver tumor incidence in Sprague-Dawley rats exposed to the chemical like 2,3,7,8-tetrachlorodibenzo-pdioxin +(TCDD). +} + +\usage{data(TCDD)} + +\format{ + A data frame with 6 observations on the following 3 variables. + \describe{ + \item{\code{conc}}{a numeric vector reporting the concentration of TCDD (ng/kg)} + \item{\code{total}}{a numeric vector} + \item{\code{incidence}}{a numeric vector} + } +} + +%\details{} + +\source{ + R. Kociba, D. Keyes, J. Beyer, R. Carreon, C. Wade, D. Dittenber, R. Kalnins, L. Frauson, +C. Park, S. Barnard, R. Hummel, and C. Humiston (1978). Results of a two-year chronic toxicity +and oncogenicity study of 2,3,7,8-tetrachlorodibenzo-p-dioxin in rats. Toxicology and +Applied Pharmacology, \bold{46(2)}:279--303. +} + +%\references{} + +\examples{ +library(drc) + +## Displaying the data +head(TCDD) + +## Fitting a two-parameter log-logistic model for binomial response +TCDD.m1 <- drm(incidence/total ~ conc, weights = total, +data = TCDD, fct = LL.2(), type = "binomial") +summary(TCDD.m1) + +## Plotting the fitted curve +plot(TCDD.m1, xlab = "Concentration of TCDD (ng/kg)", ylab = "Tumor incidence") +} + +\keyword{datasets} diff --git a/man/UCRS.4a.Rd b/man/UCRS.4a.Rd new file mode 100644 index 00000000..0e4537c8 --- /dev/null +++ b/man/UCRS.4a.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ucedergreen.R +\name{UCRS.4a} +\alias{UCRS.4a} +\title{U-shaped CRS model with lower limit 0 (alpha=1)} +\usage{ +UCRS.4a(names = c("b", "d", "e", "f"), ...) +} +\arguments{ +\item{names}{a vector of character strings giving the names of the parameters.} + +\item{...}{additional arguments passed to \code{\link{ucedergreen}}.} +} +\value{ +A list (see \code{\link{ucedergreen}}). +} +\description{ +Four-parameter u-shaped CRS hormesis model with lower limit fixed at 0 and alpha=1. +} +\seealso{ +\code{\link{ucedergreen}}, \code{\link{UCRS.5a}}, \code{\link{CRS.4a}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/UCRS.4b.Rd b/man/UCRS.4b.Rd new file mode 100644 index 00000000..f9e03b67 --- /dev/null +++ b/man/UCRS.4b.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ucedergreen.R +\name{UCRS.4b} +\alias{UCRS.4b} +\title{U-shaped CRS model with lower limit 0 (alpha=0.5)} +\usage{ +UCRS.4b(names = c("b", "d", "e", "f"), ...) +} +\arguments{ +\item{names}{a vector of character strings giving the names of the parameters.} + +\item{...}{additional arguments passed to \code{\link{ucedergreen}}.} +} +\value{ +A list (see \code{\link{ucedergreen}}). +} +\description{ +Four-parameter u-shaped CRS hormesis model with lower limit fixed at 0 and alpha=0.5. +} +\seealso{ +\code{\link{ucedergreen}}, \code{\link{UCRS.4a}}, \code{\link{CRS.4b}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/UCRS.4c.Rd b/man/UCRS.4c.Rd new file mode 100644 index 00000000..1f0e26cc --- /dev/null +++ b/man/UCRS.4c.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ucedergreen.R +\name{UCRS.4c} +\alias{UCRS.4c} +\title{U-shaped CRS model with lower limit 0 (alpha=0.25)} +\usage{ +UCRS.4c(names = c("b", "d", "e", "f"), ...) +} +\arguments{ +\item{names}{a vector of character strings giving the names of the parameters.} + +\item{...}{additional arguments passed to \code{\link{ucedergreen}}.} +} +\value{ +A list (see \code{\link{ucedergreen}}). +} +\description{ +Four-parameter u-shaped CRS hormesis model with lower limit fixed at 0 and alpha=0.25. +} +\seealso{ +\code{\link{ucedergreen}}, \code{\link{UCRS.4a}}, \code{\link{CRS.4c}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/UCRS.5a.Rd b/man/UCRS.5a.Rd new file mode 100644 index 00000000..c5bf764c --- /dev/null +++ b/man/UCRS.5a.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ucedergreen.R +\name{UCRS.5a} +\alias{UCRS.5a} +\title{U-shaped CRS five-parameter model (alpha=1)} +\usage{ +UCRS.5a(names = c("b", "c", "d", "e", "f"), ...) +} +\arguments{ +\item{names}{a vector of character strings giving the names of the parameters.} + +\item{...}{additional arguments passed to \code{\link{ucedergreen}}.} +} +\value{ +A list (see \code{\link{ucedergreen}}). +} +\description{ +Five-parameter u-shaped CRS hormesis model with alpha=1. +} +\seealso{ +\code{\link{ucedergreen}}, \code{\link{UCRS.4a}}, \code{\link{CRS.5a}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/UCRS.5b.Rd b/man/UCRS.5b.Rd new file mode 100644 index 00000000..c321b3f2 --- /dev/null +++ b/man/UCRS.5b.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ucedergreen.R +\name{UCRS.5b} +\alias{UCRS.5b} +\title{U-shaped CRS five-parameter model (alpha=0.5)} +\usage{ +UCRS.5b(names = c("b", "c", "d", "e", "f"), ...) +} +\arguments{ +\item{names}{a vector of character strings giving the names of the parameters.} + +\item{...}{additional arguments passed to \code{\link{ucedergreen}}.} +} +\value{ +A list (see \code{\link{ucedergreen}}). +} +\description{ +Five-parameter u-shaped CRS hormesis model with alpha=0.5. +} +\seealso{ +\code{\link{ucedergreen}}, \code{\link{UCRS.5a}}, \code{\link{CRS.5b}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/UCRS.5c.Rd b/man/UCRS.5c.Rd new file mode 100644 index 00000000..65bac9d9 --- /dev/null +++ b/man/UCRS.5c.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ucedergreen.R +\name{UCRS.5c} +\alias{UCRS.5c} +\title{U-shaped CRS five-parameter model (alpha=0.25)} +\usage{ +UCRS.5c(names = c("b", "c", "d", "e", "f"), ...) +} +\arguments{ +\item{names}{a vector of character strings giving the names of the parameters.} + +\item{...}{additional arguments passed to \code{\link{ucedergreen}}.} +} +\value{ +A list (see \code{\link{ucedergreen}}). +} +\description{ +Five-parameter u-shaped CRS hormesis model with alpha=0.25. +} +\seealso{ +\code{\link{ucedergreen}}, \code{\link{UCRS.5a}}, \code{\link{CRS.5c}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/W1.2.Rd b/man/W1.2.Rd new file mode 100644 index 00000000..804afaac --- /dev/null +++ b/man/W1.2.Rd @@ -0,0 +1,50 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/weibull1.R +\name{W1.2} +\alias{W1.2} +\alias{w2} +\title{Two-parameter Weibull type 1 model} +\usage{ +W1.2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) + +w2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) +} +\arguments{ +\item{upper}{numeric value giving the fixed upper limit. The default is 1.} + +\item{fixed}{numeric vector of length 2. Specifies which parameters are +fixed and at what value. Use \code{NA} for parameters that are not fixed.} + +\item{names}{character vector of length 2 giving the names of the +parameters. The default is \code{c("b", "e")}.} + +\item{\dots}{additional arguments passed to \code{\link{weibull1}}, most +notably \code{method} (a character string: \code{"1"} (default), +\code{"2"}, \code{"3"}, or \code{"4"}) which selects the self-starter +method for obtaining starting values. See \code{\link{weibull1}} for +details.} +} +\value{ +A list of class \code{Weibull-1} containing the nonlinear function, +self starter function, and parameter names. +} +\description{ +A two-parameter Weibull type 1 model with the lower limit fixed at 0 +and the upper limit fixed at a specified value (default 1). +} +\details{ +The model is given by the expression +\deqn{f(x) = upper \exp(-\exp(b(\log(x) - \log(e))))} + +This is mostly used for binomial/quantal responses. +} +\examples{ +earthworms.m1 <- drm(number/total ~ dose, weights = total, + data = earthworms, fct = W1.2(), type = "binomial") + +} +\seealso{ +\code{\link{weibull1}}, \code{\link{W1.3}}, \code{\link{W1.4}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/W1.3.Rd b/man/W1.3.Rd new file mode 100644 index 00000000..7ec69a7b --- /dev/null +++ b/man/W1.3.Rd @@ -0,0 +1,47 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/weibull1.R +\name{W1.3} +\alias{W1.3} +\alias{w3} +\title{Three-parameter Weibull type 1 model} +\usage{ +W1.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) + +w3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) +} +\arguments{ +\item{fixed}{numeric vector of length 3. Specifies which parameters are +fixed and at what value. Use \code{NA} for parameters that are not fixed.} + +\item{names}{character vector of length 3 giving the names of the +parameters. The default is \code{c("b", "d", "e")}.} + +\item{\dots}{additional arguments passed to \code{\link{weibull1}}, most +notably \code{method} (a character string: \code{"1"} (default), +\code{"2"}, \code{"3"}, or \code{"4"}) which selects the self-starter +method for obtaining starting values. See \code{\link{weibull1}} for +details.} +} +\value{ +A list of class \code{Weibull-1} containing the nonlinear function, +self starter function, and parameter names. +} +\description{ +A three-parameter Weibull type 1 model with the lower limit fixed at 0. +} +\details{ +The model is given by the expression +\deqn{f(x) = d \exp(-\exp(b(\log(x) - \log(e))))} + +This is a special case of the four-parameter Weibull type 1 model +where the lower limit is fixed at 0. +} +\examples{ +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.3()) + +} +\seealso{ +\code{\link{weibull1}}, \code{\link{W1.2}}, \code{\link{W1.4}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/W1.3u.Rd b/man/W1.3u.Rd new file mode 100644 index 00000000..a1bb6105 --- /dev/null +++ b/man/W1.3u.Rd @@ -0,0 +1,43 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/weibull1.R +\name{W1.3u} +\alias{W1.3u} +\title{Three-parameter Weibull type 1 model with upper limit fixed} +\usage{ +W1.3u(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...) +} +\arguments{ +\item{upper}{numeric value giving the fixed upper limit. The default is 1.} + +\item{fixed}{numeric vector of length 3. Specifies which parameters are +fixed and at what value. Use \code{NA} for parameters that are not fixed.} + +\item{names}{character vector of length 3 giving the names of the +parameters. The default is \code{c("b", "c", "e")}.} + +\item{\dots}{additional arguments passed to \code{\link{weibull1}}, most +notably \code{method} (a character string: \code{"1"} (default), +\code{"2"}, \code{"3"}, or \code{"4"}) which selects the self-starter +method for obtaining starting values. See \code{\link{weibull1}} for +details.} +} +\value{ +A list of class \code{Weibull-1} containing the nonlinear function, +self starter function, and parameter names. +} +\description{ +A three-parameter Weibull type 1 model with the upper limit fixed +(default 1). +} +\details{ +The model is given by the expression +\deqn{f(x) = c + (upper - c) \exp(-\exp(b(\log(x) - \log(e))))} + +This is a special case of the four-parameter Weibull type 1 model +where the upper limit is fixed at a specified value. +} +\seealso{ +\code{\link{weibull1}}, \code{\link{W1.3}}, \code{\link{W1.4}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/W1.4.Rd b/man/W1.4.Rd new file mode 100644 index 00000000..c0c9566f --- /dev/null +++ b/man/W1.4.Rd @@ -0,0 +1,52 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/weibull1.R +\name{W1.4} +\alias{W1.4} +\alias{w4} +\title{Four-parameter Weibull type 1 model} +\usage{ +W1.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) + +w4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) +} +\arguments{ +\item{fixed}{numeric vector of length 4. Specifies which parameters are +fixed and at what value. Use \code{NA} for parameters that are not fixed.} + +\item{names}{character vector of length 4 giving the names of the +parameters. The default is \code{c("b", "c", "d", "e")}.} + +\item{\dots}{additional arguments passed to \code{\link{weibull1}}, most +notably \code{method} (a character string: \code{"1"} (default), +\code{"2"}, \code{"3"}, or \code{"4"}) which selects the self-starter +method for obtaining starting values. See \code{\link{weibull1}} for +details.} +} +\value{ +A list of class \code{Weibull-1} containing the nonlinear function, +self starter function, and parameter names. +} +\description{ +A four-parameter Weibull type 1 model. +} +\details{ +The model is given by the expression +\deqn{f(x) = c + (d - c) \exp(-\exp(b(\log(x) - \log(e))))} +} +\examples{ +terbuthylazin.m1 <- drm(rgr ~ dose, data = terbuthylazin, fct = W1.4()) + +} +\references{ +Seber, G. A. F. and Wild, C. J. (1989) +\emph{Nonlinear Regression}, New York: Wiley & Sons (pp. 338--339). + +Ritz, C. (2009) +Towards a unified approach to dose-response modeling in ecotoxicology. +\emph{Environ Toxicol Chem}, \bold{29}, 220--229. +} +\seealso{ +\code{\link{weibull1}}, \code{\link{W1.2}}, \code{\link{W1.3}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/W2.2.Rd b/man/W2.2.Rd new file mode 100644 index 00000000..34ebb430 --- /dev/null +++ b/man/W2.2.Rd @@ -0,0 +1,43 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/weibull2.R +\name{W2.2} +\alias{W2.2} +\title{Two-parameter Weibull (type 2) model} +\usage{ +W2.2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) +} +\arguments{ +\item{upper}{numeric value giving the fixed upper limit (default 1).} + +\item{fixed}{numeric vector of length 2, specifying fixed parameters (use \code{NA} for +parameters that should be estimated).} + +\item{names}{character vector of length 2 giving the names of the parameters +(default \code{c("b", "e")}).} + +\item{...}{additional arguments passed to \code{\link{weibull2}}, most +notably \code{method} (a character string: \code{"1"} (default), +\code{"2"}, \code{"3"}, or \code{"4"}) which selects the self-starter +method for obtaining starting values. See \code{\link{weibull2}} for +details.} +} +\value{ +A list of class \code{"Weibull-2"} as returned by \code{\link{weibull2}}. +} +\description{ +A two-parameter Weibull type 2 model with the lower limit fixed at 0 and the +upper limit fixed at a specified value. The model is given by the equation +\deqn{f(x) = \mathrm{upper} \cdot (1 - \exp(-\exp(b(\log(x) - \log(e)))))} +This model is primarily intended for binomial/quantal responses. +} +\examples{ +earthworms.m1 <- drm(number/total ~ dose, weights = total, + data = earthworms, fct = W2.2(), type = "binomial") + +} +\seealso{ +\code{\link{weibull2}}, \code{\link{W2.3}}, \code{\link{W2.4}}, +\code{\link{W1.2}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/W2.3.Rd b/man/W2.3.Rd new file mode 100644 index 00000000..d91586c7 --- /dev/null +++ b/man/W2.3.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/weibull2.R +\name{W2.3} +\alias{W2.3} +\title{Three-parameter Weibull (type 2) model} +\usage{ +W2.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) +} +\arguments{ +\item{fixed}{numeric vector of length 3, specifying fixed parameters (use \code{NA} for +parameters that should be estimated).} + +\item{names}{character vector of length 3 giving the names of the parameters +(default \code{c("b", "d", "e")}).} + +\item{...}{additional arguments passed to \code{\link{weibull2}}, most +notably \code{method} (a character string: \code{"1"} (default), +\code{"2"}, \code{"3"}, or \code{"4"}) which selects the self-starter +method for obtaining starting values. See \code{\link{weibull2}} for +details.} +} +\value{ +A list of class \code{"Weibull-2"} as returned by \code{\link{weibull2}}. +} +\description{ +A three-parameter Weibull type 2 model with the lower limit fixed at 0. +The model is given by the equation +\deqn{f(x) = d \cdot (1 - \exp(-\exp(b(\log(x) - \log(e)))))} +} +\examples{ +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W2.3()) + +} +\seealso{ +\code{\link{weibull2}}, \code{\link{W2.2}}, \code{\link{W2.4}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/W2.3u.Rd b/man/W2.3u.Rd new file mode 100644 index 00000000..32acba4e --- /dev/null +++ b/man/W2.3u.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/weibull2.R +\name{W2.3u} +\alias{W2.3u} +\title{Three-parameter Weibull (type 2) model with upper limit fixed} +\usage{ +W2.3u(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...) +} +\arguments{ +\item{upper}{numeric value giving the fixed upper limit (default 1).} + +\item{fixed}{numeric vector of length 3, specifying fixed parameters (use \code{NA} for +parameters that should be estimated).} + +\item{names}{character vector of length 3 giving the names of the parameters +(default \code{c("b", "c", "e")}).} + +\item{...}{additional arguments passed to \code{\link{weibull2}}, most +notably \code{method} (a character string: \code{"1"} (default), +\code{"2"}, \code{"3"}, or \code{"4"}) which selects the self-starter +method for obtaining starting values. See \code{\link{weibull2}} for +details.} +} +\value{ +A list of class \code{"Weibull-2"} as returned by \code{\link{weibull2}}. +} +\description{ +A three-parameter Weibull type 2 model with the upper limit fixed at a +specified value. The model is given by the equation +\deqn{f(x) = c + (\mathrm{upper} - c)(1 - \exp(-\exp(b(\log(x) - \log(e)))))} +} +\seealso{ +\code{\link{weibull2}}, \code{\link{W2.3}}, \code{\link{W2.4}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/W2.4.Rd b/man/W2.4.Rd new file mode 100644 index 00000000..cfe0863e --- /dev/null +++ b/man/W2.4.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/weibull2.R +\name{W2.4} +\alias{W2.4} +\title{Four-parameter Weibull (type 2) model} +\usage{ +W2.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) +} +\arguments{ +\item{fixed}{numeric vector of length 4, specifying fixed parameters (use \code{NA} for +parameters that should be estimated).} + +\item{names}{character vector of length 4 giving the names of the parameters +(default \code{c("b", "c", "d", "e")}).} + +\item{...}{additional arguments passed to \code{\link{weibull2}}, most +notably \code{method} (a character string: \code{"1"} (default), +\code{"2"}, \code{"3"}, or \code{"4"}) which selects the self-starter +method for obtaining starting values. See \code{\link{weibull2}} for +details.} +} +\value{ +A list of class \code{"Weibull-2"} as returned by \code{\link{weibull2}}. +} +\description{ +A four-parameter Weibull type 2 model. The model is given by the equation +\deqn{f(x) = c + (d - c)(1 - \exp(-\exp(b(\log(x) - \log(e)))))} +} +\examples{ +terbuthylazin.m1 <- drm(rgr ~ dose, data = terbuthylazin, fct = W2.4()) + +} +\seealso{ +\code{\link{weibull2}}, \code{\link{W2.2}}, \code{\link{W2.3}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/W2.Rd b/man/W2.Rd deleted file mode 100644 index 62ee760d..00000000 --- a/man/W2.Rd +++ /dev/null @@ -1,61 +0,0 @@ -\name{W1.2} - -\alias{W1.2} -\alias{w2} -\alias{W2.2} - -\title{The two-parameter Weibull functions} - -\description{ - 'W1.2' is the two-parameter Weibull function where the lower limit is fixed at 0 and the upper limit - is fixed at 1, mostly suitable for binomial/quantal responses. -} - -\usage{ - W1.2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) - - W2.2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) -} - -\arguments{ - \item{upper}{numeric value. The fixed, upper limit in the model. Default is 1.} - \item{fixed}{numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.} - \item{names}{a vector of character strings giving the names of the parameters. The default is reasonable.} - \item{...}{additional arguments to be passed from the convenience functions.} -} - -\details{ - The two-parameter Weibull type 1 model is given by the expression - \deqn{ f(x) = \exp(-\exp(b(\log(x)-\log(e)))).} - - The function is asymmetric about the inflection point, that is the parameter \eqn{\exp(e)}. -} - -\value{ - See \code{\link{weibull1}}. -} - -%\references{ ~put references to the literature/web site here ~ } - -\author{Christian Ritz} - -\note{ - This function is for use with the function \code{\link{drm}}. -} - -\seealso{ - Related functions are \code{\link{W1.3}}, \code{\link{W1.4}}, \code{\link{weibull1}} and \code{\link{weibull2}}. -} - -\examples{ - -## Fitting a two-parameter Weibull model -earthworms.m1 <- drm(number/total~dose, weights = total, -data = earthworms, fct = W1.2(), type = "binomial") - -summary(earthworms.m1) - -} -\keyword{models} -\keyword{nonlinear} diff --git a/man/W2x.3.Rd b/man/W2x.3.Rd new file mode 100644 index 00000000..51b24bc1 --- /dev/null +++ b/man/W2x.3.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/weibull2x.R +\name{W2x.3} +\alias{W2x.3} +\title{Three-parameter Weibull type 2 model with lag time} +\usage{ +W2x.3(fixed = c(NA, NA, NA), names = c("d", "e", "t0"), ...) +} +\arguments{ +\item{fixed}{numeric vector of length 3. Specifies which parameters are +fixed and at what value. Use \code{NA} for parameters that should be +estimated (default is \code{c(NA, NA, NA)}).} + +\item{names}{character vector of length 3 giving the names of the +parameters (default is \code{c("d", "e", "t0")}).} + +\item{\dots}{additional arguments passed to \code{\link{weibull2x}}.} +} +\value{ +A list of class \code{"Weibull-2"} containing the nonlinear +function, self starter function, and parameter names. +} +\description{ +A three-parameter Weibull type 2 model with lag time, where \code{b} is +fixed at 1 and \code{c} is fixed at 0. This is a convenience wrapper +around \code{\link{weibull2x}}. +} +\examples{ +spinach.m1 <- drm(SLOPE ~ DOSE, data = spinach, fct = W2x.3()) +summary(spinach.m1) + +} +\seealso{ +\code{\link{weibull2x}}, \code{\link{W2x.4}}, \code{\link{W2.3}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/W2x.4.Rd b/man/W2x.4.Rd new file mode 100644 index 00000000..a8661b50 --- /dev/null +++ b/man/W2x.4.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/weibull2x.R +\name{W2x.4} +\alias{W2x.4} +\title{Four-parameter Weibull type 2 model with lag time} +\usage{ +W2x.4(fixed = c(NA, NA, NA, NA), names = c("c", "d", "e", "t0"), ...) +} +\arguments{ +\item{fixed}{numeric vector of length 4. Specifies which parameters are +fixed and at what value. Use \code{NA} for parameters that should be +estimated (default is \code{c(NA, NA, NA, NA)}).} + +\item{names}{character vector of length 4 giving the names of the +parameters (default is \code{c("c", "d", "e", "t0")}).} + +\item{\dots}{additional arguments passed to \code{\link{weibull2x}}.} +} +\value{ +A list of class \code{"Weibull-2"} containing the nonlinear +function, self starter function, and parameter names. +} +\description{ +A four-parameter Weibull type 2 model with lag time, where \code{b} is +fixed at 1. This is a convenience wrapper around \code{\link{weibull2x}}. +} +\examples{ +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W2x.4()) + +} +\seealso{ +\code{\link{weibull2x}}, \code{\link{W2x.3}}, \code{\link{W2.4}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/W3.Rd b/man/W3.Rd deleted file mode 100644 index 091c7d5b..00000000 --- a/man/W3.Rd +++ /dev/null @@ -1,71 +0,0 @@ -\name{W1.3} - -\alias{W1.3} -\alias{w3} -\alias{W2.3} -\alias{W2x.3} - -\alias{W1.3u} -\alias{W2.3u} - -\title{The three-parameter Weibull functions} - -\description{ - 'W1.3' and \code{W2.3} provide the three-parameter Weibull function, self starter function and names of the parameters. - - 'W1.3u' and 'W2.3u' provide three-parameter Weibull function where the upper limit is equal to 1, mainly - for use with binomial/quantal response. -} - -\usage{ - W1.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) - - W2.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) - - W2x.3(fixed = c(NA, NA, NA), names = c("d", "e", "t0"), ...) - - W1.3u(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...) - - W2.3u(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...) -} - -\arguments{ - \item{upper}{numeric value. The fixed, upper limit in the model. Default is 1.} - \item{fixed}{numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.} - \item{names}{a vector of character strings giving the names of the parameters. The default is reasonable.} - \item{...}{additional arguments to be passed from the convenience functions.} -} - -\details{ - The three-parameter Weibull type 1 model is given by the expression - \deqn{ f(x) = 0 + (d-0)\exp(-\exp(b(\log(x)-\log(e)))).} - - The model function is asymmetric about the inflection point, which is the parameter \eqn{\exp(e)}. - - The three-parameter Weibull type 1 model with upper limit 1 is given by the expression - \deqn{ f(x) = 0 + (1-0)\exp(-\exp(b(\log(x)-\log(e)))).} - -} - -\value{ - See \code{\link{weibull1}}. -} - -%\references{ ~put references to the literature/web site here ~ } - -\author{Christian Ritz} - -\note{This function is for use with the function \code{\link{drm}}.} - -\seealso{Related functions are \code{\link{W1.4}} and \code{\link{weibull1}}.} - -\examples{ - -## Fitting a three-parameter Weibull model -ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.3()) -ryegrass.m1 - -} -\keyword{models} -\keyword{nonlinear} diff --git a/man/W4.Rd b/man/W4.Rd deleted file mode 100644 index 00fe94a8..00000000 --- a/man/W4.Rd +++ /dev/null @@ -1,105 +0,0 @@ -\name{W1.4} - -\alias{W1.4} -\alias{w4} -\alias{W2.4} -\alias{W2x.4} - -\title{The four-parameter Weibull functions} - -\description{ - 'W1.4' and 'W2.4' provide the four-parameter Weibull functions, self starter function and - names of the parameters. -} - -\usage{ - W1.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) - - W2.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) -} - -\arguments{ - \item{fixed}{numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.} - \item{names}{a vector of character strings giving the names of the parameters. The default is reasonable.} - \item{...}{additional arguments to be passed from the convenience functions.} -} - -\details{ - The equations for the mean functions are given at \code{\link{weibull1}}. -} - -\value{ - See \code{\link{weibull1}}. -} - -\references{ - Seber, G. A. F. and Wild, C. J (1989) \emph{Nonlinear Regression}, New York: Wiley \& Sons (pp. 330--331). - - Ritz, C (2009) - Towards a unified approach to dose-response modeling in ecotoxicology - \emph{To appear in Environ Toxicol Chem}. -} - -\author{Christian Ritz} - -\note{This function is for use with the model fitting function \code{\link{drm}}.} - -\seealso{Setting \eqn{c=0} yields \code{\link{W1.3}}. A more flexible function, allowing -fixing or constraining parameters, is available through \code{\link{weibull1}}.} - -\examples{ - -## Fitting a four-parameter Weibull (type 1) model -terbuthylazin.m1 <- drm(rgr~dose, data = terbuthylazin, fct = W1.4()) -summary(terbuthylazin.m1) - -## Fitting a first-order multistage model -## to data from BMDS by EPA -## (Figure 3 in Ritz (2009)) -bmds.ex1 <- data.frame(ad.dose=c(0,50,100), dose=c(0, 2.83, 5.67), -num=c(6,10,19), total=c(50,49,50)) - -bmds.ex1.m1<-drm(num/total~dose, weights=total, data=bmds.ex1, -fct=W2.4(fixed=c(1,NA,1,NA)), type="binomial") - -modelFit(bmds.ex1.m1) # same as in BMDS - -summary(bmds.ex1.m1) # same background estimate as in BMDS - -logLik(bmds.ex1.m1) - -## BMD estimate identical to BMDS result -## BMDL estimate differs from BMDS result (different method) -ED(bmds.ex1.m1, 10, ci="delta") - -## Better fit - -bmds.ex1.m2<-drm(num/total~dose, weights=total, data=bmds.ex1, -fct=W1.4(fixed=c(-1,NA,1,NA)), type="binomial") -modelFit(bmds.ex1.m2) -summary(bmds.ex1.m2) - -ED(bmds.ex1.m2, 50, ci = "delta") - -## Creating Figure 3 in Ritz (2009) -bmds.ex1.m3 <- drm(num/total~dose, weights=total, data=bmds.ex1, -fct=LL.4(fixed=c(-1,NA,1,NA)), type="binomial") - -plot(bmds.ex1.m1, ylim = c(0.05, 0.4), log = "", lty = 3, lwd = 2, -xlab = "Dose (mg/kg/day)", ylab = "", -cex=1.2, cex.axis=1.2, cex.lab=1.2) - -mtext("Tumor incidence", 2, line=4, cex=1.2) # tailored y axis label - -plot(bmds.ex1.m2, ylim = c(0.05, 0.4), log = "", add = TRUE, lty = 2, lwd = 2) - -plot(bmds.ex1.m3, ylim = c(0.05, 0.4), log = "", add = TRUE, lty = 1, lwd = 2) - -arrows(2.6 , 0.14, 2, 0.14, 0.15, lwd=2) -text(2.5, 0.14, "Weibull-1", pos=4, cex=1.2) - -} - -\keyword{models} -\keyword{nonlinear} diff --git a/man/absToRel.Rd b/man/absToRel.Rd new file mode 100644 index 00000000..845a1c37 --- /dev/null +++ b/man/absToRel.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/absToRel.R +\name{absToRel} +\alias{absToRel} +\title{Convert absolute to relative response levels} +\usage{ +absToRel(parmVec, respl, typeCalc) +} +\arguments{ +\item{parmVec}{numeric vector of model parameters where the third element is the upper +asymptote and the second element is the lower asymptote.} + +\item{respl}{numeric response level to convert.} + +\item{typeCalc}{character string. If "absolute", the conversion is performed; +otherwise the input \code{respl} is returned unchanged.} +} +\value{ +A numeric value representing the (possibly converted) response level as a percentage. +} +\description{ +Internal helper that converts an absolute response level to a relative (percentage) scale +based on the upper and lower asymptotes of a dose-response curve. +} +\keyword{internal} diff --git a/man/acidiq.Rd b/man/acidiq.Rd new file mode 100644 index 00000000..ab4c049e --- /dev/null +++ b/man/acidiq.Rd @@ -0,0 +1,74 @@ +\name{acidiq} + +\alias{acidiq} + +\docType{data} + +\title{Acifluorfen and diquat tested on Lemna minor.} + +\description{ + Data from an experiment where the chemicals acifluorfen and diquat tested on Lemna minor. The dataset has 7 mixtures used in + 8 dilutions with three replicates and 12 common controls, in total 180 observations. +} + +\usage{data(acidiq)} + +\format{ + A data frame with 180 observations on the following 3 variables. + \describe{ + \item{\code{dose}}{a numeric vector of dose values} + \item{\code{pct}}{a numeric vector denoting the grouping according to the mixtures percentages} + \item{\code{rgr}}{a numeric vector of response values (relative growth rates)} + } +} + +\details{ + The dataset is analysed in Soerensen et al (2007). + Hewlett's symmetric model seems appropriate for this dataset. +} + +\source{ + The dataset is kindly provided by Nina Cedergreen, Department of Agricultural Sciences, + Royal Veterinary and Agricultural University, Denmark. +} + +\references{ + Soerensen, H. and Cedergreen, N. and Skovgaard, I. M. and Streibig, J. C. (2007) + An isobole-based statistical model and test for synergism/antagonism in binary mixture toxicity experiments, + \emph{Environmental and Ecological Statistics}, \bold{14}, 383--397. +} + +\examples{ +library(drc) +## Fitting the model with freely varying ED50 values +## Ooops: Box-Cox transformation is needed +acidiq.free <- drm(rgr ~ dose, pct, data = acidiq, fct = LL.4(), +pmodels = list(~factor(pct), ~1, ~1, ~factor(pct) - 1)) + +## Lack-of-fit test +modelFit(acidiq.free) +summary(acidiq.free) + +## Plotting isobole structure +isobole(acidiq.free, xlim = c(0, 400), ylim = c(0, 450)) + +## Fitting the concentration addition model +acidiq.ca <- mixture(acidiq.free, model = "CA") + +## Comparing to model with freely varying e parameter +anova(acidiq.ca, acidiq.free) # rejected + +## Plotting isobole based on concentration addition -- poor fit +isobole(acidiq.free, acidiq.ca, xlim = c(0, 420), ylim = c(0, 450)) # poor fit + +## Fitting the Hewlett model +acidiq.hew <- mixture(acidiq.free, model = "Hewlett") + +## Comparing to model with freely varying e parameter +anova(acidiq.free, acidiq.hew) # accepted +summary(acidiq.hew) + +## Plotting isobole based on the Hewlett model +isobole(acidiq.free, acidiq.hew, xlim = c(0, 400), ylim = c(0, 450)) # good fit +} +\keyword{datasets} diff --git a/man/aconiazide.Rd b/man/aconiazide.Rd new file mode 100644 index 00000000..bd166c88 --- /dev/null +++ b/man/aconiazide.Rd @@ -0,0 +1,41 @@ +\name{aconiazide} + +\alias{aconiazide} + +\docType{data} + +\title{Weight change in rats after exposure to a medical drug} + +\description{ + For each of 4 dose levels the weight change over 6 monts is reported for 14 rats exposed to an antituberculosis drug, aconiazide. +} + +\usage{data(aconiazide)} + +\format{ + A data frame with 55 observations of the following 2 variables. + \describe{ + \item{\code{dose}}{a numeric vector} + \item{\code{weightChange}}{a numeric vector giving weight change (g) after 6 months of exposure} + } +} + +\source{ +Beland, F. A. and Dooley, K. L. and Hansen, E. B. and Sheldon, W. G. (1995). Six-month toxicity comparison of the antituberculosis drugs aconiazide and isoniazid in fischer 344 rats. Journal of the American College of Toxicology, \bold{14(4)}:328--342. +} + +\examples{ +library(drc) + +## Displaying the data +head(aconiazide) + +## Fitting a four-parameter log-logistic model +aconiazide.m1 <- drm(weightChange ~ dose, data = aconiazide, fct = LL.4()) +summary(aconiazide.m1) + +## Plotting the fitted curve +plot(aconiazide.m1, xlab = "Dose", ylab = "Weight change (g)") +} + +\keyword{datasets} diff --git a/man/acute.inh.Rd b/man/acute.inh.Rd new file mode 100644 index 00000000..841b4a55 --- /dev/null +++ b/man/acute.inh.Rd @@ -0,0 +1,38 @@ +\name{acute.inh} + +\alias{acute.inh} + +\docType{data} + +\title{Acute inhalation} + +\description{Data from an acute inhalation toxicity test. For each of several dose levels, the total number of subjects and the number of dead subjects were recorded.} + +\usage{data(acute.inh)} + +\format{ + A data frame with 6 observations on the following 3 variables. + \describe{ + \item{\code{dose}}{a numeric vector} + \item{\code{total}}{a numeric vector} + \item{\code{num.dead}}{a numeric vector} + } +} + +\examples{ +library(drc) + +## Displaying the data +head(acute.inh) + +## Fitting a two-parameter log-logistic model for binomial response +acute.inh.m1 <- drm(num.dead/total ~ dose, weights = total, +data = acute.inh, fct = LL.2(), type = "binomial") +summary(acute.inh.m1) + +## Plotting the fitted curve +plot(acute.inh.m1, xlab = "Dose", ylab = "Proportion dead") +} + + +\keyword{datasets} diff --git a/man/algae.Rd b/man/algae.Rd new file mode 100644 index 00000000..de4bf5f2 --- /dev/null +++ b/man/algae.Rd @@ -0,0 +1,45 @@ +\name{algae} + +\alias{algae} + +\docType{data} + +\title{Volume of algae as function of increasing concentrations of a herbicide} + +\description{ + Dataset from an experiment exploring the effect of increasing concentrations of a herbicide on + the volume of the treated algae. +} + +\usage{data(algae)} + +\format{ + A data frame with 14 observations on the following 2 variables. + \describe{ + \item{\code{conc}}{a numeric vector of concentrations.} + \item{\code{vol}}{a numeric vector of response values, that is relative change in volume.} + } +} + +\details{ + This datasets requires a cubic root transformation in order to stabilise the variance. +} + +\source{ + Meister, R. and van den Brink, P. (2000) + \emph{The Analysis of Laboratory Toxicity Experiments}, + Chapter 4 in \emph{Statistics in Ecotoxicology}, Editor: T. Sparks, + New York: John Wiley & Sons, (pp. 114--116). +} + +%\references{} + +\examples{ +library(drc) +algae.m1 <- drm(vol~conc, data=algae, fct=LL.3()) +summary(algae.m1) + +algae.m2 <- boxcox(algae.m1) +summary(algae.m2) +} +\keyword{datasets} diff --git a/man/anova.drc.Rd b/man/anova.drc.Rd index 137c4261..dde7695c 100644 --- a/man/anova.drc.Rd +++ b/man/anova.drc.Rd @@ -1,65 +1,73 @@ -\name{anova.drc} - -\alias{anova.drc} - -\title{ANOVA for dose-response model fits} - -\description{ - 'anova' produces an analysis of variance table for one or two non-linear model fits. -} - -\usage{ - - \method{anova}{drc}(object, ..., details = TRUE, test = NULL) -} - -\arguments{ - \item{object}{an object of class 'drc'.} - \item{...}{additional arguments.} - \item{details}{logical indicating whether or not details on the models compared should be displayed. - Default is TRUE (details are displayed).} - \item{test}{a character string specifying the test statistic to be applied. - Use "od" to assess overdispersion for binomial data.} -} - -\details{ - Specifying only a single object gives a test for lack-of-fit, comparing the non-linear regression - model to a more general one-way or two-way ANOVA model. - - If two objects are specified a test for reduction from the larger to the smaller model is given. (This only makes statistical - sense if the models are nested, that is: one model is a submodel of the other model.) -} - -\value{ - An object of class 'anova'. -} - -\references{ - Bates, D. M. and Watts, D. G. (1988) - \emph{Nonlinear Regression Analysis and Its Applications}, - New York: Wiley \& Sons (pp. 103--104) -} - -\author{Christian Ritz} - -\seealso{ - For comparison of nested or non-nested model the function \code{\link{mselect}}can also be used. - - The function \code{\link{anova.lm}} for linear models. -} - -\examples{ - -## Comparing a Gompertz three- and four-parameter models using an F test -ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) -ryegrass.m2 <- drm(rootl ~ conc, data = ryegrass, fct = W1.3()) -anova(ryegrass.m2, ryegrass.m1) # reduction to 'W1.3' not possible (highly significant) - -anova(ryegrass.m2, ryegrass.m1, details = FALSE) # without details - -} -\keyword{models} -\keyword{nonlinear} - -\concept{extra sum-of-squares F-test} -\concept{approximate F-test} \ No newline at end of file +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/anova.drc.R +\name{anova.drc} +\alias{anova.drc} +\title{ANOVA Model Comparison for Dose-Response Models} +\usage{ +\method{anova}{drc}(object, ..., details = TRUE, test = NULL) +} +\arguments{ +\item{object}{an object of class \sQuote{drc}.} + +\item{...}{a second object of class \sQuote{drc} to compare against +\code{object}. Exactly two models must be supplied; passing a single +model will result in an error directing the user to +\code{\link{modelFit}}.} + +\item{details}{logical indicating whether or not details on the models +compared should be displayed. Default is \code{TRUE} (details are +displayed).} + +\item{test}{a character string specifying the test statistic to be applied. +For continuous data the default is \code{"F"} (F-test); for binomial data +the default is \code{"Chisq"} (likelihood-ratio test). Use \code{"Chisq"} +to force a likelihood-ratio test for continuous data.} +} +\value{ +An object of class \sQuote{anova} (inheriting from +\code{data.frame}) with columns for model degrees of freedom, residual +sum of squares (or log-likelihood), the difference in degrees of freedom, +the test statistic, and the p-value. +} +\description{ +Compares two nested dose-response model fits using a likelihood-ratio test +(for binomial data) or an F-test (for continuous data). Two \code{drc} +objects must be provided. For a lack-of-fit test of a single model, use +\code{\link{modelFit}} instead. +} +\details{ +Two \code{drc} objects must be specified. The function performs a test for +reduction from the larger to the smaller model. This only makes statistical +sense if the models are nested, that is: one model is a submodel of the +other model. + +For continuous data an F-test is used by default. For binomial data a +likelihood-ratio (chi-square) test is used by default. + +If a single model is passed, the function raises an error. To assess the +fit of a single dose-response model (lack-of-fit test comparing the model +to a more general ANOVA model), use \code{\link{modelFit}} instead. +} +\examples{ +## Comparing two nested models (two-model comparison) +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) +ryegrass.m2 <- drm(rootl ~ conc, data = ryegrass, fct = W1.3()) +anova(ryegrass.m2, ryegrass.m1) + +anova(ryegrass.m2, ryegrass.m1, details = FALSE) # without details + +## For a lack-of-fit test on a single model, use modelFit(): +modelFit(ryegrass.m1) + +} +\seealso{ +\code{\link{modelFit}} for lack-of-fit testing of a single model, +\code{\link{drm}} for fitting dose-response models, +\code{\link{logLik.drc}} for log-likelihood extraction, +\code{\link{summary.drc}} for model summaries. +} +\author{ +Christian Ritz, Hannes Reinwald +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/anova.drclist.Rd b/man/anova.drclist.Rd new file mode 100644 index 00000000..654cd3d1 --- /dev/null +++ b/man/anova.drclist.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/anova.drclist.R +\name{anova.drclist} +\alias{anova.drclist} +\title{ANOVA for list of drc objects} +\usage{ +\method{anova}{drclist}(object, ..., details = TRUE, test = NULL) +} +\description{ +ANOVA for list of drc objects +} +\keyword{internal} diff --git a/man/arandaordaz.Rd b/man/arandaordaz.Rd new file mode 100644 index 00000000..bca974fc --- /dev/null +++ b/man/arandaordaz.Rd @@ -0,0 +1,63 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/arandaordaz.R +\name{arandaordaz} +\alias{arandaordaz} +\title{Asymptotic Regression Model} +\usage{ +arandaordaz(fixed = c(NA, NA, NA), names = c("a", "b", "c"), fctName, fctText) +} +\arguments{ +\item{fixed}{numeric vector. Specifies which parameters are fixed and at what +value they are fixed. Use \code{NA} for parameters that are not fixed. +Must be of length 3.} + +\item{names}{character vector of length 3 giving the names of the parameters +(should not contain ":").} + +\item{fctName}{optional character string used internally by convenience +functions. Defaults to \code{"arandaordaz"} if not provided.} + +\item{fctText}{optional character string used internally by convenience +functions. Defaults to \code{"Asymptotic regression"} if not provided.} +} +\value{ +A list of class \code{drcMean} with the following components: +\describe{ +\item{fct}{The mean function taking arguments \code{dose} and \code{parm}.} +\item{ssfct}{Self-starter function for generating initial parameter +estimates from data.} +\item{names}{Character vector of non-fixed parameter names.} +\item{deriv1}{Reserved first derivative slot (currently \code{NULL}).} +\item{deriv2}{Reserved second derivative slot (currently \code{NULL}).} +\item{derivx}{Reserved derivative-with-respect-to-x slot (currently +\code{NULL}).} +\item{edfct}{Function for calculating effective dose (ED) values and +their derivatives.} +\item{inversion}{Inverse mean function for back-calculating dose from +response.} +\item{name}{Character string identifying the model function name.} +\item{text}{Character string with a human-readable model description.} +\item{noParm}{Integer giving the number of non-fixed parameters.} +} +} +\description{ +The base function for the asymptotic regression model, providing the mean +function and self starter for a three-parameter model. +} +\details{ +The asymptotic regression model is a three-parameter model with mean function: + +\deqn{f(x) = c + (d-c)(1-\exp(-x/e))} + +The parameter \eqn{c} is the lower limit (at \eqn{x=0}), \eqn{d} is the upper limit, +and \eqn{e>0} determines the steepness of the increase. +} +\seealso{ +\code{\link{AR.2}}, \code{\link{AR.3}}, \code{\link{EXD.2}}, +\code{\link{EXD.3}} +} +\author{ +Christian Ritz, Hannes Reinwald +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/arbovirus.Rd b/man/arbovirus.Rd new file mode 100644 index 00000000..962ba8c9 --- /dev/null +++ b/man/arbovirus.Rd @@ -0,0 +1,38 @@ +\name{arbovirus} + +\alias{arbovirus} + +\docType{data} + +\title{arbovirus} + +\description{Data from a dose-response experiment with an arbovirus involving two treatment groups (FP and SP). For each dose level, the total number of subjects and the numbers of dead and defective subjects were recorded.} + +\usage{data(arbovirus)} + +\format{ + A data frame with 9 observations on the following 5 variables. + \describe{ + \item{\code{dose}}{a numeric vector} + \item{\code{total}}{a numeric vector} + \item{\code{dead}}{a numeric vector} + \item{\code{def}}{a numeric vector} + \item{\code{trt}}{a categorical vector} + } +} + +\examples{ +library(drc) + +## Displaying the data +head(arbovirus) + +## Fitting a two-parameter log-logistic model for binomial response +arbovirus.m1 <- drm(dead/total ~ dose, trt, weights = total, +data = arbovirus, fct = LL.2(), type = "binomial") +summary(arbovirus.m1) + +## Plotting the fitted curves +plot(arbovirus.m1, xlab = "Dose", ylab = "Proportion dead") +} +\keyword{datasets} diff --git a/man/auxins.Rd b/man/auxins.Rd new file mode 100644 index 00000000..73e98829 --- /dev/null +++ b/man/auxins.Rd @@ -0,0 +1,70 @@ +\name{auxins} + +\alias{auxins} + +\docType{data} + +\title{Effect of technical grade and commercially formulated auxin herbicides} + +\description{ + MCPA, 2,4-D, mecorprop and dichorlprop were applied either as technical grades + materials or as commercial formulations. + Each experimental unit consisted of five 1-week old seedlings grown together + in a pot of nutrient solution during 14 days. +} + + +\usage{data(auxins)} + +\format{ + A data frame with 150 observations on the following 5 variables. + \describe{ + \item{\code{dryweight}}{a numeric vector} + \item{\code{dose}}{a numeric vector} + \item{\code{replicate}}{a factor with 3 levels} + \item{\code{herbicide}}{a factor with 5 levels} + \item{\code{formulation}}{a factor with 2 levels} + } +} + +\details{ + Data are parts of a larger joint action experiment with various herbicides. + + The eight herbicide preparations are naturally grouped into four pairs (herbicide:formulation) + control, and each pair of herbicides should have the same active ingredients but different formulation + constituents, which were assumed to be biologically inert. The data consist + of the 150 observations of dry weights, each observation being the weight + of five plants grown in the same pot. All the eight herbicide preparations have + essentially the same mode of action in the plant; they all act like the plant + auxins, which are plant regulators that affect cell enlongation an other + essential metabolic pathways. One of the objects of the experiment was to test + if the response functions were identical except for a multiplicative factor in + the dose. This is a necessary, but not a sufficient, condition for a similar + mode of action for the herbicides. +} + +\source{ + Streibig, J. C. (1987). Joint action of root-absorbed mixtures of auxin + herbicides in Sinapis alba L. and barley (Hordeum vulgare L.) + \emph{Weed Research}, \bold{27}, 337--347. +} + +\references{ + Rudemo, M., Ruppert, D., and Streibig, J. C. (1989). Random-Effect Models + in Nonlinear Regression with Applications to Bioassay. + \emph{Biometrics}, \bold{45}, 349--362. +} +\examples{ +library(drc) + +## Displaying the data +head(auxins) + +## Fitting a four-parameter log-logistic model with different curves per herbicide +auxins.m1 <- drm(dryweight ~ dose, herbicide, data = auxins, fct = LL.4()) +summary(auxins.m1) + +## Plotting the fitted curves +plot(auxins.m1, xlab = "Dose", ylab = "Dry weight") +} + +\keyword{datasets} diff --git a/man/backfit.Rd b/man/backfit.Rd index b0f14e46..309062f2 100644 --- a/man/backfit.Rd +++ b/man/backfit.Rd @@ -1,47 +1,33 @@ -\name{backfit} - -\alias{backfit} - -\title{ - Calculation of backfit values from a fitted dose-response model -} - -\description{ - By inverse regression backfitted dose values are calculated for the mean response per dose. -} - -\usage{ -backfit(drcObject) -} - -\arguments{ - \item{drcObject}{an object of class 'drc'.} -} - -\value{ - Two columns with the original dose values and the corresponding backfitted values using the fitted dose-response model. - For extreme dose values (e.g., high dose ) the backfitted values may not be well-defined (see the example below). -} - -\references{ - ?? -} - -\author{ - Christian Ritz after a suggestion from Keld Sorensen. -} - -\seealso{ - A related function is \code{\link{ED.drc}}. -} - -\examples{ - -ryegrass.LL.4 <- drm(rootl~conc, data=ryegrass, fct=LL.4()) - -backfit(ryegrass.LL.4) - -} - -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/backfit.R +\name{backfit} +\alias{backfit} +\title{Calculation of backfit values from a fitted dose-response model} +\usage{ +backfit(drcObject) +} +\arguments{ +\item{drcObject}{an object of class 'drc'.} +} +\value{ +Two columns with the original dose values and the corresponding backfitted values +using the fitted dose-response model. For extreme dose values (e.g., high dose) the +backfitted values may not be well-defined. +} +\description{ +By inverse regression backfitted dose values are calculated for the mean response per dose. +} +\examples{ +ryegrass.LL.4 <- drm(rootl~conc, data=ryegrass, fct=LL.4()) + +backfit(ryegrass.LL.4) + +} +\seealso{ +A related function is \code{\link{ED.drc}}. +} +\author{ +Christian Ritz after a suggestion from Keld Sorensen. +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/barley.Rd b/man/barley.Rd new file mode 100644 index 00000000..eb024ea7 --- /dev/null +++ b/man/barley.Rd @@ -0,0 +1,35 @@ +\name{barley} + +\alias{barley} + +\docType{data} + +\title{Barley} + +\description{Data from a dose-response experiment measuring the weight of barley (\emph{Hordeum vulgare}) at different dose levels of a substance.} + +\usage{data(barley)} + +\format{ + A data frame with 18 observations of the following 2 variables. + \describe{ + \item{\code{Dose}}{a numeric vector} + \item{\code{weight}}{a numeric vector} + } +} + +\examples{ +library(drc) + +## Displaying the data +head(barley) + +## Fitting a four-parameter log-logistic model +barley.m1 <- drm(weight ~ Dose, data = barley, fct = LL.4()) +summary(barley.m1) + +## Plotting the fitted curve +plot(barley.m1, xlab = "Dose", ylab = "Weight") +} + +\keyword{datasets} diff --git a/man/baro5.Rd b/man/baro5.Rd index 4fecebe6..c516bec6 100644 --- a/man/baro5.Rd +++ b/man/baro5.Rd @@ -1,53 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/baro5.R \name{baro5} - \alias{baro5} - -\title{The modified baro5 function} - -\description{ - 'baro5' allows specification of the baroreflex 5-parameter dose response function, - under various constraints on the parameters. -} - +\title{The Baroreflex Five-Parameter Dose-Response Model} \usage{ - baro5(fixed = c(NA, NA, NA, NA, NA), names = c("b1", "b2", "c", "d", "e"), - method = c("1", "2", "3", "4"), ssfct = NULL) +baro5( + fixed = c(NA, NA, NA, NA, NA), + names = c("b1", "b2", "c", "d", "e"), + method = c("1", "2", "3", "4"), + ssfct = NULL +) } - \arguments{ - \item{fixed}{numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.} - \item{names}{a vector of character strings giving the names of the parameters (should not contain ":"). - The order of the parameters is: b1, b2, c, d, e (see under 'Details').} - \item{method}{character string indicating the self starter function to use.} - \item{ssfct}{a self starter function to be used.} -} +\item{fixed}{numeric vector. Specifies which parameters are fixed and at what value +they are fixed. NAs for parameters that are not fixed.} -\details{ - The five-parameter function given by the expression +\item{names}{a vector of character strings giving the names of the parameters +(should not contain ":"). The order is: b1, b2, c, d, e.} - \deqn{ y = c + \frac{d-c}{1+f\exp(b1(\log(x)-\log(e))) + (1-f)\exp(b2(\log(x)-\log(e)))}} +\item{method}{character string indicating the self starter function to use.} - \deqn{ f = 1/( 1 + \exp((2b1b2/|b1+b2|)(\log(x)-\log(e))))} - - If the difference between the parameters b1 and b2 is different from 0 then the function is asymmetric. +\item{ssfct}{a self starter function to be used.} } - \value{ - The value returned is a list containing the nonlinear model function, the self starter function - and the parameter names. +A list containing the nonlinear model function, the self starter function, +and the parameter names. } - -\references{ - Ricketts, J. H. and Head, G. A. (1999) - A five-parameter logistic equation for investigating asymmetry of curvature in baroreflex studies. - \emph{Am. J. Physiol. (Regulatory Integrative Comp. Physiol. 46)}, \bold{277}, 441--454. +\description{ +\code{baro5} provides the five-parameter baroreflex model function, allowing +specification under various parameter constraints. The model accommodates +asymmetric dose-response curves. } +\details{ +The five-parameter function is given by: -\author{Christian Ritz} - +\deqn{y = c + \frac{d-c}{1+f\exp(b1(\log(x)-\log(e))) + (1-f)\exp(b2(\log(x)-\log(e)))}} -%\examples{} +\deqn{f = 1/(1 + \exp((2b1 b2/|b1+b2|)(\log(x)-\log(e))))} +If the difference between b1 and b2 is nonzero, the function is asymmetric. +} +\references{ +Ricketts, J. H. and Head, G. A. (1999) +A five-parameter logistic equation for investigating asymmetry of curvature +in baroreflex studies. +\emph{Am. J. Physiol. (Regulatory Integrative Comp. Physiol. 46)}, \bold{277}, 441--454. +} +\author{ +Christian Ritz +} \keyword{models} \keyword{nonlinear} diff --git a/man/bcl3.Rd b/man/bcl3.Rd new file mode 100644 index 00000000..3c75392f --- /dev/null +++ b/man/bcl3.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/braincousens.R +\name{bcl3} +\alias{bcl3} +\title{Alias for BC.4} +\usage{ +bcl3(fixed = c(NA, NA, NA, NA), names = c("b", "d", "e", "f"), ...) +} +\arguments{ +\item{fixed}{numeric vector of length 4 specifying fixed parameters (NAs for free parameters).} + +\item{names}{a vector of character strings giving the names of the parameters.} + +\item{...}{additional arguments passed to \code{\link{braincousens}}.} +} +\description{ +\code{bcl3} is an alias for \code{\link{BC.4}}. +} +\seealso{ +\code{\link{BC.4}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/bcl4.Rd b/man/bcl4.Rd new file mode 100644 index 00000000..b1ecf01e --- /dev/null +++ b/man/bcl4.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/braincousens.R +\name{bcl4} +\alias{bcl4} +\title{Alias for BC.5} +\usage{ +bcl4(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...) +} +\arguments{ +\item{fixed}{numeric vector of length 5 specifying fixed parameters (NAs for free parameters).} + +\item{names}{a vector of character strings giving the names of the parameters.} + +\item{...}{additional arguments passed to \code{\link{braincousens}}.} +} +\description{ +\code{bcl4} is an alias for \code{\link{BC.5}}. +} +\seealso{ +\code{\link{BC.5}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/bees.Rd b/man/bees.Rd new file mode 100644 index 00000000..83868562 --- /dev/null +++ b/man/bees.Rd @@ -0,0 +1,48 @@ +\name{bees} + +\alias{bees} + +\docType{data} + +\title{bees} + +\description{ + Data are from a binary mixture experiment that involves multiple single-dose factorial designs where the insecticide imidacloprid is combined with each of 7 pesticides in turn. +} + +\usage{data(bees)} + +\format{ + A data frame with 66 observations on the following 5 variables. + \describe{ + \item{\code{mixture}}{Indicator of single-dose experiment (or control)} + \item{\code{treat}}{Treatment or combination of treatments} + \item{\code{rep}}{Replication number (there were 3 replicates per group)} + \item{\code{dead0h}}{Number of dead bees initially} + \item{\code{dead48h}}{Number of dead bees after 48 hours} + } +} + +\details{ +Imidacloprid is a widely used insecticide. In a recent study potential synergistic effects on mortality of honey bees exposed to the insectide in binary mixtures with seven pesticides from different classes: acephate, λ-cyhalothrin, oxamyl, tetraconazole, sulfoxaflor, glyphosate, and clothianidin were investigated. Bees were reared in cages (25 insects per cage), with three cages per treatment group, and exposed to the mixture treatments for 48h. Mortality after 48h was the response. +} +\source{ +Data were retrieved from PLoS ONE repository. +} + +\references{ +Zhu YC, Yao J, Adamczyk J and Luttrell R, Synergistic toxicity and physiological impact of imidacloprid alone and binary mixtures with seven representative pesticides on honey bee (Apis mellifera). PLoS ONE 12: e0176837 (2017). https://doi.org/10.1371/journal.pone.0176837 + } + +\examples{ +library(drc) + +## Displaying the data +head(bees) + +## Summarizing mortality by treatment +aggregate(dead48h ~ treat, data = bees, FUN = mean) +} + +\keyword{datasets} + diff --git a/man/blackgrass.Rd b/man/blackgrass.Rd new file mode 100644 index 00000000..4eff1cb6 --- /dev/null +++ b/man/blackgrass.Rd @@ -0,0 +1,39 @@ +\name{blackgrass} +\alias{blackgrass} +\docType{data} +\title{Seedling Emergence of Blackgrass (Alopecurus myosuroides)} +\description{Seedling emergence of herbicide susceptible (S) and resistant (R) Alopecurus myosuroides in reponse to sowing depth and suboptimal temperature regimes (10/5C) and optimal temperature regimes (17/10C).} + +\usage{data("blackgrass")} + +\format{ + A data frame with 2752 observations on the following 12 variables. + \describe{ + \item{\code{Exp}}{a numeric vector} + \item{\code{Temp}}{a numeric vector} + \item{\code{Popu}}{a numeric vector} + \item{\code{Bio}}{a factor with two levels} + \item{\code{Depth}}{a numeric vector} + \item{\code{Rep}}{a numeric vector} + \item{\code{Start.Day}}{a numeric vector} + \item{\code{End.Day}}{a numeric vector} + \item{\code{Ger}}{a numeric vector} + \item{\code{Accum.Ger}}{a numeric vector} + \item{\code{TotalSeed}}{a numeric vector} + \item{\code{Pot}}{a numeric vector} + } +} +\references{Keshtkar, E., Mathiassen, S. K., Beffa, R., Kudsk, P. (2017). Seed Germination and Seedling Emergence of Blackgrass (Alopecurus myosuroides) as Affected by Non-Target-Site Herbicide Resistance. Weed Science, 65, 732-742. https://doi.org/10.1017/wsc.2017.44 +%% ~~ possibly secondary sources and usages ~~ +} + +\examples{ +library(drc) + +## Displaying the data +head(blackgrass) + +## Summarizing seedling emergence across treatments +aggregate(Accum.Ger ~ Temp + Bio, data = blackgrass, FUN = max) +} +\keyword{datasets} diff --git a/man/boxcox.drc.Rd b/man/boxcox.drc.Rd index 3a569a5f..97b22b51 100644 --- a/man/boxcox.drc.Rd +++ b/man/boxcox.drc.Rd @@ -1,70 +1,78 @@ -\name{boxcox.drc} - -\alias{boxcox.drc} - -\title{Transform-both-sides Box-Cox transformation} - -\description{ - Finds the optimal Box-Cox transformation for non-linear regression. -} - -\usage{ -\method{boxcox}{drc}(object, lambda = seq(-2, 2, by = 0.25), plotit = TRUE, bcAdd = 0, -method = c("ml", "anova"), level = 0.95, eps = 1/50, -xlab = expression(lambda), ylab = "log-Likelihood", ...) -} - -\arguments{ - \item{object}{object of class \code{drc}.} - \item{lambda}{numeric vector of lambda values; the default is (-2, 2) in steps of 0.25.} - \item{plotit}{logical which controls whether the result should be plotted.} - \item{bcAdd}{numeric value specifying the constant to be added on both sides prior to Box-Cox transformation. - The default is 0.} - \item{method}{character string specifying the estimation method for lambda: maximum likelihood or ANOVA-based - (optimal lambda inherited from more general ANOVA model fit.} - \item{eps}{numeric value: the tolerance for lambda = 0; defaults to 0.02.} - \item{level}{numeric value: the confidence level required.} - \item{xlab}{character string: the label on the x axis, defaults to "lambda".} - \item{ylab}{character string: the label on the y axis, defaults to "log-likelihood".} - \item{\dots}{additional graphical parameters.} -} - -\details{ - The optimal lambda value is determined using a profile likelihood approach: - For each lambda value the dose-response regression model is fitted and the lambda value (and corresponding model fit) resulting in the largest - value of the log likelihood function is chosen. -} - -\value{ - An object of class "drc" (returned invisibly). - If plotit = TRUE a plot of loglik vs lambda is shown indicating a confidence interval (by default 95%) about - the optimal lambda value. -} - -\references{ - Carroll, R. J. and Ruppert, D. (1988) \emph{Transformation and Weighting in Regression}, - New York: Chapman and Hall (Chapter 4). -} - -\author{Christian Ritz} - -%\note{} - -\seealso{ - For linear regression the analogue is \code{\link[MASS]{boxcox}}. -} - -\examples{ - -## Fitting log-logistic model without transformation -ryegrass.m1 <- drm(ryegrass, fct = LL.4()) -summary(ryegrass.m1) - -## Fitting the same model with the optimal Box-Cox transformation -ryegrass.m2 <- boxcox(ryegrass.m1) -summary(ryegrass.m2) - -} - -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/boxcox.drc.R +\name{boxcox.drc} +\alias{boxcox.drc} +\title{Transform-both-sides Box-Cox transformation} +\usage{ +\method{boxcox}{drc}( + object, + lambda = seq(-2, 2, by = 0.25), + plotit = TRUE, + bcAdd = 0, + method = c("ml", "anova"), + level = 0.95, + eps = 1/50, + xlab = expression(lambda), + ylab = "log-Likelihood", + ... +) +} +\arguments{ +\item{object}{object of class \code{drc}.} + +\item{lambda}{numeric vector of lambda values; the default is (-2, 2) in steps of 0.25.} + +\item{plotit}{logical which controls whether the result should be plotted.} + +\item{bcAdd}{numeric value specifying the constant to be added on both sides prior to +Box-Cox transformation. The default is 0.} + +\item{method}{character string specifying the estimation method for lambda: maximum +likelihood or ANOVA-based (optimal lambda inherited from more general ANOVA model fit).} + +\item{level}{numeric value: the confidence level required.} + +\item{eps}{numeric value: the tolerance for lambda = 0; defaults to 0.02.} + +\item{xlab}{character string: the label on the x axis, defaults to "lambda".} + +\item{ylab}{character string: the label on the y axis, defaults to "log-likelihood".} + +\item{...}{additional graphical parameters.} +} +\value{ +An object of class "drc" (returned invisibly). If plotit = TRUE a plot of +loglik vs lambda is shown indicating a confidence interval (by default 95\%) about +the optimal lambda value. +} +\description{ +Finds the optimal Box-Cox transformation for non-linear regression. +} +\details{ +The optimal lambda value is determined using a profile likelihood approach: +For each lambda value the dose-response regression model is fitted and the lambda value +(and corresponding model fit) resulting in the largest value of the log likelihood function +is chosen. +} +\examples{ +## Fitting log-logistic model without transformation +ryegrass.m1 <- drm(ryegrass, fct = LL.4()) +summary(ryegrass.m1) + +## Fitting the same model with the optimal Box-Cox transformation +ryegrass.m2 <- boxcox(ryegrass.m1) +summary(ryegrass.m2) + +} +\references{ +Carroll, R. J. and Ruppert, D. (1988) \emph{Transformation and Weighting in Regression}, +New York: Chapman and Hall (Chapter 4). +} +\seealso{ +For linear regression the analogue is \code{\link[MASS]{boxcox}}. +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/braincousens.Rd b/man/braincousens.Rd index ccee3e28..02aa1602 100644 --- a/man/braincousens.Rd +++ b/man/braincousens.Rd @@ -1,66 +1,56 @@ -\name{braincousens} - -\alias{braincousens} - -\title{The Brain-Cousens hormesis models} - -\description{ - 'braincousens' provides a very general way of specifying Brain-Cousens' - modified log- logistic model for describing hormesis, under various constraints on the parameters. -} - -\usage{ - braincousens(fixed = c(NA, NA, NA, NA, NA), - names = c("b", "c", "d", "e", "f"), - method = c("1", "2", "3", "4"), ssfct = NULL, - fctName, fctText) -} - -\arguments{ - \item{fixed}{numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.} - \item{names}{a vector of character strings giving the names of the parameters (should not contain ":"). - The default is reasonable (see under 'Usage'). The order of the parameters is: b, c, d, e, f (see under 'Details').} - \item{method}{character string indicating the self starter function to use.} - \item{ssfct}{a self starter function to be used.} - \item{fctName}{optional character string used internally by convenience functions.} - \item{fctText}{optional character string used internally by convenience functions.} -} - -\details{ - The Brain-Cousens model is given by the expression - \deqn{ f(x) = c + \frac{d-c+fx}{1+\exp(b(\log(x)-\log(e)))}} - which is a five-parameter model. - - It is a modification of the four-parameter logistic curve to take hormesis into account proposed - by Brain and Cousens (1989). -} - -\value{ - The value returned is a list containing the non-linear function, the self starter function, - the parameter names and additional model specific objects. -} - -\references{ - Brain, P. and Cousens, R. (1989) An equation to describe dose responses - where there is stimulation of growth at low doses, - \emph{Weed Research}, \bold{29}, 93--96. -} - -\author{Christian Ritz} - -\note{ - This function is for use with the function \code{\link{drm}}. - - The convenience functions of \code{braincousens} are \code{\link{BC.4}} and \code{\link{BC.5}}. These functions - should be used rather than \code{braincousens} directly. -} - -%\seealso{} - -%\examples{} - -\keyword{models} -\keyword{nonlinear} - -\concept{hormesis hormetic effect initial stimulation} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/braincousens.R +\name{braincousens} +\alias{braincousens} +\title{The Brain-Cousens hormesis models} +\usage{ +braincousens( + fixed = c(NA, NA, NA, NA, NA), + names = c("b", "c", "d", "e", "f"), + method = c("1", "2", "3", "4"), + ssfct = NULL, + fctName, + fctText +) +} +\arguments{ +\item{fixed}{numeric vector. Specifies which parameters are fixed and at what value they are fixed. +NAs for parameters that are not fixed.} + +\item{names}{a vector of character strings giving the names of the parameters (should not contain ":"). +The order of the parameters is: b, c, d, e, f.} + +\item{method}{character string indicating the self starter function to use.} + +\item{ssfct}{a self starter function to be used.} + +\item{fctName}{optional character string used internally by convenience functions.} + +\item{fctText}{optional character string used internally by convenience functions.} +} +\value{ +A list containing the non-linear function, the self starter function, +the parameter names and additional model specific objects. +} +\description{ +\code{braincousens} provides a very general way of specifying Brain-Cousens' +modified log-logistic model for describing hormesis, under various constraints on the parameters. +} +\details{ +The Brain-Cousens model is given by the expression +\deqn{f(x) = c + \frac{d-c+fx}{1+\exp(b(\log(x)-\log(e)))}} +which is a five-parameter model. +} +\references{ +Brain, P. and Cousens, R. (1989) An equation to describe dose responses +where there is stimulation of growth at low doses, +\emph{Weed Research}, \bold{29}, 93--96. +} +\seealso{ +\code{\link{BC.4}}, \code{\link{BC.5}}, \code{\link{drm}} +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/braincousens.ssf.Rd b/man/braincousens.ssf.Rd new file mode 100644 index 00000000..87670a8f --- /dev/null +++ b/man/braincousens.ssf.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/braincousens.ssf.R +\name{braincousens.ssf} +\alias{braincousens.ssf} +\title{Self-starter for Brain-Cousens model} +\usage{ +braincousens.ssf(method = c("1", "2", "3", "4"), fixed, useFixed = FALSE) +} +\description{ +Self-starter for Brain-Cousens model +} +\keyword{internal} diff --git a/man/bread.drc.Rd b/man/bread.drc.Rd index 83efb1cb..d7196d44 100644 --- a/man/bread.drc.Rd +++ b/man/bread.drc.Rd @@ -1,65 +1,32 @@ -\name{bread.drc} - -\alias{bread.drc} -\alias{estfun.drc} - -\title{Bread and meat for the sandwich} - -\description{ - Bread and meat for the sandwich estimator of the variance-covariance. -} - -\usage{ - bread.drc(x, ...) - - estfun.drc(x, ...) -} - -\arguments{ - \item{x}{object of class \code{drc}} - \item{\dots}{additional arguments. At the moment none are supported} -} - -\details{ - The details are provided by Zeileis (2006). -} - -\value{ - The unscaled hessian is returned by \code{bread.drc}, whereas \code{estfun.drc} - returns the estimating function evaluated at the data and the parameter estimates. - - By default no clustering is assumed, corresponding to robust standard errors under independence. - If a cluster variable is provided the log likelihood contributions provided by \code{estfun} - are summed up for each cluster. -} - -\references{ - Zeileis, A. (2006) Object-oriented Computation of Sandwich Estimators, - \emph{J. Statist. Software}, \bold{16}, Issue 9. -} - -\author{Christian Ritz} - -%\note{} - -%\seealso{For other applications see \code{\link[sandwich]{sandwich}}.} - -\examples{ - -## The lines below requires that the packages -## 'lmtest' and 'sandwich' are installed -# library(lmtest) -# library(sandwich) - -# ryegrass.m1<-drm(rootl ~ conc, data = ryegrass, fct = LL.4()) - -# Standard summary output -# coeftest(ryegrass.m1) - -# Output with robust standard errors -# coeftest(ryegrass.m1, vcov = sandwich) - -} - -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sandwich.R +\name{bread.drc} +\alias{bread.drc} +\title{Bread for the sandwich estimator} +\usage{ +\method{bread}{drc}(x, ...) +} +\arguments{ +\item{x}{object of class \code{drc}.} + +\item{...}{additional arguments. At the moment none are supported.} +} +\value{ +The unscaled hessian matrix. +} +\description{ +Computes the "bread" (unscaled hessian) for the sandwich estimator of the +variance-covariance matrix for objects of class 'drc'. +} +\details{ +The details are provided by Zeileis (2006). +} +\references{ +Zeileis, A. (2006) Object-oriented Computation of Sandwich Estimators, +\emph{J. Statist. Software}, \bold{16}, Issue 9. +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/broccoli.Rd b/man/broccoli.Rd new file mode 100644 index 00000000..3773f243 --- /dev/null +++ b/man/broccoli.Rd @@ -0,0 +1,35 @@ +\name{broccoli} +\alias{broccoli} +\docType{data} +\title{The Effects of Drought Stress on Leaf Development in a \emph{Brassica oleracea} population} +\description{The effect of drought stress on \emph{Brassica oleracea} should be investigated, selecting drought stress resistant out of a population of different DH genotypes. The study was carried out on 48 DH lines developed from F1 plants of a cross between the rapid cycling chinese kale (\emph{Brassica oleracea} var. \emph{alboglabra} (L.H. Bailey) Musil) and broccoli (\emph{Brassica oleracea} var. \emph{italica} Plenck). 2 stress treatments (not watered and a watered control) are randomly assigned to 4 plants per genotype (2 per treatment) resulting in 192 plants in total. For the genotypes 5, 17, 31, 48, additional 12 plants (6 per treatment) are included into the completely randomized design, which results in a total of 240 plants. For each plant the length of the youngest leaf at the beginning of the experiment is measured daily for a period of 16 days. For the additional 12 plants of the 4 genotypes the leaf water potential was measured as a secondary endpoint (omitted here); due to these destructive measurements some dropouts occur.} +\usage{data(broccoli)} +\format{ + A data frame with 3689 observations on the following 5 variables. + \describe{ + \item{\code{LeafLength}}{Length of the youngest leaf [cm]} + \item{\code{ID}}{Plant identifier for 240 plants} + \item{\code{Stress}}{Drought stress treatment with 2 levels (control/drought)} + \item{\code{Genotype}}{Genotype ID with 48 levels} + \item{\code{Day}}{Day of repeated measurement (1,2,...,16)} + } +} +\references{ +Uptmoor, R.; Osei-Kwarteng, M.; Guertler, S. & Stuetzel, H. Modeling the Effects of Drought Stress on Leaf Development in a Brassica oleracea Doubled Haploid Population Using Two-phase Linear Functions. Journal of the American Society for Horticultural Science, 2009, 134, 543-552. +} + +\examples{ +data(broccoli) + +## Display the structure of the data +head(broccoli) + +## Fit a five-parameter log-logistic model per stress treatment +broccoli.m1 <- drm(LeafLength ~ Day, curveid = Stress, + data = broccoli, fct = LL.5()) +summary(broccoli.m1) +plot(broccoli.m1, main = "Broccoli leaf growth by stress treatment") +} + + +\keyword{datasets} diff --git a/man/carbendazim.Rd b/man/carbendazim.Rd new file mode 100644 index 00000000..de87fc56 --- /dev/null +++ b/man/carbendazim.Rd @@ -0,0 +1,43 @@ +\name{carbendazim} + +\alias{carbendazim} + +\docType{data} + +\title{Damage of lymphocyte cells} + +\description{ + For each of 13 dose levels the number of damaged lymphocyte cells were reported. Each dose level consisted of a total of 2000 cells. +} + +\usage{data(carbendazim)} + +\format{ + A data frame with 13 observations of the following 3 variables. + \describe{ + \item{\code{dose}}{a numeric vector} + \item{\code{total}}{a numeric vector} + \item{\code{damage}}{a numeric vector} + } +} + + +\source{ +Bentley, K. S. and Kirkland, D. and Murphy, M. and Marshall, R. (2000). Evaluation of thresholds for benomyl- and carbendazim-induced aneuploidy in cultured human lymphocytes using fluorescence in situ hybridization, \emph{Mutation Research/Genetic Toxicology and Environmental Mutagenesis}, \bold{464}, 41--51.} + +\examples{ +library(drc) + +## Displaying the data +head(carbendazim) + +## Fitting a two-parameter log-logistic model for binomial response +carbendazim.m1 <- drm(damage/total ~ dose, weights = total, +data = carbendazim, fct = LL.2(), type = "binomial") +summary(carbendazim.m1) + +## Plotting the fitted curve +plot(carbendazim.m1, xlab = "Dose", ylab = "Proportion damaged") +} + +\keyword{datasets} diff --git a/man/cedergreen.Rd b/man/cedergreen.Rd index fd92186a..c9d0867c 100644 --- a/man/cedergreen.Rd +++ b/man/cedergreen.Rd @@ -1,103 +1,75 @@ -\name{cedergreen} - -\alias{cedergreen} -\alias{CRS.6} -\alias{ucedergreen} - -\title{The Cedergreen-Ritz-Streibig model} - -\description{ - 'cedergreen' provides a very general way of specifying then Cedergreen-Ritz-Streibig - modified log-logistic model for describing hormesis, under various constraints on the parameters. - - \code{\link{CRS.6}} is the extension of \code{link{cedergreen}} with freely varying alpha parameter. - - For u-shaped hormesis data 'ucedergreen' provides a very general way of specifying the - Cedergreen-Ritz-Streibig modified log-logistic model, under various constraints on the parameters. -} - -\usage{ - cedergreen(fixed = c(NA, NA, NA, NA, NA), - names = c("b", "c", "d", "e", "f"), - method = c("1", "2", "3", "4"), ssfct = NULL, - alpha, fctName, fctText) - - CRS.6(fixed = c(NA, NA, NA, NA, NA, NA), - names = c("b","c","d","e","f","g"), - method = c("1", "2", "3", "4"), ssfct = NULL) - - ucedergreen(fixed = c(NA, NA, NA, NA, NA), - names = c("b", "c", "d", "e", "f"), - method = c("1", "2", "3", "4"), ssfct = NULL, - alpha) -} - -\arguments{ - \item{fixed}{numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.} - \item{names}{a vector of character strings giving the names of the parameters (should not contain ":"). - The order of the parameters is: b, c, d, e, f (see under 'Details').} - \item{method}{character string indicating the self starter function to use.} - \item{ssfct}{a self starter function to be used.} - \item{alpha}{numeric value between 0 and 1, reflecting the steepness of the hormesis peak. - This argument needs to be specified.} - \item{fctName}{optional character string used internally by convenience functions.} - \item{fctText}{optional character string used internally by convenience functions.} -} - -\details{ -The model is given by the expression - - \deqn{ f(x) = c + \frac{d-c+f exp(-1/(x^{\alpha}))}{1+exp(b(log(x)-log(e)))}} - -which is a five-parameter model (alpha is fixed or freely varying). Not all features (eg EC/ED calculation) -are available for the model with freely varying alpha. - -It is a modification of the four-parameter logistic curve to take hormesis into account. - -The u-shaped model is given by the expression - - \deqn{ f(x) = cd - \frac{d-c+f \exp(-1/x^{\alpha})}{1+\exp(b(\log(x)-\log(e)))}} - -} - -\value{ - The value returned is a list containing the non-linear function, the self starter function - and the parameter names. -} - -\references{ - Cedergreen, N. and Ritz, C. and Streibig, J. C. (2005) - Improved empirical models describing hormesis, - \emph{Environmental Toxicology and Chemistry} - \bold{24}, 3166--3172. -} - -\author{Christian Ritz} - -\note{ - The functions are for use with the functions \code{\link{drm}}. -} - -\seealso{ - For fixed alpha, several special cases are handled by the following convenience functions - \code{\link{CRS.4a}}, \code{\link{CRS.4b}}, - \code{\link{CRS.4c}}, \code{\link{CRS.5a}}, \code{\link{CRS.5b}}, \code{\link{CRS.5c}}, - \code{\link{UCRS.4a}}, \code{\link{UCRS.4b}}, \code{\link{UCRS.4c}}, \code{\link{UCRS.5a}}, - \code{\link{UCRS.5b}}, \code{\link{UCRS.5c}} where a, b and c correspond to - the pre-specified alpha values 1, 0.5 and 0.25, respectively. -} - -\examples{ - -## Estimating CRS model with alpha unknown -lettuce.crsm1 <- drm(weight~conc, data = lettuce, fct = CRS.6()) -summary(lettuce.crsm1) -plot(lettuce.crsm1) # oops: not increasing until hormesis peak - -} - -\keyword{models} -\keyword{nonlinear} - -\concept{hormesis hormetic effect initial stimulation u-shaped} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cedergreen.R +\name{cedergreen} +\alias{cedergreen} +\title{Cedergreen-Ritz-Streibig Model} +\usage{ +cedergreen( + fixed = c(NA, NA, NA, NA, NA), + names = c("b", "c", "d", "e", "f"), + method = c("loglinear", "anke", "method3", "normolle"), + ssfct = NULL, + alpha, + fctName, + fctText +) +} +\arguments{ +\item{fixed}{A numeric vector of length 5 specifying any parameters to be held fixed +during the estimation. The order is \code{c(b, c, d, e, f)}. Use \code{NA} for +parameters that should be estimated. The default is to estimate all parameters.} + +\item{names}{A character vector of length 5 providing names for the parameters. +The default is \code{c("b", "c", "d", "e", "f")}.} + +\item{method}{A character string specifying the method for the self-starter function +to use for finding initial parameter values. Options are \code{"loglinear"}, +\code{"anke"}, \code{"method3"}, and \code{"normolle"}. This is only used if \code{ssfct} is \code{NULL}.} + +\item{ssfct}{A custom self-starter function. If \code{NULL} (the default), a +self-starter is automatically generated by calling \code{\link{cedergreen.ssf}} +with the specified \code{method}, \code{fixed}, and \code{alpha} arguments.} + +\item{alpha}{A mandatory numeric value specifying the fixed shape parameter \eqn{\alpha}. +The function will stop if this is not provided.} + +\item{fctName}{An optional character string to name the function object.} + +\item{fctText}{An optional character string providing a descriptive text for the model.} +} +\value{ +A list of class \code{mllogistic}, containing the model function (\code{fct}), +the self-starter function (\code{ssfct}), parameter names (\code{names}), and other +components required for use with modeling functions like \code{\link[drc]{drm}}. +} +\description{ +Provides the Cedergreen-Ritz-Streibig function, a five-parameter model +for describing dose-response curves that exhibit hormesis (a stimulatory or +beneficial effect at low doses). This function generates a model object suitable +for use with non-linear regression functions like \code{\link[drc]{drm}}. +} +\details{ +The Cedergreen-Ritz-Streibig model is defined by the following equation: +\deqn{f(x) = c + \frac{d - c + f \exp(-1/x^{\alpha})}{1 + \exp(b(\log(x) - \log(e)))}} +The parameter \eqn{f} determines the size of the hormetic effect (stimulation). +If \eqn{f=0}, the model simplifies to the standard four-parameter log-logistic model. +The parameter \eqn{\alpha} is a shape parameter that must be specified by the user. +} +\examples{ +dose <- c(0, 0.1, 0.5, 1, 5, 10, 20) +response <- c(100, 102, 95, 80, 40, 25, 20) +my_data <- data.frame(dose = dose, response = response) +model_fit <- drm(response ~ dose, data = my_data, + fct = cedergreen(alpha = 0.5)) +summary(model_fit) + +} +\seealso{ +\code{\link[drc]{drm}} for model fitting, and \code{\link{cedergreen.ssf}} for the +underlying self-starter function. +} +\author{ +Christian Ritz, Hannes Reinwald +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/cedergreen.ssf.Rd b/man/cedergreen.ssf.Rd new file mode 100644 index 00000000..cc07e94c --- /dev/null +++ b/man/cedergreen.ssf.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cedergreen.ssf.R +\name{cedergreen.ssf} +\alias{cedergreen.ssf} +\title{Self-starter for the Cedergreen-Ritz-Streibig Dose-Response Model} +\usage{ +cedergreen.ssf( + method = c("loglinear", "anke", "method3", "normolle"), + fixed, + alpha, + useFixed = FALSE +) +} +\arguments{ +\item{method}{A character string specifying the method for estimating initial +'b' and 'e' parameters. Using descriptive names is preferred.} + +\item{fixed}{A numeric vector of fixed parameter values, with \code{NA} for +parameters that need to be estimated. The required order is \code{c(b, c, d, e, f)}.} + +\item{alpha}{A numeric value for the alpha parameter, which is treated as a known +constant during the estimation of the other initial parameters.} + +\item{useFixed}{A logical value. If \code{TRUE}, the function will use the non-NA +values provided in the \code{fixed} argument as fixed parameters and only estimate the others.} +} +\value{ +A numeric vector of initial parameter estimates for the model parameters +that were not specified as \code{fixed}. +} +\description{ +A self-starting function for the Cedergreen-Ritz-Streibig model, +used to find initial parameter estimates for non-linear regression (e.g., with \code{nls} or \code{drc}). +} +\details{ +This function is a closure that returns another function. The returned +function takes a data frame and calculates initial values for the model parameters +(b, c, d, e, f). This self-starter relies on several helper functions +(e.g., \code{findcd}, \code{findbe1}, \code{findbe2}, \code{findbe3}) which must be available in the +calling environment. +} +\keyword{internal} diff --git a/man/cedergreen_edfct.Rd b/man/cedergreen_edfct.Rd new file mode 100644 index 00000000..a6720475 --- /dev/null +++ b/man/cedergreen_edfct.Rd @@ -0,0 +1,50 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cedergreen.R +\name{cedergreen_edfct} +\alias{cedergreen_edfct} +\title{Calculate Effective Dose for the Cedergreen-Ritz Hormesis Model} +\usage{ +cedergreen_edfct( + parm, + all_params, + not_fixed, + alpha, + respl, + reference, + type, + lower = 1e-04, + upper = 10000 +) +} +\arguments{ +\item{parm}{A numeric vector of the non-fixed model parameters.} + +\item{all_params}{A numeric vector template for all model parameters (b,c,d,e,f).} + +\item{not_fixed}{A logical or integer vector indicating the non-fixed parameters.} + +\item{alpha}{A numeric value for the hormesis model's alpha shape parameter.} + +\item{respl}{The response level to calculate the dose for (e.g., 50 for ED50).} + +\item{reference}{A character string ("control" or "absolute") for calculating the response.} + +\item{type}{A character string specifying the type of ED calculation.} + +\item{lower}{The lower bound of the dose interval for the root-finding search.} + +\item{upper}{The upper bound of the dose interval for the root-finding search.} +} +\value{ +A list containing the calculated effective dose and a vector of its +partial derivatives with respect to the non-fixed parameters. +} +\description{ +An internal helper function to calculate the effective dose (ED) and its +derivatives for the Cedergreen-Ritz five-parameter hormesis model. It uses +\code{uniroot} to find the dose for a given response level. +} +\author{ +Hannes Reinwald +} +\keyword{internal} diff --git a/man/cedergreen_maxfct.Rd b/man/cedergreen_maxfct.Rd new file mode 100644 index 00000000..7078d14a --- /dev/null +++ b/man/cedergreen_maxfct.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cedergreen.R +\name{cedergreen_maxfct} +\alias{cedergreen_maxfct} +\title{Find the Dose and Response at Maximum Hormesis} +\usage{ +cedergreen_maxfct( + all_params, + alpha, + lower = 1e-06, + upper = 1000, + .optimize_fn = stats::optimize +) +} +\arguments{ +\item{all_params}{A named list of all model parameters (b, c, d, e, f).} + +\item{alpha}{The hormesis alpha shape parameter.} + +\item{lower}{The lower bound of the dose interval to search for the maximum.} + +\item{upper}{The upper bound of the dose interval to search for the maximum.} +} +\value{ +A numeric vector containing two values: the dose at the maximum +response, and the maximum response value itself. Returns \code{c(NA, NA)} on failure. +} +\description{ +This function finds the dose that elicits the maximum hormetic (stimulatory) +response for the Cedergreen-Ritz model and the response value at that dose. +} +\author{ +Hannes Reinwald +} +\keyword{internal} diff --git a/man/chickweed.Rd b/man/chickweed.Rd new file mode 100644 index 00000000..160301be --- /dev/null +++ b/man/chickweed.Rd @@ -0,0 +1,130 @@ +\name{chickweed} + +\alias{chickweed} + +\alias{chickweed0} + +\docType{data} + +\title{ + Germination of common chickweed (\emph{Stellaria media}) +} + +\description{ + Germination data from tests of chickweed seeds from chlorsulfuron resistant and sensitive biotypes +} + +\usage{data(chickweed)} + +\format{ + A data frame with 35 observations on the following 3 variables. + \describe{ + \item{\code{start}}{a numeric vector of left endpoints of the monitoring intervals} + \item{\code{end}}{a numeric vector of right endpoints of the monitoring intervals} + \item{\code{count}}{a numeric vector of the number of seeds germinated in the interval between start and end} + \item{\code{time}}{a numeric vector of the non-zero left endpoints of the monitoring intervals (often used for recording in practice)} + } +} + +\details{ + The germination tests of chickweed seeds from chlorsulfuron resistant and sensitive biotypes in central Zealand were + done in petri dishes (diameter: 9.0cm) in a dark growth cabinet at a temperature of 5 degrees Celsius. The seeds were incubated for + 24 hours in a 0.3\% solution of potassium nitrate in order to imbibe seeds prior to the test. A total of 200 seeds were placed on filter plate. + After initialization of the tests, the number of germinated seeds was recorded and removed at 34 consecutive inspection times. + Definition of a germinated seed was the breakthrough of the seed testa by the radicle. + + Chickweed is known to have dormant seeds and therefore we would not expect 100\% germination. It means that the upper limit + of the proportion germinated has to be incorporated as a parameter into a model, which adequately reflects the experimental design + as well as any expectations about the resulting outcome. +} + +\source{ + Data are kindly provided by Lisa Borggaard (formerly at the Faculty of Life Sciences, University of Copenhagen). +} + +\references{ + Ritz, C., Pipper, C. B. and Streibig, J. C. (2013) Analysis of germination data from agricultural experiments, \emph{Europ. J. Agronomy}, \bold{45}, 1--6. +} + +\examples{ +library(drc) + +## Incorrect analysis using a logistic regression model +## (treating event times as binomial data) +## The argument "type" specifies that binomial data are supplied +chickweed.m0a <- drm(count/200 ~ time, weights = rep(200, 34), +data = chickweed0, fct = LL.3(), type = "binomial") +summary(chickweed.m0a) # showing a summmary of the model fit (including parameter estimates) + +## Incorrect analysis based on nonlinear regression +## LL.3() refers to the three-parameter log-logistic model +## As the argument "type" is not specified it is assumed that the data type +## is continuous and nonlinear regression based on least squares estimation is carried out +chickweed.m0b <- drm(count/200 ~ time, data = chickweed0, fct = LL.3()) +summary(chickweed.m0b) # showing a summmary of the model fit (including parameter estimates) + +## How to re-arrange the data for fitting the event-time model +## (only for illustration of the steps needed for converting a dataset, +## but in this case not needed as both datasets are already provided in "drc") +#chickweed <- data.frame(start = c(0, chickweed0$time), end = c(chickweed0$time, Inf)) +#chickweed$count <- c(0, diff(chickweed0$count), 200 - tail(chickweed0$count, 1)) +#head(chickweed) # showing top 6 lines of the dataset +#tail(chickweed) # showing bottom 6 lines + +## Fitting the event-time model (by specifying the argument type explicitly) +chickweed.m1 <- drm(count~start+end, data = chickweed, fct = LL.3(), type = "event") +summary(chickweed.m1) # showing a summmary of the model fit (including parameter estimates) + +## Summary output with robust standard errors +## library(lmtest) +## library(sandwich) +## coeftest(chickweed.m1, vcov = sandwich) + +## Calculating t10, t50, t90 for the distribution of viable seeds +ED(chickweed.m1, c(10, 50, 90)) + +## Plotting data and fitted regression curve +plot(chickweed.m1, xlab = "Time (hours)", ylab = "Proportion germinated", +xlim=c(0, 340), ylim=c(0, 0.25), log="", lwd=2, cex=1.2) +## Adding the fitted curve obtained using nonlinear regression +plot(chickweed.m0b, add = TRUE, lty = 2, xlim=c(0, 340), +ylim=c(0, 0.25), log="", lwd=2, cex=1.2) +# Note: the event-time model has slightly better fit at the upper limit + +## Enhancing the plot (to look like in the reference paper) +abline(h = 0.20011, lty = 3, lwd = 2) +text(-15, 0.21, "Upper limit: d", pos = 4, cex = 1.5) + +segments(0,0.1,196,0.1, lty = 3, lwd = 2) +segments(196,0.1, 196, -0.1, lty = 3, lwd = 2) +text(200, -0.004, expression(paste("50\% germination: ", t[50])), pos = 4, cex = 1.5) + +abline(a = 0.20011/2-0.20011*20.77/4, b = 0.20011*20.77/4/196, lty = 3, lwd = 2) +#text(200, 0.1, expression(paste("Slope: ", b*(-d/(4*t[50])))), pos = 4, cex = 1.5) +text(200, 0.1, expression("Slope: b" \%.\% "constant"), pos = 4, cex = 1.5) +points(196, 0.1, cex = 2, pch = 0) + + +## Adding confidence intervals + +## Predictions from the event-time model +#coefVec <- coef(chickweed.m1) +#names(coefVec) <- c("b","d","e") +# +#predFct <- function(tival) +#{ +# as.numeric(deltaMethod(coefVec, paste("d/(1+exp(b*(log(",tival,")-log(e))))"), +# vcov(chickweed.m1))) +#} +#predFctv <- Vectorize(predFct, "tival") +# +#etpred <- t(predFctv(0:340)) +#lines(0:340, etpred[,1]-1.96*etpred[,2], lty=1, lwd=2, col="darkgray") +#lines(0:340, etpred[,1]+1.96*etpred[,2], lty=1, lwd=2, col="darkgray") +# +### Predictions from the nonlinear regression model +#nrpred <- predict(chickweed.m0b, data.frame(time=0:340), interval="confidence") +#lines(0:340, nrpred[,2], lty=2, lwd=2, col="darkgray") +#lines(0:340, nrpred[,3], lty=2, lwd=2, col="darkgray") +} +\keyword{datasets} diff --git a/man/chlorac.Rd b/man/chlorac.Rd new file mode 100644 index 00000000..578f026f --- /dev/null +++ b/man/chlorac.Rd @@ -0,0 +1,37 @@ +\name{chlorac} + +\alias{chlorac} + +\docType{data} + +\title{chlorac} + +\description{Data from an acute toxicity test where organisms were exposed to different concentrations of chloroacetaldehyde. The number of dead subjects out of a total were recorded for each concentration.} + +\usage{data(chlorac)} + +\format{ + A data frame with 6 observations on the following 3 variables. + \describe{ + \item{\code{conc}}{a numeric vector} + \item{\code{total}}{a numeric vector} + \item{\code{num.dead}}{a numeric vector} + } +} + +\examples{ +library(drc) + +## Displaying the data +head(chlorac) + +## Fitting a two-parameter log-logistic model for binomial response +chlorac.m1 <- drm(num.dead/total ~ conc, weights = total, +data = chlorac, fct = LL.2(), type = "binomial") +summary(chlorac.m1) + +## Plotting the fitted curve +plot(chlorac.m1, xlab = "Concentration", ylab = "Proportion dead") +} + +\keyword{datasets} diff --git a/man/chlordan.Rd b/man/chlordan.Rd new file mode 100644 index 00000000..8ac76e27 --- /dev/null +++ b/man/chlordan.Rd @@ -0,0 +1,36 @@ +\name{chlordan} + +\alias{chlordan} + +\docType{data} + +\title{Chlordan} + +\description{Data from a chronic toxicity test measuring the reproduction of \emph{Daphnia} exposed to different concentrations of chlordane at two time points. The response measured was the number of offspring (repro) per replicate.} + +\usage{data(chlordan)} + +\format{ + A data frame with 60 observations on the following 5 variables. + \describe{ + \item{\code{replicate}}{a numeric vector} + \item{\code{conc}}{a numeric vector} + \item{\code{repro}}{a numeric vector} + \item{\code{time}}{a numeric vector} + } +} + +\examples{ +library(drc) + +## Displaying the data +head(chlordan) + +## Fitting a three-parameter log-logistic model +chlordan.m1 <- drm(repro ~ conc, data = chlordan, fct = LL.3()) +summary(chlordan.m1) + +## Plotting the fitted curve +plot(chlordan.m1, xlab = "Concentration", ylab = "Reproduction") +} +\keyword{datasets} diff --git a/man/coef.drc.Rd b/man/coef.drc.Rd index 9c78ff3d..70490ab9 100644 --- a/man/coef.drc.Rd +++ b/man/coef.drc.Rd @@ -1,41 +1,31 @@ -\name{coef.drc} - -\alias{coef.drc} - -\title{Extract Model Coefficients} - -\description{ - Extract parameter estimates. -} - -\usage{ - - \method{coef}{drc}(object, ...) -} - -\arguments{ - \item{object}{an object of class 'drc'.} - \item{...}{additional arguments.} -} - -\value{ - A vector of parameter coefficients which are extracted from the model object 'object'. -} - -\author{Christian Ritz} - -\note{This function may work even in cases where 'summary' does not, because the parameter estimates - are retrieved directly from the model fit object without any additional computations of summary statistics and standard errors.} - - -\seealso{A more comprehensive summary is obtained using \code{\link{summary.drc}}.} - -\examples{ - -## Fitting a four-parameter log-logistic model -ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) -coef(ryegrass.m1) - -} -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/coef.drc.R +\name{coef.drc} +\alias{coef.drc} +\title{Extract Model Coefficients} +\usage{ +\method{coef}{drc}(object, ...) +} +\arguments{ +\item{object}{an object of class 'drc'.} + +\item{...}{additional arguments.} +} +\value{ +A vector of parameter coefficients which are extracted from the +model object \code{object}. +} +\description{ +Extract parameter estimates. +} +\examples{ +## Fitting a four-parameter log-logistic model +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +coef(ryegrass.m1) + +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/commatFct.Rd b/man/commatFct.Rd new file mode 100644 index 00000000..9731cb25 --- /dev/null +++ b/man/commatFct.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/commatFct.R +\name{commatFct} +\alias{commatFct} +\title{Construct contrast matrix} +\usage{ +commatFct(object, compMatch) +} +\description{ +Construct contrast matrix +} +\keyword{internal} diff --git a/man/compParm.Rd b/man/compParm.Rd index 87faa4fc..126f214b 100644 --- a/man/compParm.Rd +++ b/man/compParm.Rd @@ -1,55 +1,62 @@ -\name{compParm} - -\alias{compParm} - -\title{Comparison of parameters} - -\description{ - Compare parameters from different assays, either by means of ratios or differences. -} - -\usage{ - compParm(object, strVal, operator = "/", vcov. = vcov, od = FALSE, - pool = TRUE, display = TRUE) -} - -\arguments{ - \item{object}{an object of class 'drc'.} - \item{strVal}{a name of parameter to compare.} - \item{operator}{a character. If equal to "/" (default) parameter ratios are compared. If equal to "-" parameter differences are compared.} - \item{vcov.}{function providing the variance-covariance matrix. \code{\link{vcov}} is the default, - but \code{sandwich} is also an option (for obtaining robust standard errors).} - \item{od}{logical. If TRUE adjustment for over-dispersion is used.} - \item{pool}{logical. If TRUE curves are pooled. Otherwise they are not. This argument only works for models with - independently fitted curves as specified in \code{\link{drm}}.} - \item{display}{logical. If TRUE results are displayed. Otherwise they are not (useful in simulations).} -} - -\value{ - A matrix with columns containing the estimates, estimated standard errors, values of t-statistics and p-values for the null hypothesis that - the ratio equals 1 or that the difference equals 0 (depending on the \code{operator} argument). -} - -\details{ - The function compares actual parameter estimates, and therefore the results depend on the parameterisation used. Probably it is most useful - in combination with the argument \code{collapse} in \code{\link{drm}} for specifying parameter constraints in models, either through - data frames or lists with formulas without intercept (-1). -} - -\author{Christian Ritz} - -\examples{ - -# Fitting a model with names assigned to the parameters! -spinach.m1 <- drm(SLOPE~DOSE, CURVE, data = spinach, -fct = LL.4(names = c("b", "lower", "upper", "ed50"))) - -## Calculating ratios of parameter estimates for the parameter named "ed50" -compParm(spinach.m1, "ed50") - -## Calculating differences between parameter estimates for the parameter named "ed50" -compParm(spinach.m1, "ed50", "-") - -} -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/compParm.R +\name{compParm} +\alias{compParm} +\title{Comparison of parameters} +\usage{ +compParm( + object, + strVal, + operator = "/", + vcov. = vcov, + od = FALSE, + pool = TRUE, + display = TRUE +) +} +\arguments{ +\item{object}{an object of class 'drc'.} + +\item{strVal}{a name of parameter to compare.} + +\item{operator}{a character. If equal to \code{"/"} (default) parameter ratios are compared. +If equal to \code{"-"} parameter differences are compared.} + +\item{vcov.}{function providing the variance-covariance matrix. \code{\link{vcov}} is the default, +but \code{sandwich} is also an option (for obtaining robust standard errors).} + +\item{od}{logical. If TRUE adjustment for over-dispersion is used.} + +\item{pool}{logical. If TRUE curves are pooled. Otherwise they are not. This argument only works +for models with independently fitted curves as specified in \code{\link{drm}}.} + +\item{display}{logical. If TRUE results are displayed. Otherwise they are not (useful in simulations).} +} +\value{ +A matrix with columns containing the estimates, estimated standard errors, values of +t-statistics and p-values for the null hypothesis that the ratio equals 1 or that the difference +equals 0 (depending on the \code{operator} argument). +} +\description{ +Compare parameters from different assays, either by means of ratios or differences. +} +\examples{ +spinach.m1 <- drm(SLOPE~DOSE, CURVE, data = spinach, +fct = LL.4(names = c("b", "lower", "upper", "ed50"))) + +## Calculating ratios of parameter estimates for "ed50" +compParm(spinach.m1, "ed50") + +## Calculating differences between parameter estimates for "ed50" +compParm(spinach.m1, "ed50", "-") + +} +\seealso{ +\code{\link{ED.drc}} for calculating effective doses and \code{\link{EDcomp}} for +comparing effective doses. +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/comped.Rd b/man/comped.Rd index 784abd88..47fb65a0 100644 --- a/man/comped.Rd +++ b/man/comped.Rd @@ -1,94 +1,54 @@ -\name{comped} - -\alias{comped} - -\title{Comparison of effective dose values} - -\description{ - Comparison of a pair of effective dose values from independent experiments - where only the estimates and their standard errors are reported. -} - -\usage{ - comped(est, se, log = TRUE, interval = TRUE, operator = c("-", "/"), - level = 0.95, df = NULL) -} - -\arguments{ - \item{est}{a numeric vector of length 2 containing the two estimated ED values} - \item{se}{a numeric vector of length 2 containing the two standard errors} - \item{log}{logical indicating whether or not estimates and standard errors are on log scale} - \item{interval}{logical indicating whether or not a confidence interval should be returned} - \item{operator}{character string taking one of the two values "-" (default) or "/" corresponding to a comparison - based on the difference or the ratio.} - \item{level}{numeric value giving the confidence level} - \item{df}{numeric value specifying the degrees of freedom for the percentile used in the confidence interval (optional)} -} - -\details{ - The choice "/" for the argument \code{operator} and FALSE for \code{log} will result in estimation of a socalled - relative potency (sometimes also called a selectivity index). - - The combination TRUE for \code{log} and "/" for \code{operator} only influences the confidence interval, - that is no ratio is calculated based on logarithm-transformed effective dose values. - - By default confidence interval relies on percentiles in the normal distribution. - - In case the entire dataset is available the functions \code{\link{drm}} and (subsequently) \code{\link{EDcomp}} - should be used instead. -} - -\value{ - A matrix with the estimated difference or ratio and the associated standard error and the resulting confidence - interval (unless not requested). -} - -\references{ - Wheeler, M. W. and Park, R. M. and Bailer, A. J. (2006) - Comparing median lethal concentration values using confidence interval overlap or ratio tests, - \emph{Environmental Toxicology and Chemistry}, \bold{25}, 1441--1441. -} - -\author{Christian Ritz} - -\note{ - The development of the function \code{comped} is a side effect of the project on statistical analysis of - toxicity data funded by the Danish EPA ("Statistisk analyse og biologisk tolkning af toksicitetsdata", - MST j.nr. 669-00079). -} - -\seealso{ - The function \code{\link{ED.drc}} calculates arbitrary effective dose values based on a model fit. The function - \code{\link{EDcomp}} calculates relative potencies based on arbitrary effective dose values. -} - -\examples{ - -## Fitting the model -S.alba.m1 <- boxcox(drm(DryMatter~Dose, Herbicide, data=S.alba, fct = LL.4(), -pmodels=data.frame(Herbicide,1,1,Herbicide)), method = "anova") - -## Displaying estimated ED values -ED(S.alba.m1, c(10, 90)) - -## Making comparisons of ED50 in two ways and for both differences and ratios -compParm(S.alba.m1, "e", "/") - -comped(c(28.396147, 65.573335), c(1.874598, 5.618945), log=FALSE, operator = "/") -# similar result - -compParm(S.alba.m1, "e", "-") - -comped(c(28.396147, 65.573335), c(1.874598, 5.618945), log=FALSE, operator = "-") -# similar result - -## Making comparisons of ED10 and ED90 -comped(c(21.173, 44.718), c(11.87, 8.42), log=FALSE, operator = "/") - -comped(c(21.173, 44.718), c(11.87, 8.42), log=FALSE, operator = "/", interval = FALSE) - -comped(c(21.173, 44.718), c(11.87, 8.42), log=FALSE, operator = "-") - -} -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/comped.R +\name{comped} +\alias{comped} +\title{Comparison of effective dose values} +\usage{ +comped( + est, + se, + log = TRUE, + interval = TRUE, + operator = c("-", "/"), + level = 0.95, + df = NULL +) +} +\arguments{ +\item{est}{a numeric vector of length 2 containing the two estimated ED values.} + +\item{se}{a numeric vector of length 2 containing the two standard errors.} + +\item{log}{logical indicating whether or not estimates and standard errors are on log scale.} + +\item{interval}{logical indicating whether or not a confidence interval should be returned.} + +\item{operator}{character string taking one of the two values \code{"-"} (default) or \code{"/"} +corresponding to a comparison based on the difference or the ratio.} + +\item{level}{numeric value giving the confidence level.} + +\item{df}{numeric value specifying the degrees of freedom for the percentile used in the +confidence interval (optional). By default confidence interval relies on the normal distribution.} +} +\value{ +A matrix with the estimated difference or ratio and the associated standard error and the +resulting confidence interval (unless not requested). +} +\description{ +Comparison of a pair of effective dose values from independent experiments where only the +estimates and their standard errors are reported. +} +\examples{ +## Comparing ED50 values as a ratio +comped(c(28.396, 65.573), c(1.875, 5.619), log = FALSE, operator = "/") + +## Comparing ED50 values as a difference +comped(c(28.396, 65.573), c(1.875, 5.619), log = FALSE, operator = "-") + +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/confint.basic.Rd b/man/confint.basic.Rd new file mode 100644 index 00000000..123963d7 --- /dev/null +++ b/man/confint.basic.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/confint.drc.R +\name{confint.basic} +\alias{confint.basic} +\title{Basic Confidence Interval Calculation} +\usage{ +\method{confint}{basic}(estMat, level, intType, dfres, formatting = TRUE) +} +\arguments{ +\item{estMat}{A numeric matrix with two columns: the first column contains +parameter estimates and the second column contains their standard errors.} + +\item{level}{The confidence level required (e.g., \code{0.95} for 95\% intervals).} + +\item{intType}{A character string specifying the response type of the model. +One of \code{"binomial"}, \code{"continuous"}, \code{"event"}, \code{"Poisson"}, +\code{"negbin1"}, or \code{"negbin2"}. Determines whether a normal or t-distribution +quantile is used. For \code{"continuous"} models a t-distribution with \code{dfres} +degrees of freedom is used; all other types use the standard normal.} + +\item{dfres}{The residual degrees of freedom. Only used when +\code{intType = "continuous"}.} + +\item{formatting}{Logical. If \code{TRUE} (default), row and column names are +added to the returned matrix.} +} +\value{ +A numeric matrix with two columns giving the lower and upper +confidence limits for each parameter. +} +\description{ +An internal helper function that constructs a confidence interval matrix +from a matrix of parameter estimates and their standard errors. A +t-distribution quantile is used for continuous response models; a standard +normal quantile is used for all other response types (binomial, event, +Poisson, negbin1, negbin2). +} +\seealso{ +\code{\link[=confint.drc]{confint.drc()}} — the user-facing function that calls this helper. +} +\keyword{internal} diff --git a/man/confint.drc.Rd b/man/confint.drc.Rd index 09dbe396..624a7275 100644 --- a/man/confint.drc.Rd +++ b/man/confint.drc.Rd @@ -1,61 +1,59 @@ -\name{confint.drc} - -\alias{confint.drc} - -\title{Confidence Intervals for model parameters} - -\description{ - Computes confidence intervals for one or more parameters in a model of class 'drc'. -} - -\usage{ - - \method{confint}{drc}(object, parm, level = 0.95, pool = TRUE, ...) - -} - -\arguments{ - \item{object}{a model object of class 'drc'.} - \item{parm}{a specification of which parameters are to be given - confidence intervals, either a vector of numbers or a vector - of names. If missing, all parameters are considered.} - \item{level}{the confidence level required.} -% \item{type}{the type of confidence interval: based on the standard normal distribution or -% based on a t-distribution (default).} - \item{pool}{logical. If TRUE curves are pooled. Otherwise they are not. This argument only works for models with - independently fitted curves as specified in \code{\link{drm}}.} - \item{\dots}{additional argument(s) for methods. Not used.} -} - -\details{ - For binomial and Poisson data the confidence intervals are based on the normal distribution, whereas \emph{t} distributions - are used of for continuous/quantitative data. -} - -\value{ - A matrix (or vector) with columns giving lower and upper confidence limits for each parameter. These will be labelled as - (1-level)/2 and 1 - (1-level)/2 in % (by default 2.5% and 97.5%). -} - -%\references{ ~put references to the literature/web site here ~ } - -\author{Christian Ritz} - -%\note{} - -%\seealso{} - -\examples{ - -## Fitting a four-parameter log-logistic model -ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) - -## Confidence intervals for all parameters -confint(ryegrass.m1) - -## Confidence interval for a single parameter -confint(ryegrass.m1, "e") - -} -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/confint.drc.R +\name{confint.drc} +\alias{confint.drc} +\title{Confidence Intervals for Model Parameters} +\usage{ +\method{confint}{drc}(object, parm, level = 0.95, pool = TRUE, ...) +} +\arguments{ +\item{object}{A fitted model object of class \code{"drc"}.} + +\item{parm}{A specification of which parameters are to be given confidence +intervals, either a vector of indices or a vector of parameter name strings. +If missing, all parameters are considered.} + +\item{level}{The confidence level required. Defaults to \code{0.95}.} + +\item{pool}{Logical. If \code{TRUE} (default), curves are pooled. Otherwise they +are not. This argument only works for models with independently fitted +curves as specified in \code{\link[=drm]{drm()}}.} + +\item{...}{Additional arguments for methods. Currently not used.} +} +\value{ +A numeric matrix with two columns giving the lower and upper +confidence limits for each parameter. Columns are labelled as +\eqn{\frac{(1 - \text{level})}{2} \times 100\%} and +\eqn{\left(1 - \frac{(1 - \text{level})}{2}\right) \times 100\%} +(by default \code{2.5 \%} and \code{97.5 \%}). +} +\description{ +Computes confidence intervals for one or more parameters in a fitted +dose-response model of class \code{"drc"}. Confidence intervals are constructed +using either a t-distribution (for continuous response models) or a standard +normal distribution (for all other response types). +} +\examples{ +## Fitting a four-parameter log-logistic model +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + +## Confidence intervals for all parameters +confint(ryegrass.m1) + +## Confidence interval for a single parameter +confint(ryegrass.m1, "e") + +} +\seealso{ +\itemize{ +\item \code{\link[=drm]{drm()}} — for fitting dose-response models. +\item \code{\link[=confint.basic]{confint.basic()}} — the internal helper used to construct the intervals. +\item \code{\link[=summary.drc]{summary.drc()}} — for a full summary of model coefficients. +} +} +\author{ +Christian Ritz, Hannes Reinwald +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/cooks.distance.drc.Rd b/man/cooks.distance.drc.Rd new file mode 100644 index 00000000..8e017fcb --- /dev/null +++ b/man/cooks.distance.drc.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cooks.distance.drc.R +\name{cooks.distance.drc} +\alias{cooks.distance.drc} +\title{Cook's distance for nonlinear dose-response models} +\usage{ +\method{cooks.distance}{drc}(model, ...) +} +\arguments{ +\item{model}{an object of class 'drc'.} + +\item{...}{additional arguments (not used).} +} +\value{ +A vector of Cook's distance values, one value per observation. +} +\description{ +Cook's distance values are provided for nonlinear dose-response model fits using the +same formulas as in linear regression but based on the corresponding approximate quantities +available for nonlinear models. +} +\examples{ +ryegrass.LL.4 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + +cooks.distance(ryegrass.LL.4) + +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/createsifct.Rd b/man/createsifct.Rd new file mode 100644 index 00000000..ba3b529c --- /dev/null +++ b/man/createsifct.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/EDcomp.R +\name{createsifct} +\alias{createsifct} +\title{Create selectivity index function} +\usage{ +createsifct(edfct, logBase = NULL, fls = FALSE, indexMat, lenCoef) +} +\description{ +Create selectivity index function +} +\keyword{internal} diff --git a/man/ctb.Rd b/man/ctb.Rd new file mode 100644 index 00000000..2091479e --- /dev/null +++ b/man/ctb.Rd @@ -0,0 +1,40 @@ +\name{ctb} +\alias{ctb} +\docType{data} +\title{CellTiter-Blue Cell Viability Assay Data} +\description{Neurotoxicity test using the CellTiter-Blue Cell Viability + Assay on SH-SY5Y cells for increasing concentrations of acrylamide.} +\usage{data(ctb)} +\format{ + A data frame with 647 observations on the following 5 variables. + \describe{ + \item{\code{well}}{well ID of a 96 well plate} + \item{\code{conc}}{12 concentrations of acrylamide, ranging from + 0-500mM} + \item{\code{fluorescence}}{measured fluorescence after adding the + resazurin reagent into the wells} + \item{\code{day}}{integer denoting 3 different days} + \item{\code{plate}}{factor with 7 levels representing the plate ID} + } +} +\references{ + Frimat, JP, Sisnaiske, J, Subbiah, S, Menne, H, Godoy, P, Lampen, P, + Leist, M, Franzke, J, Hengstler, JG, van Thriel, C, West, J. The + network formation assay: a spatially standardized neurite outgrowth + analytical display for neurotoxicity screening. Lab Chip 2010; 10:701-709. +} + + +\examples{ +data(ctb) +ctb$day <- as.factor(ctb$day) + +## Fit a four-parameter log-logistic model +ctb.m1 <- drm(fluorescence ~ conc, data = ctb, fct = LL.4()) +summary(ctb.m1) +plot(ctb.m1, main = "CTB dose-response") +} + + + +\keyword{datasets} diff --git a/man/daphnids.Rd b/man/daphnids.Rd new file mode 100644 index 00000000..4228f557 --- /dev/null +++ b/man/daphnids.Rd @@ -0,0 +1,72 @@ +\name{daphnids} + +\alias{daphnids} + +\docType{data} + +\title{Daphnia test} + +\description{ + The number of immobile daphnids --in contrast to mobile daphnids-- out of a total of 20 daphnids was counted + for several concentrations of a toxic substance. +} + +\usage{data(daphnids)} + +\format{ + A data frame with 16 observations on the following 4 variables. + \describe{ + \item{\code{dose}}{a numeric vector} + \item{\code{no}}{a numeric vector} + \item{\code{total}}{a numeric vector} + \item{\code{time}}{a factor with levels \code{24h} \code{48h}} + } +} + +\details{ + The same daphnids were counted at 24h and later again at 48h. +} + +\source{ + Nina Cedergreen, Faculty of Life Sciences, University of Copenhagen, Denmark. +} + +%\references{} + +\examples{ +library(drc) + +## Fitting a model with different parameters +## for different curves +daphnids.m1 <- drm( data = daphnids, no/total~dose, + curveid = time, weights = total, + fct = LL.2(), type = "binomial" ) + +## plot models +plot(daphnids.m1, ylim = c(0, 1), + xlab = "Dose (µg/L)", ylab = "Proportion of daphnids affected", + main = "Model with different parameters for different curves") + +## Goodness-of-fit test +modelFit(daphnids.m1) + +## Summary of the data +summary(daphnids.m1) + +## Fitting a model with a common intercept parameter +daphnids.m2 <- drm(no/total~dose, curveid = time, weights = total, + data = daphnids, fct = LL.2(), type = "binomial", + pmodels = list(~1, ~time)) + +## plot models +plot(daphnids.m2, ylim = c(0, 1), + xlab = "Dose (µg/L)", ylab = "Proportion of daphnids affected", + main = "Models with common intercept parameter") + +## Goodness-of-fit test +modelFit(daphnids.m2) + +## Summary of the data +summary(daphnids.m2) +} +\keyword{datasets} diff --git a/man/decontaminants.Rd b/man/decontaminants.Rd new file mode 100644 index 00000000..fc9c145e --- /dev/null +++ b/man/decontaminants.Rd @@ -0,0 +1,57 @@ +\name{decontaminants} + +\alias{decontaminants} + +\docType{data} + +\title{ +Performance of decontaminants used in the culturing of a micro-organism +} + +\description{ +The two decontaminants 1-hexadecylpyridium chloride and oxalic acid were used. Additionally there was a control group (coded as concentration 0 and only included under oxalic acid). +} + +\usage{data("decontaminants")} +\format{ + A data frame with 128 observations on the following 3 variables. + \describe{ + \item{\code{conc}}{a numeric vector of percentage weight per volume} + \item{\code{count}}{a numeric vector of numbers of M. bovis colonies at stationarity} + \item{\code{group}}{a factor with levels \code{hpc} and \code{oxalic} of the decontaminants used} + } +} + +\details{ +These data examplify Wadley's problem: counts where the maximum number is not known. The data were analyzed by Trajstman (1989) using a three-parameter logistic model and then re-analyzed by Morgan and Smith (1992) using a three-parameter Weibull type II model. In both cases the authors adjusted for overdispersion (in different ways). + +It seems that Morgan and Smith (1992) fitted separate models for the two decontaminants and using the control group for both model fits. In the example below a joint model is fitted where the control group is used once to determine a shared upper limit at concentration 0. +} + +\source{ +Trajstman, A. C. (1989) Indices for Comparing Decontaminants when Data Come from Dose-Response Survival and Contamination Experiments, \emph{Applied Statistics}, \bold{38}, 481--494. +} + +\references{ +Morgan, B. J. T. and Smith, D. M. (1992) A Note on Wadley's Problem with Overdispersion, \emph{Applied Statistics}, \bold{41}, 349--354. +} + +\examples{ +library(drc) + +## Wadley's problem using a three-parameter log-logistic model +decon.LL.3.1 <- drm(count~conc, group, data = decontaminants, fct = LL.3(), +type = "Poisson", pmodels = list(~group, ~1, ~group)) + +summary(decon.LL.3.1) + +plot(decon.LL.3.1) + + +## Same model fit in another parameterization (no intercepts) +decon.LL.3.2 <- drm(count~conc, group, data = decontaminants, fct=LL.3(), +type = "Poisson", pmodels = list(~group-1, ~1, ~group-1)) + +summary(decon.LL.3.2) +} +\keyword{datasets} diff --git a/man/deguelin.Rd b/man/deguelin.Rd new file mode 100644 index 00000000..17ff2171 --- /dev/null +++ b/man/deguelin.Rd @@ -0,0 +1,60 @@ +\name{deguelin} + +\alias{deguelin} + +\docType{data} + +\title{Deguelin applied to chrysanthemum aphis} + +\description{ + Quantal assay data from an experiment where the insectide deguelin was applied to + \emph{Macrosiphoniella sanborni}. +} +\usage{data(deguelin)} + +\format{ + A data frame with 6 observations on the following 4 variables. + \describe{ + \item{\code{dose}}{a numeric vector of doses applied} + \item{\code{log10dose}}{a numeric vector of logarithm-transformed doses} + \item{\code{r}}{a numeric vector contained number of dead insects} + \item{\code{n}}{a numeric vector contained the total number of insects} + } +} + +\details{ + The log-logistic model provides an inadequate fit. + + The dataset is used in Nottingham and Birch (2000) to illustrate a semiparametric approach to dose-response + modelling. +} + +\source{ + Morgan, B. J. T. (1992) \emph{Analysis of Quantal Response Data}, London: Chapman & Hall/CRC (Table 3.9, p. 117). +} + +\references{ + Notttingham, Q. J. and Birch, J. B. (2000) A semiparametric approach to analysing dose-response data, \emph{Statist. Med.}, \bold{19}, 389--404. +} + +\examples{ +library(drc) + +## Log-logistic fit +deguelin.m1 <- drm(r/n~dose, weights=n, data=deguelin, fct=LL.2(), type="binomial") +modelFit(deguelin.m1) +summary(deguelin.m1) + +## Loess fit +deguelin.m2 <- loess(r/n~dose, data=deguelin, degree=1) + +## Plot of data with fits superimposed +plot(deguelin.m1, ylim=c(0.2,1)) +lines(1:60, predict(deguelin.m2, newdata=data.frame(dose=1:60)), col = 2, lty = 2) + +lines(1:60, 0.95*predict(deguelin.m2, +newdata=data.frame(dose=1:60))+0.05*predict(deguelin.m1, newdata=data.frame(dose=1:60), se = FALSE), +col = 3, lty=3) +} + +\keyword{datasets} diff --git a/man/divAtInf.Rd b/man/divAtInf.Rd new file mode 100644 index 00000000..eb92a181 --- /dev/null +++ b/man/divAtInf.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/xlogx.R +\name{divAtInf} +\alias{divAtInf} +\title{Helper functions for x*log(x) calculations} +\usage{ +divAtInf(x, y) +} +\description{ +Helper functions for x*log(x) calculations +} +\keyword{internal} diff --git a/man/dot-onAttach.Rd b/man/dot-onAttach.Rd new file mode 100644 index 00000000..a535c1a6 --- /dev/null +++ b/man/dot-onAttach.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/onAttach.R +\name{.onAttach} +\alias{.onAttach} +\title{Package attach hook} +\usage{ +.onAttach(libname, pkgname) +} +\description{ +Package attach hook +} +\keyword{internal} diff --git a/man/drc-package.Rd b/man/drc-package.Rd new file mode 100644 index 00000000..0d457b1a --- /dev/null +++ b/man/drc-package.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/drc-package.R +\docType{package} +\name{drc-package} +\alias{drc} +\alias{drc-package} +\title{drc: Analysis of Dose-Response Data} +\description{ +\if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} + +Analysis of dose-response data is made available through a suite of flexible and versatile model fitting and after-fitting functions. +} +\seealso{ +Useful links: +\itemize{ + \item \url{https://hreinwald.github.io/drc} + \item \url{https://github.com/hreinwald/drc} + \item \url{https://www.bioassay.dk} + \item \url{https://www.r-project.org} + \item \url{https://cran.r-project.org/web/packages/drc/index.html} + \item Report bugs at \url{https://github.com/hreinwald/drc/issues/} +} + +} +\author{ +\strong{Maintainer}: Hannes Reinwald \email{hannes.reinwald@bayer.com} + +Authors: +\itemize{ + \item Christian Ritz \email{ritz@bioassay.dk} + \item Jens C. Streibig \email{streibig@bioassay.dk} +} + +} +\keyword{internal} diff --git a/man/drm.Rd b/man/drm.Rd index 12be2f87..d551babe 100644 --- a/man/drm.Rd +++ b/man/drm.Rd @@ -1,119 +1,127 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/drm.R \name{drm} - \alias{drm} - \title{Fitting dose-response models} - -\description{ - A general model fitting function for analysis of various types of dose-response data. -} - \usage{ - drm(formula, curveid, pmodels, weights, data = NULL, subset, fct, - type = c("continuous", "binomial", "Poisson", "negbin1", "negbin2", "event", "ssd"), - bcVal = NULL, bcAdd = 0, - start, na.action = na.omit, robust = "mean", logDose = NULL, - control = drmc(), lowerl = NULL, upperl = NULL, separate = FALSE, - pshifts = NULL, varcov = NULL) +drm( + formula, + curveid, + pmodels, + weights, + data = NULL, + subset, + fct, + type = c("continuous", "binomial", "Poisson", "negbin1", "negbin2", "event", "ssd"), + bcVal = NULL, + bcAdd = 0, + start, + na.action = na.omit, + robust = "mean", + logDose = NULL, + control = drmc(), + lowerl = NULL, + upperl = NULL, + separate = FALSE, + pshifts = NULL, + varcov = NULL +) } - \arguments{ - \item{formula}{a symbolic description of the model to be fit. Either of the form 'response \eqn{~} dose' - or as a data frame with response values in first column and dose values in second column.} - - \item{curveid}{a numeric vector or factor containing the grouping of the data.} - - \item{pmodels}{a data frame with a many columns as there are parameters in the non-linear function. - Or a list containing a formula for each parameter in the nonlinear function.} - - \item{weights}{ - a numeric vector containing weights. For continuous/quantitative responses, inverse weights are multiplied inside the squared errors; this means that weights should have the same unit as the response - (see the details below). - For binomial reponses weights provide information about the total number of binary observations used to obtain the response (which is a proportion): - 1/2 and 10/20 lead to different analyses due to the different totals (2 vs. 20) even though the proportion in both cases is 0.5. - } - - \item{data}{ - an optional data frame containing the variables in the model.} - - \item{subset}{an optional vector specifying a subset of observations to be used in the fitting process.} - - \item{fct}{a list with three or more elements specifying the non-linear - function, the accompanying self starter function, the names of the parameter in the non-linear function and, - optionally, the first and second derivatives as well as information used for calculation of ED values. - Currently available functions include, among others, the four- and five-parameter log-logistic models - \code{\link{LL.4}}, \code{\link{LL.5}} and the Weibull model \code{\link{W1.4}}. Use - \code{\link{getMeanFunctions}} for a full list.} - - \item{type}{a character string specifying the distribution of the data (parameter estimation will depend on the assumed distribution as different log likelihood functions will be used). - The default is "continuous", corresponding to assuming a normal distribution. The choices "binary" and "event" imply a binomial and multinomial distribution, respectively. The choice "ssd" is for fitting a species sensitivity - distribution.} - - \item{bcVal}{a numeric value specifying the lambda parameter to be used in the Box-Cox transformation.} - - \item{bcAdd}{a numeric value specifying the constant to be added on both sides prior to Box-Cox transformation. - The default is 0.} - - \item{start}{an optional numeric vector containing starting values for all mean parameters in the model. - Overrules any self starter function.} - - \item{na.action}{a function for treating mising values ('NA's). Default is \code{\link{na.omit}}.} - - \item{robust}{a character string specifying the rho function for robust estimation. Default is non-robust - least squares estimation ("mean"). Available robust methods are: median estimation ("median"), - least median of squares ("lms"), least trimmed squares ("lts"), metric trimming ("trimmed"), - metric winsorizing ("winsor") and Tukey's biweight ("tukey").} - - \item{logDose}{a numeric value or NULL. If log doses value are provided the base of the logarithm should be specified (exp(1) for the natural logarithm and 10 for the base 10 logarithm).} - - \item{control}{a list of arguments controlling constrained optimisation (zero as boundary), - maximum number of iteration in the optimisation, - relative tolerance in the optimisation, warnings issued during the optimisation.} - - \item{lowerl}{a numeric vector of lower limits for all parameters in the model - (the default corresponds to minus infinity for all parameters).} - - \item{upperl}{a numeric vector of upper limits for all parameters in the model - (the default corresponds to plus infinity for all parameters).} - - \item{separate}{logical value indicating whether curves should be fit separately (independent of each other).} - - \item{pshifts}{a matrix of constants to be added to the matrix of parameters. Default is no shift for all parameters.} - - \item{varcov}{an optional user-defined known variance-covariance matrix for the responses. Default is the identity matrix (NULL), corresponding to independent response values with a common standard deviation, which will be estimated from the data.} -} +\item{formula}{a symbolic description of the model to be fit. Either of the form +\code{response ~ dose} or as a data frame with response values in first column and dose +values in second column.} -\details{ - - This function relies on the general optimiser function \code{\link{optim}} for the minimisation of negative log likelihood function. For a continuous response this reduces to least squares estimation, which is carried out by minimising the following sums of squares - - \deqn{\sum_{i=1}^N [(y_i-f_i) / w_i]^2} - - where \eqn{y_i}, \eqn{f_i}, and \eqn{w_i} correspond to the observed response value, expected mean value, and the weight, respectively, for the ith observation (from 1 to \eqn{N}). - - Response values are assumed to be mutually independent unless the argument \code{varcov} is specified (in which case the correlation structure is assumed to be completely known). - - For robust estimation MAD (median absolute deviance) is used to estimate the residual variance. - - Setting \code{lowerl} and/or \code{upperl} automatically invokes constrained optimisation. - - The columns of a data frame argument to \code{pmodels} are automatically converted into factors. - This does not happen if a list is specified. - - Control arguments may be specified using the function \code{\link{drmc}}. -} +\item{curveid}{a numeric vector or factor containing the grouping of the data.} -\value{ - An object of (S3) class 'drc'. -} +\item{pmodels}{a data frame with as many columns as there are parameters in the non-linear +function. Or a list containing a formula for each parameter in the nonlinear function.} + +\item{weights}{a numeric vector containing weights. For continuous/quantitative responses, +inverse weights are multiplied inside the squared errors (weights should have the same unit +as the response). For binomial responses weights provide information about the total number +of binary observations used to obtain the response.} + +\item{data}{an optional data frame containing the variables in the model.} + +\item{subset}{an optional vector specifying a subset of observations to be used in the +fitting process.} + +\item{fct}{a list with three or more elements specifying the non-linear function, the +accompanying self starter function, the names of the parameters in the non-linear function +and, optionally, the first and second derivatives as well as information used for +calculation of ED values. Use \code{\link{getMeanFunctions}} for a full list.} + +\item{type}{a character string specifying the distribution of the data. The default is +\code{"continuous"}, corresponding to a normal distribution. Other choices include +\code{"binomial"}, \code{"Poisson"}, \code{"negbin1"}, \code{"negbin2"}, \code{"event"}, +and \code{"ssd"}.} + +\item{bcVal}{a numeric value specifying the lambda parameter to be used in the Box-Cox +transformation.} -%\references{ ~put references to the literature/web site here ~ } +\item{bcAdd}{a numeric value specifying the constant to be added on both sides prior to +Box-Cox transformation. The default is 0.} -\author{Christian Ritz and Jens C. Streibig} +\item{start}{an optional numeric vector containing starting values for all mean parameters +in the model. Overrules any self starter function.} -%\note{} +\item{na.action}{a function for treating missing values (\code{NA}s). Default is +\code{\link{na.omit}}.} -%\examples{} +\item{robust}{a character string specifying the rho function for robust estimation. +Default is non-robust least squares estimation (\code{"mean"}). Available robust methods +are: \code{"median"}, \code{"lms"}, \code{"lts"}, \code{"trimmed"}, \code{"winsor"}, and +\code{"tukey"}.} +\item{logDose}{a numeric value or \code{NULL}. If log dose values are provided the base of +the logarithm should be specified (e.g., \code{exp(1)} for natural logarithm, \code{10} +for base 10).} + +\item{control}{a list of arguments controlling constrained optimisation, maximum iterations, +relative tolerance, and warnings. See \code{\link{drmc}}.} + +\item{lowerl}{a numeric vector of lower limits for all parameters in the model (the default +corresponds to minus infinity for all parameters).} + +\item{upperl}{a numeric vector of upper limits for all parameters in the model (the default +corresponds to plus infinity for all parameters).} + +\item{separate}{logical value indicating whether curves should be fit separately +(independent of each other).} + +\item{pshifts}{a matrix of constants to be added to the matrix of parameters. Default is no +shift for all parameters.} + +\item{varcov}{an optional user-defined known variance-covariance matrix for the responses. +Default is the identity matrix (\code{NULL}), corresponding to independent response values +with a common standard deviation estimated from the data.} +} +\value{ +An object of (S3) class \code{"drc"}. +} +\description{ +A general model fitting function for analysis of various types of dose-response data. +} +\details{ +This function relies on \code{\link{optim}} for minimisation of the negative log +likelihood function. For a continuous response this reduces to least squares estimation. +Response values are assumed to be mutually independent unless \code{varcov} is specified. +For robust estimation MAD (median absolute deviance) is used to estimate the residual +variance. Setting \code{lowerl} and/or \code{upperl} automatically invokes constrained +optimisation. Control arguments may be specified using \code{\link{drmc}}. +} +\examples{ +## Fitting a four-parameter log-logistic model to the ryegrass data +model <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +summary(model) + +} +\seealso{ +\code{\link{drmc}}, \code{\link{LL.4}}, \code{\link{getMeanFunctions}} +} +\author{ +Christian Ritz, Jens C. Streibig and Hannes Reinwald +} \keyword{models} \keyword{nonlinear} diff --git a/man/drmConvertParm.Rd b/man/drmConvertParm.Rd new file mode 100644 index 00000000..a50aaf5e --- /dev/null +++ b/man/drmConvertParm.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/drmConvertParm.R +\name{drmConvertParm} +\alias{drmConvertParm} +\title{Convert parameter vectors to matrices} +\usage{ +drmConvertParm(startVec, startMat, factor1, colList) +} +\description{ +Convert parameter vectors to matrices +} +\keyword{internal} diff --git a/man/drmEMbinomial.Rd b/man/drmEMbinomial.Rd new file mode 100644 index 00000000..8780dc68 --- /dev/null +++ b/man/drmEMbinomial.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/drmEMbinomial.R +\name{drmEMbinomial} +\alias{drmEMbinomial} +\title{EM algorithm for binomial response} +\usage{ +drmEMbinomial( + dose, + resp, + multCurves, + startVec, + robustFct, + weights, + rmNA, + zeroTol = 1e-12, + doseScaling = 1, + respScaling = 1 +) +} +\description{ +EM algorithm for binomial response +} +\keyword{internal} diff --git a/man/drmEMls.Rd b/man/drmEMls.Rd new file mode 100644 index 00000000..a14a146b --- /dev/null +++ b/man/drmEMls.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/drmEMls.R +\name{drmEMls} +\alias{drmEMls} +\title{EM algorithm for least squares} +\usage{ +drmEMls( + dose, + resp, + multCurves, + startVec, + robustFct, + weights, + rmNA, + dmf = NULL, + doseScaling = 1, + respScaling = 1, + varcov = NULL +) +} +\description{ +EM algorithm for least squares +} +\keyword{internal} diff --git a/man/drmLOFPoisson.Rd b/man/drmLOFPoisson.Rd new file mode 100644 index 00000000..99693fad --- /dev/null +++ b/man/drmLOFPoisson.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/drmEMPoisson.R +\name{drmLOFPoisson} +\alias{drmLOFPoisson} +\title{EM algorithm for Poisson response} +\usage{ +drmLOFPoisson() +} +\description{ +EM algorithm for Poisson response +} +\keyword{internal} diff --git a/man/drmLOFbinomial.Rd b/man/drmLOFbinomial.Rd new file mode 100644 index 00000000..8b4514a7 --- /dev/null +++ b/man/drmLOFbinomial.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/drmLOFbinomial.R +\name{drmLOFbinomial} +\alias{drmLOFbinomial} +\title{Lack-of-fit test for binomial response} +\usage{ +drmLOFbinomial() +} +\description{ +Lack-of-fit test for binomial response +} +\keyword{internal} diff --git a/man/drmLOFeventtime.Rd b/man/drmLOFeventtime.Rd new file mode 100644 index 00000000..d8fad769 --- /dev/null +++ b/man/drmLOFeventtime.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/drmEMeventtime.R +\name{drmLOFeventtime} +\alias{drmLOFeventtime} +\title{EM algorithm for event time data} +\usage{ +drmLOFeventtime() +} +\description{ +EM algorithm for event time data +} +\keyword{internal} diff --git a/man/drmLOFls.Rd b/man/drmLOFls.Rd new file mode 100644 index 00000000..090ba24d --- /dev/null +++ b/man/drmLOFls.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/drmLOFls.R +\name{drmLOFls} +\alias{drmLOFls} +\title{Lack-of-fit test for least squares} +\usage{ +drmLOFls() +} +\description{ +Lack-of-fit test for least squares +} +\keyword{internal} diff --git a/man/drmLOFnegbin.Rd b/man/drmLOFnegbin.Rd new file mode 100644 index 00000000..e8d9a35b --- /dev/null +++ b/man/drmLOFnegbin.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/drmEMnegbin.R +\name{drmLOFnegbin} +\alias{drmLOFnegbin} +\title{EM algorithm for negative binomial} +\usage{ +drmLOFnegbin() +} +\description{ +EM algorithm for negative binomial +} +\keyword{internal} diff --git a/man/drmLOFssd.Rd b/man/drmLOFssd.Rd new file mode 100644 index 00000000..958d4ebd --- /dev/null +++ b/man/drmLOFssd.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/drmEMssd.R +\name{drmLOFssd} +\alias{drmLOFssd} +\title{EM algorithm for species sensitivity distribution} +\usage{ +drmLOFssd() +} +\description{ +EM algorithm for species sensitivity distribution +} +\keyword{internal} diff --git a/man/drmLOFstandard.Rd b/man/drmLOFstandard.Rd new file mode 100644 index 00000000..584b591b --- /dev/null +++ b/man/drmLOFstandard.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/drmEMstandard.R +\name{drmLOFstandard} +\alias{drmLOFstandard} +\title{Standard EM algorithm} +\usage{ +drmLOFstandard() +} +\description{ +Standard EM algorithm +} +\keyword{internal} diff --git a/man/drmOpt.Rd b/man/drmOpt.Rd new file mode 100644 index 00000000..da4f3194 --- /dev/null +++ b/man/drmOpt.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/drmOpt.R +\name{drmOpt} +\alias{drmOpt} +\title{Optimisation wrapper for drm} +\usage{ +drmOpt( + opfct, + opdfct1, + startVec, + optMethod, + constrained, + warnVal, + upperLimits, + lowerLimits, + errorMessage, + maxIt, + relTol, + opdfct2 = NULL, + parmVec, + traceVal, + silentVal = TRUE, + matchCall +) +} +\description{ +Optimisation wrapper for drm +} +\keyword{internal} diff --git a/man/drmPNsplit.Rd b/man/drmPNsplit.Rd new file mode 100644 index 00000000..d0f3f024 --- /dev/null +++ b/man/drmPNsplit.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/drmPNsplit.R +\name{drmPNsplit} +\alias{drmPNsplit} +\title{Split parameter names} +\usage{ +drmPNsplit(parmVec, sep) +} +\description{ +Split parameter names +} +\keyword{internal} diff --git a/man/drmParNames.Rd b/man/drmParNames.Rd new file mode 100644 index 00000000..b2d0f28d --- /dev/null +++ b/man/drmParNames.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/drmParNames.R +\name{drmParNames} +\alias{drmParNames} +\title{Generate parameter names for drm} +\usage{ +drmParNames( + numNames, + parNames, + collapseList2, + repStr1 = "factor(pmodels[, i])", + repStr2 = "factor(assayNo)" +) +} +\description{ +Generate parameter names for drm +} +\keyword{internal} diff --git a/man/drmRobust.Rd b/man/drmRobust.Rd new file mode 100644 index 00000000..9c6efaf7 --- /dev/null +++ b/man/drmRobust.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/drmRobust.R +\name{drmRobust} +\alias{drmRobust} +\title{Robust estimation functions for drm} +\usage{ +drmRobust(robust, fctCall, lenData, lenPar) +} +\description{ +Robust estimation functions for drm +} +\keyword{internal} diff --git a/man/drm_legacy.Rd b/man/drm_legacy.Rd new file mode 100644 index 00000000..040a7474 --- /dev/null +++ b/man/drm_legacy.Rd @@ -0,0 +1,111 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/drm_legacy.R +\name{drm_legacy} +\alias{drm_legacy} +\title{Legacy dose-response model fitting (internal)} +\usage{ +drm_legacy( + formula, + curveid, + pmodels, + weights, + data = NULL, + subset, + fct, + type = c("continuous", "binomial", "Poisson", "negbin1", "negbin2", "event", "ssd"), + bcVal = NULL, + bcAdd = 0, + start, + na.action = na.omit, + robust = "mean", + logDose = NULL, + control = drmc(), + lowerl = NULL, + upperl = NULL, + separate = FALSE, + pshifts = NULL, + varcov = NULL +) +} +\arguments{ +\item{formula}{a symbolic description of the model to be fit. Either of the form +\code{response ~ dose} or as a data frame with response values in first column and dose +values in second column.} + +\item{curveid}{a numeric vector or factor containing the grouping of the data.} + +\item{pmodels}{a data frame with as many columns as there are parameters in the non-linear +function. Or a list containing a formula for each parameter in the nonlinear function.} + +\item{weights}{a numeric vector containing weights. For continuous/quantitative responses, +inverse weights are multiplied inside the squared errors (weights should have the same unit +as the response). For binomial responses weights provide information about the total number +of binary observations used to obtain the response.} + +\item{data}{an optional data frame containing the variables in the model.} + +\item{subset}{an optional vector specifying a subset of observations to be used in the +fitting process.} + +\item{fct}{a list with three or more elements specifying the non-linear function, the +accompanying self starter function, the names of the parameters in the non-linear function +and, optionally, the first and second derivatives as well as information used for +calculation of ED values. Use \code{\link{getMeanFunctions}} for a full list.} + +\item{type}{a character string specifying the distribution of the data. The default is +\code{"continuous"}, corresponding to a normal distribution. Other choices include +\code{"binomial"}, \code{"Poisson"}, \code{"negbin1"}, \code{"negbin2"}, \code{"event"}, +and \code{"ssd"}.} + +\item{bcVal}{a numeric value specifying the lambda parameter to be used in the Box-Cox +transformation.} + +\item{bcAdd}{a numeric value specifying the constant to be added on both sides prior to +Box-Cox transformation. The default is 0.} + +\item{start}{an optional numeric vector containing starting values for all mean parameters +in the model. Overrules any self starter function.} + +\item{na.action}{a function for treating missing values (\code{NA}s). Default is +\code{\link{na.omit}}.} + +\item{robust}{a character string specifying the rho function for robust estimation. +Default is non-robust least squares estimation (\code{"mean"}). Available robust methods +are: \code{"median"}, \code{"lms"}, \code{"lts"}, \code{"trimmed"}, \code{"winsor"}, and +\code{"tukey"}.} + +\item{logDose}{a numeric value or \code{NULL}. If log dose values are provided the base of +the logarithm should be specified (e.g., \code{exp(1)} for natural logarithm, \code{10} +for base 10).} + +\item{control}{a list of arguments controlling constrained optimisation, maximum iterations, +relative tolerance, and warnings. See \code{\link{drmc}}.} + +\item{lowerl}{a numeric vector of lower limits for all parameters in the model (the default +corresponds to minus infinity for all parameters).} + +\item{upperl}{a numeric vector of upper limits for all parameters in the model (the default +corresponds to plus infinity for all parameters).} + +\item{separate}{logical value indicating whether curves should be fit separately +(independent of each other).} + +\item{pshifts}{a matrix of constants to be added to the matrix of parameters. Default is no +shift for all parameters.} + +\item{varcov}{an optional user-defined known variance-covariance matrix for the responses. +Default is the identity matrix (\code{NULL}), corresponding to independent response values +with a common standard deviation estimated from the data.} +} +\value{ +An object of (S3) class \code{"drc"}. +} +\description{ +This is the legacy implementation of the dose-response model fitting function. +It is kept only as an internal reference point in case questions or errors +might occur with the current \code{\link[=drm]{drm()}} implementation. +} +\seealso{ +\code{\link[=drm]{drm()}} for the current implementation. +} +\keyword{internal} diff --git a/man/drmc.Rd b/man/drmc.Rd index d15aabd0..c00237a5 100644 --- a/man/drmc.Rd +++ b/man/drmc.Rd @@ -1,64 +1,85 @@ -\name{drmc} - -\alias{drmc} - -\title{Sets control arguments} - -\description{ - Set control arguments in the control argument in the function 'drm'. -} - -\usage{ - drmc(constr = FALSE, errorm = TRUE, maxIt = 500, method="BFGS", - noMessage = FALSE, relTol = 1e-07, rmNA=FALSE, useD = FALSE, - trace = FALSE, otrace = FALSE, warnVal = -1, dscaleThres = 1e-15, rscaleThres = 1e-15, - conCheck = TRUE) -} - -\arguments{ - \item{constr}{logical. If TRUE optimisation is constrained, only yielding non-negative parameters.} - \item{errorm}{logical specifying whether failed convergence in \code{\link{drm}} should result - in an error or only a warning.} - \item{maxIt}{numeric. The maximum number of iterations in the optimisation procedure.} - \item{method}{character string. The method used in the optimisation procedure. - See \code{\link{optim}} for available methods.} - \item{noMessage}{logical, specifying whether or not messages should be displayed.} - \item{relTol}{numeric. The relative tolerance in the optimisation procedure.} - \item{rmNA}{logical. Should NAs be removed from sum of squares used for estimation? - Default is FALSE (not removed).} - \item{useD}{logical. If TRUE derivatives are used for estimation (if available).} - \item{trace}{logical. If TRUE the trace from \code{\link{optim}} is displayed.} - \item{otrace}{logical. If TRUE the output from \code{\link{optim}} is displayed.} - \item{warnVal}{numeric. If equal to 0 then the warnings are stored and displayed at the end. - See under 'warn' in \code{\link{options}}. The default results in suppression of warnings.} - \item{dscaleThres}{numeric value specifying the threshold for dose scaling.} - \item{rscaleThres}{numeric value specifying the threshold for response scaling.} - \item{conCheck}{logical, switching on/off handling of control measurements.} -} - -\value{ - A list with 8 components, one for each of the above arguments. -} - -\author{Christian Ritz} - -\note{ - The use of a non-zero constant \code{bcAdd} may in some cases - make it more difficult to obtain convergence of the estimation procedure.} - -%\seealso{} - -\examples{ - -### Displaying the default settings -drmc() - -### Using 'method' argument -model1 <- drm(ryegrass, fct = LL.4()) - -model2 <- drm(ryegrass, fct = LL.4(), -control = drmc(method = "Nelder-Mead")) - -} -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/drmc.R +\name{drmc} +\alias{drmc} +\title{Sets control arguments} +\usage{ +drmc( + constr = FALSE, + errorm = TRUE, + maxIt = 500, + method = "BFGS", + noMessage = FALSE, + relTol = 1e-10, + rmNA = FALSE, + useD = FALSE, + trace = FALSE, + otrace = FALSE, + warnVal = -1, + dscaleThres = 1e-15, + rscaleThres = 1e-15, + conCheck = TRUE +) +} +\arguments{ +\item{constr}{logical. If \code{TRUE} optimisation is constrained, only yielding non-negative +parameters.} + +\item{errorm}{logical specifying whether failed convergence in \code{\link{drm}} should +result in an error or only a warning.} + +\item{maxIt}{numeric. The maximum number of iterations in the optimisation procedure.} + +\item{method}{character string. The method used in the optimisation procedure. See +\code{\link{optim}} for available methods.} + +\item{noMessage}{logical, specifying whether or not messages should be displayed.} + +\item{relTol}{numeric. The relative tolerance in the optimisation procedure. A tighter +tolerance (smaller value) improves cross-platform reproducibility of results by ensuring +the optimiser converges closer to the true optimum regardless of platform-specific +floating-point behaviour. Default is \code{1e-10}.} + +\item{rmNA}{logical. Should \code{NA}s be removed from sum of squares used for estimation? +Default is \code{FALSE} (not removed).} + +\item{useD}{logical. If \code{TRUE} derivatives are used for estimation (if available).} + +\item{trace}{logical. If \code{TRUE} the trace from \code{\link{optim}} is displayed.} + +\item{otrace}{logical. If \code{TRUE} error messages from the optimisation are displayed.} + +\item{warnVal}{numeric. If equal to 0 then the warnings are stored and displayed at the end. +See under \sQuote{warn} in \code{\link{options}}. The default results in suppression of +warnings.} + +\item{dscaleThres}{numeric value specifying the threshold for dose scaling.} + +\item{rscaleThres}{numeric value specifying the threshold for response scaling.} + +\item{conCheck}{logical, switching on/off handling of control measurements.} +} +\value{ +A list with components corresponding to each of the above arguments. +} +\description{ +Set control arguments in the control argument in the function \code{\link{drm}}. +} +\examples{ +## Displaying the default settings +drmc() + +## Using the 'method' argument +model1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +model2 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4(), + control = drmc(method = "Nelder-Mead")) + +} +\seealso{ +\code{\link{drm}}, \code{\link{optim}} +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/earthworms.Rd b/man/earthworms.Rd new file mode 100644 index 00000000..35bdd262 --- /dev/null +++ b/man/earthworms.Rd @@ -0,0 +1,58 @@ +\name{earthworms} + +\alias{earthworms} + +\docType{data} + +\title{Earthworm toxicity test} + +\description{ + The dataset was obtained from a toxicity test using earthworms, and it contains the number of earthworms + remaining in a container that was contaminated with a toxic substance (not disclosed) at various doses; so the number of earthworms not migrating to the neighbouring uncontaminated container. +} + +\usage{data(earthworms)} + +\format{ + A data frame with 35 observations on the following 3 variables. + \describe{ + \item{\code{dose}}{a numeric vector of dose values} + \item{\code{number}}{a numeric vector containing counts of remaining earthworms in the container} + \item{\code{total}}{a numeric vector containing total number of earthworms put in the containers} + } +} + +\details{ + At dose 0 around half of the earthworms is expected be in each of the two containers. Thus it is not + appropriate to fit an ordinary logistic regression with log(dose) as explanatory variable to these data + as it implies an upper limit of 1 at dose 0 and in fact this model does not utilise the observations + at dose 0 (see the example section below). +} + +\source{ + The dataset is kindly provided by Nina Cedergreen, Faculty of Life Sciences, University of Copenhagen, + Denmark. +} + +%\references{} + +\examples{ +library(drc) + +## Fitting a logistic regression model +earthworms.m1 <- drm(number/total~dose, weights = total, data = earthworms, +fct = LL.2(), type = "binomial") +modelFit(earthworms.m1) # a crude goodness-of-fit test + +## Fitting an extended logistic regression model +## where the upper limit is estimated +earthworms.m2 <- drm(number/total~dose, weights = total, data = earthworms, +fct = LL.3(), type = "binomial") +modelFit(earthworms.m2) # goodness-of-fit test +# improvement not visible in test!!! + +## Comparing model1 and model2 +## (Can the first model be reduced to the second model?) +anova(earthworms.m1, earthworms.m2) +} +\keyword{datasets} diff --git a/man/echovirus.Rd b/man/echovirus.Rd new file mode 100644 index 00000000..7558f78d --- /dev/null +++ b/man/echovirus.Rd @@ -0,0 +1,48 @@ +\name{echovirus} + +\alias{echovirus} + +\docType{data} + +\title{Infections as response to exposure with \emph{Echovirus 12}} + +\description{ + For each of four doses of a pathogen, \emph{Echovirus 12}, the number of exposed and infected human volunteers are reported. +} + +\usage{data(echovirus)} + +\format{ + A data frame with 4 observations on the following 3 variables. + \describe{ + \item{\code{dose}}{a numeric vector reporting the dose in plague forming units (pfu)} + \item{\code{total}}{a numeric vector} + \item{\code{infected}}{a numeric vector} + } +} + +%\details{} + +\source{ + H. Moon, S. B. Kim, J. J. Chen, N. I. George, and R. L. Kodell (2013). Model uncertainty +and model averaging in the estimation of infectious doses for microbial pathogens. Risk +Analysis, \bold{33(2)}:220-231. +} + +%\references{} + +\examples{ +library(drc) + +## Displaying the data +head(echovirus) + +## Fitting a two-parameter log-logistic model for binomial response +echovirus.m1 <- drm(infected/total ~ dose, weights = total, +data = echovirus, fct = LL.2(), type = "binomial") +summary(echovirus.m1) + +## Plotting the fitted curve +plot(echovirus.m1, xlab = "Dose (pfu)", ylab = "Proportion infected") +} +\keyword{datasets} diff --git a/man/estfun.drc.Rd b/man/estfun.drc.Rd new file mode 100644 index 00000000..45c756a3 --- /dev/null +++ b/man/estfun.drc.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sandwich.R +\name{estfun.drc} +\alias{estfun.drc} +\title{Estimating function for the sandwich estimator} +\usage{ +\method{estfun}{drc}(x, ...) +} +\arguments{ +\item{x}{object of class \code{drc}.} + +\item{...}{additional arguments. At the moment none are supported.} +} +\value{ +The estimating function evaluated at the data and the parameter estimates. +By default no clustering is assumed, corresponding to robust standard errors +under independence. +} +\description{ +Evaluates the estimating function (the "meat") for the sandwich estimator of the +variance-covariance matrix for objects of class 'drc'. +} +\details{ +The details are provided by Zeileis (2006). +} +\examples{ +## The lines below requires that the packages +## 'lmtest' and 'sandwich' are installed +# library(lmtest) +# library(sandwich) + +# ryegrass.m1<-drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + +# Standard summary output +# coeftest(ryegrass.m1) + +# Output with robust standard errors +# coeftest(ryegrass.m1, vcov = sandwich) + +} +\references{ +Zeileis, A. (2006) Object-oriented Computation of Sandwich Estimators, +\emph{J. Statist. Software}, \bold{16}, Issue 9. +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/etmotc.Rd b/man/etmotc.Rd new file mode 100644 index 00000000..cd41bb42 --- /dev/null +++ b/man/etmotc.Rd @@ -0,0 +1,64 @@ +\name{etmotc} + +\alias{etmotc} + +\docType{data} + +\title{Effect of erythromycin on mixed sewage microorganisms} + +\description{ + Relative growth rate in biomass of mixed sewage microorganisms (per hour) as a function of + increasing concentrations of the antibiotic erythromycin (mg/l). +} + +\usage{data(etmotc)} + +\format{ + A data frame with 57 observations on the following 4 variables. + \describe{ + \item{\code{cell}}{a numeric vector} + \item{\code{dose1}}{a numeric vector} + \item{\code{pct1}}{a numeric vector} + \item{\code{rgr1}}{a numeric vector} + } +} + +\details{ + Data stem from an experiment investigating the effect of pharmaceuticals, + that are used in human and veterinary medicine and that are being released into the aquatic environment through + waste water or through manure used for fertilising agricultural land. The experiment constitutes a typical + dose-response situation. The dose is concentration of the antibiotic erythromycin (mg/l), which is an antibiotic + that can be used by persons or animals showing allergy to penicillin, and the measured response is the relative + growth rate in biomass of mixed sewage microorganisms (per hour), measured as turbidity two hours after exposure + by means of a spectrophotometer. The experiment was designed in such a way that eight replicates were assigned + to the control (dose 0), but no replicates were assigned to the 7 non-zero doses. Further details are found in + Christensen et al (2006). +} + +\source{ + Christensen, A. M. and Ingerslev, F. and Baun, A. 2006 + Ecotoxicity of mixtures of antibiotics used in aquacultures, + \emph{Environmental Toxicology and Chemistry}, \bold{25}, 2208--2215. +} + +%\references{} + +\examples{ +library(drc) + +etmotc.m1<-drm(rgr1~dose1, data=etmotc[1:15,], fct=LL.4()) +plot(etmotc.m1) +modelFit(etmotc.m1) +summary(etmotc.m1) + +etmotc.m2<-drm(rgr1~dose1, data=etmotc[1:15,], fct=W2.4()) +plot(etmotc.m2, add = TRUE) +modelFit(etmotc.m2) +summary(etmotc.m2) + +etmotc.m3<-drm(rgr1~dose1, data=etmotc[1:15,], fct=W2.3()) +plot(etmotc.m3, add = TRUE) +modelFit(etmotc.m3) +summary(etmotc.m3) +} +\keyword{datasets} diff --git a/man/fieller.Rd b/man/fieller.Rd new file mode 100644 index 00000000..ee7da5c4 --- /dev/null +++ b/man/fieller.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/EDcomp.R +\name{fieller} +\alias{fieller} +\title{Fieller's confidence interval} +\usage{ +fieller(mu, df, vcMat, level = 0.95, finney = FALSE, resVar) +} +\description{ +Fieller's confidence interval +} +\keyword{internal} diff --git a/man/figures/dose-response-curve.png b/man/figures/dose-response-curve.png new file mode 100644 index 00000000..c23abc42 Binary files /dev/null and b/man/figures/dose-response-curve.png differ diff --git a/man/figures/lifecycle-deprecated.svg b/man/figures/lifecycle-deprecated.svg new file mode 100644 index 00000000..b61c57c3 --- /dev/null +++ b/man/figures/lifecycle-deprecated.svg @@ -0,0 +1,21 @@ + + lifecycle: deprecated + + + + + + + + + + + + + + + lifecycle + + deprecated + + diff --git a/man/figures/lifecycle-experimental.svg b/man/figures/lifecycle-experimental.svg new file mode 100644 index 00000000..5d88fc2c --- /dev/null +++ b/man/figures/lifecycle-experimental.svg @@ -0,0 +1,21 @@ + + lifecycle: experimental + + + + + + + + + + + + + + + lifecycle + + experimental + + diff --git a/man/figures/lifecycle-stable.svg b/man/figures/lifecycle-stable.svg new file mode 100644 index 00000000..9bf21e76 --- /dev/null +++ b/man/figures/lifecycle-stable.svg @@ -0,0 +1,29 @@ + + lifecycle: stable + + + + + + + + + + + + + + + + lifecycle + + + + stable + + + diff --git a/man/figures/lifecycle-superseded.svg b/man/figures/lifecycle-superseded.svg new file mode 100644 index 00000000..db8d757f --- /dev/null +++ b/man/figures/lifecycle-superseded.svg @@ -0,0 +1,21 @@ + + lifecycle: superseded + + + + + + + + + + + + + + + lifecycle + + superseded + + diff --git a/man/figures/logo.png b/man/figures/logo.png new file mode 100644 index 00000000..ad475ae7 Binary files /dev/null and b/man/figures/logo.png differ diff --git a/man/findbe1.Rd b/man/findbe1.Rd new file mode 100644 index 00000000..59619c8b --- /dev/null +++ b/man/findbe1.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/findbe.R +\name{findbe1} +\alias{findbe1} +\title{Find initial parameter estimates} +\usage{ +findbe1(doseTr, respTr, sgnb = 1, back = exp) +} +\description{ +Find initial parameter estimates +} +\keyword{internal} diff --git a/man/findcd.Rd b/man/findcd.Rd new file mode 100644 index 00000000..3a25acee --- /dev/null +++ b/man/findcd.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/findcd.R +\name{findcd} +\alias{findcd} +\title{Find c and d parameters} +\usage{ +findcd(x, y, scaleInc = 0.001) +} +\description{ +Find c and d parameters +} +\keyword{internal} diff --git a/man/finney71.Rd b/man/finney71.Rd new file mode 100644 index 00000000..0b3f3fe0 --- /dev/null +++ b/man/finney71.Rd @@ -0,0 +1,64 @@ +\name{finney71} + +\alias{finney71} + +\docType{data} + +\title{Example from Finney (1971)} + +\description{ + For each of six concentrations of an insecticide the number of insects affected (out of the total number of insects) + was recorded. +} + +\usage{data(finney71)} + +\format{ + A data frame with 6 observations on the following 3 variables. + \describe{ + \item{\code{dose}}{a numeric vector} + \item{\code{total}}{a numeric vector} + \item{\code{affected}}{a numeric vector} + } +} + +%\details{} + +\source{ + Finney, D. J. (1971) \emph{Probit Analysis}, Cambridge: Cambridge University Press. +} + +%\references{} + +\examples{ +library(drc) + +## Model with ED50 as a parameter +finney71.m1 <- drm(affected/total ~ dose, weights = total, +data = finney71, fct = LL.2(), type = "binomial") + +summary(finney71.m1) +plot(finney71.m1, broken = TRUE, bp = 0.1, lwd = 2) + +ED(finney71.m1, c(10, 20, 50), interval = "delta", reference = "control") + +## Model fitted with 'glm' +#fitl.glm <- glm(cbind(affected, total-affected) ~ log(dose), +#family=binomial(link = logit), data=finney71[finney71$dose != 0, ]) +#summary(fitl.glm) # p-value almost agree for the b parameter +# +#xp <- dose.p(fitl.glm, p=c(0.50, 0.90, 0.95)) # from MASS +#xp.ci <- xp + attr(xp, "SE") \%*\% matrix(qnorm(1 - 0.05/2)*c(-1,1), nrow=1) +#zp.est <- exp(cbind(xp.ci[,1],xp,xp.ci[,2])) +#dimnames(zp.est)[[2]] <- c("zp.lcl","zp","zp.ucl") +#zp.est # not far from above results with 'ED' + +## Model with log(ED50) as a parameter +finney71.m2 <- drm(affected/total ~ dose, weights = total, +data = finney71, fct = LL2.2(), type = "binomial") + +## Confidence intervals based on back-transformation +## complete agreement with results based on 'glm' +ED(finney71.m2, c(10, 20, 50), interval = "fls", reference = "control") +} +\keyword{datasets} diff --git a/man/fitted.drc.Rd b/man/fitted.drc.Rd index 4478308e..d1c516d4 100644 --- a/man/fitted.drc.Rd +++ b/man/fitted.drc.Rd @@ -1,35 +1,29 @@ -\name{fitted.drc} - -\alias{fitted.drc} - -\title{Extract fitted values from model} - -\description{ - Extracts fitted values from an object of class 'drc'. -} - -\usage{ - - \method{fitted}{drc}(object, ...) - -} - -\arguments{ - \item{object}{an object of class 'drc'.} - \item{...}{additional arguments.} -} - -\value{ - Fitted values extracted from 'object'. -} - -\author{Christian Ritz} - -\examples{ - -ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) -plot(fitted(ryegrass.m1), residuals(ryegrass.m1)) # a residual plot - -} -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fitted.drc.R +\name{fitted.drc} +\alias{fitted.drc} +\title{Extract fitted values from model} +\usage{ +\method{fitted}{drc}(object, ...) +} +\arguments{ +\item{object}{an object of class 'drc'.} + +\item{...}{additional arguments.} +} +\value{ +Fitted values extracted from \code{object}. +} +\description{ +Extracts fitted values from an object of class 'drc'. +} +\examples{ +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +plot(fitted(ryegrass.m1), residuals(ryegrass.m1)) # a residual plot + +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/fluoranthene.Rd b/man/fluoranthene.Rd new file mode 100644 index 00000000..a6fbbcd9 --- /dev/null +++ b/man/fluoranthene.Rd @@ -0,0 +1,50 @@ +\name{fluoranthene} + +\alias{fluoranthene} + +\docType{data} + +\title{Death of fathead minnow larvae after exposure to fluoranthene} + +\description{Fathead minnow larvae were exposed to fluoranthene, a polycyclic aromatic hydrocarbon, under two different algal densities resulting in different levels of ambient ultraviolet radiation. Number of dead larvaes were reported. +} + +\usage{data(fluoranthene)} + +\format{ + A data frame with 24 observations on the following 4 variables. + \describe{ + \item{\code{algalconc}}{a numeric vector} + \item{\code{conc}}{a numeric vector} + \item{\code{totalnum}}{a numeric vector} + \item{\code{mortality}}{a numeric vector} + } +} + +%\details{} + +\source{ +M. W. Wheeler, R. M. Park, and A. J. Bailer (2006). Comparing median lethal concentration values using confidence interval overlap or ratio tests. Environmental Toxicology and Chemistry, \bold{25}:1441--1444. +} + +%\references{} + +\examples{ +library(drc) + +## Displaying the data +head(fluoranthene) + +## Fitting a two-parameter log-logistic model for binomial response +## with different curves per algal concentration +fluoranthene.m1 <- drm(mortality/totalnum ~ conc, algalconc, weights = totalnum, +data = fluoranthene, fct = LL.2(), type = "binomial") +summary(fluoranthene.m1) + +## Plotting the fitted curves +plot(fluoranthene.m1, xlab = "Fluoranthene concentration", +ylab = "Proportion dead") +} + + +\keyword{datasets} diff --git a/man/fplogistic.Rd b/man/fplogistic.Rd index 4f7d1c33..17b1b36a 100644 --- a/man/fplogistic.Rd +++ b/man/fplogistic.Rd @@ -1,64 +1,61 @@ -\name{fplogistic} - -\Rdversion{1.1} - -\alias{fplogistic} -\alias{FPL.4} - -\title{Fractional polynomial-logistic dose-response models} - -\description{ - Model function for specifying dose-response models that are a combination of a logistic model and an appropriate - class of fractional polynomials. -} - -\usage{ -fplogistic(p1, p2, fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), -method = c("1", "2", "3", "4"), ssfct = NULL, fctName, fctText) - -FPL.4(p1, p2, fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) -} - -\arguments{ - \item{p1}{numeric denoting the negative power of log(dose+1) in the fractional polynomial.} - \item{p2}{numeric denoting the positive power of log(dose+1) in the fractional polynomial.} - \item{fixed}{numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.} - \item{names}{a vector of character strings giving the names of the parameters (should not contain ":"). - The default is reasonable (see under 'Usage'). The order of the parameters is: b, c, d, e, f - (see under 'Details').} - \item{method}{character string indicating the self starter function to use.} - \item{ssfct}{a self starter function to be used.} - \item{fctName}{optional character string used internally by convenience functions.} - \item{fctText}{optional character string used internally by convenience functions.} - \item{...}{Additional arguments (see \code{\link{fplogistic}}).} -} - -\details{ - The fractional polynomial dose-response models introduced by Namata \emph{et al.} (2008) are implemented - using the logistic model as base. -} - -\value{ - The value returned is a list containing the nonlinear function, the self starter function - and the parameter names. -} - -\references{ - Namata, Harriet and Aerts, Marc and Faes, Christel and Teunis, Peter (2008) - Model Averaging in Microbial Risk Assessment Using Fractional Polynomials, - \emph{Risk Analysis} \bold{28}, 891--905. -} - -\author{Christian Ritz} - -%\note{} - -\seealso{ - Examples are found on the hep page of \code{\link{maED}}. -} - -%\examples{} - -\keyword{models} -\keyword{nonlinear} \ No newline at end of file +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fplogistic.R +\name{fplogistic} +\alias{fplogistic} +\title{Fractional polynomial-logistic dose-response model} +\usage{ +fplogistic( + p1, + p2, + fixed = c(NA, NA, NA, NA), + names = c("b", "c", "d", "e"), + method = c("1", "2", "3", "4"), + ssfct = NULL, + fctName, + fctText +) +} +\arguments{ +\item{p1}{numeric denoting the negative power of log(dose+1) in the fractional polynomial.} + +\item{p2}{numeric denoting the positive power of log(dose+1) in the fractional polynomial.} + +\item{fixed}{numeric vector. Specifies which parameters are fixed and at what value they are fixed. +NAs for parameters that are not fixed.} + +\item{names}{a vector of character strings giving the names of the parameters (should not contain ":"). +The order of the parameters is: b, c, d, e.} + +\item{method}{character string indicating the self starter function to use.} + +\item{ssfct}{a self starter function to be used.} + +\item{fctName}{optional character string used internally by convenience functions.} + +\item{fctText}{optional character string used internally by convenience functions.} +} +\value{ +A list containing the nonlinear function, the self starter function +and the parameter names. +} +\description{ +Model function for specifying dose-response models that are a combination of a logistic model +and an appropriate class of fractional polynomials. +} +\details{ +The fractional polynomial dose-response models introduced by Namata et al. (2008) are implemented +using the logistic model as base. +} +\references{ +Namata, Harriet and Aerts, Marc and Faes, Christel and Teunis, Peter (2008) +Model Averaging in Microbial Risk Assessment Using Fractional Polynomials, +\emph{Risk Analysis} \bold{28}, 891--905. +} +\seealso{ +\code{\link{FPL.4}}, \code{\link{maED}}, \code{\link{drm}} +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/gammadr.Rd b/man/gammadr.Rd index 53897997..4099ae90 100644 --- a/man/gammadr.Rd +++ b/man/gammadr.Rd @@ -1,63 +1,47 @@ -\name{gammadr} - -\Rdversion{1.1} - -\alias{gammadr} - -\title{ - Gamma dose-response model -} - -\description{ - The gamma dose-response model is a four-parameter model derived from the cumulative distribution function of the gamma distribution. -} - -\usage{ - gammadr(fixed = c(NA, NA, NA, NA), - names = c("b", "c", "d", "e"), fctName, fctText) -} - -\arguments{ - \item{fixed}{numeric vector specifying which parameters are fixed and at what value they are fixed. - NAs are used for parameters that are not fixed.} - \item{names}{a vector of character strings giving the names of the parameters (should not contain ":"). - The default is reasonable (see under 'Usage').} - \item{fctName}{optional character string used internally by convenience functions.} - \item{fctText}{optional character string used internally by convenience functions.} -} - -\details{ - Following Wheeler and Bailer (2009) the model function is defined as follows: - - \deqn{f(x) = c + (d-c) * pgamma(b*x, e, 1)} - - - This model is only suitable for increasing dose-response data. -} - -\value{ - The value returned is a list containing the nonlinear function, the self starter function - and the parameter names. -} - -\references{ - Wheeler, M. W., Bailer, A. J. (2009) - Comparing model averaging with other model selection strategies for benchmark dose estimation, - \emph{Environmental and Ecological Statistics}, \bold{16}, 37--51. -} - -\author{ - Christian Ritz -} - -%\note{} - -%\seealso{ -% The basic component in the two-phase model is the log-logistic model -% \code{\link{llogistic}}. -%} - -%\examples{} - -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gammadr.R +\name{gammadr} +\alias{gammadr} +\title{Gamma Dose-Response Model} +\usage{ +gammadr( + fixed = c(NA, NA, NA, NA), + names = c("b", "c", "d", "e"), + fctName, + fctText +) +} +\arguments{ +\item{fixed}{numeric vector specifying which parameters are fixed and at what value +they are fixed. NAs are used for parameters that are not fixed.} + +\item{names}{a vector of character strings giving the names of the parameters +(should not contain ":"). The default is reasonable.} + +\item{fctName}{optional character string used internally by convenience functions.} + +\item{fctText}{optional character string used internally by convenience functions.} +} +\value{ +A list containing the nonlinear function, the self starter function, +and the parameter names. +} +\description{ +A four-parameter dose-response model derived from the cumulative distribution +function of the gamma distribution. Only suitable for increasing dose-response data. +} +\details{ +Following Wheeler and Bailer (2009) the model function is: + +\deqn{f(x) = c + (d-c) \cdot \mathrm{pgamma}(b \cdot x, e, 1)} +} +\references{ +Wheeler, M. W., Bailer, A. J. (2009) +Comparing model averaging with other model selection strategies for benchmark +dose estimation, \emph{Environmental and Ecological Statistics}, \bold{16}, 37--51. +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/gaussian.Rd b/man/gaussian.Rd index 9fbfc498..e667009b 100644 --- a/man/gaussian.Rd +++ b/man/gaussian.Rd @@ -1,60 +1,50 @@ -\name{gaussian} - -\alias{gaussian} -\alias{lgaussian} - - -\title{ - Normal and log-normal biphasic dose-response models -} - -\description{ - Model functions for fitting symmetric or skewed bell-shaped/biphasic dose-response patterns. -} - -\usage{ - gaussian(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), - method = c("1", "2", "3", "4"), ssfct = NULL, fctName, fctText, loge = FALSE) - - lgaussian(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", - "d", "e", "f"), method = c("1", "2", "3", "4"), ssfct = NULL, - fctName, fctText, loge = FALSE) -} -%- maybe also 'usage' for other objects documented here. -\arguments{ - \item{fixed}{numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.} - - \item{names}{a vector of character strings giving the names of the parameters (should not contain ":"). - The default is reasonable (see under 'Usage'). The order of the parameters is: b, c, d, e, f - (see under 'Details').} - - \item{method}{character string indicating the self starter function to use.} - - \item{ssfct}{a self starter function to be used.} - - \item{fctName}{optional character string used internally by convenience functions.} - - \item{fctText}{optional character string used internally by convenience functions.} - - \item{loge}{logical indicating whether or not e or log(e) should be a parameter in the model. By default e is a model parameter.} - -} - -\details{ - Details yet to be provided. -} - -\value{ - The value returned is a list containing the nonlinear function, the self starter function - and the parameter names. -} - -\author{Christian Ritz} - -\note{ - The functions are for use with the function \code{\link{drm}}. -} - -\keyword{models} -\keyword{nonlinear} \ No newline at end of file +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gaussian.R +\name{gaussian} +\alias{gaussian} +\title{Normal (Gaussian) biphasic dose-response model} +\usage{ +gaussian( + fixed = c(NA, NA, NA, NA, NA), + names = c("b", "c", "d", "e", "f"), + method = c("1", "2", "3", "4"), + ssfct = NULL, + fctName, + fctText, + loge = FALSE +) +} +\arguments{ +\item{fixed}{numeric vector. Specifies which parameters are fixed and at what value they are fixed. +NAs for parameters that are not fixed.} + +\item{names}{a vector of character strings giving the names of the parameters (should not contain ":"). +The order of the parameters is: b, c, d, e, f.} + +\item{method}{character string indicating the self starter function to use.} + +\item{ssfct}{a self starter function to be used.} + +\item{fctName}{optional character string used internally by convenience functions.} + +\item{fctText}{optional character string used internally by convenience functions.} + +\item{loge}{logical indicating whether or not e or log(e) should be a parameter in the model. +By default e is a model parameter.} +} +\value{ +The value returned is a list containing the nonlinear function, the self starter function +and the parameter names. +} +\description{ +Model function for fitting symmetric or skewed bell-shaped/biphasic dose-response patterns +using the Gaussian (normal distribution) model. +} +\seealso{ +\code{\link{lgaussian}}, \code{\link{drm}} +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/gaussian.ssf.Rd b/man/gaussian.ssf.Rd new file mode 100644 index 00000000..2bb69951 --- /dev/null +++ b/man/gaussian.ssf.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gaussian.ssf.R +\name{gaussian.ssf} +\alias{gaussian.ssf} +\title{Self-starter for Gaussian model} +\usage{ +gaussian.ssf( + method = c("1", "2", "3", "4"), + fixed, + logg = FALSE, + useFixed = FALSE +) +} +\description{ +Self-starter for Gaussian model +} +\keyword{internal} diff --git a/man/germination.Rd b/man/germination.Rd new file mode 100644 index 00000000..72034a06 --- /dev/null +++ b/man/germination.Rd @@ -0,0 +1,125 @@ +\name{germination} + +\alias{germination} + +\docType{data} + +\title{ + Germination of three crops +} + +\description{ + Germination data were obtained from experiments involving the three species mungbean, rice, and wheat, which were opposed + to different temperatures between 10 and 40 degrees Celsius. Experiments lasted at most 18 days. +} +\usage{data(germination)} + +\format{ + A data frame with 192 observations on the following 5 variables. + \describe{ + \item{\code{temp}}{a numeric vector of temperatures that seeds were exposed to} + \item{\code{species}}{a factor with levels \code{mungbean} \code{rice} \code{wheat}} + \item{\code{start}}{a numeric vector of left endpoints of the monitoring intervals} + \item{\code{end}}{a numeric vector of right endpoints of the monitoring intervals} + \item{\code{germinated}}{a numeric vector giving the numbers of seeds germinated} + } +} + +\details{ + For each of the three species mungbean, rice, and wheat, a total of 20 seeds were uniformly distributed on filter paper in a petri dish (diameter: 9.0cm) + and then placed in dark climate cabinets with different temperatures (10, 16, 22, 28, 34, 40 degrees Celsius). Not all of the temperatures were applied to all species. + The germinated seeds were counted and removed from the petri dish on a daily basis up to 18 days (or until all seeds had germinated). I + + n this experiment we also assume that the upper limit of the proportion germinated is a parameter that has to be estimated from the data. Moreover, we assume + that different combinations of species and temperature may lead to different germination curves with respect to slope, time required for 50\% germination, and upper limit. +} + +%\source{ +% +%} + +\references{ + Ritz, C., Pipper, C. B. and Streibig, J. C. (2013) Analysis of germination data from agricultural experiments, \emph{Europ. J. Agronomy}, \bold{45}, 1--6. +} + +\seealso{Analysis of a single germination curve is shown for \code{\link{chickweed}}.} + +\examples{ +library(drc) + +## Fitting two-parameter log-logistic curves to each combination of species and temperature +## (upper limit fixed at 1) +## Note: Rows 24 and 62 are omitted from the dataset (all mungbean seeds germinated +## and thus no right-censoring in this case) + +## germLL.2 <- drm(germinated ~ start + end, species:factor(temp), +## data = germination[c(1:23, 25:61, 63:192), ], fct = LL.2(), type = "event") +## plot(germLL.2, ylim=c(0, 1.5), legendPos=c(2.5,1.5)) # plotting the fitted curves and the data +## summary(germLL.2) # showing the parameter estimates + +## Fitting two-parameter log-logistic curves to each combination of species and temperature +## Note: the argument "start" may be used for providing sensible initial +## parameter values for estimation procedure (is needed occasionally) +## (initial values were obtained from the model fit germLL.2) +## Note also: the argument "upper" ensures that the upper limit cannot exceed 1 +## (however, no restrictions are imposed on the two remaining parameters +## (as indicated by an infinite value) + +## germLL.3 <- drm(germinated~start+end, species:factor(temp), +## data = germination[c(1:23, 25:61, 63:192), ], fct = LL.3(), type = "event", +## start = c(coef(germLL.2)[1:13], rep(0.7,13), coef(germLL.2)[14:26]), +## upper = c(rep(Inf, 13), rep(1, 13), rep(Inf, 13))) + +## Plotting the fitted curves and the data +## plot(germLL.3, ylim = c(0, 1.5), legendPos = c(2.5,1.5)) + +## Showing the parameter estimates +## summary(germLL.3) + +## Showing the parameter estimates with robust standard errors +## library(lmtest) +## coeftest(germLL.3, vcov = sandwich) + +## Calculating t50 with associated standard errors +## ED(germLL.3, 50) + +## Calculating t10, t20, t50 with 95% confidence intervals +## ED(germLL.3, c(10, 20, 50), interval = "delta") + +## Comparing t50 between combinations by means of approximate t-tests +## compParm(germLL.3, "e", "-") + +## Making plots of fitted regression curves for each species + +## Plot for mungbean +#plot(germLL.3, log="", ylim=c(0, 1), xlim=c(0, 20), +#level=c("mungbean:10", "mungbean:16"), +#lty=2:3, lwd = 1.5, +#xlab="Time (days)", +#ylab="Proportion germinated", +#main="Mungbean", +#legendPos=c(3, 1.05), legendText=c(expression(10*degree), expression(16*degree))) + +## Plot for rice +#plot(germLL.3, log="", ylim=c(0, 1), xlim=c(0, 20), +#level=c("rice:16", "rice:22", "rice:28", "rice:34", "rice:40"), +#lty=2:6, lwd = 1.5, +#xlab="Time (days)", +#ylab="Proportion germinated", +#main="Rice", +#pch=2:6, +#legendPos=c(3, 1.05), legendText=c(expression(16*degree), expression(22*degree), +#expression(28*degree), expression(34*degree), expression(40*degree))) + +## Plot for wheat +#plot(germLL.3, log="", ylim=c(0, 1), xlim=c(0, 20), +#level=c("wheat:10", "wheat:16", "wheat:22", "wheat:28", "wheat:34", "wheat:40"), +#lty=c("dashed","dotted","dotdash","longdash","twodash","232A"), lwd = 1.5, +#xlab="Time (days)", +#ylab="Proportion germinated", +#main="Wheat", +#legendPos=c(3, 1.05), +#legendText=c(expression(10*degree), expression(16*degree), expression(22*degree), +#expression(28*degree), expression(34*degree), expression(40*degree))) +} +\keyword{datasets} diff --git a/man/getInitial.Rd b/man/getInitial.Rd index 6974bb54..ce316be8 100644 --- a/man/getInitial.Rd +++ b/man/getInitial.Rd @@ -1,40 +1,26 @@ -\name{getInitial} - -\Rdversion{1.1} - -\alias{getInitial} - -\title{ - Showing starting values used -} - -\description{ - Function for showing the starting values of the model parameters used when fitting a dose-response model -} - -\usage{ - getInitial(object) -} - -\arguments{ - \item{object}{object of class 'drc'} -} - -%\details{} - -\value{ - A vector of starting values for the model parameters used to initialize the estimation procedure. -} - -%\references{} - -\author{Christian Ritz} - -\note{This function is masking the standard function in the stats package.} - -%\seealso{} - -%\examples{} - -\keyword{models} -\keyword{nonlinear} \ No newline at end of file +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/getInitial.R +\name{getInitial} +\alias{getInitial} +\title{Showing starting values used} +\usage{ +getInitial(object) +} +\arguments{ +\item{object}{object of class 'drc'.} +} +\value{ +A vector of starting values for the model parameters used to initialize the +estimation procedure. +} +\description{ +Returns the starting values of the model parameters used when fitting a dose-response model. +} +\note{ +This function is masking the standard function in the stats package. +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/getMeanFunctions.Rd b/man/getMeanFunctions.Rd index 7db96224..0ae0a30a 100644 --- a/man/getMeanFunctions.Rd +++ b/man/getMeanFunctions.Rd @@ -1,59 +1,46 @@ -\name{getMeanFunctions} - -\alias{getMeanFunctions} - -\title{Display available dose-response models} - -\description{ - Display information about available, built-in dose-response models. -} - -\usage{ - getMeanFunctions(noParm = NA, fname = NULL, flist = NULL, display =TRUE) -} - -\arguments{ - \item{noParm}{numeric specifying the number of parameters of the models to be displayed. - The default (NA) results in display of all models, regardless of number of parameters.} - \item{fname}{character string or vector of character strings specifying the short name(s) - of the models to be displayed (need to match exactly).} - \item{flist}{list of built-in functions to be displayed.} - \item{display}{logical indicating whether or not the requested models should be displayed on the R console.} -} - -\details{ - The arguments \code{noParm} and \code{fname} can be combined. -} - -\value{ - An invisible list of functions or a list of strings with brief function descriptions is returned. -} - -%\references{} - -\author{Christian Ritz} - -%\note{} - -%\seealso{} - -\examples{ - -## Listing all functions -getMeanFunctions() - -## Listing all functions with 4 parameters -getMeanFunctions(4) - -## Listing all (log-)logistic functions -getMeanFunctions(fname = "L") - -## Listing all three-parameter (log-)logistic or Weibull functions -getMeanFunctions(3, fname = c("LL", "W")) - -## Listing all four-parameter (log-)logistic or Weibull functions -getMeanFunctions(4, fname = c("LL", "W")) - -} -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/getMeanFunctions.R +\name{getMeanFunctions} +\alias{getMeanFunctions} +\title{Display available dose-response models} +\usage{ +getMeanFunctions(noParm = NA, fname = NULL, flist = NULL, display = TRUE) +} +\arguments{ +\item{noParm}{numeric specifying the number of parameters of the models to be displayed. +The default (NA) results in display of all models, regardless of number of parameters.} + +\item{fname}{character string or vector of character strings specifying the short name(s) +of the models to be displayed (need to match exactly).} + +\item{flist}{list of built-in functions to be displayed.} + +\item{display}{logical indicating whether or not the requested models should be displayed +on the R console.} +} +\value{ +An invisible list of functions or a list of strings with brief function descriptions. +} +\description{ +Display information about available, built-in dose-response models. +The arguments \code{noParm} and \code{fname} can be combined. +} +\examples{ +## Listing all functions +getMeanFunctions() + +## Listing all functions with 4 parameters +getMeanFunctions(4) + +## Listing all (log-)logistic functions +getMeanFunctions(fname = "L") + +## Listing all three-parameter (log-)logistic or Weibull functions +getMeanFunctions(3, fname = c("LL", "W")) + +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/get_ed_interval.Rd b/man/get_ed_interval.Rd new file mode 100644 index 00000000..2b69afc4 --- /dev/null +++ b/man/get_ed_interval.Rd @@ -0,0 +1,47 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ED_robust.R +\name{get_ed_interval} +\alias{get_ed_interval} +\title{Select Appropriate Confidence Interval Method for a drc Model} +\usage{ +get_ed_interval( + model, + small_n = TRUE, + fls_pattern = "^LL|^LN|^BC|^CRS", + verbose = FALSE +) +} +\arguments{ +\item{model}{A drc model object or a character string specifying the model name (e.g., "LL.4").} + +\item{small_n}{A logical value. If TRUE, the t-distribution-based Fieller's method ("tfls") +is used for small samples for applicable models. If FALSE, the normal-distribution-based +method ("fls") is used. Defaults to TRUE.} + +\item{fls_pattern}{A regular expression character string. This pattern is used to identify +model families for which the "fls" or "tfls" method is appropriate. The default +covers standard log-logistic, log-normal, Brain-Cousens, and Cedergreen-Ritz-Streibig models.} + +\item{verbose}{A logical value. If TRUE, a message is printed when the function +resorts to its default choice because the model type was not explicitly matched. +Defaults to TRUE.} +} +\value{ +A character string: "tfls", "fls", or "delta", representing the +recommended interval type for use in \code{drc::ED()}. +} +\description{ +This function determines the recommended confidence interval calculation method +('type' argument in drc::ED) based on the model family of a 'drc' object. +} +\examples{ +ryegrass_model <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +drc:::get_ed_interval(ryegrass_model) +drc:::get_ed_interval("LL.4") +drc:::get_ed_interval("W1.4") + +} +\author{ +Hannes Reinwald +} +\keyword{internal} diff --git a/man/glymet.Rd b/man/glymet.Rd new file mode 100644 index 00000000..58fe0633 --- /dev/null +++ b/man/glymet.Rd @@ -0,0 +1,77 @@ +\name{glymet} + +\alias{glymet} + +\docType{data} + +\title{Glyphosate and metsulfuron-methyl tested on algae.} + +\description{ + The dataset has 7 mixtures, 8 dilutions, two replicates and 5 common control controls. + Four observations are missing, giving a total of 113 observations. +} + +\usage{data(glymet)} + +\format{ + A data frame with 113 observations on the following 3 variables. + \describe{ + \item{\code{dose}}{a numeric vector of dose values} + \item{\code{pct}}{a numeric vector denoting the grouping according to the mixtures percentages} + \item{\code{rgr}}{a numeric vector of response values (relative growth rates)} + } +} + +\details{ + The dataset is analysed in Soerensen et al (2007). + The concentration addition model can be entertained for this dataset. +} + +\source{ + The dataset is kindly provided by Nina Cedergreen, Department of Agricultural Sciences, + Royal Veterinary and Agricultural University, Denmark. +} + +\references{ + Soerensen, H. and Cedergreen, N. and Skovgaard, I. M. and Streibig, J. C. (2007) + An isobole-based statistical model and test for synergism/antagonism in binary mixture toxicity experiments, + \emph{Environmental and Ecological Statistics}, \bold{14}, 383--397. +} + +\examples{ +library(drc) + +## Fitting the model with freely varying ED50 values +glymet.free <- drm(rgr~dose, pct, data = glymet, +fct = LL.3(), pmodels = list(~factor(pct) , ~1, ~factor(pct))) + +## Lack-of-fit test +modelFit(glymet.free) # acceptable +summary(glymet.free) + +## Plotting isobole structure +isobole(glymet.free, exchange=0.01) + +## Fitting the concentration addition model +glymet.ca <- mixture(glymet.free, model = "CA") + +## Comparing to model with freely varying e parameter +anova(glymet.ca, glymet.free) # borderline accepted + +## Plotting isobole based on concentration addition +isobole(glymet.free, glymet.ca, exchange = 0.01) # acceptable fit + +## Fitting the Hewlett model +glymet.hew <- mixture(glymet.free, model = "Hewlett") + +### Comparing to model with freely varying e parameter +anova(glymet.ca, glymet.hew) +# borderline accepted +# the Hewlett model offers no improvement over concentration addition + +## Plotting isobole based on the Hewlett model +isobole(glymet.free, glymet.hew, exchange = 0.01) +# no improvement over concentration addition +} + +\keyword{datasets} diff --git a/man/gompertz.Rd b/man/gompertz.Rd index 91110e7c..e3b4807a 100644 --- a/man/gompertz.Rd +++ b/man/gompertz.Rd @@ -1,72 +1,55 @@ -\name{gompertz} - -\alias{gompertz} -\alias{G.2} -\alias{G.3} -\alias{G.3u} -\alias{G.4} - -\title{Mean function for the Gompertz dose-response or growth curve} - -\description{ - This function provides a very general way of specifying the mean function of the decreasing or incresing - Gompertz dose-response or growth curve models. -} - -\usage{ - gompertz(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), - method = c("1", "2", "3", "4"), ssfct = NULL, - fctName, fctText) -} - -\arguments{ - \item{fixed}{numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.} - \item{names}{vector of character strings giving the names of the parameters (should not contain ":"). - The order of the parameters is: b, c, d, e (see under 'Details' for the precise meaning of each parameter).} - \item{method}{character string indicating the self starter function to use.} - \item{ssfct}{a self starter function to be used.} - \item{fctName}{character string used internally by convenience functions (optional).} - \item{fctText}{character string used internally by convenience functions (optional).} -} - -\details{ - The Gompertz model is given by the mean function - - \deqn{ f(x) = c + (d-c)(\exp(-\exp(b(x-e)))) } - - and it is a dose-response/growth curve on the entire real axis, that is it is not limited to - non-negative values even though this is the range for most dose-response and growth data. One consequence is - that the curve needs not reach the lower asymptote at dose 0. - - If \deqn{b<0} the mean function is increasing and it is decreasing for \deqn{b>0}. The decreasing Gompertz model is - not a well-defined dose-response model and other dose-response models such as the Weibull models - should be used instead. - - Various re-parameterisations of the model are used in practice. -} - -\value{ - The value returned is a list containing the non-linear function, the self starter function - and the parameter names. -} - -\references{ - Seber, G. A. F. and Wild, C. J. (1989) \emph{Nonlinear Regression}, New York: Wiley \& Sons (p. 331). -} - -\author{Christian Ritz} - -\note{ - The function is for use with the function \code{\link{drm}}, but typically the convenience functions - \code{\link{G.2}}, \code{\link{G.3}}, \code{\link{G.3u}}, and \code{\link{G.4}} should be used. -} - -\seealso{The Weibull model \code{\link{weibull2}} is closely related to the Gompertz model.} - -%\examples{} - -\keyword{models} -\keyword{nonlinear} - -\concept{Gompertz} \ No newline at end of file +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gompertz.R +\name{gompertz} +\alias{gompertz} +\title{Gompertz dose-response or growth curve model} +\usage{ +gompertz( + fixed = c(NA, NA, NA, NA), + names = c("b", "c", "d", "e"), + method = c("1", "2", "3", "4"), + ssfct = NULL, + fctName, + fctText +) +} +\arguments{ +\item{fixed}{numeric vector. Specifies which parameters are fixed and at what value they are fixed. +NAs for parameters that are not fixed.} + +\item{names}{vector of character strings giving the names of the parameters (should not contain ":"). +The order of the parameters is: b, c, d, e.} + +\item{method}{character string indicating the self starter function to use.} + +\item{ssfct}{a self starter function to be used.} + +\item{fctName}{optional character string used internally by convenience functions.} + +\item{fctText}{optional character string used internally by convenience functions.} +} +\value{ +A list containing the non-linear function, the self starter function +and the parameter names. +} +\description{ +Provides a very general way of specifying the mean function of the decreasing or increasing +Gompertz dose-response or growth curve models. +} +\details{ +The Gompertz model is given by the mean function +\deqn{f(x) = c + (d-c)(\exp(-\exp(b(x-e))))} + +If \eqn{b<0} the mean function is increasing; it is decreasing for \eqn{b>0}. +} +\references{ +Seber, G. A. F. and Wild, C. J. (1989) \emph{Nonlinear Regression}, New York: Wiley & Sons (p. 331). +} +\seealso{ +The Weibull model \code{\link{weibull2}} is closely related to the Gompertz model. +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/gompertz.ssf.Rd b/man/gompertz.ssf.Rd new file mode 100644 index 00000000..0c84a116 --- /dev/null +++ b/man/gompertz.ssf.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gompertz.ssf.R +\name{gompertz.ssf} +\alias{gompertz.ssf} +\title{Self-starter for Gompertz model} +\usage{ +gompertz.ssf(method = c("1", "2", "3", "4"), fixed, useFixed = FALSE) +} +\description{ +Self-starter for Gompertz model +} +\keyword{internal} diff --git a/man/gompertzd.Rd b/man/gompertzd.Rd index 755a022c..a437b240 100644 --- a/man/gompertzd.Rd +++ b/man/gompertzd.Rd @@ -1,50 +1,37 @@ -\name{gompertzd} - -\alias{gompertzd} - -\title{The derivative of the Gompertz function} - -\description{ - 'gompertzd' provides a way of specifying the derivative of the Gompertz function - as a dose-response model. -} - -\usage{ - gompertzd(fixed = c(NA, NA), names = c("a", "b")) -} - -\arguments{ - \item{fixed}{numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.} - \item{names}{a vector of character strings giving the names of the parameters (should not contain ":"). - The default is (notice the order): a, b.} -} - -\details{ - The derivative of the Gompertz function is defined as - - \deqn{ f(x) = a \exp(bx-a/b(exp(bx)-1))} - - For \eqn{a>0} and \eqn{b} not 0, the function is decreasing, equaling \eqn{a} at \eqn{x=0} - and approaching 0 at plus infinity. -} - -\value{ - The value returned is a list containing the model function, the self starter function - and the parameter names. -} - -%\references{} - -\author{Christian Ritz} - -\note{ - This function is for use with the function \code{\link{drm}}. -} - -%\seealso{} - -%\examples{} - -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gompertzd.R +\name{gompertzd} +\alias{gompertzd} +\title{Derivative of the Gompertz function} +\usage{ +gompertzd(fixed = c(NA, NA), names = c("a", "b")) +} +\arguments{ +\item{fixed}{numeric vector. Specifies which parameters are fixed and at what value they are fixed. +NAs for parameters that are not fixed.} + +\item{names}{a vector of character strings giving the names of the parameters (should not contain ":"). +The default is (notice the order): a, b.} +} +\value{ +A list containing the model function, the self starter function +and the parameter names. +} +\description{ +\code{gompertzd} provides a way of specifying the derivative of the Gompertz function +as a dose-response model. +} +\details{ +The derivative of the Gompertz function is defined as +\deqn{f(x) = a \exp(bx-a/b(\exp(bx)-1))} +For \eqn{a>0} and \eqn{b} not 0, the function is decreasing, equaling \eqn{a} at \eqn{x=0} +and approaching 0 at plus infinity. +} +\seealso{ +\code{\link{gompertz}}, \code{\link{drm}} +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/guthion.Rd b/man/guthion.Rd new file mode 100644 index 00000000..b2d4136c --- /dev/null +++ b/man/guthion.Rd @@ -0,0 +1,39 @@ +\name{guthion} + +\alias{guthion} + +\docType{data} + +\title{guthion} + +\description{Data from an acute toxicity test with the insecticide guthion (azinphos-methyl). For each dose level in two treatment groups, the numbers of alive, moribund, and dead subjects were recorded.} + +\usage{data(guthion)} + +\format{ + A data frame with 6 observations on the following 6 variables. + \describe{ + \item{\code{trt}}{a categorial vector} + \item{\code{dose}}{a numeric vector} + \item{\code{alive}}{a numeric vector} + \item{\code{moribund}}{a numeric vector} + \item{\code{dead}}{a numeric vector} + \item{\code{total}}{a numeric vector} + } +} + +\examples{ +library(drc) + +## Displaying the data +head(guthion) + +## Fitting a two-parameter log-logistic model for binomial response +guthion.m1 <- drm(dead/total ~ dose, trt, weights = total, +data = guthion, fct = LL.2(), type = "binomial") +summary(guthion.m1) + +## Plotting the fitted curves +plot(guthion.m1, xlab = "Dose", ylab = "Proportion dead", ylim = c(0, 1)) +} +\keyword{datasets} diff --git a/man/hatvalues.drc.Rd b/man/hatvalues.drc.Rd index a782397b..d64111aa 100644 --- a/man/hatvalues.drc.Rd +++ b/man/hatvalues.drc.Rd @@ -1,64 +1,46 @@ -\name{hatvalues.drc} - -\alias{hatvalues.drc} -\alias{cooks.distance.drc} - -\title{ - Model diagnostics for nonlinear dose-response models -} - -\description{ - Hat values (leverage values) and Cook's distance are provided for nonlinear dose-response model fits using the same formulas - as in linear regression but based on the corresponding but approximate quantities available for nonlinear models. -} - -\usage{ - \method{cooks.distance}{drc}(model, ...) - - \method{hatvalues}{drc}(model, ...) -} - -\arguments{ - \item{model}{an object of class 'drc'.} - \item{\dots}{additional arguments (not used).} -} - -\details{ - Hat values and Cook's distance are calculated using the formula given by Cook et al. (1986) and McCullagh and Nelder (1989). - - The output values can be assessed in the same way as in linear regression. -} - -\value{ - A vector of leverage values (hat values) or values of Cook's distance (one value per observation). -} -\references{ - - Cook, R. D. and Tsai, C.-L. and Wei, B. C. (1986) - Bias in Nonlinear Regression, - \emph{Biometrika} - \bold{73}, 615--623. - - McCullagh, P. and Nelder, J. A. (1989) - emph{Generalized Linear Models}, - Second edition, Chapman \& Hall/CRC. -} - -\author{ - Christian Ritz -} - -%\note{ -%} - -\examples{ - -ryegrass.LL.4 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) - -hatvalues(ryegrass.LL.4) - -cooks.distance(ryegrass.LL.4) - -} -\keyword{models} -\keyword{nonlinear} \ No newline at end of file +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/hatvalues.drc.R +\name{hatvalues.drc} +\alias{hatvalues.drc} +\title{Model diagnostics for nonlinear dose-response models} +\usage{ +\method{hatvalues}{drc}(model, ...) +} +\arguments{ +\item{model}{an object of class 'drc'.} + +\item{...}{additional arguments (not used).} +} +\value{ +A vector of leverage values (hat values), one value per observation. +} +\description{ +Hat values (leverage values) are provided for nonlinear dose-response model fits using the +same formulas as in linear regression but based on the corresponding approximate quantities +available for nonlinear models. +} +\details{ +Hat values are calculated using the formula given by Cook et al. (1986) and +McCullagh and Nelder (1989). The output values can be assessed in the same way as +in linear regression. +} +\examples{ +ryegrass.LL.4 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + +hatvalues(ryegrass.LL.4) + +} +\references{ +Cook, R. D. and Tsai, C.-L. and Wei, B. C. (1986) +Bias in Nonlinear Regression, +\emph{Biometrika} \bold{73}, 615--623. + +McCullagh, P. and Nelder, J. A. (1989) +\emph{Generalized Linear Models}, +Second edition, Chapman & Hall/CRC. +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/heartrate.Rd b/man/heartrate.Rd new file mode 100644 index 00000000..64106dad --- /dev/null +++ b/man/heartrate.Rd @@ -0,0 +1,64 @@ +\name{heartrate} + +\alias{heartrate} + +\docType{data} + +\title{Heart rate baroreflexes for rabbits} + +\description{ + The dataset contains measurements of mean arterial pressure (mmHG) and heart rate (b/min) for a baroreflex curve. +} + +\usage{data(heartrate)} + +\format{ + A data frame with 18 observations on the following 2 variables. + \describe{ + \item{\code{pressure}}{a numeric vector containing measurements of arterial pressure.} + \item{\code{rate}}{a numeric vector containing measurements of heart rate.} + } +} + +\details{ + The dataset is an example of an asymmetric dose-response curve, that is not + easily handled using the log-logistic or Weibull models. +} + +\source{ + Ricketts, J. H. and Head, G. A. (1999) A five-parameter logistic equation for investigating asymmetry of + curvature in baroreflex studies, + \emph{Am. J. Physiol. (Regulatory Integrative Comp. Physiol. 46)}, \bold{277}, 441--454. +} + +\examples{ +library(drc) + +## Fitting the baro5 model +heartrate.m1 <- drm(rate~pressure, data=heartrate, fct=baro5()) +plot(heartrate.m1) + +coef(heartrate.m1) + +#Output: +#b1:(Intercept) b2:(Intercept) c:(Intercept) d:(Intercept) e:(Intercept) +# 11.07984 46.67492 150.33588 351.29613 75.59392 + +## Inserting the estimated baro5 model function in deriv() +baro5Derivative <- deriv(~ 150.33588 + ((351.29613 - 150.33588)/ +(1 + (1/(1 + exp((2 * 11.07984 * 46.67492/(11.07984 + 46.67492)) * +(log(x) - log(75.59392 ))))) * (exp(11.07984 * (log(x) - log(75.59392)))) + +(1 - (1/(1 + exp((2 * 11.07984 * 46.67492/(11.07984 + 46.67492)) * +(log(x) - log(75.59392 )))))) * (exp(46.67492 * (log(x) - log(75.59392 )))))), "x", function(x){}) + +## Plotting the derivative +#pressureVector <- 50:100 +pressureVector <- seq(50, 100, length.out=300) +derivativeVector <- attr(baro5Derivative(pressureVector), "gradient") +plot(pressureVector, derivativeVector, type = "l") + +## Finding the minimum +pressureVector[which.min(derivativeVector)] + +} +\keyword{datasets} diff --git a/man/hewlett.Rd b/man/hewlett.Rd new file mode 100644 index 00000000..c3610e65 --- /dev/null +++ b/man/hewlett.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/hewlett.R +\name{hewlett} +\alias{hewlett} +\title{Hewlett Mixture Model} +\usage{ +hewlett( + fixed = c(NA, NA, NA, NA, NA, NA), + names = c("b", "c", "d", "e", "f", "g"), + method = c("1", "2", "3", "4"), + ssfct = NULL, + eps = 1e-10 +) +} +\arguments{ +\item{fixed}{numeric vector. Specifies which parameters are fixed and at what value +they are fixed. NAs for parameters that are not fixed.} + +\item{names}{a vector of character strings giving the names of the parameters +(should not contain ":").} + +\item{method}{character string indicating the self starter function to use.} + +\item{ssfct}{a self starter function to be used (optional).} + +\item{eps}{numeric tolerance for handling zero dose values.} +} +\value{ +A list containing the nonlinear model function, the self starter function, +and the parameter names. +} +\description{ +Provides the Hewlett model for describing the joint action of two compounds +in binary mixture experiments. Used internally by \code{\link{mixture}}. +} +\seealso{ +\code{\link{mixture}}, \code{\link{voelund}} +} +\author{ +Christian Ritz +} +\keyword{internal} diff --git a/man/idrm.Rd b/man/idrm.Rd new file mode 100644 index 00000000..4ec75ecd --- /dev/null +++ b/man/idrm.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/idrm.R +\name{idrm} +\alias{idrm} +\title{Interactive dose-response modelling} +\usage{ +idrm(x, y, curveid, weights, fct, type, control) +} +\description{ +Interactive dose-response modelling +} +\keyword{internal} diff --git a/man/isobole.Rd b/man/isobole.Rd index 439a84b4..13421e03 100644 --- a/man/isobole.Rd +++ b/man/isobole.Rd @@ -1,54 +1,65 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/isobole.R \name{isobole} \alias{isobole} - \title{Creating isobolograms} - -\description{ - 'isobole' displays isobole based on EC/ED50 estimates from a log-logistic model. - Additionally isoboles determined by the concentration addition model, Hewlett's - model and Voelund's model can be added to the plot. -} - \usage{ -isobole(object1, object2, exchange = 1, cifactor = 2, ename = "e", -xaxis = "100", xlab, ylab, xlim, ylim, ...) +isobole( + object1, + object2, + exchange = 1, + cifactor = 2, + ename = "e", + xaxis = "100", + xlab, + ylab, + xlim, + ylim, + ... +) } - \arguments{ - \item{object1}{object of class 'drc' where EC/ED50 parameters vary freely.} - \item{object2}{object of class 'drc' where EC/ED50 parameters vary according to Hewlett's model.} - \item{ename}{character string. The name of the EC/ED50 variable.} - \item{xaxis}{character string. Is the mixture "0:100" or "100:0" on the x axis?} - \item{exchange}{numeric. The exchange rate between the two substances.} - \item{cifactor}{numeric. The factor to be used in the confidence intervals. - Default is 2, but 1 has been used in publications.} - \item{xlab}{an optional label for the x axis.} - \item{ylab}{an optional label for the y axis.} - \item{xlim}{a numeric vector of length two, containing the lower and upper limit for the x axis.} - \item{ylim}{a numeric vector of length two, containing the lower and upper limit for the y axis.} - \item{\dots}{Additional graphical parameters.} -} +\item{object1}{object of class 'drc' where EC/ED50 parameters vary freely.} -\details{ - The model fits to be supplied as first and optionally second argument are obtained - using \code{\link{mixture}} and \code{\link{drm}}. -} +\item{object2}{object of class 'drc' where EC/ED50 parameters vary according to Hewlett's model.} -\value{ - No value is returned. Only used for the side effect: the isobologram shown. -} +\item{exchange}{numeric. The exchange rate between the two substances.} -\references{ - Ritz, C. and Streibig, J. C. (2014) - From additivity to synergism - A modelling perspective - \emph{Synergy}, \bold{1}, 22--29. -} +\item{cifactor}{numeric. The factor to be used in the confidence intervals. Default is 2, +but 1 has been used in publications.} -\author{Christian Ritz} +\item{ename}{character string. The name of the EC/ED50 variable.} -%\note{} +\item{xaxis}{character string. Is the mixture "0:100" or "100:0" on the x axis?} -%\examples{} +\item{xlab}{an optional label for the x axis.} +\item{ylab}{an optional label for the y axis.} + +\item{xlim}{a numeric vector of length two, containing the lower and upper limit for the x axis.} + +\item{ylim}{a numeric vector of length two, containing the lower and upper limit for the y axis.} + +\item{...}{Additional graphical parameters.} +} +\value{ +No value is returned. Only used for the side effect: the isobologram shown. +} +\description{ +\code{isobole} displays isobole based on EC/ED50 estimates from a log-logistic model. +Additionally isoboles determined by the concentration addition model, Hewlett's model +and Voelund's model can be added to the plot. +} +\details{ +The model fits to be supplied as first and optionally second argument are obtained +using \code{\link{mixture}} and \code{\link{drm}}. +} +\references{ +Ritz, C. and Streibig, J. C. (2014) From additivity to synergism - A +modelling perspective \emph{Synergy}, \bold{1}, 22--29. +} +\author{ +Christian Ritz +} \keyword{models} \keyword{nonlinear} diff --git a/man/leaflength.Rd b/man/leaflength.Rd new file mode 100644 index 00000000..9d03a548 --- /dev/null +++ b/man/leaflength.Rd @@ -0,0 +1,49 @@ +\name{leaflength} + +\alias{leaflength} + +\docType{data} + +\title{Leaf length of barley} + +\description{ + In an experiment barley was grown in a hydroponic solution with a herbicide. +} + +\usage{data(leaflength)} + +\format{ + A data frame with 42 observations on the following 2 variables. + \describe{ + \item{\code{Dose}}{a numeric vector} + \item{\code{DW}}{a numeric vector} + } +} + +\details{ + The dataset exhibits a large hormetical effect. +} + +\source{ + Nina Cedergreen, Royal Veterinary and Agricultural University, Denmark. +} + +%\references{} + +\examples{ +library(drc) + +## Fitting a hormesis model +leaflength.crs4c1 <- drm(DW ~ Dose, data = leaflength, fct = CRS.4c()) +plot(fitted(leaflength.crs4c1), residuals(leaflength.crs4c1)) + +leaflength.crs4c2 <- boxcox(drm(DW ~ Dose, data = leaflength, fct = CRS.4c()), +method = "anova", plotit = FALSE) +summary(leaflength.crs4c2) + +## Plottinf fitted curve and original data +plot(leaflength.crs4c2, broken = TRUE, conLevel = 0.001, type = "all", legend = FALSE, +ylab = "Produced leaf length (cm)", xlab = "Metsulfuron-methyl (mg/l)", +main = "Hormesis: leaf length of barley") +} +\keyword{datasets} diff --git a/man/leaveOneOut.Rd b/man/leaveOneOut.Rd new file mode 100644 index 00000000..91879dd3 --- /dev/null +++ b/man/leaveOneOut.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mrdrm.R +\name{leaveOneOut} +\alias{leaveOneOut} +\title{Model-robust dose-response modelling} +\usage{ +leaveOneOut(object1, object2, dose, dataSet, resp, fixedEnd) +} +\description{ +Model-robust dose-response modelling +} +\keyword{internal} diff --git a/man/lemna.Rd b/man/lemna.Rd new file mode 100644 index 00000000..ca068fe5 --- /dev/null +++ b/man/lemna.Rd @@ -0,0 +1,34 @@ +\name{lemna} + +\alias{lemna} + +\docType{data} + +\title{Lemna} + +\description{Data from a dose-response experiment with the aquatic plant \emph{Lemna minor} (duckweed). The response measured was the frond number (count) at different concentrations of a test substance.} + +\usage{data(lemna)} + +\format{ + A data frame with 44 observations on the following 2 variables. + \describe{ + \item{\code{conc}}{a numeric vector containing the concentration.} + \item{\code{frond.num}}{a numeric vector containing the response (count).} + } +} + +\examples{ +library(drc) + +## Displaying the data +head(lemna) + +## Fitting a four-parameter log-logistic model +lemna.m1 <- drm(frond.num ~ conc, data = lemna, fct = LL.4()) +summary(lemna.m1) + +## Plotting the fitted curve +plot(lemna.m1, xlab = "Concentration", ylab = "Frond number") +} +\keyword{datasets} diff --git a/man/lepidium.Rd b/man/lepidium.Rd new file mode 100644 index 00000000..fa009f5c --- /dev/null +++ b/man/lepidium.Rd @@ -0,0 +1,45 @@ +\name{lepidium} + +\alias{lepidium} + +\docType{data} + +\title{Dose-response profile of degradation of agrochemical using lepidium} + +\description{ + Estimation of the degradation profile of an agrochemical based on soil samples at depth 0-10cm + from a calibration experiment. +} + +\usage{data(lepidium)} + +\format{ + A data frame with 42 observations on the following 2 variables. + \describe{ + \item{\code{conc}}{a numeric vector of concentrations (g/ha)} + \item{\code{weight}}{a numeric vector of plant weight (g) after 3 weeks' growth} + } +} + +\details{ + It is an experiment with seven concentrations and six replicates per concentration. \emph{Lepidium} + is rather robust as it only responds to high concentrations. +} + +\source{ + Racine-Poon, A. (1988) A Bayesian Approach to Nonlinear Calibration Problems, + \emph{J. Am. Statist. Ass.}, \bold{83}, 650--656. +} + +%\references{} + +\examples{ +library(drc) + +lepidium.m1 <- drm(weight~conc, data=lepidium, fct = LL.4()) + +modelFit(lepidium.m1) + +plot(lepidium.m1, type = "all", log = "") +} +\keyword{datasets} diff --git a/man/lettuce.Rd b/man/lettuce.Rd new file mode 100644 index 00000000..6749506d --- /dev/null +++ b/man/lettuce.Rd @@ -0,0 +1,64 @@ +\name{lettuce} + +\alias{lettuce} + +\docType{data} + +\title{Hormesis in lettuce plants} + +\description{ + Data are from an experiment where isobutylalcohol was dissolved in a nutrient solution in which lettuce + (\emph{Lactuca sativa}) plants were grown. The plant biomass of the shoot was determined af 21 days. +} + +\usage{data(lettuce)} + +\format{ + A data frame with 14 observations on the following 2 variables. + \describe{ + \item{conc}{a numeric vector of concentrations of isobutylalcohol (mg/l)} + \item{weight}{a numeric vector of biomass of shoot (g)} + } +} + +\details{ + The data set illustrates hormesis, presence of a subtoxic stimulus at low concentrations. +} + +\source{ + van Ewijk, P. H. and Hoekstra, J. A. (1993) + Calculation of the EC50 and its Confidence Interval When Subtoxic Stimulus Is Present, + \emph{ECOTOXICOLOGY AND ENVIRONMENTAL SAFETY}, \bold{25}, 25--32. +} + +\references{ + van Ewijk, P. H. and Hoekstra, J. A. (1994) + Curvature Measures and Confidence Intervals for the Linear Logistic Model, + \emph{Appl. Statist.}, \bold{43}, 477--487. +} + +\examples{ +library(drc) + +## Look at data +lettuce + +## Monotonous dose-response model +lettuce.m1 <- drm(weight~conc, data=lettuce, fct=LL.3()) + +plot(lettuce.m1, broken = TRUE) + +## Model fit in van Ewijk and Hoekstra (1994) +lettuce.m2 <- drm(weight~conc, data=lettuce, fct=BC.4()) +modelFit(lettuce.m2) + +plot(lettuce.m2, add = TRUE, broken = TRUE, type = "none", lty = 2) + +## Hormesis effect only slightly significant +summary(lettuce.m2) + +## Hormesis effect highly significant +## compare with t-test for the "f" parameter in the summary output) +anova(lettuce.m1, lettuce.m2) +} +\keyword{datasets} diff --git a/man/lgaussian.Rd b/man/lgaussian.Rd new file mode 100644 index 00000000..f24ba9fb --- /dev/null +++ b/man/lgaussian.Rd @@ -0,0 +1,50 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/lgaussian.R +\name{lgaussian} +\alias{lgaussian} +\title{Log-normal (log-Gaussian) biphasic dose-response model} +\usage{ +lgaussian( + fixed = c(NA, NA, NA, NA, NA), + names = c("b", "c", "d", "e", "f"), + method = c("1", "2", "3", "4"), + ssfct = NULL, + fctName, + fctText, + loge = FALSE +) +} +\arguments{ +\item{fixed}{numeric vector. Specifies which parameters are fixed and at what value they are fixed. +NAs for parameters that are not fixed.} + +\item{names}{a vector of character strings giving the names of the parameters (should not contain ":"). +The order of the parameters is: b, c, d, e, f.} + +\item{method}{character string indicating the self starter function to use.} + +\item{ssfct}{a self starter function to be used.} + +\item{fctName}{optional character string used internally by convenience functions.} + +\item{fctText}{optional character string used internally by convenience functions.} + +\item{loge}{logical indicating whether or not e or log(e) should be a parameter in the model. +By default e is a model parameter.} +} +\value{ +The value returned is a list containing the nonlinear function, the self starter function +and the parameter names. +} +\description{ +Model function for fitting symmetric or skewed bell-shaped/biphasic dose-response patterns +using the log-Gaussian model. This is the log-transformed variant of the \code{\link{gaussian}} model. +} +\seealso{ +\code{\link{gaussian}}, \code{\link{drm}} +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/lin.test.Rd b/man/lin.test.Rd index 89a088bb..8e8accdf 100644 --- a/man/lin.test.Rd +++ b/man/lin.test.Rd @@ -1,107 +1,80 @@ -\name{lin.test} - -\Rdversion{1.1} - -\alias{lin.test} - -\title{ - Lack-of-fit test for the mean structure based on cumulated residuals -} - -\description{ - The function provides a lack-of-fit test for the mean structure based on cumulated residuals from the model fit. -} - -\usage{ - lin.test(object, noksSim = 20, seed = 20070325, plotit = TRUE, - log = "", bp = 0.01, xlab, ylab, ylim, ...) -} - -\arguments{ - \item{object}{ - object of class 'drc'. -} - \item{noksSim}{ - numeric specifying the number of simulations used to obtain the p-value. -} - \item{seed}{ - numeric specifying the seed value for the random number generator. -} - \item{plotit}{ - logical indicating whether or not the observed cumulated residual process should be plotted. Default is to - plot the process. -} - \item{log}{ - character string which should contains '"x"' if the x axis is to be logarithmic, '"y"' if the y axis is to be - logarithmic and '"xy"' or '"yx"' if both axes are to be logarithmic. The default is "x". - The empty string "" yields the original axes. -} - \item{bp}{ - numeric value specifying the break point below which the dose is zero (the amount of stretching on - the dose axis above zero in order to create the visual illusion of a logarithmic scale \emph{including} 0). -} - \item{xlab}{ - string character specifying an optional label for the x axis. -} - \item{ylab}{ - character string specifying an optional label for the y axis. -} - \item{ylim}{ - numeric vector of length two, containing the lower and upper limit for the y axis. -} - \item{\dots}{ - additional arguments to be passed further to the basic \code{\link{plot}} method. -} -} - -\details{ - The function provides a graphical model checking of the mean structure in a dose-response model. The graphical - display is supplemented by a p-value based on a supremum-type test. - - The test is applicable even in cases where data are non-normal or exhibit variance heterogeneity. -} - -\value{ - A p-value for test of the null hypothesis that the mean structure is appropriate. - Ritz and Martinussen (2009) provide the details. -} -\references{ - Ritz, C and Martinussen, T. (2009) - Lack-of-fit tests for assessing mean structures for continuous dose-response data, - \emph{Submitted manuscript} -} -\author{ - Christian Ritz -} - -%\note{ -%} - -\seealso{ - Other available lack-of-fit tests are the Neill test (\code{\link{neill.test}}) and - ANOVA-based test (\code{\link{modelFit}}). -} - -\examples{ - -## Fitting a log-logistic model to the dataset 'etmotc' -etmotc.m1<-drm(rgr1~dose1, data=etmotc[1:15,], fct=LL.4()) - -## Test based on umulated residuals -lin.test(etmotc.m1, 1000) -#lin.test(etmotc.m1, 10000, plotit = FALSE) # more precise - -## Fitting an exponential model to the dataset 'O.mykiss' -O.mykiss.m1<-drm(weight~conc, data=O.mykiss, fct=EXD.2(), na.action=na.omit) - -## ANOVA-based test -modelFit(O.mykiss.m1) - -## Test based on umulated residuals -lin.test(O.mykiss.m1, log = "", cl = 0.2, xlab = "Dose (mg/l)", main = "B", ylim = c(-0.6, 0.6)) -#lin.test(O.mykiss.m1, noksSim = 10000, plotit = FALSE) # more precise - -} - -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/lin.test.R +\name{lin.test} +\alias{lin.test} +\title{Lack-of-fit test for the mean structure based on cumulated residuals} +\usage{ +lin.test( + object, + noksSim = 20, + seed = 20070325, + plotit = TRUE, + log = "", + bp = 0.01, + xlab, + ylab, + ylim, + ... +) +} +\arguments{ +\item{object}{object of class 'drc'.} + +\item{noksSim}{numeric specifying the number of simulations used to obtain the p-value.} + +\item{seed}{numeric specifying the seed value for the random number generator.} + +\item{plotit}{logical indicating whether or not the observed cumulated residual process +should be plotted. Default is to plot the process.} + +\item{log}{character string which should contain \code{"x"} if the x axis is to be +logarithmic, \code{"y"} if the y axis is to be logarithmic and \code{"xy"} or +\code{"yx"} if both axes are to be logarithmic. The empty string \code{""} yields +the original axes.} + +\item{bp}{numeric value specifying the break point below which the dose is zero.} + +\item{xlab}{character string specifying an optional label for the x axis.} + +\item{ylab}{character string specifying an optional label for the y axis.} + +\item{ylim}{numeric vector of length two, containing the lower and upper limit for the y axis.} + +\item{...}{additional arguments to be passed further to the basic \code{\link{plot}} method.} +} +\value{ +A p-value for test of the null hypothesis that the mean structure is appropriate. +Ritz and Martinussen (2009) provide the details. +} +\description{ +The function provides a lack-of-fit test for the mean structure based on cumulated +residuals from the model fit. +} +\details{ +The function provides a graphical model checking of the mean structure in a dose-response +model. The graphical display is supplemented by a p-value based on a supremum-type test. + +The test is applicable even in cases where data are non-normal or exhibit variance +heterogeneity. +} +\examples{ +## Fitting a log-logistic model to the dataset 'etmotc' +etmotc.m1<-drm(rgr1~dose1, data=etmotc[1:15,], fct=LL.4()) + +## Test based on cumulated residuals +lin.test(etmotc.m1, 1000) + +} +\references{ +Ritz, C and Martinussen, T. (2009) Lack-of-fit tests for assessing mean +structures for continuous dose-response data, \emph{Submitted manuscript} +} +\seealso{ +Other available lack-of-fit tests are the Neill test (\code{\link{neill.test}}) +and ANOVA-based test (\code{\link{modelFit}}). +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/liver.tumor.Rd b/man/liver.tumor.Rd new file mode 100644 index 00000000..a0e6628e --- /dev/null +++ b/man/liver.tumor.Rd @@ -0,0 +1,53 @@ +\name{liver.tumor} + +\alias{liver.tumor} + +\docType{data} + +\title{Liver tumor incidence} + +\description{ + Liver tumor incidence in female Sprague-Dawley rats exposed to the chemical like 2,3,7,8-tetrachlorodibenzo-pdioxin +(TCDD). +} + +\usage{data(liver.tumor)} + +\format{ + A data frame with 6 observations on the following 3 variables. + \describe{ + \item{\code{conc}}{a numeric vector reporting the concentration of TCDD (ng/kg)} + \item{\code{total}}{a numeric vector} + \item{\code{incidence}}{a numeric vector} + } +} + +%\details{} + +\source{ + National Toxicology Program. NTP technical report on the toxicology and carcinogenesis +studies of 2,3,7,8-tetrachlorodibenzo-p-dioxin (tcdd) (CAS No. 1746-01-6) in female Harlan +Sprague-Dawley rats (gavage studies). National Toxicology Program technical report series, +(521):4--232, apr 2006. +} + +%\references{} + +\examples{ +library(drc) + +## Displaying the data +head(liver.tumor) + +## Fitting a two-parameter log-logistic model for binomial response +liver.tumor.m1 <- drm(incidence/total ~ conc, weights = total, +data = liver.tumor, fct = LL.2(), type = "binomial") +summary(liver.tumor.m1) + +## Plotting the fitted curve +plot(liver.tumor.m1, xlab = "Concentration of TCDD (ng/kg)", +ylab = "Tumor incidence") +} + + +\keyword{datasets} diff --git a/man/llogistic.Rd b/man/llogistic.Rd index d8eab235..23c947cc 100644 --- a/man/llogistic.Rd +++ b/man/llogistic.Rd @@ -1,84 +1,56 @@ -\name{llogistic} - -\alias{llogistic} -\alias{llogistic2} - -\title{The log-logistic function} - -\description{ - 'llogistic' provides a very general way of specifying log-logistic models, - under various constraints on the parameters. -} - -\usage{ - llogistic(fixed = c(NA, NA, NA, NA, NA), - names = c("b", "c", "d", "e", "f"), - method = c("1", "2", "3", "4"), ssfct = NULL, - fctName, fctText) - - llogistic2(fixed = c(NA, NA, NA, NA, NA), - names = c("b", "c", "d", "e", "f"), - ss = c("1", "2", "3"), ssfct = NULL, - fctName, fctText) -} - -\arguments{ - \item{fixed}{numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.} - \item{names}{a vector of character strings giving the names of the parameters (should not contain ":"). - The default is reasonable (see under 'Usage'). The order of the parameters is: b, c, d, e, f - (see under 'Details').} - \item{method}{character string indicating the self starter function to use.} - \item{ss}{character string indicating the self starter function to use.} - \item{ssfct}{a self starter function to be used.} - \item{fctName}{optional character string used internally by convenience functions.} - \item{fctText}{optional character string used internally by convenience functions.} -} - -\details{ - The default arguments yields the five-parameter log-logistic function given by the expression - - \deqn{ f(x) = c + \frac{d-c}{(1+\exp(b(\log(x)-\log(e))))^f}} - - If the parameter \eqn{f} differs from 1 then the function is asymmetric; otherwise it - is symmetric (on log scale). This function is fitted using \code{\link{llogistic}}. - - The log-logistic function with log(e) rather than e as a parameter, that is using the parameterisation - - \deqn{ f(x) = c + \frac{d-c}{(1+\exp(b(\log(x)-e)))^f}} - - is fitted using \code{\link{llogistic2}}. - - Sometimes the log-logistic models are also called Hill models. -} - -\value{ - The value returned is a list containing the nonlinear function, the self starter function - and the parameter names. -} - -\references{ - Finney, D. J. (1979) Bioassay and the Practise of Statistical Inference, - \emph{Int. Statist. Rev.}, \bold{47}, 1--12. - - Seber, G. A. F. and Wild, C. J. (1989) \emph{Nonlinear Regression}, New York: Wiley \& Sons (p. 330). -} - -\author{Christian Ritz} - -\note{ - The functions are for use with the function \code{\link{drm}}. -} - -\seealso{ - For convenience several special cases are available: - \code{\link{LL.2}}, \code{\link{LL.3}}, \code{\link{LL.4}} and \code{\link{LL.5}}. - Examples are provided in the help pages for these functions. -} - -%\examples{} - -\keyword{models} -\keyword{nonlinear} - -\concept{Hill} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/llogistic.R +\name{llogistic} +\alias{llogistic} +\title{The log-logistic function} +\usage{ +llogistic( + fixed = c(NA, NA, NA, NA, NA), + names = c("b", "c", "d", "e", "f"), + method = c("1", "2", "3", "4"), + ssfct = NULL, + fctName, + fctText +) +} +\arguments{ +\item{fixed}{numeric vector of length 5, specifying fixed parameters +(use NA for non-fixed parameters).} + +\item{names}{character vector of length 5, specifying the names of the +parameters: b, c, d, e, f.} + +\item{method}{character string indicating the self starter function to use.} + +\item{ssfct}{a self starter function to be used.} + +\item{fctName}{optional character string used internally.} + +\item{fctText}{optional character string used internally.} +} +\value{ +A list containing the nonlinear function, the self starter function, +and the parameter names. +} +\description{ +A very general way of specifying log-logistic models under various +constraints on parameters. +} +\details{ +The five-parameter log-logistic function is given by the expression +\deqn{f(x) = c + \frac{d-c}{(1+\exp(b(\log(x)-\log(e))))^f}} +} +\references{ +Finney, D. J. (1979). + +Seber, G. A. F. and Wild, C. J. (1989). +} +\seealso{ +\code{\link{LL.2}}, \code{\link{LL.3}}, \code{\link{LL.4}}, +\code{\link{LL.5}} +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/llogistic.ssf.Rd b/man/llogistic.ssf.Rd new file mode 100644 index 00000000..7a53cf8d --- /dev/null +++ b/man/llogistic.ssf.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/llogistic.ssf.R +\name{llogistic.ssf} +\alias{llogistic.ssf} +\title{Self-starter for log-logistic model} +\usage{ +llogistic.ssf(method = c("1", "2", "3", "4"), fixed, useFixed = FALSE) +} +\description{ +Self-starter for log-logistic model +} +\keyword{internal} diff --git a/man/llogistic2.Rd b/man/llogistic2.Rd new file mode 100644 index 00000000..43ddd097 --- /dev/null +++ b/man/llogistic2.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/llogistic2.R +\name{llogistic2} +\alias{llogistic2} +\title{Five-Parameter Log-Logistic Model with log(ED50) as Parameter} +\usage{ +llogistic2( + fixed = c(NA, NA, NA, NA, NA), + names = c("b", "c", "d", "e", "f"), + ss = c("1", "2", "3"), + ssfct = NULL, + fctName, + fctText +) +} +\arguments{ +\item{fixed}{numeric vector of length 5. Specifies which parameters are +fixed and at what value. Use \code{NA} for parameters that should be +estimated.} + +\item{names}{character vector of length 5 giving the names of the +parameters \code{b}, \code{c}, \code{d}, \code{e}, and \code{f}.} + +\item{ss}{character string indicating the self-starter version to use. +One of \code{"1"} (default), \code{"2"}, or \code{"3"}.} + +\item{ssfct}{optional self-starter function. If provided, overrides the +built-in self-starter selected by \code{ss}.} + +\item{fctName}{optional character string specifying the name of the function.} + +\item{fctText}{optional character string providing a short description of +the function.} +} +\value{ +A list of class \code{"llogistic"} containing the nonlinear function, +self-starter function, parameter names, and related helper functions. +} +\description{ +A five-parameter log-logistic model where the ED50 is parameterised on the +log scale. The mean function is: +\deqn{f(x) = c + \frac{d - c}{(1 + \exp(b(\log(x) - e)))^f}}{f(x) = c + (d-c)/(1+exp(b(log(x)-e)))^f} +where \code{e} is the logarithm of the ED50 (not exponentiated). +} +\seealso{ +\code{\link{llogistic}}, \code{\link{LL2.2}}, \code{\link{LL2.3}}, +\code{\link{LL2.4}}, \code{\link{LL2.5}} +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/lnormal.Rd b/man/lnormal.Rd index de9b6bfd..aa95b8df 100644 --- a/man/lnormal.Rd +++ b/man/lnormal.Rd @@ -1,103 +1,64 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/lnormal.R \name{lnormal} - \alias{lnormal} -\alias{LN.2} -\alias{LN.3} -\alias{LN.3u} -\alias{LN.4} - \title{Log-normal dose-response model} - -\description{ - \code{lnormal} and the accompanying convenience functions provide a general framework for specifying - the mean function of the decreasing or incresing log-normal dose-response model. -} - \usage{ - lnormal(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), - method = c("1", "2", "3", "4"), ssfct = NULL, - fctName, fctText, loge = FALSE) - - LN.2(upper = 1, fixed = c(NA, NA), names = c("b", "e"), ...) - - LN.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) - - LN.3u(upper = 1, fixed = c(NA, NA, NA), names = c("b", "c", "e"), ...) - - LN.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) +lnormal( + fixed = c(NA, NA, NA, NA), + names = c("b", "c", "d", "e"), + method = c("1", "2", "3", "4"), + ssfct = NULL, + fctName, + fctText, + loge = FALSE +) } - \arguments{ - \item{fixed}{numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.} - \item{names}{vector of character strings giving the names of the parameters (should not contain ":"). - The default is reasonable (see under 'Usage'). The order of the parameters is: b, c, d, e, f - (see under 'Details' for the precise meaning of each parameter).} - \item{method}{character string indicating the self starter function to use.} - \item{ssfct}{a self starter function to be used.} - \item{fctName}{character string used internally by convenience functions (optional).} - \item{fctText}{character string used internally by convenience functions (optional).} - \item{loge}{logical indicating whether or not ED50 or log(ED50) should be a parameter in the model. - By default ED50 is a model parameter.} - - \item{upper}{numeric specifying the upper horizontal asymptote in the convenience function. - The default is 1.} - \item{...}{additional arguments to be passed from the convenience functions to \code{lnormal}.} -} +\item{fixed}{numeric vector. Specifies which parameters are fixed and at what value they are fixed. +NAs for parameters that are not fixed.} -\details{ - For the case where log(ED50), denoted \eqn{e} in the equation below, is a parameter in the model, - the mean function is: - - \deqn{f(x) = c + (d-c)(\Phi(b(\log(x)-e)))} +\item{names}{vector of character strings giving the names of the parameters (should not contain ":"). +The order of the parameters is: b, c, d, e.} - and the mean function is: - - \deqn{f(x) = c + (d-c)(\Phi(b(\log(x)-\log(e))))} +\item{method}{character string indicating the self starter function to use.} - in case ED50, which is also denoted \eqn{e}, is a parameter in the model. If the former model is fitted - any estimated ED values will need to be back-transformed subsequently in order to obtain effective doses - on the original scale. +\item{ssfct}{a self starter function to be used.} - The mean functions above yield the same models as those described by Bruce and Versteeg (1992), - but using a different parameterisation (among other things the natural logarithm is used). - - For the case \eqn{c=0} and \eqn{d=1}, the log-normal model reduces the classic probit model (Finney, 1971) - with log dose as explanatory variable (mostly used for quantal data). This special case is available through - the convenience function \code{LN.2}. - - The case \eqn{c=0} is available as the function \code{LN.3}, whereas the \code{LN.3u} corresponds to the special - case where the upper horizontal asymptote is fixed (default is 1). The full four-parameter model is available - through \code{LN.4}. -} +\item{fctName}{optional character string used internally by convenience functions.} + +\item{fctText}{optional character string used internally by convenience functions.} +\item{loge}{logical indicating whether or not ED50 or log(ED50) should be a parameter in the model. +By default ED50 is a model parameter.} +} \value{ - The value returned is a list containing the non-linear function, the self starter function - and the parameter names. +A list containing the non-linear function, the self starter function +and the parameter names. } - -\references{ - Finney, D. J. (1971) \emph{Probit analysis}, London: Cambridge University Press. - - Bruce, R. D. and Versteeg, D. J. (1992) A statistical procedure for modeling continuous toxicity data, - \emph{Environ. Toxicol. Chem.}, \bold{11}, 1485--1494. +\description{ +\code{lnormal} provides a general framework for specifying the mean function of the +decreasing or increasing log-normal dose-response model. } +\details{ +For the case where log(ED50) is a parameter in the model, the mean function is: +\deqn{f(x) = c + (d-c)(\Phi(b(\log(x)-e)))} +and in case ED50 is a parameter: +\deqn{f(x) = c + (d-c)(\Phi(b(\log(x)-\log(e))))} -\author{Christian Ritz} - -\note{ - The function is for use with the function \code{\link{drm}}, but typically the convenience functions - \code{link{LN.2}}, \code{link{LN.3}}, \code{link{LN.3u}}, and \code{link{LN.4}} should be used. +For \eqn{c=0} and \eqn{d=1}, the model reduces to the classic probit model. } +\references{ +Finney, D. J. (1971) \emph{Probit analysis}, London: Cambridge University Press. +Bruce, R. D. and Versteeg, D. J. (1992) A statistical procedure for modeling continuous toxicity data, +\emph{Environ. Toxicol. Chem.}, \bold{11}, 1485--1494. +} \seealso{ - The log-logistic model (\code{\link{llogistic}}) is very similar to the log-normal model at least in the middle, - but they may differ in the tails and thus provide different estimates of low effect concentrations EC/ED. +The log-logistic model \code{\link{llogistic}} is very similar to the log-normal model. +} +\author{ +Christian Ritz } - -%\examples{} - \keyword{models} \keyword{nonlinear} - -\concept{log-normal probit} \ No newline at end of file diff --git a/man/lnormal.ssf.Rd b/man/lnormal.ssf.Rd new file mode 100644 index 00000000..3e2135c8 --- /dev/null +++ b/man/lnormal.ssf.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/lnormal.ssf.R +\name{lnormal.ssf} +\alias{lnormal.ssf} +\title{Self-starter for log-normal model} +\usage{ +lnormal.ssf(method = c("1", "2", "3", "4"), fixed, loge, useFixed = FALSE) +} +\description{ +Self-starter for log-normal model +} +\keyword{internal} diff --git a/man/logLik.drc.Rd b/man/logLik.drc.Rd index 86e2f145..88ab6033 100644 --- a/man/logLik.drc.Rd +++ b/man/logLik.drc.Rd @@ -1,39 +1,33 @@ -\name{logLik.drc} - -\alias{logLik.drc} - -\title{Extracting the log likelihood} - -\description{ - \code{loglik} extracts the value of the log likelihood function evaluated at the parameter estimates. -} -\usage{ - \method{logLik}{drc}(object, ...) -} - -\arguments{ - \item{object}{an object of class 'drc'.} - \item{...}{additional arguments.} -} - -\value{ - The evaluated log likelihood as a numeric value and the corresponding degrees of freedom as well as the number of observations as attributes. -} - -\note{ - The value of the log likelihood could be used to compare model fits of the same data based on different - dose-response models or based on the same model but fitted different algorithms, software programmes, or - starting values. For comparisons: Larger is better. -} - -\author{Christian Ritz} - -\examples{ - -## Fitting a four-parameter log-logistic model -ryegrass.m1 <- drm(rootl ~conc, data = ryegrass, fct = LL.4()) -logLik(ryegrass.m1) - -} -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/logLik.drc.R +\name{logLik.drc} +\alias{logLik.drc} +\title{Extracting the log likelihood} +\usage{ +\method{logLik}{drc}(object, ...) +} +\arguments{ +\item{object}{an object of class 'drc'.} + +\item{...}{additional arguments.} +} +\value{ +The evaluated log likelihood as a numeric value and the +corresponding degrees of freedom as well as the number of observations +as attributes. +} +\description{ +\code{logLik} extracts the value of the log likelihood function evaluated +at the parameter estimates. +} +\examples{ +## Fitting a four-parameter log-logistic model +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +logLik(ryegrass.m1) + +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/logistic.Rd b/man/logistic.Rd index 2224801e..e729a2ba 100644 --- a/man/logistic.Rd +++ b/man/logistic.Rd @@ -1,94 +1,59 @@ -\name{logistic} - -\alias{logistic} - -\alias{L.3} -\alias{L.4} -\alias{L.5} - -%\alias{boltzmann} - -%\alias{B.3} -%\alias{B.4} -%\alias{B.5} -%\alias{b3} -%\alias{b4} -%\alias{b5} - -\title{The logistic model} - -\description{ - The general asymmetric five-parameter logistic model for describing dose-response relationships. -} - -\usage{ - logistic(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), - method = c("1", "2", "3", "4"), ssfct = NULL, - fctName, fctText) - - L.3(fixed = c(NA, NA, NA), names = c("b", "d", "e"), ...) - L.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e"), ...) - L.5(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), ...) - -% boltzmann(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f"), fctName, fctText) -% -% B.3(fixed = c(NA, NA, NA), names = c("b", "d", "e")) -% B.4(fixed = c(NA, NA, NA, NA), names = c("b", "c", "d", "e")) -% B.5(fixed = c(NA, NA, NA, NA, NA), names = c("b", "c", "d", "e", "f")) -} - - -\arguments{ - \item{fixed}{numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.} - \item{names}{a vector of character strings giving the names of the parameters (should not contain ":"). - The order of the parameters is: b, c, d, e, f (see under 'Details').} - \item{method}{character string indicating the self starter function to use.} - \item{ssfct}{a self starter function to be used.} - \item{fctName}{optional character string used internally by convenience functions.} - \item{fctText}{optional character string used internally by convenience functions.} - \item{...}{Additional arguments (see \code{\link{llogistic}}).} -} - -\details{ - The default arguments yields the five-parameter logistic mean function given by the expression - - \deqn{ f(x) = c + \frac{d-c}{(1+\exp(b(x - e)))^f}} - - The model is different from the log-logistic models \code{\link{llogistic}} and \code{\link{llogistic2}} - where the term \deqn{log(x)} is used instead of \deqn{x}. - - The model is sometimes referred to as the Boltzmann model. -} - -\value{ - The value returned is a list containing the nonlinear function, the self starter function - and the parameter names. -} - -% \references{ ~put references to the literature/web site here ~ } - -\author{Christian Ritz} - -%\note{} - -%\seealso{ ~~objects to See Also as \code{\link{help}}, ~~~ } - -\examples{ - -## Fitting the four-parameter logistic model -ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = L.4()) -summary(ryegrass.m1) - -## Fitting an asymmetric logistic model -## requires installing the package 'NISTnls' -# Ratkowsky3.m1 <- drm(y~x, data = Ratkowsky3, -# fct = L.5(fixed = c(NA, 0, NA, NA, NA))) -# plot(Ratkowsky3.m1) -# summary(Ratkowsky3.m1) -## okay agreement with NIST values -## for the two parameters that are the same - -} -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/logistic.R +\name{logistic} +\alias{logistic} +\title{The general asymmetric five-parameter logistic model} +\usage{ +logistic( + fixed = c(NA, NA, NA, NA, NA), + names = c("b", "c", "d", "e", "f"), + method = c("1", "2", "3", "4"), + ssfct = NULL, + fctName, + fctText +) +} +\arguments{ +\item{fixed}{numeric vector of length 5. Specifies which parameters are fixed +and at what value they are fixed. \code{NA} indicates that the corresponding +parameter is not fixed.} + +\item{names}{character vector of length 5 giving the names of the parameters +\code{(b, c, d, e, f)}. Default is \code{c("b", "c", "d", "e", "f")}.} + +\item{method}{character string indicating the self starter function to use +(\code{"1"}, \code{"2"}, \code{"3"}, or \code{"4"}).} + +\item{ssfct}{a self starter function to be used. If \code{NULL} (default), +a built-in self starter is selected via \code{method}.} + +\item{fctName}{optional character string used internally to overwrite the +function name.} + +\item{fctText}{optional character string used internally to overwrite the +description text.} +} +\value{ +A list of class \code{"Boltzmann"} containing the nonlinear function, +self starter function, and parameter names. +} +\description{ +The five-parameter logistic model given by the expression +\deqn{f(x) = c + \frac{d - c}{(1 + \exp(b(x - e)))^f}} +} +\details{ +This model differs from the log-logistic in that it uses \code{x} directly +rather than \code{log(x)}. It is sometimes referred to as the Boltzmann model. +} +\examples{ +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = L.4()) +} +\seealso{ +\code{\link{L.3}}, \code{\link{L.4}}, \code{\link{L.5}}, +\code{\link{llogistic}} +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/logistic.ssf.Rd b/man/logistic.ssf.Rd new file mode 100644 index 00000000..fa49fda4 --- /dev/null +++ b/man/logistic.ssf.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/logistic.ssf.R +\name{logistic.ssf} +\alias{logistic.ssf} +\title{Self-starter for logistic model} +\usage{ +logistic.ssf(method = c("1", "2", "3", "4"), fixed, useFixed = FALSE) +} +\description{ +Self-starter for logistic model +} +\keyword{internal} diff --git a/man/lowFixed.Rd b/man/lowFixed.Rd new file mode 100644 index 00000000..43c25a81 --- /dev/null +++ b/man/lowFixed.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/llogistic2.R +\name{lowFixed} +\alias{lowFixed} +\title{Construct Text for Model with Fixed Lower Limit} +\usage{ +lowFixed(modelStr) +} +\arguments{ +\item{modelStr}{character string with the base model description.} +} +\value{ +A character string describing the model with its fixed lower limit. +} +\description{ +Helper function that appends lower limit information to a model description +string. +} +\keyword{internal} diff --git a/man/lowupFixed.Rd b/man/lowupFixed.Rd new file mode 100644 index 00000000..79ec8355 --- /dev/null +++ b/man/lowupFixed.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/llogistic2.R +\name{lowupFixed} +\alias{lowupFixed} +\title{Construct Text for Model with Fixed Lower and Upper Limits} +\usage{ +lowupFixed(modelStr, upper) +} +\arguments{ +\item{modelStr}{character string with the base model description.} + +\item{upper}{numeric value for the fixed upper limit.} +} +\value{ +A character string describing the model with its fixed limits. +} +\description{ +Helper function that appends lower and upper limit information to a model +description string. +} +\keyword{internal} diff --git a/man/maED.Rd b/man/maED.Rd index 3a5c2c40..0e4c32a6 100644 --- a/man/maED.Rd +++ b/man/maED.Rd @@ -1,120 +1,124 @@ -\name{maED} - -\Rdversion{1.1} - -\alias{maED} - -\title{Estimation of ED values using model-averaging} - -\description{ - Estimates and confidence intervals for ED values are estimated using model-averaging. -} - -\usage{ -maED(object, fctList = NULL, respLev, interval = c("none", "buckland", "kang"), -linreg = FALSE, clevel = NULL, level = 0.95, type = c("relative", "absolute"), -display = TRUE, na.rm = FALSE, extended = FALSE) -} - -\arguments{ - \item{object}{an object of class 'drc'.} - \item{fctList}{a list of non-linear functions to be compared.} - \item{respLev}{a numeric vector containing the response levels.} - \item{interval}{character string specifying the type of confidence intervals to be supplied. The default is "none". - The choices "buckland" and "kang" are explained in the Details section.} - \item{linreg}{logical indicating whether or not additionally a simple linear regression model - should be fitted.} - \item{clevel}{character string specifying the curve id in case on estimates for a specific curve or compound is requested. By default estimates - are shown for all curves.} - \item{level}{numeric. The level for the confidence intervals. The default is 0.95.} - \item{type}{character string. Whether the specified response levels are absolute or relative (default).} - \item{display}{logical. If TRUE results are displayed. Otherwise they are not (useful in simulations).} - \item{na.rm}{logical indicating whether or not NA occurring during model fitting should be left out of - subsequent calculations.} - \item{extended}{logical specifying whether or not an extended output (including fit summaries) should be - returned.} -} -\details{ - Model-averaging of individual estimates is carried out as described by Buckland \emph{et al.} (1997) and - Kang \emph{et al.} (2000) using AIC-based weights. The two approaches differ w.r.t. the calculation of confidence - intervals: Buckland \emph{et al.} (1997) provide an approximate variance formula under the assumption of - perfectly correlated estimates (so, confidence intervals will tend to be too wide). - Kang \emph{et al.} (2000) use the model weights to calculate confidence limits as weighted means of - the confidence limits for the individual fits; this procedure corresponds to using the standard error in Equation (3) - given by Buckland \emph{et al.} (1997) (assuming symmetric confidence intervals based on the same percentile). -} - -\value{ - A matrix with two or more columns, containing the estimates - and the corresponding estimated standard errors and possibly lower and upper confidence limits. -} - -\references{ - Buckland, S. T. and Burnham, K. P. and Augustin, N. H. (1997) - Model Selection: An Integral Part of Inference, - \emph{Biometrics} \bold{53}, 603--618. - - Kang, Seung-Ho and Kodell, Ralph L. and Chen, James J. (2000) - Incorporating Model Uncertainties along with Data Uncertainties in Microbial Risk Assessment, - \emph{Regulatory Toxicology and Pharmacology} \bold{32}, 68--72. -} - -\author{Christian Ritz} - -%\note{} - -\seealso{ - The function \code{\link{mselect}} provides a summary of fit statistics for several models fitted to the same data. -} - -\examples{ - -## Fitting an example dose-response model -ryegrass.m1 <- drm(rootl~conc, data = ryegrass, fct = LL.4()) - -## Comparing models (showing the AIC values) -mselect(ryegrass.m1, -list(LL.5(), LN.4(), W1.4(), W2.4(), FPL.4(-1,1), FPL.4(-2,3), FPL.4(-0.5,0.5))) - -## Doing the actual model-averaging -maED(ryegrass.m1, -list(LL.5(), LN.4(), W1.4(), W2.4(), FPL.4(-1,1), FPL.4(-2,3), FPL.4(-0.5,0.5)), -c(10, 50, 90)) - -## With confidence intervals according to Buckland et al. (1997) -maED(ryegrass.m1, -list(LL.5(), LN.4(), W1.4(), W2.4(), FPL.4(-1,1), FPL.4(-2,3), FPL.4(-0.5,0.5)), -c(10, 50, 90), "buckland") - -## With confidence intervals according to Kang et al. (2000) -maED(ryegrass.m1, -list(LL.5(), LN.4(), W1.4(), W2.4(), FPL.4(-1,1), FPL.4(-2,3), FPL.4(-0.5,0.5)), -c(10, 50, 90), "kang") - -## Comparing to model-averaged ED values with simple linear regression included -maED(ryegrass.m1, -list(LL.5(), LN.4(), W1.4(), W2.4(), FPL.4(-1,1), FPL.4(-2,3), FPL.4(-0.5,0.5)), -c(10, 50, 90), interval = "buckland", linreg = TRUE) - - - -## Example with a model fit involving two compounds/curves -S.alba.m1 <- drm(DryMatter~Dose, Herbicide, data=S.alba, fct = LL.4(), -pmodels=data.frame(Herbicide,1,1,Herbicide)) - -## Model-averaged ED50 for both compounds -maED(S.alba.m1, list(LL.3(), LN.4()), 50) - -## Model-averaged ED50 only for one compound (glyphosate) -maED(S.alba.m1, list(LL.3(), LN.4()), 50, clevel="Glyphosate") - -## With confidence intervals -maED(S.alba.m1, list(LL.3(), LN.4()), 50, interval="buckland") - -## For comparison model-specific confidence intervals -ED(S.alba.m1, 50, interval="delta") # wider! - -} - -\keyword{models} -\keyword{nonlinear} \ No newline at end of file +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/maED.R +\name{maED} +\alias{maED} +\title{Estimation of ED values using model-averaging} +\usage{ +maED( + object, + fctList = NULL, + respLev = c(10, 20, 50), + interval = c("none", "buckland", "kang"), + linreg = FALSE, + clevel = NULL, + level = 0.95, + type = c("relative", "absolute"), + display = TRUE, + na.rm = FALSE, + extended = FALSE +) +} +\arguments{ +\item{object}{an object of class \code{drc}.} + +\item{fctList}{a list of non-linear functions to be compared.} + +\item{respLev}{a numeric vector containing the response levels.} + +\item{interval}{character string specifying the type of confidence intervals +to be supplied. The default is \code{"none"}. The choices \code{"buckland"} +and \code{"kang"} are explained in the Details section.} + +\item{linreg}{logical indicating whether or not additionally a simple linear +regression model should be fitted.} + +\item{clevel}{character string specifying the curve id in case estimates for +a specific curve or compound are requested. By default estimates are shown +for all curves.} + +\item{level}{numeric. The confidence level. Must be a single value strictly +between 0 and 1. The default is \code{0.95}.} + +\item{type}{character string. Whether the specified response levels are +absolute or relative (default).} + +\item{display}{logical. If \code{TRUE} results are displayed. Otherwise they +are not (useful in simulations).} + +\item{na.rm}{logical indicating whether or not \code{NA} values occurring +during model fitting should be excluded from subsequent calculations.} + +\item{extended}{logical specifying whether or not an extended output +(including fit summaries) should be returned.} +} +\value{ +If \code{extended = FALSE}, a matrix with two or more columns +containing the model-averaged estimates and the corresponding estimated +standard errors and, optionally, lower and upper confidence limits. +If \code{extended = TRUE}, a list with components: +\describe{ +\item{estimates}{Matrix of model-averaged ED estimates and intervals.} +\item{fits}{Matrix of per-model ED estimates and AIC-based weights.} +} +} +\description{ +Estimates and confidence intervals for ED values are estimated using +model-averaging. +} +\details{ +Model-averaging of individual estimates is carried out as described by +Buckland \emph{et al.} (1997) and Kang \emph{et al.} (2000) using +AIC-based weights. The two approaches differ w.r.t. the calculation of +confidence intervals: Buckland \emph{et al.} (1997) provide an approximate +variance formula under the assumption of perfectly correlated estimates +(so, confidence intervals will tend to be too wide). Kang \emph{et al.} +(2000) use the model weights to calculate confidence limits as weighted +means of the confidence limits for the individual fits. +} +\examples{ +## Fitting an example dose-response model +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + +## Model-averaging with default settings (no confidence intervals) +maED( + ryegrass.m1, + list(LL.5(), LN.4(), W1.4(), W2.4(), FPL.4(-1, 1), FPL.4(-2, 3), FPL.4(-0.5, 0.5)), + c(10, 50, 90) +) + +## Model-averaging with Buckland confidence intervals +maED( + ryegrass.m1, + list(LL.5(), LN.4(), W1.4(), W2.4()), + c(10, 50, 90), + interval = "buckland" +) + +## Model-averaging with Kang confidence intervals +maED( + ryegrass.m1, + list(LL.5(), LN.4(), W1.4(), W2.4()), + c(10, 50, 90), + interval = "kang" +) + +} +\references{ +Buckland, S. T. and Burnham, K. P. and Augustin, N. H. (1997) +Model Selection: An Integral Part of Inference, +\emph{Biometrics} \bold{53}, 603--618. + +Kang, Seung-Ho and Kodell, Ralph L. and Chen, James J. (2000) +Incorporating Model Uncertainties along with Data Uncertainties in +Microbial Risk Assessment, +\emph{Regulatory Toxicology and Pharmacology} \bold{32}, 68--72. +} +\seealso{ +The function \code{\link{mselect}} provides a summary of fit +statistics for several models fitted to the same data. +} +\author{ +Christian Ritz, Hannes Reinwald +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/maED_robust.Rd b/man/maED_robust.Rd new file mode 100644 index 00000000..0c8c3a44 --- /dev/null +++ b/man/maED_robust.Rd @@ -0,0 +1,88 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ED_robust.R +\name{maED_robust} +\alias{maED_robust} +\title{Robust Calculation of Model-Averaged Effective Doses} +\usage{ +maED_robust( + mod, + fct_ls = NULL, + respLev = c(10, 20, 50), + interval = "buckland", + CI_level = 0.95, + verbose = FALSE, + ... +) +} +\arguments{ +\item{mod}{A model object of class 'drc', which serves as the base model for +the averaging.} + +\item{fct_ls}{A list of alternative dose-response functions (e.g., \code{LL.3()}, +\code{W1.4()}) to be used in the model averaging process. The list should be +named.} + +\item{respLev}{A numeric vector specifying the response levels (in +percentages) for which to calculate the EDs (e.g., \code{c(10, 50)} for EC10 +and EC50).} + +\item{interval}{A character string specifying the type of confidence interval +to be supplied. The default is "buckland". See \code{drc::maED} for other options.} + +\item{CI_level}{A numeric value between 0 and 1 specifying the confidence +level for the confidence intervals. Default is 0.95.} + +\item{verbose}{A logical value. If \code{TRUE}, the function will print status +messages about the calculation progress and any errors encountered for each +response level. Default is \code{FALSE}.} + +\item{...}{Additional arguments to be passed to the underlying \code{drc::maED} +function.} +} +\value{ +A \code{data.frame} with one row for each response level specified in +\code{respLev}. The columns are: +\item{Estimate}{The estimated model-averaged effective dose.} +\item{stderr}{The standard error of the estimate.} +\item{Lower}{The lower bound of the confidence interval.} +\item{Upper}{The upper bound of the confidence interval.} +\item{confint_level}{The confidence level used for the interval.} +\item{confint_method}{The method used for the confidence interval calculation.} +\item{model}{A character string listing the models used for averaging.} +\item{EC}{The response level (as a percentage).} +If the calculation for a specific response level fails or results in a +non-positive estimate, the corresponding row will contain \code{NA} values for +\code{Estimate}, \code{stderr}, \code{Lower}, and \code{Upper}. +} +\description{ +This function serves as a robust wrapper for \code{drc::maED}. It calculates +model-averaged effective doses (EDs) for specified response levels. The key +feature is its resilience to errors; it iterates through each response level +individually and handles failures gracefully by returning \code{NA} values for that +level, rather than terminating the entire operation. +} +\details{ +The function enhances \code{drc::maED} by introducing a robust calculation loop. +It iterates over each element of \code{respLev} and calls \code{drc::maED} within a +\code{tryCatch} block. This approach isolates failures, preventing an error at one +response level (e.g., an EC99 that cannot be estimated) from halting the +calculation of others. + +Furthermore, after a successful calculation, the function checks if the +resulting 'Estimate' is positive. If the estimate is \code{NA}, non-positive, or +if the \code{tryCatch} block catches an error, the function returns a structured +row of \code{NA}s for that response level, ensuring a consistent output format. +} +\examples{ +data(lettuce) +base_model <- drm(weight ~ conc, data = lettuce, fct = BC.5()) +model_list <- list(W2.4 = W2.4()) +maED_robust(base_model, fct_ls = model_list, respLev = c(10, 50)) + +} +\seealso{ +\code{\link[drc]{maED}} +} +\author{ +Hannes Reinwald +} diff --git a/man/mdra.Rd b/man/mdra.Rd new file mode 100644 index 00000000..54a6fc34 --- /dev/null +++ b/man/mdra.Rd @@ -0,0 +1,32 @@ +\name{mdra} +\alias{mdra} +\docType{data} +\title{3T3 mouse fibroblasts and NRU assay} +\description{ +The toxicity of sodium valproate was tested, using the 3T3 mouse fibroblasts and neutral red uptake (NRU) assay. 22 different experiments were performed independently in six laboratories, using eight concentration levels, each with six replicates on a 96-well plate. In addition, twelve measurements were taken for the solvent control. +} +\usage{data("mdra")} +\format{ + A data frame with 1320 observations on the following 4 variables. + \describe{ + \item{\code{LabID}}{a factor with levels \code{A} \code{B} \code{C} \code{D} \code{E} \code{F}} + \item{\code{ExperimentID}}{a factor with levels \code{1} \code{2} \code{3} \code{4} \code{5} \code{6} \code{7} \code{8} \code{9} \code{10} \code{11} \code{12} \code{13} \code{14} \code{15} \code{16} \code{17} \code{18} \code{19} \code{20} \code{21} \code{22}} + \item{\code{Concentration}}{a numeric vector} + \item{\code{Response}}{a numeric vector} + } +} +\source{ +http://biostatistics.dkfz.de/download/mdra/MDRA_ExampleData.csv +} +\references{ +Clothier, R., Gomez-Lechon, M. J., Kinsner-Ovaskainen, A., Kopp-Schneider, A., O'Connor, J. E., Prieto, P., and Stanzel, S. (2013). Comparative analysis of eight cytotoxicity assays evaluated within the ACuteTox Project. Toxicology in vitro, 27(4):1347--1356. +} +\examples{ +data(mdra) + +## Fit a three-parameter log-logistic model +mdra.m1 <- drm(Response ~ Concentration, data = mdra, fct = LL.3()) +summary(mdra.m1) +plot(mdra.m1, main = "MDRA dose-response") +} +\keyword{datasets} diff --git a/man/mecter.Rd b/man/mecter.Rd new file mode 100644 index 00000000..52968f6d --- /dev/null +++ b/man/mecter.Rd @@ -0,0 +1,81 @@ +\name{mecter} + +\alias{mecter} + +\docType{data} + +\title{Mechlorprop and terbythylazine tested on Lemna minor} + +\description{ + Data consist of 5 mixture, 6 dilutions, three replicates, and 12 common controls; in total 102 onservations. +} + +\usage{data(mecter)} + +\format{ + A data frame with 102 observations on the following 3 variables. + \describe{ + \item{\code{dose}}{a numeric vector of dose values} + \item{\code{pct}}{a numeric vector denoting the grouping according to the mixtures percentages} + \item{\code{rgr}}{a numeric vector of response values (relative growth rates)} + } +} + +\details{ + The dataset is analysed in Soerensen et al (2007). + The asymmetric Voelund model is appropriate, whereas the symmetric Hewlett model is not. +} + +\source{ + The dataset is kindly provided by Nina Cedergreen, Department of Agricultural Sciences, + Royal Veterinary and Agricultural University, Denmark. +} + +\references{ + Soerensen, H. and Cedergreen, N. and Skovgaard, I. M. and Streibig, J. C. (2007) + An isobole-based statistical model and test for synergism/antagonism in binary mixture toxicity experiments, + \emph{Environmental and Ecological Statistics}, \bold{14}, 383--397. +} + +\examples{ +library(drc) + +## Fitting the model with freely varying ED50 values +mecter.free <- drm(rgr ~ dose, pct, data = mecter, +fct = LL.4(), pmodels = list(~1, ~1, ~1, ~factor(pct) - 1)) + +## Lack-of-fit test +modelFit(mecter.free) # not really acceptable +summary(mecter.free) + +## Plotting isobole structure +isobole(mecter.free, exchange = 0.02) + +## Fitting the concentration addition model +mecter.ca <- mixture(mecter.free, model = "CA") + +## Comparing to model with freely varying e parameter +anova(mecter.ca, mecter.free) # rejected + +## Plotting isobole based on concentration addition +isobole(mecter.free, mecter.ca, exchange = 0.02) # poor fit + +## Fitting the Hewlett model +mecter.hew <- mixture(mecter.free, model = "Hewlett") + +## Comparing to model with freely varying e parameter +anova(mecter.hew, mecter.free) # rejected + +## Plotting isobole based on the Hewlett model +isobole(mecter.free, mecter.hew, exchange = 0.02) # poor fit + +## Fitting the Voelund model +mecter.voe<-mixture(mecter.free, model = "Voelund") + +## Comparing to model with freely varying e parameter +anova(mecter.voe, mecter.free) # accepted + +## Plotting isobole based on the Voelund model +isobole(mecter.free, mecter.voe, exchange = 0.02) # good fit +} +\keyword{datasets} diff --git a/man/metals.Rd b/man/metals.Rd new file mode 100644 index 00000000..21b20eee --- /dev/null +++ b/man/metals.Rd @@ -0,0 +1,71 @@ +\name{metals} +\alias{metals} +\docType{data} + +\title{ +Data from heavy metal mixture experiments +} + +\description{ +Data are from a study of the response of the cyanobacterial self-luminescent metallothionein-based whole-cell biosensor Synechoccocus elongatus PCC 7942 pBG2120 to binary mixtures of 6 heavy metals (Zn, Cu, Cd, Ag, Co and Hg). +} + +\usage{data("metals")} +\format{ + A data frame with 543 observations on the following 3 variables. + \describe{ + \item{\code{metal}}{a factor with levels \code{Ag} \code{AgCd} \code{Cd} \code{Co} \code{CoAg} \code{CoCd} \code{Cu} \code{CuAg} \code{CuCd} \code{CuCo} \code{CuHg} \code{CuZn} \code{Hg} \code{HgCd} \code{HgCo} \code{Zn} \code{ZnAg} \code{ZnCd} \code{ZnCo} \code{ZnHg}} + \item{\code{conc}}{a numeric vector of concentrations} + \item{\code{BIF}}{a numeric vector of luminescence induction factors} + } +} + +\details{ +Data are from the study described by Martin-Betancor et al. (2015). +} + +\source{ +Martin-Betancor, K. and Ritz, C. and Fernandez-Pinas, F. and Leganes, F. and Rodea-Palomares, I. (2015) +Defining an additivity framework for mixture research in inducible whole-cell biosensors, +\emph{Scientific Reports} +\bold{17200}.} + +%\references{} + +\examples{ +library(drc) + +## One example from the paper by Martin-Betancor et al (2015) + +## Figure 2 + +## Fitting a model for "Zn" +Zn.lgau <- drm(BIF ~ conc, data = subset(metals, metal == "Zn"), +fct = lgaussian(), bcVal = 0, bcAdd = 10) + +## Plotting data and fitted curve +plot(Zn.lgau, log = "", type = "all", +xlab = expression(paste(plain("Zn")^plain("2+"), " ", mu, "", plain("M")))) + +## Calculating effective doses +ED(Zn.lgau, 50, interval = "delta") +ED(Zn.lgau, -50, interval = "delta", bound = FALSE) +ED(Zn.lgau, 99.999,interval = "delta") # approx. for ED0 + +## Fitting a model for "Cu" +Cu.lgau <- drm(BIF ~ conc, data = subset(metals, metal == "Cu"), +fct = lgaussian()) + +## Fitting a model for the mixture Cu-Zn +CuZn.lgau <- drm(BIF ~ conc, data = subset(metals, metal == "CuZn"), +fct = lgaussian()) + +## Calculating effects needed for the FA-CI plot +CuZn.effects <- CIcompX(0.015, list(CuZn.lgau, Cu.lgau, Zn.lgau), +c(-5, -10, -20, -30, -40, -50, -60, -70, -80, -90, -99, 99, 90, 80, 70, 60, 50, 40, 30, 20, 10)) + +## Reproducing the FA-cI plot shown in Figure 5d +plotFACI(CuZn.effects, "ED", ylim = c(0.8, 1.6), showPoints = TRUE) +} + +\keyword{datasets} diff --git a/man/methionine.Rd b/man/methionine.Rd new file mode 100644 index 00000000..45eb5adc --- /dev/null +++ b/man/methionine.Rd @@ -0,0 +1,55 @@ +%\encoding{latin1} + +\name{methionine} + +\alias{methionine} + +\docType{data} + +\title{Weight gain for different methionine sources} + +\description{ + Data consist of average body weight gain of chickens being treated + with one of the two methionine sources DLM and HMTBA. +} + +\usage{data(methionine)} + +\format{ + A data frame with 9 observations on the following 3 variables: + \describe{ + \item{\code{product}}{a factor with levels \code{control}, \code{DLM} and \code{MHA} denoting the treatments} + \item{\code{dose}}{a numeric vector of methionine dose} + \item{\code{gain}}{a numeric vector of average body weight gain} + } +} + +\details{ + The dataset contains a common control measurement for the two treatments. +} + +\source{ + Kratzer. D. D. and Littell, R. C. (2006) Appropriate Statistical Methods to Compare + Dose Responses of Methionine Sources, \emph{Poultry Science}, \bold{85}, 947--954. +} + +%\references{ +% Schutte, J. B. and de Jong, J. (1996) Biological efficacy of DL-methinonine hydroxy analog free acid compared +% to DL-methionine in broiler chicks as determined by performance and breast meat yield, +% \emph{Agribiol. Res.}, \bold{49}, 74--82. +%} + +\examples{ +library(drc) + +## Fitting model with constraint on one parameter +met.ar.m1 <- drm(gain~dose, product, data = methionine, +fct = AR.3(), pmodels = list(~1, ~factor(product), ~factor(product)), +upperl = c(Inf, Inf, 1700, Inf, Inf)) + +plot(met.ar.m1, xlim=c(0,0.3), ylim=c(1450, 1800)) +abline(h=1700, lty=1) + +summary(met.ar.m1) +} +\keyword{datasets} diff --git a/man/mixture.Rd b/man/mixture.Rd index b61bb5a7..c488b090 100644 --- a/man/mixture.Rd +++ b/man/mixture.Rd @@ -1,49 +1,52 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mixture.R \name{mixture} - \alias{mixture} - \title{Fitting binary mixture models} - -\description{ - 'mixture' fits a concentration addition, Hewlett or Voelund model to data from binary mixture toxicity experiments. -} - \usage{ - mixture(object, model = c("CA", "Hewlett", "Voelund"), start, startm, control = drmc()) +mixture( + object, + model = c("CA", "Hewlett", "Voelund"), + start, + startm, + control = drmc() +) } - \arguments{ - \item{object}{object of class 'drc' corresponding to the model with freely varying EC50 values.} - \item{model}{character string. It can be "CA", "Hewlett" or "Voelund".} - \item{start}{optional numeric vector supplying starting values for all parameters in the mixture model.} - \item{startm}{optional numeric vector supplying the lambda parameter in the Hewlett model or - the eta parameters (two parameters) in the Voelund model.} - \item{control}{list of arguments controlling constrained optimisation (zero as boundary), - maximum number of iteration in the optimisation, - relative tolerance in the optimisation, warnings issued during the optimisation.} -} +\item{object}{object of class 'drc' corresponding to the model with freely varying EC50 values.} -\details{ - The function is a wrapper to \code{\link{drm}}, implementing the models described in Soerensen et al. (2007). - See the paper for a discussion of the merits of the different models. - - Currently only the log-logistic models are available. Application of Box-Cox transformation is not yet available. -} +\item{model}{character string. It can be "CA", "Hewlett" or "Voelund".} + +\item{start}{optional numeric vector supplying starting values for all parameters in the +mixture model.} +\item{startm}{optional numeric vector supplying the lambda parameter in the Hewlett model or +the eta parameters (two parameters) in the Voelund model.} + +\item{control}{list of arguments controlling constrained optimisation (zero as boundary), +maximum number of iteration in the optimisation, relative tolerance in the optimisation, +warnings issued during the optimisation.} +} \value{ - An object of class 'drc' with a few additional components. +An object of class 'drc' with a few additional components. +} +\description{ +\code{mixture} fits a concentration addition, Hewlett or Voelund model to data from binary +mixture toxicity experiments. } +\details{ +The function is a wrapper to \code{\link{drm}}, implementing the models described in +Soerensen et al. (2007). See the paper for a discussion of the merits of the different models. +Currently only the log-logistic models are available. Application of Box-Cox transformation +is not yet available. +} \references{ - Ritz, C. and Streibig, J. C. (2014) - From additivity to synergism - A modelling perspective - \emph{Synergy}, \bold{1}, 22--29. +Ritz, C. and Streibig, J. C. (2014) From additivity to synergism - A +modelling perspective \emph{Synergy}, \bold{1}, 22--29. +} +\author{ +Christian Ritz } - -\author{Christian Ritz} - - -%\examples{} - \keyword{models} \keyword{nonlinear} diff --git a/man/ml3a.Rd b/man/ml3a.Rd new file mode 100644 index 00000000..c80938bf --- /dev/null +++ b/man/ml3a.Rd @@ -0,0 +1,69 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cedergreen.R +\name{ml3a} +\alias{ml3a} +\title{Alias for CRS.4a (Deprecated)} +\usage{ +ml3a(names = c("b", "c", "d", "e", "f"), fixed = c(NA, 0, NA, NA, NA), ...) +} +\arguments{ +\item{names}{A character vector of length 5 specifying the names of the model +parameters in the following order: +\describe{ +\item{\code{b}}{Hill slope (steepness of the dose-response curve).} +\item{\code{c}}{Lower asymptote (fixed at 0 via the \code{fixed} argument).} +\item{\code{d}}{Upper asymptote.} +\item{\code{e}}{Effective dose producing a response midway between \code{c} and \code{d} +(ED50).} +\item{\code{f}}{Hormesis parameter controlling the magnitude of the stimulatory +effect at low doses.} +} +Defaults to \code{c("b", "c", "d", "e", "f")}.} + +\item{fixed}{A numeric vector of length 5 specifying fixed (non-estimated) +parameter values. Use \code{NA} for parameters that should be estimated freely. +Defaults to \code{c(NA, 0, NA, NA, NA)}, which fixes the lower asymptote \code{c} +at 0.} + +\item{...}{Additional arguments passed to \code{\link[=cedergreen]{cedergreen()}}.} +} +\value{ +A list of class \code{"drcMean"} as returned by \code{\link[=cedergreen]{cedergreen()}}, containing +the model definition including the mean function, its gradient, parameter +names, and fixed values. This object is intended for use as the \code{fct} +argument in \code{\link[=drm]{drm()}}. +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} + +This function is a deprecated alias for \code{\link[=CRS.4a]{CRS.4a()}}, itself deprecated as of +version 3.3.0. Please use \code{\link[=CRS.5]{CRS.5()}} instead, which provides a more general +and flexible interface. +} +\examples{ +# NOTE: ml3a() is a deprecated alias for CRS.4a(). Use CRS.5() instead. +# The example below is retained for backward compatibility illustration only. + +lettuce.crsm1 <- drm( lettuce[, c(2, 1)], fct = ml3a() ) +summary(lettuce.crsm1) +ED(lettuce.crsm1, c(50)) + +# Recommended replacement: +fct_spec <- CRS.5(alpha_type = "a", fixed = c(NA, 0, NA, NA, NA)) +lettuce.crs5 <- drm(lettuce[, c(2, 1)], fct = fct_spec) +summary(lettuce.crs5) +ED(lettuce.crs5, c(50)) + +} +\seealso{ +\itemize{ +\item \code{\link[=CRS.5]{CRS.5()}} — the recommended replacement for this deprecated function. +\item \code{\link[=CRS.4a]{CRS.4a()}} — the function this alias points to. +\item \code{\link[=cedergreen]{cedergreen()}} — the underlying model constructor. +} +} +\author{ +Christian Ritz, Hannes Reinwald +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/ml3b.Rd b/man/ml3b.Rd new file mode 100644 index 00000000..aceba28d --- /dev/null +++ b/man/ml3b.Rd @@ -0,0 +1,69 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cedergreen.R +\name{ml3b} +\alias{ml3b} +\title{Alias for CRS.4b (Deprecated)} +\usage{ +ml3b(names = c("b", "c", "d", "e", "f"), fixed = c(NA, 0, NA, NA, NA), ...) +} +\arguments{ +\item{names}{A character vector of length 5 specifying the names of the model +parameters in the following order: +\describe{ +\item{\code{b}}{Hill slope (steepness of the dose-response curve).} +\item{\code{c}}{Lower asymptote (fixed at 0 via the \code{fixed} argument).} +\item{\code{d}}{Upper asymptote.} +\item{\code{e}}{Effective dose producing a response midway between \code{c} and \code{d} +(ED50).} +\item{\code{f}}{Hormesis parameter controlling the magnitude of the stimulatory +effect at low doses.} +} +Defaults to \code{c("b", "c", "d", "e", "f")}.} + +\item{fixed}{A numeric vector of length 5 specifying fixed (non-estimated) +parameter values. Use \code{NA} for parameters that should be estimated freely. +Defaults to \code{c(NA, 0, NA, NA, NA)}, which fixes the lower asymptote \code{c} +at 0.} + +\item{...}{Additional arguments passed to \code{\link[=cedergreen]{cedergreen()}}.} +} +\value{ +A list of class \code{"drcMean"} as returned by \code{\link[=cedergreen]{cedergreen()}}, containing +the model definition including the mean function, its gradient, parameter +names, and fixed values. This object is intended for use as the \code{fct} +argument in \code{\link[=drm]{drm()}}. +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} + +This function is a deprecated alias for \code{\link[=CRS.4b]{CRS.4b()}}, itself deprecated as of +version 3.3.0. Please use \code{\link[=CRS.5]{CRS.5()}} instead, which provides a more general +and flexible interface. +} +\examples{ +# NOTE: ml3b() is a deprecated alias for CRS.4b(). Use CRS.5() instead. +# The example below is retained for backward compatibility illustration only. + +lettuce.crsm2 <- drm( lettuce[, c(2, 1)], fct = ml3b() ) +summary(lettuce.crsm2) +ED(lettuce.crsm2, c(50)) + +# Recommended replacement: +fct_spec <- CRS.5(alpha_type = "b", fixed = c(NA, 0, NA, NA, NA)) +lettuce.crs5 <- drm(lettuce[, c(2, 1)], fct = fct_spec) +summary(lettuce.crs5) +ED(lettuce.crs5, c(50)) + +} +\seealso{ +\itemize{ +\item \code{\link[=CRS.5]{CRS.5()}} — the recommended replacement for this deprecated function. +\item \code{\link[=CRS.4b]{CRS.4b()}} — the function this alias points to. +\item \code{\link[=cedergreen]{cedergreen()}} — the underlying model constructor. +} +} +\author{ +Christian Ritz, Hannes Reinwald +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/ml3c.Rd b/man/ml3c.Rd new file mode 100644 index 00000000..4aa083d0 --- /dev/null +++ b/man/ml3c.Rd @@ -0,0 +1,69 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cedergreen.R +\name{ml3c} +\alias{ml3c} +\title{Alias for CRS.4c (Deprecated)} +\usage{ +ml3c(names = c("b", "c", "d", "e", "f"), fixed = c(NA, 0, NA, NA, NA), ...) +} +\arguments{ +\item{names}{A character vector of length 5 specifying the names of the model +parameters in the following order: +\describe{ +\item{\code{b}}{Hill slope (steepness of the dose-response curve).} +\item{\code{c}}{Lower asymptote (fixed at 0 via the \code{fixed} argument).} +\item{\code{d}}{Upper asymptote.} +\item{\code{e}}{Effective dose producing a response midway between \code{c} and \code{d} +(ED50).} +\item{\code{f}}{Hormesis parameter controlling the magnitude of the stimulatory +effect at low doses.} +} +Defaults to \code{c("b", "c", "d", "e", "f")}.} + +\item{fixed}{A numeric vector of length 5 specifying fixed (non-estimated) +parameter values. Use \code{NA} for parameters that should be estimated freely. +Defaults to \code{c(NA, 0, NA, NA, NA)}, which fixes the lower asymptote \code{c} +at 0.} + +\item{...}{Additional arguments passed to \code{\link[=cedergreen]{cedergreen()}}.} +} +\value{ +A list of class \code{"drcMean"} as returned by \code{\link[=cedergreen]{cedergreen()}}, containing +the model definition including the mean function, its gradient, parameter +names, and fixed values. This object is intended for use as the \code{fct} +argument in \code{\link[=drm]{drm()}}. +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} + +This function is a deprecated alias for \code{\link[=CRS.4c]{CRS.4c()}}, itself deprecated as of +version 3.3.0. Please use \code{\link[=CRS.5]{CRS.5()}} instead, which provides a more general +and flexible interface. +} +\examples{ +# NOTE: ml3c() is a deprecated alias for CRS.4c(). Use CRS.5() instead. +# The example below is retained for backward compatibility illustration only. + +lettuce.crsm3 <- drm( lettuce[, c(2, 1)], fct = ml3c() ) +summary(lettuce.crsm3) +ED(lettuce.crsm3, c(50)) + +# Recommended replacement: +fct_spec <- CRS.5(alpha_type = "c", fixed = c(NA, 0, NA, NA, NA)) +lettuce.crs5 <- drm(lettuce[, c(2, 1)], fct = fct_spec) +summary(lettuce.crs5) +ED(lettuce.crs5, c(50)) + +} +\seealso{ +\itemize{ +\item \code{\link[=CRS.5]{CRS.5()}} — the recommended replacement for this deprecated function. +\item \code{\link[=CRS.4c]{CRS.4c()}} — the function this alias points to. +\item \code{\link[=cedergreen]{cedergreen()}} — the underlying model constructor. +} +} +\author{ +Christian Ritz, Hannes Reinwald +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/ml4a.Rd b/man/ml4a.Rd new file mode 100644 index 00000000..f8b13ec1 --- /dev/null +++ b/man/ml4a.Rd @@ -0,0 +1,68 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cedergreen.R +\name{ml4a} +\alias{ml4a} +\title{Alias for CRS.5a (Deprecated)} +\usage{ +ml4a(names = c("b", "c", "d", "e", "f"), fixed = c(NA, NA, NA, NA, NA), ...) +} +\arguments{ +\item{names}{A character vector of length 5 specifying the names of the model +parameters in the following order: +\describe{ +\item{\code{b}}{Hill slope (steepness of the dose-response curve).} +\item{\code{c}}{Lower asymptote (freely estimated).} +\item{\code{d}}{Upper asymptote.} +\item{\code{e}}{Effective dose producing a response midway between \code{c} and \code{d} +(ED50).} +\item{\code{f}}{Hormesis parameter controlling the magnitude of the stimulatory +effect at low doses.} +} +Defaults to \code{c("b", "c", "d", "e", "f")}.} + +\item{fixed}{A numeric vector of length 5 specifying fixed (non-estimated) +parameter values. Use \code{NA} for parameters that should be estimated freely. +Defaults to \code{c(NA, NA, NA, NA, NA)}, meaning all five parameters are +freely estimated.} + +\item{...}{Additional arguments passed to \code{\link[=cedergreen]{cedergreen()}}.} +} +\value{ +A list of class \code{"drcMean"} as returned by \code{\link[=cedergreen]{cedergreen()}}, containing +the model definition including the mean function, its gradient, parameter +names, and fixed values. This object is intended for use as the \code{fct} +argument in \code{\link[=drm]{drm()}}. +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} + +This function is a deprecated alias for \code{\link[=CRS.5a]{CRS.5a()}}, itself deprecated as of +version 3.3.0. Please use \code{\link[=CRS.5]{CRS.5()}} instead, which provides a more general +and flexible interface. +} +\examples{ +# NOTE: ml4a() is a deprecated alias for CRS.5a(). Use CRS.5() instead. +# The example below is retained for backward compatibility illustration only. + +lettuce.m1 <- drm( lettuce[, c(2, 1)], fct = ml4a() ) +summary(lettuce.m1) +ED(lettuce.m1, c(50)) + +# Recommended replacement: +lettuce.crs5 <- drm( lettuce[, c(2, 1)], fct = CRS.5(alpha_type = "a") ) +summary(lettuce.crs5) +ED(lettuce.crs5, c(50)) + +} +\seealso{ +\itemize{ +\item \code{\link[=CRS.5]{CRS.5()}} — the recommended replacement for this deprecated function. +\item \code{\link[=CRS.5a]{CRS.5a()}} — the function this alias points to. +\item \code{\link[=cedergreen]{cedergreen()}} — the underlying model constructor. +} +} +\author{ +Christian Ritz, Hannes Reinwald +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/ml4b.Rd b/man/ml4b.Rd new file mode 100644 index 00000000..30f1704f --- /dev/null +++ b/man/ml4b.Rd @@ -0,0 +1,68 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cedergreen.R +\name{ml4b} +\alias{ml4b} +\title{Alias for CRS.5b (Deprecated)} +\usage{ +ml4b(names = c("b", "c", "d", "e", "f"), fixed = c(NA, NA, NA, NA, NA), ...) +} +\arguments{ +\item{names}{A character vector of length 5 specifying the names of the model +parameters in the following order: +\describe{ +\item{\code{b}}{Hill slope (steepness of the dose-response curve).} +\item{\code{c}}{Lower asymptote (freely estimated).} +\item{\code{d}}{Upper asymptote.} +\item{\code{e}}{Effective dose producing a response midway between \code{c} and \code{d} +(ED50).} +\item{\code{f}}{Hormesis parameter controlling the magnitude of the stimulatory +effect at low doses.} +} +Defaults to \code{c("b", "c", "d", "e", "f")}.} + +\item{fixed}{A numeric vector of length 5 specifying fixed (non-estimated) +parameter values. Use \code{NA} for parameters that should be estimated freely. +Defaults to \code{c(NA, NA, NA, NA, NA)}, meaning all five parameters are +freely estimated.} + +\item{...}{Additional arguments passed to \code{\link[=cedergreen]{cedergreen()}}.} +} +\value{ +A list of class \code{"drcMean"} as returned by \code{\link[=cedergreen]{cedergreen()}}, containing +the model definition including the mean function, its gradient, parameter +names, and fixed values. This object is intended for use as the \code{fct} +argument in \code{\link[=drm]{drm()}}. +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} + +This function is a deprecated alias for \code{\link[=CRS.5b]{CRS.5b()}}, itself deprecated as of +version 3.3.0. Please use \code{\link[=CRS.5]{CRS.5()}} instead, which provides a more general +and flexible interface. +} +\examples{ +# NOTE: ml4b() is a deprecated alias for CRS.5b(). Use CRS.5() instead. +# The example below is retained for backward compatibility illustration only. + +lettuce.m2 <- drm( lettuce[, c(2, 1)], fct = ml4b() ) +summary(lettuce.m2) +ED(lettuce.m2, c(50)) + +# Recommended replacement: +lettuce.crs5 <- drm( lettuce[, c(2, 1)], fct = CRS.5(alpha_type = "b") ) +summary(lettuce.crs5) +ED(lettuce.crs5, c(50)) + +} +\seealso{ +\itemize{ +\item \code{\link[=CRS.5]{CRS.5()}} — the recommended replacement for this deprecated function. +\item \code{\link[=CRS.5b]{CRS.5b()}} — the function this alias points to. +\item \code{\link[=cedergreen]{cedergreen()}} — the underlying model constructor. +} +} +\author{ +Christian Ritz, Hannes Reinwald +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/ml4c.Rd b/man/ml4c.Rd new file mode 100644 index 00000000..8e77feb9 --- /dev/null +++ b/man/ml4c.Rd @@ -0,0 +1,68 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cedergreen.R +\name{ml4c} +\alias{ml4c} +\title{Alias for CRS.5c (Deprecated)} +\usage{ +ml4c(names = c("b", "c", "d", "e", "f"), fixed = c(NA, NA, NA, NA, NA), ...) +} +\arguments{ +\item{names}{A character vector of length 5 specifying the names of the model +parameters in the following order: +\describe{ +\item{\code{b}}{Hill slope (steepness of the dose-response curve).} +\item{\code{c}}{Lower asymptote (freely estimated).} +\item{\code{d}}{Upper asymptote.} +\item{\code{e}}{Effective dose producing a response midway between \code{c} and \code{d} +(ED50).} +\item{\code{f}}{Hormesis parameter controlling the magnitude of the stimulatory +effect at low doses.} +} +Defaults to \code{c("b", "c", "d", "e", "f")}.} + +\item{fixed}{A numeric vector of length 5 specifying fixed (non-estimated) +parameter values. Use \code{NA} for parameters that should be estimated freely. +Defaults to \code{c(NA, NA, NA, NA, NA)}, meaning all five parameters are +freely estimated.} + +\item{...}{Additional arguments passed to \code{\link[=cedergreen]{cedergreen()}}.} +} +\value{ +A list of class \code{"drcMean"} as returned by \code{\link[=cedergreen]{cedergreen()}}, containing +the model definition including the mean function, its gradient, parameter +names, and fixed values. This object is intended for use as the \code{fct} +argument in \code{\link[=drm]{drm()}}. +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} + +This function is a deprecated alias for \code{\link[=CRS.5c]{CRS.5c()}}, itself deprecated as of +version 3.3.0. Please use \code{\link[=CRS.5]{CRS.5()}} instead, which provides a more general +and flexible interface. +} +\examples{ +# NOTE: ml4c() is a deprecated alias for CRS.5c(). Use CRS.5() instead. +# The example below is retained for backward compatibility illustration only. + +lettuce.m3 <- drm( lettuce[, c(2, 1)], fct = ml4c() ) +summary(lettuce.m3) +ED(lettuce.m3, c(50)) + +# Recommended replacement: +lettuce.crs5 <- drm( lettuce[, c(2, 1)], fct = CRS.5(alpha_type = "c") ) +summary(lettuce.crs5) +ED(lettuce.crs5, c(50)) + +} +\seealso{ +\itemize{ +\item \code{\link[=CRS.5]{CRS.5()}} — the recommended replacement for this deprecated function. +\item \code{\link[=CRS.5c]{CRS.5c()}} — the function this alias points to. +\item \code{\link[=cedergreen]{cedergreen()}} — the underlying model constructor. +} +} +\author{ +Christian Ritz, Hannes Reinwald +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/modelFit.Rd b/man/modelFit.Rd index a605506d..3cf76a26 100644 --- a/man/modelFit.Rd +++ b/man/modelFit.Rd @@ -1,56 +1,49 @@ -\name{modelFit} - -\alias{modelFit} - -\title{Assessing the model fit} - -\description{ - Checking the fit of dose-response model by means of formal significance tests or graphical procedures. -} - -\usage{ - modelFit(object, test = NULL, method = c("gof", "cum")) -} - -\arguments{ - \item{object}{object of class 'drc'} - \item{test}{character string defining the test method to apply} - \item{method}{character string specifying the method to be used for assessing the model fit} -} - -\details{ - Currently two methods are available. For continuous data the clasical lack-of-fit test is applied - (Bates and Watts, 1988). The test compares the dose-response model to a more general ANOVA model - using an approximate F-test. For quantal data the crude goodness-of-fit test based on Pearson's statistic is used. - - None of these tests are very powerful. A significant test result is more alarming than a non-significant one. -} - -\value{ - An object of class 'anova' which will be displayed in much the same way as an ordinary ANOVA table. -} - -\references{ - Bates, D. M. and Watts, D. G. (1988) - \emph{Nonlinear Regression Analysis and Its Applications}, - New York: Wiley \& Sons (pp. 103--104). -} - -\author{Christian Ritz} - -%\note{} - -%\seealso{ ~~objects to See Also as \code{\link{help}}, ~~~ } - -\examples{ - -## Comparing the four-parameter log-logistic model -## to a one-way ANOVA model using an approximate F test -## in other words applying a lack-of-fit test -ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) -modelFit(ryegrass.m1) - -} - -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/modelFit.R +\name{modelFit} +\alias{modelFit} +\title{Assessing the model fit} +\usage{ +modelFit(object, test = NULL, method = c("gof", "cum")) +} +\arguments{ +\item{object}{object of class 'drc'.} + +\item{test}{character string defining the test method to apply.} + +\item{method}{character string specifying the method to be used for assessing the model fit.} +} +\value{ +An object of class 'anova' which will be displayed in much the same way as an +ordinary ANOVA table. +} +\description{ +Checking the fit of a dose-response model by means of formal significance tests. +} +\details{ +Currently two methods are available. For continuous data the classical lack-of-fit test is +applied (Bates and Watts, 1988). The test compares the dose-response model to a more general +ANOVA model using an approximate F-test. For quantal data the crude goodness-of-fit test +based on Pearson's statistic is used. + +None of these tests are very powerful. A significant test result is more alarming than a +non-significant one. +} +\examples{ +## Comparing the four-parameter log-logistic model +## to a one-way ANOVA model using an approximate F test +## in other words applying a lack-of-fit test +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) +modelFit(ryegrass.m1) + +} +\references{ +Bates, D. M. and Watts, D. G. (1988) +\emph{Nonlinear Regression Analysis and Its Applications}, +New York: Wiley & Sons (pp. 103--104). +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/modelFunction.Rd b/man/modelFunction.Rd new file mode 100644 index 00000000..36462b76 --- /dev/null +++ b/man/modelFunction.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/modelFunction.R +\name{modelFunction} +\alias{modelFunction} +\title{Create model evaluation function} +\usage{ +modelFunction( + dose, + parm2mat, + drcFct, + cm, + assayNoOld, + upperPos, + retFct, + doseScaling, + respScaling, + isFinite, + pshifts = NULL +) +} +\description{ +Create model evaluation function +} +\keyword{internal} diff --git a/man/mr.test.Rd b/man/mr.test.Rd index e3dc5e9e..d26fc2cc 100644 --- a/man/mr.test.Rd +++ b/man/mr.test.Rd @@ -1,91 +1,73 @@ -\name{mr.test} - -\Rdversion{1.1} - -\alias{mr.test} - -\title{ - Mizon-Richard test for dose-response models -} - -\description{ - The function provides a lack-of-fit test for the mean structure based on the Mizon-Richard test as compared to a - specific alternative model. -} - -\usage{ -mr.test(object1, object2, object, x, var.equal = TRUE, component = 1) -} - -\arguments{ - \item{object1}{ - object of class 'drc' (null model). -} - \item{object2}{ - object of class 'drc' (alternative model). -} - \item{object}{ - object of class 'drc' (fitted model under alternative). -} - \item{x}{ - numeric vector of dose values. -} - \item{var.equal}{ - logical indicating whether or not equal variances can be assumed across doses. -} - \item{component}{ - numeric vector specifying the component(s) in the parameter vector to use in the test. -} -} - -\details{ - The function provides a p-value indicating whether or not the mean structure is appropriate. - - The test is applicable even in cases where data are non-normal or exhibit variance heterogeneity. -} - -\value{ - A p-value for test of the null hypothesis that the chosen mean structure is appropriate as compared - to the alternative mean structure provided (see Ritz and Martinussen (2011) for a detailed explanation). -} - -\references{ - - Ritz, C and Martinussen, T. (2011) - Lack-of-fit tests for assessing mean structures for continuous dose-response data, - \emph{Environmental and Ecological Statistics}, \bold{18}, 349--366 -} - -\author{ - Christian Ritz -} - -\note{ - This functionality is still experimental: Currently, the null and alternative models are hardcoded! - In the future the function will be working for null and alternative models specified by the user. -} - -\seealso{ - See also \code{\link{modelFit}} for details on the related lack-of-fit test against an ANOVA model. -} -\examples{ - -## Fitting log-logistic and Weibull models -## The Weibull model is the alternative -etmotc.m1<-drm(rgr1~dose1, data=etmotc[1:15,], fct=LL.4()) -etmotc.m2 <- update(etmotc.m1, fct=W1.4()) - -## Fitting the fitted model (using the alternative model) -etmotc.m3 <- drm(fitted(etmotc.m1)~dose1, data=etmotc[1:15,], fct=W1.4()) - -## Handling missing values -xVec <- etmotc[1:15,]$dose1 -xVec[1:8] <- 1e-10 # avoiding 0's - -## Obtaining the Mizon-Richard test -mr.test(etmotc.m1, etmotc.m2, etmotc.m3, xVec, var.equal = FALSE) - -} - -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mr.test.R +\name{mr.test} +\alias{mr.test} +\title{Mizon-Richard test for dose-response models} +\usage{ +mr.test(object1, object2, object, x, var.equal = TRUE, component = 1) +} +\arguments{ +\item{object1}{object of class 'drc' (null model).} + +\item{object2}{object of class 'drc' (alternative model).} + +\item{object}{object of class 'drc' (fitted model under alternative).} + +\item{x}{numeric vector of dose values.} + +\item{var.equal}{logical indicating whether or not equal variances can be assumed across doses.} + +\item{component}{numeric vector specifying the component(s) in the parameter vector to use +in the test.} +} +\value{ +A p-value for test of the null hypothesis that the chosen mean structure is +appropriate as compared to the alternative mean structure provided (see Ritz and +Martinussen (2011) for a detailed explanation). +} +\description{ +The function provides a lack-of-fit test for the mean structure based on the +Mizon-Richard test as compared to a specific alternative model. +} +\details{ +The function provides a p-value indicating whether or not the mean structure is appropriate. + +The test is applicable even in cases where data are non-normal or exhibit variance +heterogeneity. +} +\note{ +This functionality is still experimental: Currently, the null and alternative models +are hardcoded! In the future the function will be working for null and alternative models +specified by the user. +} +\examples{ +## Fitting log-logistic and Weibull models +## The Weibull model is the alternative +etmotc.m1<-drm(rgr1~dose1, data=etmotc[1:15,], fct=LL.4()) +etmotc.m2 <- update(etmotc.m1, fct=W1.4()) + +## Fitting the fitted model (using the alternative model) +etmotc.m3 <- drm(fitted(etmotc.m1)~dose1, data=etmotc[1:15,], fct=W1.4()) + +## Handling missing values +xVec <- etmotc[1:15,]$dose1 +xVec[1:8] <- 1e-10 # avoiding 0's + +## Obtaining the Mizon-Richard test +mr.test(etmotc.m1, etmotc.m2, etmotc.m3, xVec, var.equal = FALSE) + +} +\references{ +Ritz, C and Martinussen, T. (2011) Lack-of-fit tests for assessing mean +structures for continuous dose-response data, \emph{Environmental and Ecological +Statistics}, \bold{18}, 349--366 +} +\seealso{ +See also \code{\link{modelFit}} for details on the related lack-of-fit test +against an ANOVA model. +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/mselect.Rd b/man/mselect.Rd index b0902f74..d9fc727e 100644 --- a/man/mselect.Rd +++ b/man/mselect.Rd @@ -1,77 +1,68 @@ -\name{mselect} - -\alias{mselect} - -\title{Dose-response model selection} - -\description{ - Model selection by comparison of different models using the following criteria: the log likelihood value, - Akaike's information criterion (AIC), the estimated residual standard error - or the p-value from a lack-of-fit test. -} - -\usage{ - mselect(object, fctList = NULL, nested = FALSE, - sorted = c("IC", "Res var", "Lack of fit", "no"), linreg = FALSE, icfct = AIC) -} - -\arguments{ - \item{object}{an object of class 'drc'.} - \item{fctList}{a list of dose-response functions to be compared.} - \item{nested}{logical. TRUE results in F tests between adjacent models (in 'fctList'). - Only sensible for nested models.} - \item{sorted}{character string determining according to which criterion the model fits are ranked.} - \item{linreg}{logical indicating whether or not additionally polynomial regression models (linear, quadratic, and cubic models) - should be fitted (they could be useful for a kind of informal lack-of-test consideration for the models specified, - capturing unexpected departures).} - \item{icfct}{function for supplying the information criterion to be used. \code{\link{AIC}} and \code{\link{BIC}} are two options.} -} - -\details{ - For Akaike's information criterion and the residual standard error: the smaller the better and - for lack-of-fit test (against a one-way ANOVA model): the larger (the p-value) the better. Note that the residual standard error is only available for - continuous dose-response data. - - Log likelihood values cannot be used for comparison unless the models are nested. - -} - -\value{ - A matrix with one row for each model and one column for each criterion. -} - -%\references{} - -\author{Christian Ritz} - -%\note{} - -%\seealso{} - -\examples{ - -### Example with continuous/quantitative data -## Fitting initial four-parameter log-logistic model -ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) - -## Model selection -mselect(ryegrass.m1, list(LL.3(), LL.5(), W1.3(), W1.4(), W2.4(), baro5())) - -## Model selection including linear, quadratic, and cubic regression models -mselect(ryegrass.m1, list(LL.3(), LL.5(), W1.3(), W1.4(), W2.4(), baro5()), linreg = TRUE) - -## Comparing nested models -mselect(ryegrass.m1, list(LL.5()), nested = TRUE) - -### Example with quantal data -## Fitting initial two-parameter log-logistic model -earthworms.m1 <- drm(number/total~dose, weights=total, -data = earthworms, fct = LL.2(), type = "binomial") - -## Comparing 4 models -mselect(earthworms.m1, list(W1.2(), W2.2(), LL.3())) - - -} -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mselect.R +\name{mselect} +\alias{mselect} +\title{Dose-response model selection} +\usage{ +mselect( + object, + fctList = NULL, + nested = FALSE, + sorted = c("IC", "Res var", "Lack of fit", "no"), + linreg = FALSE, + icfct = AIC +) +} +\arguments{ +\item{object}{an object of class 'drc'.} + +\item{fctList}{a list of dose-response functions to be compared.} + +\item{nested}{logical. TRUE results in F tests between adjacent models (in \code{fctList}). +Only sensible for nested models.} + +\item{sorted}{character string determining according to which criterion the model fits +are ranked.} + +\item{linreg}{logical indicating whether or not additionally polynomial regression models +(linear, quadratic, and cubic models) should be fitted.} + +\item{icfct}{function for supplying the information criterion to be used. +\code{\link{AIC}} and \code{\link{BIC}} are two options.} +} +\value{ +A matrix with one row for each model and one column for each criterion. +} +\description{ +Model selection by comparison of different models using the following criteria: the log +likelihood value, Akaike's information criterion (AIC), the estimated residual standard +error or the p-value from a lack-of-fit test. +} +\details{ +For Akaike's information criterion and the residual standard error: the smaller the better +and for lack-of-fit test (against a one-way ANOVA model): the larger (the p-value) the +better. Note that the residual standard error is only available for continuous dose-response +data. + +Log likelihood values cannot be used for comparison unless the models are nested. +} +\examples{ +### Example with continuous/quantitative data +## Fitting initial four-parameter log-logistic model +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + +## Model selection +mselect(ryegrass.m1, list(LL.3(), LL.5(), W1.3(), W1.4(), W2.4(), baro5())) + +## Model selection including linear, quadratic, and cubic regression models +mselect(ryegrass.m1, list(LL.3(), LL.5(), W1.3(), W1.4(), W2.4(), baro5()), linreg = TRUE) + +## Comparing nested models +mselect(ryegrass.m1, list(LL.5()), nested = TRUE) + +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/multi2.Rd b/man/multi2.Rd index d6596571..5089e5cb 100644 --- a/man/multi2.Rd +++ b/man/multi2.Rd @@ -1,63 +1,52 @@ -\name{multi2} - -\alias{multi2} - -\title{ - Multistage dose-response model with quadratic terms -} - -\description{ - The multistage dose-response model is a combination of log-logistic models that should be useful for describing - more complex dose-response patterns. -} - -\usage{ - multi2( - fixed = c(NA, NA, NA, NA, NA), - names = c("b1", "b2", "b3", "c", "d"), - ssfct = NULL, - fctName, - fctText) -} - -\arguments{ - \item{fixed}{numeric vector specifying which parameters are fixed and at what value they are fixed. - NAs are used for parameters that are not fixed.} - \item{names}{a vector of character strings giving the names of the parameters (should not contain ":"). - The default is reasonable (see under 'Usage').} - \item{ssfct}{a self starter function to be used.} - \item{fctName}{optional character string used internally by convenience functions.} - \item{fctText}{optional character string used internally by convenience functions.} -} - -\details{ - The multistage model function with quadratic terms is defined as follows - - \deqn{ f(x) = c + (d-c)\exp(-b1-b2x-b3x^2)} - - where x denotes the dose or the logarithm-transformed dose. -} - -\value{ - The value returned is a list containing the nonlinear function, the self starter function - and the parameter names. -} - -\references{ - Wheeler, M. W., Bailer, A. J. (2009) - Comparing model averaging with other model selection strategies for benchmark dose estimation, - \emph{Environmental and Ecological Statistics}, \bold{16}, 37--51. -} - -\author{ - Christian Ritz -} - -%\note{} - -%\seealso{} - -%\examples{} - -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/multi2.R +\name{multi2} +\alias{multi2} +\title{Multistage Dose-Response Model with Quadratic Terms} +\usage{ +multi2( + fixed = c(NA, NA, NA, NA, NA), + names = c("b1", "b2", "b3", "c", "d"), + ssfct = NULL, + fctName, + fctText +) +} +\arguments{ +\item{fixed}{numeric vector specifying which parameters are fixed and at what value +they are fixed. NAs are used for parameters that are not fixed.} + +\item{names}{a vector of character strings giving the names of the parameters +(should not contain ":"). The default is reasonable.} + +\item{ssfct}{a self starter function to be used.} + +\item{fctName}{optional character string used internally by convenience functions.} + +\item{fctText}{optional character string used internally by convenience functions.} +} +\value{ +A list containing the nonlinear function, the self starter function, +and the parameter names. +} +\description{ +A five-parameter multistage dose-response model useful for describing more complex +dose-response patterns. +} +\details{ +The multistage model function with quadratic terms is: + +\deqn{f(x) = c + (d-c)\exp(-b1 - b2 x - b3 x^2)} + +where x denotes the dose or the logarithm-transformed dose. +} +\references{ +Wheeler, M. W., Bailer, A. J. (2009) +Comparing model averaging with other model selection strategies for benchmark +dose estimation, \emph{Environmental and Ecological Statistics}, \bold{16}, 37--51. +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/nasturtium.Rd b/man/nasturtium.Rd new file mode 100644 index 00000000..8624e844 --- /dev/null +++ b/man/nasturtium.Rd @@ -0,0 +1,49 @@ +\name{nasturtium} + +\alias{nasturtium} + +\docType{data} + +\title{Dose-response profile of degradation of agrochemical using nasturtium} + +\description{ + Estimation of the degradation profile of an agrochemical based on soil samples at depth 0-10cm + from a calibration experiment. +} + +\usage{data(nasturtium)} + +\format{ + A data frame with 42 observations on the following 2 variables. + \describe{ + \item{\code{conc}}{a numeric vector of concentrations (g/ha)} + \item{\code{wt}}{a numeric vector of plant weight (mg) after 3 weeks' growth} + \item{\code{rep}}{a numeric vector of replicates} + } +} + +\details{ + It is an experiment with seven concentrations and six replicates per concentration. \emph{Nasturtium} + is sensitive and its weight reduces noticeable at low concentrations. + + Racine-Poon (1988) suggests using a three-parameter log-logistic model. +} + +\source{ + Racine-Poon, A. (1988) A Bayesian Approach to Nonlinear Calibration Problems, + \emph{J. Am. Statist. Ass.}, \bold{83}, 650--656. +} + +%\references{} + +\examples{ +library(drc) + +nasturtium.m1 <- drm(wt~conc, data=nasturtium, fct = LL.3()) + +modelFit(nasturtium.m1) + +plot(nasturtium.m1, type = "all", log = "", xlab = "Concentration (g/ha)", ylab = "Weight (mg)") +} + +\keyword{datasets} diff --git a/man/neill.test.Rd b/man/neill.test.Rd index 68f0c3fe..170ccf51 100644 --- a/man/neill.test.Rd +++ b/man/neill.test.Rd @@ -1,83 +1,75 @@ -\name{neill.test} - -\alias{neill.test} - -\title{ - Neill's lack-of-fit test for dose-response models -} - -\description{ - 'neill.test' provides a lack-of-fit test for non-linear regression models. It is applicable both in cases - where there are replicates (in which case it reduces to the standard lack-of-fit test against an ANOVA - model) and in cases where there are no replicates, though then a grouping has to be provided. -} - -\usage{ - neill.test(object, grouping, method = c("c-finest", "finest", "percentiles"), - breakp = NULL, display = TRUE) -} - -\arguments{ - \item{object}{ - object of class 'drc' or 'nls'. -} - \item{grouping}{ - character or numeric vector that provides the grouping of the dose values. -} - \item{method}{ - character string specifying the method to be used to generate a grouping of the dose values. -} - \item{breakp}{ - numeric vector of break points for generating dose intervals that form a grouping. -} - \item{display}{ - logical. If TRUE results are displayed. Otherwise they are not (useful in simulations). -} -} - -\details{ - The functions used the methods \code{\link{df.residual}} and \code{\link{residuals}} and the 'data' - component of \code{object} (only for determining the number of observations). -} - -\value{ - The function returns an object of class anova which is displayed using \code{print.anova}. -} - -\references{ - Neill, J. W. (1988) Testing for lack of fit in nonlinear regression, - \emph{Ann. Statist.}, \bold{16}, 733--740 -} - -\author{Christian Ritz} - -\note{ - A clustering technique could be employed to determine the grouping to be used in cases where there are - no replicates. There should at most be ceiling(n/2) clusters as otherwise some observations will not be used - in the test. At the other end there need to be more clusters than parameters in the model. -} - -\seealso{ - See also \code{\link{modelFit}} for details on the lack-of-fit test against an ANOVA model.} - -\examples{ - -### Example with 'drc' object - -## Lack-of-fit test against ANOVA -ryegrass.m1 <-drm(rootl~conc, data = ryegrass, fct = LL.4()) -modelFit(ryegrass.m1) - -## The same test using 'neill.test' -neill.test(ryegrass.m1, ryegrass$conc) - -## Generating a grouping -neill.test(ryegrass.m1, method="c-finest") -neill.test(ryegrass.m1, method="finest") -neill.test(ryegrass.m1, method="perc") - - -} - -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/neill.test.R +\name{neill.test} +\alias{neill.test} +\title{Neill's lack-of-fit test for dose-response models} +\usage{ +neill.test( + object, + grouping, + method = c("c-finest", "finest", "percentiles"), + breakp = NULL, + display = TRUE +) +} +\arguments{ +\item{object}{object of class 'drc' or 'nls'.} + +\item{grouping}{character or numeric vector that provides the grouping of the dose values.} + +\item{method}{character string specifying the method to be used to generate a grouping +of the dose values.} + +\item{breakp}{numeric vector of break points for generating dose intervals that form a grouping.} + +\item{display}{logical. If TRUE results are displayed. Otherwise they are not (useful in simulations).} +} +\value{ +The function returns an object of class anova which is displayed using +\code{print.anova}. +} +\description{ +\code{neill.test} provides a lack-of-fit test for non-linear regression models. It is +applicable both in cases where there are replicates (in which case it reduces to the +standard lack-of-fit test against an ANOVA model) and in cases where there are no +replicates, though then a grouping has to be provided. +} +\details{ +The functions use the methods \code{\link{df.residual}} and \code{\link{residuals}} and +the \code{data} component of \code{object} (only for determining the number of observations). +} +\note{ +A clustering technique could be employed to determine the grouping to be used in cases +where there are no replicates. There should at most be ceiling(n/2) clusters as otherwise +some observations will not be used in the test. At the other end there need to be more +clusters than parameters in the model. +} +\examples{ +### Example with 'drc' object + +## Lack-of-fit test against ANOVA +ryegrass.m1 <-drm(rootl~conc, data = ryegrass, fct = LL.4()) +modelFit(ryegrass.m1) + +## The same test using 'neill.test' +neill.test(ryegrass.m1, ryegrass$conc) + +## Generating a grouping +neill.test(ryegrass.m1, method="c-finest") +neill.test(ryegrass.m1, method="finest") +neill.test(ryegrass.m1, method="perc") + +} +\references{ +Neill, J. W. (1988) Testing for lack of fit in nonlinear regression, +\emph{Ann. Statist.}, \bold{16}, 733--740 +} +\seealso{ +See also \code{\link{modelFit}} for details on the lack-of-fit test against an +ANOVA model. +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/nfa.Rd b/man/nfa.Rd new file mode 100644 index 00000000..9342f1f4 --- /dev/null +++ b/man/nfa.Rd @@ -0,0 +1,35 @@ +\name{nfa} +\alias{nfa} +\docType{data} +\title{Network Formation Assay Data} +\description{Neurotoxicity test using a network formation assay studying + the inhibition of network formation at acrylamide exposure.} +\usage{data(nfa)} +\format{ + A data frame with 45 observations on the following 4 variables. + \describe{ + \item{\code{chip}}{chip ID} + \item{\code{conc}}{7 concentrations of acrylamide, ranging from + 0-5mM} + \item{\code{experiment}}{factor with levels 1 or 2 denoting two + consecutive experiments} + \item{\code{response}}{Number of connections [\%]} + } +} +\references{ + Frimat, JP, Sisnaiske, J, Subbiah, S, Menne, H, Godoy, P, Lampen, P, + Leist, M, Franzke, J, Hengstler, JG, van Thriel, C, West, J. The + network formation assay: a spatially standardized neurite outgrowth + analytical display for neurotoxicity screening. Lab Chip 2010; 10:701-709. +} + +\examples{ +data(nfa) + +## Fit a four-parameter log-logistic model +nfa.m1 <- drm(response ~ conc, data = nfa, fct = LL.4()) +summary(nfa.m1) +plot(nfa.m1, main = "NFA dose-response") +} + +\keyword{datasets} diff --git a/man/nicotine.Rd b/man/nicotine.Rd new file mode 100644 index 00000000..ab52079c --- /dev/null +++ b/man/nicotine.Rd @@ -0,0 +1,36 @@ +\name{nicotine} + +\alias{nicotine} + +\docType{data} + +\title{nicotine} + +\description{Data from an acute toxicity test with nicotine. For each of several concentrations, the total number of subjects and the number of dead subjects were recorded.} + +\usage{data(nicotine)} + +\format{ + A data frame with 12 observations on the following 3 variables. + \describe{ + \item{\code{conc}}{a numeric vector} + \item{\code{total}}{a numeric vector} + \item{\code{num.dead}}{a numeric vector} + } +} + +\examples{ +library(drc) + +## Displaying the data +head(nicotine) + +## Fitting a two-parameter log-logistic model for binomial response +nicotine.m1 <- drm(num.dead/total ~ conc, weights = total, +data = nicotine, fct = LL.2(), type = "binomial") +summary(nicotine.m1) + +## Plotting the fitted curve +plot(nicotine.m1, xlab = "Concentration", ylab = "Proportion dead", ylim = c(0, 1)) +} +\keyword{datasets} diff --git a/man/noEffect.Rd b/man/noEffect.Rd index fe54df0d..30fcaacd 100644 --- a/man/noEffect.Rd +++ b/man/noEffect.Rd @@ -1,49 +1,35 @@ -\name{noEffect} - -\alias{noEffect} - -\title{ - Testing if there is a dose effect at all -} - -\description{ - A significance test is provided for the comparison of the dose-response model considered and the simple linear regression - model with slope 0 (a horizontal regression line corresponding to no dose effect) -} - -\usage{ -noEffect(object) -} - -\arguments{ - \item{object}{an object of class 'drc'.} -} - -\details{ - Perhaps useful for screening purposes. -} - -\value{ - The likelihood ratio test statistic and the corresponding degrees of freedom and p-value are reported. -} - -%\references{ -%} - -\author{Christian Ritz} - -%\note{ -%} - -\examples{ - -ryegrass.LL.4 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) - -noEffect(ryegrass.LL.4) -# p-value < 0.0001: there is a highly significant dose effect! - -} - -\keyword{models} -\keyword{nonlinear} - +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/noEffect.R +\name{noEffect} +\alias{noEffect} +\title{Testing if there is a dose effect at all} +\usage{ +noEffect(object) +} +\arguments{ +\item{object}{an object of class 'drc'.} +} +\value{ +The likelihood ratio test statistic and the corresponding degrees of freedom +and p-value are reported. +} +\description{ +A significance test is provided for the comparison of the dose-response model considered +and the simple linear regression model with slope 0 (a horizontal regression line +corresponding to no dose effect). +} +\details{ +Perhaps useful for screening purposes. +} +\examples{ +ryegrass.LL.4 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + +noEffect(ryegrass.LL.4) +# p-value < 0.0001: there is a highly significant dose effect! + +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/pickParm.Rd b/man/pickParm.Rd new file mode 100644 index 00000000..fe85a73f --- /dev/null +++ b/man/pickParm.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/pickParm.R +\name{pickParm} +\alias{pickParm} +\title{Pick parameters from model} +\usage{ +pickParm(parmVec, indexVec, parmNo) +} +\description{ +Pick parameters from model +} +\keyword{internal} diff --git a/man/plot.drc.Rd b/man/plot.drc.Rd index 0435ade9..6cd5d416 100644 --- a/man/plot.drc.Rd +++ b/man/plot.drc.Rd @@ -1,193 +1,218 @@ -\name{plot.drc} - -\alias{plot.drc} - -\title{Plotting fitted dose-response curves} - -\description{ - \code{plot} displays fitted curves and observations in the same plot window, - distinguishing between curves by different plot symbols and line types. -} - -\usage{ - - \method{plot}{drc}(x, ..., add = FALSE, level = NULL, - type = c("average", "all", "bars", "none", "obs", "confidence"), - broken = FALSE, bp, bcontrol = NULL, conName = NULL, axes = TRUE, - gridsize = 100, log = "x", xtsty, xttrim = TRUE, - xt = NULL, xtlab = NULL, xlab, xlim, - yt = NULL, ytlab = NULL, ylab, ylim, - cex, cex.axis = 1, col = FALSE, lty, pch, - legend, legendText, legendPos, cex.legend = 1, - normal = FALSE, normRef = 1, confidence.level = 0.95) -} - -\arguments{ - \item{x}{an object of class 'drc'.} - \item{...}{additional graphical arguments. For instance, use \code{lwd=2} or \code{lwd=3} to increase the width of plot symbols.} - \item{add}{logical. If TRUE then add to already existing plot.} - \item{level}{vector of character strings. To plot only the curves specified by their names.} - \item{type}{a character string specifying how to plot the data. There are currently - 5 options: "average" (averages and fitted curve(s); default), - "none" (only the fitted curve(s)), "obs" (only the data points), - "all" (all data points and fitted curve(s)), - "bars" (averages and fitted curve(s) with model-based standard errors (see Details)), and - "confidence" (confidence bands for fitted curve(s)).} - \item{broken}{logical. If TRUE the x axis is broken provided this axis is logarithmic - (using functionality in the CRAN package 'plotrix').} - \item{bp}{numeric value specifying the break point below which the dose is zero (the amount of stretching on - the dose axis above zero in order to create the visual illusion of a logarithmic scale \emph{including} 0). - The default is the base-10 value corresponding to the rounded value of the minimum of the log10 values of - all positive dose values. This argument is only working for logarithmic dose axes.} - \item{bcontrol}{a list with components \code{factor}, \code{style} and \code{width}. - Controlling the appearance of the break (in case \code{broken} is \code{TRUE}). - The component \code{factor} is the distance from the control to the break as a - multiple of the value of \code{bp} (default is 2). - The component \code{style} can take the values: \code{gap}, \code{slash} or \code{zigzag}. - The component \code{width} is the width of the break symbol (default is 0.02).} - \item{conName}{character string. Name on x axis for dose zero. Default is '"0"'.} - \item{axes}{logical indicating whether both axes should be drawn on the plot.} - \item{gridsize}{numeric. Number of points in the grid used for plotting the fitted curves.} - \item{log}{a character string which contains '"x"' if the x axis is to be logarithmic, '"y"' if the y axis is to be logarithmic and '"xy"' or - '"yx"' if both axes are to be logarithmic. The default is "x". The empty string "" yields the original axes.} - \item{xtsty}{a character string specifying the dose axis style for arrangement of tick marks. By default ("base10") - For a logarithmic axis by default only base 10 tick marks are shown ("base10"). Otherwise sensible - equidistantly located tick marks are shown ("standard"), relying on \code{\link{axTicks}}.} - \item{xttrim}{logical specifying if the number of tick marks should be trimmed in case too many tick marks - are initially determined.} - \item{xt}{a numeric vector containing the positions of the tick marks on the x axis.} - \item{xtlab}{a vector containing the tick marks on the x axis.} - \item{xlab}{an optional label for the x axis.} - \item{xlim}{a numeric vector of length two, containing the lower and upper limit for the x axis.} - \item{yt}{a numeric vector, containing the positions of the tick marks on the y axis.} - \item{ytlab}{a vector containing the tick marks on the y axis.} - \item{ylab}{an optional label for the y axis.} - \item{ylim}{a numeric vector of length two, containing the lower and upper limit for the y axis.} - \item{cex}{numeric or numeric vector specifying the size of plotting symbols and text - (see \code{\link{par}} for details).} - \item{cex.axis}{numeric value specifying the magnification to be used for axis annotation - relative to the current setting of cex.} - \item{col}{either logical or a vector of colours. If TRUE default colours are used. - If FALSE (default) no colours are used.} - \item{legend}{logical. If TRUE a legend is displayed.} - \item{legendText}{a character string or vector of character strings specifying the legend text - (the position of the upper right corner of the legend box).} - \item{legendPos}{numeric vector of length 2 giving the position of the legend.} - \item{cex.legend}{numeric specifying the legend text size.} - \item{lty}{a numeric vector specifying the line types.} - \item{pch}{a vector of plotting characters or symbols (see \code{\link{points}}).} - \item{normal}{logical. If TRUE the plot of the normalized data and fitted curves are shown - (for details see Weimer et al. (2012) for details).} - \item{normRef}{numeric specifying the reference for the normalization (default is 1).} - \item{confidence.level}{confidence level for error bars. Defaults to 0.95.} -} - -\details{ - The use of \code{xlim} allows changing the range of the x axis, extrapolating the fitted dose-response curves. - Note that changing the range on the x axis may also entail a change of the range on the y axis. Sometimes - it may be useful to extend the upper limit on the y axis (using \code{ylim}) in order to fit a legend into - the plot. - - See \code{\link{colors}} for the available colours. - - Suitable labels are automatically provided. - - The arguments \code{broken} and \code{bcontrol} rely on the function - \code{link{axis.break}} with arguments - \code{style} and \code{brw} in the package \code{plotrix}. - - The model-based standard errors used for the error bars are calculated - as the fitted value plus/minus the estimated error times the - 1-(alpha/2) quantile in the t distribution with degrees of freedom - equal to the residual degrees of freedom for the model (or using a - standard normal distribution in case of binomial and poisson data), - where alpha=1-confidence.level. The standard errors are obtained using - the predict method with the arguments interval = "confidence" - and level=confidence.level. -} - -\value{ - An invisible data frame with the values used for plotting the fitted curves. The first column contains the dose values, -and the following columns (one for each curve) contain the fitted response values. -} - -\author{ - Christian Ritz and Jens C. Streibig. Contributions from Xiaoyan Wang and Greg Warnes. -} - -\references{ - Weimer, M., Jiang, X., Ponta, O., Stanzel, S., Freyberger, A., Kopp-Schneider, A. (2012) - The impact of data transformations on concentration-response modeling. - \emph{Toxicology Letters}, \bold{213}, 292--298. -} - -%\note{ ~~further notes~~ } - -%\seealso{\code{\link{plotraw}} plots the observations only.} - -\examples{ - -## Fitting models to be plotted below -ryegrass.m1 <- drm(rootl~conc, data = ryegrass, fct = LL.4()) -ryegrass.m2 <- drm(rootl~conc, data = ryegrass, fct = LL.3()) # lower limit fixed at 0 - -## Plotting observations and fitted curve for the first model -plot(ryegrass.m1, broken = TRUE) - -## Adding fitted curve for the second model (not much difference) -plot(ryegrass.m2, broken = TRUE, add = TRUE, type = "none", col = 2, lty = 2) - -## Add confidence region for the first model. -plot(ryegrass.m1, broken = TRUE, type="confidence", add=TRUE) - -## Finetuning the axis break -plot(ryegrass.m1, broken = TRUE, bcontrol = list(style = "gap")) -plot(ryegrass.m1, broken = TRUE, bcontrol = list(style = "slash")) -plot(ryegrass.m1, broken = TRUE, bcontrol = list(style = "zigzag")) - -## Plot without axes -plot(ryegrass.m1, axes = FALSE) - -## Fitting model to be plotted below -spinach.m1 <- drm(SLOPE~DOSE, CURVE, data = spinach, fct = LL.4()) - -## Plot with no colours -plot(spinach.m1, main = "Different line types (default)") - -## Plot with default colours -plot(spinach.m1, col = TRUE, main = "Default colours") - -## Plot with specified colours -plot(spinach.m1, col = c(2,6,3,23,56), main = "User-specified colours") - -## Plot of curves 1 and 2 only -plot(spinach.m1, level = c(1,2), main = "User-specified curves") - -## Plot with symbol of different sizes -plot(spinach.m1, cex = c(1,2,3,4,5), main = "User-specified symbil sizes") - -## Plot with confidence regions -plot(spinach.m1, col = TRUE, main = "Confidence Regions", type = "confidence") - -## Add points -plot(spinach.m1, col = TRUE, add=TRUE) - -## Fitting another model to be plotted below -lettuce.m1 <- drm(weight~conc, data = lettuce, fct = LL.4()) - -## Using the argument 'bp'. Compare the plots! -par(mfrow = c(2, 2)) -plot(lettuce.m1, main = "bp = default") # using the default -plot(lettuce.m1, bp = 1e-4, main = "bp = 1e-4") -plot(lettuce.m1, bp = 1e-6, main = "bp = 1e-6") -plot(lettuce.m1, bp = 1e-8, main = "bp = 1e-8") -par(mfrow = c(1,1)) - -## User-specified position of legend -S.alba.m1 <- drm(DryMatter~Dose, Herbicide, data = S.alba, fct = LL.4()) - -plot(S.alba.m1) -plot(S.alba.m1, legendPos = c(0.3, 4.8)) - -} -\keyword{aplot} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot.drc.R +\name{plot.drc} +\alias{plot.drc} +\title{Plotting fitted dose-response curves} +\usage{ +\method{plot}{drc}( + x, + ..., + add = FALSE, + level = NULL, + type = c("average", "all", "bars", "none", "obs", "confidence"), + broken = FALSE, + bp, + bcontrol = NULL, + conName = NULL, + axes = TRUE, + gridsize = 100, + log = "x", + xtsty, + xttrim = TRUE, + xt = NULL, + xtlab = NULL, + xlab, + xlim, + yt = NULL, + ytlab = NULL, + ylab, + ylim, + cex, + cex.axis = 1, + col = FALSE, + errbar.col = NULL, + errbar.lwd = NULL, + lty, + pch, + legend, + legendText, + legendPos, + cex.legend = 1, + normal = FALSE, + normRef = 1, + confidence.level = 0.95 +) +} +\arguments{ +\item{x}{an object of class 'drc'.} + +\item{...}{additional graphical arguments. For instance, use \code{lwd=2} or +\code{lwd=3} to increase the width of plot symbols.} + +\item{add}{logical. If TRUE then add to already existing plot.} + +\item{level}{vector of character strings. To plot only the curves specified +by their names.} + +\item{type}{a character string specifying how to plot the data. Options are: +\code{"average"} (averages and fitted curve(s); default), \code{"none"} +(only the fitted curve(s)), \code{"obs"} (only the data points), +\code{"all"} (all data points and fitted curve(s)), \code{"bars"} +(averages and fitted curve(s) with model-based standard errors), and +\code{"confidence"} (confidence bands for fitted curve(s)).} + +\item{broken}{logical. If TRUE the x axis is broken provided this axis is +logarithmic (using functionality in the CRAN package 'plotrix').} + +\item{bp}{numeric value specifying the break point below which the dose is +zero. The default is the base-10 value corresponding to the rounded value +of the minimum of the log10 values of all positive dose values. Only works +for logarithmic dose axes.} + +\item{bcontrol}{a list with components \code{factor}, \code{style} and +\code{width} controlling the appearance of the break (when \code{broken} +is \code{TRUE}).} + +\item{conName}{character string. Name on x axis for dose zero. Default is +\code{"0"}.} + +\item{axes}{logical indicating whether both axes should be drawn on the plot.} + +\item{gridsize}{numeric. Number of points in the grid used for plotting the +fitted curves.} + +\item{log}{a character string which contains \code{"x"} if the x axis is to +be logarithmic, \code{"y"} if the y axis is to be logarithmic and +\code{"xy"} or \code{"yx"} if both axes are to be logarithmic. The default +is \code{"x"}. The empty string \code{""} yields the original axes.} + +\item{xtsty}{a character string specifying the dose axis style for +arrangement of tick marks. By default for a logarithmic axis only base 10 +tick marks are shown (\code{"base10"}). Otherwise sensible equidistantly +located tick marks are shown (\code{"standard"}).} + +\item{xttrim}{logical specifying if the number of tick marks should be +trimmed in case too many tick marks are initially determined.} + +\item{xt}{a numeric vector containing the positions of the tick marks on the +x axis.} + +\item{xtlab}{a vector containing the tick marks on the x axis.} + +\item{xlab}{an optional label for the x axis.} + +\item{xlim}{a numeric vector of length two, containing the lower and upper +limit for the x axis.} + +\item{yt}{a numeric vector containing the positions of the tick marks on the +y axis.} + +\item{ytlab}{a vector containing the tick marks on the y axis.} + +\item{ylab}{an optional label for the y axis.} + +\item{ylim}{a numeric vector of length two, containing the lower and upper +limit for the y axis.} + +\item{cex}{numeric or numeric vector specifying the size of plotting symbols +and text (see \code{\link{par}} for details).} + +\item{cex.axis}{numeric value specifying the magnification to be used for +axis annotation relative to the current setting of cex.} + +\item{col}{either logical or a vector of colours. If TRUE default colours are +used. If FALSE (default) no colours are used.} + +\item{errbar.col}{colour(s) for error bars when using \code{type = "bars"}. +If \code{NULL} (default), error bars will match the curve colours specified +by \code{col}. Use \code{errbar.col = "black"} to restore the previous +behaviour of black error bars.} + +\item{errbar.lwd}{line width(s) for error bars when using \code{type = "bars"}. +If \code{NULL} (default), error bars will inherit the line width specified +by \code{lwd} (via \code{...}). If \code{lwd} is also not specified, the +default graphical parameter \code{par("lwd")} is used.} + +\item{lty}{a numeric vector specifying the line types.} + +\item{pch}{a vector of plotting characters or symbols (see +\code{\link{points}}).} + +\item{legend}{logical. If TRUE a legend is displayed.} + +\item{legendText}{a character string or vector of character strings +specifying the legend text.} + +\item{legendPos}{numeric vector of length 2 giving the position of the +legend.} + +\item{cex.legend}{numeric specifying the legend text size.} + +\item{normal}{logical. If TRUE the plot of the normalized data and fitted +curves are shown (see Weimer et al. (2012) for details).} + +\item{normRef}{numeric specifying the reference for the normalization +(default is 1).} + +\item{confidence.level}{confidence level for error bars. Defaults to 0.95.} +} +\value{ +An invisible data frame with the values used for plotting the fitted +curves. The first column contains the dose values, and the following +columns (one for each curve) contain the fitted response values. +} +\description{ +\code{plot} displays fitted curves and observations in the same plot window, +distinguishing between curves by different plot symbols and line types. +} +\details{ +The use of \code{xlim} allows changing the range of the x axis, +extrapolating the fitted dose-response curves. Note that changing the range +on the x axis may also entail a change of the range on the y axis. Sometimes +it may be useful to extend the upper limit on the y axis (using \code{ylim}) +in order to fit a legend into the plot. + +See \code{\link{colors}} for the available colours. Suitable labels are +automatically provided. + +The arguments \code{broken} and \code{bcontrol} rely on the function +\code{axis.break} with arguments \code{style} and \code{brw} in the package +\pkg{plotrix}. + +The model-based standard errors used for the error bars are calculated as the +fitted value plus/minus the estimated error times the 1-(alpha/2) quantile in +the t distribution with degrees of freedom equal to the residual degrees of +freedom for the model (or using a standard normal distribution in case of +binomial and Poisson data), where alpha = 1 - confidence.level. The standard +errors are obtained using the predict method with the arguments +\code{interval = "confidence"} and \code{level = confidence.level}. +} +\examples{ +## Fitting models to be plotted below +ryegrass.m1 <- drm(rootl~conc, data = ryegrass, fct = LL.4()) +ryegrass.m2 <- drm(rootl~conc, data = ryegrass, fct = LL.3()) + +## Plotting observations and fitted curve for the first model +plot(ryegrass.m1, broken = TRUE) + +## Adding fitted curve for the second model +plot(ryegrass.m2, broken = TRUE, add = TRUE, type = "none", col = 2, lty = 2) + +## Add confidence region for the first model +plot(ryegrass.m1, broken = TRUE, type="confidence", add=TRUE) + +## Fitting model with multiple curves +spinach.m1 <- drm(SLOPE~DOSE, CURVE, data = spinach, fct = LL.4()) + +## Plot with default colours +plot(spinach.m1, col = TRUE, main = "Default colours") + +} +\seealso{ +\code{\link{colors}} +} +\author{ +Christian Ritz and Jens C. Streibig. Contributions from Xiaoyan Wang +and Greg Warnes. +} +\keyword{aplot} diff --git a/man/plotFACI.Rd b/man/plotFACI.Rd new file mode 100644 index 00000000..84cbb3a6 --- /dev/null +++ b/man/plotFACI.Rd @@ -0,0 +1,45 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/CIcompX.R +\name{plotFACI} +\alias{plotFACI} +\title{Plot combination index as a function of fraction affected} +\usage{ +plotFACI( + effList, + indAxis = c("ED", "EF"), + caRef = TRUE, + showPoints = FALSE, + add = FALSE, + ylim, + ... +) +} +\arguments{ +\item{effList}{a list as returned by \code{\link{CIcompX}}.} + +\item{indAxis}{character string. Either "ED" for effective doses or "EF" for effects.} + +\item{caRef}{logical. If TRUE (default), a reference line for concentration addition is drawn.} + +\item{showPoints}{logical. If TRUE, estimated combination indices are plotted as points.} + +\item{add}{logical. If TRUE, the plot is added to an existing plot.} + +\item{ylim}{numeric vector of length 2 giving the range for the y axis.} + +\item{...}{additional graphical arguments.} +} +\value{ +Invisibly returns the plot matrix of combination index values. +} +\description{ +Visualizes the combination index from \code{\link{CIcompX}} as a function of the fraction affected. +} +\seealso{ +\code{\link{CIcompX}}, \code{\link{CIcomp}} +} +\author{ +Christian Ritz and Ismael Rodea-Palomares +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/predict.drc.Rd b/man/predict.drc.Rd index 31e93356..1910bec5 100644 --- a/man/predict.drc.Rd +++ b/man/predict.drc.Rd @@ -1,91 +1,89 @@ -\name{predict.drc} - -\alias{predict.drc} -%\alias{predict.mrdrc} - -\title{Prediction} - -\description{ - Predicted values for models of class 'drc'. -} - -\usage{ - - \method{predict}{drc}(object, newdata, se.fit = FALSE, - interval = c("none", "confidence", "prediction", "ssd"), - level = 0.95, na.action = na.pass, od = FALSE, vcov. = vcov, - ssdSEfct = NULL, constrain = TRUE, checkND = TRUE, ...) - -% \method{predict}{mrdrc}(object, newdata, se.fit = FALSE, -% interval = c("none", "confidence", "prediction"), -% level = 0.95, pava = FALSE, ...) -} - -\arguments{ - \item{object}{an object of class 'drc'.} - \item{newdata}{An optional data frame in which to look for variables with which to predict. - If omitted, the fitted values are used.} - \item{se.fit}{logical. If TRUE standard errors are required.} - \item{interval}{character string. Type of interval calculation: "none", "confidence", "prediction", or "ssd".} - \item{level}{Tolerance/confidence level.} - \item{na.action}{function determining what should be done with missing values in 'newdata'. - The default is to predict 'NA'.} - \item{od}{logical. If TRUE adjustment for over-dispersion is used.} - \item{vcov.}{function providing the variance-covariance matrix. \code{\link{vcov}} is the default, - but \code{sandwich} is also an option (for obtaining robust standard errors).} - \item{ssdSEfct}{specifies the function for interpolating standard errors between observed standard errors. - The default is linear interpolation on log-log scale (back-transformed). See Details for more explanation.} - \item{constrain}{logical. If TRUE (default) predicted values are truncated within meaningful limits, i.e., - 0 and, possibly, 1.} -% \item{pava}{logical. If TRUE the fit is monotoniosed using pool adjacent violators algorithm.} - \item{checkND}{logical indicating whether or not names in "newdata" data frame match - the names in the original data frame (used for fitting the model). Default is TRUE.} - \item{\dots}{further arguments passed to or from other methods.} -} - -\details{ - For the built-in log-logistic, log-normal, and Weibull-type models standard errors and confidence/prediction - intervals can be calculated. For other built-in models it may not yet be implemented (drop us an e-mail if - you need them). - - The function for interpolating standard errors of estimates, which may be used when fitting an SSD, should - have 3 arguments: observed estimates and corresponding standard errors and future estimates and should return - interpolated standard errors corresponding to the future estimates provided. -} - -\value{ - A matrix with as many rows as there are dose values provided in 'newdata' or in the original dataset - (in case 'newdata' is not specified) and, at most, 4 columns containing fitted, standard errors, lower and - upper limits of confidence/prediction intervals. -} - -%\references{} - -\author{Christian Ritz} - -%\note{} - -\seealso{For details are found in the help page for \code{\link{predict.lm}}.} - -\examples{ - -## Fitting a model -spinach.model1 <- drm(SLOPE~DOSE, CURVE, data = spinach, fct = LL.4()) - -## Predicting values a dose=2 (with standard errors) -predict(spinach.model1, data.frame(dose=2, CURVE=c("1", "2", "3")), se.fit = TRUE) - -## Getting confidence intervals -predict(spinach.model1, data.frame(dose=2, CURVE=c("1", "2", "3")), -interval = "confidence") - -## Getting prediction intervals -predict(spinach.model1, data.frame(dose=2, CURVE=c("1", "2", "3")), -interval = "prediction") - -} - -\keyword{models} -\keyword{nonlinear} - -\concept{prediction} \ No newline at end of file +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/predict.drc.R +\name{predict.drc} +\alias{predict.drc} +\title{Prediction} +\usage{ +\method{predict}{drc}( + object, + newdata, + se.fit = FALSE, + interval = c("none", "confidence", "prediction", "ssd"), + level = 0.95, + na.action = na.pass, + od = FALSE, + vcov. = vcov, + ssdSEfct = NULL, + constrain = TRUE, + checkND = TRUE, + ... +) +} +\arguments{ +\item{object}{an object of class 'drc'.} + +\item{newdata}{an optional data frame in which to look for variables with +which to predict. If omitted, the fitted values are used.} + +\item{se.fit}{logical. If TRUE standard errors are required.} + +\item{interval}{character string. Type of interval calculation: +\code{"none"}, \code{"confidence"}, \code{"prediction"}, or \code{"ssd"}.} + +\item{level}{tolerance/confidence level.} + +\item{na.action}{function determining what should be done with missing values +in \code{newdata}. The default is to predict \code{NA}.} + +\item{od}{logical. If TRUE adjustment for over-dispersion is used.} + +\item{vcov.}{function providing the variance-covariance matrix. +\code{\link{vcov}} is the default, but \code{sandwich} is also an option +(for obtaining robust standard errors).} + +\item{ssdSEfct}{specifies the function for interpolating standard errors +between observed standard errors. The default is linear interpolation on +log-log scale (back-transformed).} + +\item{constrain}{logical. If TRUE (default) predicted values are truncated +within meaningful limits, i.e., 0 and, possibly, 1.} + +\item{checkND}{logical indicating whether or not names in \code{newdata} +data frame match the names in the original data frame used for fitting +the model. Default is TRUE.} + +\item{...}{further arguments passed to or from other methods.} +} +\value{ +A matrix with as many rows as there are dose values provided in +\code{newdata} or in the original dataset (in case \code{newdata} is not +specified) and, at most, 4 columns containing fitted values, standard +errors, lower and upper limits of confidence/prediction intervals. +} +\description{ +Predicted values for models of class 'drc'. +} +\examples{ +## Fitting a model +spinach.model1 <- drm(SLOPE~DOSE, CURVE, data = spinach, fct = LL.4()) + +## Predicting values at dose=2 (with standard errors) +predict(spinach.model1, data.frame(dose=2, CURVE=c("1", "2", "3")), se.fit = TRUE) + +## Getting confidence intervals +predict(spinach.model1, data.frame(dose=2, CURVE=c("1", "2", "3")), +interval = "confidence") + +## Getting prediction intervals +predict(spinach.model1, data.frame(dose=2, CURVE=c("1", "2", "3")), +interval = "prediction") + +} +\seealso{ +For details see the help page for \code{\link{predict.lm}}. +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/print.drc.Rd b/man/print.drc.Rd index 4f62fa10..f866adc7 100644 --- a/man/print.drc.Rd +++ b/man/print.drc.Rd @@ -1,36 +1,35 @@ -\name{print.drc} - -\alias{print.drc} - -\title{Printing key features} - -\description{ - 'print' displays brief information on an object of class 'drc'. -} - -\usage{ - - \method{print}{drc}(x, ..., digits = max(3, getOption("digits") - 3)) - -} - -\arguments{ - \item{x}{an object of class 'drc'.} - \item{...}{additional arguments.} - \item{digits}{an integer giving the number of digits of the parameter coefficients. Default is 3.} -} - -\author{Christian Ritz} - -\examples{ - -## Fitting a four-parameter log-logistic model -ryegrass.m1 <- drm(rootl ~conc, data = ryegrass, fct = LL.4()) - -## Displaying the model fit -print(ryegrass.m1) -ryegrass.m1 # gives the same output as the previous line - -} -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/print.drc.R +\name{print.drc} +\alias{print.drc} +\title{Printing key features} +\usage{ +\method{print}{drc}(x, ..., digits = max(3, getOption("digits") - 3)) +} +\arguments{ +\item{x}{an object of class 'drc'.} + +\item{...}{additional arguments.} + +\item{digits}{an integer giving the number of digits of the parameter coefficients. Default is 3.} +} +\value{ +The object is returned invisibly. +} +\description{ +\code{print} displays brief information on an object of class 'drc'. +} +\examples{ +## Fitting a four-parameter log-logistic model +ryegrass.m1 <- drm(rootl ~conc, data = ryegrass, fct = LL.4()) + +## Displaying the model fit +print(ryegrass.m1) +ryegrass.m1 # gives the same output as the previous line + +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/print.summary.drc.Rd b/man/print.summary.drc.Rd index 834979e2..7b2aa795 100644 --- a/man/print.summary.drc.Rd +++ b/man/print.summary.drc.Rd @@ -1,37 +1,31 @@ -\name{print.summary.drc} - -\alias{print.summary.drc} - -\title{Printing summary of non-linear model fits} - -\description{ - This method produces formatted output of the summary statistics: parameter estimates, estimated standard errors, - z-test statistics and corresponding p-values. -} - -\usage{ - - \method{print}{summary.drc}(x, ...) - -} - -\arguments{ - \item{x}{an object of class 'drc'.} - \item{...}{additional arguments.} -} - -\value{ - The object (argument \code{x}) is returned invisibly. -} - -\author{Christian Ritz} - -\examples{ - -ryegrass.m1 <- drm(rootl~conc, data=ryegrass, fct= LL.4()) - -summary(ryegrass.m1) - -} -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/print.summary.drc.R +\name{print.summary.drc} +\alias{print.summary.drc} +\title{Printing summary of non-linear model fits} +\usage{ +\method{print}{summary.drc}(x, ...) +} +\arguments{ +\item{x}{an object of class 'drc'.} + +\item{...}{additional arguments.} +} +\value{ +The object (argument \code{x}) is returned invisibly. +} +\description{ +This method produces formatted output of the summary statistics: parameter estimates, +estimated standard errors, z-test statistics and corresponding p-values. +} +\examples{ +ryegrass.m1 <- drm(rootl~conc, data=ryegrass, fct= LL.4()) + +summary(ryegrass.m1) + +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/rdrm.Rd b/man/rdrm.Rd index 458a7669..fc25bdf2 100644 --- a/man/rdrm.Rd +++ b/man/rdrm.Rd @@ -1,77 +1,80 @@ -\name{rdrm} - -\alias{rdrm} - -\title{Simulating a dose-response curve} - -\description{ - Simulation of a dose-response curve with user-specified dose values and error distribution. -} - -\usage{ - rdrm(nosim, fct, mpar, xerror, xpar = 1, yerror = "rnorm", ypar = c(0, 1), - onlyY = FALSE) -} - -\arguments{ - \item{nosim}{numeric. The number of simulated curves to be returned.} - \item{fct}{list. Any built-in function in the package \emph{drc} or a list with similar components.} - \item{mpar}{numeric. The model parameters to be supplied to \code{fct}.} - \item{xerror}{numeric or character. The distribution for the dose values.} - \item{xpar}{numeric vector supplying the parameter values defining the distribution for the dose values. - If \code{xerror} is a distribution then remember that the number of dose values also is part of this argument - (the first argument).} - \item{yerror}{numeric or character. The error distribution for the response values.} - \item{ypar}{numeric vector supplying the parameter values defining the error distribution for the - response values.} - \item{onlyY}{logical. If TRUE then only the response values are returned (useful in simulations). - Otherwise both dose values and response values (and for binomial data also the weights) are returned.} -} - -\details{ - The distribution for the dose values can either be a fixed set of dose values (a numeric vector) - used repeatedly for creating all curves or be a distribution specified as a character string resulting in - varying dose values from curve to curve. - - The error distribution for the response values can be any continuous distribution - like \code{\link{rnorm}} or \code{\link{rgamma}}. Alternatively it can be the binomial distribution - \code{\link{rbinom}}. -} - -\value{ - A list with up to 3 components (depending on the value of the \code{onlyY} argument). -} - -\references{ ~put references to the literature/web site here ~ } - -\author{Christian Ritz} - -%\note{} - -%\seealso{} - -\examples{ - -## Simulating normally distributed dose-response data - -## Model fit to simulate from -ryegrass.m1 <- drm(rootl~conc, data = ryegrass, fct = LL.4()) - -## 10 random dose-response curves based on the model fit -sim10a <- rdrm(10, LL.4(), coef(ryegrass.m1), xerror = ryegrass$conc) -sim10a - - -## Simulating binomial dose-response data - -## Model fit to simulate from -deguelin.m1 <- drm(r/n~dose, weights=n, data=deguelin, fct=LL.2(), type="binomial") - -## 10 random dose-response curves -sim10b <- rdrm(10, LL.2(), coef(deguelin.m1), deguelin$dose, yerror="rbinom", ypar=deguelin$n) -sim10b - -} - -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rdrm.R +\name{rdrm} +\alias{rdrm} +\title{Simulating a dose-response curve} +\usage{ +rdrm( + nosim, + fct, + mpar, + xerror, + xpar = 1, + yerror = "rnorm", + ypar = c(0, 1), + onlyY = FALSE +) +} +\arguments{ +\item{nosim}{numeric. The number of simulated curves to be returned.} + +\item{fct}{list. Any built-in function in the package \emph{drc} or a list with similar +components.} + +\item{mpar}{numeric. The model parameters to be supplied to \code{fct}.} + +\item{xerror}{numeric or character. The distribution for the dose values.} + +\item{xpar}{numeric vector supplying the parameter values defining the distribution for the +dose values. If \code{xerror} is a distribution then remember that the number of dose +values also is part of this argument (the first argument).} + +\item{yerror}{numeric or character. The error distribution for the response values.} + +\item{ypar}{numeric vector supplying the parameter values defining the error distribution +for the response values.} + +\item{onlyY}{logical. If TRUE then only the response values are returned (useful in +simulations). Otherwise both dose values and response values (and for binomial data also +the weights) are returned.} +} +\value{ +A list with up to 3 components (depending on the value of the \code{onlyY} argument). +} +\description{ +Simulation of a dose-response curve with user-specified dose values and error distribution. +} +\details{ +The distribution for the dose values can either be a fixed set of dose values (a numeric +vector) used repeatedly for creating all curves or be a distribution specified as a +character string resulting in varying dose values from curve to curve. + +The error distribution for the response values can be any continuous distribution +like \code{\link{rnorm}} or \code{\link{rgamma}}. Alternatively it can be the binomial +distribution \code{\link{rbinom}}. +} +\examples{ +## Simulating normally distributed dose-response data + +## Model fit to simulate from +ryegrass.m1 <- drm(rootl~conc, data = ryegrass, fct = LL.4()) + +## 10 random dose-response curves based on the model fit +sim10a <- rdrm(10, LL.4(), coef(ryegrass.m1), xerror = ryegrass$conc) +sim10a + +## Simulating binomial dose-response data + +## Model fit to simulate from +deguelin.m1 <- drm(r/n~dose, weights=n, data=deguelin, fct=LL.2(), type="binomial") + +## 10 random dose-response curves +sim10b <- rdrm(10, LL.2(), coef(deguelin.m1), deguelin$dose, yerror="rbinom", ypar=deguelin$n) +sim10b + +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/red.fescue.Rd b/man/red.fescue.Rd new file mode 100644 index 00000000..7ee89213 --- /dev/null +++ b/man/red.fescue.Rd @@ -0,0 +1,35 @@ +\name{red.fescue} + +\alias{red.fescue} + +\docType{data} + +\title{Red fescue} + +\description{Data from a dose-response experiment with red fescue (\emph{Festuca rubra}). Biomass was measured at different dose levels and at two time points (day 0 and day 16).} + +\usage{data(red.fescue)} + +\format{ + A data frame with 26 observations on the following 3 variables. + \describe{ + \item{\code{dose}}{a numeric vector} + \item{\code{day}}{a numeric vector} + \item{\code{biomass}}{a numeric vector} + } +} + +\examples{ +library(drc) + +## Displaying the data +head(red.fescue) + +## Fitting a four-parameter log-logistic model with separate curves per day +red.fescue.m1 <- drm(biomass ~ dose, day, data = red.fescue, fct = LL.4()) +summary(red.fescue.m1) + +## Plotting the fitted curves +plot(red.fescue.m1, xlab = "Dose", ylab = "Biomass") +} +\keyword{datasets} diff --git a/man/relpot.Rd b/man/relpot.Rd new file mode 100644 index 00000000..e2ea74d8 --- /dev/null +++ b/man/relpot.Rd @@ -0,0 +1,48 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/relpot.R +\name{relpot} +\alias{relpot} +\title{Relative potency function} +\usage{ +relpot( + object, + plotit = TRUE, + compMatch = NULL, + percVec = NULL, + interval = "none", + type = c("relative", "absolute"), + scale = c("original", "percent", "unconstrained"), + ... +) +} +\arguments{ +\item{object}{an object of class 'drc'.} + +\item{plotit}{logical. If TRUE (default), a plot of relative potency against response level is produced.} + +\item{compMatch}{a numeric vector of length 2 specifying which two curves to compare.} + +\item{percVec}{numeric vector of response levels at which to evaluate relative potency. +If NULL, a suitable range is determined automatically.} + +\item{interval}{character string specifying confidence interval type. Default is "none".} + +\item{type}{character string. Either "relative" (default) or "absolute" response levels.} + +\item{scale}{character string. One of "original" (default), "percent", or "unconstrained".} + +\item{...}{additional graphical arguments passed to \code{plot}.} +} +\value{ +An invisible list with components \code{x}, \code{y} (relative potency values), +and \code{percVec}. +} +\description{ +Calculates and optionally plots relative potency as a function of the response level +for two curves in a dose-response model, using \code{\link{EDcomp}} for the underlying comparisons. +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/repChar.Rd b/man/repChar.Rd new file mode 100644 index 00000000..a9acdf20 --- /dev/null +++ b/man/repChar.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/repChar.R +\name{repChar} +\alias{repChar} +\title{Replace characters in strings} +\usage{ +repChar(str, names, fixed, keep) +} +\description{ +Replace characters in strings +} +\keyword{internal} diff --git a/man/resPrint.Rd b/man/resPrint.Rd new file mode 100644 index 00000000..f551b3fe --- /dev/null +++ b/man/resPrint.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/resPrint.R +\name{resPrint} +\alias{resPrint} +\title{Print residual information} +\usage{ +resPrint(resMat, headerText, interval, intervalLabel, display) +} +\description{ +Print residual information +} +\keyword{internal} diff --git a/man/residuals.drc.Rd b/man/residuals.drc.Rd index d30e9ece..d2841e54 100644 --- a/man/residuals.drc.Rd +++ b/man/residuals.drc.Rd @@ -1,62 +1,50 @@ -\name{residuals.drc} - -\alias{residuals.drc} - -\title{Extracting residuals from the fitted dose-response model} - -\description{ - 'residuals' extracts different types of residuals from an object of class 'drc'. -} - -\usage{ - - \method{residuals}{drc}(object, typeRes = c("working", "standardised", "studentised"), - trScale = TRUE, ...) - -} - -\arguments{ - \item{object}{an object of class 'drc'.} - \item{typeRes}{character string specifying the type of residual to be returned: raw/working residuals, - residuals standardised using the estimated residual standard error, - or studentised residuals based on the H matrix of partial derivatives of the model function.} - \item{trScale}{logical value indicating whether or not to return residuals on the transformed scale (in case a Box-Cox transformation was applied).} - \item{...}{additional arguments.} -} - -\value{ - The raw (also called working) residuals or some kind of scaled residuals extracted from 'object'. -} - -\details{ - Standardised residuals are the raw residuals divided by a scale estimate (if available). - - Studentised residuals are obtained by dividing by a scale estimate and in - addition a correction factor (square root of 1 minus h with h is a diagonal element in the hat matrix). -} - -\note{ - The 'standardised' residuals are available for least squares estimation - with or without Box-Cox transformation or variance as a power of the - mean. -} - -\author{Christian Ritz} - -\examples{ - -## Fitting a four-parameter log-logistic model -ryegrass.m1 <- drm(rootl ~conc, data = ryegrass, fct = LL.4()) - -## Displaying the residual plot (raw residuals) -plot(fitted(ryegrass.m1), residuals(ryegrass.m1)) - -## Using the standardised residuals -plot(fitted(ryegrass.m1), residuals(ryegrass.m1, typeRes = "standard")) - -## Overlayering the studentised residuals ... not much of a difference -points(fitted(ryegrass.m1), residuals(ryegrass.m1, typeRes = "student"), col = 2) - -} -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/residuals.drc.R +\name{residuals.drc} +\alias{residuals.drc} +\title{Extracting residuals from the fitted dose-response model} +\usage{ +\method{residuals}{drc}( + object, + typeRes = c("working", "standardised", "studentised"), + trScale = TRUE, + ... +) +} +\arguments{ +\item{object}{an object of class 'drc'.} + +\item{typeRes}{character string specifying the type of residual to be +returned: raw/working residuals, residuals standardised using the +estimated residual standard error, or studentised residuals based on the +H matrix of partial derivatives of the model function.} + +\item{trScale}{logical value indicating whether or not to return residuals +on the transformed scale (in case a Box-Cox transformation was applied).} + +\item{...}{additional arguments.} +} +\value{ +The raw (also called working) residuals or some kind of scaled +residuals extracted from \code{object}. +} +\description{ +\code{residuals} extracts different types of residuals from an object of +class 'drc'. +} +\examples{ +## Fitting a four-parameter log-logistic model +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + +## Displaying the residual plot (raw residuals) +plot(fitted(ryegrass.m1), residuals(ryegrass.m1)) + +## Using the standardised residuals +plot(fitted(ryegrass.m1), residuals(ryegrass.m1, typeRes = "standard")) + +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/rse.Rd b/man/rse.Rd new file mode 100644 index 00000000..7f553473 --- /dev/null +++ b/man/rse.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rse.R +\name{rse} +\alias{rse} +\title{Residual standard error} +\usage{ +rse(object, resvar = FALSE) +} +\description{ +Residual standard error +} +\keyword{internal} diff --git a/man/rss.Rd b/man/rss.Rd new file mode 100644 index 00000000..b360895a --- /dev/null +++ b/man/rss.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rss.R +\name{rss} +\alias{rss} +\title{Residual sum of squares for dose-response models} +\usage{ +rss(object, print = TRUE) +} +\arguments{ +\item{object}{an object of class 'drc'.} + +\item{print}{logical. If \code{TRUE} (the default), the RSS values are printed.} +} +\value{ +Invisibly returns a matrix of RSS values. For single-curve models, a 1x1 matrix. +For multi-curve models, includes per-curve values and a total RSS. +} +\description{ +Calculates and displays the residual sum of squares (RSS) for a fitted dose-response model. +For models with multiple curves, per-curve and total RSS values are returned. +} +\seealso{ +\code{\link[=Rsq]{Rsq()}} which uses this function to compute R-squared. +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/ryegrass.Rd b/man/ryegrass.Rd new file mode 100644 index 00000000..9dfacf1a --- /dev/null +++ b/man/ryegrass.Rd @@ -0,0 +1,81 @@ +\name{ryegrass} + +\alias{ryegrass} + +\docType{data} + +\title{Effect of ferulic acid on growth of ryegrass} + +\description{ + A single dose-response curve. +} + +\usage{data(ryegrass)} + +\format{ + A data frame with 24 observations on the following 2 variables. + \describe{ + \item{rootl}{a numeric vector of root lengths} + \item{conc}{a numeric vector of concentrations of ferulic acid} + } +} + +\details{ + The data are part of a study to investigate the joint action + of phenolic acids on root growth inhibition of perennial ryegrass (\emph{Lolium perenne L}). + + \code{conc} is the concentration of ferulic acid is in mM, and \code{rootl} is the root length + of perennial ryegrass measured in cm. +} + +\source{ + Inderjit and J. C. Streibig, and M. Olofsdotter (2002) Joint action of + phenolic acid mixtures and its significance in allelopathy + research, \emph{Physiologia Plantarum}, \bold{114}, 422--428, 2002. +} + +\examples{ +library(drc) + +## Displaying the data set +ryegrass + +## Fitting a four-parameter Weibull model (type 2) +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W2.4()) + +## Displaying a summary of the model fit +summary(ryegrass.m1) + +## Plotting the fitted curve together with the original data +plot(ryegrass.m1) + +## Fitting a four-parameter Weibull model (type 1) +ryegrass.m2 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) +plot(ryegrass.m2) + +## Fitting a four-parameter log-logistic model +## with user-defined parameter names +ryegrass.m3 <- drm(rootl ~ conc, data = ryegrass, +fct = LL.4(names = c("Slope", "Lower Limit", "Upper Limit", "ED50"))) +summary(ryegrass.m3) + +## Comparing log-logistic and Weibull models +## (Figure 2 in Ritz (2009)) +ryegrass.m0 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) +ryegrass.m2 <- drm(rootl ~ conc, data = ryegrass, fct = W2.4()) + +plot(ryegrass.m0, broken=TRUE, xlab="Dose (mM)", ylab="Root length (cm)", lwd=2, +cex=1.2, cex.axis=1.2, cex.lab=1.2) +plot(ryegrass.m1, add=TRUE, broken=TRUE, lty=2, lwd=2) +plot(ryegrass.m2, add=TRUE, broken=TRUE, lty=3, lwd=2) + +arrows(3, 7.5, 1.4, 7.5, 0.15, lwd=2) +text(3,7.5, "Weibull-2", pos=4, cex=1.2) + +arrows(2.5, 0.9, 5.7, 0.9, 0.15, lwd=2) +text(3,0.9, "Weibull-1", pos=2, cex=1.2) + +} +\keyword{datasets} + diff --git a/man/ryegrass2.Rd b/man/ryegrass2.Rd new file mode 100644 index 00000000..a8b5b8e2 --- /dev/null +++ b/man/ryegrass2.Rd @@ -0,0 +1,35 @@ +\name{ryegrass2} + +\alias{ryegrass2} + +\docType{data} + +\title{Ryegrass} + +\description{Data from a dose-response experiment with ryegrass (\emph{Lolium} sp.). Biomass was measured at different dose levels and at two time points.} + +\usage{data(ryegrass2)} + +\format{ + A data frame with 27 observations on the following 3 variables. + \describe{ + \item{\code{dose}}{a numeric vector} + \item{\code{biomass}}{a numeric vector} + \item{\code{day}}{a categorial vector} + } +} + +\examples{ +library(drc) + +## Displaying the data +head(ryegrass2) + +## Fitting a four-parameter log-logistic model with separate curves per day +ryegrass2.m1 <- drm(biomass ~ dose, day, data = ryegrass2, fct = LL.4()) +summary(ryegrass2.m1) + +## Plotting the fitted curves +plot(ryegrass2.m1, xlab = "Dose", ylab = "Biomass") +} +\keyword{datasets} diff --git a/man/searchdrc.Rd b/man/searchdrc.Rd index 0c59f0be..6425b523 100644 --- a/man/searchdrc.Rd +++ b/man/searchdrc.Rd @@ -1,46 +1,79 @@ -\name{searchdrc} -\alias{searchdrc} - -\title{Searching through a range of initial parameter values to obtain convergence} - -\description{ - 'searchdrc' provides a facility for searching through a range of parameter values (one-dimensional) - in order to obtain convergence of the estimation procedure. -} - -\usage{ -searchdrc(object, which, range, len = 50) -} - -\arguments{ - \item{object}{an object of class 'drc'. The object can be from a model that could not fitted.} - \item{which}{a character string containing the parameter name} - \item{range}{a numeric vector of length 2 specifying the interval endpoints for the range.} - \item{len}{numeric. The number of points in the interval.} -} - -\details{ - The function goes through the range with increments such that in total at most \code{len} sets of parameter values - are used as initial values for the estimation procedure. You would need to identify the parameter which is most likely to - cause problems for the estimation procedure. -} - -\value{ - An object of class 'drc'. -} - -%\references{ ~put references to the literature/web site here ~ } - -\author{Christian Ritz} - -%\note{ ~~further notes~~ } - -%\seealso{ ~~objects to See Also as \code{\link{~~fun~~}}, ~~~ } - -\examples{ - -## No example yet - -} -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/searchdrc.R +\name{searchdrc} +\alias{searchdrc} +\title{Search through a range of initial parameter values to obtain convergence} +\usage{ +searchdrc(object, which, range, len = 50, verbose = FALSE) +} +\arguments{ +\item{object}{an object of class \code{'drc'}, which must have valid +\code{$start} and \code{$parNames} fields populated. This is typically +an object from a model that failed to converge but was still constructed +with initial parameter values.} + +\item{which}{a character string containing the parameter name +\strong{without} the curve suffix (e.g., \code{"b"} not \code{"b:1"}). +Must exactly match one of the parameter names in the model object.} + +\item{range}{a numeric vector of exactly length 2 specifying the interval +endpoints \code{c(lower, upper)} for the search range. The two endpoints +must be different.} + +\item{len}{a positive integer (minimum 2). The maximum number of evenly +spaced starting values to try within \code{range}. The search stops early +as soon as convergence is achieved, so the actual number of attempts may +be less than \code{len}. Defaults to \code{50}.} + +\item{verbose}{logical. If \code{TRUE}, prints progress messages indicating +which starting value is currently being tried. Defaults to \code{FALSE}.} +} +\value{ +If convergence is achieved, returns the fitted model object of class +\code{'drc'}, corresponding to the \strong{first} starting value in the +search grid that led to a successful fit. If no starting value leads to +convergence, the function throws an error. +} +\description{ +\code{searchdrc} provides a facility for searching through a range of initial +values for a single parameter in order to obtain convergence of the non-linear +estimation procedure used in dose-response curve fitting. +} +\details{ +The function iterates through at most \code{len} evenly spaced values within +the specified \code{range}, using each as a starting value for the chosen +parameter. The search stops as soon as the first successful model fit is +found. You would need to identify the parameter which is most likely to cause +problems for the estimation procedure. + +Parameter names should be provided \strong{without} the curve suffix. For +example, use \code{"b"} rather than \code{"b:1"}. The function internally +matches the parameter using the pattern \code{"^:"} against the full +parameter names stored in the model object. +} +\examples{ +\dontrun{ +library(drc) + +# Fit an initial model (which may fail to converge) +myModel <- drm(response ~ dose, data = myData, fct = LL.4()) + +# Search over a range of starting values for the slope parameter "b" +myModelFixed <- searchdrc(myModel, which = "b", range = c(-5, 5), len = 100) + +# With progress messages enabled +myModelFixed <- searchdrc(myModel, which = "b", range = c(-5, 5), + len = 100, verbose = TRUE) +} + +} +\seealso{ +\code{\link[drc]{drm}} for the main model fitting function, +\code{\link[drc]{drmc}} for control arguments, +\code{\link[stats]{update}} for the update method used internally. +} +\author{ +Christian Ritz, Hannes Reinwald. +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/secalonic.Rd b/man/secalonic.Rd new file mode 100644 index 00000000..539c28c4 --- /dev/null +++ b/man/secalonic.Rd @@ -0,0 +1,64 @@ +\name{secalonic} + +\alias{secalonic} + +\docType{data} + +\title{Root length measurements} + +\description{ + Data stem from an experiment assessing the inhibitory effect of secalonic acids on plant growth. +} + +\usage{data(secalonic)} + +\format{ + A data frame with 7 observations on the following 2 variables: + \describe{ + \item{\code{dose}}{a numeric vector containing dose values (mM)} + \item{\code{rootl}}{a numeric vector containing root lengths (cm)} + } +} + +\details{ + For each dose the root length is an average three measurements. +} + +\source{ + Gong, X. and Zeng, R. and Luo, S. and Yong, C. and Zheng, Q. (2004) Two new + secalonic acids from \emph{Aspergillus Japonicus} and their allelopathic effects on higher plants, + \emph{Proceedings of International Symposium on Allelopathy Research and Application, 27-29 April, + Shanshui, Guangdong, China (Editors: R. Zeng and S. Luo)}, 209--217. + + Ritz, C (2009) + Towards a unified approach to dose-response modeling in ecotoxicology + \emph{To appear in Environ Toxicol Chem}. +} + +%\references{} + +\examples{ +library(drc) + +## Fitting a four-parameter log-logistic model +secalonic.m1 <- drm(rootl ~ dose, data = secalonic, fct = LL.4()) +summary(secalonic.m1) + +## Fitting a three-parameter log-logistic model +## lower limit fixed at 0 +secalonic.m2 <- drm(rootl ~ dose, data = secalonic, fct = LL.3()) +summary(secalonic.m1) + +## Comparing logistic and log-logistic models +## (Figure 1 in Ritz (2009)) +secalonic.LL4 <- drm(rootl ~ dose, data = secalonic, fct = LL.4()) +secalonic.L4 <- drm(rootl ~ dose, data = secalonic, fct = L.4()) + +plot(secalonic.LL4, broken=TRUE, ylim=c(0,7), xlab="Dose (mM)", ylab="Root length (cm)", +cex=1.2, cex.axis=1.2, cex.lab=1.2, lwd=2) + +plot(secalonic.L4, broken=TRUE, ylim=c(0,7), add=TRUE, type="none", lty=2, lwd=2) + +abline(h=coef(secalonic.L4)[3], lty=3, lwd=2) +} +\keyword{datasets} diff --git a/man/selenium.Rd b/man/selenium.Rd new file mode 100644 index 00000000..889e5f43 --- /dev/null +++ b/man/selenium.Rd @@ -0,0 +1,76 @@ +\name{selenium} + +\alias{selenium} + +\docType{data} + +\title{ + Data from toxicology experiments with selenium +} + +\description{ + Comparison of toxicity of four types of selenium by means of dose-response analysis +} + +\usage{data(selenium)} + +\format{ + A data frame with 25 observations on the following 4 variables. + \describe{ + \item{\code{type}}{a numeric vector indicating the form of selenium applied} + \item{\code{conc}}{a numeric vector of (total) selenium concentrations} + \item{\code{total}}{a numeric vector containing the total number of flies} + \item{\code{dead}}{a numeric vector containing the number of dead flies} + } +} + +\details{ + The experiment is described in more details by Jeske et al. (2009). +} + +\source{ + Jeske, D. R., Xu, H. K., Blessinger, T., Jensen, P. and Trumble, J. (2009) Testing for the Equality of EC50 Values in the Presence of + Unequal Slopes With Application to Toxicity of Selenium Types, \emph{Journal of Agricultural, Biological, and Environmental Statistics}, + \bold{14}, 469--483} + + +\examples{ +library(drc) + +## Analysis similar to what is proposed in Jeske et al (2009) +## but simply using existing functionality in "drc" + +## Fitting the two-parameter log-logistic model with unequal ED50 and slope +sel.m1 <- drm(dead/total~conc, type, weights=total, data=selenium, fct=LL.2(), +type="binomial") +#sel.m1b <- drm(dead/total~conc, type, weights=total, data=selenium, fct=LN.2(), +# type="binomial", start=c(1,1,1,1,50,50,50,50)) +plot(sel.m1, ylim = c(0, 1.3)) +summary(sel.m1) + +## Testing for equality of slopes +sel.m2 <- drm(dead/total~conc, type, weights=total, data=selenium, fct=LL.2(), +type="binomial", pmodels=list(~1, ~factor(type)-1)) +sel.m2b <- drm(dead/total~conc, type, weights=total, data=selenium, fct=LN.2(), +type="binomial", pmodels=list(~1, ~factor(type)-1)) +plot(sel.m2, ylim = c(0, 1.3)) +summary(sel.m2) +anova(sel.m2, sel.m1) # 48.654 +#anova(sel.m2b, sel.m1b) +# close to the value 48.46 reported in the paper + +## Testing for equality of ED50 +sel.m3<-drm(dead/total~conc, type, weights=total, data=selenium, fct=LL.2(), +type="binomial", pmodels=list(~factor(type)-1, ~1)) +#sel.m3b<-drm(dead/total~conc, type, weights=total, data=selenium, fct=LN.2(), +# type="binomial", pmodels=list(~factor(type)-1, ~1), start=c(1,1,1,1,50)) +plot(sel.m3, ylim = c(0, 1.3)) +summary(sel.m3) + +anova(sel.m3, sel.m1) # 123.56 +#anova(sel.m3b, sel.m1b) +# not too far from the value 138.45 reported in the paper +# (note that the estimation procedure is not exactly the same) +# (and we use the log-logistic model instead of the log-normal model) +} +\keyword{datasets} diff --git a/man/siInner.Rd b/man/siInner.Rd new file mode 100644 index 00000000..d4acc015 --- /dev/null +++ b/man/siInner.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/siInner.R +\name{siInner} +\alias{siInner} +\title{Inner function for selectivity index} +\usage{ +siInner( + indPair, + pVec, + compMatch, + object, + indexMat, + parmMat, + varMat, + level, + reference, + type, + sifct, + interval, + degfree, + logBase +) +} +\description{ +Inner function for selectivity index +} +\keyword{internal} diff --git a/man/simDR.Rd b/man/simDR.Rd index 261f6b9f..cee1f940 100644 --- a/man/simDR.Rd +++ b/man/simDR.Rd @@ -1,57 +1,71 @@ -\name{simDR} - -\alias{simDR} - -\title{Simulating ED values under various scenarios} - -\description{ - Simulating ED values for a given model and given dose values. -} - -\usage{ - simDR(mpar, sigma, fct, noSim = 1000, conc, edVec = c(10, 50), seedVal = 20070723) -} - -\arguments{ - \item{mpar}{numeric vector of model parameters} - \item{sigma}{numeric specifying the residual standard deviation} - \item{fct}{list supplying the chosen mean function} - \item{conc}{numeric vector of concentration/dose values} - \item{edVec}{numeric vector of ED values to estimate in each simulation} - \item{noSim}{numeric giving the number of simulations} - \item{seedVal}{numeric giving the seed used to initiate the random number generator} -} - -\details{ - The arguments \code{mpar} and \code{sigma} are typically obtained from a previous model fit. - - Only dose-response models assuming normally distributed errors can be used. -} - -\value{ - A list of matrices with as many components as there are chosen ED values. The entries in the matrices are - empirical standard deviations of the estimated ED values. Row-wise from top to bottom more and more - concentration/dose values are included in the simulations; top row starting with 5 concentrations. The - number of replicates increases column by column from left to right. - - The list is returned invisbly as the matrices also are displayed. -} - -%\references{ ~put references to the literature/web site here ~ } - -\author{Christian Ritz} - -%\note{} - -%\seealso{ ~~objects to See Also as \code{\link{help}}, ~~~ } - -\examples{ - -ryegrass.m1 <- drm(ryegrass, fct=LL.4()) - -simDR(coef(ryegrass.m1), sqrt(summary(ryegrass.m1)$resVar), LL.4(), 2, -c(1.88, 3.75, 7.50, 0.94, 15, 0.47, 30, 0.23, 60), seedVal = 200710291) - -} -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/simDR.R +\name{simDR} +\alias{simDR} +\title{Simulating ED values under various scenarios} +\usage{ +simDR( + mpar, + sigma, + fct, + noSim = 1000, + conc, + edVec = c(10, 50), + seedVal = 20070723 +) +} +\arguments{ +\item{mpar}{numeric vector of model parameters.} + +\item{sigma}{numeric specifying the residual standard deviation.} + +\item{fct}{list supplying the chosen dose-response mean function (e.g., \code{LL.4()}).} + +\item{noSim}{numeric giving the number of simulations. Defaults to \code{1000}.} + +\item{conc}{numeric vector of concentration/dose values. Must contain at least 5 values.} + +\item{edVec}{numeric vector of ED levels to estimate in each simulation. Defaults to +\code{c(10, 50)}.} + +\item{seedVal}{numeric giving the seed used to initialise the random number generator. +Defaults to \code{20070723}.} +} +\value{ +Invisibly returns a list with one element: +\describe{ +\item{\code{se}}{A 3D array of dimensions +\code{(length(conc) - 4) x 6 x length(edVec)} containing empirical +standard deviations of the estimated ED values. Rows correspond to the +number of concentration levels used (starting from 5). Columns correspond +to the number of replicates per concentration (1 to 6). The third dimension +corresponds to each ED level in \code{edVec}.} +} +The array values are also printed to the console during execution. +} +\description{ +Simulating ED values for a given model and given dose values. +} +\details{ +The arguments \code{mpar} and \code{sigma} are typically obtained from a +previous model fit. Only dose-response models assuming normally distributed +errors can be used. +} +\examples{ +ryegrass.m1 <- drm(ryegrass, fct = LL.4()) + +simDR( + mpar = coef(ryegrass.m1), + sigma = sqrt(summary(ryegrass.m1)$resVar), + fct = LL.4(), + noSim = 2, + conc = c(1.88, 3.75, 7.50, 0.94, 15, 0.47, 30, 0.23, 60), + seedVal = 20070723 +) + +} +\author{ +Christian Ritz, Hannes Reinwald +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/simFct.Rd b/man/simFct.Rd new file mode 100644 index 00000000..94446bd2 --- /dev/null +++ b/man/simFct.Rd @@ -0,0 +1,82 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/simFct.R +\name{simFct} +\alias{simFct} +\title{Simulation of dose-response data and ED estimation} +\usage{ +simFct( + noSim, + edVal = c(10, 20, 50), + type = c("non-parametric", "parametric"), + response = c("bin", "con"), + fct = LL.2(), + coefVec, + method = c("sp", "p", "np"), + doseVec, + nVec, + pVec, + rVec, + resVar, + pfct = fct, + reference = NULL, + span = NA, + minmax = "response", + lower = NULL, + upper = NULL, + seedVal = 200810201 +) +} +\arguments{ +\item{noSim}{integer. Number of simulations to run.} + +\item{edVal}{numeric vector of ED levels to estimate (default is \code{c(10, 20, 50)}).} + +\item{type}{character string. Either "non-parametric" or "parametric" simulation.} + +\item{response}{character string. Either "bin" (binomial) or "con" (continuous) response.} + +\item{fct}{dose-response function used for simulation (default is \code{LL.2()}).} + +\item{coefVec}{numeric vector of model coefficients for parametric simulation.} + +\item{method}{character string. Estimation method: "sp" (semi-parametric), "p" (parametric), +or "np" (non-parametric).} + +\item{doseVec}{numeric vector of dose values.} + +\item{nVec}{numeric vector of sample sizes per dose (for binomial response).} + +\item{pVec}{numeric vector of expected response probabilities (for non-parametric simulation).} + +\item{rVec}{numeric vector of responses.} + +\item{resVar}{numeric. Residual variance (for continuous response).} + +\item{pfct}{dose-response function used for fitting (defaults to \code{fct}).} + +\item{reference}{character string specifying the reference for ED estimation.} + +\item{span}{numeric. Smoothing parameter for local regression. NA uses default.} + +\item{minmax}{character string. Type of min/max calculation. Default is "response".} + +\item{lower}{numeric. Lower bounds for optimization.} + +\item{upper}{numeric. Upper bounds for optimization.} + +\item{seedVal}{integer. Random seed for reproducibility (default is 200810201).} +} +\value{ +A list with components \code{edArray} (array of ED estimates), \code{mixVec}, +\code{edVal}, \code{aicVec}, and \code{spanVec}. +} +\description{ +Simulates dose-response datasets using parametric or non-parametric methods and estimates +effective doses (ED values) from each simulated dataset. Useful for assessing the +performance of ED estimation methods via Monte Carlo simulation. +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/spinach.Rd b/man/spinach.Rd new file mode 100644 index 00000000..3fb751bb --- /dev/null +++ b/man/spinach.Rd @@ -0,0 +1,49 @@ +\name{spinach} + +\alias{spinach} + +\docType{data} + +\title{Inhibition of photosynthesis} + +\description{ + Data from an experiment investigating the inhibition of photosynthesis in response to two synthetic + photosystem II inhibitors, the herbicides diuron and bentazon. + More specifically, the effect of oxygen consumption of thylakoid membranes (chloroplasts) from spinach + was measured after incubation with the synthetic inhibitors in 5 assays, resulting in 5 dose-response curves. +} + +\usage{data(spinach)} + +\format{ + A data frame with 105 observations on the following four variables: + \describe{ + \item{CURVE}{a numeric vector specifying the assay or curve (a total of 5 independent assays where used in this experiment).} + \item{HERBICIDE}{a character vector specifying the herbicide applied: bentazon or diuron.} + \item{DOSE}{a numeric vector giving the herbicide concentration in muMol.} + \item{SLOPE}{a numeric vector with the measured response: oxygen consumption of thylakoid membranes.} + } +} + +\details{ + The experiment is described in more details by Streibig (1998). +} + +\source{ + Streibig, J. C. (1998) Joint action of natural and synthetic photosystem II inhibitors, \emph{Pesticide Science}, \bold{55}, 137--146. +} + +\examples{ +library(drc) + +## Displaying the first rows in the dataset +head(spinach) + +## Fitting a four-parameter log-logistic model with separate curves per herbicide +spinach.m1 <- drm(SLOPE ~ DOSE, HERBICIDE, data = spinach, fct = LL.4()) +summary(spinach.m1) + +## Plotting the fitted curves +plot(spinach.m1, xlab = "Dose (muMol)", ylab = "Oxygen consumption (slope)") +} +\keyword{datasets} diff --git a/man/splitInd.Rd b/man/splitInd.Rd new file mode 100644 index 00000000..170c6768 --- /dev/null +++ b/man/splitInd.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/EDcomp.R +\name{splitInd} +\alias{splitInd} +\title{Split index vectors into shared and unique components} +\usage{ +splitInd(ind1, ind2) +} +\description{ +Split index vectors into shared and unique components +} +\keyword{internal} diff --git a/man/summary.drc.Rd b/man/summary.drc.Rd index 9bf653eb..ea22fbcb 100644 --- a/man/summary.drc.Rd +++ b/man/summary.drc.Rd @@ -1,35 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/summary.drc.R \name{summary.drc} - \alias{summary.drc} - \title{Summarising non-linear model fits} - -\description{ - 'summary' compiles a comprehensive summary for objects of class 'drc'. +\usage{ +\method{summary}{drc}(object, od = FALSE, pool = TRUE, ...) } +\arguments{ +\item{object}{an object of class 'drc'.} -\usage{ +\item{od}{logical. If TRUE adjustment for over-dispersion is used.} - \method{summary}{drc}(object, od = FALSE, pool = TRUE, ...) -} +\item{pool}{logical. If TRUE curves are pooled. Otherwise they are not. This +argument only works for models with independently fitted curves as +specified in \code{\link{drm}}.} -\arguments{ - \item{object}{an object of class 'drc'.} - \item{od}{logical. If TRUE adjustment for over-dispersion is used.} - \item{pool}{logical. If TRUE curves are pooled. Otherwise they are not. This argument only works for models with - independently fitted curves as specified in \code{\link{drm}}.} - \item{...}{additional arguments.} +\item{...}{additional arguments.} } - \value{ - A list of summary statistics that includes parameter estimates and estimated standard errors. +A list of summary statistics that includes parameter estimates and +estimated standard errors. } +\description{ +\code{summary} compiles a comprehensive summary for objects of class 'drc'. +} +\examples{ +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +summary(ryegrass.m1) -\author{Christian Ritz} - - - -%\examples{} - +} +\seealso{ +\code{\link{drm}}, \code{\link{coef.drc}}, \code{\link{confint.drc}} +} +\author{ +Christian Ritz +} \keyword{models} \keyword{nonlinear} diff --git a/man/terbuthylazin.Rd b/man/terbuthylazin.Rd new file mode 100644 index 00000000..514d393a --- /dev/null +++ b/man/terbuthylazin.Rd @@ -0,0 +1,47 @@ +\name{terbuthylazin} + +\alias{terbuthylazin} + +\docType{data} + +\title{The effect of terbuthylazin on growth rate} + +\description{ + Test on the effect of terbuthylazin on \emph{Lemna minor}, performed on an aseptic + culture according to the OECD-guidelines. +} + +\usage{data(terbuthylazin)} + +\format{ + A data frame with 30 observations on the following 2 variables. + \describe{ + \item{dose}{a numeric vector of dose values.} + \item{rgr}{a numeric vector of relative growth rates.} + } +} + +\details{ + Dose is \deqn{\mu l^{-1}} and rgr is the relative growth rate of \emph{Lemna}. +} + +\source{ + Cedergreen N. (2004). Unpublished bioassay data. +} + +\examples{ +library(drc) + +## displaying first 6 rows of the data set +head(terbuthylazin) + +## Fitting log-logistic model +terbuthylazin.m1 <- drm(rgr~dose, data = terbuthylazin, fct = LL.4()) +summary(terbuthylazin.m1) + +## Fitting log-logistic model +## with Box-Cox transformation +terbuthylazin.m2 <- boxcox(terbuthylazin.m1, method = "anova") +summary(terbuthylazin.m2) +} +\keyword{datasets} diff --git a/man/threephase.Rd b/man/threephase.Rd new file mode 100644 index 00000000..6a86de66 --- /dev/null +++ b/man/threephase.Rd @@ -0,0 +1,47 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/threephase.R +\name{threephase} +\alias{threephase} +\title{Three-Phase Dose-Response Model} +\usage{ +threephase( + fixed = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), + names = c("b1", "c1", "d1", "e1", "b2", "d2", "e2", "b3", "d3", "e3"), + fctName, + fctText +) +} +\arguments{ +\item{fixed}{numeric vector specifying which parameters are fixed and at what value +they are fixed. NAs are used for parameters that are not fixed.} + +\item{names}{a vector of character strings giving the names of the parameters +(should not contain ":"). The default is reasonable.} + +\item{fctName}{optional character string used internally by convenience functions.} + +\item{fctText}{optional character string used internally by convenience functions.} +} +\value{ +A list containing the nonlinear function, the self starter function, +and the parameter names. +} +\description{ +A ten-parameter dose-response model combining three log-logistic components, +extending the two-phase model (\code{\link{twophase}}) for describing even more +complex dose-response patterns. +} +\details{ +The model function is the sum of a four-parameter log-logistic model and two +three-parameter log-logistic models: + +\deqn{f(x) = \mathrm{LL.4}(x; b1, c1, d1, e1) + \mathrm{LL.3}(x; b2, d2, e2) + \mathrm{LL.3}(x; b3, d3, e3)} +} +\seealso{ +\code{\link{twophase}}, \code{\link{llogistic}} +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/twophase.Rd b/man/twophase.Rd index d7fc3c7e..4ed11a77 100644 --- a/man/twophase.Rd +++ b/man/twophase.Rd @@ -1,64 +1,55 @@ -\name{twophase} - -\Rdversion{1.1} - -\alias{twophase} - -\title{ - Two-phase dose-response model -} - -\description{ - The two-phase dose-response model is a combination of log-logistic models that should be useful for describing - more complex dose-response patterns. -} - -\usage{ - twophase(fixed = c(NA, NA, NA, NA, NA, NA, NA), - names = c("b1", "c1", "d1", "e1", "b2", "d2", "e2"), fctName, fctText) -} - -\arguments{ - \item{fixed}{numeric vector specifying which parameters are fixed and at what value they are fixed. - NAs are used for parameters that are not fixed.} - \item{names}{a vector of character strings giving the names of the parameters (should not contain ":"). - The default is reasonable (see under 'Usage').} - \item{fctName}{optional character string used internally by convenience functions.} - \item{fctText}{optional character string used internally by convenience functions.} -} - -\details{ - Following Groot \emph{et al} (1996) the two-phase model function is defined as follows - - \deqn{ f(x) = c + \frac{d1-c}{1+\exp(b1(\log(x)-\log(e1)))} + \frac{d2}{1+\exp(b2(\log(x)-\log(e2)))}} - - For each of the two phases, the parameters have the same interpretation as in the ordinary log-logistic - model. -} - -\value{ - The value returned is a list containing the nonlinear function, the self starter function - and the parameter names. -} - -\references{ - Groot, J. C. J., Cone, J. W., Williams, B. A., Debersaques, F. M. A., Lantinga, E. A. (1996) - Multiphasic analysis of gas production kinetics for in vitro fermentation of ruminant feeds, - \emph{Animal Feed Science Technology}, \bold{64}, 77--89. -} - -\author{ - Christian Ritz -} - -%\note{} - -\seealso{ - The basic component in the two-phase model is the log-logistic model - \code{\link{llogistic}}. -} - -%\examples{} - -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/twophase.R +\name{twophase} +\alias{twophase} +\title{Two-Phase Dose-Response Model} +\usage{ +twophase( + fixed = c(NA, NA, NA, NA, NA, NA, NA), + names = c("b1", "c1", "d1", "e1", "b2", "d2", "e2"), + fctName, + fctText +) +} +\arguments{ +\item{fixed}{numeric vector specifying which parameters are fixed and at what value +they are fixed. NAs are used for parameters that are not fixed.} + +\item{names}{a vector of character strings giving the names of the parameters +(should not contain ":"). The default is reasonable.} + +\item{fctName}{optional character string used internally by convenience functions.} + +\item{fctText}{optional character string used internally by convenience functions.} +} +\value{ +A list containing the nonlinear function, the self starter function, +and the parameter names. +} +\description{ +A seven-parameter dose-response model combining two log-logistic components, +useful for describing more complex dose-response patterns. +} +\details{ +Following Groot \emph{et al} (1996) the two-phase model function is: + +\deqn{f(x) = c + \frac{d1-c}{1+\exp(b1(\log(x)-\log(e1)))} + \frac{d2}{1+\exp(b2(\log(x)-\log(e2)))}} + +For each of the two phases, the parameters have the same interpretation as in +the ordinary log-logistic model. +} +\references{ +Groot, J. C. J., Cone, J. W., Williams, B. A., Debersaques, F. M. A., +Lantinga, E. A. (1996) Multiphasic analysis of gas production kinetics for +in vitro fermentation of ruminant feeds, +\emph{Animal Feed Science Technology}, \bold{64}, 77--89. +} +\seealso{ +The basic component in the two-phase model is the log-logistic model +\code{\link{llogistic}}. +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/ucedergreen.Rd b/man/ucedergreen.Rd new file mode 100644 index 00000000..9ab0ab13 --- /dev/null +++ b/man/ucedergreen.Rd @@ -0,0 +1,65 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ucedergreen.R +\name{ucedergreen} +\alias{ucedergreen} +\title{U-shaped Cedergreen-Ritz-Streibig model} +\usage{ +ucedergreen( + fixed = c(NA, NA, NA, NA, NA), + names = c("b", "c", "d", "e", "f"), + method = c("loglinear", "anke", "method3", "normolle"), + ssfct = NULL, + alpha, + fctName, + fctText +) +} +\arguments{ +\item{fixed}{A numeric vector of length 5 specifying any parameters to be held fixed +during the estimation. The order is \code{c(b, c, d, e, f)}. Use \code{NA} for +parameters that should be estimated. The default is to estimate all parameters.} + +\item{names}{A character vector of length 5 providing names for the parameters. +The default is \code{c("b", "c", "d", "e", "f")}.} + +\item{method}{A character string specifying the method for the self-starter function +to use for finding initial parameter values. Options are \code{"loglinear"}, +\code{"anke"}, \code{"method3"}, and \code{"normolle"}. This is only used if \code{ssfct} is \code{NULL}.} + +\item{ssfct}{A custom self-starter function. If \code{NULL} (the default), a +self-starter is automatically generated by calling \code{\link{cedergreen.ssf}} +with the specified \code{method}, \code{fixed}, and \code{alpha} arguments.} + +\item{alpha}{A mandatory numeric value specifying the fixed shape parameter \eqn{\alpha}. +The function will stop if this is not provided.} + +\item{fctName}{An optional character string to name the function object.} + +\item{fctText}{An optional character string providing a descriptive text for the model.} +} +\value{ +A list of class \code{"UCRS"}, containing the model function (\code{fct}), +the self-starter function (\code{ssfct}), parameter names (\code{names}), and other +components required for use with modeling functions like \code{\link[drc]{drm}}. +} +\description{ +\code{ucedergreen} provides a very general way of specifying the Cedergreen-Ritz-Streibig +modified log-logistic model for describing u-shaped hormesis, under various constraints on the parameters. +} +\details{ +The u-shaped model is given by the expression +\deqn{f(x) = c + d - \frac{d-c+f \exp(-1/x^{\alpha})}{1+\exp(b(\log(x)-\log(e)))}} +} +\references{ +Cedergreen, N. and Ritz, C. and Streibig, J. C. (2005) +Improved empirical models describing hormesis, +\emph{Environmental Toxicology and Chemistry} \bold{24}, 3166--3172. +} +\seealso{ +\code{\link{cedergreen}}, \code{\link{UCRS.4a}}, \code{\link{UCRS.5a}}, \code{\link{drm}} +} +\author{ +Christian Ritz, Hannes Reinwald +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/uml3a.Rd b/man/uml3a.Rd new file mode 100644 index 00000000..0f110491 --- /dev/null +++ b/man/uml3a.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ucedergreen.R +\name{uml3a} +\alias{uml3a} +\title{Alias for UCRS.4a} +\usage{ +uml3a(names = c("b", "d", "e", "f"), ...) +} +\arguments{ +\item{names}{a vector of character strings giving the names of the parameters.} + +\item{...}{additional arguments passed to \code{\link{ucedergreen}}.} +} +\description{ +\code{uml3a} is an alias for \code{\link{UCRS.4a}}. +} +\seealso{ +\code{\link{UCRS.4a}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/uml3b.Rd b/man/uml3b.Rd new file mode 100644 index 00000000..723d9d8b --- /dev/null +++ b/man/uml3b.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ucedergreen.R +\name{uml3b} +\alias{uml3b} +\title{Alias for UCRS.4b} +\usage{ +uml3b(names = c("b", "d", "e", "f"), ...) +} +\arguments{ +\item{names}{a vector of character strings giving the names of the parameters.} + +\item{...}{additional arguments passed to \code{\link{ucedergreen}}.} +} +\description{ +\code{uml3b} is an alias for \code{\link{UCRS.4b}}. +} +\seealso{ +\code{\link{UCRS.4b}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/uml3c.Rd b/man/uml3c.Rd new file mode 100644 index 00000000..bdeb9faa --- /dev/null +++ b/man/uml3c.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ucedergreen.R +\name{uml3c} +\alias{uml3c} +\title{Alias for UCRS.4c} +\usage{ +uml3c(names = c("b", "d", "e", "f"), ...) +} +\arguments{ +\item{names}{a vector of character strings giving the names of the parameters.} + +\item{...}{additional arguments passed to \code{\link{ucedergreen}}.} +} +\description{ +\code{uml3c} is an alias for \code{\link{UCRS.4c}}. +} +\seealso{ +\code{\link{UCRS.4c}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/uml4a.Rd b/man/uml4a.Rd new file mode 100644 index 00000000..b21eccb7 --- /dev/null +++ b/man/uml4a.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ucedergreen.R +\name{uml4a} +\alias{uml4a} +\title{Alias for UCRS.5a} +\usage{ +uml4a(names = c("b", "c", "d", "e", "f"), ...) +} +\arguments{ +\item{names}{a vector of character strings giving the names of the parameters.} + +\item{...}{additional arguments passed to \code{\link{ucedergreen}}.} +} +\description{ +\code{uml4a} is an alias for \code{\link{UCRS.5a}}. +} +\seealso{ +\code{\link{UCRS.5a}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/uml4b.Rd b/man/uml4b.Rd new file mode 100644 index 00000000..7362d48c --- /dev/null +++ b/man/uml4b.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ucedergreen.R +\name{uml4b} +\alias{uml4b} +\title{Alias for UCRS.5b} +\usage{ +uml4b(names = c("b", "c", "d", "e", "f"), ...) +} +\arguments{ +\item{names}{a vector of character strings giving the names of the parameters.} + +\item{...}{additional arguments passed to \code{\link{ucedergreen}}.} +} +\description{ +\code{uml4b} is an alias for \code{\link{UCRS.5b}}. +} +\seealso{ +\code{\link{UCRS.5b}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/uml4c.Rd b/man/uml4c.Rd new file mode 100644 index 00000000..6efc982d --- /dev/null +++ b/man/uml4c.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ucedergreen.R +\name{uml4c} +\alias{uml4c} +\title{Alias for UCRS.5c} +\usage{ +uml4c(names = c("b", "c", "d", "e", "f"), ...) +} +\arguments{ +\item{names}{a vector of character strings giving the names of the parameters.} + +\item{...}{additional arguments passed to \code{\link{ucedergreen}}.} +} +\description{ +\code{uml4c} is an alias for \code{\link{UCRS.5c}}. +} +\seealso{ +\code{\link{UCRS.5c}} +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/upFixed.Rd b/man/upFixed.Rd new file mode 100644 index 00000000..f027b3b4 --- /dev/null +++ b/man/upFixed.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/llogistic2.R +\name{upFixed} +\alias{upFixed} +\title{Construct Text for Model with Fixed Upper Limit} +\usage{ +upFixed(modelStr, upper) +} +\arguments{ +\item{modelStr}{character string with the base model description.} + +\item{upper}{numeric value for the fixed upper limit.} +} +\value{ +A character string describing the model with its fixed upper limit. +} +\description{ +Helper function that appends upper limit information to a model description +string. +} +\keyword{internal} diff --git a/man/update.drc.Rd b/man/update.drc.Rd index 3687bc45..ad0f010c 100644 --- a/man/update.drc.Rd +++ b/man/update.drc.Rd @@ -1,41 +1,35 @@ -\name{update.drc} - -\alias{update.drc} - -\title{Updating and re-fitting a model} - -\description{ - 'update' updates and re-fits a model on the basis of an object of class 'drc'. -} - -\usage{ - - \method{update}{drc}(object, ..., evaluate = TRUE) - -} - -\arguments{ - \item{object}{an object of class 'drc'.} - \item{...}{arguments to alter in object.} - \item{evaluate}{logical. If TRUE model is re-fit; otherwise an unevaluated call is returned.} -} - -\value{ - An object of class 'drc'. -} - -\author{Christian Ritz} - -\examples{ - -## Fitting a four-parameter Weibull model -model1 <- drm(ryegrass, fct = W1.4()) - -## Updating 'model1' by fitting a three-parameter Weibull model instead -model2 <- update(model1, fct = W1.3()) -anova(model2, model1) - - -} -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/update.drc.R +\name{update.drc} +\alias{update.drc} +\title{Updating and re-fitting a model} +\usage{ +\method{update}{drc}(object, ..., evaluate = TRUE) +} +\arguments{ +\item{object}{an object of class 'drc'.} + +\item{...}{arguments to alter in object.} + +\item{evaluate}{logical. If TRUE model is re-fit; otherwise an unevaluated call is returned.} +} +\value{ +An object of class 'drc'. +} +\description{ +\code{update} updates and re-fits a model on the basis of an object of class 'drc'. +} +\examples{ +## Fitting a four-parameter Weibull model +model1 <- drm(ryegrass, fct = W1.4()) + +## Updating 'model1' by fitting a three-parameter Weibull model instead +model2 <- update(model1, fct = W1.3()) +anova(model2, model1) + +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/ursa.Rd b/man/ursa.Rd index 2f0e3b19..1722b10c 100644 --- a/man/ursa.Rd +++ b/man/ursa.Rd @@ -1,107 +1,66 @@ -\name{ursa} - -\Rdversion{1.1} - -\alias{ursa} -\alias{genursa} -\alias{actimL} - -\alias{genLoewe} -\alias{genLoewe2} -\alias{iceLoewe.1} -\alias{iceLoewe2.1} - -\alias{genBliss} -\alias{genBliss2} - -\title{ - Model function for the universal response surface approach (URSA) for the quantitative assessment of drug interaction -} - -\description{ - URSA provides a parametric approach for modelling the joint action of several agents. The model allows quantification of synergistic effects through a single parameter. -} - -\usage{ - ursa(fixed = rep(NA, 7), names = c("b1", "b2", "c", "d", "e1", "e1", "f"), - ssfct = NULL) - -} - -\arguments{ - \item{fixed}{numeric vector. Specifies which parameters are fixed and at what value they are fixed. NAs for parameter that are not fixed.} - \item{names}{a vector of character strings giving the names of the parameters. The default is reasonable.} - \item{ssfct}{a self starter function to be used (optional).} -} - -\details{ - The model function is defined implicitly through an appropriate equation. More details are provided by Greco et al (1990, 1995). -} - -\value{ - A list containing the nonlinear function, the self starter function, and the parameter names. -} - -\references{ - - Greco, W. R. and Park H. S. and Rustum, Y. M. (1990) Application of a New Approach for the Quantitation of Drug Synergism - to the Combination of cis-Diamminedichloroplatinum and 1-beta-D-Arabinofuranosylcytosine, \emph{Cancer Research}, \bold{50}, 5318--5327. - - Greco, W. R. Bravo, G. and Parsons, J. C. (1995) The Search for Synergy: A Critical Review from a Response Surface Perspective, - \emph{Pharmacological Reviews}, \bold{47}, Issue 2, 331--385. -} - -\author{ - Christian Ritz after an idea by Hugo Ceulemans. -} - -%\note{} - -\seealso{ - Other models for fitting mixture data are the Hewlett and Voelund models \code{\link{mixture}}. -} - -\examples{ - -## Here is the complete statistical analysis of the data -## from Greco et al. (1995) by means of the URSA model -if (FALSE) -{ -d1 <- c(0, 0, 0, 0, 0, 0, 0, 0, 2, 5, 10, 20, 50, 2, 2, 2, -2, 2, 5, 5, 5, 5, 5, 10, 10, 10, 10, 10, 20, 20, 20, 20, -20, 50, 50, 50, 50, 50) - -d2 <- c(0, 0, 0, 0.2, 0.5, 1, 2, 5, 0, 0, 0, 0, 0, 0.2, -0.5, 1, 2, 5, 0.2, 0.5, 1, 2, 5, 0.2, 0.5, 1, 2, 5, 0.2, -0.5, 1, 2, 5, 0.2, 0.5, 1, 2, 5) - -effect <- c(106.00, 99.20, 115.00, 79.20, 70.10, 49.00, -21.00, 3.83, 74.20, 71.50,48.10, 30.90, 16.30, 76.30, -48.80, 44.50, 15.50, 3.21, 56.70, 47.50, 26.80, 16.90, -3.25, 46.70, 35.60, 21.50, 11.10, 2.94, 24.80, 21.60, -17.30, 7.78, 1.84, 13.60, 11.10, 6.43, 3.34, 0.89) - -greco <- data.frame(d1, d2, effect) - -greco.m1 <- drm(effect ~ d1 + d2, data = greco, fct = ursa(fixed = c(NA, NA, 0, NA, NA, NA, NA))) - -plot(fitted(greco.m1), residuals(greco.m1)) # wedge-shaped - -summary(greco.m1) - -## Transform-both-sides approach using a logarithm transformation -greco.m2 <- drm(effect ~ d1 + d2, data = greco, fct = ursa(fixed = c(NA, NA, 0, NA, NA, NA, NA)), -bcVal = 0, control = drmc(relTol = 1e-12)) - -plot(fitted(greco.m2), residuals(greco.m2)) # looks okay - -summary(greco.m2) -# close to the estimates reported by Greco et al. (1995) -} - -} - -\keyword{models} -\keyword{nonlinear} - -%\concept{Hill 4-parameter four-parameter} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ursa.R +\name{ursa} +\alias{ursa} +\title{Universal Response Surface Approach (URSA) for Drug Interaction} +\usage{ +ursa( + fixed = rep(NA, 7), + names = c("b1", "b2", "c", "d", "e1", "e2", "f"), + ssfct = NULL +) +} +\arguments{ +\item{fixed}{numeric vector. Specifies which parameters are fixed and at what value +they are fixed. NAs for parameters that are not fixed.} + +\item{names}{a vector of character strings giving the names of the parameters. +The default is reasonable.} + +\item{ssfct}{a self starter function to be used (optional).} +} +\value{ +A list containing the nonlinear function, the self starter function, +and the parameter names. +} +\description{ +URSA provides a parametric approach for modelling the joint action of several +agents. The model allows quantification of synergistic effects through a single +parameter. The model function is defined implicitly through an appropriate equation. +} +\examples{ +d1 <- c(0, 0, 0, 0, 0, 0, 0, 0, 2, 5, 10, 20, 50, 2, 2, 2, + 2, 2, 5, 5, 5, 5, 5, 10, 10, 10, 10, 10, 20, 20, 20, 20, + 20, 50, 50, 50, 50, 50) +d2 <- c(0, 0, 0, 0.2, 0.5, 1, 2, 5, 0, 0, 0, 0, 0, 0.2, + 0.5, 1, 2, 5, 0.2, 0.5, 1, 2, 5, 0.2, 0.5, 1, 2, 5, 0.2, + 0.5, 1, 2, 5, 0.2, 0.5, 1, 2, 5) +effect <- c(106, 99.2, 115, 79.2, 70.1, 49, 21, 3.83, 74.2, + 71.5, 48.1, 30.9, 16.3, 76.3, 48.8, 44.5, 15.5, 3.21, + 56.7, 47.5, 26.8, 16.9, 3.25, 46.7, 35.6, 21.5, 11.1, + 2.94, 24.8, 21.6, 17.3, 7.78, 1.84, 13.6, 11.1, 6.43, + 3.34, 0.89) +greco <- data.frame(d1, d2, effect) +greco.m1 <- drm(effect ~ d1 + d2, data = greco, + fct = ursa(fixed = c(NA, NA, 0, NA, NA, NA, NA))) +summary(greco.m1) + +} +\references{ +Greco, W. R. and Park H. S. and Rustum, Y. M. (1990) Application of a New +Approach for the Quantitation of Drug Synergism to the Combination of +cis-Diamminedichloroplatinum and 1-beta-D-Arabinofuranosylcytosine, +\emph{Cancer Research}, \bold{50}, 5318--5327. + +Greco, W. R. Bravo, G. and Parsons, J. C. (1995) The Search for Synergy: +A Critical Review from a Response Surface Perspective, +\emph{Pharmacological Reviews}, \bold{47}, Issue 2, 331--385. +} +\seealso{ +Other models for fitting mixture data: \code{\link{mixture}}. +} +\author{ +Christian Ritz after an idea by Hugo Ceulemans. +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/vcov.drc.Rd b/man/vcov.drc.Rd index e89e1a38..93927b05 100644 --- a/man/vcov.drc.Rd +++ b/man/vcov.drc.Rd @@ -1,42 +1,44 @@ -\name{vcov.drc} - -\alias{vcov.drc} - -\title{Calculating variance-covariance matrix for objects of class 'drc'} - -\description{ - 'vcov' returns the estimated variance-covariance matrix for the parameters in the non-linear function. -} - -\usage{ - \method{vcov}{drc}(object, ..., corr = FALSE, od = FALSE, pool = TRUE, unscaled = FALSE) -} - -\arguments{ - \item{object}{an object of class 'drc'.} - \item{...}{additional arguments.} - \item{corr}{logical. If TRUE a correlation matrix is returned.} - \item{od}{logical. If TRUE adjustment for over-dispersion is used. This argument only makes a difference for - binomial data.} - \item{pool}{logical. If TRUE curves are pooled. Otherwise they are not. This argument only works for models with - independently fitted curves as specified in \code{\link{drm}}.} - \item{unscaled}{logical. If TRUE the unscaled variance-covariance is returned. This argument only makes a difference - for continuous data.} -} - -\value{ - A matrix of estimated variances and covariances. -} - -\author{Christian Ritz} - -\examples{ - -## Fitting a four-parameter log-logistic model -ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) -vcov(ryegrass.m1) -vcov(ryegrass.m1, corr = TRUE) - -} -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/vcov.drc.R +\name{vcov.drc} +\alias{vcov.drc} +\title{Calculating variance-covariance matrix for objects of class 'drc'} +\usage{ +\method{vcov}{drc}(object, ..., corr = FALSE, od = FALSE, pool = TRUE, unscaled = FALSE) +} +\arguments{ +\item{object}{an object of class 'drc'.} + +\item{...}{additional arguments.} + +\item{corr}{logical. If TRUE a correlation matrix is returned.} + +\item{od}{logical. If TRUE adjustment for over-dispersion is used. This +argument only makes a difference for binomial data.} + +\item{pool}{logical. If TRUE curves are pooled. Otherwise they are not. This +argument only works for models with independently fitted curves as +specified in \code{\link{drm}}.} + +\item{unscaled}{logical. If TRUE the unscaled variance-covariance is +returned. This argument only makes a difference for continuous data.} +} +\value{ +A matrix of estimated variances and covariances. +} +\description{ +\code{vcov} returns the estimated variance-covariance matrix for the +parameters in the non-linear function. +} +\examples{ +## Fitting a four-parameter log-logistic model +ryegrass.m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +vcov(ryegrass.m1) +vcov(ryegrass.m1, corr = TRUE) + +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/vec2mat.Rd b/man/vec2mat.Rd new file mode 100644 index 00000000..cfc05e4b --- /dev/null +++ b/man/vec2mat.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fct2list.R +\name{vec2mat} +\alias{vec2mat} +\title{Convert function specification to list} +\usage{ +vec2mat(fct, no) +} +\description{ +Convert function specification to list +} +\keyword{internal} diff --git a/man/vinclozolin.Rd b/man/vinclozolin.Rd new file mode 100644 index 00000000..aca4fd0e --- /dev/null +++ b/man/vinclozolin.Rd @@ -0,0 +1,53 @@ +\name{vinclozolin} + +\alias{vinclozolin} + +\docType{data} + +\title{Vinclozolin from AR in vitro assay} + +\description{ + Dose-response experiment with vinclozolin in an AR reporter gene assay +} + +\usage{data(vinclozolin)} + +\format{ + A data frame with 53 observations on the following 3 variables. + \describe{ + \item{\code{exper}}{a factor with levels \code{10509} \code{10821} \code{10828} \code{10904} \code{11023} \code{11106}} + \item{\code{conc}}{a numeric vector of concentrations of vinclozolin} + \item{\code{effect}}{a numeric vector of luminescense effects} + } +} + +\details{ + The basic dose-response experiment was repeated 6 times on different days. Chinese Hamster Ovary cells + were exposed to various concentrations of vinclozolin for 22 hours and the resulting luminescense effects + were recorded. + + Data are part of mixture experiment reported in Nellemann \emph{et al} (2003). +} + +\source{ + Nellemann C., Dalgaard M., Lam H.R. and Vinggaard A.M. (2003) + The combined effects of vinclozolin and procymidone do not deviate from expected additivity \emph{in vitro} + and \emph{in vivo}, \emph{Toxicological Sciences}, \bold{71}, 251--262. +} + +%\references{} + +\examples{ +library(drc) + +vinclozolin.m1 <- drm(effect~conc, exper, data=vinclozolin, fct = LL.3()) +plot(vinclozolin.m1, xlim=c(0,50), ylim=c(0,2800), conLevel=1e-4) + +vinclozolin.m2 <- drm(effect~conc, data=vinclozolin, fct = LL.3()) +plot(vinclozolin.m2, xlim=c(0,50), conLevel=1e-4, add=TRUE, type="none", col="red") + +## Are the ED50 values indetical across experiments? +vinclozolin.m3 <- update(vinclozolin.m1, pmodels=data.frame(exper, exper, 1)) +anova(vinclozolin.m3, vinclozolin.m1) # No! +} +\keyword{datasets} diff --git a/man/voelund.Rd b/man/voelund.Rd new file mode 100644 index 00000000..6adf3ea4 --- /dev/null +++ b/man/voelund.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/voelund.R +\name{voelund} +\alias{voelund} +\title{Voelund Mixture Model} +\usage{ +voelund( + fixed = c(NA, NA, NA, NA, NA, NA, NA), + names = c("b", "c", "d", "e", "f", "g", "h"), + method = c("1", "2", "3", "4"), + ssfct = NULL, + eps = 1e-10 +) +} +\arguments{ +\item{fixed}{numeric vector. Specifies which parameters are fixed and at what value +they are fixed. NAs for parameters that are not fixed.} + +\item{names}{a vector of character strings giving the names of the parameters +(should not contain ":").} + +\item{method}{character string indicating the self starter function to use.} + +\item{ssfct}{a self starter function to be used (optional).} + +\item{eps}{numeric tolerance for handling zero dose values.} +} +\value{ +A list containing the nonlinear model function, the self starter function, +and the parameter names. +} +\description{ +Provides the Voelund model for describing the joint action of two compounds +in binary mixture experiments. Used internally by \code{\link{mixture}}. +} +\seealso{ +\code{\link{mixture}}, \code{\link{hewlett}} +} +\author{ +Christian Ritz +} +\keyword{internal} diff --git a/man/weibull1.Rd b/man/weibull1.Rd index d3f89741..98bafb8a 100644 --- a/man/weibull1.Rd +++ b/man/weibull1.Rd @@ -1,109 +1,82 @@ -\name{weibull1} - -\alias{weibull1} -\alias{weibull2} -\alias{weibull2x} - -\title{Weibull model functions} - -\description{ - 'weibull' and 'weibull2' provide a very general way of specifying Weibull dose response functions, - under various constraints on the parameters. -} - -\usage{ - weibull1(fixed = c(NA, NA, NA, NA), - names = c("b", "c", "d", "e"), - method = c("1", "2", "3", "4"), - ssfct = NULL, - fctName, fctText) - - weibull2(fixed = c(NA, NA, NA, NA), - names = c("b", "c", "d", "e"), - method = c("1", "2", "3", "4"), - ssfct = NULL, - fctName, fctText) - - weibull2x(fixed = rep(NA, 5), - names = c("b", "c", "d", "e", "t0"), - method = c("1", "2", "3", "4"), - ssfct = NULL, - fctName, fctText) - -} - -\arguments{ - \item{fixed}{numeric vector. Specifies which parameters are fixed and at what value they are fixed. - NAs for parameter that are not fixed.} - \item{names}{a vector of character strings giving the names of the parameters (should not contain ":"). - The default is reasonable (see under 'Usage'). The order of the parameters is: b, c, d, e (see under 'Details').} - \item{method}{character string indicating the self starter function to use.} - \item{ssfct}{a self starter function to be used.} - \item{fctName}{optional character string used internally by convenience functions.} - \item{fctText}{optional character string used internally by convenience functions.} -} - -\details{ - As pointed out in Seber and Wild (1989), there exist two different parameterisations of the Weibull model. They - do not yield the same fitted curve for a given dataset (see under Examples). - - The four-parameter Weibull type 1 model ('weibull1') is - \deqn{ f(x) = c + (d-c) \exp(-\exp(b(\log(x)-\log(e)))).} - - Thw four-parameter Weibull type 2 model ('weibull2') is - \deqn{ f(x) = c + (d-c) (1 - \exp(-\exp(b(\log(x)-\log(e))))).} - - Both four-parameter model functions are asymmetric with inflection point at the dose equal \eqn{e}. -} - -\value{ - The value returned is a list containing the non-linear function, the self starter function - and the parameter names. -} - -\references{ - Seber, G. A. F. and Wild, C. J (1989) - \emph{Nonlinear Regression}, - New York: Wiley \& Sons (pp. 338--339). -} - -\author{Christian Ritz} - -\note{ - The functions are for use with the function \code{\link{drm}}. - -} - -\seealso{ - For convenience several special cases of the function 'weibull1' are available: - \code{\link{W1.2}}, \code{\link{W1.3}} and \code{\link{W1.4}}. - - Special cases of 'weibull2' are: - \code{\link{W2.2}}, \code{\link{W2.3}} and \code{\link{W2.4}}. - - These convenience functions should be used rather than the underlying functions - \code{weibull1} and \code{weibull2}. -} - -\examples{ - -## Fitting two different Weibull models -ryegrass.m1 <- drm(ryegrass, fct = W1.4()) -plot(ryegrass.m1, conLevel=0.5) - -ryegrass.m2 <- drm(ryegrass, fct = W2.4()) -plot(ryegrass.m2, conLevel=0.5, add = TRUE, type = "none", col = 2) -# you could also look at the ED values to see the difference - -## A four-parameter Weibull model with b fixed at 1 -ryegrass.m3 <- drm(ryegrass, fct = W1.4(fixed = c(1, NA, NA, NA))) -summary(ryegrass.m3) - -## A four-parameter Weibull model with the constraint b>3 -ryegrass.m4 <- drm(ryegrass, fct = W1.4(), lowerl = c(3, -Inf, -Inf, -Inf), -control = drmc(constr=TRUE)) -summary(ryegrass.m4) - -} -\keyword{models} -\keyword{nonlinear} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/weibull1.R +\name{weibull1} +\alias{weibull1} +\title{The four-parameter Weibull type 1 model} +\usage{ +weibull1( + fixed = c(NA, NA, NA, NA), + names = c("b", "c", "d", "e"), + method = c("1", "2", "3", "4"), + ssfct = NULL, + fctName, + fctText +) +} +\arguments{ +\item{fixed}{numeric vector of length 4. Specifies which parameters are +fixed and at what value. Use \code{NA} for parameters that are not fixed.} + +\item{names}{character vector of length 4 giving the names of the +parameters \code{b}, \code{c}, \code{d}, and \code{e}.} + +\item{method}{character string indicating the self starter function to use +for obtaining starting values (\code{"1"} (default), \code{"2"}, +\code{"3"}, or \code{"4"}). See Details.} + +\item{ssfct}{a self starter function to be used. If \code{NULL} (default), +the built-in self starter is used.} + +\item{fctName}{optional character string used internally for the function +name.} + +\item{fctText}{optional character string used internally for the function +text description.} +} +\value{ +A list of class \code{Weibull-1} containing the nonlinear function, +self starter function, and parameter names. +} +\description{ +The general Weibull type 1 model for fitting dose-response data. +} +\details{ +The four-parameter Weibull type 1 model is given by the expression +\deqn{f(x) = c + (d - c) \exp(-\exp(b(\log(x) - \log(e))))} + +The model is sometimes also called the Gompertz model. + +The \code{method} argument determines how starting values for the parameters +\code{b} and \code{e} are estimated (the starting values for \code{c} and +\code{d} are always based on the range of the response values). Four methods +are available: +\describe{ +\item{\code{"1"} (default)}{Linear regression on transformed data. Applies a +log-log transformation to the response and a log transformation to the +dose, then fits a linear regression to estimate starting values for +\code{b} and \code{e}.} +\item{\code{"2"}}{Anke's procedure. Estimates \code{e} by finding the dose +at which the response crosses the midpoint between \code{c} and \code{d}, +then estimates \code{b} as the median of back-calculated values.} +\item{\code{"3"}}{Stepwise approach. Identifies where the mean response +crosses the midpoint between \code{c} and \code{d} and uses the +corresponding dose as the starting value for \code{e}. The starting value +for \code{b} is based on the sign of the slope at that point.} +\item{\code{"4"}}{Normolle's procedure. Uses the mean of the dose range as +an initial estimate for \code{e}, then estimates \code{b} and \code{e} +using median-based back-calculations.} +} +} +\references{ +Seber, G. A. F. and Wild, C. J. (1989) +\emph{Nonlinear Regression}, New York: Wiley & Sons (pp. 338--339). +} +\seealso{ +\code{\link{W1.2}}, \code{\link{W1.3}}, \code{\link{W1.4}}, +\code{\link{weibull2}} +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/weibull1.ssf.Rd b/man/weibull1.ssf.Rd new file mode 100644 index 00000000..f754e6d1 --- /dev/null +++ b/man/weibull1.ssf.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/weibull1.ssf.R +\name{weibull1.ssf} +\alias{weibull1.ssf} +\title{Self-starter for Weibull type 1 model} +\usage{ +weibull1.ssf(method = c("1", "2", "3", "4"), fixed, useFixed = FALSE) +} +\description{ +Self-starter for Weibull type 1 model +} +\keyword{internal} diff --git a/man/weibull2.Rd b/man/weibull2.Rd new file mode 100644 index 00000000..6aebe4f0 --- /dev/null +++ b/man/weibull2.Rd @@ -0,0 +1,77 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/weibull2.R +\name{weibull2} +\alias{weibull2} +\title{The four-parameter Weibull (type 2) model} +\usage{ +weibull2( + fixed = c(NA, NA, NA, NA), + names = c("b", "c", "d", "e"), + method = c("1", "2", "3", "4"), + ssfct = NULL, + fctName, + fctText +) +} +\arguments{ +\item{fixed}{numeric vector of length 4, specifying fixed parameters (use \code{NA} for +parameters that should be estimated).} + +\item{names}{character vector of length 4 giving the names of the parameters +(default \code{c("b", "c", "d", "e")}).} + +\item{method}{character string indicating the self starter method to use for +obtaining starting values. One of \code{"1"} (default), \code{"2"}, +\code{"3"}, or \code{"4"}. See Details.} + +\item{ssfct}{a self starter function. If \code{NULL} (default), a built-in +self starter is used based on \code{method}.} + +\item{fctName}{optional character string used internally for the function name.} + +\item{fctText}{optional character string used internally for the function description.} +} +\value{ +A list containing the nonlinear function, self starter function, +and parameter names. The list has class \code{"Weibull-2"}. +} +\description{ +Provides a general framework for the four-parameter Weibull type 2 model +given by the equation +\deqn{f(x) = c + (d - c)(1 - \exp(-\exp(b(\log(x) - \log(e)))))} +} +\details{ +The \code{method} argument determines how starting values for the parameters +\code{b} and \code{e} are estimated (the starting values for \code{c} and +\code{d} are always based on the range of the response values). Four methods +are available: +\describe{ +\item{\code{"1"} (default)}{Linear regression on transformed data. Applies a +complementary log-log transformation to the response and a log +transformation to the dose, then fits a linear regression to estimate +starting values for \code{b} and \code{e}.} +\item{\code{"2"}}{Anke's procedure. Estimates \code{e} by finding the dose +at which the response crosses the midpoint between \code{c} and \code{d}, +then estimates \code{b} as the median of back-calculated values.} +\item{\code{"3"}}{Stepwise approach. Identifies where the mean response +crosses the midpoint between \code{c} and \code{d} and uses the +corresponding dose as the starting value for \code{e}. The starting value +for \code{b} is based on the sign of the slope at that point.} +\item{\code{"4"}}{Normolle's procedure. Uses the mean of the dose range as +an initial estimate for \code{e}, then estimates \code{b} and \code{e} +using median-based back-calculations.} +} +} +\references{ +Seber, G. A. F. and Wild, C. J. (1989) +\emph{Nonlinear Regression}, New York: Wiley & Sons (pp. 338--339). +} +\seealso{ +\code{\link{weibull1}}, \code{\link{W2.2}}, \code{\link{W2.3}}, +\code{\link{W2.4}} +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/weibull2.ssf.Rd b/man/weibull2.ssf.Rd new file mode 100644 index 00000000..5bdc49fe --- /dev/null +++ b/man/weibull2.ssf.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/weibull2.ssf.R +\name{weibull2.ssf} +\alias{weibull2.ssf} +\title{Self-starter for Weibull type 2 model} +\usage{ +weibull2.ssf(method = c("1", "2", "3", "4"), fixed, useFixed = FALSE) +} +\description{ +Self-starter for Weibull type 2 model +} +\keyword{internal} diff --git a/man/weibull2x.Rd b/man/weibull2x.Rd new file mode 100644 index 00000000..daf8ead1 --- /dev/null +++ b/man/weibull2x.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/weibull2x.R +\name{weibull2x} +\alias{weibull2x} +\title{Five-parameter Weibull type 2 model with lag time} +\usage{ +weibull2x( + fixed = rep(NA, 5), + names = c("b", "c", "d", "e", "t0"), + method = c("1", "2", "3", "4"), + ssfct = NULL, + fctName, + fctText +) +} +\arguments{ +\item{fixed}{numeric vector of length 5. Specifies which parameters are +fixed and at what value. Use \code{NA} for parameters that should be +estimated (default is \code{rep(NA, 5)}).} + +\item{names}{character vector of length 5 giving the names of the +parameters (default is \code{c("b", "c", "d", "e", "t0")}).} + +\item{method}{character string indicating the self starter method to use. +One of \code{"1"}, \code{"2"}, \code{"3"}, or \code{"4"}.} + +\item{ssfct}{a self starter function. If \code{NULL} (default), a built-in +self starter is used.} + +\item{fctName}{optional character string specifying the function name +(used internally).} + +\item{fctText}{optional character string specifying the function description +(used internally).} +} +\value{ +A list of class \code{"Weibull-2"} containing the nonlinear +function, self starter function, and parameter names. +} +\description{ +A five-parameter Weibull type 2 model extended with a lag time parameter +\code{t0}. The model is given by the expression +\deqn{f(x) = c + (d - c)(1 - \exp(-\exp(b(\log(x - t0) - \log(e)))))} +for \eqn{x > t0} and \eqn{f(x) = c} otherwise. +} +\details{ +The lag time parameter \code{t0} cannot be fixed. +} +\seealso{ +\code{\link{weibull2}}, \code{\link{W2x.3}}, \code{\link{W2x.4}} +} +\author{ +Christian Ritz +} +\keyword{models} +\keyword{nonlinear} diff --git a/man/yieldLoss.Rd b/man/yieldLoss.Rd index 722c1cd2..45c66fd5 100644 --- a/man/yieldLoss.Rd +++ b/man/yieldLoss.Rd @@ -1,68 +1,57 @@ -\name{yieldLoss} - -\alias{yieldLoss} - -\title{Calculating yield loss parameters} - -\description{ - Calculation of parameters in the re-parameterization of the Michaelis-Menten model that is commonly - used to assess yield loss (the rectangular hyperbola model) -} - -\usage{ - yieldLoss(object, interval = c("none", "as"), level = 0.95, display = TRUE) -} - -\arguments{ - \item{object}{object of class 'drc} - \item{interval}{character string specifying the type of confidence intervals to be supplied. The default is "none". - Use "as" for asymptotically-based confidence intervals.} - \item{level}{numeric. The level for the confidence intervals. The default is 0.95.} - \item{display}{logical. If TRUE results are displayed. Otherwise they are not (useful in simulations).} -} - -\details{ - The rectangular hyperbola model is a reparameterization of the Michaelis-Menten in terms of parameters - \eqn{A} and \eqn{I} - - \deqn{ Y_L = \frac{Id}{1+Id/A}} - - where \eqn{d} denotes the weed density and \eqn{Y_L} the resulting yield loss. -} - -\value{ - For each of the two parameters, a matrix with two or more columns, containing the estimates - and the corresponding estimated standard errors and possibly lower and upper confidence limits. -} - -\references{ - Cousens, R. (1985). A simple model relating yield loss to weed density, - \emph{Ann. Appl. Biol.}, \bold{107}, 239--252. -} - -\author{Christian Ritz} - -\note{ - This function is only for use with model fits based on Michaelis-Menten models. -} - -%\seealso{} - -\examples{ - -## Fitting Michaelis-Menten model -met.mm.m1 <- drm(gain~dose, product, data = methionine, fct = MM.3(), -pmodels = list(~1, ~factor(product), ~factor(product))) - -## Yield loss parameters with standard errrors -yieldLoss(met.mm.m1) - -## Also showing confidence intervals -yieldLoss(met.mm.m1, "as") - -} - -\keyword{models} -\keyword{nonlinear} - -\concept{rectangular hyperbola model} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/yieldLoss.R +\name{yieldLoss} +\alias{yieldLoss} +\title{Calculating yield loss parameters} +\usage{ +yieldLoss(object, interval = c("none", "as"), level = 0.95, display = TRUE) +} +\arguments{ +\item{object}{object of class 'drc'.} + +\item{interval}{character string specifying the type of confidence intervals. The default is "none". +Use "as" for asymptotically-based confidence intervals.} + +\item{level}{numeric. The level for the confidence intervals. The default is 0.95.} + +\item{display}{logical. If TRUE results are displayed. Otherwise they are not (useful in simulations).} +} +\value{ +For each of the two parameters, a matrix with two or more columns, containing the estimates +and the corresponding estimated standard errors and possibly lower and upper confidence limits. +} +\description{ +Calculation of parameters in the re-parameterization of the Michaelis-Menten model that is commonly +used to assess yield loss (the rectangular hyperbola model). +} +\details{ +The rectangular hyperbola model is a reparameterization of the Michaelis-Menten in terms of parameters +\eqn{A} and \eqn{I}: +\deqn{Y_L = \frac{Id}{1+Id/A}}{Y_L = Id / (1 + Id/A)} +where \eqn{d} denotes the weed density and \eqn{Y_L} the resulting yield loss. +} +\note{ +This function is only for use with model fits based on Michaelis-Menten models. +} +\examples{ +## Fitting Michaelis-Menten model +met.mm.m1 <- drm(gain~dose, product, data = methionine, fct = MM.3(), +pmodels = list(~1, ~factor(product), ~factor(product))) + +## Yield loss parameters with standard errors +yieldLoss(met.mm.m1) + +## Also showing confidence intervals +yieldLoss(met.mm.m1, "as") + +} +\references{ +Cousens, R. (1985). A simple model relating yield loss to weed density, +\emph{Ann. Appl. Biol.}, \bold{107}, 239--252. +} +\author{ +Christian Ritz +} +\concept{rectangular hyperbola model} +\keyword{models} +\keyword{nonlinear} diff --git a/news b/news deleted file mode 100644 index 2ee5e15c..00000000 --- a/news +++ /dev/null @@ -1,364 +0,0 @@ -## Changes in 'drc' - -2017-12-19: Updating the event-time part of "drc", in particular in drm() (improved code provided by Andrea Onofri). - -2017-09-29: The argument checkND has been added to the predict method. It allows switching off comparing names of variables -in the the original data frame and the "newdata" data frame: It's useful for predicting in e.g., mixture models (after a report -by Evan Palmer-Young). - -2017-05-31: Confidence intervals for ED values may now be obtained using inverse regression (interval = "inv"). - -2017-05-29: Species sensitivity distributions may now be fitted using drm() with type = "ssd". The predict method is now by default -constraining predicted values to meaningful ranges. The predict method allows incorporating standard errors of estimates in the confidence -bands for fitted SSD's. - -2017-01-05: Small bug in mixture() resolved (after a report by Andrew Kniss). - -2016-11-15: Negative binomial distributions may now be fitted using the argument type with values "negbin1" and -"negbin2" (after a suggestion from Signe M. Jensen). - -2016-10-21: Argument "conCheck" added to drmc(), to switch on/off handling of control measurements. Help page for -the two- and three-parameter Weilbull models has been updated, removing typos -(after a report by Mikael Gustavsson). - -2016-07-25: na.omit() is now the default in drm(). New functions included: CIcomp(), CIcompX(), and plotFACI() for calculating combination indices -based on effective doses and also effects as described in the paper by Martin-Betancor et al. (2015). An accompanying -dataset named "metals" has also been included. - -2016-07-21: A small bug in printing confidence intervals has been fixed (after a report from Johannes Ranke). The -output text has also been modified slightly. - -2016-06-03: A small error for binomial data in the function estfun.drc for use with the package "sandwich" has been fixed (after a report from Andrew Kniss). - -2015-12-16: The predict method has been updated (after a report from Duncan Mackay). The function SI() -has been completely replaced by the function EDcomp(). - -2015-09-16: The function isobole() now also propagates graphical arguments to fitted isoboles. - -2015-08-19: The print.summary.drc method shows a warning message in case of df<1. -Calculation of the log likelihood for binomial data has updated and improved. - -2015-08-14: The function backfit() has been updated. - -2015-08-10: The function diagnostics() has been removed. - -2015-08-07: Help page for EDcomp() updated. - -2015-07-30: Robust estimation is working again (ater reports from Kathy Mutambanengwe, Sten Ilmjrv, and Corina Dueas Roca). - -2015-04-14: Minor labelling issue in the plot method resolved (with help from Bert Oosthuyse). - -2015-04-13: Help pages for ED() and isobole() has been updated. Some code has been tidied up. - -2015-04-12: The plot method extended to provide confidence bands (contribution by Gregory Warnes). - -2014-12-17: The argument "pshifts" has been added to drm() to allow weights on parameters -(after a comment from Florent Baty). - -2014-11-13: The argument "control" is now correctly propagated in case separate = TRUE in drm() -(after a report from Andy Liaw). - -2014-06-30: The help page for ursa() has been improved (in particular the example section). - -2014-06-25: A number of not fully implemented model functions for mixture data have been removed. - -2014-04-23: The model function gammadr() and multi2() have been added. - -2014-04-06: The argument "vcov." has been added to compParm(). - -2014-03-26: The argument "vcov." has been added to EDcomp() and predict(). - -2014-03-19: The argument "vcov." has been added to ED() to allow choosing between the standard vcov method and -the sandwich function for robust standard errors. SI() has been renamed into EDcomp(). - -2014-03-05: The bread and estfun methods have been extended to event-time data. The help page for G.aparine -has been improved. - -2014-03-03: A number of functions depending on ED() and SI() have been updated. The predict method has been improved. -Plot functionality for event-time data has been improved (after a report from Eshagh Keshtkar). - -2014-02-24: ED() and SI() return (invisible) a list with 1 components where the second can be used directly with -the package multcomp (after a suggestion by Daniel Gerhard). - -2014-02-12: Small bug in the plot method (not ordering labels in legend text correctly) has been fixed -(after a report by Francois Keck). - -2013-10-22: Adding "fixed" value to output from logistic() (after a suggestion from Daniel Gerhard). - -2013-10-01: Help page for "germination" has been updated. - -2013-09-30: bread.drc() and estfun.drc() have been updated to handle fits for binomial and Poisson data -(after a suggestion by Signe M. Jensen). - -2013-08-22: Help page for plot.drc() has been improved regarding the explanation on the use of error bars -(after an enquiry from Julien Delafontaine). - -2013-05-24: Help page for "selenium" has been improved (after a comment from Keith Taulbee). - -2013-05-21: An argument for specifying the reference for the normalization (after a suggestion from Sunniva Foerster). - -2013-05-14: An argument for showing normalized data and fitted curves has been added to the plot method (after a suggestion -from Ludwig A. Hothorn). - -2013-03-25: Help page for mselect() has been improved (after a comment from Sona Jesenska). - -2013-02-11: cedergreen() has been improved to provide meaningful names (after a suggestion from Dave Smithson). - -2013-01-11: plot methods works for fits obtained from drm() using separate = TRUE (after a report from Thomas Kroeber). - -2012-12-29: Model functions gaussian() and lgaussian() have been included (after a suggestion from Ismael Rodea). The method -for residuals has been extended to provide residuals on the transformed scale in case a Box-cox transformation -was applied. - -2012-12-14: Help page for maED() has been extended. - -2012-11-19: Small bug in drm() related to starting values for event-time models resolved. - -2012-10-22: hatvalues and cooks.distance methods have been added (after a question from Sunniva Frster). -noEffect() function included for testing the dose-response model against a simpler model with no dose effect -(after a suggestion by Ryan Hechinger). - -2012-09-08: backfit() function added (after a suggestion by Keld Sorensen). - -2012-08-25: Poisson models can be fitted weights (after a suggestion by Marie Laure Delignette-Muller). - -2012-08-20: Help page of NEC() has been updated. - -2012-07-04: Small error in plot.drc for event times fixed (after report from Christian Andreasen). - -2012-06-22: vcov.drc() has been updated. - -2012-05-29: ED() now also works for gompertz models (after a question from Calvin Odero). - -2012-05-29: The dataset germination has been included. - -2012-05-27: The dataset chickweed has been included. - -2012-05-23: Help page of lettuce has been revised. - -2012-05-16: The dataset selenium has been included. - -2012-05-16: Limit in dose scaling has been lifted (after a report from Andreas Wernitznig). - -2012-03-13: Help page for the function modelFit() has been revised (removing a typo in the title) (after a comment from John Lynch). - -2012-03-01: Help page for the function mr.test() has been updated. - -2012-02-20: Summary output for separate = TRUE now shows the original labels (levels in the variable curveid) (thanks a comment from Radu Slobodeanu). - -2012-01-23: Small scaling error in fitted method has been removed (after a report from Andreas Betz). - -2011-12-28: Plotting for event-time data has been improved. - -2011-12-21: Error in calculation of ED values for fplogistic() has been fixed. - -2011-12-16: Help page of drm() (type argument) has been updated (after comment from Radu Slobodeanu). - -2011-12-07: Error in label ordering and calculation of standard errors in SI() have been fixed (bug report by Andrew Kniss). - -2011-11-06: Problem with confidence intervals in the predict method has been solved (was reported on R-help sometimes ago: 2010-11-28). - -2011-10-27: Help page of mixture() has been slightly improved. - -2011-09-20: Problem with logDose argument in drm() and subsequent plotting has been solved (reported by Ralf Schfer). - -2011-09-02: Constrained estimation uses the actual limits provided (bug report by Andrew Kniss). - -2011-08-31: The functions genLoewe(), genLoewe2(), genBliss(), genBliss2(), and ursa() have been improved w.r.t. starting values. The model specification has also been simplified. - -2011-08-24: genBliss() and genBliss2() has been updated (after suggestions from Hugo Ceulemans). Functions iceLoewe1() and iceLoewe2.1() have -benn added. - -2011-08-23: Error in ED calculation for the logistic models (e.g., L.4()) has been fixed (after a report from Daniel Gerhard). The error was caused by an update of the function deltaMethod() in alr3 has been fixed. - -2011-07-04: Small changes for the anova method. Adding df for event time and Poisson models. - -2011-07-01: Small update in the calculation of confidence intervals (after a suggestion from Scott Ray). - -2011-06-24: The model function W2x.4() has been added (after a suggestion by Ccile Cornou). - -2011-05-24: Small improvement in the calculation of ED value for the log-normal and Weibull type 2 models. -"display" and "type" arguments have been added to maED(). - -2011-05-19: The argument "type" can now also take the value "event" for fitting event times. - -2011-05-10: The help page for spinach has been improved. - -2011-05-02: Simplifying the R lines in print.summary.drc() for printing the summary output of a model fit. - -2011-05-02: The self starter function for llogistic models can now handle infinite dose values (after a report from Marc Weimer). - -2011-04-09: multdrc() has been completely removed. - -2011-04-04: The model function weibull2x() (a model including a sort of "lag time" parameter) -has been added (after a suggestion by Ccile Cornou). - -2011-03-23: A small bug in ED() has been fixed (after a report from Nathan Pace). - -2011-03-09: The BIC method has been removed (after suggestion from Prof. Brian Ripley). - -2011-02-04: The functions isobole() and mixture() have been modified in order to fix an error in the plotting of -the isoboles (after a report from Andreas Betz). - -2010-12-16: The model function genursa2() has been replaced by actimL(). - -2010-12-14: The model genursa2() for fitting the generalized URSA model has been included (after an idea by Hugo Ceulemans). - -2010-12-10: The model genursa() for fitting the generalized URSA model has been included (after an idea by Hugo Ceulemans). - -2010-12-09: The model function genBliss(), genBliss2(), and genLoewe2() for fitting generalized Bliss independence and Loewe additivity with different maxima has been included (after an idea by Hugo Ceulemans). - -2010-11-23: The model function genLoewe() for fitting generalized Loewe additivity has been included (after an idea by Hugo Ceulemans). - -2010-11-16: Small improvement in the summary output. Now the actual curve names are used. - -2010-11-11: A small bug in ED() (mismatch of curve names and parameter estimates) has been fixecd (after a report from Andreas Betz). - -2010-11-03: A small bug in the plot produced by isobole() has been fixed (after an inquiry from Andreas Betz). - -2010-10-12: A bug in the calculation of standard errors in SI() has been fixed (after a report from Andrea Onofri). - -2010-09-23: mselect() has been extended to include an argument for specifying the type of information criterion to use. - -2010-09-20: maED() has been extended to include simple linear regression. - -2010-09-16: mselect() has been extended to include a few standard polynomial regression models. - -2010-08-03: Studentised residuals are now also available for binomial responses (after an inquiry from Stuart Rosen). - -2010-06-04: Studentised residuals are now also available (after an inquiry from John). - -2010-06-02: ED values are now correct for cedergreen() models (after a bug report by Claire Della Vedova). - -2010-05-31: Small bug in plot.drc() related to "xt" and "xtlab" arguments has been fixed (after a comment by Anja Coors). A small bug in comped() has also been fixed (after a question from Jochen Zubrod). - -2010-05-06: The argument "clevel" has been added to ED(). The function maED() has been extended and now also handles model fits -involving several curves (after a suggestion from Andre Kleensang). - -2010-04-29: Dataset 'ecvam' has been removed. The mixdrc() function has been temperarily removed. - -2010-04-23: Minor bug in the predict method has been fixed. This means that type="bars" in the plot method now works again -(after a bug report by Andy Robinson). - -2010-04-16: The help for NEC() has been improved (after a question from Ins Gonzlez). - -2010-04-15: The comped() has been re-introduced (after suggestion from Jochen Zubrod). - -2010-03-17: logLik has been extended with a "nobs" attribute (provided by Tobias Verbeke). A S4 BIC method has been added -(also provided by Tobias Verbeke). - -2010-03-12: The help page of drm() has been improved a bit w.r.t. the use of weights (after a question by Xuesong Yu). - -2010-03-10: A slight modification in vcov.drc() to suppress unnecessary error messages (reported by Xuesong Yu). - -2010-01-26: A slightly different bisection method has been implemented in ursa(). The corresponding help page has also been extended (more example lines). - -2010-01-13: The model function ursa() for describing combination effects has been added (after an idea by Hugo Ceulemans). -The help page for MM.2() and MM.3() has been improved. - -2010-01-11: The model function cedergreen() has been updated to ensure correct calculation of ED values (reported by Claire Della Vedova). - -2009-11-17: The help page of drm() has been updated. - -2009-10-13: confint has been improved to automatically use the appropriate reference distribution for the confidence intervals; -Internal structure of ED() has also been modified (reported by Marc Weimer). - -2009-10-12: The self starter for twophase() has been slightly improved. - -2009-09-03: The functions NEC.2(), NEC.3(), NEC.4() for estimation of no effect concentration have been included (after an idea by Ralf Schaefer). - -2009-09-03: The function comped() has been removed. - -2009-09-02: The argument "extended" has been added to the function maED(). - -2009-09-01: The model function twophase() based on log-logistic models has been added (after an idea by Ida Katarina Auf der Maur Hindrichsen). - -2009-07-28: Small bug in cedergreen() and ucedergreen() related to calculation of ED values has been fixed (reported by Clare Della Vedova). - -2009-07-27: Small bug in the function modelFit() has been fixed (after feedback from Heike Schmitt). - -2009-07-27: Help page for CRS.5a has been improved (after comment from Claire Della Vedova). - -2009-07-06: The functions lin.test(), mr.test(), and neill.test() have been added. - -2009-06-30: The data frame etmotc has been included. - -2009-06-08: The argument 'display' (with same functionality as in Ed()) has been added for compParm() (after a suggestion from Scott Ray). - -2009-06-02: The help pages for anova.drc and BC.4(), BC.5(), CRS.5.() have been improved. - -2009-05-29: The dataset ecvam has been included (migrated from the package 'mrdrc'). - -2009-05-28: The function maED() for parametric model averaging has been added. - -2009-05-27: The functions fplogistic() and FPL.4() enable fitting dose-response models based on fractional polynomials. The function maED() -can be used to do model-average based estimation of ED values. - -2009-05-24: Structure of self starter functions has been completely revamped. Four initial value procedure are now available for -almost all implemented dose-response models. - -2009-05-23: The function getInitial() has been included. - -2009-05-20: Help page for ED() has been improved (after comment from Claire Della Vedova). - -2009-05-07: Bug in ED() concerning the arguments type="absolute" and reference="upper" has been resolved (reported by Yue Zeng-Li). - -2009-04-22: Help page for gompertz() has been improved slightly. - -2009-04-08: Help page for earthworms dataset has been improved. Error in likelihood calculation for some binomial models has been fixed. - -2009-04-07: mixture() also works for binomial data. Argument "legendCex" in the plot method renamed into "cex.legend" in line with other cex arguments. - -2009-04-01: Minor internals changes in drm() and in the plot method. - -2009-03-27: The convenience functions b.3(), B.3(), b.4(), B.4(), b.5(), B.5(), and boltzmann have been removed. Use L.3(), L.4(), and L.5() instead. -compParm(), ED(), SI() have been restructured. drm() has been extended to allow fitting models separately for each curve. -confint, summary, vcov, ED, MAX, SI have a new argument "pool" to allow pooling of separate fits. Argument "ci" in relpot() and SI() has -been renamed into "interval". modelFit() now also works for binomial data. - -2009-03-25: The dataset "algae" has been included. vcov method has been re-structured. - -2009-03-24: The function plotraw() has been removed. Initial plots of the data should be done using R's standard plotting functionality, -e.g. plot and xyplot(). - -2009-03-19: The argument "conLevel" has a more sensible default (no longer hardcorded at 0.01). The argument "xsty" has been introduced -to control the arrangement of tick marks on the dose axis. - -2009-03-17: The function yieldLoss() has been included to handle a different parameterization of the Michaelis-Menten model -(after a suggestion by Andrew Kniss). - -2009-03-11: The argument "fctList" has been removed from drm(). - -2009-03-06: mixture() has been completely revised with a lot of changes to the arguments. The model function richards() has been removed -as it is simply a different parameterization of the five-parameter log-logistic model. colFct() has also been removed. - -2009-03-04: A new function modelFit() has been introduced for assessing the model fit, partly replacing the anova method. - -2009-02-27: Bug in mselect() has been fixed (reported by John Lewis). - -2009-02-25: Bug in boxcox.drc has been fixed. Moreover, this method has been extended to include functionality previously available through drm(). - -2009-02-19: multdrc() and associated mdControl have been taken completely out of use. drm() has been improved w.r.t. handling extremely -small or large dose or response values. Arguments "lowerc" and "upperc" have been removed in model functions as they were redundant. - -2009-02-13: Argument "ci" renames into "interval" in ED(). - -2009-02-12: Bug in predict.drc fixed (thanks to Mario D'Antuono). - -2009-02-09: Redundant encoding removed. Argument "fixed" added to BC.4() and BC.5() (thanks to Nina Cedergreen). - -2008-12-02: Dataset "H.virescens" added. Asymptotic regression and exponential decay implemented differently. - -2008-11-26: "lnormal" function has been added plus three new datasets. - -2008-11-18: "gompertz" function has been added. - -2008-11-13: Error in level argument in plot method has been fixed. - -2008-11-03 Datasets 'lepidium' and 'nasturtium' have been added. - -2008-10-31: Bug in 'level' argument in plot method has been fixed. - -2008-10-02: New function mrdrm() for model-robust modelling included. Accompanying ED and predict methods also added. - -2008-09-30: The lettuce dataset got correct row numbers. diff --git a/tests/package_coverage.log b/tests/package_coverage.log new file mode 100644 index 00000000..fde29ec2 --- /dev/null +++ b/tests/package_coverage.log @@ -0,0 +1,118 @@ +# OUTPUT from covr::package_coverage() +drc Coverage: 93.05% +R/modelFunction.R: 51.61% +R/drmOpt.R: 54.29% +R/anova.drclist.R: 66.30% +R/drm_legacy.R: 68.97% +R/logLik.drc.R: 70.00% +R/mselect.R: 71.19% +R/cooks.distance.drc.R: 75.00% +R/compParm.R: 78.43% +R/plot.drc.R: 79.08% +R/vcov.drc.R: 79.55% +R/comped.R: 80.00% +R/noEffect.R: 80.00% +R/llogistic.R: 81.01% +R/drmLOFbinomial.R: 81.82% +R/summary.drc.R: 84.44% +R/EDhelper.R: 84.62% +R/predict.drc.R: 84.62% +R/lnormal.ssf.R: 85.00% +R/drmEMls.R: 85.19% +R/EDinvreg.R: 86.21% +R/drm.R: 86.35% +R/update.drc.R: 86.67% +R/drmEMnegbin.R: 87.88% +R/weibull1.ssf.R: 88.89% +R/weibull2.ssf.R: 88.89% +R/llogistic.ssf.R: 89.47% +R/drmRobust.R: 91.11% +R/maED.R: 91.67% +R/ED.drc.R: 92.63% +R/rse.R: 93.33% +R/drmParNames.R: 94.12% +R/drmConvertParm.R: 94.44% +R/ucedergreen.R: 95.12% +R/drmEMPoisson.R: 96.00% +R/drmEMbinomial.R: 96.43% +R/print.summary.drc.R: 98.15% +R/ED_robust.R: 99.04% +R/lnormal.R: 99.38% +R/absToRel.R: 100.00% +R/anova.drc.R: 100.00% +R/arandaordaz.R: 100.00% +R/backfit.R: 100.00% +R/baro5.R: 100.00% +R/boxcox.drc.R: 100.00% +R/braincousens.R: 100.00% +R/braincousens.ssf.R: 100.00% +R/cedergreen.R: 100.00% +R/cedergreen.ssf.R: 100.00% +R/CIcompX.R: 100.00% +R/coef.drc.R: 100.00% +R/commatFct.R: 100.00% +R/confint.drc.R: 100.00% +R/CRS.6.R: 100.00% +R/drmc.R: 100.00% +R/drmEMeventtime.R: 100.00% +R/drmEMssd.R: 100.00% +R/drmEMstandard.R: 100.00% +R/drmLOFls.R: 100.00% +R/drmPNsplit.R: 100.00% +R/ED.lin.R: 100.00% +R/EDcomp.R: 100.00% +R/fct2list.R: 100.00% +R/findbe.R: 100.00% +R/findcd.R: 100.00% +R/fitted.drc.R: 100.00% +R/fplogistic.R: 100.00% +R/gammadr.R: 100.00% +R/gaussian.R: 100.00% +R/gaussian.ssf.R: 100.00% +R/getInitial.R: 100.00% +R/getMeanFunctions.R: 100.00% +R/gompertz.R: 100.00% +R/gompertz.ssf.R: 100.00% +R/gompertzd.R: 100.00% +R/hatvalues.drc.R: 100.00% +R/hewlett.R: 100.00% +R/idrm.R: 100.00% +R/isobole.R: 100.00% +R/lgaussian.R: 100.00% +R/lin.test.R: 100.00% +R/llogistic2.R: 100.00% +R/logistic.R: 100.00% +R/logistic.ssf.R: 100.00% +R/max.R: 100.00% +R/mixture.R: 100.00% +R/modelFit.R: 100.00% +R/mr.test.R: 100.00% +R/mrdrm.R: 100.00% +R/multi2.R: 100.00% +R/nec.R: 100.00% +R/neill.test.R: 100.00% +R/onAttach.R: 100.00% +R/pickParm.R: 100.00% +R/pr.R: 100.00% +R/print.drc.R: 100.00% +R/rdrm.R: 100.00% +R/relpot.R: 100.00% +R/repChar.R: 100.00% +R/residuals.drc.R: 100.00% +R/resPrint.R: 100.00% +R/Rsq.R: 100.00% +R/rss.R: 100.00% +R/sandwich.R: 100.00% +R/searchdrc.R: 100.00% +R/siInner.R: 100.00% +R/simDR.R: 100.00% +R/simFct.R: 100.00% +R/threephase.R: 100.00% +R/twophase.R: 100.00% +R/ursa.R: 100.00% +R/voelund.R: 100.00% +R/weibull1.R: 100.00% +R/weibull2.R: 100.00% +R/weibull2x.R: 100.00% +R/xlogx.R: 100.00% +R/yieldLoss.R: 100.00% \ No newline at end of file diff --git a/tests/seedGerminationMods.R b/tests/seedGerminationMods.R deleted file mode 100644 index f4d4f6a9..00000000 --- a/tests/seedGerminationMods.R +++ /dev/null @@ -1,35 +0,0 @@ -# test only works with package drcSeedGerm - -#One single germination curve ########################################## -# library(drcSeedGerm) -# mod <- drm(count ~ start + end, data=chickweed, type="event", fct=LL.3()) -# summary(mod) -# plot(mod) -# -# #Multiple germination curves ########################################## -# data(verbascum) -# # mod <- drm(nSeeds ~ timeBef + timeAf, data=verbascum, fct=LL.3(), -# # curveid=Species, type="event" ) -# -# #The error is due to the fact that the self starting routine returns a 'd' -# #value for the third species that is higher than 1. -# #The error can be overriden by manually supplying correct starting values -# verbascum_cum <- subset(verbascum, is.finite(timeAf)==T) -# mod <- drm(I(nCum/25) ~ timeAf, data=verbascum, fct=LL.3(), -# curveid=Species) -# mod2 <- drm(nSeeds ~ timeBef + timeAf, data=verbascum, fct=LL.3(), -# curveid=Species, type="event", start=coef(mod)) -# summary(mod2) -# plot(mod2) -# -# #Hydrotime-to-event model -# data(rape) -# HTEmod <- drm(nSeeds ~ timeBef + timeAf + Psi, data = rape, fct=HTE1(), type = "event") -# summary(HTEmod) -# -# #Thermal-time-to-event model -# data(barley) -# TTEmod <- drm(nSeeds ~ timeBef + timeAf + Temp, -# fct=TTERF(), data = barley, type="event") -# summary(TTEmod) - diff --git a/tests/test1.data1.txt b/tests/test1.data1.txt deleted file mode 100644 index 7b13a75e..00000000 --- a/tests/test1.data1.txt +++ /dev/null @@ -1,31 +0,0 @@ -no y x -1 3.641576e-08 1.0e-15 -2 3.790695e-08 1.0e-15 -3 3.414660e-08 1.0e-15 -4 4.092381e-08 2.0e+05 -5 4.475260e-08 2.0e+05 -6 3.321342e-08 2.0e+05 -7 4.550796e-08 7.0e+08 -8 3.455892e-08 7.0e+08 -9 3.951095e-08 7.0e+08 -10 4.137666e-08 3.0e+10 -11 4.596439e-08 3.0e+10 -12 3.619490e-08 3.0e+10 -13 3.558301e-08 6.0e+11 -14 2.790208e-08 6.0e+11 -15 3.526419e-08 6.0e+11 -16 1.991840e-08 8.0e+11 -17 2.311384e-08 8.0e+11 -18 2.268084e-08 8.0e+11 -19 1.586795e-08 8.5e+11 -20 1.725204e-08 8.5e+11 -21 1.721599e-08 8.5e+11 -22 1.353287e-08 9.0e+11 -23 1.511435e-08 9.0e+11 -24 1.242025e-08 9.0e+11 -25 9.421442e-09 9.5e+11 -26 9.228599e-09 9.5e+11 -27 1.103911e-08 9.5e+11 -28 7.549732e-09 1.0e+12 -29 7.359270e-09 1.0e+12 -30 8.346784e-09 1.0e+12 diff --git a/tests/test1.r b/tests/test1.r deleted file mode 100644 index 79d5acd7..00000000 --- a/tests/test1.r +++ /dev/null @@ -1,33 +0,0 @@ -## Test provided by Eddy Delpierre 2007-01-11 - - -#data1 <- read.table("c://stat//projects//R//drcurves//r-part//pkgfolder//drc//tests//test1.data1.txt", header = TRUE) -data1 <- read.table("test1.data1.txt", header = TRUE) -#data2 <- read.table("c://stat//projects//R//drcurves//r-part//pkgfolder//drc//tests//test1.w1.txt", header = TRUE) -data2 <- read.table("test1.w1.txt", header = TRUE) - -library(drc) - -#FIT1 <- drm(y~x, data = data1, fct = LL.4()) -#summary(FIT1) - -FIT2 <- drm(y~x, data = data1, fct = LL.4(method = "3")) -summary(FIT2) - -FIT3 <- drm(y~x, data = data1, fct = LL.4(method = "3"), weights = data2[, 2]) -summary(FIT3) -plot(FIT3) - -FIT4a <- drm(y~x, data=data1, fct=LL.4(fixed=c(6, -5e-9, NA, NA), method = "3")) -summary(FIT4a) -plot(FIT4a) - -FIT4 <- drm(y~x, data=data1, fct=LL.4(fixed=c(6, -5e-9, NA, NA), method = "3"), weights=data2[, 2]) -summary(FIT4) -plot(FIT4) - -FIT5 <- drm(y~x, data=data1, fct=LL.4(fixed=c(NA,1E-9,5E-8,1E+12))) -summary(FIT5) - -FIT6 <- drm(y~x, data=data1, fct=LL.4(fixed=c(NA,1E-9,5E-8,1E+12), method = "2")) -summary(FIT6) diff --git a/tests/test1.w1.txt b/tests/test1.w1.txt deleted file mode 100644 index 4e1c3c2c..00000000 --- a/tests/test1.w1.txt +++ /dev/null @@ -1,31 +0,0 @@ -no W -1 5240.290 -2 5136.184 -3 5411.607 -4 4943.243 -5 4727.057 -6 5487.104 -7 4687.662 -8 5379.228 -9 5030.849 -10 4916.118 -11 4664.330 -12 5256.254 -13 5301.255 -14 5986.620 -15 5325.165 -16 7085.537 -17 6577.547 -18 6640.036 -19 7938.521 -20 7613.420 -21 7621.387 -22 8596.171 -23 8134.020 -24 8972.941 -25 10302.469 -26 10409.554 -27 9517.721 -28 11508.911 -29 11656.888 -30 10945.621 diff --git a/tests/test2.r b/tests/test2.r deleted file mode 100644 index bd90a850..00000000 --- a/tests/test2.r +++ /dev/null @@ -1,37 +0,0 @@ -## Test provided by Pamela Hutchinson 2007-02-05 - -#pam <- read.csv("c://stat//projects//R//drcurves//r-part//pkgfolder//drc//tests//test2.redroot_dose.csv") -pam <- read.csv("test2.redroot_dose.csv") - -library(drc) - -## Initial model: different parameters for the resistant curve -## and for the susceptible curve - -## Temporarily taken out (May 23 2009) - -#m1 <- drm(biomass~dose, population, data=pam, fct=LL.4(method = "3")) -#summary(m1) -#plot(m1) - - -## Reduced model: common slope, lower and upper parameter for both curves, -## but e/ED50 parameters differ - -#m2 <- drm(biomass~dose, population, data=pam, fct=LL.4(method = "3"), pmodels=data.frame(1,1,1,population)) -#summary(m2) -#plot(m2) -#anova(m2,m1) - -## Further reduced model: all parameters in common -## This model is too simple: it is rejected - -#m3 <- drm(biomass~dose, population, data=pam, fct=LL.4(method = "3"), pmodels=data.frame(1,1,1,1)) -#summary(m3) -#plot(m3) -#anova(m3,m2) - - -## Final model is 'm2' with different ED50 values for resistant and susceptible, -## but the remaining parameters in common - diff --git a/tests/test2.redroot_dose.csv b/tests/test2.redroot_dose.csv deleted file mode 100644 index 008f8c1e..00000000 --- a/tests/test2.redroot_dose.csv +++ /dev/null @@ -1,145 +0,0 @@ -plot,dose,population,visual,biomass -1,0,susceptible,0,0.0238 -2,0,susceptible,0,0.0232 -3,0,susceptible,0,0.039 -4,0,susceptible,0,0.048 -5,0,susceptible,0,0.05 -6,0,susceptible,0,0.041 -7,0,susceptible,0,0.0246 -8,0,susceptible,0,0.051 -1,0.125,susceptible,100,0.0092 -2,0.125,susceptible,100,0.0104 -3,0.125,susceptible,100,0.0106 -4,0.125,susceptible,100,0.0052 -5,0.125,susceptible,100,0.011 -6,0.125,susceptible,100,0.0078 -7,0.125,susceptible,100,0.0082 -8,0.125,susceptible,100,0.011 -1,0.25,susceptible,100,0.0092 -2,0.25,susceptible,100,0.0056 -3,0.25,susceptible,100,0.0138 -4,0.25,susceptible,100,0.0044 -5,0.25,susceptible,100,0.008 -6,0.25,susceptible,100,0.0078 -7,0.25,susceptible,100,0.009 -8,0.25,susceptible,100,0.009 -1,0.5,susceptible,100,0.0052 -2,0.5,susceptible,100,0.007 -3,0.5,susceptible,100,0.0048 -4,0.5,susceptible,100,0.0066 -5,0.5,susceptible,100,0.0106 -6,0.5,susceptible,100,0.0154 -7,0.5,susceptible,100,0.0044 -8,0.5,susceptible,100,0.01 -1,1,susceptible,100,0.0094 -2,1,susceptible,100,0.0074 -3,1,susceptible,100,0.0126 -4,1,susceptible,100,0.0106 -5,1,susceptible,100,0.0068 -6,1,susceptible,100,0.0088 -7,1,susceptible,100,0.008 -8,1,susceptible,100,0.0116 -1,2,susceptible,100,0.008 -2,2,susceptible,100,0.006 -3,2,susceptible,100,0.0074 -4,2,susceptible,100,0.0052 -5,2,susceptible,100,0.0062 -6,2,susceptible,100,0.007 -7,2,susceptible,100,0.0156 -8,2,susceptible,100,0.0068 -1,4,susceptible,100,0.0072 -2,4,susceptible,100,0.01 -3,4,susceptible,100,0.0092 -4,4,susceptible,100,0.0082 -5,4,susceptible,100,0.007 -6,4,susceptible,100,0.0116 -7,4,susceptible,100,0.0094 -8,4,susceptible,100,0.0088 -1,8,susceptible,100,0.01 -2,8,susceptible,100,0.0094 -3,8,susceptible,100,0.012 -4,8,susceptible,100,0.011 -5,8,susceptible,100,0.0064 -6,8,susceptible,100,0.0098 -7,8,susceptible,100,0.007 -8,8,susceptible,100,0.009 -1,16,susceptible,100,0.012 -2,16,susceptible,100,0.006 -3,16,susceptible,100,0.0056 -4,16,susceptible,100,0.0058 -5,16,susceptible,100,0.0104 -6,16,susceptible,100,0.0072 -7,16,susceptible,100,0.0094 -8,16,susceptible,100,0.0038 -1,0,resistant,0,0.0236 -2,0,resistant,0,0.0482 -3,0,resistant,0,0.0438 -4,0,resistant,0,0.048 -5,0,resistant,0,0.0498 -6,0,resistant,0,0.0302 -7,0,resistant,0,0.0394 -8,0,resistant,0,0.028 -1,0.125,resistant,5,0.0436 -2,0.125,resistant,5,0.0324 -3,0.125,resistant,5,0.039 -4,0.125,resistant,5,0.0474 -5,0.125,resistant,5,0.0352 -6,0.125,resistant,5,0.038 -7,0.125,resistant,5,0.0186 -8,0.125,resistant,5,0.0312 -1,0.25,resistant,5,0.0332 -2,0.25,resistant,5,0.0225 -3,0.25,resistant,5,0.0258 -4,0.25,resistant,5,0.037 -5,0.25,resistant,10,0.0356 -6,0.25,resistant,10,0.0272 -7,0.25,resistant,5,0.029 -8,0.25,resistant,10,0.0242 -1,0.5,resistant,15,0.0236 -2,0.5,resistant,15,0.024 -3,0.5,resistant,20,0.0168 -4,0.5,resistant,20,0.027 -5,0.5,resistant,20,0.0168 -6,0.5,resistant,15,0.0356 -7,0.5,resistant,15,0.03 -8,0.5,resistant,10,0.0382 -1,1,resistant,20,0.0412 -2,1,resistant,20,0.026 -3,1,resistant,25,0.0272 -4,1,resistant,30,0.0114 -5,1,resistant,25,0.027 -6,1,resistant,15,0.0358 -7,1,resistant,20,0.0386 -8,1,resistant,25,0.0254 -1,2,resistant,60,0.0126 -2,2,resistant,100,0.0058 -3,2,resistant,75,0.008 -4,2,resistant,40,0.0294 -5,2,resistant,85,0.0092 -6,2,resistant,90,0.01275 -7,2,resistant,50,0.018 -8,2,resistant,40,0.0234 -1,4,resistant,85,0.0098 -2,4,resistant,90,0.0064 -3,4,resistant,85,0.0146 -4,4,resistant,95,0.0068 -5,4,resistant,85,0.012 -6,4,resistant,95,0.0098 -7,4,resistant,95,0.0125 -8,4,resistant,100,0.0044 -1,8,resistant,100,0.0084 -2,8,resistant,99,0.0056 -3,8,resistant,100,0.0088 -4,8,resistant,99,0.012 -5,8,resistant,100,0.0106 -6,8,resistant,100,0.01 -7,8,resistant,100,0.0074 -8,8,resistant,100,0.007 -1,16,resistant,100,0.0102 -2,16,resistant,100,0.0076 -3,16,resistant,100,0.0036 -4,16,resistant,100,0.0086 -5,16,resistant,100,0.007 -6,16,resistant,100,0.0144 -7,16,resistant,100,0.0088 -8,16,resistant,100,0.0108 diff --git a/tests/test3.r b/tests/test3.r deleted file mode 100644 index 5e7887a5..00000000 --- a/tests/test3.r +++ /dev/null @@ -1,37 +0,0 @@ -## Test provided by Nicholas Lewin-Koh 2007-03-01 - -library(drc) - -# First dataset -dat1 <- -structure(list(conc = c(500, 250, 125, 62.5, 31.25, 15.625, 7.8125, -3.90625, 500, 250, 125, 62.5, 31.25, 15.625, 7.8125, 3.90625, -500, 250, 125, 62.5, 31.25, 15.625, 7.8125, 3.90625), -response = -c(2.756, 2.167, 1.38, 0.873, 0.571, 0.43, 0.361, 0.326, 2.82, 2.174, 1.402, -0.911, 0.593, 0.458, 0.387, 0.348, 2.732, 2.143, 1.419, 0.874, -0.582, 0.442, 0.366, 0.331)), -.Names = c("conc", "response"), -row.names = as.integer(c(1, 2, 3, 4, 5, 6, 7, 8, 17, 18, 19, 20, 21, 22, 23, 24, 33, 34, -35, 36, 37, 38, 39, 40)), -class = "data.frame") - -m1 <- drm(response~conc, data=dat1, fct=LL.4()) -#m2 <- drm(response~conc, data=dat1, fct=LL.4(), adjust="vp") # huge standard errors - - -## Second dataset -dat2 <- -structure(list(conc = c(500, 250, 125, 62.5, 31.25, 15.625, 7.8125, -3.90625, 500, 250, 125, 62.5, 31.25, 15.625, 7.8125, 3.90625, -500, 250, 125, 62.5, 31.25, 15.625, 7.8125, 3.90625), -response = c(2.943, 2.337, 1.521, 0.989, 0.669, 0.481, 0.413, 0.36, 2.952, 2.272, -1.518, 0.974, 0.648, 0.493, 0.413, 0.36, 2.943, 2.309, 1.505, -0.979, 0.649, 0.478, 0.387, 0.34)), -.Names = c("conc", "response" ), -row.names = as.integer(c(49, 50, 51, 52, 53, 54, 55, 56, 65, -66, 67, 68, 69, 70, 71, 72, 81, 82, 83, 84, 85, 86, 87, 88)), -class = "data.frame") - -m3 <- drm(response~conc, data=dat2, fct=LL.4()) -#m4 <- drm(response~conc, data=dat2, fct=LL.4(), adjust="vp") # huge standard errors diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 00000000..58e91fe6 --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,4 @@ +library(testthat) +library(drc) + +test_check("drc") diff --git a/tests/testthat/test-CIcompX.R b/tests/testthat/test-CIcompX.R new file mode 100644 index 00000000..deb01e06 --- /dev/null +++ b/tests/testthat/test-CIcompX.R @@ -0,0 +1,308 @@ +## -------------------------------------------------------------------------- +## Tests for CIcompX, CIcomp, and plotFACI (R/CIcompX.R) +## -------------------------------------------------------------------------- + +# Shared test data: fit 3 dose-response models using acidiq dataset +# acidiq.17 = mixture model (17:83 ratio) +# acidiq.0 = pure substance 1 +# acidiq.100 = pure substance 2 +acidiq.0 <- drm(rgr ~ dose, data = subset(acidiq, pct == 999 | pct == 0), fct = LL.4()) +acidiq.100 <- drm(rgr ~ dose, data = subset(acidiq, pct == 999 | pct == 100), fct = LL.4()) +acidiq.17 <- drm(rgr ~ dose, data = subset(acidiq, pct == 17 | pct == 0), fct = LL.4()) + +modList <- list(acidiq.17, acidiq.0, acidiq.100) + +## ===== CIcompX tests ===== + +# --- Input validation --- + +test_that("CIcompX errors when mixProp < 0", { + expect_error( + CIcompX(-0.1, modList, c(10, 50)), + "Mixture proportion should be between 0 and 1" + ) +}) + +test_that("CIcompX errors when mixProp > 1", { + expect_error( + CIcompX(1.5, modList, c(10, 50)), + "Mixture proportion should be between 0 and 1" + ) +}) + +test_that("CIcompX errors when modelList is not a list", { + expect_error( + CIcompX(0.17, "not_a_list", c(10, 50)), + "Exactly 3 model fits should be provided in a list" + ) +}) + +test_that("CIcompX errors when modelList has wrong length", { + expect_error( + CIcompX(0.17, list(acidiq.17, acidiq.0), c(10, 50)), + "Exactly 3 model fits should be provided in a list" + ) +}) + +test_that("CIcompX errors when EDvec is empty", { + expect_error( + CIcompX(0.17, modList, numeric(0)), + "At least effective dose level should be specified" + ) +}) + +# --- Happy path: multiple ED levels, EDonly = FALSE --- + +test_that("CIcompX returns correct structure with multiple ED levels (EDonly=FALSE)", { + res <- CIcompX(0.17, modList, c(10, 20, 50), EDonly = FALSE) + + expect_true(is.list(res)) + expect_equal(length(res), 5) + expect_true(all(c("Effx", "Effy", "CAx", "CAy", "EDvec") %in% names(res))) + + # Effx: 3 rows x 6 cols + + expect_true(is.matrix(res$Effx)) + expect_equal(nrow(res$Effx), 3) + expect_equal(ncol(res$Effx), 6) + expect_equal(colnames(res$Effx), c("ED.mix", "ED1", "ED2", "SE.mix", "SE1", "SE2")) + expect_equal(rownames(res$Effx), c("10", "20", "50")) + + # Effy: 3 rows x 6 cols + expect_true(is.matrix(res$Effy)) + expect_equal(nrow(res$Effy), 3) + expect_equal(ncol(res$Effy), 6) + expect_equal(colnames(res$Effy), c("E.mix", "E1", "E2", "SE.mix", "SE1", "SE2")) + + # CAx: 3 rows x 8 cols + expect_true(is.matrix(res$CAx)) + expect_equal(nrow(res$CAx), 3) + expect_equal(ncol(res$CAx), 8) + expect_equal(colnames(res$CAx), + c("combInd", "SE", "lowCI", "highCI", "CAdiff", "CAdiffp", "PredAdd", "sePredAdd")) + + # CAy: 3 rows x 8 cols + expect_true(is.matrix(res$CAy)) + expect_equal(nrow(res$CAy), 3) + expect_equal(ncol(res$CAy), 8) + + # EDvec preserved + + expect_equal(res$EDvec, c(10, 20, 50)) + + # All ED values should be positive + expect_true(all(res$Effx[, "ED.mix"] > 0)) + expect_true(all(res$Effx[, "ED1"] > 0)) + expect_true(all(res$Effx[, "ED2"] > 0)) +}) + +# --- Happy path: multiple ED levels, EDonly = TRUE --- + +test_that("CIcompX returns only ED-related components when EDonly=TRUE", { + res <- CIcompX(0.17, modList, c(10, 20, 50), EDonly = TRUE) + + expect_true(is.list(res)) + expect_equal(length(res), 3) + expect_true(all(c("Effx", "CAx", "EDvec") %in% names(res))) + expect_false("Effy" %in% names(res)) + expect_false("CAy" %in% names(res)) + + expect_true(is.matrix(res$Effx)) + expect_true(is.matrix(res$CAx)) + expect_equal(res$EDvec, c(10, 20, 50)) +}) + +# --- Single ED level (triggers !is.matrix branch for predictions) --- + +test_that("CIcompX works with a single ED level", { + res <- CIcompX(0.17, modList, 50, EDonly = FALSE) + + expect_true(is.list(res)) + expect_equal(length(res), 5) + + # Matrices should have 1 row + expect_equal(nrow(res$Effx), 1) + expect_equal(nrow(res$Effy), 1) + expect_equal(nrow(res$CAx), 1) + expect_equal(nrow(res$CAy), 1) + expect_equal(rownames(res$Effx), "50") + expect_equal(res$EDvec, 50) +}) + +test_that("CIcompX single ED level with EDonly=TRUE", { + res <- CIcompX(0.17, modList, 50, EDonly = TRUE) + + expect_equal(length(res), 3) + expect_equal(nrow(res$Effx), 1) + expect_equal(nrow(res$CAx), 1) +}) + +# --- Combination index numerical sanity --- + +test_that("CIcompX combination indices have expected properties", { + res <- CIcompX(0.17, modList, c(10, 20, 50)) + + # Standard errors should be positive + expect_true(all(res$CAx[, "SE"] > 0)) + expect_true(all(res$CAy[, "SE"] > 0)) + + # Confidence intervals: lower < estimate < upper + expect_true(all(res$CAx[, "lowCI"] < res$CAx[, "combInd"])) + expect_true(all(res$CAx[, "highCI"] > res$CAx[, "combInd"])) + + # p-values between 0 and 1 + expect_true(all(res$CAx[, "CAdiffp"] >= 0 & res$CAx[, "CAdiffp"] <= 1)) + expect_true(all(res$CAy[, "CAdiffp"] >= 0 & res$CAy[, "CAdiffp"] <= 1)) + + # PredAdd and sePredAdd should be positive + expect_true(all(res$CAx[, "PredAdd"] > 0)) + expect_true(all(res$CAx[, "sePredAdd"] > 0)) +}) + +# --- Edge cases for mixProp boundary --- + +test_that("CIcompX works with mixProp at boundaries (0 and 1)", { + res0 <- CIcompX(0, modList, c(10, 50)) + res1 <- CIcompX(1, modList, c(10, 50)) + + expect_true(is.list(res0)) + expect_true(is.list(res1)) + expect_equal(length(res0), 5) + expect_equal(length(res1), 5) +}) + +## ===== CIcomp tests ===== + +test_that("CIcomp returns correct matrix structure with multiple ED levels", { + res <- CIcomp(0.17, modList, c(10, 20, 50)) + + expect_true(is.matrix(res)) + expect_equal(nrow(res), 3) + expect_equal(ncol(res), 9) + expect_equal(rownames(res), c("10", "20", "50")) + + # Check renamed columns + expect_equal(colnames(res)[6], "ED.CA") + expect_equal(colnames(res)[7], "SE.CA") + + # Numeric sanity + expect_true(all(is.finite(res))) +}) + +test_that("CIcomp works with single ED level (drop=FALSE fix)", { + res <- CIcomp(0.17, modList, 50) + + expect_true(is.matrix(res)) + expect_equal(nrow(res), 1) + expect_equal(ncol(res), 9) + expect_equal(rownames(res), "50") + expect_equal(colnames(res)[6], "ED.CA") + expect_equal(colnames(res)[7], "SE.CA") +}) + +test_that("CIcomp values are consistent with CIcompX output", { + edvec <- c(10, 20, 50) + resX <- CIcompX(0.17, modList, edvec, EDonly = FALSE) + resC <- CIcomp(0.17, modList, edvec) + + # CIcomp columns 1-5 should be CAx without column 5 (CAdiff) minus column 5 + # combInd from CAx matches column 1 of CIcomp + expect_equal(resC[, "combInd"], resX$CAx[, "combInd"]) + + # ED.mix and SE.mix from Effx + expect_equal(as.numeric(resC[, "ED.mix"]), as.numeric(resX$Effx[, "ED.mix"])) + expect_equal(as.numeric(resC[, "SE.mix"]), as.numeric(resX$Effx[, "SE.mix"])) +}) + +## ===== plotFACI tests ===== + +# Helper: build an effList for plotting tests +build_effList <- function(edvec = c(10, 20, 50)) { + CIcompX(0.17, modList, edvec, EDonly = FALSE) +} + +test_that("plotFACI default call (ED axis, caRef, new plot) works", { + effL <- build_effList() + res <- plotFACI(effL) + + expect_true(is.matrix(res)) + expect_equal(nrow(res), 3) + expect_equal(ncol(res), 8) +}) + +test_that("plotFACI with indAxis='EF' works", { + effL <- build_effList() + res <- plotFACI(effL, indAxis = "EF") + + expect_true(is.matrix(res)) + expect_equal(nrow(res), 3) +}) + +test_that("plotFACI with caRef=FALSE uses range for ylim", { + effL <- build_effList() + res <- plotFACI(effL, caRef = FALSE) + + expect_true(is.matrix(res)) +}) + +test_that("plotFACI with explicit ylim overrides computed limits", { + effL <- build_effList() + res <- plotFACI(effL, ylim = c(0, 3)) + + expect_true(is.matrix(res)) +}) + +test_that("plotFACI with showPoints=TRUE draws points", { + effL <- build_effList() + res <- plotFACI(effL, showPoints = TRUE) + + expect_true(is.matrix(res)) +}) + +test_that("plotFACI with add=TRUE adds to existing plot", { + effL <- build_effList() + # Create initial plot + plot(1, 1, xlim = c(0, 100), ylim = c(0, 3), + xlab = "FA", ylab = "CI") + res <- plotFACI(effL, add = TRUE) + + expect_true(is.matrix(res)) +}) + +test_that("plotFACI with all optional arguments combined", { + effL <- build_effList() + plot(1, 1, xlim = c(0, 100), ylim = c(0, 3), + xlab = "FA", ylab = "CI") + res <- plotFACI(effL, indAxis = "EF", caRef = FALSE, + showPoints = TRUE, add = TRUE) + + expect_true(is.matrix(res)) +}) + +test_that("plotFACI handles negative faValues in EDvec", { + # Construct a mock effList with negative EDvec values + effL <- build_effList(c(10, 20, 50)) + + # Manually adjust EDvec to include negative values for coverage of line 234 + effL$EDvec <- c(-10, 20, 50) + rownames(effL$CAx) <- as.character(c(-10, 20, 50)) + rownames(effL$CAy) <- as.character(c(-10, 20, 50)) + + res <- plotFACI(effL) + expect_true(is.matrix(res)) +}) + +test_that("plotFACI with caRef=FALSE and ylim provided", { + effL <- build_effList() + res <- plotFACI(effL, caRef = FALSE, ylim = c(0, 5)) + + expect_true(is.matrix(res)) +}) + +test_that("plotFACI returns correct matrix invisibly", { + effL <- build_effList() + res <- plotFACI(effL, indAxis = "ED") + + # Returned matrix should be the CAx component + expect_equal(res, effL$CAx) +}) diff --git a/tests/testthat/test-CRS6.R b/tests/testthat/test-CRS6.R new file mode 100644 index 00000000..fa23fd85 --- /dev/null +++ b/tests/testthat/test-CRS6.R @@ -0,0 +1,617 @@ +# Test file for CRS.6 function +# Goal: Achieve 100% code coverage + +library(testthat) +library(drc) + +# Load test data +data(ryegrass) +test_data <- data.frame(dose = ryegrass$conc, response = ryegrass$rootl) + +# ============================================================================== +# Basic Structure and Default Behavior Tests +# ============================================================================== + +test_that("CRS.6 returns correct structure with defaults", { + model <- CRS.6() + + expect_s3_class(model, "cedergreen.extended") + expect_named( + model, + c("fct", "ssfct", "names", "deriv1", "deriv2", "edfct", "maxfct", "name", "text", "noParm") + ) + expect_equal(model$noParm, 6) + expect_equal(model$name, "CRS.6") + expect_equal(model$text, "Generalised Cedergreen-Ritz-Streibig (hormesis)") +}) + +test_that("CRS.6 has correct default parameter names", { + model <- CRS.6() + + expect_equal(model$names, c("b", "c", "d", "e", "f", "g")) + expect_length(model$names, 6) +}) + +test_that("CRS.6 fct function exists and is callable", { + model <- CRS.6() + + expect_true(is.function(model$fct)) + + # Test with simple parameters + result <- model$fct( + dose = c(0.1, 1, 10), + parm = matrix(c(2, 0, 100, 1, 10, 1), nrow = 1) + ) + + expect_type(result, "double") + expect_length(result, 3) + expect_true(all(is.finite(result))) +}) + +test_that("CRS.6 ssfct function exists and is callable", { + model <- CRS.6() + + expect_true(is.function(model$ssfct)) + + inits <- model$ssfct(test_data) + + expect_type(inits, "double") + expect_length(inits, 6) + expect_true(all(is.finite(inits))) +}) + +test_that("CRS.6 deriv1 and deriv2 are NULL", { + model <- CRS.6() + + expect_null(model$deriv1) + expect_null(model$deriv2) +}) + +test_that("CRS.6 edfct and maxfct are NULL", { + model <- CRS.6() + + expect_null(model$edfct) + expect_null(model$maxfct) +}) + +# ============================================================================== +# Custom Names Tests +# ============================================================================== + +test_that("CRS.6 accepts custom parameter names", { + custom_names <- c("slope", "lower", "upper", "ed50", "horm", "alpha") + + model <- CRS.6(names = custom_names) + + expect_equal(model$names, custom_names) +}) + +test_that("CRS.6 rejects invalid names argument - not character", { + expect_error( + CRS.6(names = c(1, 2, 3, 4, 5, 6)), + "Not correct 'names' argument" + ) +}) + +test_that("CRS.6 rejects invalid names argument - wrong length", { + expect_error( + CRS.6(names = c("b", "c", "d", "e")), + "Not correct 'names' argument" + ) +}) + +test_that("CRS.6 rejects invalid names argument - NULL", { + expect_error( + CRS.6(names = NULL), + "Not correct 'names' argument" + ) +}) + +# ============================================================================== +# Fixed Parameters Tests +# ============================================================================== + +test_that("CRS.6 with no fixed parameters", { + model <- CRS.6(fixed = c(NA, NA, NA, NA, NA, NA)) + + expect_equal(model$noParm, 6) + expect_length(model$names, 6) + + inits <- model$ssfct(test_data) + expect_length(inits, 6) +}) + +test_that("CRS.6 with all parameters fixed", { + model <- CRS.6(fixed = c(2, 0, 100, 1, 10, 1)) + + expect_equal(model$noParm, 0) + expect_length(model$names, 0) + + inits <- model$ssfct(test_data) + expect_length(inits, 0) +}) + +test_that("CRS.6 with b fixed", { + model <- CRS.6(fixed = c(2, NA, NA, NA, NA, NA)) + + expect_equal(model$noParm, 5) + expect_equal(model$names, c("c", "d", "e", "f", "g")) + + inits <- model$ssfct(test_data) + expect_length(inits, 5) +}) + +test_that("CRS.6 with c fixed", { + model <- CRS.6(fixed = c(NA, 0, NA, NA, NA, NA)) + + expect_equal(model$noParm, 5) + expect_equal(model$names, c("b", "d", "e", "f", "g")) + + inits <- model$ssfct(test_data) + expect_length(inits, 5) +}) + +test_that("CRS.6 with d fixed", { + model <- CRS.6(fixed = c(NA, NA, 100, NA, NA, NA)) + + expect_equal(model$noParm, 5) + expect_equal(model$names, c("b", "c", "e", "f", "g")) + + inits <- model$ssfct(test_data) + expect_length(inits, 5) +}) + +test_that("CRS.6 with e fixed", { + model <- CRS.6(fixed = c(NA, NA, NA, 1, NA, NA)) + + expect_equal(model$noParm, 5) + expect_equal(model$names, c("b", "c", "d", "f", "g")) + + inits <- model$ssfct(test_data) + expect_length(inits, 5) +}) + +test_that("CRS.6 with f fixed", { + model <- CRS.6(fixed = c(NA, NA, NA, NA, 10, NA)) + + expect_equal(model$noParm, 5) + expect_equal(model$names, c("b", "c", "d", "e", "g")) + + inits <- model$ssfct(test_data) + expect_length(inits, 5) +}) + +test_that("CRS.6 with g (alpha) fixed", { + model <- CRS.6(fixed = c(NA, NA, NA, NA, NA, 1)) + + expect_equal(model$noParm, 5) + expect_equal(model$names, c("b", "c", "d", "e", "f")) + + inits <- model$ssfct(test_data) + expect_length(inits, 5) +}) + +test_that("CRS.6 with multiple parameters fixed", { + model <- CRS.6(fixed = c(2, 0, NA, NA, NA, 1)) + + expect_equal(model$noParm, 3) + expect_equal(model$names, c("d", "e", "f")) + + inits <- model$ssfct(test_data) + expect_length(inits, 3) +}) + +test_that("CRS.6 rejects invalid fixed argument - wrong length", { + expect_error( + CRS.6(fixed = c(NA, NA, NA, NA)), + "Not correct 'fixed' argument" + ) +}) + +test_that("CRS.6 rejects invalid fixed argument - NULL", { + expect_error( + CRS.6(fixed = NULL), + "Not correct 'fixed' argument" + ) +}) + +# ============================================================================== +# Method Parameter Tests +# ============================================================================== + +test_that("CRS.6 accepts method parameter (for compatibility)", { + # method parameter exists but is not currently used in active ssfct + model1 <- CRS.6(method = "1") + model2 <- CRS.6(method = "2") + model3 <- CRS.6(method = "3") + model4 <- CRS.6(method = "4") + + expect_s3_class(model1, "cedergreen.extended") + expect_s3_class(model2, "cedergreen.extended") + expect_s3_class(model3, "cedergreen.extended") + expect_s3_class(model4, "cedergreen.extended") +}) + +# ============================================================================== +# Custom ssfct Tests +# ============================================================================== + +test_that("CRS.6 accepts custom ssfct function", { + custom_ssfct <- function(dframe) { + c(2, 0, 100, 1, 10, 1) + } + + model <- CRS.6(ssfct = custom_ssfct) + + expect_true(is.function(model$ssfct)) + + inits <- model$ssfct(test_data) + expect_equal(inits, c(2, 0, 100, 1, 10, 1)) +}) + +test_that("CRS.6 with NULL ssfct uses default", { + model <- CRS.6(ssfct = NULL) + + expect_true(is.function(model$ssfct)) + + inits <- model$ssfct(test_data) + expect_type(inits, "double") + expect_length(inits, 6) +}) + +test_that("CRS.6 custom ssfct respects fixed parameters", { + custom_ssfct <- function(dframe) { + c(2, 0, 100, 1, 10, 1) + } + + model <- CRS.6( + fixed = c(NA, 0, NA, NA, NA, NA), + ssfct = custom_ssfct + ) + + inits <- model$ssfct(test_data) + # Should return full vector from custom_ssfct + expect_length(inits, 6) +}) + +# ============================================================================== +# Self-starter Function (ssfct) Tests +# ============================================================================== + +test_that("CRS.6 ssfct uses llogistic for first 4 parameters", { + model <- CRS.6() + + inits <- model$ssfct(test_data) + + # Compare with llogistic ssfct + ll_model <- llogistic() + ll_inits <- ll_model$ssfct(test_data) + + # First 4 parameters should match llogistic + expect_equal(inits[1:4], ll_inits[1:4]) +}) + +test_that("CRS.6 ssfct sets g (6th parameter) to 0", { + model <- CRS.6() + + inits <- model$ssfct(test_data) + + # 6th parameter (g/alpha) should be 0 + expect_equal(inits[6], 0) +}) + +test_that("CRS.6 ssfct calculates f (5th parameter) correctly", { + model <- CRS.6() + + inits <- model$ssfct(test_data) + + # f should be calculated using the formula on line 99 + # f = (2*(median(dframe[, 2])-initval[2])-(initval[3]-initval[2]))*exp(1/(initval[4]^initval[6])) + + ll_model <- llogistic() + ll_inits <- ll_model$ssfct(test_data) + + expected_f <- (2 * (median(test_data[, 2]) - ll_inits[2]) - + (ll_inits[3] - ll_inits[2])) * exp(1 / (ll_inits[4]^0)) + + expect_equal(inits[5], expected_f) +}) + +test_that("CRS.6 ssfct works with different data sets", { + model <- CRS.6() + + # Test with different data + small_data <- data.frame( + dose = c(0.1, 1, 10), + response = c(1, 5, 9) + ) + + inits <- model$ssfct(small_data) + + expect_type(inits, "double") + expect_length(inits, 6) + expect_true(all(is.finite(inits))) +}) + +# ============================================================================== +# Function (fct) Tests +# ============================================================================== + +test_that("CRS.6 fct works with single dose value", { + model <- CRS.6() + + result <- model$fct( + dose = 1, + parm = matrix(c(2, 0, 100, 1, 10, 1), nrow = 1) + ) + + expect_type(result, "double") + expect_length(result, 1) + expect_true(is.finite(result)) +}) + +test_that("CRS.6 fct works with multiple dose values", { + model <- CRS.6() + + result <- model$fct( + dose = c(0.1, 1, 10, 100), + parm = matrix(c(2, 0, 100, 1, 10, 1), nrow = 1) + ) + + expect_type(result, "double") + expect_length(result, 4) + expect_true(all(is.finite(result))) +}) + +test_that("CRS.6 fct works with multiple parameter sets", { + model <- CRS.6() + + # Test with 2 parameter sets + parms <- matrix( + c( + 2, 0, 100, 1, 10, 1, + 3, 0, 100, 2, 5, 0.5 + ), + nrow = 2, + byrow = TRUE + ) + + result <- model$fct(dose = c(0.1, 1, 10), parm = parms) + + expect_type(result, "double") + expect_length(result, 3) +}) + +test_that("CRS.6 fct respects fixed parameters", { + # Fix b=2 and c=0 + model <- CRS.6(fixed = c(2, 0, NA, NA, NA, NA)) + + # Only provide d, e, f, g (4 parameters) + result <- model$fct( + dose = c(0.1, 1, 10), + parm = matrix(c(100, 1, 10, 1), nrow = 1) + ) + + expect_type(result, "double") + expect_length(result, 3) + expect_true(all(is.finite(result))) +}) + +test_that("CRS.6 fct with all parameters fixed uses fixed values", { + model <- CRS.6(fixed = c(2, 0, 100, 1, 10, 1)) + + # Provide empty parameter matrix + result <- model$fct( + dose = c(0.1, 1, 10), + parm = matrix(numeric(0), nrow = 1, ncol = 0) + ) + + expect_type(result, "double") + expect_length(result, 3) +}) + +test_that("CRS.6 fct model equation is correct", { + model <- CRS.6() + + b <- 2 + c_param <- 0 + d <- 100 + e <- 1 + f <- 10 + g <- 1 + + dose <- 1 + + # Manual calculation: c + (d-c+f*exp(-1/dose^g))/(1+exp(b*(log(dose)-log(e)))) + expected <- c_param + (d - c_param + f * exp(-1 / (dose^g))) / + (1 + exp(b * (log(dose) - log(e)))) + + result <- model$fct( + dose = dose, + parm = matrix(c(b, c_param, d, e, f, g), nrow = 1) + ) + + expect_equal(result[1], expected) +}) + +# ============================================================================== +# Integration Tests with drm +# ============================================================================== + +test_that("CRS.6 works with drm function", { + model <- CRS.6() + + fit <- drm(rootl ~ conc, data = ryegrass, fct = model) + + expect_s3_class(fit, "drc") + expect_true(length(coef(fit)) > 0) + expect_equal(length(coef(fit)), 6) +}) + +test_that("CRS.6 with fixed parameters works with drm", { + model <- CRS.6(fixed = c(NA, NA, NA, NA, NA, 1)) + + fit <- drm(rootl ~ conc, data = ryegrass, fct = model) + + expect_s3_class(fit, "drc") + expect_equal(length(coef(fit)), 5) +}) + +test_that("CRS.6 with custom names works with drm", { + model <- CRS.6(names = c("slope", "lower", "upper", "ed50", "horm", "alpha")) + + fit <- drm(rootl ~ conc, data = ryegrass, fct = model) + + expect_s3_class(fit, "drc") + # drm adds ":(Intercept)" suffix to parameter names + expect_true(all(grepl("^(slope|lower|upper|ed50|horm|alpha):", names(coef(fit))))) +}) + +# ============================================================================== +# Edge Cases and Boundary Conditions +# ============================================================================== + +test_that("CRS.6 handles dose = 0 gracefully", { + model <- CRS.6() + + # dose = 0 will cause issues with log(dose), but should handle via exp() + result <- model$fct( + dose = c(0, 0.1, 1), + parm = matrix(c(2, 0, 100, 1, 10, 1), nrow = 1) + ) + + expect_type(result, "double") + expect_length(result, 3) + # First value may be non-finite + expect_true(all(is.finite(result[2:3]))) +}) + +test_that("CRS.6 handles very small dose values", { + model <- CRS.6() + + result <- model$fct( + dose = c(1e-10, 1e-5, 1), + parm = matrix(c(2, 0, 100, 1, 10, 1), nrow = 1) + ) + + expect_type(result, "double") + expect_length(result, 3) +}) + +test_that("CRS.6 handles very large dose values", { + model <- CRS.6() + + result <- model$fct( + dose = c(1, 1000, 1e6), + parm = matrix(c(2, 0, 100, 1, 10, 1), nrow = 1) + ) + + expect_type(result, "double") + expect_length(result, 3) +}) + +test_that("CRS.6 with g=0 (special case)", { + model <- CRS.6() + + # When g=0, exp(-1/dose^0) = exp(-1) for all dose + result <- model$fct( + dose = c(0.1, 1, 10), + parm = matrix(c(2, 0, 100, 1, 10, 0), nrow = 1) + ) + + expect_type(result, "double") + expect_length(result, 3) + expect_true(all(is.finite(result))) +}) + +test_that("CRS.6 with negative g (edge case)", { + model <- CRS.6() + + result <- model$fct( + dose = c(0.1, 1, 10), + parm = matrix(c(2, 0, 100, 1, 10, -1), nrow = 1) + ) + + expect_type(result, "double") + expect_length(result, 3) +}) + +test_that("CRS.6 ssfct with minimal data", { + model <- CRS.6() + + minimal_data <- data.frame( + dose = c(0.1, 1, 10), + response = c(1, 5, 9) + ) + + inits <- model$ssfct(minimal_data) + + expect_type(inits, "double") + expect_length(inits, 6) +}) + +# ============================================================================== +# Class and Attributes Tests +# ============================================================================== + +test_that("CRS.6 returns object with correct class", { + model <- CRS.6() + + expect_s3_class(model, "cedergreen.extended") + expect_true("cedergreen.extended" %in% class(model)) +}) + +test_that("CRS.6 invisible return", { + # CRS.6 uses invisible() to return the list + # This test ensures the function still returns the model + model <- CRS.6() + + expect_type(model, "list") + expect_s3_class(model, "cedergreen.extended") +}) + +# ============================================================================== +# Consistency Tests +# ============================================================================== + +test_that("CRS.6 ssfct + fct produce reasonable results", { + model <- CRS.6() + + inits <- model$ssfct(test_data) + + # Use initial parameters to predict + predictions <- model$fct( + dose = test_data$dose, + parm = matrix(inits, nrow = 1) + ) + + expect_type(predictions, "double") + expect_length(predictions, nrow(test_data)) + expect_true(all(is.finite(predictions))) + + # Predictions should be in a reasonable range + expect_true(all(predictions >= min(test_data$response) - 10)) + expect_true(all(predictions <= max(test_data$response) + 10)) +}) + +test_that("CRS.6 with fixed params - ssfct returns correct length", { + # Test various fixed parameter combinations + fixed_combinations <- list( + c(2, NA, NA, NA, NA, NA), # 5 params + c(NA, 0, NA, NA, NA, NA), # 5 params + c(NA, NA, 100, NA, NA, NA), # 5 params + c(2, 0, NA, NA, NA, NA), # 4 params + c(2, 0, 100, NA, NA, NA), # 3 params + c(2, 0, 100, 1, NA, NA), # 2 params + c(2, 0, 100, 1, 10, NA) # 1 param + ) + + expected_lengths <- c(5, 5, 5, 4, 3, 2, 1) + + for (i in seq_along(fixed_combinations)) { + model <- CRS.6(fixed = fixed_combinations[[i]]) + inits <- model$ssfct(test_data) + + expect_length(inits, expected_lengths[i]) + } +}) diff --git a/tests/testthat/test-ED.R b/tests/testthat/test-ED.R new file mode 100644 index 00000000..58d6cd6a --- /dev/null +++ b/tests/testthat/test-ED.R @@ -0,0 +1,648 @@ +# Test ED.drc() function - Estimating effective doses + +# Create test dataset (ryegrass) +ryegrass <- data.frame( + rootl = c( + 7.58, 8.00, 8.33, 7.25, 7.17, 7.00, 7.17, 7.83, 7.92, 7.58, + 6.17, 5.75, 5.83, 6.00, 5.83, 4.92, 4.50, 4.17, 4.42, 4.00, + 2.67, 2.08, 2.42, 2.50, 2.25, 1.17, 0.75, 0.92, 1.00, 0.58 + ), + conc = c( + rep(0, 5), rep(0.94, 5), rep(1.88, 5), + rep(3.75, 5), rep(7.50, 5), rep(15, 5) + ) +) + +# Multi-curve dataset +set.seed(42) +multi_data <- data.frame( + dose = rep(c(0, 0.5, 1, 2, 5, 10), each = 5, times = 2), + resp = c( + rnorm(5, 100, 5), rnorm(5, 95, 5), rnorm(5, 85, 5), + rnorm(5, 60, 5), rnorm(5, 20, 5), rnorm(5, 5, 5), + rnorm(5, 100, 5), rnorm(5, 90, 5), rnorm(5, 70, 5), + rnorm(5, 40, 5), rnorm(5, 10, 5), rnorm(5, 3, 5) + ), + group = rep(c("A", "B"), each = 30) +) + +# Tests for ED.drc() with single curve models + +test_that("ED.drc returns correct structure for single response level", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- ED(m1, 50, display = FALSE) + + expect_true(is.matrix(result)) + expect_equal(nrow(result), 1) + expect_equal(ncol(result), 2) + expect_true(all(c("Estimate", "Std. Error") %in% colnames(result))) +}) + +test_that("ED.drc returns correct structure for multiple response levels", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- ED(m1, c(10, 50, 90), display = FALSE) + + expect_true(is.matrix(result)) + expect_equal(nrow(result), 3) + expect_equal(ncol(result), 2) + expect_true(all(result[, "Estimate"] > 0)) +}) + +test_that("ED.drc with delta method confidence intervals", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- ED(m1, 50, interval = "delta", display = FALSE) + + expect_equal(ncol(result), 4) + expect_true(all(c("Estimate", "Std. Error", "Lower", "Upper") %in% colnames(result))) + expect_true(result[, "Lower"] < result[, "Estimate"]) + expect_true(result[, "Upper"] > result[, "Estimate"]) +}) + +test_that("ED.drc with different confidence levels", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result_95 <- ED(m1, 50, interval = "delta", level = 0.95, display = FALSE) + result_90 <- ED(m1, 50, interval = "delta", level = 0.90, display = FALSE) + + # 90% CI should be narrower than 95% CI + width_95 <- result_95[, "Upper"] - result_95[, "Lower"] + width_90 <- result_90[, "Upper"] - result_90[, "Lower"] + expect_true(width_90 < width_95) +}) + +test_that("ED.drc validates response level bounds for relative type", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Should error for response levels outside (0, 100) + expect_error(ED(m1, 0, display = FALSE), "outside the interval") + expect_error(ED(m1, 100, display = FALSE), "outside the interval") + expect_error(ED(m1, -10, display = FALSE), "outside the interval") + expect_error(ED(m1, 150, display = FALSE), "outside the interval") +}) + +test_that("ED.drc allows extreme values when bound = FALSE", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Should not error with bound = FALSE + expect_no_error(ED(m1, 0, bound = FALSE, display = FALSE)) + expect_no_error(ED(m1, 100, bound = FALSE, display = FALSE)) +}) + +test_that("ED.drc works with absolute type response levels", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- ED(m1, 5, type = "absolute", display = FALSE) + + expect_true(is.matrix(result)) + expect_equal(nrow(result), 1) + expect_true(result[, "Estimate"] > 0) +}) + +# Helper: compute the expected SE for an absolute-type ED using numerical +# central differences on the model's edfct and the fitted vcov matrix. +compute_numgrad_se <- function(model, absResp) { + vc <- vcov(model) + edfct <- model$fct$edfct + parms <- coef(model) + eps <- .Machine$double.eps + numGrad <- numeric(length(parms)) + for (k in seq_along(parms)) { + p <- parms[k] + h <- if (abs(p) > sqrt(eps)) abs(p) * eps^(1/3) else eps^(1/3) + pu <- replace(parms, k, parms[k] + h) + pd <- replace(parms, k, parms[k] - h) + eu <- edfct(pu, absResp, reference = "control", type = "absolute")[[1]] + ed <- edfct(pd, absResp, reference = "control", type = "absolute")[[1]] + numGrad[k] <- (eu - ed) / (2 * h) + } + as.numeric(sqrt(numGrad %*% vc %*% numGrad)) +} + +test_that("ED.drc absolute type SE includes asymptote parameter uncertainty", { + # Fit a 4-parameter log-logistic model + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Pick an absolute response level (midpoint of the fitted curve) + cf <- coef(m1) + midResp <- (cf[2] + cf[3]) / 2 # midpoint between c and d + + result_abs <- ED(m1, midResp, type = "absolute", display = FALSE) + result_rel <- ED(m1, 50, type = "relative", display = FALSE) + + # The ED estimates should be the same (midpoint = ED50 for symmetric model) + expect_equal(result_abs[, "Estimate"], result_rel[, "Estimate"], + tolerance = 0.01) + + # The absolute-type SE differs from the relative-type SE because it + # additionally accounts for uncertainty in c and d via the full + # numerical gradient (parameter covariances can make it larger or smaller). + expect_false(isTRUE(all.equal(result_abs[, "Std. Error"], + result_rel[, "Std. Error"]))) + + # Cross-check: manually computed SE should match + expectedSE <- compute_numgrad_se(m1, midResp) + expect_equal(result_abs[, "Std. Error"], expectedSE, tolerance = 1e-4) +}) + +test_that("ED.drc absolute type SE is correct for Weibull type 2", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = W2.4()) + + cf <- coef(m1) + midResp <- (cf[2] + cf[3]) / 2 + + result_abs <- ED(m1, midResp, type = "absolute", display = FALSE) + + expectedSE <- compute_numgrad_se(m1, midResp) + expect_equal(result_abs[, "Std. Error"], expectedSE, tolerance = 1e-4) +}) + +test_that("ED.drc absolute type SE is correct for Weibull type 1", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) + + cf <- coef(m1) + midResp <- (cf[2] + cf[3]) / 2 + + result_abs <- ED(m1, midResp, type = "absolute", display = FALSE) + + expectedSE <- compute_numgrad_se(m1, midResp) + expect_equal(result_abs[, "Std. Error"], expectedSE, tolerance = 1e-4) +}) + +test_that("ED.drc relative type SE unchanged by fix", { + # The relative-type SE should NOT be affected by the absolute-type fix + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + result <- ED(m1, 50, type = "relative", display = FALSE) + + # Manually compute relative-type SE using the analytical gradient + cf <- coef(m1) + vc <- vcov(m1) + edfct <- m1$fct$edfct + edResult <- edfct(cf, 50, reference = "control", type = "relative") + edGrad <- edResult[[2]] + expectedSE <- as.numeric(sqrt(edGrad %*% vc %*% edGrad)) + + expect_equal(result[, "Std. Error"], expectedSE, tolerance = 1e-8) +}) + +test_that("ED.drc errors when model has no edfct function", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + # Remove the edfct function to simulate a model without it + m1$fct$edfct <- NULL + + expect_error(ED(m1, 50, display = FALSE), "ED values cannot be calculated") +}) + +# Tests for input validation error branches in ED.drc + +test_that("ED.drc errors when object is not of class drc", { + expect_error(drc:::ED.drc("not_a_model", 50), "'object' must be of class 'drc'") + expect_error(drc:::ED.drc(42, 50), "'object' must be of class 'drc'") +}) + +test_that("ED.drc errors when respLev is invalid", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + expect_error(drc:::ED.drc(m1, "abc"), "'respLev' must be a non-empty numeric vector") + expect_error(drc:::ED.drc(m1, numeric(0)), "'respLev' must be a non-empty numeric vector") +}) + +test_that("ED.drc errors when level is invalid", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + expect_error(drc:::ED.drc(m1, 50, level = "a"), "'level' must be a single numeric value strictly between 0 and 1") + expect_error(drc:::ED.drc(m1, 50, level = 0), "'level' must be a single numeric value strictly between 0 and 1") + expect_error(drc:::ED.drc(m1, 50, level = 1), "'level' must be a single numeric value strictly between 0 and 1") + expect_error(drc:::ED.drc(m1, 50, level = c(0.9, 0.95)), "'level' must be a single numeric value strictly between 0 and 1") +}) + +test_that("ED.drc errors when bound is invalid", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + expect_error(drc:::ED.drc(m1, 50, bound = "yes"), "'bound' must be a single logical value") + expect_error(drc:::ED.drc(m1, 50, bound = c(TRUE, FALSE)), "'bound' must be a single logical value") +}) + +test_that("ED.drc errors when display is invalid", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + expect_error(drc:::ED.drc(m1, 50, display = "yes"), "'display' must be a single logical value") +}) + +test_that("ED.drc errors when multcomp is invalid", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + expect_error(drc:::ED.drc(m1, 50, multcomp = "yes"), "'multcomp' must be a single logical value") +}) + +# Tests for multi-curve models + +test_that("ED.drc works with multi-curve models", { + m_multi <- drm(resp ~ dose, curveid = group, data = multi_data, fct = LL.4()) + result <- ED(m_multi, 50, display = FALSE) + + expect_equal(nrow(result), 2) # One ED50 for each curve + expect_true(all(grepl("A:|B:", rownames(result)))) +}) + +test_that("ED.drc with clevel filters specific curves", { + m_multi <- drm(resp ~ dose, curveid = group, data = multi_data, fct = LL.4()) + result <- ED(m_multi, 50, clevel = "A", display = FALSE) + + expect_equal(nrow(result), 1) + expect_true(grepl("A:", rownames(result))) +}) + +test_that("ED.drc with multiple response levels and curves", { + m_multi <- drm(resp ~ dose, curveid = group, data = multi_data, fct = LL.4()) + result <- ED(m_multi, c(10, 50, 90), display = FALSE) + + expect_equal(nrow(result), 6) # 3 response levels × 2 curves +}) + +# Tests for different interval types + +test_that("ED.drc with fls interval (from log scale)", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- ED(m1, 50, interval = "fls", display = FALSE) + + expect_equal(ncol(result), 4) # Estimate, Std. Error, Lower, Upper + expect_true(all(c("Estimate", "Std. Error", "Lower", "Upper") %in% colnames(result))) +}) + +test_that("ED.drc with tfls interval (to and from log scale)", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- ED(m1, 50, interval = "tfls", display = FALSE) + + # SE column is now retained alongside Lower and Upper + expect_equal(ncol(result), 4) + expect_true(all(c("Estimate", "Std. Error", "Lower", "Upper") %in% colnames(result))) + expect_true(result[, "Lower"] < result[, "Estimate"]) + expect_true(result[, "Upper"] > result[, "Estimate"]) +}) + +test_that("ED.drc with inverse regression interval", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- ED(m1, 50, interval = "inv", display = FALSE) + + expect_equal(ncol(result), 4) # Estimate, Std. Error, Lower, Upper + expect_true(all(c("Estimate", "Std. Error", "Lower", "Upper") %in% colnames(result))) +}) + +# Tests for different model types + +test_that("ED.drc works with LL.3 model", { + m_ll3 <- drm(rootl ~ conc, data = ryegrass, fct = LL.3()) + result <- ED(m_ll3, 50, display = FALSE) + + expect_true(is.matrix(result)) + expect_equal(nrow(result), 1) + expect_true(result[, "Estimate"] > 0) +}) + +test_that("ED.drc works with Weibull models", { + m_w1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) + result <- ED(m_w1, 50, display = FALSE) + + expect_true(is.matrix(result)) + expect_equal(nrow(result), 1) + expect_true(result[, "Estimate"] > 0) +}) + +test_that("ED.drc works with binomial type data", { + binom_data <- data.frame( + dose = c(0, 0.1, 0.5, 1, 2, 5, 10), + resp = c(0, 0.05, 0.15, 0.35, 0.65, 0.90, 0.98), + n = rep(50, 7) + ) + m_binom <- drm(resp ~ dose, data = binom_data, fct = LL.2(), type = "binomial", weights = n) + result <- ED(m_binom, 50, display = FALSE) + + expect_true(is.matrix(result)) + expect_true(result[, "Estimate"] > 0) +}) + +# Tests for display parameter + +test_that("ED.drc respects display parameter", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # With display = FALSE, should not print anything + expect_silent(result <- ED(m1, 50, display = FALSE)) + expect_true(is.matrix(result)) +}) + +# Tests for multcomp output + +test_that("ED.drc returns multcomp format when requested", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- ED(m1, c(10, 50), multcomp = TRUE, display = FALSE) + + expect_true(is.list(result)) + expect_true("EDmultcomp" %in% names(result)) +}) + +# Tests for reference parameter + +test_that("ED.drc works with different reference types", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + result_control <- ED(m1, 50, reference = "control", display = FALSE) + result_upper <- ED(m1, 50, reference = "upper", display = FALSE) + + expect_true(is.matrix(result_control)) + expect_true(is.matrix(result_upper)) + # Both reference types should produce valid estimates + expect_true(result_control[, "Estimate"] > 0) + expect_true(result_upper[, "Estimate"] > 0) +}) + +# Tests for logBase parameter + +test_that("ED.drc transforms ED values with logBase", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + result_no_log <- ED(m1, 50, display = FALSE) + result_with_log <- ED(m1, 50, logBase = 10, display = FALSE) + + # With logBase transformation, estimates should differ + expect_false(isTRUE(all.equal(result_no_log[, "Estimate"], + result_with_log[, "Estimate"]))) +}) + +# Tests for vcov parameter + +test_that("ED.drc accepts custom vcov function", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Use a custom vcov that returns scaled variance + custom_vcov <- function(x) vcov(x) * 2 + + result_default <- ED(m1, 50, interval = "delta", display = FALSE) + result_custom <- ED(m1, 50, interval = "delta", vcov. = custom_vcov, display = FALSE) + + # Standard errors should be different (larger with scaled vcov) + expect_true(result_custom[, "Std. Error"] > result_default[, "Std. Error"]) +}) + +test_that("ED.drc accepts vcov matrix directly", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + vcov_mat <- vcov(m1) + result <- ED(m1, 50, vcov. = vcov_mat, display = FALSE) + + expect_true(is.matrix(result)) + expect_true(result[, "Estimate"] > 0) +}) + +# Tests for edge cases + +test_that("ED.drc handles single curve with numeric curve names", { + ryegrass_num <- ryegrass + m1 <- drm(rootl ~ conc, data = ryegrass_num, fct = LL.4()) + result <- ED(m1, 50, display = FALSE) + + expect_true(is.matrix(result)) + # ED.drc prefixes rownames with "e:" (e.g., "e:1:50") + expect_true(all(grepl("^e:", rownames(result)))) +}) + +test_that("ED.drc handles very small response levels", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- ED(m1, 1, display = FALSE) + + expect_true(is.matrix(result)) + expect_true(result[, "Estimate"] > 0) +}) + +test_that("ED.drc handles very large response levels", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- ED(m1, 99, display = FALSE) + + expect_true(is.matrix(result)) + expect_true(result[, "Estimate"] > 0) +}) + +test_that("ED.drc returns invisible output", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # invisible() should not print when assigned + result <- ED(m1, 50, display = FALSE) + expect_true(is.matrix(result)) +}) + +# Integration test: ED values should be reasonable + +test_that("ED.drc ED values are in expected order", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- ED(m1, c(10, 50, 90), display = FALSE) + + # For decreasing curves, ED10 < ED50 < ED90 + ed_values <- result[, "Estimate"] + expect_true(ed_values[1] < ed_values[2]) + expect_true(ed_values[2] < ed_values[3]) +}) + +test_that("ED.drc standard errors are positive", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- ED(m1, c(10, 50, 90), display = FALSE) + + expect_true(all(result[, "Std. Error"] > 0)) +}) + +test_that("ED.drc confidence intervals contain the estimate", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- ED(m1, 50, interval = "delta", display = FALSE) + + expect_true(result[, "Lower"] < result[, "Estimate"]) + expect_true(result[, "Upper"] > result[, "Estimate"]) +}) + +# --- Acceptance criteria tests for FIX #1 through #11 ----------------------- + +test_that("FIX #1: clevel filtering does not corrupt row indices (multi-curve)", { + m_multi <- drm(resp ~ dose, curveid = group, data = multi_data, fct = LL.4()) + result_A <- ED(m_multi, 50, interval = "delta", clevel = "A", display = FALSE) + + expect_equal(nrow(result_A), 1) + expect_true(grepl("A:", rownames(result_A))) + expect_true(result_A[, "Lower"] < result_A[, "Estimate"]) + expect_true(result_A[, "Upper"] > result_A[, "Estimate"]) + + # Multiple response levels with clevel filtering + result_A3 <- ED(m_multi, c(10, 50, 90), clevel = "A", display = FALSE) + expect_equal(nrow(result_A3), 3) + expect_true(all(grepl("A:", rownames(result_A3)))) +}) + +test_that("FIX #11: multcomp = TRUE with display = FALSE is fully silent", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + expect_silent(result <- ED(m1, 50, multcomp = TRUE, display = FALSE)) + expect_true(is.list(result)) + expect_true("EDmultcomp" %in% names(result)) +}) + +# --- Regression test for EXD.3 with two fixed parameters -------------------- + +# Exponential decay dataset (from GitHub issue: ED() fails with 1x1 vcov) +exd_data <- data.frame( + conc = c(1e+01, 1e+00, 1e-01, 1e+04, 1e+03, 1e+02, 1e+01, 1e+00, + 1e-01, 1e+04, 1e+03, 1e+02, 1e+01, 1e+00, 1e-01, 1e+04, + 1e+03, 1e+02, 0e+00, 0e+00, 0e+00, 0e+00, 0e+00, 0e+00, + 0e+00, 0e+00, 0e+00, 0e+00, 0e+00, 0e+00, 0e+00, 0e+00, + 0e+00, 0e+00, 0e+00, 0e+00), + yield = c(15083.677, 142275.764, 197718.468, 0.000, 0.000, 0.000, + 67265.046, 197718.468, 266206.515, 28129.019, 5299.695, + 47697.033, 0.000, 139014.428, 178150.455, 0.000, 0.000, + 28129.019, 181411.790, 142275.764, 329394.891, 156544.107, + 230331.770, 256422.508, 112923.744, 187934.462, 321649.219, + 158582.442, 189157.384, 109662.408, 155321.106, 158582.442, + 311865.213, 259683.844, 152059.728, 178150.455) +) + +test_that("EXD.3 with one fixed param: ED() works", { + res <- drm(yield ~ conc, data = exd_data, + fct = EXD.3(fixed = c(0, NA, NA))) + result <- ED(res, c(10, 20, 50), interval = "tfls", display = FALSE) + + expect_true(is.matrix(result)) + expect_equal(nrow(result), 3) + expect_true(all(result[, "Estimate"] > 0)) + expect_true(all(result[, "Lower"] < result[, "Estimate"])) + expect_true(all(result[, "Upper"] > result[, "Estimate"])) +}) + +test_that("EXD.3 with two fixed params: ED() works (1x1 vcov regression)", { + # This is the key regression test: when both c and d are fixed, only e is + # estimated, producing a 1x1 vcov matrix and a scalar indexMat. The legacy + # code failed with "incorrect number of dimensions" because indexMat was not + # coerced to a matrix and vcMat subsetting dropped dimensions. + res2 <- drm(yield ~ conc, data = exd_data, + fct = EXD.3(fixed = c(0, 199553, NA))) + + # Basic model checks + expect_equal(length(coef(res2)), 1) + expect_true(is.matrix(vcov(res2))) + expect_equal(dim(vcov(res2)), c(1, 1)) + + # ED without interval + result_none <- ED(res2, c(10, 20, 50), interval = "none", display = FALSE) + expect_true(is.matrix(result_none)) + expect_equal(nrow(result_none), 3) + expect_true(all(result_none[, "Estimate"] > 0)) + expect_true(all(result_none[, "Std. Error"] > 0)) + + # ED with delta interval + result_delta <- ED(res2, c(10, 20, 50), interval = "delta", display = FALSE) + expect_equal(ncol(result_delta), 4) + expect_true(all(result_delta[, "Lower"] < result_delta[, "Estimate"])) + expect_true(all(result_delta[, "Upper"] > result_delta[, "Estimate"])) + + # ED with tfls interval (the original failing case) + result_tfls <- ED(res2, c(10, 20, 50), interval = "tfls", display = FALSE) + expect_true(is.matrix(result_tfls)) + expect_equal(nrow(result_tfls), 3) + expect_true(all(result_tfls[, "Lower"] < result_tfls[, "Estimate"])) + expect_true(all(result_tfls[, "Upper"] > result_tfls[, "Estimate"])) + + # Verify estimates match analytical formula: ED_p = -e * ln(1 - p/100) + e_hat <- coef(res2)[["e:(Intercept)"]] + p <- c(10, 20, 50) + ED_manual <- -e_hat * log(1 - p / 100) + expect_equal(as.numeric(result_none[, "Estimate"]), ED_manual, tolerance = 1e-6) + + # Verify SE matches analytical delta-method: SE(ED_p) = |ln(1 - p/100)| * SE(e) + se_e <- sqrt(vcov(res2)[1, 1]) + SE_manual <- abs(log(1 - p / 100)) * se_e + expect_equal(as.numeric(result_none[, "Std. Error"]), SE_manual, tolerance = 1e-6) +}) + +# --- Additional stability tests for fixed-parameter edge cases --------------- + +test_that("FIX #12: ED() handles pre-computed vcov as scalar for 1-param model", { + res2 <- drm(yield ~ conc, data = exd_data, + fct = EXD.3(fixed = c(0, 199553, NA))) + v_scalar <- as.numeric(vcov(res2)) # accidentally convert to scalar + result <- ED(res2, c(10, 50), vcov. = v_scalar, display = FALSE) + expect_true(is.matrix(result)) + expect_equal(nrow(result), 2) + expect_true(all(result[, "Std. Error"] > 0)) +}) + +test_that("FIX #12: ED() rejects non-square numeric vcov", { + res2 <- drm(yield ~ conc, data = exd_data, + fct = EXD.3(fixed = c(0, 199553, NA))) + expect_error(ED(res2, 50, vcov. = c(1, 2, 3), display = FALSE), + "square matrix") +}) + +test_that("FIX #12: ED() rejects non-numeric vcov", { + res2 <- drm(yield ~ conc, data = exd_data, + fct = EXD.3(fixed = c(0, 199553, NA))) + expect_error(ED(res2, 50, vcov. = "not_a_matrix", display = FALSE), + "numeric matrix") +}) + +test_that("FIX #13: ED() with logBase transform and single free param", { + res2 <- drm(yield ~ conc, data = exd_data, + fct = EXD.3(fixed = c(0, 199553, NA))) + result <- ED(res2, c(10, 50), logBase = 10, display = FALSE) + expect_true(is.matrix(result)) + expect_equal(nrow(result), 2) + expect_true(all(result[, "Estimate"] > 0)) +}) + +test_that("ED() works with LL.4 and 3 fixed params (only e free)", { + m_full <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + cf <- coef(m_full) + m_1free <- drm(rootl ~ conc, data = ryegrass, + fct = LL.4(fixed = c(cf[1], cf[2], cf[3], NA))) + + expect_equal(length(coef(m_1free)), 1) + expect_true(is.matrix(vcov(m_1free))) + expect_equal(dim(vcov(m_1free)), c(1, 1)) + + # All interval types should work + for (int in c("none", "delta", "tfls", "fls")) { + result <- ED(m_1free, c(10, 50), interval = int, display = FALSE) + expect_true(is.matrix(result), info = paste("interval =", int)) + expect_equal(nrow(result), 2, info = paste("interval =", int)) + expect_true(all(result[, "Estimate"] > 0), info = paste("interval =", int)) + } +}) + +test_that("ED() works with W1.4 and 3 fixed params", { + m_full <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) + cf <- coef(m_full) + m_1free <- drm(rootl ~ conc, data = ryegrass, + fct = W1.4(fixed = c(cf[1], cf[2], cf[3], NA))) + + result <- ED(m_1free, c(10, 50), interval = "delta", display = FALSE) + expect_true(is.matrix(result)) + expect_equal(nrow(result), 2) + expect_true(all(result[, "Estimate"] > 0)) + expect_true(all(result[, "Std. Error"] > 0)) +}) + +test_that("ED() works with W2.4 and 3 fixed params", { + m_full <- drm(rootl ~ conc, data = ryegrass, fct = W2.4()) + cf <- coef(m_full) + m_1free <- drm(rootl ~ conc, data = ryegrass, + fct = W2.4(fixed = c(cf[1], cf[2], cf[3], NA))) + + result <- ED(m_1free, c(10, 50), interval = "delta", display = FALSE) + expect_true(is.matrix(result)) + expect_equal(nrow(result), 2) + expect_true(all(result[, "Estimate"] > 0)) + expect_true(all(result[, "Std. Error"] > 0)) +}) + +test_that("ED() multcomp output works with single free param", { + res2 <- drm(yield ~ conc, data = exd_data, + fct = EXD.3(fixed = c(0, 199553, NA))) + result <- ED(res2, c(10, 50), multcomp = TRUE, display = FALSE) + expect_true(is.list(result)) + expect_true("EDmultcomp" %in% names(result)) +}) + +test_that("ED() absolute type works with single free param", { + res2 <- drm(yield ~ conc, data = exd_data, + fct = EXD.3(fixed = c(0, 199553, NA))) + result <- ED(res2, 100000, type = "absolute", display = FALSE) + expect_true(is.matrix(result)) + expect_equal(nrow(result), 1) + expect_true(result[, "Estimate"] > 0) +}) diff --git a/tests/testthat/test-ED.lin.R b/tests/testthat/test-ED.lin.R new file mode 100644 index 00000000..725180a5 --- /dev/null +++ b/tests/testthat/test-ED.lin.R @@ -0,0 +1,193 @@ +# tests/testthat/test-ED.lin.R +# Comprehensive tests for ED.lin() - ED calculation for linear models + +# Helper to extract numeric value from the list-matrix returned by ED.lin +get_val <- function(result, row, col) { + as.numeric(unlist(result[row, col])) +} + +# --- 2-parameter linear models (lparco == 2) --------------------------------- + +test_that("ED.lin returns correct structure for increasing linear model", { + set.seed(42) + x <- 1:10 + y <- 2 + 3 * x + rnorm(10, 0, 0.5) + fit <- lm(y ~ x) + + result <- ED.lin(fit, 50) + + # Return type and dimensions + expect_true(is.matrix(result)) + expect_equal(nrow(result), 1) + expect_equal(ncol(result), 4) + expect_equal(colnames(result), c("Estimate", "SE", "2.5 %", "97.5 %")) + + # The ED50 estimate should be finite and positive + expect_true(is.finite(get_val(result, 1, "Estimate"))) + expect_true(get_val(result, 1, "Estimate") > 0) + # SE should be positive + expect_true(get_val(result, 1, "SE") > 0) +}) + +test_that("ED.lin handles increasing linear model (non-decreasing path)", { + # y = 2 + 3*x => increasing, parCoef[2] > 0 => decreasing = FALSE + set.seed(1) + x <- 1:10 + y <- 2 + 3 * x + rnorm(10, 0, 0.1) + fit <- lm(y ~ x) + + # decreasing should be FALSE for positive slope + expect_true(coef(fit)[2] > 0) + + result <- ED.lin(fit, 50) + + # ED50 estimate should be reasonable + est <- get_val(result, 1, "Estimate") + expect_true(is.finite(est)) +}) + +test_that("ED.lin handles decreasing linear model (decreasing path)", { + # y = 30 - 3*x => decreasing, parCoef[2] < 0 => decreasing = TRUE + set.seed(1) + x <- 1:10 + y <- 30 - 3 * x + rnorm(10, 0, 0.1) + fit <- lm(y ~ x) + + # decreasing should be TRUE for negative slope + expect_true(coef(fit)[2] < 0) + + result <- ED.lin(fit, 50) + + expect_true(is.matrix(result)) + expect_equal(nrow(result), 1) + expect_true(is.finite(get_val(result, 1, "Estimate"))) +}) + +test_that("ED.lin handles multiple response levels for 2-param model", { + set.seed(42) + x <- 1:10 + y <- 2 + 3 * x + rnorm(10, 0, 0.5) + fit <- lm(y ~ x) + + result <- ED.lin(fit, c(10, 25, 50, 75, 90)) + + expect_true(is.matrix(result)) + expect_equal(nrow(result), 5) + expect_equal(ncol(result), 4) + # All estimates should be finite + for (i in seq_len(nrow(result))) { + expect_true(is.finite(get_val(result, i, "Estimate"))) + } +}) + +# --- 3-parameter quadratic models (lparco == 3) ------------------------------ + +test_that("ED.lin handles quadratic concave-down model (vertex within range)", { + # parCoef[3] < 0, vertex within data range + set.seed(42) + x <- seq(0, 10, length.out = 20) + y <- 5 + 3 * x - 0.3 * x^2 + rnorm(20, 0, 0.5) + fit <- lm(y ~ x + I(x^2)) + + cc <- coef(fit) + expect_true(cc[3] < 0) # concave down + vertex_x <- -cc[2] / (2 * cc[3]) + expect_true(vertex_x <= max(x)) # vertex within range + + result <- ED.lin(fit, 50) + + expect_true(is.matrix(result)) + expect_equal(nrow(result), 1) + expect_equal(ncol(result), 4) + expect_true(is.finite(get_val(result, 1, "Estimate"))) +}) + +test_that("ED.lin handles quadratic concave-down model (vertex beyond range)", { + # parCoef[3] < 0, vertex > max(x) + set.seed(42) + x <- seq(0, 3, length.out = 20) + y <- 5 + 10 * x - 0.5 * x^2 + rnorm(20, 0, 0.5) + fit <- lm(y ~ x + I(x^2)) + + cc <- coef(fit) + expect_true(cc[3] < 0) # concave down + vertex_x <- -cc[2] / (2 * cc[3]) + expect_true(vertex_x > max(x)) # vertex beyond range + + result <- ED.lin(fit, 50) + + expect_true(is.matrix(result)) + expect_true(is.finite(get_val(result, 1, "Estimate"))) +}) + +test_that("ED.lin handles quadratic concave-up model (cup, parCoef[3] > 0)", { + # parCoef[3] > 0, decreasing = TRUE on line 11 + set.seed(42) + x <- seq(0, 10, length.out = 20) + y <- 10 - 3 * x + 0.3 * x^2 + rnorm(20, 0, 0.5) + fit <- lm(y ~ x + I(x^2)) + + cc <- coef(fit) + expect_true(cc[3] > 0) # concave up (cup) + + result <- ED.lin(fit, 50) + + expect_true(is.matrix(result)) + expect_true(is.finite(get_val(result, 1, "Estimate"))) +}) + +test_that("ED.lin handles multiple response levels for quadratic model", { + set.seed(42) + x <- seq(0, 10, length.out = 20) + y <- 5 + 3 * x - 0.3 * x^2 + rnorm(20, 0, 0.5) + fit <- lm(y ~ x + I(x^2)) + + result <- ED.lin(fit, c(10, 50, 90)) + + expect_equal(nrow(result), 3) + expect_equal(ncol(result), 4) +}) + +# --- Edge case: negative cVal truncation (pmax(0, cVal)) --------------------- + +test_that("ED.lin truncates negative cVal to zero", { + # Create a model where cVal (lower limit) would be negative + # For an increasing model, cVal = fitted at min(x) + set.seed(42) + x <- 0:10 + y <- -5 + 3 * x + rnorm(11, 0, 0.1) + fit <- lm(y ~ x) + + # Verify fitted value at min(x) is negative + expect_true(fitted(fit)[which.min(x)] < 0) + + # cVal is truncated to 0 by pmax + result <- ED.lin(fit, 50) + expect_true(is.matrix(result)) + expect_true(is.finite(get_val(result, 1, "Estimate"))) +}) + +# --- Correctness checks (known solutions) ------------------------------------ + +test_that("ED.lin gives correct ED50 for perfect linear model", { + # Perfect model: y = 10*x, x from 0 to 10 + # cVal = max(0, fitted(0)) = 0, dVal = fitted(10) = 100 + # ED50: x = 5 + x <- seq(0, 10, by = 1) + y <- 10 * x + fit <- lm(y ~ x) + + result <- suppressWarnings(ED.lin(fit, 50)) + expect_equal(get_val(result, 1, "Estimate"), 5, tolerance = 1e-6) +}) + +test_that("ED.lin gives correct ED50 for perfect decreasing linear model", { + # y = 100 - 10*x, x from 0 to 10 + # ED50: x = 5 + x <- seq(0, 10, by = 1) + y <- 100 - 10 * x + fit <- lm(y ~ x) + + result <- suppressWarnings(ED.lin(fit, 50)) + expect_equal(get_val(result, 1, "Estimate"), 5, tolerance = 1e-6) +}) diff --git a/tests/testthat/test-ED_robust.R b/tests/testthat/test-ED_robust.R new file mode 100644 index 00000000..ce20381b --- /dev/null +++ b/tests/testthat/test-ED_robust.R @@ -0,0 +1,406 @@ +# Tests for ED_robust() and maED_robust() functions +# Also covers helper functions: get_ed_interval() and drm_name() + +# Create test dataset (ryegrass) +ryegrass <- data.frame( + rootl = c( + 7.58, 8.00, 8.33, 7.25, 7.17, 7.00, 7.17, 7.83, 7.92, 7.58, + 6.17, 5.75, 5.83, 6.00, 5.83, 4.92, 4.50, 4.17, 4.42, 4.00, + 2.67, 2.08, 2.42, 2.50, 2.25, 1.17, 0.75, 0.92, 1.00, 0.58 + ), + conc = c( + rep(0, 5), rep(0.94, 5), rep(1.88, 5), + rep(3.75, 5), rep(7.50, 5), rep(15, 5) + ) +) + + +# ============================================================================= +# Tests for get_ed_interval() +# ============================================================================= + +test_that("get_ed_interval returns 'tfls' for LL model with small_n = TRUE", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + expect_equal(drc:::get_ed_interval(m1), "tfls") +}) + +test_that("get_ed_interval returns 'fls' for LL model with small_n = FALSE", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + expect_equal(drc:::get_ed_interval(m1, small_n = FALSE), "fls") +}) + +test_that("get_ed_interval returns 'delta' for Weibull models", { + expect_equal(drc:::get_ed_interval("W1.4"), "delta") + expect_equal(drc:::get_ed_interval("W2.3"), "delta") +}) + +test_that("get_ed_interval returns 'tfls' for LL character input", { + expect_equal(drc:::get_ed_interval("LL.4"), "tfls") + expect_equal(drc:::get_ed_interval("LL.4", small_n = TRUE), "tfls") +}) + +test_that("get_ed_interval returns 'fls' for LN character input with small_n = FALSE", { + expect_equal(drc:::get_ed_interval("LN.4", small_n = FALSE), "fls") +}) + +test_that("get_ed_interval returns 'tfls' for BC character input", { + expect_equal(drc:::get_ed_interval("BC.4"), "tfls") +}) + +test_that("get_ed_interval returns 'tfls' for CRS character input", { + expect_equal(drc:::get_ed_interval("CRS.4"), "tfls") +}) + +test_that("get_ed_interval defaults to 'tfls' for unknown model with message when verbose", { + expect_message( + result <- drc:::get_ed_interval("SomeUnknownModel", verbose = TRUE), + "Defaulting to 'tfls'" + ) + expect_equal(result, "tfls") +}) + +test_that("get_ed_interval defaults to 'tfls' for unknown model silently when not verbose", { + expect_silent(result <- drc:::get_ed_interval("SomeUnknownModel", verbose = FALSE)) + expect_equal(result, "tfls") +}) + +test_that("get_ed_interval errors for invalid input", { + expect_error(drc:::get_ed_interval(42), "must be a 'drc' object or a single character string") + expect_error(drc:::get_ed_interval(c("LL.4", "W1.4")), "must be a 'drc' object or a single character string") + expect_error(drc:::get_ed_interval(NULL), "must be a 'drc' object or a single character string") +}) + +test_that("get_ed_interval works with drc object input", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- drc:::get_ed_interval(m1) + expect_true(result %in% c("tfls", "fls", "delta")) +}) + +test_that("get_ed_interval works with Weibull drc model", { + m_w <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) + expect_equal(drc:::get_ed_interval(m_w), "delta") +}) + + +# ============================================================================= +# Tests for drm_name() +# ============================================================================= + +test_that("drm_name returns correct format for LL.4 model", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- drc:::drm_name(m1) + expect_true(is.character(result)) + expect_true(grepl("LL.4", result)) + expect_true(grepl(":", result)) + expect_true(grepl("-", result)) +}) + +test_that("drm_name errors for non-drc input", { + expect_error(drc:::drm_name("not_a_model"), "must be a `drc` object") + expect_error(drc:::drm_name(42), "must be a `drc` object") + expect_error(drc:::drm_name(lm(rootl ~ conc, data = ryegrass)), "must be a `drc` object") +}) + + +# ============================================================================= +# Tests for ED_robust() +# ============================================================================= + +test_that("ED_robust returns data.table with correct structure", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- ED_robust(m1, respLev = c(10, 50)) + + expect_true(data.table::is.data.table(result)) + expect_equal(nrow(result), 2) + expect_true(all(c("Estimate", "stderr", "Lower", "Upper", "confint_level", + "confint_method", "model", "EC") %in% names(result))) +}) + +test_that("ED_robust returns positive estimates for valid levels", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- ED_robust(m1, respLev = c(10, 50, 90)) + + expect_true(all(result$Estimate > 0, na.rm = TRUE)) + expect_true(all(result$EC == c(10, 50, 90))) +}) + +test_that("ED_robust returns correct metadata", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- ED_robust(m1, respLev = 50, CI_level = 0.90) + + expect_equal(result$confint_level, 0.90) + expect_equal(result$EC, 50) + expect_true(grepl("LL.4", result$model)) +}) + +test_that("ED_robust returns NA for non-estimable response levels", { + # BC.4 model with extreme response levels might fail + data(lettuce, package = "drc") + m1 <- drm(weight ~ conc, data = lettuce, fct = BC.4()) + result <- ED_robust(m1, respLev = c(50, 99)) + + expect_true(data.table::is.data.table(result)) + expect_equal(nrow(result), 2) + # At least one row should have data; some extreme levels may be NA +}) + +test_that("ED_robust handles errors gracefully and returns NA rows", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + # Remove edfct to force an error inside ED + m1_broken <- m1 + m1_broken$fct$edfct <- NULL + + result <- ED_robust(m1_broken, respLev = c(10, 50)) + + expect_true(data.table::is.data.table(result)) + expect_equal(nrow(result), 2) + # All should be NA since the model is broken + expect_true(all(is.na(result$Estimate))) +}) + +test_that("ED_robust verbose mode prints messages on success", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + expect_message( + ED_robust(m1, respLev = 50, verbose = TRUE), + "Successfully calculated ED" + ) +}) + +test_that("ED_robust verbose mode prints messages on error", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + m1$fct$edfct <- NULL + expect_message( + ED_robust(m1, respLev = 50, verbose = TRUE), + "Error calculating ED" + ) +}) + +test_that("ED_robust verbose mode prints appending info message", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + expect_message( + ED_robust(m1, respLev = 50, verbose = TRUE), + "Appending info" + ) +}) + +test_that("ED_robust handles single response level", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- ED_robust(m1, respLev = 50) + + expect_true(data.table::is.data.table(result)) + expect_equal(nrow(result), 1) +}) + +test_that("ED_robust uses default interval from get_ed_interval", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- ED_robust(m1, respLev = 50) + expect_true(result$confint_method %in% c("tfls", "fls", "delta")) +}) + +test_that("ED_robust works with Weibull model", { + m_w <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) + result <- ED_robust(m_w, respLev = c(10, 50)) + + expect_true(data.table::is.data.table(result)) + expect_equal(nrow(result), 2) + expect_equal(result$confint_method[1], "delta") +}) + +test_that("ED_robust returns NA row for negative or NA estimate", { + # Use a model where ED at an extreme level might produce negative estimates + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + # Test with very extreme response level that might produce non-positive ED + result <- ED_robust(m1, respLev = c(50, 99.99)) + + expect_true(data.table::is.data.table(result)) + expect_equal(nrow(result), 2) +}) + + +# ============================================================================= +# Tests for maED_robust() +# ============================================================================= + +test_that("maED_robust returns data.table with correct structure", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + fct_list <- list(LL.5 = LL.5(), W1.4 = W1.4()) + result <- maED_robust(m1, fct_ls = fct_list, respLev = c(10, 50)) + + expect_true(data.table::is.data.table(result)) + expect_equal(nrow(result), 2) + expect_true(all(c("Estimate", "stderr", "Lower", "Upper", "confint_level", + "confint_method", "model", "EC") %in% names(result))) +}) + +test_that("maED_robust returns positive estimates for valid levels", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + fct_list <- list(LL.5 = LL.5()) + result <- maED_robust(m1, fct_ls = fct_list, respLev = c(10, 50)) + + expect_true(all(result$Estimate > 0, na.rm = TRUE)) +}) + +test_that("maED_robust returns correct metadata", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + fct_list <- list(W1.4 = W1.4()) + result <- maED_robust(m1, fct_ls = fct_list, respLev = 50, CI_level = 0.90) + + expect_equal(result$confint_level, 0.90) + expect_equal(result$confint_method, "buckland") + expect_equal(result$EC, 50) + expect_true(grepl("/", result$model)) # model name should contain "/" separator +}) + +test_that("maED_robust handles errors gracefully", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + m1_broken <- m1 + m1_broken$fct$edfct <- NULL + + fct_list <- list(LL.5 = LL.5()) + result <- maED_robust(m1_broken, fct_ls = fct_list, respLev = c(10, 50)) + + expect_true(data.table::is.data.table(result)) + expect_equal(nrow(result), 2) + # Should have NA estimates due to broken model + expect_true(all(is.na(result$Estimate))) +}) + +test_that("maED_robust verbose mode prints messages on success", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + fct_list <- list(LL.5 = LL.5()) + expect_message( + maED_robust(m1, fct_ls = fct_list, respLev = 50, verbose = TRUE), + "Successfully calculated maED" + ) +}) + +test_that("maED_robust verbose mode prints messages on error", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + m1$fct$edfct <- NULL + fct_list <- list(LL.5 = LL.5()) + expect_message( + maED_robust(m1, fct_ls = fct_list, respLev = 50, verbose = TRUE), + "Error calculating maED" + ) +}) + +test_that("maED_robust verbose mode prints appending info message", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + fct_list <- list(LL.5 = LL.5()) + expect_message( + maED_robust(m1, fct_ls = fct_list, respLev = 50, verbose = TRUE), + "Appending info" + ) +}) + +test_that("maED_robust handles single response level", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + fct_list <- list(LL.5 = LL.5()) + result <- maED_robust(m1, fct_ls = fct_list, respLev = 50) + + expect_true(data.table::is.data.table(result)) + expect_equal(nrow(result), 1) +}) + +test_that("maED_robust returns NA for non-estimable response levels", { + data(lettuce, package = "drc") + m1 <- drm(weight ~ conc, data = lettuce, fct = BC.5()) + fct_list <- list(W2.4 = W2.4()) + result <- maED_robust(m1, fct_ls = fct_list, respLev = c(50, 99)) + + expect_true(data.table::is.data.table(result)) + expect_equal(nrow(result), 2) +}) + +test_that("maED_robust model name includes all model names", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + fct_list <- list(LL.5 = LL.5(), W1.4 = W1.4()) + result <- maED_robust(m1, fct_ls = fct_list, respLev = 50) + + # Model name should combine base model + alternatives separated by / + expect_true(grepl("LL.4", result$model)) +}) + +test_that("maED_robust works with default parameters", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + fct_list <- list(LL.5 = LL.5()) + result <- maED_robust(m1, fct_ls = fct_list) + + expect_true(data.table::is.data.table(result)) + expect_equal(nrow(result), 3) # default respLev is c(10, 20, 50) + expect_equal(result$confint_level[1], 0.95) +}) + + +# --- Tests for non-positive/NA estimate paths (lines 148, 283) --- + +test_that("ED_robust returns NA row when ED estimate is non-positive", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Mock drc::ED to return a result with a non-positive estimate + mock_ed <- function(mod, respLev, interval, level, display, ...) { + mat <- matrix(c(-1, 0.5, -2, 0), nrow = 1) + colnames(mat) <- c("Estimate", "Std. Error", "Lower", "Upper") + rownames(mat) <- paste0("e:1:", respLev) + mat + } + local_mocked_bindings(ED = mock_ed, .package = "drc") + + result <- ED_robust(m1, respLev = 50) + expect_true(data.table::is.data.table(result)) + expect_equal(nrow(result), 1) + expect_true(is.na(result$Estimate)) +}) + +test_that("ED_robust returns NA row when ED estimate is NA", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + mock_ed <- function(mod, respLev, interval, level, display, ...) { + mat <- matrix(c(NA_real_, 0.5, NA_real_, NA_real_), nrow = 1) + colnames(mat) <- c("Estimate", "Std. Error", "Lower", "Upper") + rownames(mat) <- paste0("e:1:", respLev) + mat + } + local_mocked_bindings(ED = mock_ed, .package = "drc") + + result <- ED_robust(m1, respLev = 50) + expect_true(data.table::is.data.table(result)) + expect_equal(nrow(result), 1) + expect_true(is.na(result$Estimate)) +}) + +test_that("maED_robust returns NA row when maED estimate is non-positive", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + fct_list <- list(LL.5 = LL.5()) + + mock_maED <- function(mod, fctList, respLev, interval, level, display, na.rm, ...) { + mat <- matrix(c(-1, 0.5, -2, 0), nrow = 1) + colnames(mat) <- c("Estimate", "Std. Error", "Lower", "Upper") + rownames(mat) <- paste0("e:1:", respLev) + mat + } + local_mocked_bindings(maED = mock_maED, .package = "drc") + + result <- maED_robust(m1, fct_ls = fct_list, respLev = 50) + expect_true(data.table::is.data.table(result)) + expect_equal(nrow(result), 1) + expect_true(is.na(result$Estimate)) +}) + +test_that("maED_robust returns NA row when maED estimate is NA", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + fct_list <- list(LL.5 = LL.5()) + + mock_maED <- function(mod, fctList, respLev, interval, level, display, na.rm, ...) { + mat <- matrix(c(NA_real_, 0.5, NA_real_, NA_real_), nrow = 1) + colnames(mat) <- c("Estimate", "Std. Error", "Lower", "Upper") + rownames(mat) <- paste0("e:1:", respLev) + mat + } + local_mocked_bindings(maED = mock_maED, .package = "drc") + + result <- maED_robust(m1, fct_ls = fct_list, respLev = 50) + expect_true(data.table::is.data.table(result)) + expect_equal(nrow(result), 1) + expect_true(is.na(result$Estimate)) +}) diff --git a/tests/testthat/test-EDcomp.R b/tests/testthat/test-EDcomp.R new file mode 100644 index 00000000..6e4143cc --- /dev/null +++ b/tests/testthat/test-EDcomp.R @@ -0,0 +1,379 @@ +# Tests for EDcomp (R/EDcomp.R) and related functions: +# - EDcomp: main function for comparing relative potencies +# - fieller: Fieller's confidence interval (also tested in test-siInner.R) +# - splitInd: split index vectors into shared/unique components +# - createsifct: factory for selectivity index functions + +# ============================================================================= +# Tests for EDcomp +# ============================================================================= + +test_that("EDcomp basic call with numeric curve names returns correct structure", { + # spinach has numeric curve names: 1,2,3,4,5 + spinach.LL.4 <- drm(SLOPE ~ DOSE, CURVE, data = spinach, fct = LL.4()) + result <- EDcomp(spinach.LL.4, c(50, 50), display = FALSE) + + expect_true(is.matrix(result)) + expect_equal(ncol(result), 4) + expect_equal(colnames(result), c("Estimate", "Std. Error", "t-value", "p-value")) + # With 5 curves and 2 percentages: C(5,2) * C(2,2) = 10 * 1 = 10 comparisons + expect_equal(nrow(result), 10) +}) + +test_that("EDcomp with non-numeric curve names triggers alphabetical ordering", { + # Use HERBICIDE factor for non-numeric curve names + spinach_herb <- drm(SLOPE ~ DOSE, HERBICIDE, data = spinach, fct = LL.4()) + result <- EDcomp(spinach_herb, c(50, 50), display = FALSE) + + expect_true(is.matrix(result)) + expect_equal(nrow(result), 1) # 2 curves -> 1 comparison + expect_true(grepl("bentazon", rownames(result)[1])) + expect_true(grepl("diuron", rownames(result)[1])) +}) + +test_that("EDcomp errors when interval='fls' and logBase is NULL", { + spinach.LL.4 <- drm(SLOPE ~ DOSE, CURVE, data = spinach, fct = LL.4()) + expect_error( + EDcomp(spinach.LL.4, c(50, 50), interval = "fls"), + "Argument 'logBase' not specified" + ) +}) + +test_that("EDcomp errors when relative percentages are outside (0, 100)", { + spinach.LL.4 <- drm(SLOPE ~ DOSE, CURVE, data = spinach, fct = LL.4()) + expect_error( + EDcomp(spinach.LL.4, c(0, 50)), + "Percentages outside the interval" + ) + expect_error( + EDcomp(spinach.LL.4, c(100, 50)), + "Percentages outside the interval" + ) + expect_error( + EDcomp(spinach.LL.4, c(-5, 50)), + "Percentages outside the interval" + ) +}) + +test_that("EDcomp with compMatch filters comparisons", { + spinach.LL.4 <- drm(SLOPE ~ DOSE, CURVE, data = spinach, fct = LL.4()) + result <- EDcomp(spinach.LL.4, c(50, 50), compMatch = c("1", "2"), display = FALSE) + + expect_true(is.matrix(result)) + expect_equal(nrow(result), 1) + expect_true(grepl("1/2", rownames(result)[1])) +}) + +test_that("EDcomp with percMat restricts percentage comparisons", { + spinach.LL.4 <- drm(SLOPE ~ DOSE, CURVE, data = spinach, fct = LL.4()) + result <- EDcomp(spinach.LL.4, c(10, 50, 90), percMat = matrix(c(1, 2), ncol = 2), + display = FALSE) + + expect_true(is.matrix(result)) + # Only one percentage comparison (10 vs 50), but 10 curve pairs + expect_equal(nrow(result), 10) +}) + +test_that("EDcomp with reverse=TRUE reverses comparison order", { + spinach.LL.4 <- drm(SLOPE ~ DOSE, CURVE, data = spinach, fct = LL.4()) + result_fwd <- EDcomp(spinach.LL.4, c(10, 50), display = FALSE) + result_rev <- EDcomp(spinach.LL.4, c(10, 50), reverse = TRUE, display = FALSE) + + expect_true(is.matrix(result_rev)) + # Reversed order: ratio should be reciprocal + # Row names should be reversed + expect_true(grepl("2/1", rownames(result_rev)[1])) +}) + +test_that("EDcomp with interval='delta' returns CI columns", { + spinach.LL.4 <- drm(SLOPE ~ DOSE, CURVE, data = spinach, fct = LL.4()) + result <- EDcomp(spinach.LL.4, c(50, 50), interval = "delta", display = FALSE) + + expect_true(is.matrix(result)) + expect_equal(ncol(result), 3) + expect_equal(colnames(result), c("Estimate", "Lower", "Upper")) + # Lower < Estimate < Upper for most comparisons + expect_true(all(result[, "Lower"] < result[, "Estimate"])) + expect_true(all(result[, "Upper"] > result[, "Estimate"])) +}) + +test_that("EDcomp with interval='fieller' returns CI columns", { + spinach.LL.4 <- drm(SLOPE ~ DOSE, CURVE, data = spinach, fct = LL.4()) + result <- EDcomp(spinach.LL.4, c(50, 50), interval = "fieller", display = FALSE) + + expect_true(is.matrix(result)) + expect_equal(ncol(result), 3) + expect_equal(colnames(result), c("Estimate", "Lower", "Upper")) +}) + +test_that("EDcomp with interval='fls' and logBase returns CI columns", { + spinach.LL.4 <- drm(SLOPE ~ DOSE, CURVE, data = spinach, fct = LL.4()) + result <- EDcomp(spinach.LL.4, c(50, 50), interval = "fls", logBase = 10, + display = FALSE) + + expect_true(is.matrix(result)) + expect_equal(ncol(result), 3) + expect_equal(colnames(result), c("Estimate", "Lower", "Upper")) +}) + +test_that("EDcomp with display=TRUE prints output", { + spinach.LL.4 <- drm(SLOPE ~ DOSE, CURVE, data = spinach, fct = LL.4()) + expect_output( + EDcomp(spinach.LL.4, c(50, 50), display = TRUE), + "Estimated ratios of effect doses" + ) +}) + +test_that("EDcomp with multcomp=TRUE returns parm object", { + spinach.LL.4 <- drm(SLOPE ~ DOSE, CURVE, data = spinach, fct = LL.4()) + result <- EDcomp(spinach.LL.4, c(50, 50), multcomp = TRUE, display = FALSE) + + expect_true(is.list(result)) + expect_true("multcomp" %in% names(result)) + expect_s3_class(result$multcomp, "parm") +}) + +test_that("EDcomp with multcomp=FALSE returns matrix invisibly", { + spinach.LL.4 <- drm(SLOPE ~ DOSE, CURVE, data = spinach, fct = LL.4()) + result <- EDcomp(spinach.LL.4, c(50, 50), multcomp = FALSE, display = FALSE) + + expect_true(is.matrix(result)) + expect_equal(ncol(result), 4) +}) + +test_that("EDcomp with logBase (no fls) applies logBase transformation", { + spinach.LL.4 <- drm(SLOPE ~ DOSE, CURVE, data = spinach, fct = LL.4()) + result <- EDcomp(spinach.LL.4, c(50, 50), logBase = 10, display = FALSE) + + expect_true(is.matrix(result)) + expect_equal(ncol(result), 4) + # All estimates should be positive (10^x is always positive) + expect_true(all(result[, "Estimate"] > 0)) +}) + +test_that("EDcomp with 3 percentages generates correct number of comparisons", { + spinach.LL.4 <- drm(SLOPE ~ DOSE, CURVE, data = spinach, fct = LL.4()) + result <- EDcomp(spinach.LL.4, c(10, 50, 90), display = FALSE) + + # 5 curves -> C(5,2) = 10 curve pairs + # 3 percentages -> C(3,2) = 3 percentage pairs + # Total: 10 * 3 = 30 comparisons + expect_equal(nrow(result), 30) +}) + +test_that("EDcomp switch statement covers 'delta' ciLabel path", { + spinach.LL.4 <- drm(SLOPE ~ DOSE, CURVE, data = spinach, fct = LL.4()) + # Delta interval triggers "Delta method" ciLabel + expect_output( + EDcomp(spinach.LL.4, c(50, 50), interval = "delta", display = TRUE), + "Estimated ratios of effect doses" + ) +}) + +test_that("EDcomp switch statement covers 'fieller' ciLabel path", { + spinach.LL.4 <- drm(SLOPE ~ DOSE, CURVE, data = spinach, fct = LL.4()) + expect_output( + EDcomp(spinach.LL.4, c(50, 50), interval = "fieller", display = TRUE), + "Estimated ratios of effect doses" + ) +}) + +test_that("EDcomp switch statement covers 'fls' ciLabel path", { + spinach.LL.4 <- drm(SLOPE ~ DOSE, CURVE, data = spinach, fct = LL.4()) + expect_output( + EDcomp(spinach.LL.4, c(50, 50), interval = "fls", logBase = 10, display = TRUE), + "Estimated ratios of effect doses" + ) +}) + +test_that("EDcomp with compMatch that matches no curves returns empty matrix", { + spinach.LL.4 <- drm(SLOPE ~ DOSE, CURVE, data = spinach, fct = LL.4()) + result <- EDcomp(spinach.LL.4, c(50, 50), compMatch = c("nonexistent1", "nonexistent2"), + display = FALSE) + expect_true(is.matrix(result)) + expect_equal(nrow(result), 0) +}) + +test_that("EDcomp with two percentages and two curves in compMatch", { + spinach.LL.4 <- drm(SLOPE ~ DOSE, CURVE, data = spinach, fct = LL.4()) + result <- EDcomp(spinach.LL.4, c(10, 50), compMatch = c("1", "2"), + display = FALSE) + + expect_true(is.matrix(result)) + # Only 1 curve pair, 1 percentage pair -> 1 row + expect_equal(nrow(result), 1) +}) + +# ============================================================================= +# Tests for splitInd +# ============================================================================= + +test_that("splitInd correctly identifies common and unique elements", { + result <- drc:::splitInd(c(1, 2, 3, 4), c(3, 4, 5, 6)) + + # only1: elements in ind1 but not ind2 + expect_equal(result[[1]], matrix(c(1, 2, 1, 2), ncol = 2)) + # only2: elements in ind2 but not ind1 + expect_equal(result[[2]], matrix(c(3, 4, 5, 6), ncol = 2)) + # inCommon: shared elements with positions in both vectors + expect_true(is.matrix(result[[3]])) + expect_equal(nrow(result[[3]]), 2) # elements 3 and 4 are common + expect_equal(result[[3]][, 3], c(3, 4)) # the common values +}) + +test_that("splitInd with no overlap returns NULL for inCommon", { + result <- drc:::splitInd(c(1, 2), c(3, 4)) + + expect_equal(result[[1]], matrix(c(1, 2, 1, 2), ncol = 2)) + expect_equal(result[[2]], matrix(c(1, 2, 3, 4), ncol = 2)) + expect_null(result[[3]]) +}) + +test_that("splitInd with full overlap returns empty only1 and only2", { + result <- drc:::splitInd(c(1, 2, 3), c(1, 2, 3)) + + # only1 and only2 should have 0 rows + expect_equal(nrow(result[[1]]), 0) + expect_equal(nrow(result[[2]]), 0) + # inCommon should have 3 rows + expect_equal(nrow(result[[3]]), 3) + expect_equal(result[[3]][, 3], c(1, 2, 3)) +}) + +test_that("splitInd with single elements", { + result <- drc:::splitInd(c(5), c(5)) + + expect_equal(nrow(result[[1]]), 0) + expect_equal(nrow(result[[2]]), 0) + expect_equal(nrow(result[[3]]), 1) + expect_equal(result[[3]][, 3], 5) +}) + +test_that("splitInd with single elements no overlap", { + result <- drc:::splitInd(c(1), c(2)) + + expect_equal(result[[1]], matrix(c(1, 1), ncol = 2)) + expect_equal(result[[2]], matrix(c(1, 2), ncol = 2)) + expect_null(result[[3]]) +}) + +# ============================================================================= +# Tests for createsifct +# ============================================================================= + +test_that("createsifct errors when edfct is NULL", { + indexMat <- matrix(1:4, nrow = 2, ncol = 2) + expect_error( + drc:::createsifct(NULL, NULL, FALSE, indexMat, 4), + "SI values cannot be calculated" + ) +}) + +test_that("createsifct returns function when fls=FALSE and logBase=NULL", { + spinach.LL.4 <- drm(SLOPE ~ DOSE, CURVE, data = spinach, fct = LL.4()) + sifct <- drc:::createsifct( + spinach.LL.4$fct$edfct, logBase = NULL, fls = FALSE, + indexMat = spinach.LL.4$indexMat, lenCoef = length(coef(spinach.LL.4)) + ) + expect_true(is.function(sifct)) + + # Test the returned function + parm1 <- spinach.LL.4$parmMat[, 1] + parm2 <- spinach.LL.4$parmMat[, 2] + result <- sifct(parm1, parm2, c(50, 50), 1, 2, "control", "relative") + expect_true(is.list(result)) + expect_true("val" %in% names(result)) + expect_true("der" %in% names(result)) + expect_true("der1" %in% names(result)) + expect_true("der2" %in% names(result)) + expect_true("valnum" %in% names(result)) + expect_true("valden" %in% names(result)) + # val should be ratio of ED values + expect_true(is.numeric(result$val)) +}) + +test_that("createsifct returns function when fls=FALSE and logBase is provided", { + spinach.LL.4 <- drm(SLOPE ~ DOSE, CURVE, data = spinach, fct = LL.4()) + sifct <- drc:::createsifct( + spinach.LL.4$fct$edfct, logBase = 10, fls = FALSE, + indexMat = spinach.LL.4$indexMat, lenCoef = length(coef(spinach.LL.4)) + ) + expect_true(is.function(sifct)) + + parm1 <- spinach.LL.4$parmMat[, 1] + parm2 <- spinach.LL.4$parmMat[, 2] + result <- sifct(parm1, parm2, c(50, 50), 1, 2, "control", "relative") + expect_true(is.list(result)) + # With logBase, SIpair = logBase^(ED1v - ED2v) + expect_true(result$val > 0) # logBase^x is always positive +}) + +test_that("createsifct returns function when fls=TRUE", { + spinach.LL.4 <- drm(SLOPE ~ DOSE, CURVE, data = spinach, fct = LL.4()) + sifct <- drc:::createsifct( + spinach.LL.4$fct$edfct, logBase = 10, fls = TRUE, + indexMat = spinach.LL.4$indexMat, lenCoef = length(coef(spinach.LL.4)) + ) + expect_true(is.function(sifct)) + + parm1 <- spinach.LL.4$parmMat[, 1] + parm2 <- spinach.LL.4$parmMat[, 2] + result <- sifct(parm1, parm2, c(50, 50), 1, 2, "control", "relative") + expect_true(is.list(result)) + # With fls=TRUE, SIpair = ED1v - ED2v (difference, not ratio) + expect_true(is.numeric(result$val)) +}) + +# ============================================================================= +# Tests for fieller (additional coverage beyond test-siInner.R) +# ============================================================================= + +test_that("fieller standard (finney=FALSE) returns two numeric values", { + mu <- c(10, 5) + df <- 20 + vcMat <- matrix(c(1, 0.2, 0.2, 0.5), 2, 2) + + result <- drc:::fieller(mu, df, vcMat, level = 0.95) + expect_true(is.numeric(result)) + expect_length(result, 2) + expect_true(result[1] < mu[1] / mu[2]) + expect_true(result[2] > mu[1] / mu[2]) +}) + +test_that("fieller Finney variant (finney=TRUE) returns two numeric values", { + mu <- c(10, 5) + df <- 20 + vcMat <- matrix(c(1, 0.2, 0.2, 0.5), 2, 2) + resVar <- 2.0 + + result <- drc:::fieller(mu, df, vcMat, level = 0.95, finney = TRUE, resVar = resVar) + expect_true(is.numeric(result)) + expect_length(result, 2) + expect_true(result[1] < result[2]) +}) + +test_that("fieller finney=TRUE errors when g >= 1", { + mu <- c(10, 0.5) + df <- 20 + vcMat <- matrix(c(1, 0.2, 0.2, 50), 2, 2) + resVar <- 2.0 + + expect_error( + drc:::fieller(mu, df, vcMat, level = 0.95, finney = TRUE, resVar = resVar), + "Fieller's theorem not useful" + ) +}) + +test_that("fieller with different confidence levels", { + mu <- c(10, 5) + df <- 20 + vcMat <- matrix(c(1, 0.2, 0.2, 0.5), 2, 2) + + result_90 <- drc:::fieller(mu, df, vcMat, level = 0.90) + result_99 <- drc:::fieller(mu, df, vcMat, level = 0.99) + + # 99% CI should be wider than 90% CI + width_90 <- result_90[2] - result_90[1] + width_99 <- result_99[2] - result_99[1] + expect_true(width_99 > width_90) +}) diff --git a/tests/testthat/test-MAX.R b/tests/testthat/test-MAX.R new file mode 100644 index 00000000..843d6573 --- /dev/null +++ b/tests/testthat/test-MAX.R @@ -0,0 +1,272 @@ +# tests/testthat/test-MAX.R +# Comprehensive tests for drc:::MAX to achieve 100% code coverage. + +# ────────────────────────────────────────────────────────────────────── +# Helper: fit a simple hormesis model for the happy-path tests +# ────────────────────────────────────────────────────────────────────── +make_crs_model <- function() { + data(lettuce, package = "drc", envir = environment()) + drm(weight ~ conc, data = lettuce, fct = CRS.4c()) +} + +make_bc_model <- function() { + data(lettuce, package = "drc", envir = environment()) + drm(weight ~ conc, data = lettuce, fct = BC.4()) +} + +# ==================================================================== +# 1. Input validation – object class (lines 81-83) +# ==================================================================== +test_that("MAX errors when object is not class 'drc'", { + expect_error( + drc:::MAX("not_a_model"), + "'object' must be of class 'drc'" + ) + expect_error( + drc:::MAX(list(a = 1)), + "'object' must be of class 'drc'" + ) + expect_error( + drc:::MAX(42), + "'object' must be of class 'drc'" + ) +}) + +# ==================================================================== +# 2. Input validation – no maxfct method (lines 88-94) +# ==================================================================== +test_that("MAX errors when model has no 'maxfct' method", { + # LL.4 is a log-logistic model with no hormesis => maxfct is NULL + data(ryegrass, package = "drc", envir = environment()) + m_ll4 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + expect_error( + drc:::MAX(m_ll4), + "No 'maxfct' method available" + ) +}) + +# ==================================================================== +# 3. Input validation – lower bound (lines 99-101) +# ==================================================================== +test_that("MAX errors for invalid 'lower' argument", { + m <- make_crs_model() + # Non-numeric + expect_error(drc:::MAX(m, lower = "a"), + "'lower' must be a single finite numeric value") + # Length > 1 + expect_error(drc:::MAX(m, lower = c(1, 2)), + "'lower' must be a single finite numeric value") + # NA + expect_error(drc:::MAX(m, lower = NA_real_), + "'lower' must be a single finite numeric value") + # Inf + expect_error(drc:::MAX(m, lower = Inf), + "'lower' must be a single finite numeric value") + # -Inf + expect_error(drc:::MAX(m, lower = -Inf), + "'lower' must be a single finite numeric value") + # NaN + expect_error(drc:::MAX(m, lower = NaN), + "'lower' must be a single finite numeric value") +}) + +# ==================================================================== +# 4. Input validation – upper bound (lines 102-104) +# ==================================================================== +test_that("MAX errors for invalid 'upper' argument", { + m <- make_crs_model() + # Non-numeric + expect_error(drc:::MAX(m, upper = "b"), + "'upper' must be a single finite numeric value") + # Length > 1 + expect_error(drc:::MAX(m, upper = c(100, 200)), + "'upper' must be a single finite numeric value") + # NA + expect_error(drc:::MAX(m, upper = NA_real_), + "'upper' must be a single finite numeric value") + # Inf + expect_error(drc:::MAX(m, upper = Inf), + "'upper' must be a single finite numeric value") +}) + +# ==================================================================== +# 5. Input validation – lower >= upper (lines 105-109) +# ==================================================================== +test_that("MAX errors when lower >= upper", { + m <- make_crs_model() + expect_error(drc:::MAX(m, lower = 100, upper = 100), + "'lower'.*must be strictly less than 'upper'") + expect_error(drc:::MAX(m, lower = 200, upper = 100), + "'lower'.*must be strictly less than 'upper'") +}) + +# ==================================================================== +# 6. Happy path – CRS.4c model (cedergreen class) +# ==================================================================== +test_that("MAX returns correct structure for CRS.4c model", { + m <- make_crs_model() + result <- drc:::MAX(m) + + expect_true(is.matrix(result)) + expect_equal(ncol(result), 2) + expect_equal(colnames(result), c("Dose", "Response")) + expect_true(nrow(result) >= 1) + # Values should be finite positive numbers for this dataset + expect_true(all(is.finite(result))) + expect_true(all(result[, "Dose"] > 0)) + expect_true(all(result[, "Response"] > 0)) +}) + +# ==================================================================== +# 7. Happy path – BC.4 model (braincousens class) +# ==================================================================== +test_that("MAX returns correct structure for BC.4 model", { + m <- make_bc_model() + result <- drc:::MAX(m) + + expect_true(is.matrix(result)) + expect_equal(ncol(result), 2) + expect_equal(colnames(result), c("Dose", "Response")) + expect_true(nrow(result) >= 1) + expect_true(all(is.finite(result))) +}) + +# ==================================================================== +# 8. Custom search interval +# ==================================================================== +test_that("MAX works with custom lower/upper bounds", { + m <- make_crs_model() + result <- drc:::MAX(m, lower = 1e-5, upper = 500) + + expect_true(is.matrix(result)) + expect_equal(ncol(result), 2) + expect_true(all(is.finite(result))) +}) + +# ==================================================================== +# 9. pool = FALSE path (lines 119-125, alternate vcov call) +# ==================================================================== +test_that("MAX works with pool = FALSE", { + m <- make_crs_model() + result <- drc:::MAX(m, pool = FALSE) + + expect_true(is.matrix(result)) + expect_equal(ncol(result), 2) + expect_true(all(is.finite(result))) +}) + +# ==================================================================== +# 10. vcov computation failure – warning path (lines 119-125) +# ==================================================================== +test_that("MAX warns when vcov computation fails", { + m <- make_crs_model() + # Corrupt the model's fit component so vcov.drc errors internally + m$fit <- NULL + + expect_warning( + result <- drc:::MAX(m), + "Could not compute variance-covariance matrix" + ) + + # Should still return valid results despite vcov failure + expect_true(is.matrix(result)) + expect_equal(ncol(result), 2) +}) + +# ==================================================================== +# 11. Boundary warning – dose at lower bound (lines 151-158) +# ==================================================================== +test_that("MAX warns when maximum dose is at the lower boundary", { + m <- make_crs_model() + # Use a very high lower bound so the result must be at the boundary + # The lettuce model max dose is around 0.02, so lower = 50 forces boundary + expect_warning( + result <- drc:::MAX(m, lower = 50, upper = 100), + "is at the boundary" + ) +}) + +# ==================================================================== +# 12. Boundary warning – dose at upper bound (lines 151-158) +# ==================================================================== +test_that("MAX warns when maximum dose is at the upper boundary", { + m <- make_crs_model() + # Use a very small upper bound so the result sits at the boundary + expect_warning( + result <- drc:::MAX(m, lower = 1e-8, upper = 1e-7), + "is at the boundary" + ) +}) + +# ==================================================================== +# 13. maxfct error → warning + NA (lines 161-167) +# ==================================================================== +test_that("MAX returns NA and warns when maxfct computation fails for a curve", { + m <- make_crs_model() + + # Replace the maxfct function with one that errors + m$fct$maxfct <- function(parm, lower, upper, ...) { + stop("simulated maxfct failure") + } + + expect_warning( + result <- drc:::MAX(m), + "MAX computation failed for curve" + ) + # All values should be NA + expect_true(all(is.na(result))) +}) + +# ==================================================================== +# 14. Curve name fallback when strParm is NULL (line 141) +# ==================================================================== +test_that("MAX falls back to 'Curve_i' when strParm is NULL", { + m <- make_crs_model() + # Remove column names from parmMat to trigger fallback + colnames(m$parmMat) <- NULL + + result <- drc:::MAX(m) + expect_true(is.matrix(result)) + expect_true(all(grepl("^Curve_", rownames(result)))) +}) + +# ==================================================================== +# 15. Curve name fallback when strParm is NA (line 141) +# ==================================================================== +test_that("MAX falls back to 'Curve_i' when strParm contains NA", { + m <- make_crs_model() + # Set column names to NA to trigger the fallback + colnames(m$parmMat) <- NA_character_ + + result <- drc:::MAX(m) + expect_true(is.matrix(result)) + expect_true(all(grepl("^Curve_", rownames(result)))) +}) + +# ==================================================================== +# 16. Return value is invisible (line 176) +# ==================================================================== +test_that("MAX returns invisibly", { + m <- make_crs_model() + # expect_invisible checks that the return value is invisible + expect_invisible(drc:::MAX(m)) +}) + +# ==================================================================== +# 17. Multiple curves +# ==================================================================== +test_that("MAX works with multiple curves (multi-curve data)", { + data(lettuce, package = "drc", envir = environment()) + # Create a fake curveid column to have two "curves" + lettuce2 <- rbind( + transform(lettuce, curveid = "A"), + transform(lettuce, curveid = "B", weight = weight * 1.1) + ) + m <- drm(weight ~ conc, curveid = curveid, data = lettuce2, fct = CRS.4c()) + result <- drc:::MAX(m) + + expect_true(is.matrix(result)) + expect_equal(nrow(result), 2) + expect_equal(ncol(result), 2) + expect_equal(colnames(result), c("Dose", "Response")) +}) diff --git a/tests/testthat/test-PR.R b/tests/testthat/test-PR.R new file mode 100644 index 00000000..8b1e9d79 --- /dev/null +++ b/tests/testthat/test-PR.R @@ -0,0 +1,120 @@ +# tests/testthat/test-PR.R +# Comprehensive tests for PR() function (R/pr.R) + +# --- Setup: Fit models used across multiple tests --- + +# Single-curve model using ryegrass dataset +ryegrass_model <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + +# Multi-curve model using S.alba dataset (two herbicide curves) +salba_model <- drm(DryMatter ~ Dose, curveid = Herbicide, + data = S.alba, fct = LL.4()) + +# ------------------------------------------------------------------- +# Section 1: Correctness tests ("Happy Path") — single-curve models +# ------------------------------------------------------------------- + +test_that("PR returns named numeric vector for single-curve model", { + result <- drc:::PR(ryegrass_model, c(1, 5, 10)) + + # Should be a numeric vector, not a matrix + + expect_false(is.matrix(result)) + expect_true(is.numeric(result)) + expect_length(result, 3) + + # Names should correspond to xVec values + + expect_equal(names(result), c("1", "5", "10")) +}) + +test_that("PR predictions match predict.drc for single-curve model", { + xvals <- c(0.5, 2, 8) + pr_result <- drc:::PR(ryegrass_model, xvals) + pred_result <- predict(ryegrass_model, data.frame(xvals)) + + expect_equal(unname(pr_result), as.numeric(pred_result)) +}) + +test_that("PR handles single dose value for single-curve model", { + result <- drc:::PR(ryegrass_model, 5) + + expect_false(is.matrix(result)) + expect_true(is.numeric(result)) + expect_length(result, 1) + expect_equal(names(result), "5") +}) + +# ------------------------------------------------------------------- +# Section 2: Single-curve model with se.fit = TRUE (matrix return) +# Covers lines 34-37: the is.matrix(retMat) == TRUE branch +# ------------------------------------------------------------------- + +test_that("PR returns matrix with rownames when se.fit = TRUE (single-curve)", { + result <- drc:::PR(ryegrass_model, c(2, 10), se.fit = TRUE) + + # predict.drc with se.fit=TRUE returns a matrix + expect_true(is.matrix(result)) + expect_equal(nrow(result), 2) + expect_true(ncol(result) >= 2) # At least Prediction + SE + + # Rownames should be the dose values as strings + expect_equal(rownames(result), c("2", "10")) +}) + +# ------------------------------------------------------------------- +# Section 3: Correctness tests — multi-curve models +# Covers lines 29-32: the lenCI > 1 branch +# ------------------------------------------------------------------- + +test_that("PR returns matrix with rownames for multi-curve model", { + xvals <- c(1, 10) + result <- drc:::PR(salba_model, xvals) + + # Multi-curve always returns a matrix (se.fit = TRUE is hardcoded) + expect_true(is.matrix(result)) + + # Curve IDs are stored as numeric codes internally + curve_ids <- as.character(unique(salba_model$data[, 3])) + expected_nrow <- length(xvals) * length(curve_ids) + expect_equal(nrow(result), expected_nrow) + + # Rownames should be curveId:dose format + expected_names <- paste(rep(curve_ids, each = length(xvals)), + rep(as.character(xvals), length(curve_ids)), + sep = ":") + expect_equal(rownames(result), expected_names) +}) + +test_that("PR handles single dose value for multi-curve model", { + result <- drc:::PR(salba_model, 5) + + expect_true(is.matrix(result)) + + curve_ids <- as.character(unique(salba_model$data[, 3])) + expect_equal(nrow(result), length(curve_ids)) +}) + +# ------------------------------------------------------------------- +# Section 4: Edge cases +# ------------------------------------------------------------------- + +test_that("PR works with dose value of zero", { + result <- drc:::PR(ryegrass_model, 0) + expect_true(is.numeric(result)) + expect_length(result, 1) + expect_equal(names(result), "0") +}) + +test_that("PR works with very large dose values", { + result <- drc:::PR(ryegrass_model, c(1e6)) + expect_true(is.numeric(result)) + expect_length(result, 1) +}) + +test_that("PR works with many dose values", { + xvals <- seq(0, 30, by = 0.5) + result <- drc:::PR(ryegrass_model, xvals) + expect_length(result, length(xvals)) + expect_equal(names(result), as.character(xvals)) +}) diff --git a/tests/testthat/test-anova.drclist.R b/tests/testthat/test-anova.drclist.R new file mode 100644 index 00000000..9fa029f6 --- /dev/null +++ b/tests/testthat/test-anova.drclist.R @@ -0,0 +1,436 @@ +# Tests for anova.drclist() function +# Achieves 100% coverage of R/anova.drclist.R + +# ─── Test Data ─────────────────────────────────────────────────────────────── + +ryegrass_data <- data.frame( + rootl = c( + 7.58, 8.00, 8.33, 7.25, 7.17, 7.00, 7.17, 7.83, 7.92, 7.58, + 6.17, 5.75, 5.83, 6.00, 5.83, 4.92, 4.50, 4.17, 4.42, 4.00, + 2.67, 2.08, 2.42, 2.50, 2.25, 1.17, 0.75, 0.92, 1.00, 0.58 + ), + conc = c( + rep(0, 5), rep(0.94, 5), rep(1.88, 5), + rep(3.75, 5), rep(7.50, 5), rep(15, 5) + ) +) + +binom_data <- data.frame( + dose = c(0, 0.1, 0.5, 1, 2, 5, 10), + resp = c(0, 0.05, 0.15, 0.35, 0.65, 0.90, 0.98), + n = rep(50, 7) +) + +# ─── Error Handling Tests ──────────────────────────────────────────────────── + +test_that("anova.drclist errors when more than 2 models are provided", { + m1 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.3()) + m2 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + m3 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.5()) + + expect_error( + anova(m1, m2, m3), + "Only two models can be compared" + ) +}) + +test_that("anova.drclist errors when models have different data types", { + m_cont <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + m_binom <- drm(resp ~ dose, data = binom_data, fct = LL.2(), + type = "binomial", weights = n) + + expect_error( + anova(m_cont, m_binom), + "The two models are based on different types on data" + ) +}) + +# ─── F-test Branch (Continuous Data) ───────────────────────────────────────── + +test_that("F-test: basic comparison with details = TRUE", { + m1 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.3()) + m2 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + + result <- anova(m1, m2, details = TRUE) + + expect_s3_class(result, "anova") + expect_s3_class(result, "data.frame") + expect_equal(nrow(result), 2) + expect_equal(ncol(result), 5) + expect_equal(colnames(result), c("ModelDf", "RSS", "Df", "F value", "p value")) + expect_equal(attr(result, "heading"), "ANOVA table\n") + + # First row should have NA for test stat and p-value + expect_true(is.na(result[1, "F value"])) + expect_true(is.na(result[1, "p value"])) + # Second row should have actual values + expect_false(is.na(result[2, "F value"])) + expect_false(is.na(result[2, "p value"])) + # p-value should be between 0 and 1 + expect_true(result[2, "p value"] >= 0 && result[2, "p value"] <= 1) +}) + +test_that("F-test: comparison with details = FALSE", { + m1 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.3()) + m2 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + + result <- anova(m1, m2, details = FALSE) + + expect_s3_class(result, "anova") + expect_equal(nrow(result), 2) +}) + +test_that("F-test: model order is swapped when df2 > df1", { + # LL.4 has more parameters (4) -> fewer df.residual than LL.3 (3 params) + m1 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + m2 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.3()) + + # When obj1 has fewer df (more params) and obj2 has more df (fewer params), + # df2 > df1 triggers the swap + result <- anova(m1, m2, details = FALSE) + + expect_s3_class(result, "anova") + expect_equal(nrow(result), 2) + # Row names should be swapped + expect_equal(rownames(result), c("2nd model", "1st model")) +}) + +test_that("F-test: explicit test='F' parameter", { + m1 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.3()) + m2 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + + result <- anova(m1, m2, test = "F", details = FALSE) + + expect_s3_class(result, "anova") + expect_equal(colnames(result), c("ModelDf", "RSS", "Df", "F value", "p value")) +}) + +# ─── Chi-square Test Branch (Binomial Data) ────────────────────────────────── + +test_that("Chi-square test: binomial data with default test=NULL selects Chisq", { + m1 <- drm(resp ~ dose, data = binom_data, fct = LL.2(), + type = "binomial", weights = n) + m2 <- drm(resp ~ dose, data = binom_data, fct = LL.3(), + type = "binomial", weights = n) + + result <- anova(m1, m2, details = FALSE) + + expect_s3_class(result, "anova") + expect_equal(nrow(result), 2) + expect_equal(colnames(result), c("ModelDf", "Loglik", "Df", "LR value", "p value")) + expect_equal(attr(result, "heading"), "ANOVA-like table\n") +}) + +test_that("Chi-square test: explicit test='Chisq' for continuous data", { + m1 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.3()) + m2 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + + result <- anova(m1, m2, test = "Chisq", details = FALSE) + + expect_s3_class(result, "anova") + expect_equal(colnames(result), c("ModelDf", "Loglik", "Df", "LR value", "p value")) + expect_equal(attr(result, "heading"), "ANOVA-like table\n") + # p-value should be valid + pval <- result[2, "p value"] + expect_true(!is.na(pval) && pval >= 0 && pval <= 1) +}) + +# ─── F-test Edge Cases for p-value ─────────────────────────────────────────── + +test_that("F-test: NaN test statistic gives NA p-value", { + m1 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.3()) + m2 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + + # Manipulate RSS to produce NaN (0/0 scenario) + m1_mod <- m1 + m2_mod <- m2 + m1_mod$summary[4] <- 0 + m2_mod$summary[4] <- 0 + + result <- anova(m1_mod, m2_mod, test = "F", details = FALSE) + expect_true(is.na(result[2, "p value"])) +}) + +test_that("F-test: negative test statistic gives p-value of 1", { + m1 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.3()) + m2 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + + # Manipulate so simpler model has lower RSS than complex model + m1_mod <- m1 + m2_mod <- m2 + # After swap: m1 is the model with more df (simpler), m2 has fewer df (complex) + # testStat = ((loglik[1]-loglik[2])/dfDiff[2]) / (loglik[2]/df2) + # Make loglik[1] < loglik[2] to get negative numerator + m1_mod$summary[4] <- 100 # simpler model RSS (will be obj1 after swap since more df) + m2_mod$summary[4] <- 200 # complex model RSS (will be obj2) + + result <- anova(m1_mod, m2_mod, test = "F", details = FALSE) + expect_equal(result[2, "p value"], 1) +}) + +test_that("F-test: Inf test statistic gives NA p-value", { + m1 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.3()) + m2 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + + # Make obj2 RSS = 0 to produce Inf (positive numerator / 0 denominator) + m1_mod <- m1 + m2_mod <- m2 + m2_mod$summary[4] <- 0 + m1_mod$summary[4] <- 10 + + result <- anova(m1_mod, m2_mod, test = "F", details = FALSE) + expect_true(is.na(result[2, "p value"])) +}) + +# ─── Details Printing: Collapse Paths for obj1 ────────────────────────────── + +test_that("details: collapse1 from obj1[[8]]$collapse (character)", { + m1 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.3()) + m2 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + + # Set a character collapse + m1_mod <- m1 + m1_mod[[8]]$collapse <- "custom_collapse" + + output <- capture.output(result <- anova(m1_mod, m2, details = TRUE)) + expect_true(any(grepl("custom_collapse", output))) +}) + +test_that("details: collapse1 from pmodelsText", { + m1 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.3()) + m2 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + + m1_mod <- m1 + m1_mod$pmodelsText <- "pmodels_text_1" + + output <- capture.output(result <- anova(m1_mod, m2, details = TRUE)) + expect_true(any(grepl("pmodels_text_1", output))) +}) + +test_that("details: collapse1 from obj1[[8]]$curve (non-NULL)", { + m1 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.3()) + m2 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + + m1_mod <- m1 + m1_mod[[8]]$collapse <- NULL + m1_mod[[8]]$pmodels <- NULL + m1_mod$pmodelsText <- NULL + m1_mod[[8]]$curve <- ~ group + + output <- capture.output(result <- anova(m1_mod, m2, details = TRUE)) + expect_true(any(grepl("group", output))) +}) + +test_that("details: collapse1 is non-character (formula/expression)", { + m1 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.3()) + m2 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + + m1_mod <- m1 + m1_mod[[8]]$collapse <- ~ a + b + m1_mod$pmodelsText <- NULL + + output <- capture.output(result <- anova(m1_mod, m2, details = TRUE)) + expect_s3_class(result, "anova") +}) + +test_that("details: collapse1 contains 'data.frame(' prefix", { + m1 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.3()) + m2 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + + m1_mod <- m1 + m1_mod[[8]]$collapse <- "data.frame(x, y, z)" + m1_mod$pmodelsText <- NULL + + output <- capture.output(result <- anova(m1_mod, m2, details = TRUE)) + # data.frame( prefix should be stripped + expect_true(any(grepl("x, y, z", output))) +}) + +test_that("details: collapse1 contains 'list(' prefix", { + m1 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.3()) + m2 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + + m1_mod <- m1 + m1_mod[[8]]$collapse <- "list(a, b, c)" + m1_mod$pmodelsText <- NULL + + output <- capture.output(result <- anova(m1_mod, m2, details = TRUE)) + # list( prefix should be stripped + expect_true(any(grepl("a, b, c", output))) +}) + +# ─── Details Printing: Collapse Paths for obj2 ────────────────────────────── + +test_that("details: collapse2 from obj2[[8]]$curve (non-NULL)", { + m1 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.3()) + m2 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + + m2_mod <- m2 + m2_mod[[8]]$collapse <- NULL + m2_mod[[8]]$pmodels <- NULL + m2_mod$pmodelsText <- NULL + m2_mod[[8]]$curve <- ~ treatment + + output <- capture.output(result <- anova(m1, m2_mod, details = TRUE)) + expect_true(any(grepl("treatment", output))) +}) + +test_that("details: collapse2 is non-character (formula)", { + m1 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.3()) + m2 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + + m2_mod <- m2 + m2_mod[[8]]$collapse <- ~ x + y + m2_mod$pmodelsText <- NULL + + output <- capture.output(result <- anova(m1, m2_mod, details = TRUE)) + expect_s3_class(result, "anova") +}) + +test_that("details: collapse2 contains 'data.frame(' prefix", { + m1 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.3()) + m2 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + + m2_mod <- m2 + m2_mod[[8]]$collapse <- "data.frame(p, q)" + m2_mod$pmodelsText <- NULL + + output <- capture.output(result <- anova(m1, m2_mod, details = TRUE)) + expect_true(any(grepl("p, q", output))) +}) + +test_that("details: collapse2 contains 'list(' prefix", { + m1 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.3()) + m2 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + + m2_mod <- m2 + m2_mod[[8]]$collapse <- "list(m, n)" + m2_mod$pmodelsText <- NULL + + output <- capture.output(result <- anova(m1, m2_mod, details = TRUE)) + expect_true(any(grepl("m, n", output))) +}) + +test_that("details: collapse2 from pmodelsText", { + m1 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.3()) + m2 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + + m2_mod <- m2 + m2_mod$pmodelsText <- "pmodels_text_2" + + output <- capture.output(result <- anova(m1, m2_mod, details = TRUE)) + expect_true(any(grepl("pmodels_text_2", output))) +}) + +# ─── Details Printing: colLine and pmodels paths ───────────────────────────── + +test_that("details: colLine = TRUE when collapse1 != collapse2", { + m1 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.3()) + m2 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + + # Set different collapse values to make colLine TRUE + m1_mod <- m1 + m2_mod <- m2 + m1_mod[[8]]$collapse <- "collapse_A" + m1_mod$pmodelsText <- NULL + m2_mod[[8]]$collapse <- "collapse_B" + m2_mod$pmodelsText <- NULL + + output <- capture.output(result <- anova(m1_mod, m2_mod, details = TRUE)) + # Both collapse values should appear in the output + expect_true(any(grepl("collapse_A", output))) + expect_true(any(grepl("collapse_B", output))) +}) + +test_that("details: colLine = FALSE when collapse1 == collapse2", { + m1 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.3()) + m2 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + + # Both have NULL collapse (default), so both will be "1 (for all parameters)" + output <- capture.output(result <- anova(m1, m2, details = TRUE)) + # The pmodels line should not appear since colLine is FALSE + # (both models have the same default collapse) + expect_true(any(grepl("1st model", output))) + expect_true(any(grepl("2nd model", output))) +}) + +test_that("details: pmodels present in obj1 triggers fctStart alignment", { + m1 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.3()) + m2 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + + m1_mod <- m1 + m1_mod[[8]]$pmodels <- list(~ 1, ~ 1, ~ 1) + m1_mod[[8]]$collapse <- "pmodel_collapse" + m1_mod$pmodelsText <- NULL + + output <- capture.output(result <- anova(m1_mod, m2, details = TRUE)) + # Should use " fct: " (with one fewer space) when pmodels present + expect_true(any(grepl("fct:", output))) +}) + +test_that("details: pmodels present in obj2 triggers fctStart alignment", { + m1 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.3()) + m2 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + + m2_mod <- m2 + m2_mod[[8]]$pmodels <- list(~ 1, ~ 1, ~ 1, ~ 1) + m2_mod[[8]]$collapse <- "pmodel_collapse_2" + m2_mod$pmodelsText <- NULL + + output <- capture.output(result <- anova(m1, m2_mod, details = TRUE)) + expect_true(any(grepl("fct:", output))) +}) + +# ─── Details Printing: fctInfo (text field) ────────────────────────────────── + +test_that("details: fctInfo uses obj$text when available", { + m1 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.3()) + m2 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + + m1_mod <- m1 + m1_mod$text <- "Custom Model Text 1" + + output <- capture.output(result <- anova(m1_mod, m2, details = TRUE)) + expect_true(any(grepl("Custom Model Text 1", output))) +}) + +test_that("details: fctInfo uses deparse(obj[[8]]$fct) when text is NULL", { + m1 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.3()) + m2 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + + # text is NULL by default, so deparse should be used + output <- capture.output(result <- anova(m1, m2, details = TRUE)) + expect_true(any(grepl("fct:", output))) +}) + +# ─── Chi-square Test with Details ──────────────────────────────────────────── + +test_that("Chi-square test with details = TRUE", { + m1 <- drm(resp ~ dose, data = binom_data, fct = LL.2(), + type = "binomial", weights = n) + m2 <- drm(resp ~ dose, data = binom_data, fct = LL.3(), + type = "binomial", weights = n) + + output <- capture.output(result <- anova(m1, m2, details = TRUE)) + + expect_s3_class(result, "anova") + expect_equal(colnames(result), c("ModelDf", "Loglik", "Df", "LR value", "p value")) + expect_true(any(grepl("1st model", output))) + expect_true(any(grepl("2nd model", output))) +}) + +# ─── Return Value Structure ───────────────────────────────────────────────── + +test_that("return value has correct structure and class", { + m1 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.3()) + m2 <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + + result <- anova(m1, m2, details = FALSE) + + expect_s3_class(result, "anova") + expect_s3_class(result, "data.frame") + expect_equal(nrow(result), 2) + expect_equal(ncol(result), 5) + expect_true(!is.null(attr(result, "heading"))) + expect_equal(rownames(result), c("1st model", "2nd model")) +}) diff --git a/tests/testthat/test-arandaordaz.R b/tests/testthat/test-arandaordaz.R new file mode 100644 index 00000000..0be03bcb --- /dev/null +++ b/tests/testthat/test-arandaordaz.R @@ -0,0 +1,339 @@ +# Tests for arandaordaz.R: arandaordaz() function + +# --- Input Validation: Error Handling --- + +test_that("arandaordaz errors when fixed is not numeric", { + expect_error( + arandaordaz(fixed = c("a", "b", "c")), + "'fixed' must be a numeric vector" + ) + expect_error( + arandaordaz(fixed = list(NA, NA, NA)), + "'fixed' must be a numeric vector" + ) +}) + +test_that("arandaordaz errors when fixed has wrong length", { + expect_error( + arandaordaz(fixed = c(NA, NA)), + "'fixed' must have length 3" + ) + expect_error( + arandaordaz(fixed = c(NA, NA, NA, NA)), + "'fixed' must have length 3" + ) + expect_error( + arandaordaz(fixed = numeric(0)), + "'fixed' must have length 3" + ) +}) + +test_that("arandaordaz errors when names is not character", { + expect_error( + arandaordaz(names = c(1, 2, 3)), + "'names' must be a character vector of length 3" + ) + expect_error( + arandaordaz(names = list("a", "b", "c")), + "'names' must be a character vector of length 3" + ) +}) + +test_that("arandaordaz errors when names has wrong length", { + expect_error( + arandaordaz(names = c("a", "b")), + "'names' must be a character vector of length 3" + ) + expect_error( + arandaordaz(names = c("a", "b", "c", "d")), + "'names' must be a character vector of length 3" + ) + expect_error( + arandaordaz(names = character(0)), + "'names' must be a character vector of length 3" + ) +}) + +# --- Correctness: Happy Path --- + +test_that("arandaordaz returns correct class and structure with defaults", { + ar <- arandaordaz() + expect_s3_class(ar, "drcMean") + expect_true(is.list(ar)) + expect_true(all(c("fct", "ssfct", "names", "deriv1", "deriv2", "derivx", + "edfct", "inversion", "name", "text", "noParm") %in% names(ar))) +}) + +test_that("arandaordaz has correct default parameter names", { + ar <- arandaordaz() + expect_equal(ar$names, c("a", "b", "c")) +}) + +test_that("arandaordaz has correct noParm with no fixed parameters", { + ar <- arandaordaz() + expect_equal(ar$noParm, 3) +}) + +test_that("arandaordaz uses default name when fctName not provided", { + ar <- arandaordaz() + expect_equal(ar$name, "arandaordaz") +}) + +test_that("arandaordaz uses default text when fctText not provided", { + ar <- arandaordaz() + expect_equal(ar$text, "Asymptotic regression") +}) + +test_that("arandaordaz uses provided fctName", { + ar <- arandaordaz(fctName = "CustomName") + expect_equal(ar$name, "CustomName") +}) + +test_that("arandaordaz uses provided fctText", { + ar <- arandaordaz(fctText = "Custom text description") + expect_equal(ar$text, "Custom text description") +}) + +test_that("arandaordaz returns invisible result", { + result <- withVisible(arandaordaz()) + expect_false(result$visible) +}) + +# --- Fixed Parameters --- + +test_that("arandaordaz handles fixed parameters correctly", { + ar <- arandaordaz(fixed = c(1, NA, NA)) + expect_equal(ar$noParm, 2) + expect_equal(ar$names, c("b", "c")) +}) + +test_that("arandaordaz handles multiple fixed parameters", { + ar <- arandaordaz(fixed = c(1, 10, NA)) + expect_equal(ar$noParm, 1) + expect_equal(ar$names, c("c")) +}) + +test_that("arandaordaz handles all parameters fixed", { + ar <- arandaordaz(fixed = c(1, 10, 0.5)) + expect_equal(ar$noParm, 0) + expect_equal(length(ar$names), 0) +}) + +test_that("arandaordaz custom names are preserved for non-fixed parameters", { + ar <- arandaordaz(fixed = c(NA, 5, NA), names = c("alpha", "beta", "gamma")) + expect_equal(ar$names, c("alpha", "gamma")) +}) + +# --- Mean Function (fct) --- + +test_that("arandaordaz fct computes correct values", { + ar <- arandaordaz() + # Parameters: a=0, b=10, c=1 + dose <- c(0, 1, 5, 10) + parm <- matrix(c(0, 10, 1), nrow = 4, ncol = 3, byrow = TRUE) + result <- ar$fct(dose, parm) + # f(x) = a + (b-a)(1-exp(-c*x)) + expected <- 0 + (10 - 0) * (1 - exp(-1 * dose)) + expect_equal(result, expected) +}) + +test_that("arandaordaz fct works with fixed parameters", { + ar <- arandaordaz(fixed = c(0, NA, NA)) + dose <- c(0, 1, 5) + parm <- matrix(c(10, 1), nrow = 3, ncol = 2, byrow = TRUE) + result <- ar$fct(dose, parm) + expected <- 0 + (10 - 0) * (1 - exp(-1 * dose)) + expect_equal(result, expected) +}) + +test_that("arandaordaz fct handles zero dose", { + ar <- arandaordaz() + dose <- 0 + parm <- matrix(c(1, 5, 0.5), nrow = 1, ncol = 3) + result <- ar$fct(dose, parm) + # At dose=0: f(0) = a + (b-a)(1-exp(0)) = a + (b-a)*0 = a + expect_equal(result, 1) +}) + +# --- Self-Starter Function (ssfct) --- + +test_that("arandaordaz ssfct returns initial parameter estimates", { + ar <- arandaordaz() + # Create simple test data + dataf <- data.frame( + x = c(0, 1, 2, 5, 10), + y = c(1, 2, 3, 5, 7) + ) + init_params <- ar$ssfct(dataf) + expect_equal(length(init_params), 3) + expect_true(all(is.finite(init_params))) +}) + +test_that("arandaordaz ssfct works with fixed parameters", { + ar <- arandaordaz(fixed = c(NA, NA, 0.5)) + dataf <- data.frame( + x = c(0, 1, 2, 5, 10), + y = c(1, 2, 3, 5, 7) + ) + init_params <- ar$ssfct(dataf) + expect_equal(length(init_params), 2) + expect_true(all(is.finite(init_params))) +}) + +test_that("arandaordaz ssfct warns on invalid log argument", { + ar <- arandaordaz() + # Create data that will trigger warning + # The warning triggers when innerVal = -((y - aPar) / (bPar - aPar) - 1) <= 0 + # With negative y values, the LOWER_SHRINK and UPPER_EXPAND factors + # work in reverse: aPar = min(y) * 0.95 becomes less negative (larger), + # and bPar = max(y) * 1.05 becomes more negative (smaller), + # causing some y values to exceed the bPar threshold. + dataf <- data.frame( + x = c(0, 1, 2, 3, 4), + y = c(-10, -8, -6, -4, -2) + ) + expect_warning( + ar$ssfct(dataf), + "Self-starter encountered invalid log argument" + ) +}) + +# --- Effective Dose Function (edfct) --- + +test_that("arandaordaz edfct works with relative type and control reference", { + ar <- arandaordaz() + parm <- c(0, 10, 1) + result <- ar$edfct(parm, respl = 50, reference = "control", type = "relative") + expect_true(is.list(result)) + expect_equal(length(result), 2) + expect_true(is.numeric(result[[1]])) + expect_true(is.numeric(result[[2]])) +}) + +test_that("arandaordaz edfct works with absolute type and control reference", { + ar <- arandaordaz() + parm <- c(0, 10, 1) + result <- ar$edfct(parm, respl = 5, reference = "control", type = "absolute") + expect_true(is.list(result)) + expect_true(is.numeric(result[[1]])) +}) + +test_that("arandaordaz edfct works with relative type and non-control reference", { + ar <- arandaordaz() + parm <- c(0, 10, 1) + result <- ar$edfct(parm, respl = 50, reference = "upper", type = "relative") + expect_true(is.list(result)) + expect_true(is.numeric(result[[1]])) +}) + +test_that("arandaordaz edfct works with absolute type and non-control reference", { + ar <- arandaordaz() + parm <- c(0, 10, 1) + result <- ar$edfct(parm, respl = 5, reference = "upper", type = "absolute") + expect_true(is.list(result)) + expect_true(is.numeric(result[[1]])) +}) + +test_that("arandaordaz edfct works with fixed parameters", { + ar <- arandaordaz(fixed = c(0, NA, NA)) + parm <- c(10, 1) # Only non-fixed parameters + result <- ar$edfct(parm, respl = 50, reference = "control", type = "relative") + expect_true(is.list(result)) + expect_equal(length(result), 2) + expect_equal(length(result[[2]]), 2) # Derivatives only for non-fixed +}) + +# --- Inverse Function (inversion) --- + +test_that("arandaordaz inversion computes correct values", { + ar <- arandaordaz() + parm <- c(0, 10, 1) + y <- c(2, 5, 8) + result <- ar$inversion(y, parm) + expect_true(all(is.finite(result))) + expect_equal(length(result), 3) +}) + +test_that("arandaordaz inversion works with fixed parameters", { + ar <- arandaordaz(fixed = c(0, NA, NA)) + parm <- c(10, 1) + y <- c(2, 5, 8) + result <- ar$inversion(y, parm) + expect_true(all(is.finite(result))) +}) + +test_that("arandaordaz inversion is inverse of fct", { + ar <- arandaordaz() + parm <- c(1, 10, 0.5) + dose <- c(1, 5, 10) + + # Calculate response from dose + parm_mat <- matrix(parm, nrow = 3, ncol = 3, byrow = TRUE) + y <- ar$fct(dose, parm_mat) + + # Back-calculate dose from response + dose_back <- ar$inversion(y, parm) + + expect_equal(dose, dose_back, tolerance = 1e-10) +}) + +# --- Derivative Slots --- + +test_that("arandaordaz deriv1 is NULL", { + ar <- arandaordaz() + expect_null(ar$deriv1) +}) + +test_that("arandaordaz deriv2 is NULL", { + ar <- arandaordaz() + expect_null(ar$deriv2) +}) + +test_that("arandaordaz derivx is NULL", { + ar <- arandaordaz() + expect_null(ar$derivx) +}) + +# --- Edge Cases --- + +test_that("arandaordaz handles NA in fixed at different positions", { + ar1 <- arandaordaz(fixed = c(1, NA, NA)) + expect_equal(ar1$names, c("b", "c")) + + ar2 <- arandaordaz(fixed = c(NA, 5, NA)) + expect_equal(ar2$names, c("a", "c")) + + ar3 <- arandaordaz(fixed = c(NA, NA, 0.5)) + expect_equal(ar3$names, c("a", "b")) +}) + +test_that("arandaordaz handles numeric fixed values including zero", { + ar <- arandaordaz(fixed = c(0, NA, NA)) + expect_equal(ar$noParm, 2) + expect_true(all(c("fct", "ssfct") %in% names(ar))) +}) + +test_that("arandaordaz handles negative fixed values", { + ar <- arandaordaz(fixed = c(-5, NA, NA)) + expect_equal(ar$noParm, 2) + expect_s3_class(ar, "drcMean") +}) + +test_that("arandaordaz ssfct handles single data point", { + ar <- arandaordaz() + dataf <- data.frame(x = 1, y = 5) + init_params <- ar$ssfct(dataf) + expect_equal(length(init_params), 3) +}) + +test_that("arandaordaz ssfct handles identical y values", { + ar <- arandaordaz() + dataf <- data.frame( + x = c(0, 1, 2, 3), + y = c(5, 5, 5, 5) + ) + # This will produce aPar = 4.75, bPar = 5.25 + # All y values will be the same, potentially causing issues + init_params <- ar$ssfct(dataf) + expect_equal(length(init_params), 3) +}) diff --git a/tests/testthat/test-backfit.R b/tests/testthat/test-backfit.R new file mode 100644 index 00000000..6ef342e4 --- /dev/null +++ b/tests/testthat/test-backfit.R @@ -0,0 +1,60 @@ +# Test backfit() function - Calculation of backfit values from fitted dose-response model + +# Create test dataset (ryegrass) +ryegrass <- data.frame( + rootl = c( + 7.58, 8.00, 8.33, 7.25, 7.17, 7.00, 7.17, 7.83, 7.92, 7.58, + 6.17, 5.75, 5.83, 6.00, 5.83, 4.92, 4.50, 4.17, 4.42, 4.00, + 2.67, 2.08, 2.42, 2.50, 2.25, 1.17, 0.75, 0.92, 1.00, 0.58 + ), + conc = c( + rep(0, 5), rep(0.94, 5), rep(1.88, 5), + rep(3.75, 5), rep(7.50, 5), rep(15, 5) + ) +) + +test_that("backfit returns correct structure", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- suppressWarnings(backfit(m1)) + + expect_true(is.matrix(result)) + expect_equal(ncol(result), 2) + expect_equal(colnames(result), c("dose", "Estimate")) + expect_null(rownames(result)) +}) + +test_that("backfit returns correct number of rows matching unique dose levels", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- suppressWarnings(backfit(m1)) + + unique_doses <- sort(unique(ryegrass$conc)) + expect_equal(nrow(result), length(unique_doses)) + expect_equal(result[, "dose"], unique_doses) +}) + +test_that("backfit values are numeric", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- suppressWarnings(backfit(m1)) + + expect_true(is.numeric(result[, "Estimate"])) +}) + +test_that("backfit produces reasonable values for mid-range doses", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- suppressWarnings(backfit(m1)) + + # For mid-range doses (within the dynamic range of the curve), + + # backfit values should approximate the original dose within a tolerance + mid_idx <- which(result[, "dose"] == 3.75) + expect_true(abs(result[mid_idx, "Estimate"] - 3.75) < 2) +}) + +test_that("backfit works with different dose-response models", { + m_w1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) + result <- suppressWarnings(backfit(m_w1)) + + expect_true(is.matrix(result)) + expect_equal(ncol(result), 2) + expect_equal(colnames(result), c("dose", "Estimate")) +}) diff --git a/tests/testthat/test-baro5.R b/tests/testthat/test-baro5.R new file mode 100644 index 00000000..60fc9bd5 --- /dev/null +++ b/tests/testthat/test-baro5.R @@ -0,0 +1,172 @@ +# Tests for baro5() function +# Baroreflex five-parameter dose-response model + +# =========================================================================== +# baro5() - Input validation +# =========================================================================== + +test_that("baro5 errors on invalid 'names' argument", { + # Wrong length + expect_error(baro5(names = c("a", "b")), + "Not correct 'names' argument") + # Not character + expect_error(baro5(names = c(1, 2, 3, 4, 5)), + "Not correct 'names' argument") +}) + +test_that("baro5 errors on invalid 'fixed' argument", { + expect_error(baro5(fixed = c(NA, NA)), + "Not correct 'fixed' argument") + expect_error(baro5(fixed = c(NA, NA, NA, NA, NA, NA)), + "Not correct 'fixed' argument") +}) + +# =========================================================================== +# baro5() - Happy path construction (all parameters free) +# =========================================================================== + +test_that("baro5 returns correct structure with default args", { + b <- baro5() + + # Class and type + expect_s3_class(b, "baro5") + expect_type(b, "list") + + # All expected components present + expected_names <- c("fct", "ssfct", "names", "deriv1", "deriv2", + "edfct", "sifct", "name", "text", "noParm") + expect_true(all(expected_names %in% names(b))) + + # Parameter names (all 5 free) + expect_equal(b$names, c("b1", "b2", "c", "d", "e")) + expect_equal(b$noParm, 5) + + # Name and text + expect_equal(b$name, "baro5") + expect_equal(b$text, "Baroreflex") + + # NULL fields + expect_null(b$deriv1) + expect_null(b$deriv2) + expect_null(b$edfct) + expect_null(b$sifct) +}) + +test_that("baro5 handles custom parameter names", { + b <- baro5(names = c("slope1", "slope2", "lower", "upper", "mid")) + expect_equal(b$names, c("slope1", "slope2", "lower", "upper", "mid")) +}) + +# =========================================================================== +# baro5() - Fixed parameters +# =========================================================================== + +test_that("baro5 with fixed parameters reduces names and noParm", { + # Fix c=0 + b <- baro5(fixed = c(NA, NA, 0, NA, NA)) + expect_equal(b$names, c("b1", "b2", "d", "e")) + expect_equal(b$noParm, 4) + + # Fix c=0 and d=100 + b2 <- baro5(fixed = c(NA, NA, 0, 100, NA)) + expect_equal(b2$names, c("b1", "b2", "e")) + expect_equal(b2$noParm, 3) +}) + +# =========================================================================== +# baro5() - fct function (model evaluation) +# =========================================================================== + +test_that("baro5 fct evaluates correctly with all free parameters", { + b <- baro5() + + # parm must be a matrix with one row per curve + # Parameters: b1, b2, c, d, e + parm <- matrix(c(1, 1, 0, 100, 5), nrow = 1) + doses <- c(1, 5, 10) + result <- b$fct(doses, parm) + + expect_length(result, 3) + expect_true(is.numeric(result)) + # At dose=e=5, with b1=b2=1, c=0, d=100: should be at midpoint + expect_equal(result[2], 50, tolerance = 1) +}) + +test_that("baro5 fct with fixed parameters works", { + b <- baro5(fixed = c(NA, NA, 0, NA, NA)) + # parm has only 4 columns (b1, b2, d, e) + parm <- matrix(c(1, 1, 100, 5), nrow = 1) + doses <- c(1, 5, 10) + result <- b$fct(doses, parm) + expect_length(result, 3) + expect_true(is.numeric(result)) +}) + +test_that("baro5 fct works with asymmetric parameters (b1 != b2)", { + b <- baro5() + # b1=2, b2=0.5 -> asymmetric curve + parm <- matrix(c(2, 0.5, 0, 100, 5), nrow = 1) + doses <- c(1, 5, 10) + result <- b$fct(doses, parm) + expect_length(result, 3) + expect_true(is.numeric(result)) + # All values should be between c=0 and d=100 + expect_true(all(result >= 0 & result <= 100)) +}) + +test_that("baro5 fct handles multiple rows in parm matrix", { + b <- baro5() + parm <- matrix(c(1, 1, 0, 100, 5, + 2, 2, 10, 90, 3), nrow = 2, byrow = TRUE) + doses <- c(1, 5) + result <- b$fct(doses, parm) + expect_length(result, 2) + expect_true(is.numeric(result)) +}) + +# =========================================================================== +# baro5() - ssfct (self-starter) +# =========================================================================== + +test_that("baro5 default ssfct returns correct number of initial values", { + b <- baro5() + dframe <- data.frame(dose = c(0, 0.5, 1, 2, 5, 10), + resp = c(100, 90, 75, 50, 20, 5)) + ssvals <- b$ssfct(dframe) + + expect_length(ssvals, 5) # all 5 parameters free + expect_true(is.numeric(ssvals)) +}) + +test_that("baro5 default ssfct respects fixed parameters", { + b <- baro5(fixed = c(NA, NA, 0, NA, NA)) + dframe <- data.frame(dose = c(0, 0.5, 1, 2, 5, 10), + resp = c(100, 90, 75, 50, 20, 5)) + ssvals <- b$ssfct(dframe) + + expect_length(ssvals, 4) # only 4 free parameters +}) + +test_that("baro5 with custom ssfct uses provided function", { + custom_ss <- function(dframe) { c(1, 1, 0, 100, 5) } + b <- baro5(ssfct = custom_ss) + dframe <- data.frame(dose = c(0, 1, 5), resp = c(100, 50, 5)) + result <- b$ssfct(dframe) + expect_equal(result, c(1, 1, 0, 100, 5)) +}) + +# =========================================================================== +# baro5() - Integration with drm model fitting +# =========================================================================== + +test_that("baro5 works with drm for model fitting", { + # Create dose-response data suitable for baro5 + set.seed(42) + dose <- rep(c(0.1, 0.5, 1, 2, 5, 10, 20, 50), each = 3) + resp <- 50 + 50 / (1 + exp(1.5 * (log(dose) - log(5)))) + rnorm(24, 0, 2) + test_data <- data.frame(dose = dose, resp = resp) + + m1 <- drm(resp ~ dose, data = test_data, fct = baro5()) + expect_s3_class(m1, "drc") + expect_length(coef(m1), 5) +}) diff --git a/tests/testthat/test-boxcox.drc.R b/tests/testthat/test-boxcox.drc.R new file mode 100644 index 00000000..8ee5632b --- /dev/null +++ b/tests/testthat/test-boxcox.drc.R @@ -0,0 +1,258 @@ +# Tests for boxcox.drc(), boxcoxCI(), and anovaFormula() + +# ========================================================================= +# Tests for boxcox.drc() +# ========================================================================= + +# --- Method "ml" --- + +test_that("boxcox.drc works with method='ml' and plotit=TRUE", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + pdf(file = tempfile(fileext = ".pdf")) + result <- boxcox(m1, lambda = seq(-2, 2, by = 0.5), plotit = TRUE, method = "ml") + dev.off() + + expect_true(inherits(result, "drc")) + expect_true(is.list(result$boxcox)) + expect_true(is.numeric(result$boxcox$lambda)) + expect_equal(length(result$boxcox$lambda), 1) + expect_equal(length(result$boxcox$ci), 2) + expect_equal(result$boxcox$bcAdd, 0) + expect_false(is.null(result$call$bcVal)) + expect_false(is.null(result$call$bcAdd)) +}) + +test_that("boxcox.drc works with method='ml' and plotit=FALSE", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- boxcox(m1, lambda = seq(-1, 2, by = 0.5), plotit = FALSE, method = "ml") + + expect_true(inherits(result, "drc")) + expect_true(is.list(result$boxcox)) + expect_true(is.numeric(result$boxcox$lambda)) +}) + +test_that("boxcox.drc ml method with bcAdd", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- boxcox(m1, lambda = seq(0, 2, by = 0.5), plotit = FALSE, bcAdd = 1) + + expect_true(inherits(result, "drc")) + expect_equal(result$boxcox$bcAdd, 1) + expect_equal(result$call$bcAdd, 1) +}) + +test_that("boxcox.drc ml method with custom level", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- boxcox(m1, lambda = seq(-1, 2, by = 0.5), plotit = FALSE, level = 0.90) + + expect_true(inherits(result, "drc")) + expect_true(is.list(result$boxcox)) +}) + +# --- Method "fixed" --- + +test_that("boxcox.drc works with a single lambda (fixed method)", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- boxcox(m1, lambda = 1) + + expect_true(inherits(result, "drc")) + expect_equal(result$boxcox$lambda, 1) + expect_true(all(is.na(result$boxcox$ci))) + expect_equal(result$call$bcVal, 1) +}) + +test_that("boxcox.drc fixed method with lambda = 0", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- boxcox(m1, lambda = 0) + + expect_true(inherits(result, "drc")) + expect_equal(result$boxcox$lambda, 0) + expect_equal(result$boxcox$ci, c(NA, NA)) +}) + +# --- Method "anova" --- + +test_that("boxcox.drc works with method='anova' single curve", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + pdf(file = tempfile(fileext = ".pdf")) + result <- boxcox(m1, lambda = seq(-2, 2, by = 0.5), method = "anova", plotit = TRUE) + dev.off() + + expect_true(inherits(result, "drc")) + expect_true(is.list(result$boxcox)) + expect_true(is.numeric(result$boxcox$lambda)) + expect_equal(length(result$boxcox$ci), 2) +}) + +test_that("boxcox.drc works with method='anova' and plotit=FALSE", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- boxcox(m1, lambda = seq(-2, 2, by = 0.5), method = "anova", plotit = FALSE) + + expect_true(inherits(result, "drc")) + expect_true(is.list(result$boxcox)) +}) + +test_that("boxcox.drc works with method='anova' multi-curve", { + m1 <- drm(DryMatter ~ Dose, curveid = Herbicide, data = S.alba, fct = LL.4()) + pdf(file = tempfile(fileext = ".pdf")) + result <- boxcox(m1, lambda = seq(0, 2, by = 0.5), method = "anova", plotit = TRUE) + dev.off() + + expect_true(inherits(result, "drc")) + expect_true(is.list(result$boxcox)) +}) + +test_that("boxcox.drc anova method errors without replicates", { + # Create a dataset with no replicates (each dose has exactly 1 obs) + no_rep_data <- data.frame( + dose = c(0, 1, 2, 5, 10, 20), + resp = c(100, 90, 70, 40, 10, 3) + ) + m1 <- drm(resp ~ dose, data = no_rep_data, fct = LL.4()) + + expect_error( + boxcox(m1, method = "anova"), + "ANOVA-based TBS approach requires replicates for each dose value" + ) +}) + +# --- Return value structure --- + +test_that("boxcox.drc returns invisible drc object with boxcox component", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- boxcox(m1, lambda = 1) + expect_true(inherits(result, "drc")) + expect_true("boxcox" %in% names(result)) + expect_true(is.list(result$boxcox)) + expect_true(all(c("lambda", "ci", "bcAdd") %in% names(result$boxcox))) +}) + +# ========================================================================= +# Tests for boxcoxCI() +# ========================================================================= + +test_that("boxcoxCI computes correct confidence interval", { + # Create a synthetic bell-shaped log-likelihood + x <- seq(-2, 2, by = 0.25) + y <- -((x - 0.5)^2) + 10 # peak at x = 0.5 + + ci <- drc:::boxcoxCI(x, y, level = 0.95) + + expect_equal(length(ci), 2) + expect_true(is.numeric(ci)) + # CI should bracket the optimal value of 0.5 + expect_true(ci[1] < 0.5) + expect_true(ci[2] > 0.5) +}) + +test_that("boxcoxCI handles NA values in y", { + x <- seq(-2, 2, by = 0.25) + y <- -((x - 0.5)^2) + 10 + y[c(1, 2, 16, 17)] <- NA # add some NAs + + ci <- drc:::boxcoxCI(x, y, level = 0.95) + + expect_equal(length(ci), 2) + expect_true(is.numeric(ci)) +}) + +test_that("boxcoxCI returns NA for lower bound when max is at left edge", { + # Log-likelihood that is monotonically decreasing + x <- seq(-2, 2, by = 0.25) + y <- -x + 10 # max at x = -2 (left edge), loglik[1] >= lim + # Here loglik[1] = max, so loglik[1] is NOT < lim => xx[1] stays NA + + ci <- drc:::boxcoxCI(x, y, level = 0.95) + + expect_true(is.na(ci[1])) # lower bound NA because max is at edge +}) + +test_that("boxcoxCI returns NA for upper bound when max is at right edge", { + # Log-likelihood that is monotonically increasing + x <- seq(-2, 2, by = 0.25) + y <- x + 10 # max at x = 2 (right edge), loglik[m] >= lim + # Here loglik[m] = max, so loglik[m] is NOT < lim => xx[2] stays NA + + ci <- drc:::boxcoxCI(x, y, level = 0.95) + + expect_true(is.na(ci[2])) # upper bound NA because max is at edge +}) + +test_that("boxcoxCI with different confidence levels", { + # Use wide grid centered at 0 to ensure both CI bounds are captured + x <- seq(-5, 5, by = 0.25) + y <- -((x - 0)^2) + 10 + + ci_95 <- drc:::boxcoxCI(x, y, level = 0.95) + ci_99 <- drc:::boxcoxCI(x, y, level = 0.99) + + # 99% CI should be wider than 95% CI + expect_true((ci_99[2] - ci_99[1]) >= (ci_95[2] - ci_95[1])) +}) + +# ========================================================================= +# Tests for anovaFormula() +# ========================================================================= + +test_that("anovaFormula creates formula for single curve", { + dose <- c(0, 1, 2, 5, 10) + resp <- c(100, 80, 60, 30, 5) + curveid <- rep("A", 5) + bcAdd <- 0 + + result <- drc:::anovaFormula(dose, resp, curveid, bcAdd) + + expect_true(is.list(result)) + expect_true("anovaFormula" %in% names(result)) + expect_true("anovaData" %in% names(result)) + expect_true(inherits(result$anovaFormula, "formula")) + expect_true(is.data.frame(result$anovaData)) + expect_equal(nrow(result$anovaData), 5) + expect_true(all(c("dose", "resp", "curveid", "bcc") %in% names(result$anovaData))) + # Single curve: should NOT have interaction term + formula_str <- deparse(result$anovaFormula) + expect_false(grepl("\\*", paste(formula_str, collapse = " "))) +}) + +test_that("anovaFormula creates formula for multiple curves", { + dose <- c(0, 1, 2, 5, 10, 0, 1, 2, 5, 10) + resp <- c(100, 80, 60, 30, 5, 95, 75, 55, 25, 3) + curveid <- rep(c("A", "B"), each = 5) + bcAdd <- 0 + + result <- drc:::anovaFormula(dose, resp, curveid, bcAdd) + + expect_true(is.list(result)) + expect_true(inherits(result$anovaFormula, "formula")) + expect_equal(nrow(result$anovaData), 10) + # Multi curve: should have interaction term + formula_str <- deparse(result$anovaFormula) + expect_true(grepl("\\*", paste(formula_str, collapse = " "))) +}) + +test_that("anovaFormula with non-zero bcAdd", { + dose <- c(0, 1, 2) + resp <- c(100, 80, 60) + curveid <- rep("A", 3) + bcAdd <- 2 + + result <- drc:::anovaFormula(dose, resp, curveid, bcAdd) + + expect_true(all(result$anovaData$bcc == 2)) + expect_equal(nrow(result$anovaData), 3) +}) + +# ========================================================================= +# Tests for functional programming usage (lapply / purrr::map) +# ========================================================================= + +test_that("boxcox.drc works when model fitted inside lapply", { + datasets <- list(ryegrass, ryegrass) + models <- lapply(datasets, function(.x) { + drm(rootl ~ conc, data = .x, fct = LL.4()) + }) + + result <- boxcox(models[[1]], lambda = seq(-1, 2, by = 0.5), plotit = FALSE, method = "ml") + expect_true(inherits(result, "drc")) + expect_true(is.list(result$boxcox)) + expect_true(is.numeric(result$boxcox$lambda)) +}) diff --git a/tests/testthat/test-braincousens.R b/tests/testthat/test-braincousens.R new file mode 100644 index 00000000..bb1c959b --- /dev/null +++ b/tests/testthat/test-braincousens.R @@ -0,0 +1,350 @@ +# Test file for braincousens function + +# Test basic functionality and correctness + +test_that("braincousens returns correct structure with default arguments", { + result <- braincousens() + + expect_s3_class(result, "braincousens") + expect_type(result, "list") + expect_true(all(c("fct", "ssfct", "names", "deriv1", "deriv2", "edfct", "maxfct", "name", "text", "noParm") %in% names(result))) + expect_equal(result$noParm, 5) + expect_equal(result$names, c("b", "c", "d", "e", "f")) + expect_equal(result$name, "braincousens") + expect_equal(result$text, "Brain-Cousens (hormesis)") + expect_null(result$deriv2) +}) + +test_that("braincousens works with custom fctName and fctText", { + result <- braincousens(fctName = "custom_name", fctText = "custom text") + + expect_equal(result$name, "custom_name") + expect_equal(result$text, "custom text") +}) + +test_that("braincousens works with fixed parameters", { + result <- braincousens(fixed = c(1, NA, NA, NA, 0)) + + expect_equal(result$noParm, 3) + expect_equal(result$names, c("c", "d", "e")) +}) + +test_that("braincousens works with custom parameter names", { + custom_names <- c("slope", "lower", "upper", "ed50", "horm") + result <- braincousens(names = custom_names) + + expect_equal(result$names, custom_names) +}) + +test_that("braincousens fct evaluates correctly", { + result <- braincousens() + + # Test with simple parameters + dose <- c(0.1, 1, 10) + parm <- matrix(c(1, 0, 1, 1, 0.1), nrow = 1) + + output <- result$fct(dose, parm) + + expect_type(output, "double") + expect_length(output, length(dose)) + expect_true(all(is.finite(output))) +}) + +test_that("braincousens ssfct works with valid data", { + result <- braincousens() + + # Create test data frame + dframe <- data.frame( + dose = c(0.1, 0.5, 1, 2, 5, 10), + response = c(0.9, 0.7, 0.5, 0.3, 0.1, 0.05) + ) + + init_vals <- result$ssfct(dframe) + + expect_type(init_vals, "double") + expect_length(init_vals, 5) + expect_true(all(is.finite(init_vals))) +}) + +test_that("braincousens ssfct works with custom ssfct", { + custom_ssfct <- function(dframe) { + return(c(1, 0, 1, 1, 0)) + } + + result <- braincousens(ssfct = custom_ssfct) + + dframe <- data.frame(dose = 1:5, response = 5:1) + init_vals <- result$ssfct(dframe) + + expect_equal(init_vals, c(1, 0, 1, 1, 0)) +}) + +test_that("braincousens deriv1 evaluates correctly", { + result <- braincousens() + + dose <- c(0.1, 1, 10) + parm <- matrix(c(1, 0, 1, 1, 0.1), nrow = 1) + + derivs <- result$deriv1(dose, parm) + + expect_true(is.matrix(derivs)) + expect_equal(nrow(derivs), length(dose)) + expect_equal(ncol(derivs), 5) + expect_true(all(is.finite(derivs))) +}) + +test_that("braincousens edfct works correctly", { + result <- braincousens() + + # Use parameters that work well with the Brain-Cousens model + parm <- c(2, 0, 1, 1, 0.5) + + ed_result <- result$edfct(parm, respl = 50, reference = "control", type = "relative") + + expect_type(ed_result, "list") + expect_length(ed_result, 2) + expect_type(ed_result[[1]], "double") + expect_type(ed_result[[2]], "double") + expect_length(ed_result[[2]], 5) +}) + +test_that("braincousens maxfct works correctly", { + result <- braincousens() + + parm <- c(2, 0, 1, 1, 0.5) + + max_result <- result$maxfct(parm) + + expect_type(max_result, "double") + expect_length(max_result, 2) + expect_true(all(is.finite(max_result))) +}) + +# Test error handling + +test_that("braincousens errors with incorrect names argument - not character", { + expect_error( + braincousens(names = c(1, 2, 3, 4, 5)), + "Not correct 'names' argument" + ) +}) + +test_that("braincousens errors with incorrect names argument - wrong length", { + expect_error( + braincousens(names = c("b", "c", "d")), + "Not correct 'names' argument" + ) +}) + +test_that("braincousens errors with incorrect fixed argument - wrong length", { + expect_error( + braincousens(fixed = c(NA, NA, NA)), + "Not correct 'fixed' argument" + ) +}) + +test_that("braincousens maxfct errors when b < 1", { + result <- braincousens() + + parm <- c(0.5, 0, 1, 1, 0.5) + + expect_error( + result$maxfct(parm), + "Brain-Cousens model with b<1 not meaningful" + ) +}) + +test_that("braincousens maxfct errors when f < 0", { + result <- braincousens() + + parm <- c(2, 0, 1, 1, -0.5) + + expect_error( + result$maxfct(parm), + "Brain-Cousens model with f<0 not meaningful" + ) +}) + +# Test edge cases + +test_that("braincousens works with all parameters fixed", { + result <- braincousens(fixed = c(1, 0, 1, 1, 0)) + + expect_equal(result$noParm, 0) + expect_length(result$names, 0) +}) + +test_that("braincousens works with only one parameter free", { + result <- braincousens(fixed = c(1, 0, 1, 1, NA)) + + expect_equal(result$noParm, 1) + expect_equal(result$names, "f") +}) + +test_that("braincousens method argument accepts different values", { + result1 <- braincousens(method = "1") + result2 <- braincousens(method = "2") + result3 <- braincousens(method = "3") + result4 <- braincousens(method = "4") + + expect_s3_class(result1, "braincousens") + expect_s3_class(result2, "braincousens") + expect_s3_class(result3, "braincousens") + expect_s3_class(result4, "braincousens") +}) + +test_that("braincousens fct handles edge case doses", { + result <- braincousens() + parm <- matrix(c(1, 0, 1, 1, 0.1), nrow = 1) + + # Very small dose + output_small <- result$fct(1e-10, parm) + expect_true(is.finite(output_small)) + + # Very large dose + output_large <- result$fct(1e10, parm) + expect_true(is.finite(output_large)) +}) + +test_that("braincousens deriv1 handles edge case doses", { + result <- braincousens() + parm <- matrix(c(1, 0, 1, 1, 0.1), nrow = 1) + + # Very small dose + derivs_small <- result$deriv1(1e-10, parm) + expect_true(all(is.finite(derivs_small))) + + # Very large dose + derivs_large <- result$deriv1(1e10, parm) + expect_true(all(is.finite(derivs_large))) +}) + +test_that("braincousens edfct works with different bounds", { + result <- braincousens() + parm <- c(2, 0, 1, 1, 0.5) + + ed_result <- result$edfct(parm, respl = 50, reference = "control", type = "relative", + lower = 1e-6, upper = 10000) + + expect_type(ed_result, "list") + expect_length(ed_result, 2) +}) + +test_that("braincousens maxfct works with different bounds", { + result <- braincousens() + parm <- c(2, 0, 1, 1, 0.5) + + max_result <- result$maxfct(parm, lower = 1e-6, upper = 10000) + + expect_type(max_result, "double") + expect_length(max_result, 2) +}) + +test_that("braincousens fct works with matrix parm", { + result <- braincousens() + + dose <- c(0.1, 1, 10) + # The function expects the number of rows in parm to match the number of doses + parm <- matrix(c(1, 0, 1, 1, 0.1, + 1, 0, 1, 1, 0.1, + 1, 0, 1, 1, 0.1), + nrow = 3, byrow = TRUE) + + output <- result$fct(dose, parm) + + expect_type(output, "double") + expect_length(output, length(dose)) +}) + +test_that("braincousens works with partial fixed parameters in different positions", { + # Fix first and last + result1 <- braincousens(fixed = c(1, NA, NA, NA, 0)) + expect_equal(result1$noParm, 3) + + # Fix middle parameters + result2 <- braincousens(fixed = c(NA, 0, 1, NA, NA)) + expect_equal(result2$noParm, 3) + + # Fix alternating parameters + result3 <- braincousens(fixed = c(NA, 0, NA, 1, NA)) + expect_equal(result3$noParm, 3) +}) + +# Test BC.4 wrapper function + +test_that("BC.4 returns correct structure", { + result <- BC.4() + + expect_s3_class(result, "braincousens") + expect_equal(result$noParm, 4) + expect_equal(result$names, c("b", "d", "e", "f")) + expect_equal(result$name, "BC.4") + expect_equal(result$text, "Brain-Cousens (hormesis) with lower limit fixed at 0") +}) + +test_that("BC.4 works with custom names", { + custom_names <- c("slope", "upper", "ed50", "horm") + result <- BC.4(names = custom_names) + + expect_equal(result$names, custom_names) +}) + +test_that("BC.4 works with fixed parameters", { + result <- BC.4(fixed = c(1, NA, NA, 0)) + + expect_equal(result$noParm, 2) + expect_equal(result$names, c("d", "e")) +}) + +test_that("BC.4 errors with incorrect names length", { + expect_error( + BC.4(names = c("b", "d", "e")), + "Not correct 'names' argument" + ) +}) + +test_that("BC.4 errors with non-character names", { + expect_error( + BC.4(names = c(1, 2, 3, 4)), + "Not correct 'names' argument" + ) +}) + +# Test BC.5 wrapper function + +test_that("BC.5 returns correct structure", { + result <- BC.5() + + expect_s3_class(result, "braincousens") + expect_equal(result$noParm, 5) + expect_equal(result$names, c("b", "c", "d", "e", "f")) + expect_equal(result$name, "BC.5") +}) + +test_that("BC.5 works with custom names", { + custom_names <- c("slope", "lower", "upper", "ed50", "horm") + result <- BC.5(names = custom_names) + + expect_equal(result$names, custom_names) +}) + +test_that("BC.5 works with fixed parameters", { + result <- BC.5(fixed = c(1, 0, NA, NA, 0)) + + expect_equal(result$noParm, 2) + expect_equal(result$names, c("d", "e")) +}) + +test_that("BC.5 errors with incorrect names length", { + expect_error( + BC.5(names = c("b", "c", "d")), + "Not correct 'names' argument" + ) +}) + +test_that("BC.5 errors with non-character names", { + expect_error( + BC.5(names = c(1, 2, 3, 4, 5)), + "Not correct 'names' argument" + ) +}) diff --git a/tests/testthat/test-braincousens.ssf.R b/tests/testthat/test-braincousens.ssf.R new file mode 100644 index 00000000..3dc50d3c --- /dev/null +++ b/tests/testthat/test-braincousens.ssf.R @@ -0,0 +1,312 @@ +# Test file for braincousens.ssf function +# Note: braincousens.ssf is an internal function, accessed via ::: + +# Test basic functionality and correctness + +test_that("braincousens.ssf returns a function", { + result <- drc:::braincousens.ssf(method = "1", fixed = c(NA, NA, NA, NA, NA)) + + expect_type(result, "closure") + expect_true(is.function(result)) +}) + +test_that("braincousens.ssf with method 1 returns valid initial values", { + ssfct <- drc:::braincousens.ssf(method = "1", fixed = c(NA, NA, NA, NA, NA)) + + # Create test data frame + dframe <- data.frame( + dose = c(0.1, 0.5, 1, 2, 5, 10), + response = c(0.9, 0.7, 0.5, 0.3, 0.1, 0.05) + ) + + init_vals <- ssfct(dframe) + + expect_type(init_vals, "double") + expect_length(init_vals, 5) +}) + +test_that("braincousens.ssf with method 2 returns valid initial values", { + ssfct <- drc:::braincousens.ssf(method = "2", fixed = c(NA, NA, NA, NA, NA)) + + dframe <- data.frame( + dose = c(0.1, 0.5, 1, 2, 5, 10), + response = c(0.9, 0.7, 0.5, 0.3, 0.1, 0.05) + ) + + init_vals <- ssfct(dframe) + + expect_type(init_vals, "double") + expect_length(init_vals, 5) +}) + +test_that("braincousens.ssf with method 3 returns valid initial values", { + ssfct <- drc:::braincousens.ssf(method = "3", fixed = c(NA, NA, NA, NA, NA)) + + dframe <- data.frame( + dose = c(0.1, 0.5, 1, 2, 5, 10), + response = c(0.9, 0.7, 0.5, 0.3, 0.1, 0.05) + ) + + init_vals <- ssfct(dframe) + + expect_type(init_vals, "double") + expect_length(init_vals, 5) +}) + +test_that("braincousens.ssf with method 4 returns valid initial values", { + ssfct <- drc:::braincousens.ssf(method = "4", fixed = c(NA, NA, NA, NA, NA)) + + dframe <- data.frame( + dose = c(0.1, 0.5, 1, 2, 5, 10), + response = c(0.9, 0.7, 0.5, 0.3, 0.1, 0.05) + ) + + init_vals <- ssfct(dframe) + + expect_type(init_vals, "double") + expect_length(init_vals, 5) +}) + +test_that("braincousens.ssf works with fixed parameters", { + # Fix first and last parameters + ssfct <- drc:::braincousens.ssf(method = "1", fixed = c(1, NA, NA, NA, 0)) + + dframe <- data.frame( + dose = c(0.1, 0.5, 1, 2, 5, 10), + response = c(0.9, 0.7, 0.5, 0.3, 0.1, 0.05) + ) + + init_vals <- ssfct(dframe) + + # Should only return values for non-fixed parameters (c, d, e) + expect_length(init_vals, 3) +}) + +test_that("braincousens.ssf works with all parameters fixed", { + ssfct <- drc:::braincousens.ssf(method = "1", fixed = c(1, 0, 1, 1, 0)) + + dframe <- data.frame( + dose = c(0.1, 0.5, 1, 2, 5, 10), + response = c(0.9, 0.7, 0.5, 0.3, 0.1, 0.05) + ) + + init_vals <- ssfct(dframe) + + # Should return empty vector since all parameters are fixed + expect_length(init_vals, 0) +}) + +test_that("braincousens.ssf f parameter is always 0", { + ssfct <- drc:::braincousens.ssf(method = "1", fixed = c(NA, NA, NA, NA, NA)) + + dframe <- data.frame( + dose = c(0.1, 0.5, 1, 2, 5, 10), + response = c(0.9, 0.7, 0.5, 0.3, 0.1, 0.05) + ) + + init_vals <- ssfct(dframe) + + # The 5th parameter (f) should be 0 + expect_equal(init_vals[5], 0) +}) + +test_that("braincousens.ssf works with useFixed parameter", { + # Test with useFixed = TRUE (although not implemented, should not error) + ssfct <- drc:::braincousens.ssf(method = "1", fixed = c(NA, NA, NA, NA, NA), useFixed = TRUE) + + dframe <- data.frame( + dose = c(0.1, 0.5, 1, 2, 5, 10), + response = c(0.9, 0.7, 0.5, 0.3, 0.1, 0.05) + ) + + init_vals <- ssfct(dframe) + + expect_type(init_vals, "double") + expect_length(init_vals, 5) +}) + +test_that("braincousens.ssf works with useFixed = FALSE", { + ssfct <- drc:::braincousens.ssf(method = "1", fixed = c(NA, NA, NA, NA, NA), useFixed = FALSE) + + dframe <- data.frame( + dose = c(0.1, 0.5, 1, 2, 5, 10), + response = c(0.9, 0.7, 0.5, 0.3, 0.1, 0.05) + ) + + init_vals <- ssfct(dframe) + + expect_type(init_vals, "double") + expect_length(init_vals, 5) +}) + +# Test error handling + +test_that("braincousens.ssf errors with invalid method", { + expect_error( + drc:::braincousens.ssf(method = "5", fixed = c(NA, NA, NA, NA, NA)), + "'arg' should be one of" + ) +}) + +test_that("braincousens.ssf errors with non-character method", { + expect_error( + drc:::braincousens.ssf(method = 1, fixed = c(NA, NA, NA, NA, NA)) + ) +}) + +# Test edge cases + +test_that("braincousens.ssf works with minimal data", { + ssfct <- drc:::braincousens.ssf(method = "1", fixed = c(NA, NA, NA, NA, NA)) + + # Minimal data frame + dframe <- data.frame( + dose = c(0.1, 1, 10), + response = c(0.9, 0.5, 0.1) + ) + + init_vals <- ssfct(dframe) + + expect_type(init_vals, "double") + expect_length(init_vals, 5) +}) + +test_that("braincousens.ssf works with larger dataset", { + ssfct <- drc:::braincousens.ssf(method = "2", fixed = c(NA, NA, NA, NA, NA)) + + # Larger data frame + dframe <- data.frame( + dose = rep(c(0.01, 0.1, 0.5, 1, 2, 5, 10, 20), each = 3), + response = c( + rep(0.95, 3), rep(0.9, 3), rep(0.7, 3), rep(0.5, 3), + rep(0.3, 3), rep(0.15, 3), rep(0.05, 3), rep(0.02, 3) + ) + ) + + init_vals <- ssfct(dframe) + + expect_type(init_vals, "double") + expect_length(init_vals, 5) +}) + +test_that("braincousens.ssf handles data with varying responses", { + ssfct <- drc:::braincousens.ssf(method = "3", fixed = c(NA, NA, NA, NA, NA)) + + # Data with some variation + set.seed(123) + dframe <- data.frame( + dose = c(0.1, 0.5, 1, 2, 5, 10), + response = c(0.9, 0.7, 0.5, 0.3, 0.1, 0.05) + rnorm(6, 0, 0.05) + ) + + init_vals <- ssfct(dframe) + + expect_type(init_vals, "double") + expect_length(init_vals, 5) +}) + +test_that("braincousens.ssf method 1 uses findbe1", { + # Test that method 1 produces expected behavior + ssfct <- drc:::braincousens.ssf(method = "1", fixed = c(NA, NA, NA, NA, NA)) + + dframe <- data.frame( + dose = c(0.1, 1, 10, 100), + response = c(0.95, 0.75, 0.25, 0.05) + ) + + init_vals <- ssfct(dframe) + + # All values should be finite + expect_true(all(is.finite(init_vals))) +}) + +test_that("braincousens.ssf method 2 uses findbe2 with Anke", { + ssfct <- drc:::braincousens.ssf(method = "2", fixed = c(NA, NA, NA, NA, NA)) + + dframe <- data.frame( + dose = c(0.1, 1, 10, 100), + response = c(0.95, 0.75, 0.25, 0.05) + ) + + init_vals <- ssfct(dframe) + + expect_true(all(is.finite(init_vals))) +}) + +test_that("braincousens.ssf method 3 uses findbe3", { + ssfct <- drc:::braincousens.ssf(method = "3", fixed = c(NA, NA, NA, NA, NA)) + + dframe <- data.frame( + dose = c(0.1, 1, 10, 100), + response = c(0.95, 0.75, 0.25, 0.05) + ) + + init_vals <- ssfct(dframe) + + expect_true(all(is.finite(init_vals))) +}) + +test_that("braincousens.ssf method 4 uses findbe2 with Normolle", { + ssfct <- drc:::braincousens.ssf(method = "4", fixed = c(NA, NA, NA, NA, NA)) + + dframe <- data.frame( + dose = c(0.1, 1, 10, 100), + response = c(0.95, 0.75, 0.25, 0.05) + ) + + init_vals <- ssfct(dframe) + + expect_true(all(is.finite(init_vals))) +}) + +test_that("braincousens.ssf works with different fixed parameter combinations", { + # Fix only b parameter + ssfct1 <- drc:::braincousens.ssf(method = "1", fixed = c(1, NA, NA, NA, NA)) + + # Fix c and d parameters + ssfct2 <- drc:::braincousens.ssf(method = "1", fixed = c(NA, 0, 1, NA, NA)) + + # Fix e parameter + ssfct3 <- drc:::braincousens.ssf(method = "1", fixed = c(NA, NA, NA, 1, NA)) + + dframe <- data.frame( + dose = c(0.1, 0.5, 1, 2, 5, 10), + response = c(0.9, 0.7, 0.5, 0.3, 0.1, 0.05) + ) + + init1 <- ssfct1(dframe) + init2 <- ssfct2(dframe) + init3 <- ssfct3(dframe) + + expect_length(init1, 4) + expect_length(init2, 3) + expect_length(init3, 4) +}) + +test_that("braincousens.ssf helper functions are defined", { + # The helper functions should be created inside braincousens.ssf + ssfct <- drc:::braincousens.ssf(method = "1", fixed = c(NA, NA, NA, NA, NA)) + + # Should work without error + dframe <- data.frame( + dose = c(0.1, 1, 10), + response = c(0.9, 0.5, 0.1) + ) + + expect_no_error(ssfct(dframe)) +}) + +test_that("braincousens.ssf returns correct parameter order", { + ssfct <- drc:::braincousens.ssf(method = "1", fixed = c(NA, NA, NA, NA, NA)) + + dframe <- data.frame( + dose = c(0.1, 0.5, 1, 2, 5, 10), + response = c(0.9, 0.7, 0.5, 0.3, 0.1, 0.05) + ) + + init_vals <- ssfct(dframe) + + # Should return c(b, c, d, e, f) in that order + # We know f should be 0 + expect_equal(init_vals[5], 0) +}) diff --git a/tests/testthat/test-cedergreen-ssf.R b/tests/testthat/test-cedergreen-ssf.R new file mode 100644 index 00000000..4922f5f3 --- /dev/null +++ b/tests/testthat/test-cedergreen-ssf.R @@ -0,0 +1,762 @@ +# Test file for cedergreen.ssf function +# Goal: Achieve 100% code coverage + +library(testthat) +library(drc) + +# Load test data +data(ryegrass) +test_data <- data.frame(dose = ryegrass$conc, response = ryegrass$rootl) + +# ============================================================================== +# Basic Structure and Default Behavior Tests +# ============================================================================== + +test_that("cedergreen.ssf returns a function", { + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(NA, NA, NA, NA, NA), + alpha = 1 + ) + + expect_true(is.function(ssf)) +}) + +test_that("cedergreen.ssf with default useFixed = FALSE works", { + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(NA, NA, NA, NA, NA), + alpha = 1, + useFixed = FALSE + ) + + result <- ssf(test_data) + + expect_type(result, "double") + expect_named(result, c("b", "c", "d", "e", "f")) + expect_length(result, 5) + expect_true(all(is.finite(result))) +}) + +test_that("cedergreen.ssf with useFixed = TRUE works", { + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(NA, NA, NA, NA, NA), + alpha = 1, + useFixed = TRUE + ) + + result <- ssf(test_data) + + expect_type(result, "double") + expect_length(result, 5) +}) + +# ============================================================================== +# Method Argument Tests - Test all 4 methods +# ============================================================================== + +test_that("cedergreen.ssf method='loglinear' works", { + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(NA, NA, NA, NA, NA), + alpha = 1 + ) + + result <- ssf(test_data) + + expect_named(result, c("b", "c", "d", "e", "f")) + expect_true(all(is.finite(result))) +}) + +test_that("cedergreen.ssf method='anke' works", { + ssf <- cedergreen.ssf( + method = "anke", + fixed = c(NA, NA, NA, NA, NA), + alpha = 1 + ) + + result <- ssf(test_data) + + expect_named(result, c("b", "c", "d", "e", "f")) + expect_true(all(is.finite(result))) +}) + +test_that("cedergreen.ssf method='method3' works", { + ssf <- cedergreen.ssf( + method = "method3", + fixed = c(NA, NA, NA, NA, NA), + alpha = 1 + ) + + result <- ssf(test_data) + + expect_named(result, c("b", "c", "d", "e", "f")) + expect_true(all(is.finite(result))) +}) + +test_that("cedergreen.ssf method='normolle' works", { + ssf <- cedergreen.ssf( + method = "normolle", + fixed = c(NA, NA, NA, NA, NA), + alpha = 1 + ) + + result <- ssf(test_data) + + expect_named(result, c("b", "c", "d", "e", "f")) + # Note: normolle method can produce Inf for f when e is very small + # This is expected behavior when exp(1/(e^alpha)) overflows + expect_type(result, "double") + expect_length(result, 5) +}) + +test_that("cedergreen.ssf method argument validation works", { + expect_error( + cedergreen.ssf( + method = "invalid_method", + fixed = c(NA, NA, NA, NA, NA), + alpha = 1 + ), + "'arg' should be one of" + ) +}) + +# ============================================================================== +# Fixed Parameter Tests - Test all combinations of fixed parameters +# ============================================================================== + +test_that("cedergreen.ssf with all parameters fixed returns empty vector", { + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(2, 0, 100, 3, 10), + alpha = 1 + ) + + result <- ssf(test_data) + + expect_length(result, 0) + expect_named(result, character(0)) +}) + +test_that("cedergreen.ssf with only b fixed", { + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(2, NA, NA, NA, NA), + alpha = 1, + useFixed = FALSE + ) + + result <- ssf(test_data) + + expect_named(result, c("c", "d", "e", "f")) + expect_length(result, 4) +}) + +test_that("cedergreen.ssf with only c fixed", { + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(NA, 0.5, NA, NA, NA), + alpha = 1, + useFixed = FALSE + ) + + result <- ssf(test_data) + + expect_named(result, c("b", "d", "e", "f")) + expect_length(result, 4) +}) + +test_that("cedergreen.ssf with only d fixed", { + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(NA, NA, 10, NA, NA), + alpha = 1, + useFixed = FALSE + ) + + result <- ssf(test_data) + + expect_named(result, c("b", "c", "e", "f")) + expect_length(result, 4) +}) + +test_that("cedergreen.ssf with only e fixed", { + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(NA, NA, NA, 3, NA), + alpha = 1, + useFixed = FALSE + ) + + result <- ssf(test_data) + + expect_named(result, c("b", "c", "d", "f")) + expect_length(result, 4) +}) + +test_that("cedergreen.ssf with only f fixed", { + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(NA, NA, NA, NA, 5), + alpha = 1, + useFixed = FALSE + ) + + result <- ssf(test_data) + + expect_named(result, c("b", "c", "d", "e")) + expect_length(result, 4) +}) + +test_that("cedergreen.ssf with b and e fixed", { + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(2, NA, NA, 3, NA), + alpha = 1, + useFixed = FALSE + ) + + result <- ssf(test_data) + + expect_named(result, c("c", "d", "f")) + expect_length(result, 3) +}) + +test_that("cedergreen.ssf with c and d fixed", { + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(NA, 0, NA, NA, NA), + alpha = 1, + useFixed = FALSE + ) + + result <- ssf(test_data) + + expect_named(result, c("b", "d", "e", "f")) + expect_length(result, 4) +}) + +# ============================================================================== +# useFixed Parameter Tests +# ============================================================================== + +test_that("cedergreen.ssf with useFixed=TRUE uses fixed c value (line 73)", { + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(NA, 0.5, NA, NA, NA), + alpha = 1, + useFixed = TRUE + ) + + result <- ssf(test_data) + + # c is fixed, so not in result + expect_named(result, c("b", "d", "e", "f")) + expect_length(result, 4) +}) + +test_that("cedergreen.ssf with useFixed=TRUE uses fixed d value (line 74)", { + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(NA, NA, 8.5, NA, NA), + alpha = 1, + useFixed = TRUE + ) + + result <- ssf(test_data) + + # d is fixed, so not in result + expect_named(result, c("b", "c", "e", "f")) + expect_length(result, 4) +}) + +test_that("cedergreen.ssf with useFixed=TRUE and both c and d fixed (line 67-69)", { + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(NA, 0.2, 8.4, NA, NA), + alpha = 1, + useFixed = TRUE + ) + + result <- ssf(test_data) + + # c and d are fixed, so not in result + expect_named(result, c("b", "e", "f")) + expect_length(result, 3) +}) + +test_that("cedergreen.ssf with useFixed=TRUE uses fixed b value (line 92)", { + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(2.5, NA, NA, NA, NA), + alpha = 1, + useFixed = TRUE + ) + + result <- ssf(test_data) + + # b is fixed, so not in result + expect_named(result, c("c", "d", "e", "f")) + expect_length(result, 4) +}) + +test_that("cedergreen.ssf with useFixed=TRUE uses fixed e value (line 93)", { + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(NA, NA, NA, 3.5, NA), + alpha = 1, + useFixed = TRUE + ) + + result <- ssf(test_data) + + # e is fixed, so not in result + expect_named(result, c("b", "c", "d", "f")) + expect_length(result, 4) +}) + +test_that("cedergreen.ssf with useFixed=TRUE and both b and e fixed (line 87-89)", { + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(2.4, NA, NA, 3.5, NA), + alpha = 1, + useFixed = TRUE + ) + + result <- ssf(test_data) + + # b and e are fixed, so not in result + expect_named(result, c("c", "d", "f")) + expect_length(result, 3) +}) + +test_that("cedergreen.ssf with useFixed=TRUE uses fixed f value (line 97-98)", { + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(NA, NA, NA, NA, 2.1), + alpha = 1, + useFixed = TRUE + ) + + result <- ssf(test_data) + + # f is fixed, so not in result + expect_named(result, c("b", "c", "d", "e")) + expect_length(result, 4) +}) + +# ============================================================================== +# Alpha Parameter Tests +# ============================================================================== + +test_that("cedergreen.ssf with different alpha values", { + ssf_alpha_0.5 <- cedergreen.ssf( + method = "loglinear", + fixed = c(NA, NA, NA, NA, NA), + alpha = 0.5 + ) + + ssf_alpha_1 <- cedergreen.ssf( + method = "loglinear", + fixed = c(NA, NA, NA, NA, NA), + alpha = 1 + ) + + ssf_alpha_2 <- cedergreen.ssf( + method = "loglinear", + fixed = c(NA, NA, NA, NA, NA), + alpha = 2 + ) + + result_0.5 <- ssf_alpha_0.5(test_data) + result_1 <- ssf_alpha_1(test_data) + result_2 <- ssf_alpha_2(test_data) + + # Different alpha should give different f values (line 102) + expect_false(isTRUE(all.equal(result_0.5["f"], result_1["f"]))) + expect_false(isTRUE(all.equal(result_1["f"], result_2["f"]))) +}) + +# ============================================================================== +# Robustness Check - Warning for response outside (c, d) range +# ============================================================================== + +test_that("cedergreen.ssf warns when response outside (c, d) range (line 79-84)", { + # Create data where responses are outside the initial (c, d) range + # when c and d are fixed to values that don't encompass all data + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(NA, 2, 8, NA, NA), # Fix c=2 and d=8 + alpha = 1, + useFixed = TRUE + ) + + # Use test_data which has responses from ~0.2 to ~8.4 + # With c=2 and d=8, some responses will be outside this range + expect_warning( + result <- ssf(test_data), + "Response values detected outside the initial" + ) + + # Should still return valid result + expect_type(result, "double") + expect_true(length(result) > 0) +}) + +test_that("cedergreen.ssf adjusts c_init when response <= c_init (line 82)", { + # Fix c to a value that is higher than minimum response + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(NA, 5, NA, NA, NA), # Fix c=5, which is > than some responses in test_data + alpha = 1, + useFixed = TRUE + ) + + expect_warning( + result <- ssf(test_data), + "Response values detected outside" + ) + + expect_true(all(is.finite(result))) +}) + +test_that("cedergreen.ssf adjusts d_init when response >= d_init (line 83)", { + # Fix d to a value that is lower than maximum response + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(NA, NA, 5, NA, NA), # Fix d=5, which is < than some responses in test_data + alpha = 1, + useFixed = TRUE + ) + + expect_warning( + result <- ssf(test_data), + "Response values detected outside" + ) + + expect_true(all(is.finite(result))) +}) + +# ============================================================================== +# Helper Function Coverage Tests +# ============================================================================== + +test_that("cedergreen.ssf y_transform function is used", { + # The y_transform function is used in findbe1 for loglinear method + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(NA, NA, NA, NA, NA), + alpha = 1 + ) + + result <- ssf(test_data) + + # Should compute successfully using y_transform + expect_true(all(is.finite(result))) +}) + +test_that("cedergreen.ssf b_function is used in anke method", { + ssf <- cedergreen.ssf( + method = "anke", + fixed = c(NA, NA, NA, NA, NA), + alpha = 1 + ) + + result <- ssf(test_data) + + # Should compute successfully using b_function + expect_true(all(is.finite(result))) +}) + +test_that("cedergreen.ssf e_function is used in normolle method", { + ssf <- cedergreen.ssf( + method = "normolle", + fixed = c(NA, NA, NA, NA, NA), + alpha = 1 + ) + + result <- ssf(test_data) + + # Should compute successfully using e_function (may have Inf in f) + expect_type(result, "double") + expect_length(result, 5) +}) + +# ============================================================================== +# Integration Tests - Test with actual drm fitting +# ============================================================================== + +test_that("cedergreen.ssf works with drm function", { + # Create model with custom self-starter + custom_ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(NA, NA, NA, NA, NA), + alpha = 1 + ) + + model <- cedergreen( + ssfct = custom_ssf, + alpha = 1, + fixed = c(NA, NA, NA, NA, NA) + ) + + # Fit model + fit <- drm(rootl ~ conc, data = ryegrass, fct = model) + + expect_s3_class(fit, "drc") + expect_true(length(coef(fit)) > 0) +}) + +test_that("cedergreen.ssf with different methods in drm", { + # Skip normolle as it can produce Inf values that cause convergence issues + methods_to_test <- c("loglinear", "anke", "method3") + + for (method in methods_to_test) { + custom_ssf <- cedergreen.ssf( + method = method, + fixed = c(NA, NA, NA, NA, NA), + alpha = 1 + ) + + model <- cedergreen( + ssfct = custom_ssf, + alpha = 1, + fixed = c(NA, NA, NA, NA, NA) + ) + + fit <- drm(rootl ~ conc, data = ryegrass, fct = model) + + expect_s3_class(fit, "drc") + } +}) + +# ============================================================================== +# Edge Cases and Boundary Conditions +# ============================================================================== + +test_that("cedergreen.ssf with minimal data", { + minimal_data <- data.frame( + dose = c(0.1, 1, 10), + response = c(1, 5, 9) + ) + + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(NA, NA, NA, NA, NA), + alpha = 1 + ) + + result <- ssf(minimal_data) + + expect_type(result, "double") + expect_length(result, 5) +}) + +test_that("cedergreen.ssf with single dose level but multiple replicates", { + replicate_data <- data.frame( + dose = rep(c(0.1, 1, 10), each = 3), + response = c(rep(2, 3), rep(5, 3), rep(8, 3)) + ) + + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(NA, NA, NA, NA, NA), + alpha = 1 + ) + + result <- ssf(replicate_data) + + expect_type(result, "double") + expect_length(result, 5) +}) + +test_that("cedergreen.ssf with zero dose values", { + zero_dose_data <- data.frame( + dose = c(0, 0.1, 1, 10), + response = c(8, 7, 5, 2) + ) + + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(NA, NA, NA, NA, NA), + alpha = 1 + ) + + # Should handle zero doses (log will produce NA but should be handled) + result <- ssf(zero_dose_data) + + expect_type(result, "double") + expect_length(result, 5) +}) + +test_that("cedergreen.ssf with large dose range", { + large_range_data <- data.frame( + dose = c(0.001, 0.01, 0.1, 1, 10, 100, 1000), + response = c(10, 9, 8, 6, 4, 2, 1) + ) + + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(NA, NA, NA, NA, NA), + alpha = 1 + ) + + result <- ssf(large_range_data) + + expect_type(result, "double") + expect_length(result, 5) + expect_true(all(is.finite(result))) +}) + +# ============================================================================== +# Test f parameter calculation (line 102) +# ============================================================================== + +test_that("cedergreen.ssf f parameter calculation uses median and exp", { + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(NA, NA, NA, NA, NA), + alpha = 1 + ) + + result <- ssf(test_data) + + # f should be calculated using the formula on line 102 + # f_init <- (2 * (median(response) - c_init) - (d_init - c_init)) * exp(1 / (e_init^alpha)) + expect_true(is.finite(result["f"])) + expect_type(result["f"], "double") +}) + +test_that("cedergreen.ssf f parameter with useFixed and f not fixed (line 100-103)", { + # Test the else branch for f calculation + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(NA, NA, NA, NA, NA), # f is NA, so will be calculated + alpha = 1, + useFixed = TRUE # useFixed is TRUE but f is NA + ) + + result <- ssf(test_data) + + # Should calculate f using line 102 + expect_true("f" %in% names(result)) + expect_true(is.finite(result["f"])) +}) + +# ============================================================================== +# Test all combinations for complete coverage +# ============================================================================== + +test_that("cedergreen.ssf with c, d, e, f fixed and only b estimated", { + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(NA, 0.2, 8.4, 3.5, 2.1), + alpha = 1, + useFixed = TRUE + ) + + result <- ssf(test_data) + + expect_named(result, "b") + expect_length(result, 1) +}) + +test_that("cedergreen.ssf with b, d, e, f fixed and only c estimated", { + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(2.4, NA, 8.4, 3.5, 2.1), + alpha = 1, + useFixed = TRUE + ) + + result <- ssf(test_data) + + expect_named(result, "c") + expect_length(result, 1) +}) + +test_that("cedergreen.ssf with b, c, e, f fixed and only d estimated", { + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(2.4, 0.2, NA, 3.5, 2.1), + alpha = 1, + useFixed = TRUE + ) + + result <- ssf(test_data) + + expect_named(result, "d") + expect_length(result, 1) +}) + +test_that("cedergreen.ssf with b, c, d, f fixed and only e estimated", { + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(2.4, 0.2, 8.4, NA, 2.1), + alpha = 1, + useFixed = TRUE + ) + + result <- ssf(test_data) + + expect_named(result, "e") + expect_length(result, 1) +}) + +test_that("cedergreen.ssf with b, c, d, e fixed and only f estimated", { + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(2.4, 0.2, 8.4, 3.5, NA), + alpha = 1, + useFixed = TRUE + ) + + result <- ssf(test_data) + + expect_named(result, "f") + expect_length(result, 1) +}) + +# ============================================================================== +# Test data frame structure assumptions +# ============================================================================== + +test_that("cedergreen.ssf correctly extracts dose and response from data frame", { + # Test that it uses column 1 for dose and column 2 for response (lines 60-61) + custom_names_data <- data.frame( + my_dose = ryegrass$conc, + my_response = ryegrass$rootl + ) + + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(NA, NA, NA, NA, NA), + alpha = 1 + ) + + result <- ssf(custom_names_data) + + expect_type(result, "double") + expect_length(result, 5) +}) + +test_that("cedergreen.ssf with data frame having more than 2 columns", { + multi_col_data <- data.frame( + dose = ryegrass$conc, + response = ryegrass$rootl, + extra_col = 1:nrow(ryegrass) + ) + + ssf <- cedergreen.ssf( + method = "loglinear", + fixed = c(NA, NA, NA, NA, NA), + alpha = 1 + ) + + # Should only use first 2 columns + result <- ssf(multi_col_data) + + expect_type(result, "double") + expect_length(result, 5) +}) diff --git a/tests/testthat/test-cedergreen.R b/tests/testthat/test-cedergreen.R new file mode 100644 index 00000000..36aea3c9 --- /dev/null +++ b/tests/testthat/test-cedergreen.R @@ -0,0 +1,576 @@ +# Test suite for cedergreen function +# Target: 100% code coverage + +# Test data setup +test_dose <- c(0.1, 0.5, 1, 2, 5, 10, 20) +test_response <- c(102, 105, 95, 80, 40, 25, 20) +test_data <- data.frame(dose = test_dose, response = test_response) + +# ============================================================================== +# Tests for cedergreen() main function +# ============================================================================== + +test_that("cedergreen returns correct structure with default arguments", { + result <- cedergreen(alpha = 0.5) + + expect_true(is.list(result)) + expect_s3_class(result, "mllogistic") + expect_true("fct" %in% names(result)) + expect_true("ssfct" %in% names(result)) + expect_true("names" %in% names(result)) + expect_true("deriv1" %in% names(result)) + expect_true("edfct" %in% names(result)) + expect_true("maxfct" %in% names(result)) + expect_equal(result$noParm, 5) +}) + +test_that("cedergreen works with different alpha values", { + result1 <- cedergreen(alpha = 1) + result2 <- cedergreen(alpha = 0.5) + result3 <- cedergreen(alpha = 0.25) + + expect_s3_class(result1, "mllogistic") + expect_s3_class(result2, "mllogistic") + expect_s3_class(result3, "mllogistic") +}) + +test_that("cedergreen works with fixed parameters", { + # Fix c parameter to 0 + result <- cedergreen(fixed = c(NA, 0, NA, NA, NA), alpha = 1) + + expect_equal(result$noParm, 4) # Only 4 parameters to estimate + expect_equal(length(result$names), 4) + expect_false("c" %in% result$names) +}) + +test_that("cedergreen works with multiple fixed parameters", { + # Fix b and c + result <- cedergreen(fixed = c(2, 0, NA, NA, NA), alpha = 1) + + expect_equal(result$noParm, 3) # Only 3 parameters to estimate + expect_false("b" %in% result$names) + expect_false("c" %in% result$names) +}) + +test_that("cedergreen works with all different methods", { + result1 <- cedergreen(method = "loglinear", alpha = 1) + result2 <- cedergreen(method = "anke", alpha = 1) + result3 <- cedergreen(method = "method3", alpha = 1) + result4 <- cedergreen(method = "normolle", alpha = 1) + + expect_s3_class(result1, "mllogistic") + expect_s3_class(result2, "mllogistic") + expect_s3_class(result3, "mllogistic") + expect_s3_class(result4, "mllogistic") +}) + +test_that("cedergreen works with custom parameter names", { + custom_names <- c("slope", "lower", "upper", "ed50", "hormesis") + result <- cedergreen(names = custom_names, alpha = 1) + + expect_equal(result$names, custom_names) +}) + +test_that("cedergreen works with custom fctName and fctText", { + result <- cedergreen(alpha = 1, fctName = "MyModel", fctText = "My custom model") + + expect_equal(result$name, "MyModel") + expect_equal(result$text, "My custom model") +}) + +test_that("cedergreen sets default fctName and fctText when missing", { + result <- cedergreen(alpha = 1) + + expect_equal(result$name, "cedergreen") + expect_equal(result$text, "Cedergreen-Ritz-Streibig") +}) + +test_that("cedergreen works with custom ssfct", { + custom_ssfct <- function(dframe) { + return(c(1, 0, 100, 1, 10)) + } + + result <- cedergreen(ssfct = custom_ssfct, alpha = 1) + + expect_identical(result$ssfct, custom_ssfct) +}) + +test_that("cedergreen fct function can be called", { + result <- cedergreen(alpha = 1) + + # Test the fct function with sample data + dose_vec <- c(0.1, 1, 10) + parm_mat <- matrix(c(2, 0, 100, 1, 10), nrow = 1) + + response <- result$fct(dose_vec, parm_mat) + + expect_true(is.numeric(response)) + expect_equal(length(response), length(dose_vec)) + expect_true(all(is.finite(response))) +}) + +test_that("cedergreen fct function handles multiple parameter sets", { + result <- cedergreen(alpha = 1) + + dose_vec <- c(1, 10) + parm_mat <- matrix(c(2, 0, 100, 1, 10, + 3, 5, 95, 2, 15), nrow = 2, byrow = TRUE) + + response <- result$fct(dose_vec, parm_mat) + + expect_equal(length(response), length(dose_vec)) +}) + +test_that("cedergreen deriv1 function can be called", { + result <- cedergreen(alpha = 1) + + dose_vec <- c(0.1, 1, 10) + parm_mat <- matrix(c(2, 0, 100, 1, 10), nrow = 1) + + derivs <- result$deriv1(dose_vec, parm_mat) + + expect_true(is.matrix(derivs) || is.numeric(derivs)) +}) + +test_that("cedergreen edfct function can be called", { + result <- cedergreen(alpha = 1) + + parm_vec <- c(2, 0, 100, 1, 10) + + ed_result <- result$edfct(parm_vec, respl = 50, reference = "control", type = "relative") + + expect_true(is.list(ed_result)) + expect_equal(length(ed_result), 2) +}) + +test_that("cedergreen maxfct function can be called", { + result <- cedergreen(alpha = 1) + + parm_vec <- c(2, 0, 100, 1, 10) + + max_result <- result$maxfct(parm_vec) + + expect_true(is.numeric(max_result)) + expect_equal(length(max_result), 2) + expect_true(all(names(max_result) %in% c("maxDose", "maxResponse"))) +}) + +# ============================================================================== +# Error Handling Tests +# ============================================================================== + +test_that("cedergreen errors when names is not character", { + expect_error( + cedergreen(names = c(1, 2, 3, 4, 5), alpha = 1), + "Not correct 'names' argument" + ) +}) + +test_that("cedergreen errors when names has wrong length", { + expect_error( + cedergreen(names = c("b", "c", "d"), alpha = 1), + "Not correct 'names' argument" + ) +}) + +test_that("cedergreen errors when fixed has wrong length", { + expect_error( + cedergreen(fixed = c(NA, NA, NA), alpha = 1), + "Not correct 'fixed' argument" + ) +}) + +test_that("cedergreen errors when alpha is missing", { + expect_error( + cedergreen(), + "'alpha' argument must be specified" + ) +}) + +# ============================================================================== +# Tests for cedergreen_edfct helper function +# ============================================================================== + +test_that("cedergreen_edfct returns NA when root finding fails", { + # Create a scenario where root finding should fail + result <- cedergreen(alpha = 1) + + # Use parameters that might cause issues + parm_vec <- c(0.1, 50, 51, 1, 0.01) # Very small range + + # This might trigger a warning and return NA + ed_result <- result$edfct(parm_vec, respl = 99, reference = "control", type = "relative") + + # The result could be NA or a valid number depending on convergence + expect_true(is.list(ed_result)) +}) + +test_that("cedergreen_edfct handles different response levels", { + result <- cedergreen(alpha = 1) + parm_vec <- c(2, 0, 100, 1, 10) + + ed10 <- result$edfct(parm_vec, respl = 10, reference = "control", type = "relative") + ed50 <- result$edfct(parm_vec, respl = 50, reference = "control", type = "relative") + ed90 <- result$edfct(parm_vec, respl = 90, reference = "control", type = "relative") + + expect_true(is.list(ed10)) + expect_true(is.list(ed50)) + expect_true(is.list(ed90)) +}) + +test_that("cedergreen_edfct handles absolute reference type", { + result <- cedergreen(alpha = 1) + parm_vec <- c(2, 0, 100, 1, 10) + + ed_abs <- result$edfct(parm_vec, respl = 50, reference = "control", type = "absolute") + + expect_true(is.list(ed_abs)) +}) + +# ============================================================================== +# Tests for cedergreen_maxfct helper function +# ============================================================================== + +test_that("cedergreen_maxfct finds maximum hormesis", { + result <- cedergreen(alpha = 1) + parm_vec <- c(2, 0, 100, 1, 50) # Significant hormesis parameter + + max_result <- result$maxfct(parm_vec) + + expect_true(is.numeric(max_result)) + expect_equal(length(max_result), 2) + expect_false(is.na(max_result[1])) + expect_false(is.na(max_result[2])) +}) + +test_that("cedergreen_maxfct handles custom bounds", { + result <- cedergreen(alpha = 1) + parm_vec <- c(2, 0, 100, 1, 10) + + max_result <- result$maxfct(parm_vec, lower = 0.001, upper = 100) + + expect_true(is.numeric(max_result)) + expect_equal(length(max_result), 2) +}) + +test_that("cedergreen_maxfct handles edge case parameters", { + result <- cedergreen(alpha = 1) + + # Test with different parameter combinations + parm_vec1 <- c(2, 0, 100, 1, 0) # Zero hormesis + max_result1 <- result$maxfct(parm_vec1) + expect_true(is.numeric(max_result1)) + + # Test with negative hormesis (shouldn't have maximum above baseline) + parm_vec2 <- c(2, 0, 100, 1, -10) + max_result2 <- result$maxfct(parm_vec2) + expect_true(is.numeric(max_result2)) + + # Test with parameters that might cause numerical issues in optimize + # Using very extreme values + parm_vec3 <- c(1e10, 1e10, 1e10, 1e-20, 1e10) + suppressWarnings({ + max_result3 <- result$maxfct(parm_vec3, lower=1e-30, upper=1e-25) + }) + expect_true(is.numeric(max_result3)) + expect_equal(length(max_result3), 2) + + # Test with parameters where c > d (inverted bounds) + parm_vec4 <- c(2, 100, 0, 1, 10) # c > d + suppressWarnings({ + max_result4 <- result$maxfct(parm_vec4) + }) + expect_true(is.numeric(max_result4)) +}) + +test_that("cedergreen_maxfct error handling when optimize fails", { + result <- cedergreen(alpha = 1) + + # Create a mock optimize that fails + mock_optimize <- function(...) { + stop("Forced error for testing") + } + + # Test error handling using the injectable parameter + expect_warning( + max_result <- result$maxfct(c(2, 0, 100, 1, 10), .optimize_fn = mock_optimize), + "Optimization failed" + ) + + # Should return NA when optimization fails + expect_true(is.na(max_result[1])) + expect_true(is.na(max_result[2])) +}) + +# ============================================================================== +# Tests for CRS.5 wrapper function +# ============================================================================== + +test_that("CRS.5 works with default arguments", { + result <- CRS.5() + + expect_s3_class(result, "mllogistic") + expect_equal(result$noParm, 5) +}) + +test_that("CRS.5 works with alpha_type 'a'", { + result <- CRS.5(alpha_type = "a") + + expect_s3_class(result, "mllogistic") + expect_true(grepl("alpha=1", result$text, fixed = TRUE)) +}) + +test_that("CRS.5 works with alpha_type 'b'", { + result <- CRS.5(alpha_type = "b") + + expect_s3_class(result, "mllogistic") + expect_true(grepl("alpha=0.5", result$text, fixed = TRUE)) +}) + +test_that("CRS.5 works with alpha_type 'c'", { + result <- CRS.5(alpha_type = "c") + + expect_s3_class(result, "mllogistic") + expect_true(grepl("alpha=0.25", result$text, fixed = TRUE)) +}) + +test_that("CRS.5 works with numeric alpha_type", { + result <- CRS.5(alpha_type = 0.75) + + expect_s3_class(result, "mllogistic") + expect_true(grepl("alpha=0.75", result$text, fixed = TRUE)) +}) + +test_that("CRS.5 works with fixed parameters", { + result <- CRS.5(fixed = c(NA, 0, NA, NA, NA)) + + expect_equal(result$noParm, 4) +}) + +test_that("CRS.5 works with custom names", { + custom_names <- c("slope", "lower", "upper", "ed50", "hormesis") + result <- CRS.5(names = custom_names) + + expect_equal(result$names, custom_names) +}) + +test_that("CRS.5 generates automatic fctName when not provided", { + result <- CRS.5(alpha_type = "a") + + expect_equal(result$name, "CRS.5a") +}) + +test_that("CRS.5 uses custom fctName when provided", { + result <- CRS.5(fctName = "MyCustomModel") + + expect_equal(result$name, "MyCustomModel") +}) + +test_that("CRS.5 generates automatic fctText when not provided", { + result <- CRS.5(alpha_type = "a") + + expect_true(grepl("Cedergreen-Ritz-Streibig", result$text)) +}) + +test_that("CRS.5 uses custom fctText when provided", { + result <- CRS.5(fctText = "My custom text") + + expect_equal(result$text, "My custom text") +}) + +test_that("CRS.5 errors with invalid alpha_type character", { + expect_error( + CRS.5(alpha_type = "invalid"), + "Invalid 'alpha_type'" + ) +}) + +test_that("CRS.5 errors with invalid names argument", { + expect_error( + CRS.5(names = c("a", "b", "c")), + "Not correct 'names' argument" + ) +}) + +test_that("CRS.5 errors with non-character names", { + expect_error( + CRS.5(names = c(1, 2, 3, 4, 5)), + "Not correct 'names' argument" + ) +}) + +test_that("CRS.5 handles various parameter combinations", { + # Test that CRS.5 can handle various combinations without crashing + result1 <- CRS.5(alpha_type = "a") + expect_s3_class(result1, "mllogistic") + + result2 <- CRS.5(alpha_type = 0.3, fixed = c(NA, 0, NA, NA, NA)) + expect_s3_class(result2, "mllogistic") + + result3 <- CRS.5(alpha_type = 2.5) + expect_s3_class(result3, "mllogistic") +}) + +test_that("CRS.5 handles errors from cedergreen when invalid fixed length passed", { + # CRS.5's tryCatch should catch errors from cedergreen + # Pass invalid fixed argument (wrong length) which will cause cedergreen to stop() + expect_warning( + result <- CRS.5(fixed = c(NA, NA, NA), alpha_type = "a"), + "cedergreen\\(\\) model call failed" + ) + + expect_null(result) +}) + +# ============================================================================== +# Tests for deprecated functions +# ============================================================================== + +test_that("CRS.4a triggers deprecation warning", { + expect_warning( + CRS.4a(), + "deprecated" + ) +}) + +test_that("CRS.4a returns correct structure", { + suppressWarnings({ + result <- CRS.4a() + }) + + expect_s3_class(result, "mllogistic") + expect_equal(result$noParm, 4) # c is fixed, so 4 parameters +}) + +test_that("ml3a is an alias for CRS.4a", { + expect_identical(ml3a, CRS.4a) +}) + +test_that("CRS.4b triggers deprecation warning", { + expect_warning( + CRS.4b(), + "deprecated" + ) +}) + +test_that("CRS.4b returns correct structure", { + suppressWarnings({ + result <- CRS.4b() + }) + + expect_s3_class(result, "mllogistic") + expect_equal(result$noParm, 4) +}) + +test_that("ml3b is an alias for CRS.4b", { + expect_identical(ml3b, CRS.4b) +}) + +test_that("CRS.4c triggers deprecation warning", { + expect_warning( + CRS.4c(), + "deprecated" + ) +}) + +test_that("CRS.4c returns correct structure", { + suppressWarnings({ + result <- CRS.4c() + }) + + expect_s3_class(result, "mllogistic") + expect_equal(result$noParm, 4) +}) + +test_that("ml3c is an alias for CRS.4c", { + expect_identical(ml3c, CRS.4c) +}) + +test_that("CRS.5a triggers deprecation warning", { + expect_warning( + CRS.5a(), + "deprecated" + ) +}) + +test_that("CRS.5a returns correct structure", { + suppressWarnings({ + result <- CRS.5a() + }) + + expect_s3_class(result, "mllogistic") + expect_equal(result$noParm, 5) +}) + +test_that("ml4a is an alias for CRS.5a", { + expect_identical(ml4a, CRS.5a) +}) + +test_that("CRS.5b triggers deprecation warning", { + expect_warning( + CRS.5b(), + "deprecated" + ) +}) + +test_that("CRS.5b returns correct structure", { + suppressWarnings({ + result <- CRS.5b() + }) + + expect_s3_class(result, "mllogistic") + expect_equal(result$noParm, 5) +}) + +test_that("ml4b is an alias for CRS.5b", { + expect_identical(ml4b, CRS.5b) +}) + +test_that("CRS.5c triggers deprecation warning", { + expect_warning( + CRS.5c(), + "deprecated" + ) +}) + +test_that("CRS.5c returns correct structure", { + suppressWarnings({ + result <- CRS.5c() + }) + + expect_s3_class(result, "mllogistic") + expect_equal(result$noParm, 5) +}) + +test_that("ml4c is an alias for CRS.5c", { + expect_identical(ml4c, CRS.5c) +}) + +# ============================================================================== +# Integration Tests - Using cedergreen with drm +# ============================================================================== + +test_that("cedergreen can be used with drm function", { + skip_if_not_installed("drc") + + # Simple test data with hormesis + dose <- c(0.1, 0.5, 1, 2, 5, 10, 20) + response <- c(100, 105, 95, 80, 40, 25, 20) + test_data <- data.frame(dose = dose, response = response) + + expect_no_error({ + model <- drm(response ~ dose, data = test_data, fct = cedergreen(alpha = 1)) + }) +}) + +test_that("CRS.5 can be used with drm function", { + skip_if_not_installed("drc") + + dose <- c(0.1, 0.5, 1, 2, 5, 10, 20) + response <- c(100, 105, 95, 80, 40, 25, 20) + test_data <- data.frame(dose = dose, response = response) + + expect_no_error({ + model <- drm(response ~ dose, data = test_data, fct = CRS.5(alpha_type = "a")) + }) +}) diff --git a/tests/testthat/test-coef-vcov-confint.R b/tests/testthat/test-coef-vcov-confint.R new file mode 100644 index 00000000..86686ff3 --- /dev/null +++ b/tests/testthat/test-coef-vcov-confint.R @@ -0,0 +1,392 @@ +# Test coef.drc(), vcov.drc(), and confint.drc() functions + +# Create test datasets +ryegrass <- data.frame( + rootl = c( + 7.58, 8.00, 8.33, 7.25, 7.17, 7.00, 7.17, 7.83, 7.92, 7.58, + 6.17, 5.75, 5.83, 6.00, 5.83, 4.92, 4.50, 4.17, 4.42, 4.00, + 2.67, 2.08, 2.42, 2.50, 2.25, 1.17, 0.75, 0.92, 1.00, 0.58 + ), + conc = c( + rep(0, 5), rep(0.94, 5), rep(1.88, 5), + rep(3.75, 5), rep(7.50, 5), rep(15, 5) + ) +) + +set.seed(42) +multi_data <- data.frame( + dose = rep(c(0, 0.5, 1, 2, 5, 10), each = 5, times = 2), + resp = c( + rnorm(5, 100, 5), rnorm(5, 95, 5), rnorm(5, 85, 5), + rnorm(5, 60, 5), rnorm(5, 20, 5), rnorm(5, 5, 5), + rnorm(5, 100, 5), rnorm(5, 90, 5), rnorm(5, 70, 5), + rnorm(5, 40, 5), rnorm(5, 10, 5), rnorm(5, 3, 5) + ), + group = rep(c("A", "B"), each = 30) +) + +# Tests for coef.drc() + +test_that("coef.drc returns coefficient vector", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + coeffs <- coef(m1) + + expect_true(is.numeric(coeffs)) + expect_true(length(coeffs) > 0) + expect_true(!is.null(names(coeffs))) +}) + +test_that("coef.drc returns correct number of coefficients for LL.4", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + coeffs <- coef(m1) + + expect_equal(length(coeffs), 4) +}) + +test_that("coef.drc returns correct number of coefficients for LL.3", { + m_ll3 <- drm(rootl ~ conc, data = ryegrass, fct = LL.3()) + coeffs <- coef(m_ll3) + + expect_equal(length(coeffs), 3) +}) + +test_that("coef.drc coefficients have proper names", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + coeffs <- coef(m1) + + # LL.4 parameters: b (slope), c (lower), d (upper), e (ED50) + expect_true(all(grepl(":", names(coeffs)))) # Parameters should have colon separator +}) + +test_that("coef.drc works with multi-curve models", { + m_multi <- drm(resp ~ dose, curveid = group, data = multi_data, fct = LL.4()) + coeffs <- coef(m_multi) + + # Should have 4 parameters × 2 curves = 8 coefficients + expect_equal(length(coeffs), 8) +}) + +test_that("coef.drc handles NULL coefficients gracefully", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Simulate NULL coefficients + m1_copy <- m1 + m1_copy$coefficients <- NULL + + # Should fall back to fit$par + coeffs <- coef(m1_copy) + expect_true(is.numeric(coeffs)) + expect_true(length(coeffs) > 0) +}) + +# Tests for vcov.drc() + +test_that("vcov.drc returns variance-covariance matrix", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + vcov_mat <- vcov(m1) + + expect_true(is.matrix(vcov_mat)) + expect_equal(nrow(vcov_mat), length(coef(m1))) + expect_equal(ncol(vcov_mat), length(coef(m1))) +}) + +test_that("vcov.drc matrix is symmetric", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + vcov_mat <- vcov(m1) + + expect_equal(vcov_mat, t(vcov_mat)) +}) + +test_that("vcov.drc diagonal elements are positive", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + vcov_mat <- vcov(m1) + + diag_elements <- diag(vcov_mat) + expect_true(all(diag_elements > 0)) +}) + +test_that("vcov.drc returns correlation matrix when corr = TRUE", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + corr_mat <- vcov(m1, corr = TRUE) + + expect_true(is.matrix(corr_mat)) + + # Diagonal elements should be 1 for correlation matrix + expect_true(all(abs(diag(corr_mat) - 1) < 1e-10)) + + # Off-diagonal elements should be between -1 and 1 + expect_true(all(corr_mat >= -1 & corr_mat <= 1)) +}) + +test_that("vcov.drc with od = TRUE for binomial data", { + binom_data <- data.frame( + dose = c(0, 0.1, 0.5, 1, 2, 5, 10), + resp = c(0, 0.05, 0.15, 0.35, 0.65, 0.90, 0.98), + n = rep(50, 7) + ) + m_binom <- drm(resp ~ dose, data = binom_data, fct = LL.2(), type = "binomial", weights = n) + + vcov_no_od <- vcov(m_binom, od = FALSE) + vcov_with_od <- vcov(m_binom, od = TRUE) + + expect_true(is.matrix(vcov_no_od)) + expect_true(is.matrix(vcov_with_od)) + + # Dimensions should be the same + expect_equal(dim(vcov_no_od), dim(vcov_with_od)) + + # Values might differ with OD adjustment + expect_equal(nrow(vcov_no_od), length(coef(m_binom))) +}) + +test_that("vcov.drc with pool = FALSE for multi-curve models", { + m_multi <- drm(resp ~ dose, curveid = group, data = multi_data, fct = LL.4()) + + vcov_pooled <- vcov(m_multi, pool = TRUE) + vcov_unpooled <- vcov(m_multi, pool = FALSE) + + expect_true(is.matrix(vcov_pooled)) + expect_true(is.matrix(vcov_unpooled)) + + # Both should have same dimensions + expect_equal(dim(vcov_pooled), dim(vcov_unpooled)) +}) + +test_that("vcov.drc with unscaled = TRUE for continuous data", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + vcov_scaled <- vcov(m1, unscaled = FALSE) + vcov_unscaled <- vcov(m1, unscaled = TRUE) + + expect_true(is.matrix(vcov_scaled)) + expect_true(is.matrix(vcov_unscaled)) + expect_equal(dim(vcov_scaled), dim(vcov_unscaled)) +}) + +test_that("vcov.drc works for different model types", { + m_ll3 <- drm(rootl ~ conc, data = ryegrass, fct = LL.3()) + m_ll4 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + vcov_ll3 <- vcov(m_ll3) + vcov_ll4 <- vcov(m_ll4) + + expect_equal(nrow(vcov_ll3), 3) + expect_equal(nrow(vcov_ll4), 4) +}) + +test_that("vcov.drc works with Poisson type data", { + poisson_data <- data.frame( + dose = c(0, 1, 2, 4, 8, 16, 32), + count = c(50, 48, 40, 25, 10, 3, 1) + ) + m_poisson <- drm(count ~ dose, data = poisson_data, fct = LL.4(), type = "Poisson") + vcov_mat <- vcov(m_poisson) + + expect_true(is.matrix(vcov_mat)) + expect_equal(nrow(vcov_mat), length(coef(m_poisson))) +}) + +# Tests for confint.drc() + +test_that("confint.drc returns confidence intervals for all parameters", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + ci <- confint(m1) + + expect_true(is.matrix(ci)) + expect_equal(nrow(ci), length(coef(m1))) + expect_equal(ncol(ci), 2) +}) + +test_that("confint.drc interval contains point estimate", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + ci <- confint(m1) + coeffs <- coef(m1) + + # Each coefficient should be within its confidence interval + for (i in 1:length(coeffs)) { + expect_true(ci[i, 1] < coeffs[i]) + expect_true(ci[i, 2] > coeffs[i]) + } +}) + +test_that("confint.drc respects level parameter", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + ci_95 <- confint(m1, level = 0.95) + ci_90 <- confint(m1, level = 0.90) + + # 90% CI should be narrower than 95% CI + width_95 <- ci_95[, 2] - ci_95[, 1] + width_90 <- ci_90[, 2] - ci_90[, 1] + + expect_true(all(width_90 < width_95)) +}) + +test_that("confint.drc can select specific parameters", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Get CI for just one parameter using short parameter names + # confint.drc matches against parNames[[2]] (e.g., "b", "c", "d", "e") + param_name <- m1$parNames[[2]][1] + ci <- confint(m1, parm = param_name) + + expect_equal(nrow(ci), 1) +}) + +test_that("confint.drc errors for invalid parameter name", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + expect_error(confint(m1, parm = "nonexistent_param"), + "does not match an actual parameter") +}) + +test_that("confint.drc can select multiple parameters", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Get CI for first two parameters using short parameter names + # confint.drc matches against parNames[[2]] (e.g., "b", "c", "d", "e") + param_names <- m1$parNames[[2]][1:2] + ci <- confint(m1, parm = param_names) + + expect_equal(nrow(ci), 2) +}) + +test_that("confint.drc works with multi-curve models", { + m_multi <- drm(resp ~ dose, curveid = group, data = multi_data, fct = LL.4()) + ci <- confint(m_multi) + + expect_equal(nrow(ci), length(coef(m_multi))) + expect_equal(ncol(ci), 2) +}) + +test_that("confint.drc with pool = FALSE for multi-curve models", { + m_multi <- drm(resp ~ dose, curveid = group, data = multi_data, fct = LL.4()) + + ci_pooled <- confint(m_multi, pool = TRUE) + ci_unpooled <- confint(m_multi, pool = FALSE) + + expect_true(is.matrix(ci_pooled)) + expect_true(is.matrix(ci_unpooled)) + expect_equal(dim(ci_pooled), dim(ci_unpooled)) +}) + +test_that("confint.drc uses t-distribution for continuous data", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + ci <- confint(m1, level = 0.95) + + # Check that CI is calculated correctly using t-distribution + summ <- summary(m1) + est <- summ$coefficients[, "Estimate"] + se <- summ$coefficients[, "Std. Error"] + df <- df.residual(m1) + t_val <- qt(0.975, df) + + expected_lower <- est - t_val * se + expected_upper <- est + t_val * se + + expect_equal(ci[, 1], expected_lower, tolerance = 1e-6) + expect_equal(ci[, 2], expected_upper, tolerance = 1e-6) +}) + +test_that("confint.drc uses normal distribution for binomial data", { + binom_data <- data.frame( + dose = c(0, 0.1, 0.5, 1, 2, 5, 10), + resp = c(0, 0.05, 0.15, 0.35, 0.65, 0.90, 0.98), + n = rep(50, 7) + ) + m_binom <- drm(resp ~ dose, data = binom_data, fct = LL.2(), type = "binomial", weights = n) + ci <- confint(m_binom, level = 0.95) + + # Check that CI is calculated correctly using normal distribution + summ <- summary(m_binom) + est <- summ$coefficients[, "Estimate"] + se <- summ$coefficients[, "Std. Error"] + z_val <- qnorm(0.975) + + expected_lower <- est - z_val * se + expected_upper <- est + z_val * se + + expect_equal(ci[, 1], expected_lower, tolerance = 1e-6) + expect_equal(ci[, 2], expected_upper, tolerance = 1e-6) +}) + +# Integration tests + +test_that("coef, vcov, and confint are consistent", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + coeffs <- coef(m1) + vcov_mat <- vcov(m1) + ci <- confint(m1) + + # Number of coefficients should match dimensions + expect_equal(length(coeffs), nrow(vcov_mat)) + expect_equal(length(coeffs), nrow(ci)) + + # Names of coefficients should match CI rownames + expect_equal(names(coeffs), rownames(ci)) +}) + +test_that("vcov diagonal matches SE squared", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + vcov_mat <- vcov(m1) + summ <- summary(m1) + + se_from_vcov <- sqrt(diag(vcov_mat)) + se_from_summary <- unname(summ$coefficients[, "Std. Error"]) + + expect_equal(unname(se_from_vcov), se_from_summary, tolerance = 1e-10) +}) + +test_that("confint.basic helper function works", { + est_mat <- matrix(c(1, 0.1, 2, 0.2), ncol = 2) + rownames(est_mat) <- c("param1", "param2") + colnames(est_mat) <- c("Estimate", "Std. Error") + + ci <- confint.basic(est_mat, level = 0.95, intType = "continuous", dfres = 26) + + expect_true(is.matrix(ci)) + expect_equal(nrow(ci), 2) + expect_equal(ncol(ci), 2) + expect_equal(rownames(ci), c("param1", "param2")) +}) + +test_that("confint.basic uses correct quantiles for different types", { + est_mat <- matrix(c(1, 0.1), ncol = 2) + + # Continuous should use t-distribution + ci_cont <- confint.basic(est_mat, level = 0.95, intType = "continuous", dfres = 30) + + # Binomial should use normal distribution + ci_binom <- confint.basic(est_mat, level = 0.95, intType = "binomial", dfres = 30) + + expect_true(is.matrix(ci_cont)) + expect_true(is.matrix(ci_binom)) + + # CI widths will differ slightly due to different distributions + width_cont <- ci_cont[1, 2] - ci_cont[1, 1] + width_binom <- ci_binom[1, 2] - ci_binom[1, 1] + + expect_true(width_cont > 0) + expect_true(width_binom > 0) +}) + +test_that("All three functions work together in a workflow", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Extract coefficients + coeffs <- coef(m1) + expect_true(length(coeffs) == 4) + + # Get variance-covariance matrix + vcov_mat <- vcov(m1) + expect_equal(dim(vcov_mat), c(4, 4)) + + # Get confidence intervals + ci <- confint(m1) + expect_equal(dim(ci), c(4, 2)) + + # Coefficient names should match CI rownames + expect_equal(names(coeffs), rownames(ci)) +}) diff --git a/tests/testthat/test-drm-legacy-match.R b/tests/testthat/test-drm-legacy-match.R new file mode 100644 index 00000000..3a5dec6d --- /dev/null +++ b/tests/testthat/test-drm-legacy-match.R @@ -0,0 +1,199 @@ +# Compare drm() output to drm_legacy() output +# drm() must produce an identically structured and valued output as drm_legacy() + +# Helper function to compare two drc fits element by element +compare_drc_fits <- function(fit1, fit2, tol = .Machine$double.eps^0.5) { + # Check that names match + expect_identical(names(fit1), names(fit2)) + + # Compare all non-function elements + for (nm in names(fit1)) { + # 'call' naturally differs because the function names are different + if (nm == "call") next + + el1 <- fit1[[nm]] + el2 <- fit2[[nm]] + + if (is.function(el1)) next + + if (is.list(el1) && !is.data.frame(el1)) { + # Compare list sub-elements + expect_identical(names(el1), names(el2), info = paste("List names for", nm)) + for (subnm in names(el1)) { + if (is.function(el1[[subnm]])) next + expect_equal(el1[[subnm]], el2[[subnm]], + tolerance = tol, + info = paste(nm, "$", subnm, sep = "") + ) + } + } else { + expect_equal(el1, el2, tolerance = tol, info = nm) + } + } +} + +# Create test datasets +ryegrass <- data.frame( + rootl = c( + 7.58, 8.00, 8.33, 7.25, 7.17, 7.00, 7.17, 7.83, 7.92, 7.58, + 6.17, 5.75, 5.83, 6.00, 5.83, 4.92, 4.50, 4.17, 4.42, 4.00, + 2.67, 2.08, 2.42, 2.50, 2.25, 1.17, 0.75, 0.92, 1.00, 0.58 + ), + conc = c( + rep(0, 5), rep(0.94, 5), rep(1.88, 5), + rep(3.75, 5), rep(7.50, 5), rep(15, 5) + ) +) + +set.seed(42) +multi_data <- data.frame( + dose = rep(c(0, 0.5, 1, 2, 5, 10), each = 5, times = 2), + resp = c( + rnorm(5, 100, 5), rnorm(5, 95, 5), rnorm(5, 85, 5), + rnorm(5, 60, 5), rnorm(5, 20, 5), rnorm(5, 5, 5), + rnorm(5, 100, 5), rnorm(5, 90, 5), rnorm(5, 70, 5), + rnorm(5, 40, 5), rnorm(5, 10, 5), rnorm(5, 3, 5) + ), + group = rep(c("A", "B"), each = 30) +) + +test_that("drm() matches drm_legacy() for single curve LL.4", { + fit1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + fit2 <- drc:::drm_legacy(rootl ~ conc, data = ryegrass, fct = LL.4()) + compare_drc_fits(fit1, fit2) +}) + +test_that("drm() matches drm_legacy() for multi-curve LL.4", { + fit1 <- drm(resp ~ dose, curveid = group, data = multi_data, fct = LL.4()) + fit2 <- drc:::drm_legacy(resp ~ dose, curveid = group, data = multi_data, fct = LL.4()) + compare_drc_fits(fit1, fit2) +}) + +test_that("drm() matches drm_legacy() with Box-Cox transformation", { + fit1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4(), bcVal = 0) + fit2 <- drc:::drm_legacy(rootl ~ conc, data = ryegrass, fct = LL.4(), bcVal = 0) + compare_drc_fits(fit1, fit2) +}) + +test_that("drm() matches drm_legacy() with logDose", { + fit1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4(), logDose = 10) + fit2 <- drc:::drm_legacy(rootl ~ conc, data = ryegrass, fct = LL.4(), logDose = 10) + compare_drc_fits(fit1, fit2) +}) + +test_that("drm() matches drm_legacy() with Weibull W1.4", { + fit1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) + fit2 <- drc:::drm_legacy(rootl ~ conc, data = ryegrass, fct = W1.4()) + compare_drc_fits(fit1, fit2) +}) + +test_that("drm() matches drm_legacy() with pmodels", { + fit1 <- drm(resp ~ dose, + curveid = group, data = multi_data, fct = LL.4(), + pmodels = data.frame(multi_data$group, multi_data$group, 1, multi_data$group) + ) + fit2 <- drc:::drm_legacy(resp ~ dose, + curveid = group, data = multi_data, fct = LL.4(), + pmodels = data.frame(multi_data$group, multi_data$group, 1, multi_data$group) + ) + compare_drc_fits(fit1, fit2) +}) + +test_that("drm() matches drm_legacy() with constrained optimization", { + fit1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4(), lowerl = c(-Inf, 0, -Inf, -Inf)) + fit2 <- drc:::drm_legacy(rootl ~ conc, data = ryegrass, fct = LL.4(), lowerl = c(-Inf, 0, -Inf, -Inf)) + compare_drc_fits(fit1, fit2) +}) + +test_that("drm() matches drm_legacy() with binomial type", { + binom_data <- data.frame( + dose = c(0, 0.1, 0.5, 1, 2, 5, 10), + resp = c(0, 0.05, 0.15, 0.35, 0.65, 0.90, 0.98), + n = rep(50, 7) + ) + fit1 <- drm(resp ~ dose, data = binom_data, fct = LL.2(), type = "binomial", weights = n) + fit2 <- drc:::drm_legacy(resp ~ dose, data = binom_data, fct = LL.2(), type = "binomial", weights = n) + compare_drc_fits(fit1, fit2) +}) + +test_that("drm() matches drm_legacy() with Poisson type", { + poisson_data <- data.frame( + dose = c(0, 1, 2, 4, 8, 16, 32), + count = c(50, 48, 40, 25, 10, 3, 1) + ) + fit1 <- drm(count ~ dose, data = poisson_data, fct = LL.4(), type = "Poisson") + fit2 <- drc:::drm_legacy(count ~ dose, data = poisson_data, fct = LL.4(), type = "Poisson") + compare_drc_fits(fit1, fit2) +}) + +test_that("drm() matches drm_legacy() with negbin1 type", { + count_data <- data.frame( + dose = c(0, 1, 2, 4, 8, 16, 32), + count = c(50, 48, 40, 25, 10, 3, 1) + ) + fit1 <- drm(count ~ dose, data = count_data, fct = LL.4(), type = "negbin1") + fit2 <- drc:::drm_legacy(count ~ dose, data = count_data, fct = LL.4(), type = "negbin1") + compare_drc_fits(fit1, fit2) +}) + +test_that("drm() matches drm_legacy() with negbin2 type", { + count_data <- data.frame( + dose = c(0, 1, 2, 4, 8, 16, 32), + count = c(50, 48, 40, 25, 10, 3, 1) + ) + fit1 <- drm(count ~ dose, data = count_data, fct = LL.4(), type = "negbin2") + fit2 <- drc:::drm_legacy(count ~ dose, data = count_data, fct = LL.4(), type = "negbin2") + compare_drc_fits(fit1, fit2) +}) + +test_that("drm() matches drm_legacy() with robust estimation (median)", { + fit1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4(), robust = "median") + fit2 <- drc:::drm_legacy(rootl ~ conc, data = ryegrass, fct = LL.4(), robust = "median") + compare_drc_fits(fit1, fit2) +}) + +test_that("drm() matches drm_legacy() with LL.3 model", { + fit1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.3()) + fit2 <- drc:::drm_legacy(rootl ~ conc, data = ryegrass, fct = LL.3()) + compare_drc_fits(fit1, fit2) +}) + +test_that("drm() matches drm_legacy() with user-supplied start values", { + fit1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4(), start = c(2.5, 1, 0.5, 8)) + fit2 <- drc:::drm_legacy(rootl ~ conc, data = ryegrass, fct = LL.4(), start = c(2.5, 1, 0.5, 8)) + compare_drc_fits(fit1, fit2) +}) + +test_that("drm() matches drm_legacy() with varcov matrix", { + vcov_mat <- diag(30) * 2 + fit1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4(), varcov = vcov_mat) + fit2 <- drc:::drm_legacy(rootl ~ conc, data = ryegrass, fct = LL.4(), varcov = vcov_mat) + compare_drc_fits(fit1, fit2) +}) + +test_that("drm() matches drm_legacy() with noMessage=TRUE", { + fit1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4(), control = drmc(noMessage = TRUE)) + fit2 <- drc:::drm_legacy(rootl ~ conc, data = ryegrass, fct = LL.4(), control = drmc(noMessage = TRUE)) + compare_drc_fits(fit1, fit2) +}) + +test_that("drm() return value has correct class", { + fit1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + fit2 <- drc:::drm_legacy(rootl ~ conc, data = ryegrass, fct = LL.4()) + expect_identical(class(fit1), class(fit2)) + expect_identical(class(fit1), "drc") +}) + +test_that("drm() return value has all expected named elements", { + fit1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + expected_names <- c( + "varParm", "fit", "curve", "summary", "start", "parNames", + "predres", "call", "data", + "parmMat", "fct", "robust", "estMethod", "df.residual", + "sumList", "scaleFct", "pmFct", "pfFct", "type", "indexMat", + "logDose", "cm", "deriv1", + "curveVarNam", "origData", "weights", + "dataList", "coefficients", "boxcox", "indexMat2" + ) + expect_identical(names(fit1), expected_names) +}) diff --git a/tests/testthat/test-drmEMeventtime.R b/tests/testthat/test-drmEMeventtime.R new file mode 100644 index 00000000..5442ff05 --- /dev/null +++ b/tests/testthat/test-drmEMeventtime.R @@ -0,0 +1,215 @@ +# Tests for drmEMeventtime() and drmLOFeventtime() +# These are internal functions used for dose-response model fitting +# with an EM algorithm approach for event time data. + +# --- Helper setup --- +# A simple CDF-like model: F(dose) = 1 - exp(-a * dose) +# This mimics a cumulative distribution function used in event time analysis. +simple_cdf <- function(dose, parm) { + 1 - exp(-parm[1] * dose) +} + +# Test dose as a 2-column matrix (start, end intervals) +# When dose has exactly 2 columns, dose[, -1] returns a vector (not matrix) +test_dose_2col <- matrix(c(0, 1, 2, 3, # start times (column 1) + 1, 2, 3, Inf), # end times (column 2) + ncol = 2) + +# Test dose as a 3-column matrix (start, extra, end intervals) +# When dose has 3+ columns, dose[, -1] returns a matrix +test_dose_3col <- matrix(c(0, 1, 2, 3, # column 1 (start times) + 0.5, 1.5, 2.5, 3.5, # column 2 (middle) + 1, 2, 3, Inf), # column 3 (end times) + ncol = 3) + +test_resp <- c(5, 10, 8, 2) +test_parm <- c(0.5) + + +# ============================================================================= +# Tests for drmEMeventtime(): structure and return value +# ============================================================================= + +test_that("drmEMeventtime returns a list with the correct named elements", { + result <- drmEMeventtime(test_dose_2col, test_resp, simple_cdf) + + expect_true(is.list(result)) + expect_named(result, c("llfct", "opfct", "ssfct", "rvfct", "vcovfct", "parmfct")) + expect_true(is.function(result$llfct)) + expect_true(is.function(result$opfct)) + expect_null(result$ssfct) + expect_null(result$rvfct) + expect_true(is.function(result$vcovfct)) + expect_true(is.function(result$parmfct)) +}) + +test_that("drmEMeventtime works with doseScaling parameter", { + result <- drmEMeventtime(test_dose_2col, test_resp, simple_cdf, doseScaling = 2) + + expect_true(is.list(result)) + expect_named(result, c("llfct", "opfct", "ssfct", "rvfct", "vcovfct", "parmfct")) +}) + + +# ============================================================================= +# Tests for opfct(): objective function (negative log-likelihood) +# ============================================================================= + +test_that("opfct computes a numeric scalar value with 2-column dose", { + em <- drmEMeventtime(test_dose_2col, test_resp, simple_cdf) + + val <- em$opfct(test_parm) + expect_true(is.numeric(val)) + expect_equal(length(val), 1) + expect_true(is.finite(val)) +}) + +test_that("opfct handles 3-column dose matrix (matrix branch of ifelse)", { + em <- drmEMeventtime(test_dose_3col, test_resp, simple_cdf) + + val <- em$opfct(test_parm) + expect_true(is.numeric(val)) + expect_equal(length(val), 1) + expect_true(is.finite(val)) +}) + +test_that("opfct replaces zero temp values with 1e-9", { + # Create a model that returns constant values so Fend - Fstart = 0 + constant_model <- function(dose, parm) { + rep(parm[1], length(dose)) + } + + dose_mat <- matrix(c(0, 1, 1, 2), ncol = 2) + resp <- c(1, 1) + + em <- drmEMeventtime(dose_mat, resp, constant_model) + # With a constant model, Fend - Fstart = 0, which gets replaced by 1e-9 + val <- em$opfct(c(0.5)) + expect_true(is.finite(val)) +}) + +test_that("opfct respects doseScaling parameter", { + em1 <- drmEMeventtime(test_dose_2col, test_resp, simple_cdf, doseScaling = 1) + em2 <- drmEMeventtime(test_dose_2col * 2, test_resp, simple_cdf, doseScaling = 2) + + val1 <- em1$opfct(test_parm) + val2 <- em2$opfct(test_parm) + expect_equal(val1, val2, tolerance = 1e-10) +}) + +test_that("opfct handles Inf in dose end times (2-column, vector path)", { + # With 2-column dose, dose[,-1] is a vector + # Inf values should cause Fend to be set to 1 + dose_with_inf <- matrix(c(0, 1, # start + Inf, 2), # end (first is Inf) + ncol = 2) + resp <- c(3, 5) + + em <- drmEMeventtime(dose_with_inf, resp, simple_cdf) + val <- em$opfct(test_parm) + expect_true(is.finite(val)) +}) + +test_that("opfct handles Inf in dose end times (3-column, matrix path)", { + # With 3-column dose, dose[,-1] is a matrix + # Inf values should cause Fend to be set to 1 + dose_with_inf <- matrix(c(0, 1, # column 1 + 0.5, 1.5, # column 2 + Inf, 2), # column 3 (first is Inf) + ncol = 3) + resp <- c(3, 5) + + em <- drmEMeventtime(dose_with_inf, resp, simple_cdf) + val <- em$opfct(test_parm) + expect_true(is.finite(val)) +}) + + +# ============================================================================= +# Tests for llfct(): log-likelihood function +# ============================================================================= + +test_that("llfct returns a numeric vector of length 2", { + em <- drmEMeventtime(test_dose_2col, test_resp, simple_cdf) + + mock_object <- list( + fit = list(value = 10), + sumList = list(df.residual = 3) + ) + + result <- em$llfct(mock_object) + expect_true(is.numeric(result)) + expect_equal(length(result), 2) +}) + +test_that("llfct computes correct values", { + em <- drmEMeventtime(test_dose_2col, test_resp, simple_cdf) + + mock_object <- list( + fit = list(value = 10), + sumList = list(df.residual = 3) + ) + + result <- em$llfct(mock_object) + # First element: -object$fit$value + expect_equal(result[1], -10) + # Second element: df.residual + expect_equal(result[2], 3) +}) + + +# ============================================================================= +# Tests for parmfct(): parameter extraction function +# ============================================================================= + +test_that("parmfct extracts par from fit object", { + em <- drmEMeventtime(test_dose_2col, test_resp, simple_cdf) + + mock_fit <- list(par = c(0.5, 1.2, 0.8)) + result <- em$parmfct(mock_fit) + expect_equal(result, c(0.5, 1.2, 0.8)) +}) + +test_that("parmfct works with fixed argument", { + em <- drmEMeventtime(test_dose_2col, test_resp, simple_cdf) + + mock_fit <- list(par = c(1, 2)) + result <- em$parmfct(mock_fit, fixed = FALSE) + expect_equal(result, c(1, 2)) +}) + + +# ============================================================================= +# Tests for vcovfct(): variance-covariance matrix function +# ============================================================================= + +test_that("vcovfct returns inverse of hessian", { + em <- drmEMeventtime(test_dose_2col, test_resp, simple_cdf) + + hessian <- matrix(c(4, 1, 1, 4), nrow = 2) + mock_object <- list( + fit = list(hessian = hessian) + ) + + result <- em$vcovfct(mock_object) + expect_true(is.matrix(result)) + expect_equal(nrow(result), 2) + expect_equal(ncol(result), 2) + + expected <- solve(hessian) + expect_equal(result, expected, tolerance = 1e-10) +}) + + +# ============================================================================= +# Tests for drmLOFeventtime() +# ============================================================================= + +test_that("drmLOFeventtime returns a list with NULL elements", { + result <- drmLOFeventtime() + + expect_true(is.list(result)) + expect_named(result, c("anovaTest", "gofTest")) + expect_null(result$anovaTest) + expect_null(result$gofTest) +}) diff --git a/tests/testthat/test-drmEMssd.R b/tests/testthat/test-drmEMssd.R new file mode 100644 index 00000000..5e6308bc --- /dev/null +++ b/tests/testthat/test-drmEMssd.R @@ -0,0 +1,234 @@ +# Tests for drmEMssd() and drmLOFssd() +# These are internal functions used for species sensitivity distribution (SSD) +# model fitting with an EM algorithm approach. + +# --- Helper setup --- +# A simple PDF-like function (always positive) for use as multCurves +simple_pdf <- function(dose, parm) { + dnorm(dose, mean = parm[1], sd = parm[2]) +} + +# A simple CDF function for use as multCurves2 +simple_cdf <- function(dose, parm) { + pnorm(dose, mean = parm[1], sd = parm[2]) +} + +# Test data for uncensored case +test_dose <- c(1, 2, 3, 4, 5) +test_resp <- rep(0, 5) # resp is unused in drmEMssd +test_parm <- c(3, 1) # mean=3, sd=1 + +# Test data for censored case (2-column matrix) +# Some observations are censored (dose1 != dose2), some are exact (dose1 == dose2) +test_dose_cens <- matrix(c( + 1, 1, # exact (uncensored) + 2, 2, # exact (uncensored) + 3, 4, # censored interval [3, 4] + 4, 5, # censored interval [4, 5] + 5, 5 # exact (uncensored) +), ncol = 2, byrow = TRUE) + + +# ============================================================================= +# Tests for drmEMssd(): structure and return value +# ============================================================================= + +test_that("drmEMssd returns a list with the correct named elements (uncensored)", { + result <- drmEMssd(test_dose, test_resp, simple_pdf) + + expect_true(is.list(result)) + expect_named(result, c("llfct", "opfct", "ssfct", "rvfct", "vcovfct", "parmfct")) + expect_true(is.function(result$llfct)) + expect_true(is.function(result$opfct)) + expect_null(result$ssfct) + expect_null(result$rvfct) + expect_true(is.function(result$vcovfct)) + expect_true(is.function(result$parmfct)) +}) + +test_that("drmEMssd returns a list with the correct named elements (censored)", { + result <- drmEMssd(test_dose_cens, test_resp, simple_pdf, + multCurves2 = simple_cdf) + + expect_true(is.list(result)) + expect_named(result, c("llfct", "opfct", "ssfct", "rvfct", "vcovfct", "parmfct")) + expect_true(is.function(result$llfct)) + expect_true(is.function(result$opfct)) + expect_null(result$ssfct) + expect_null(result$rvfct) + expect_true(is.function(result$vcovfct)) + expect_true(is.function(result$parmfct)) +}) + +test_that("drmEMssd works with doseScaling parameter", { + result <- drmEMssd(test_dose, test_resp, simple_pdf, doseScaling = 2) + + expect_true(is.list(result)) + expect_named(result, c("llfct", "opfct", "ssfct", "rvfct", "vcovfct", "parmfct")) +}) + + +# ============================================================================= +# Tests for opfct(): objective function (uncensored path) +# ============================================================================= + +test_that("opfct computes a numeric scalar value (uncensored)", { + em <- drmEMssd(test_dose, test_resp, simple_pdf) + + val <- em$opfct(test_parm) + expect_true(is.numeric(val)) + expect_equal(length(val), 1) + expect_true(is.finite(val)) +}) + +test_that("opfct computes correct negative log-likelihood (uncensored)", { + em <- drmEMssd(test_dose, test_resp, simple_pdf) + + val <- em$opfct(test_parm) + expected <- -sum(log(dnorm(test_dose, mean = 3, sd = 1))) + expect_equal(val, expected, tolerance = 1e-10) +}) + +test_that("opfct respects doseScaling parameter (uncensored)", { + em1 <- drmEMssd(test_dose, test_resp, simple_pdf, doseScaling = 1) + em2 <- drmEMssd(test_dose * 2, test_resp, simple_pdf, doseScaling = 2) + + val1 <- em1$opfct(test_parm) + val2 <- em2$opfct(test_parm) + expect_equal(val1, val2, tolerance = 1e-10) +}) + + +# ============================================================================= +# Tests for opfct(): objective function (censored path) +# ============================================================================= + +test_that("opfct computes a numeric scalar value (censored)", { + em <- drmEMssd(test_dose_cens, test_resp, simple_pdf, + multCurves2 = simple_cdf) + + val <- em$opfct(test_parm) + expect_true(is.numeric(val)) + expect_equal(length(val), 1) + expect_true(is.finite(val)) +}) + +test_that("opfct computes correct value (censored)", { + em <- drmEMssd(test_dose_cens, test_resp, simple_pdf, + multCurves2 = simple_cdf) + + val <- em$opfct(test_parm) + + # Manual computation: + dose1 <- test_dose_cens[, 1] + dose2 <- test_dose_cens[, 2] + notCens <- dose1 == dose2 # rows 1, 2, 5 are exact + + # PDF values for uncensored observations + fValues <- dnorm(dose1[notCens], mean = 3, sd = 1) + # CDF values for censored observations + Fvalues1 <- pnorm(dose1[!notCens], mean = 3, sd = 1) + Fvalues2 <- pnorm(dose2[!notCens], mean = 3, sd = 1) + + expected <- -sum(log(fValues)) + (-sum(log(Fvalues2 - Fvalues1))) + expect_equal(val, expected, tolerance = 1e-10) +}) + +test_that("opfct respects doseScaling parameter (censored)", { + em1 <- drmEMssd(test_dose_cens, test_resp, simple_pdf, + doseScaling = 1, multCurves2 = simple_cdf) + em2 <- drmEMssd(test_dose_cens * 2, test_resp, simple_pdf, + doseScaling = 2, multCurves2 = simple_cdf) + + val1 <- em1$opfct(test_parm) + val2 <- em2$opfct(test_parm) + expect_equal(val1, val2, tolerance = 1e-10) +}) + + +# ============================================================================= +# Tests for llfct(): log-likelihood function +# ============================================================================= + +test_that("llfct returns a numeric vector of length 2", { + em <- drmEMssd(test_dose, test_resp, simple_pdf) + + mock_object <- list( + fit = list(value = 10), + sumList = list(df.residual = 3) + ) + + result <- em$llfct(mock_object) + expect_true(is.numeric(result)) + expect_equal(length(result), 2) +}) + +test_that("llfct computes correct values", { + em <- drmEMssd(test_dose, test_resp, simple_pdf) + + mock_object <- list( + fit = list(value = 10), + sumList = list(df.residual = 3) + ) + + result <- em$llfct(mock_object) + # First element: -object$fit$value (negated because opfct minimizes negative LL) + expect_equal(result[1], -10) + # Second element: df.residual + expect_equal(result[2], 3) +}) + + +# ============================================================================= +# Tests for vcovfct(): variance-covariance matrix function +# ============================================================================= + +test_that("vcovfct returns inverse of hessian", { + em <- drmEMssd(test_dose, test_resp, simple_pdf) + + hessian <- matrix(c(4, 1, 1, 4), nrow = 2) + mock_object <- list( + fit = list(hessian = hessian) + ) + + result <- em$vcovfct(mock_object) + expect_true(is.matrix(result)) + expect_equal(nrow(result), 2) + expect_equal(ncol(result), 2) + expect_equal(result, solve(hessian), tolerance = 1e-10) +}) + + +# ============================================================================= +# Tests for parmfct(): parameter extraction function +# ============================================================================= + +test_that("parmfct extracts par from fit object", { + em <- drmEMssd(test_dose, test_resp, simple_pdf) + + mock_fit <- list(par = c(3, 1)) + result <- em$parmfct(mock_fit) + expect_equal(result, c(3, 1)) +}) + +test_that("parmfct works with fixed argument", { + em <- drmEMssd(test_dose, test_resp, simple_pdf) + + mock_fit <- list(par = c(3, 1)) + result <- em$parmfct(mock_fit, fixed = FALSE) + expect_equal(result, c(3, 1)) +}) + + +# ============================================================================= +# Tests for drmLOFssd() +# ============================================================================= + +test_that("drmLOFssd returns a list with NULL elements", { + result <- drmLOFssd() + + expect_true(is.list(result)) + expect_named(result, c("anovaTest", "gofTest")) + expect_null(result$anovaTest) + expect_null(result$gofTest) +}) diff --git a/tests/testthat/test-drmEMstandard.R b/tests/testthat/test-drmEMstandard.R new file mode 100644 index 00000000..353604cd --- /dev/null +++ b/tests/testthat/test-drmEMstandard.R @@ -0,0 +1,221 @@ +# Tests for drmEMstandard() and drmLOFstandard() +# These are internal functions used for dose-response model fitting +# with a standard EM algorithm approach. + +# --- Helper setup --- +# A simple linear dose-response model: y = a + b * dose +# This is used as the multCurves function throughout the tests. +simple_model <- function(dose, parm) { + parm[1] + parm[2] * dose +} + +# Test doses with 2 zero-dose observations and 3 non-zero +test_dose <- c(0, 0, 1, 2, 3) +test_resp <- c(10, 11, 8, 5, 3) +test_parm <- c(10, -2) + + +# ============================================================================= +# Tests for drmEMstandard(): structure and return value +# ============================================================================= + +test_that("drmEMstandard returns a list with the correct named elements", { + result <- drmEMstandard(test_dose, test_resp, simple_model) + + expect_true(is.list(result)) + expect_named(result, c("llfct", "opfct", "ssfct", "rvfct", "vcovfct", "parmfct")) + expect_true(is.function(result$llfct)) + expect_true(is.function(result$opfct)) + expect_null(result$ssfct) + expect_true(is.function(result$rvfct)) + expect_true(is.function(result$vcovfct)) + expect_true(is.function(result$parmfct)) +}) + +test_that("drmEMstandard works with doseScaling parameter", { + result <- drmEMstandard(test_dose, test_resp, simple_model, doseScaling = 2) + + expect_true(is.list(result)) + expect_named(result, c("llfct", "opfct", "ssfct", "rvfct", "vcovfct", "parmfct")) +}) + + +# ============================================================================= +# Tests for opfct(): objective function +# ============================================================================= + +test_that("opfct computes a numeric scalar value", { + em <- drmEMstandard(test_dose, test_resp, simple_model) + + val <- em$opfct(test_parm) + expect_true(is.numeric(val)) + expect_equal(length(val), 1) + expect_true(is.finite(val)) +}) + +test_that("opfct value is non-negative (weighted sum of squared residuals)", { + em <- drmEMstandard(test_dose, test_resp, simple_model) + + val <- em$opfct(test_parm) + expect_true(val >= 0) +}) + +test_that("opfct respects doseScaling parameter", { + em1 <- drmEMstandard(test_dose, test_resp, simple_model, doseScaling = 1) + em2 <- drmEMstandard(test_dose * 2, test_resp, simple_model, doseScaling = 2) + + # With scaled dose and matching doseScaling, multCurves sees the same values + val1 <- em1$opfct(test_parm) + val2 <- em2$opfct(test_parm) + expect_equal(val1, val2, tolerance = 1e-10) +}) + + +# ============================================================================= +# Tests for llfct(): log-likelihood function +# ============================================================================= + +test_that("llfct returns a numeric vector of length 2", { + em <- drmEMstandard(test_dose, test_resp, simple_model) + + mock_object <- list( + fit = list(value = 10), + sumList = list(df.residual = 3) + ) + + result <- em$llfct(mock_object) + expect_true(is.numeric(result)) + expect_equal(length(result), 2) +}) + +test_that("llfct computes correct values", { + em <- drmEMstandard(test_dose, test_resp, simple_model) + + mock_object <- list( + fit = list(value = 10), + sumList = list(df.residual = 3) + ) + + result <- em$llfct(mock_object) + # First element: -object$fit$value + sum(log(gamma(resp+1))) + expected_ll <- -10 + sum(log(gamma(test_resp + 1))) + expect_equal(result[1], expected_ll) + # Second element: df.residual + expect_equal(result[2], 3) +}) + + +# ============================================================================= +# Tests for rvfct(): residual variance function +# ============================================================================= + +test_that("rvfct returns a numeric scalar", { + em <- drmEMstandard(test_dose, test_resp, simple_model) + + mock_object <- list( + fit = list(value = 15), + df.residual = 3 # used by stats::df.residual.default + ) + + result <- em$rvfct(mock_object) + expect_true(is.numeric(result)) + expect_equal(length(result), 1) + expect_equal(result, 15 / 3) +}) + + +# ============================================================================= +# Tests for parmfct(): parameter extraction function +# ============================================================================= + +test_that("parmfct extracts par from fit object", { + em <- drmEMstandard(test_dose, test_resp, simple_model) + + mock_fit <- list(par = c(10, -2, 0.5)) + result <- em$parmfct(mock_fit) + expect_equal(result, c(10, -2, 0.5)) +}) + +test_that("parmfct works with fixed argument", { + em <- drmEMstandard(test_dose, test_resp, simple_model) + + mock_fit <- list(par = c(1, 2)) + result <- em$parmfct(mock_fit, fixed = FALSE) + expect_equal(result, c(1, 2)) +}) + + +# ============================================================================= +# Tests for vcovfct(): variance-covariance matrix function +# ============================================================================= + +test_that("vcovfct returns inverse of scaled hessian when solve succeeds", { + em <- drmEMstandard(test_dose, test_resp, simple_model) + + # Well-conditioned positive definite hessian + hessian <- matrix(c(4, 1, 1, 4), nrow = 2) + mock_object <- list( + fit = list(value = 10, hessian = hessian), + df.residual = 3 + ) + + result <- em$vcovfct(mock_object) + expect_true(is.matrix(result)) + expect_equal(nrow(result), 2) + expect_equal(ncol(result), 2) + + # Verify it's the inverse of the scaled hessian + rv <- 10 / 3 # rvfct result + scaledH <- hessian / (2 * rv) + expected <- solve(scaledH) + expect_equal(result, expected, tolerance = 1e-10) +}) + +test_that("vcovfct falls back to regularized Cholesky when solve and first chol fail", { + em <- drmEMstandard(test_dose, test_resp, simple_model) + + # Zero matrix: solve fails (singular), chol fails (not PD) + # Regularized: 0.99 * 0 + 0.01 * I = 0.01 * I → PD → chol succeeds + hessian <- matrix(0, nrow = 2, ncol = 2) + mock_object <- list( + fit = list(value = 10, hessian = hessian), + df.residual = 3 + ) + + result <- em$vcovfct(mock_object) + # Regularized = 0.01 * I, so result = chol2inv(chol(0.01 * I)) = 100 * I + expected <- chol2inv(chol(0.01 * diag(2))) + + expect_true(is.matrix(result)) + expect_equal(result, expected, tolerance = 1e-10) +}) + +test_that("vcovfct returns NULL when all decompositions fail", { + em <- drmEMstandard(test_dose, test_resp, simple_model) + + # Matrix with eigenvalue 0 and a negative eigenvalue: + # eigenvalues: 0 and -1 + # After regularization: 0.99*0+0.01=0.01 and 0.99*(-1)+0.01=-0.98 → not PD + hessian <- matrix(c(-0.5, 0.5, 0.5, -0.5), nrow = 2) + mock_object <- list( + fit = list(value = 10, hessian = hessian), + df.residual = 3 + ) + + result <- em$vcovfct(mock_object) + expect_null(result) +}) + + +# ============================================================================= +# Tests for drmLOFstandard() +# ============================================================================= + +test_that("drmLOFstandard returns a list with NULL elements", { + result <- drmLOFstandard() + + expect_true(is.list(result)) + expect_named(result, c("anovaTest", "gofTest")) + expect_null(result$anovaTest) + expect_null(result$gofTest) +}) diff --git a/tests/testthat/test-drmOpt.R b/tests/testthat/test-drmOpt.R new file mode 100644 index 00000000..83a973bd --- /dev/null +++ b/tests/testthat/test-drmOpt.R @@ -0,0 +1,384 @@ +# tests/testthat/test-drmOpt.R +# Comprehensive tests for drmOpt() — internal optim() wrapper + +# --- Helper: simple quadratic objective (min at x=3, y=1) ---- +quad_obj <- function(par) (par[1] - 3)^2 + (par[2] - 1)^2 +quad_grad <- function(par) c(2 * (par[1] - 3), 2 * (par[2] - 1)) +quad_hess <- function(par) matrix(c(2, 0, 0, 2), 2, 2) + +# A function that always errors, to make optim() fail via try() +bad_obj <- function(par) stop("forced failure") +bad_grad <- function(par) stop("forced gradient failure") + +# Pre-define a matchCall value to avoid match.call() errors inside test wrappers +fake_call <- call("drmOpt") + +# ============================================================ +# 1. No derivatives, unconstrained, success (happy path) +# ============================================================ +test_that("no derivatives, unconstrained, success", { + res <- drc:::drmOpt( + opfct = quad_obj, + opdfct1 = NULL, + startVec = c(0, 0), + optMethod = "Nelder-Mead", + constrained = FALSE, + warnVal = 0, + upperLimits = NULL, + lowerLimits = NULL, + errorMessage = TRUE, + maxIt = 500, + relTol = 1e-8, + opdfct2 = NULL, + parmVec = c("a", "b"), + traceVal = 0, + silentVal = TRUE, + matchCall = fake_call + ) + expect_true(res$convergence) + expect_true(!is.null(res$hessian)) + expect_equal(res$par, c(3, 1), tolerance = 1e-3) + # ovalue is the raw optim value; value is recomputed via opfct + expect_equal(res$value, quad_obj(res$par)) +}) + +# ============================================================ +# 2. No derivatives, constrained, success +# ============================================================ +test_that("no derivatives, constrained, success", { + res <- drc:::drmOpt( + opfct = quad_obj, + opdfct1 = NULL, + startVec = c(0, 0), + optMethod = "L-BFGS-B", + constrained = TRUE, + warnVal = 0, + upperLimits = c(10, 10), + lowerLimits = c(-10, -10), + errorMessage = TRUE, + maxIt = 500, + relTol = 1e-8, + opdfct2 = NULL, + parmVec = c("a", "b"), + traceVal = 0, + silentVal = TRUE, + matchCall = fake_call + ) + expect_true(res$convergence) + expect_equal(res$par, c(3, 1), tolerance = 1e-3) +}) + +# ============================================================ +# 3. No derivatives, convergence failure + errorMessage=TRUE → stop() +# ============================================================ +test_that("no derivatives, failure with errorMessage=TRUE throws stop()", { + expect_error( + drc:::drmOpt( + opfct = bad_obj, + opdfct1 = NULL, + startVec = c(0, 0), + optMethod = "Nelder-Mead", + constrained = FALSE, + warnVal = 0, + upperLimits = NULL, + lowerLimits = NULL, + errorMessage = TRUE, + maxIt = 10, + relTol = 1e-8, + opdfct2 = NULL, + parmVec = c("a", "b"), + traceVal = 0, + silentVal = TRUE, + matchCall = fake_call + ), + "Convergence failed" + ) +}) + +# ============================================================ +# 4. No derivatives, convergence failure + errorMessage=FALSE → warning +# ============================================================ +test_that("no derivatives, failure with errorMessage=FALSE gives warning", { + expect_warning( + { + res <- drc:::drmOpt( + opfct = bad_obj, + opdfct1 = NULL, + startVec = c(0, 0), + optMethod = "Nelder-Mead", + constrained = FALSE, + warnVal = 0, + upperLimits = NULL, + lowerLimits = NULL, + errorMessage = FALSE, + maxIt = 10, + relTol = 1e-8, + opdfct2 = NULL, + parmVec = c("a", "b"), + traceVal = 0, + silentVal = TRUE, + matchCall = fake_call + ) + }, + "Convergence failed" + ) + expect_false(res$convergence) + expect_equal(res$startVal, c(0, 0)) + expect_equal(res$parNames, c("a", "b")) +}) + +# ============================================================ +# 5. No derivatives, constrained, convergence failure + errorMessage=FALSE +# ============================================================ +test_that("no derivatives, constrained, failure with errorMessage=FALSE gives warning", { + expect_warning( + { + res <- drc:::drmOpt( + opfct = bad_obj, + opdfct1 = NULL, + startVec = c(0, 0), + optMethod = "L-BFGS-B", + constrained = TRUE, + warnVal = 0, + upperLimits = c(10, 10), + lowerLimits = c(-10, -10), + errorMessage = FALSE, + maxIt = 10, + relTol = 1e-8, + opdfct2 = NULL, + parmVec = c("a", "b"), + traceVal = 0, + silentVal = TRUE, + matchCall = fake_call + ) + }, + "Convergence failed" + ) + expect_false(res$convergence) +}) + +# ============================================================ +# 6. With derivatives, unconstrained, success (opdfct2=NULL → hes=TRUE) +# ============================================================ +test_that("with derivatives, unconstrained, success, hessian from optim", { + res <- drc:::drmOpt( + opfct = quad_obj, + opdfct1 = quad_grad, + startVec = c(0, 0), + optMethod = "BFGS", + constrained = FALSE, + warnVal = 0, + upperLimits = NULL, + lowerLimits = NULL, + errorMessage = TRUE, + maxIt = 500, + relTol = 1e-8, + opdfct2 = NULL, + parmVec = c("a", "b"), + traceVal = 0, + silentVal = TRUE, + matchCall = fake_call + ) + expect_true(res$convergence) + expect_equal(res$par, c(3, 1), tolerance = 1e-5) + expect_true(!is.null(res$hessian)) + expect_equal(res$value, quad_obj(res$par)) +}) + +# ============================================================ +# 7. With derivatives, constrained, success +# ============================================================ +test_that("with derivatives, constrained, success", { + res <- drc:::drmOpt( + opfct = quad_obj, + opdfct1 = quad_grad, + startVec = c(0, 0), + optMethod = "L-BFGS-B", + constrained = TRUE, + warnVal = 0, + upperLimits = c(10, 10), + lowerLimits = c(-10, -10), + errorMessage = TRUE, + maxIt = 500, + relTol = 1e-8, + opdfct2 = NULL, + parmVec = c("a", "b"), + traceVal = 0, + silentVal = TRUE, + matchCall = fake_call + ) + expect_true(res$convergence) + expect_equal(res$par, c(3, 1), tolerance = 1e-5) +}) + +# ============================================================ +# 8. With derivatives, unconstrained, success, opdfct2 provided (hes=FALSE) +# ============================================================ +test_that("with derivatives, opdfct2 provided, hessian computed externally", { + res <- drc:::drmOpt( + opfct = quad_obj, + opdfct1 = quad_grad, + startVec = c(0, 0), + optMethod = "BFGS", + constrained = FALSE, + warnVal = 0, + upperLimits = NULL, + lowerLimits = NULL, + errorMessage = TRUE, + maxIt = 500, + relTol = 1e-8, + opdfct2 = quad_hess, + parmVec = c("a", "b"), + traceVal = 0, + silentVal = TRUE, + matchCall = fake_call + ) + expect_true(res$convergence) + expect_equal(res$par, c(3, 1), tolerance = 1e-5) + # hessian should be from quad_hess, i.e. diag(2,2) + expect_equal(res$hessian, matrix(c(2, 0, 0, 2), 2, 2)) +}) + +# ============================================================ +# 9. With derivatives, convergence failure → warning + return +# ============================================================ +test_that("with derivatives, convergence failure gives warning", { + expect_warning( + { + res <- drc:::drmOpt( + opfct = bad_obj, + opdfct1 = bad_grad, + startVec = c(0, 0), + optMethod = "BFGS", + constrained = FALSE, + warnVal = 0, + upperLimits = NULL, + lowerLimits = NULL, + errorMessage = TRUE, + maxIt = 10, + relTol = 1e-8, + opdfct2 = NULL, + parmVec = c("a", "b"), + traceVal = 0, + silentVal = TRUE, + matchCall = fake_call + ) + }, + "Convergence failed" + ) + expect_false(res$convergence) + expect_equal(res$startVal, c(0, 0)) + expect_equal(res$parNames, c("a", "b")) +}) + +# ============================================================ +# 10. With derivatives, constrained, convergence failure +# ============================================================ +test_that("with derivatives, constrained, convergence failure gives warning", { + expect_warning( + { + res <- drc:::drmOpt( + opfct = bad_obj, + opdfct1 = bad_grad, + startVec = c(0, 0), + optMethod = "L-BFGS-B", + constrained = TRUE, + warnVal = 0, + upperLimits = c(10, 10), + lowerLimits = c(-10, -10), + errorMessage = TRUE, + maxIt = 10, + relTol = 1e-8, + opdfct2 = NULL, + parmVec = c("a", "b"), + traceVal = 0, + silentVal = TRUE, + matchCall = fake_call + ) + }, + "Convergence failed" + ) + expect_false(res$convergence) +}) + +# ============================================================ +# 11. Edge case: startVec with very small values (psVec clamping) +# ============================================================ +test_that("small startVec values are clamped in parscale", { + # Start with very small values — triggers psVec[psVec < 1e-4] <- 1 + res <- drc:::drmOpt( + opfct = quad_obj, + opdfct1 = NULL, + startVec = c(1e-6, 1e-6), + optMethod = "Nelder-Mead", + constrained = FALSE, + warnVal = 0, + upperLimits = NULL, + lowerLimits = NULL, + errorMessage = TRUE, + maxIt = 500, + relTol = 1e-8, + opdfct2 = NULL, + parmVec = c("a", "b"), + traceVal = 0, + silentVal = TRUE, + matchCall = fake_call + ) + expect_true(res$convergence) + expect_equal(res$par, c(3, 1), tolerance = 1e-2) +}) + +# ============================================================ +# 12. With derivatives, constrained, opdfct2 provided (hes=FALSE) +# ============================================================ +test_that("with derivatives, constrained, opdfct2 provided", { + res <- drc:::drmOpt( + opfct = quad_obj, + opdfct1 = quad_grad, + startVec = c(0, 0), + optMethod = "L-BFGS-B", + constrained = TRUE, + warnVal = 0, + upperLimits = c(10, 10), + lowerLimits = c(-10, -10), + errorMessage = TRUE, + maxIt = 500, + relTol = 1e-8, + opdfct2 = quad_hess, + parmVec = c("a", "b"), + traceVal = 0, + silentVal = TRUE, + matchCall = fake_call + ) + expect_true(res$convergence) + expect_equal(res$par, c(3, 1), tolerance = 1e-5) + # Hessian should come from opdfct2 + expect_equal(res$hessian, matrix(c(2, 0, 0, 2), 2, 2)) +}) + +# ============================================================ +# 13. No derivatives, constrained, convergence failure + errorMessage=TRUE → stop +# ============================================================ +test_that("no derivatives, constrained, failure with errorMessage=TRUE throws stop()", { + expect_error( + drc:::drmOpt( + opfct = bad_obj, + opdfct1 = NULL, + startVec = c(0, 0), + optMethod = "L-BFGS-B", + constrained = TRUE, + warnVal = 0, + upperLimits = c(10, 10), + lowerLimits = c(-10, -10), + errorMessage = TRUE, + maxIt = 10, + relTol = 1e-8, + opdfct2 = NULL, + parmVec = c("a", "b"), + traceVal = 0, + silentVal = TRUE, + matchCall = fake_call + ), + "Convergence failed" + ) +}) diff --git a/tests/testthat/test-fct2list.R b/tests/testthat/test-fct2list.R new file mode 100644 index 00000000..5a6bf242 --- /dev/null +++ b/tests/testthat/test-fct2list.R @@ -0,0 +1,227 @@ +# Tests for fct2list.R: vec2mat, nParm, fParm, fct2list + +# ============================================================================= +# Helper: define simple test functions +# ============================================================================= + +# A simple 2-parameter function using vector indexing +simple_2p <- function(x, b) { + b[1] + b[2] * x +} + +# A 3-parameter function using vector indexing +simple_3p <- function(x, b) { + b[1] + b[2] * x + b[3] * x^2 +} + +# A 4-parameter log-logistic function using vector indexing +ll4_raw <- function(dose, b) { + b[2] + (b[3] - b[2]) / (1 + exp(b[1] * (log(dose) - log(b[4])))) +} + +# A single-line function (no braces in body) +single_line_fct <- function(x, b) b[1] + b[2] * x + +# ============================================================================= +# Tests for vec2mat() +# ============================================================================= + +test_that("vec2mat converts vector indexing to matrix indexing for a 2-param function", { + result <- drc:::vec2mat(simple_2p, 2) + + # Returns a list of length 3 + + expect_type(result, "list") + expect_length(result, 3) + + # First element is a function + + expect_true(is.function(result[[1]])) + + # Second element is a character string (body text) + expect_type(result[[2]], "character") + + # Third element is the parameter name + expect_equal(result[[3]], "b") + + # The body string should contain matrix-style indexing [, + expect_true(grepl("\\[,", result[[2]])) +}) + +test_that("vec2mat works with a 3-param function", { + result <- drc:::vec2mat(simple_3p, 2) + + expect_type(result, "list") + expect_length(result, 3) + expect_true(is.function(result[[1]])) + expect_equal(result[[3]], "b") + expect_true(grepl("\\[,", result[[2]])) +}) + +test_that("vec2mat works with a 4-param log-logistic function", { + result <- drc:::vec2mat(ll4_raw, 2) + + expect_type(result, "list") + expect_length(result, 3) + expect_true(is.function(result[[1]])) + expect_equal(result[[3]], "b") +}) + +test_that("vec2mat works with a single-line (no braces) function body", { + result <- drc:::vec2mat(single_line_fct, 2) + + expect_type(result, "list") + expect_length(result, 3) + expect_true(is.function(result[[1]])) + expect_equal(result[[3]], "b") +}) + +test_that("vec2mat errors when argument number does not exist", { + expect_error( + drc:::vec2mat(simple_2p, 5), + "Argument number does not exist" + ) +}) + +test_that("vec2mat works with first argument index", { + f <- function(a, b) a[1] + a[2] * b + result <- drc:::vec2mat(f, 1) + + expect_type(result, "list") + expect_equal(result[[3]], "a") + expect_true(grepl("\\[,", result[[2]])) +}) + +# ============================================================================= +# Tests for nParm() +# ============================================================================= + +test_that("nParm counts 2 unique parameters correctly", { + # vec2mat result for 2-param function + v2m <- drc:::vec2mat(simple_2p, 2) + result <- drc:::nParm(v2m[[2]]) + expect_equal(result, 2) +}) + +test_that("nParm counts 3 unique parameters correctly", { + v2m <- drc:::vec2mat(simple_3p, 2) + result <- drc:::nParm(v2m[[2]]) + expect_equal(result, 3) +}) + +test_that("nParm counts 4 unique parameters correctly", { + v2m <- drc:::vec2mat(ll4_raw, 2) + result <- drc:::nParm(v2m[[2]]) + expect_equal(result, 4) +}) + +# ============================================================================= +# Tests for fParm() +# ============================================================================= + +test_that("fParm returns the vec2mat function when all fixed are NA", { + # When all elements of fixed are NA, fParm returns v2m[[1]] early + fixed_all_na <- c(NA, NA) + result <- drc:::fParm(simple_2p, 2, fixed_all_na) + + expect_true(is.function(result)) +}) + +test_that("fParm fixes one parameter and frees another", { + # Fix b[1] = 5, let b[2] be free + fixed <- c(5, NA) + result <- drc:::fParm(simple_2p, 2, fixed) + + expect_true(is.function(result)) +}) + +test_that("fParm fixes all parameters", { + # Fix both parameters + fixed <- c(5, 3) + result <- drc:::fParm(simple_2p, 2, fixed) + + expect_true(is.function(result)) +}) + +test_that("fParm works with 3-param function fixing one parameter", { + # Fix b[2] = 10, leave b[1] and b[3] free + fixed <- c(NA, 10, NA) + result <- drc:::fParm(simple_3p, 2, fixed) + + expect_true(is.function(result)) +}) + +test_that("fParm works with 4-param function fixing multiple parameters", { + # Fix b[1] = 1, b[3] = 100, free b[2] and b[4] + fixed <- c(1, NA, 100, NA) + result <- drc:::fParm(ll4_raw, 2, fixed) + + expect_true(is.function(result)) +}) + +test_that("fParm handles renumbering when parameter count changes digit length", { + # Create a function with many parameters (>= 10) to trigger the digit-count branch + # This tests lines 106-112 where nchar(inStr3) < nchar(as.character(numVec[i])) + many_params_fct <- function(x, b) { + b[1] + b[2] * x + b[3] * x^2 + b[4] * x^3 + b[5] * x^4 + + b[6] * x^5 + b[7] * x^6 + b[8] * x^7 + b[9] * x^8 + b[10] * x^9 + } + # Fix parameters 1-9, leave parameter 10 free + # This means parameter 10 gets renumbered to 1 (nchar("1") < nchar("10")) + fixed <- c(1, 2, 3, 4, 5, 6, 7, 8, 9, NA) + result <- drc:::fParm(many_params_fct, 2, fixed) + expect_true(is.function(result)) +}) + +# ============================================================================= +# Tests for fct2list() +# ============================================================================= + +test_that("fct2list returns a proper list for a 2-param function", { + result <- drc:::fct2list(simple_2p, 2) + + expect_type(result, "list") + expect_length(result, 3) + + # First element is a function + expect_true(is.function(result[[1]])) + + # Second element is NULL + expect_null(result[[2]]) + + # Third element is parameter names as letters + expect_equal(result[[3]], c("a", "b")) +}) + +test_that("fct2list returns correct parameter names for a 3-param function", { + result <- drc:::fct2list(simple_3p, 2) + + expect_equal(result[[3]], c("a", "b", "c")) + expect_null(result[[2]]) + expect_true(is.function(result[[1]])) +}) + +test_that("fct2list returns correct parameter names for a 4-param function", { + result <- drc:::fct2list(ll4_raw, 2) + + expect_equal(result[[3]], c("a", "b", "c", "d")) + expect_null(result[[2]]) + expect_true(is.function(result[[1]])) +}) + +test_that("fct2list works with single-line function", { + result <- drc:::fct2list(single_line_fct, 2) + + expect_type(result, "list") + expect_length(result, 3) + expect_true(is.function(result[[1]])) + expect_null(result[[2]]) + expect_equal(result[[3]], c("a", "b")) +}) + +test_that("fct2list errors when argument number is invalid", { + expect_error( + drc:::fct2list(simple_2p, 10), + "Argument number does not exist" + ) +}) diff --git a/tests/testthat/test-findbe.R b/tests/testthat/test-findbe.R new file mode 100644 index 00000000..c815fad5 --- /dev/null +++ b/tests/testthat/test-findbe.R @@ -0,0 +1,333 @@ +# Test file for findbe.R functions (findbe1, findbe2, findbe3) +# These are internal helper functions for finding initial b and e parameter estimates + +# ============================================================================== +# Common helper functions (mirroring those used in self-starter functions) +# ============================================================================== + +ytrans <- function(y, cVal, dVal) { log((dVal - y) / (y - cVal)) } +bfct_helper <- function(x, y, cVal, dVal, eVal) { ytrans(y, cVal, dVal) / log(x / eVal) } +efct_helper <- function(x, y, bVal, cVal, dVal) { x * exp(-ytrans(y, cVal, dVal) / bVal) } +doseTr_log <- function(x) { rVec <- log(x); rVec[!x > 0] <- NA; rVec } + +# ============================================================================== +# Tests for findbe1 +# ============================================================================== + +test_that("findbe1 returns a closure", { + fn <- drc:::findbe1(doseTr_log, ytrans) + expect_type(fn, "closure") + expect_true(is.function(fn)) +}) + +test_that("findbe1 returns correct estimates with standard decreasing data", { + fn <- drc:::findbe1(doseTr_log, ytrans) + + x <- c(0.1, 0.5, 1, 2, 5, 10, 50, 100) + y <- c(0.95, 0.85, 0.75, 0.55, 0.25, 0.1, 0.03, 0.01) + cVal <- 0 + dVal <- 1 + + result <- fn(x, y, cVal, dVal) + + expect_type(result, "double") + expect_length(result, 2) + expect_true(all(is.finite(result))) + # b should be positive for decreasing response + expect_true(result[1] > 0) + # e should be positive + expect_true(result[2] > 0) +}) + +test_that("findbe1 works with sgnb = -1", { + fn <- drc:::findbe1(doseTr_log, ytrans, sgnb = -1) + + x <- c(0.1, 0.5, 1, 2, 5, 10, 50, 100) + y <- c(0.95, 0.85, 0.75, 0.55, 0.25, 0.1, 0.03, 0.01) + cVal <- 0 + dVal <- 1 + + result <- fn(x, y, cVal, dVal) + + expect_type(result, "double") + expect_length(result, 2) +}) + +test_that("findbe1 works with custom back function", { + fn <- drc:::findbe1(doseTr_log, ytrans, back = function(x) 10^x) + + x <- c(0.1, 0.5, 1, 2, 5, 10, 50, 100) + y <- c(0.95, 0.85, 0.75, 0.55, 0.25, 0.1, 0.03, 0.01) + cVal <- 0 + dVal <- 1 + + result <- fn(x, y, cVal, dVal) + + expect_type(result, "double") + expect_length(result, 2) +}) + +# ============================================================================== +# Tests for findbe2 - Anke method +# ============================================================================== + +test_that("findbe2 Anke returns a closure", { + fn <- drc:::findbe2(bfct_helper, efct_helper, "Anke") + expect_type(fn, "closure") + expect_true(is.function(fn)) +}) + +test_that("findbe2 Anke returns valid estimates with standard data", { + fn <- drc:::findbe2(bfct_helper, efct_helper, "Anke") + + x <- c(0.1, 0.5, 1, 2, 5, 10, 50, 100) + y <- c(0.95, 0.85, 0.7, 0.55, 0.25, 0.1, 0.03, 0.01) + cVal <- 0 + dVal <- 1 + + result <- fn(x, y, cVal, dVal) + + expect_type(result, "double") + expect_length(result, 2) +}) + +test_that("findbe2 Anke: mixed responses at dose triggers aboveVec trim (line 51)", { + fn <- drc:::findbe2(bfct_helper, efct_helper, "Anke") + + # At dose=2, one response above midResp (0.6) and one below (0.3) + # This triggers: length(aboveVec) < sum(x %in% uniAbove) on line 49 + x <- c(0.1, 0.5, 1, 2, 2, 5, 10, 50) + y <- c(0.95, 0.85, 0.7, 0.6, 0.3, 0.2, 0.05, 0.01) + cVal <- 0 + dVal <- 1 + + result <- fn(x, y, cVal, dVal) + + expect_type(result, "double") + expect_length(result, 2) +}) + +test_that("findbe2 Anke: mixed responses triggers belowVec trim (line 62)", { + fn <- drc:::findbe2(bfct_helper, efct_helper, "Anke") + + # At dose=5, one response above midResp (0.6) and one below (0.3) + # This triggers: length(belowVec) < sum(x %in% uniBelow) on line 59 + x <- c(0.1, 0.5, 1, 5, 5, 10, 50, 100) + y <- c(0.95, 0.85, 0.7, 0.6, 0.3, 0.1, 0.03, 0.01) + cVal <- 0 + dVal <- 1 + + result <- fn(x, y, cVal, dVal) + + expect_type(result, "double") + expect_length(result, 2) +}) + +test_that("findbe2 Anke: NaN eVal fallback when no doses between max and min (line 69-71)", { + fn <- drc:::findbe2(bfct_helper, efct_helper, "Anke") + + # Adjacent dose levels with all responses above/below midResp + # subsetInd = (x > maxDose) & (x < minDose) is all FALSE + x <- c(1, 2, 3, 4) + y <- c(0.9, 0.7, 0.3, 0.1) + cVal <- 0 + dVal <- 1 + + result <- fn(x, y, cVal, dVal) + + expect_type(result, "double") + expect_length(result, 2) + expect_true(all(is.finite(result))) +}) + +test_that("findbe2 Anke: eVal < sort1 triggers correction (line 74-76)", { + fn <- drc:::findbe2(bfct_helper, efct_helper, "Anke") + + # maxDose=1, minDose=3 → eVal=(3+1)/2=2 but sort1=3 + # Actually need (NaN fallback) eVal < sort1 + x <- c(1, 3, 5, 7) + y <- c(0.6, 0.3, 0.1, 0.01) + cVal <- 0 + dVal <- 1 + # midResp = 0.5, aboveVec = c(1), maxDose = 1 + # belowVec = c(3, 5, 7), minDose = 3 + # subsetInd: no x between 1 and 3 → NaN + # eVal = (3+1)/2 = 2, sort1 = 3 → eVal < sort1 → eVal = 3 + + result <- fn(x, y, cVal, dVal) + + expect_type(result, "double") + expect_length(result, 2) +}) + +test_that("findbe2 Anke: eVal > sort2 triggers correction (line 79-81)", { + fn <- drc:::findbe2(bfct_helper, efct_helper, "Anke") + + # maxDose=5, minDose=7 → eVal=(7+5)/2=6 but sort2=5 + x <- c(1, 3, 5, 7) + y <- c(0.95, 0.7, 0.6, 0.1) + cVal <- 0 + dVal <- 1 + # midResp = 0.5, aboveVec = c(1,3,5), maxDose = 5 + # belowVec = c(7), minDose = 7 + # subsetInd: no x between 5 and 7 → NaN + # eVal = (7+5)/2 = 6, sort2 = 5 → eVal > sort2 → eVal = 5 + + result <- fn(x, y, cVal, dVal) + + expect_type(result, "double") + expect_length(result, 2) +}) + +test_that("findbe2 Anke: sign correction triggers with sgnb=-1 (line 92-98)", { + fn <- drc:::findbe2(bfct_helper, efct_helper, "Anke", sgnb = -1) + + # Standard decreasing data: regSlope < 0, bVal > 0 initially + # sgnb*regSlope/bVal = (-1)*(neg)/(pos) = pos > 0 → triggers correction + x <- c(0.1, 0.5, 1, 2, 5, 10, 50, 100) + y <- c(0.95, 0.85, 0.7, 0.55, 0.25, 0.1, 0.03, 0.01) + cVal <- 0 + dVal <- 1 + + result <- fn(x, y, cVal, dVal) + + expect_type(result, "double") + expect_length(result, 2) +}) + +test_that("findbe2 Anke: NaN bVal triggers fallback to regSlope (line 99-102)", { + fn <- drc:::findbe2(bfct_helper, efct_helper, "Anke") + + # y values outside [cVal, dVal] make all ytrans = NaN + # so bFct returns NaN (treated as NA) + x <- c(1, 2, 3, 4, 5) + y <- c(1.5, 1.3, 1.1, -0.1, -0.3) + cVal <- 0 + dVal <- 1 + + result <- fn(x, y, cVal, dVal) + + expect_type(result, "double") + expect_length(result, 2) + # bVal should be from the fallback: sgnb * (-regSlope) + expect_true(is.finite(result[1])) +}) + +# ============================================================================== +# Tests for findbe2 - Normolle method +# ============================================================================== + +test_that("findbe2 Normolle returns a closure", { + fn <- drc:::findbe2(bfct_helper, efct_helper, "Normolle") + expect_type(fn, "closure") + expect_true(is.function(fn)) +}) + +test_that("findbe2 Normolle returns valid estimates with standard data", { + fn <- drc:::findbe2(bfct_helper, efct_helper, "Normolle") + + x <- c(0.1, 0.5, 1, 2, 5, 10, 50, 100) + y <- c(0.95, 0.85, 0.7, 0.55, 0.25, 0.1, 0.03, 0.01) + cVal <- 0 + dVal <- 1 + + result <- fn(x, y, cVal, dVal) + + expect_type(result, "double") + expect_length(result, 2) +}) + +test_that("findbe2 Normolle works with sgnb = -1", { + fn <- drc:::findbe2(bfct_helper, efct_helper, "Normolle", sgnb = -1) + + x <- c(0.1, 0.5, 1, 2, 5, 10, 50, 100) + y <- c(0.95, 0.85, 0.7, 0.55, 0.25, 0.1, 0.03, 0.01) + cVal <- 0 + dVal <- 1 + + result <- fn(x, y, cVal, dVal) + + expect_type(result, "double") + expect_length(result, 2) +}) + +# ============================================================================== +# Tests for findbe3 +# ============================================================================== + +test_that("findbe3 returns a closure", { + fn <- drc:::findbe3() + expect_type(fn, "closure") + expect_true(is.function(fn)) +}) + +test_that("findbe3 returns valid estimates with decreasing response (crit2 path)", { + fn <- drc:::findbe3() + + # Crossing at i=4: uniy[4]=0.3 < 0.5, uniy[3]=0.6 > 0.5 → crit2 TRUE + x <- c(1, 2, 3, 4, 5) + y <- c(0.95, 0.8, 0.6, 0.3, 0.1) + cVal <- 0 + dVal <- 1 + + result <- fn(x, y, cVal, dVal) + + expect_type(result, "double") + expect_length(result, 2) + expect_true(all(is.finite(result))) + # For decreasing: bVal should be positive with sgnb=1 + expect_equal(result[1], 1) + # eVal should be (unix[4]+unix[3])/2 = 3.5 + expect_equal(result[2], 3.5) +}) + +test_that("findbe3 returns valid estimates with increasing response (crit1 path)", { + fn <- drc:::findbe3() + + # Crossing at i=3: uniy[3]=0.6 > 0.5, uniy[2]=0.3 < 0.5 → crit1 TRUE + x <- c(1, 2, 3, 4, 5) + y <- c(0.1, 0.3, 0.6, 0.8, 0.95) + cVal <- 0 + dVal <- 1 + + result <- fn(x, y, cVal, dVal) + + expect_type(result, "double") + expect_length(result, 2) + expect_true(all(is.finite(result))) + # For increasing: bVal should be negative with sgnb=1 (sign of -(uniy[j]-uniy[j-1])) + expect_equal(result[1], -1) + # eVal should be (unix[3]+unix[2])/2 = 2.5 + expect_equal(result[2], 2.5) +}) + +test_that("findbe3 works with sgnb = -1", { + fn <- drc:::findbe3(sgnb = -1) + + x <- c(1, 2, 3, 4, 5) + y <- c(0.95, 0.8, 0.6, 0.3, 0.1) + cVal <- 0 + dVal <- 1 + + result <- fn(x, y, cVal, dVal) + + expect_type(result, "double") + expect_length(result, 2) + # With sgnb=-1, bVal sign flips + expect_equal(result[1], -1) +}) + +test_that("findbe3 works with replicated doses", { + fn <- drc:::findbe3() + + x <- c(1, 1, 2, 2, 3, 3, 4, 4, 5, 5) + y <- c(0.95, 0.9, 0.85, 0.75, 0.6, 0.55, 0.3, 0.25, 0.1, 0.05) + cVal <- 0 + dVal <- 1 + + result <- fn(x, y, cVal, dVal) + + expect_type(result, "double") + expect_length(result, 2) + expect_true(all(is.finite(result))) +}) diff --git a/tests/testthat/test-fitted-residuals.R b/tests/testthat/test-fitted-residuals.R new file mode 100644 index 00000000..8e430274 --- /dev/null +++ b/tests/testthat/test-fitted-residuals.R @@ -0,0 +1,331 @@ +# Test fitted.drc() and residuals.drc() functions + +# Create test datasets +ryegrass <- data.frame( + rootl = c( + 7.58, 8.00, 8.33, 7.25, 7.17, 7.00, 7.17, 7.83, 7.92, 7.58, + 6.17, 5.75, 5.83, 6.00, 5.83, 4.92, 4.50, 4.17, 4.42, 4.00, + 2.67, 2.08, 2.42, 2.50, 2.25, 1.17, 0.75, 0.92, 1.00, 0.58 + ), + conc = c( + rep(0, 5), rep(0.94, 5), rep(1.88, 5), + rep(3.75, 5), rep(7.50, 5), rep(15, 5) + ) +) + +set.seed(42) +multi_data <- data.frame( + dose = rep(c(0, 0.5, 1, 2, 5, 10), each = 5, times = 2), + resp = c( + rnorm(5, 100, 5), rnorm(5, 95, 5), rnorm(5, 85, 5), + rnorm(5, 60, 5), rnorm(5, 20, 5), rnorm(5, 5, 5), + rnorm(5, 100, 5), rnorm(5, 90, 5), rnorm(5, 70, 5), + rnorm(5, 40, 5), rnorm(5, 10, 5), rnorm(5, 3, 5) + ), + group = rep(c("A", "B"), each = 30) +) + +# Tests for fitted.drc() + +test_that("fitted.drc returns fitted values", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + fitted_vals <- fitted(m1) + + expect_true(is.numeric(fitted_vals)) + expect_equal(length(fitted_vals), nrow(ryegrass)) +}) + +test_that("fitted.drc returns same as predict with no newdata", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + fitted_vals <- fitted(m1) + predicted_vals <- predict(m1) + + expect_equal(fitted_vals, predicted_vals) +}) + +test_that("fitted.drc works with multi-curve models", { + m_multi <- drm(resp ~ dose, curveid = group, data = multi_data, fct = LL.4()) + fitted_vals <- fitted(m_multi) + + expect_equal(length(fitted_vals), nrow(multi_data)) + expect_true(all(is.finite(fitted_vals))) +}) + +test_that("fitted.drc values are within reasonable range", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + fitted_vals <- fitted(m1) + + # Fitted values should be within the range of observed data + expect_true(all(fitted_vals >= min(ryegrass$rootl) - 2)) + expect_true(all(fitted_vals <= max(ryegrass$rootl) + 2)) +}) + +test_that("fitted.drc passes additional arguments to predict", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Pass se.fit argument + result <- fitted(m1, se.fit = TRUE) + + expect_true(is.matrix(result)) + expect_equal(ncol(result), 2) +}) + +# Tests for residuals.drc() + +test_that("residuals.drc returns working residuals by default", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + resids <- residuals(m1) + + expect_true(is.numeric(resids)) + expect_equal(length(resids), nrow(ryegrass)) +}) + +test_that("residuals.drc working residuals sum to near zero", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + resids <- residuals(m1, typeRes = "working") + + # For models with intercept, sum of residuals should be near zero + expect_true(abs(sum(resids)) < 1) +}) + +test_that("residuals.drc fitted + residuals equals observed", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + fitted_vals <- fitted(m1) + resids <- residuals(m1, typeRes = "working") + reconstructed <- fitted_vals + resids + + expect_equal(reconstructed, ryegrass$rootl, tolerance = 1e-10) +}) + +test_that("residuals.drc returns standardised residuals", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + resids_std <- residuals(m1, typeRes = "standardised") + + expect_true(is.numeric(resids_std)) + expect_equal(length(resids_std), nrow(ryegrass)) +}) + +test_that("residuals.drc standardised residuals have unit variance approx", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + resids_std <- residuals(m1, typeRes = "standardised") + + # Standardised residuals should have approximately unit variance + expect_true(abs(var(resids_std) - 1) < 0.5) +}) + +test_that("residuals.drc returns studentised residuals", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + resids_stud <- residuals(m1, typeRes = "studentised") + + expect_true(is.numeric(resids_stud)) + expect_equal(length(resids_stud), nrow(ryegrass)) +}) + +test_that("residuals.drc studentised residuals account for leverage", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + resids_std <- residuals(m1, typeRes = "standardised") + resids_stud <- residuals(m1, typeRes = "studentised") + + # Studentised residuals should generally have larger absolute values + # (accounting for leverage), but not always + expect_equal(length(resids_std), length(resids_stud)) + expect_false(identical(resids_std, resids_stud)) +}) + +test_that("residuals.drc errors for studentised without derivative matrix", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + m1$deriv1 <- NULL + + expect_error(residuals(m1, typeRes = "studentised"), + "Studentised residuals not available") +}) + +test_that("residuals.drc with trScale handles Box-Cox transformation", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4(), bcVal = 0) # log transform + resids_tr <- residuals(m1, trScale = TRUE) + resids_no_tr <- residuals(m1, trScale = FALSE) + + expect_equal(length(resids_tr), nrow(ryegrass)) + expect_equal(length(resids_no_tr), nrow(ryegrass)) + # With Box-Cox, residuals on different scales should differ + expect_false(isTRUE(all.equal(resids_tr, resids_no_tr))) +}) + +test_that("residuals.drc with no Box-Cox ignores trScale", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + resids_tr <- residuals(m1, trScale = TRUE) + resids_no_tr <- residuals(m1, trScale = FALSE) + + # Without Box-Cox, both should be the same + expect_equal(resids_tr, resids_no_tr) +}) + +# Tests with multi-curve models + +test_that("residuals.drc works with multi-curve models", { + m_multi <- drm(resp ~ dose, curveid = group, data = multi_data, fct = LL.4()) + resids <- residuals(m_multi) + + expect_equal(length(resids), nrow(multi_data)) +}) + +test_that("residuals.drc multi-curve fitted + residuals equals observed", { + m_multi <- drm(resp ~ dose, curveid = group, data = multi_data, fct = LL.4()) + + fitted_vals <- fitted(m_multi) + resids <- residuals(m_multi) + reconstructed <- fitted_vals + resids + + expect_equal(reconstructed, multi_data$resp, tolerance = 1e-10) +}) + +# Tests with different model types + +test_that("residuals.drc works with binomial type data", { + binom_data <- data.frame( + dose = c(0, 0.1, 0.5, 1, 2, 5, 10), + resp = c(0, 0.05, 0.15, 0.35, 0.65, 0.90, 0.98), + n = rep(50, 7) + ) + m_binom <- drm(resp ~ dose, data = binom_data, fct = LL.2(), type = "binomial", weights = n) + resids <- residuals(m_binom) + + expect_equal(length(resids), 7) + expect_true(all(is.finite(resids))) +}) + +test_that("residuals.drc handles binomial without standardisation", { + binom_data <- data.frame( + dose = c(0, 0.1, 0.5, 1, 2, 5, 10), + resp = c(0, 0.05, 0.15, 0.35, 0.65, 0.90, 0.98), + n = rep(50, 7) + ) + m_binom <- drm(resp ~ dose, data = binom_data, fct = LL.2(), type = "binomial", weights = n) + + # May return working residuals with a message for binomial + expect_no_error(resids <- residuals(m_binom, typeRes = "standardised")) +}) + +test_that("residuals.drc works with Poisson type data", { + poisson_data <- data.frame( + dose = c(0, 1, 2, 4, 8, 16, 32), + count = c(50, 48, 40, 25, 10, 3, 1) + ) + m_poisson <- drm(count ~ dose, data = poisson_data, fct = LL.4(), type = "Poisson") + resids <- residuals(m_poisson) + + expect_equal(length(resids), 7) + expect_true(all(is.finite(resids))) +}) + +test_that("residuals.drc studentised for non-continuous handles NA scale", { + poisson_data <- data.frame( + dose = c(0, 1, 2, 4, 8, 16, 32), + count = c(50, 48, 40, 25, 10, 3, 1) + ) + m_poisson <- drm(count ~ dose, data = poisson_data, fct = LL.4(), type = "Poisson") + + # For non-continuous data, scale estimate might be NA + # Function should handle this gracefully + resids_stud <- residuals(m_poisson, typeRes = "studentised") + + expect_true(is.numeric(resids_stud)) + expect_equal(length(resids_stud), 7) +}) + +# Edge cases + +test_that("residuals.drc all three types return same length", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + resids_work <- residuals(m1, typeRes = "working") + resids_std <- residuals(m1, typeRes = "standardised") + resids_stud <- residuals(m1, typeRes = "studentised") + + expect_equal(length(resids_work), nrow(ryegrass)) + expect_equal(length(resids_std), nrow(ryegrass)) + expect_equal(length(resids_stud), nrow(ryegrass)) +}) + +test_that("residuals.drc types are ordered by variance adjustment", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + resids_work <- residuals(m1, typeRes = "working") + resids_std <- residuals(m1, typeRes = "standardised") + + # Standardised residuals should have similar scale but adjusted + var_work <- var(resids_work) + var_std <- var(resids_std) + + # Both should be finite and positive + expect_true(is.finite(var_work) && var_work > 0) + expect_true(is.finite(var_std) && var_std > 0) +}) + +# Integration tests + +test_that("residuals.drc residual plot data makes sense", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + fitted_vals <- fitted(m1) + resids <- residuals(m1) + + # Should be able to create residual plot without errors + expect_no_error({ + plot_data <- data.frame(fitted = fitted_vals, residuals = resids) + }) + + # No strong pattern in residuals (approximate check) + cor_val <- cor(fitted_vals, resids) + expect_true(abs(cor_val) < 0.5) # Weak correlation suggests good fit +}) + +test_that("residuals.drc no extreme outliers in standardised residuals", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + resids_std <- residuals(m1, typeRes = "standardised") + + # Most standardised residuals should be within ±3 + prop_within_3sd <- mean(abs(resids_std) < 3) + expect_true(prop_within_3sd > 0.95) +}) + +test_that("fitted and residuals are consistent across calls", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + fitted1 <- fitted(m1) + resids1 <- residuals(m1) + + fitted2 <- fitted(m1) + resids2 <- residuals(m1) + + expect_equal(fitted1, fitted2) + expect_equal(resids1, resids2) +}) + +test_that("residuals.drc typeRes argument validation", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Valid types should work + expect_no_error(residuals(m1, typeRes = "working")) + expect_no_error(residuals(m1, typeRes = "standardised")) + expect_no_error(residuals(m1, typeRes = "studentised")) + + # Invalid type should error + expect_error(residuals(m1, typeRes = "invalid")) +}) + +test_that("studentised residuals return NA for high-leverage points instead of NaN/Inf", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + resids <- residuals(m1, typeRes = "studentised") + + # Should be numeric and same length as data + expect_equal(length(resids), nrow(ryegrass)) + expect_true(is.numeric(resids)) + + # No NaN or Inf values should be present (high-leverage points should be NA) + expect_false(any(is.nan(resids))) + expect_false(any(is.infinite(resids))) +}) diff --git a/tests/testthat/test-fplogistic.R b/tests/testthat/test-fplogistic.R new file mode 100644 index 00000000..d91d2de8 --- /dev/null +++ b/tests/testthat/test-fplogistic.R @@ -0,0 +1,327 @@ +# Tests for fplogistic() and FPL.4() functions +# Fractional polynomial-logistic dose-response model + +# --- Helper data --- + +# Simple dose-response data for self-starter and model fitting tests +ryegrass <- data.frame( + rootl = c( + 7.58, 8.00, 8.33, 7.25, 7.17, 7.00, 7.17, 7.83, 7.92, 7.58, + 6.17, 5.75, 5.83, 6.00, 5.83, 4.92, 4.50, 4.17, 4.42, 4.00, + 2.67, 2.08, 2.42, 2.50, 2.25, 1.17, 0.75, 0.92, 1.00, 0.58 + ), + conc = c( + rep(0, 5), rep(0.94, 5), rep(1.88, 5), + rep(3.75, 5), rep(7.50, 5), rep(15, 5) + ) +) + +# =========================================================================== +# fplogistic() - Input validation +# =========================================================================== + +test_that("fplogistic errors on invalid 'names' argument", { + # Wrong length + +expect_error(fplogistic(-1, 1, names = c("a", "b")), + "Not correct 'names' argument") + # Not character + expect_error(fplogistic(-1, 1, names = c(1, 2, 3, 4)), + "Not correct 'names' argument") +}) + +test_that("fplogistic errors on invalid 'fixed' argument", { + expect_error(fplogistic(-1, 1, fixed = c(NA, NA)), + "Not correct 'fixed' argument") + expect_error(fplogistic(-1, 1, fixed = c(NA, NA, NA, NA, NA)), + "Not correct 'fixed' argument") +}) + +# =========================================================================== +# fplogistic() - Happy path construction (all parameters free) +# =========================================================================== + +test_that("fplogistic returns correct structure with default args", { + fp <- fplogistic(-1, 1) + + # Class and type +expect_s3_class(fp, "fp-logistic") + expect_type(fp, "list") + + # All expected components present + expected_names <- c("fct", "ssfct", "names", "deriv1", "deriv2", "derivx", + "edfct", "name", "text", "noParm", "fixed") + expect_true(all(expected_names %in% names(fp))) + + # Parameter names + expect_equal(fp$names, c("b", "c", "d", "e")) + expect_equal(fp$noParm, 4) + expect_equal(fp$fixed, c(NA, NA, NA, NA)) + + # Default name and text + expect_match(fp$name, "fplogistic\\(-1,1\\)") + expect_equal(fp$text, "Fractional polynomial") + + # deriv2 is always NULL + expect_null(fp$deriv2) +}) + +test_that("fplogistic accepts custom fctName and fctText", { + fp <- fplogistic(-1, 1, fctName = "myModel", fctText = "My description") + expect_equal(fp$name, "myModel") + expect_equal(fp$text, "My description") +}) + +test_that("fplogistic handles custom parameter names", { + fp <- fplogistic(-1, 1, names = c("slope", "lower", "upper", "scale")) + expect_equal(fp$names, c("slope", "lower", "upper", "scale")) +}) + +# =========================================================================== +# fplogistic() - Fixed parameters +# =========================================================================== + +test_that("fplogistic with fixed parameters reduces names and noParm", { + # Fix c=0 + fp <- fplogistic(-1, 1, fixed = c(NA, 0, NA, NA)) + expect_equal(fp$names, c("b", "d", "e")) + expect_equal(fp$noParm, 3) + + # Fix c=0 and d=100 + fp2 <- fplogistic(-1, 1, fixed = c(NA, 0, 100, NA)) + expect_equal(fp2$names, c("b", "e")) + expect_equal(fp2$noParm, 2) +}) + +# =========================================================================== +# fplogistic() - fct function (model evaluation) +# =========================================================================== + +test_that("fplogistic fct evaluates correctly", { + fp <- fplogistic(-1, 1) + + # parm must be a matrix with one row per curve + parm <- matrix(c(-1, 0, 100, 1), nrow = 1) + doses <- c(0, 1, 5, 10) + result <- fp$fct(doses, parm) + + # At dose=0: log(0+1)=0, exp(0)=1, c + (d-c)/2 = 50 ... wait + # Actually at dose=0: log(1)=0, 0^p1 is NaN for p1<0, but exp(b*NaN + e*NaN) is NaN + # So dose=0 may produce NaN. Let's just check dose > 0. + expect_length(result, 4) + expect_true(is.numeric(result)) + + # Gradient attribute should be present + grad <- attr(result, "gradient") + expect_true(!is.null(grad)) + expect_equal(dim(grad), c(4, 4)) +}) + +test_that("fplogistic fct with fixed parameters works", { + fp <- fplogistic(-1, 1, fixed = c(NA, 0, NA, NA)) + # parm has only 3 columns (b, d, e) + parm <- matrix(c(-1, 100, 1), nrow = 1) + doses <- c(1, 5, 10) + result <- fp$fct(doses, parm) + expect_length(result, 3) + expect_true(is.numeric(result)) +}) + +# =========================================================================== +# fplogistic() - ssfct (self-starter) +# =========================================================================== + +test_that("fplogistic default ssfct returns correct number of initial values", { + fp <- fplogistic(-1, 1) + dframe <- data.frame(dose = c(0, 0.5, 1, 2, 5, 10), + resp = c(100, 90, 75, 50, 20, 5)) + ssvals <- fp$ssfct(dframe) + + expect_length(ssvals, 4) # all 4 parameters free + expect_true(is.numeric(ssvals)) +}) + +test_that("fplogistic default ssfct respects fixed parameters", { + fp <- fplogistic(-1, 1, fixed = c(NA, 0, NA, NA)) + dframe <- data.frame(dose = c(0, 0.5, 1, 2, 5, 10), + resp = c(100, 90, 75, 50, 20, 5)) + ssvals <- fp$ssfct(dframe) + + expect_length(ssvals, 3) # only 3 free parameters +}) + +test_that("fplogistic with custom ssfct uses provided function", { + custom_ss <- function(dframe) { c(-1, 0, 100, 1) } + fp <- fplogistic(-1, 1, ssfct = custom_ss) + dframe <- data.frame(dose = c(0, 1, 5), resp = c(100, 50, 5)) + result <- fp$ssfct(dframe) + expect_equal(result, c(-1, 0, 100, 1)) +}) + +# =========================================================================== +# fplogistic() - deriv1 (parameter derivatives) +# =========================================================================== + +test_that("fplogistic deriv1 returns gradient matrix", { + fp <- fplogistic(-1, 1) + parm <- matrix(c(-1, 0, 100, 1), nrow = 1) + doses <- c(1, 5, 10) + d1 <- fp$deriv1(doses, parm) + + expect_true(is.matrix(d1) || is.numeric(d1)) + # Should have 3 rows (doses) x 4 cols (params) + expect_equal(nrow(d1), 3) + expect_equal(ncol(d1), 4) +}) + +test_that("fplogistic deriv1 with fixed parameters returns reduced cols", { + fp <- fplogistic(-1, 1, fixed = c(NA, 0, NA, NA)) + parm <- matrix(c(-1, 100, 1), nrow = 1) + doses <- c(1, 5, 10) + d1 <- fp$deriv1(doses, parm) + + expect_equal(ncol(d1), 3) # only free parameters +}) + +# =========================================================================== +# fplogistic() - derivx (dose derivative) +# =========================================================================== + +test_that("fplogistic derivx returns gradient in dose", { + fp <- fplogistic(-1, 1) + parm <- matrix(c(-1, 0, 100, 1), nrow = 1) + doses <- c(1, 5, 10) + dx <- fp$derivx(doses, parm) + + expect_true(is.matrix(dx) || is.numeric(dx)) + expect_equal(nrow(dx), 3) + expect_equal(ncol(dx), 1) +}) + +# =========================================================================== +# fplogistic() - edfct (effective dose calculation) +# =========================================================================== + +test_that("fplogistic edfct computes ED values for relative type", { + fp <- fplogistic(-1, 1) + parm <- c(-1, 0, 100, 1) + result <- fp$edfct(parm, 50, "control", "relative") + + expect_type(result, "list") + expect_length(result, 2) + # First element is ED estimate + expect_true(is.numeric(result[[1]])) + expect_true(result[[1]] > 0) + # Second element is derivative vector + expect_length(result[[2]], 4) +}) + +test_that("fplogistic edfct computes ED with absolute type", { + fp <- fplogistic(-1, 1) + parm <- c(-1, 0, 100, 1) + result <- fp$edfct(parm, 50, "control", "absolute") + + expect_type(result, "list") + expect_true(is.numeric(result[[1]])) + expect_true(result[[1]] > 0) +}) + +test_that("fplogistic edfct with loged=TRUE returns log-transformed ED", { + fp <- fplogistic(-1, 1) + parm <- c(-1, 0, 100, 1) + + result_nolog <- fp$edfct(parm, 50, "control", "relative", loged = FALSE) + result_log <- fp$edfct(parm, 50, "control", "relative", loged = TRUE) + + # Log-transformed ED should be log of non-transformed + expect_equal(result_log[[1]], log(result_nolog[[1]]), tolerance = 1e-6) + # Derivative should also be transformed + expect_true(all(is.numeric(result_log[[2]]))) +}) + +test_that("fplogistic edfct works with positive b (increasing curve)", { + fp <- fplogistic(-1, 1) + parm <- c(1, 0, 100, -1) # positive b + result <- fp$edfct(parm, 50, "control", "relative") + + expect_type(result, "list") + expect_true(is.numeric(result[[1]])) +}) + +test_that("fplogistic edfct with fixed parameters returns reduced deriv", { + fp <- fplogistic(-1, 1, fixed = c(NA, 0, NA, NA)) + parm <- c(-1, 100, 1) + result <- fp$edfct(parm, 50, "control", "relative") + + expect_length(result[[2]], 3) # only free parameters +}) + +# =========================================================================== +# fplogistic() - Integration with drm model fitting +# =========================================================================== + +test_that("fplogistic works with drm for model fitting", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = FPL.4(-1, 1)) + expect_s3_class(m1, "drc") + expect_length(coef(m1), 4) +}) + +test_that("fplogistic ED calculation works through drm", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = FPL.4(-1, 1)) + ed <- ED(m1, 50, display = FALSE) + expect_true(is.matrix(ed)) + expect_true(ed[1, 1] > 0) +}) + +# =========================================================================== +# fplogistic() - Different p1, p2 values +# =========================================================================== + +test_that("fplogistic works with various p1, p2 combinations", { + # Different power combinations + fp1 <- fplogistic(-2, 3) + expect_s3_class(fp1, "fp-logistic") + expect_match(fp1$name, "fplogistic\\(-2,3\\)") + + fp2 <- fplogistic(-0.5, 0.5) + expect_s3_class(fp2, "fp-logistic") + + # Check that fct evaluation works with these + parm <- matrix(c(-1, 0, 100, 1), nrow = 1) + doses <- c(1, 5) + r1 <- fp1$fct(doses, parm) + r2 <- fp2$fct(doses, parm) + expect_length(r1, 2) + expect_length(r2, 2) + # Different powers should give different results + expect_false(isTRUE(all.equal(r1, r2, check.attributes = FALSE))) +}) + +# =========================================================================== +# FPL.4() - Convenience wrapper +# =========================================================================== + +test_that("FPL.4 returns fp-logistic object", { + fp <- FPL.4(-1, 1) + expect_s3_class(fp, "fp-logistic") + expect_equal(fp$noParm, 4) + expect_match(fp$name, "FPL\\.4\\(-1,1\\)") +}) + +test_that("FPL.4 errors on invalid 'names' argument", { + expect_error(FPL.4(-1, 1, names = c("a", "b")), + "Not correct names argument") + expect_error(FPL.4(-1, 1, names = c(1, 2, 3, 4)), + "Not correct names argument") +}) + +test_that("FPL.4 errors on invalid 'fixed' argument", { + expect_error(FPL.4(-1, 1, fixed = c(NA, NA)), + "Not correct length of 'fixed' argument") +}) + +test_that("FPL.4 passes extra arguments to fplogistic", { + fp <- FPL.4(-1, 1, fixed = c(NA, 0, NA, NA)) + expect_equal(fp$noParm, 3) + expect_equal(fp$names, c("b", "d", "e")) +}) diff --git a/tests/testthat/test-gammadr.R b/tests/testthat/test-gammadr.R new file mode 100644 index 00000000..70aef417 --- /dev/null +++ b/tests/testthat/test-gammadr.R @@ -0,0 +1,328 @@ +# Tests for gammadr.R: gammadr() function + +# --- gammadr() main function --- + +test_that("gammadr returns correct class and structure", { + g <- gammadr() + + expect_s3_class(g, "gamma") + expect_true(is.list(g)) + expect_true(all(c("fct", "ssfct", "names", "deriv1", "deriv2", "derivx", + "edfct", "name", "text", "noParm") %in% names(g))) +}) + +test_that("gammadr default names are b, c, d, e", { + g <- gammadr() + expect_equal(g$names, c("b", "c", "d", "e")) +}) + +test_that("gammadr noParm reflects number of NA in fixed", { + g_full <- gammadr() + expect_equal(g_full$noParm, 4) + + g_partial <- gammadr(fixed = c(1, NA, NA, NA)) + expect_equal(g_partial$noParm, 3) + expect_equal(g_partial$names, c("c", "d", "e")) +}) + +test_that("gammadr uses default text when fctText not provided", { + g <- gammadr() + expect_equal(g$text, "Gamma") +}) + +test_that("gammadr uses provided fctText", { + g <- gammadr(fctText = "Custom text") + expect_equal(g$text, "Custom text") +}) + +test_that("gammadr uses provided fctName", { + g <- gammadr(fctName = "myFunc") + expect_equal(g$name, "myFunc") +}) + +test_that("gammadr uses default name when fctName not provided", { + g <- gammadr() + expect_equal(g$name, "gammadr") +}) + +# --- Error handling --- + +test_that("gammadr errors on invalid names argument - not character", { + expect_error(gammadr(names = c(1, 2, 3, 4)), "Not correct 'names' argument") +}) + +test_that("gammadr errors on invalid names argument - wrong length", { + expect_error(gammadr(names = c("a", "b")), "Not correct 'names' argument") +}) + +test_that("gammadr errors on invalid fixed argument - wrong length", { + expect_error(gammadr(fixed = c(NA, NA)), "Not correct 'fixed' argument") + expect_error(gammadr(fixed = c(NA, NA, NA)), "Not correct 'fixed' argument") +}) + +# --- deriv2 and edfct are NULL --- + +test_that("gammadr deriv2 is NULL", { + g <- gammadr() + expect_null(g$deriv2) +}) + +test_that("gammadr edfct is NULL", { + g <- gammadr() + expect_null(g$edfct) +}) + +# --- Fixed parameter variations --- + +test_that("gammadr works with all parameters fixed", { + g <- gammadr(fixed = c(1, 0, 1, 2)) + expect_equal(g$noParm, 0) + expect_length(g$names, 0) +}) + +test_that("gammadr works with only one parameter free", { + g <- gammadr(fixed = c(1, 0, 1, NA)) + expect_equal(g$noParm, 1) + expect_equal(g$names, "e") +}) + +test_that("gammadr works with partial fixed parameters in different positions", { + # Fix first and last + g1 <- gammadr(fixed = c(1, NA, NA, 2)) + expect_equal(g1$noParm, 2) + expect_equal(g1$names, c("c", "d")) + + # Fix middle parameters + g2 <- gammadr(fixed = c(NA, 0, 1, NA)) + expect_equal(g2$noParm, 2) + expect_equal(g2$names, c("b", "e")) +}) + +# --- fct (internal nonlinear function) --- + +test_that("gammadr fct computes correct values", { + g <- gammadr() + + # Parameters: b=1, c=0, d=1, e=2 + dose <- c(1, 2, 5) + parm <- matrix(c(1, 0, 1, 2), nrow = 3, ncol = 4, byrow = TRUE) + + result <- g$fct(dose, parm) + + # f(x) = c + (d - c) * pgamma(b * x, e, 1) + expected <- 0 + (1 - 0) * pgamma(1 * dose, 2, 1) + expect_equal(as.numeric(result), expected) +}) + +test_that("gammadr fct works with fixed parameters", { + g <- gammadr(fixed = c(1, 0, NA, NA)) + + dose <- c(1, 2, 5) + # Only 2 free parameters: d, e + parm <- matrix(c(1, 2), nrow = 3, ncol = 2, byrow = TRUE) + + result <- g$fct(dose, parm) + + # b=1 (fixed), c=0 (fixed), d=1, e=2 + expected <- 0 + (1 - 0) * pgamma(1 * dose, 2, 1) + expect_equal(as.numeric(result), expected) +}) + +test_that("gammadr fct handles dose = 0", { + g <- gammadr() + + dose <- c(0) + parm <- matrix(c(1, 0, 1, 2), nrow = 1, ncol = 4) + + result <- g$fct(dose, parm) + + # pgamma(0, ...) = 0, so f(0) = c = 0 + expect_equal(as.numeric(result), 0) +}) + +test_that("gammadr fct handles multiple rows in parm", { + g <- gammadr() + + dose <- c(1, 5, 10) + parm <- matrix(c(1, 0, 1, 2, + 1, 0, 1, 2, + 1, 0, 1, 2), + nrow = 3, byrow = TRUE) + + result <- g$fct(dose, parm) + expect_length(result, 3) + expect_true(all(is.finite(result))) +}) + +# --- deriv1 (parameter derivatives) --- + +test_that("gammadr deriv1 returns matrix with correct dimensions", { + g <- gammadr() + + dose <- c(1, 2, 5) + parm <- matrix(c(1, 0, 1, 2), nrow = 3, ncol = 4, byrow = TRUE) + + result <- g$deriv1(dose, parm) + + expect_true(is.matrix(result)) + expect_equal(nrow(result), 3) + expect_equal(ncol(result), 4) +}) + +test_that("gammadr deriv1 works with fixed parameters", { + g <- gammadr(fixed = c(1, NA, NA, NA)) + + dose <- c(1, 2, 5) + parm <- matrix(c(0, 1, 2), nrow = 3, ncol = 3, byrow = TRUE) + + result <- g$deriv1(dose, parm) + + expect_true(is.matrix(result)) + expect_equal(ncol(result), 3) +}) + +test_that("gammadr deriv1 computes finite values", { + g <- gammadr() + + dose <- c(0.5, 1, 3) + parm <- matrix(c(2, 0, 1, 3), nrow = 3, ncol = 4, byrow = TRUE) + + result <- g$deriv1(dose, parm) + + expect_true(all(is.finite(result))) +}) + +test_that("gammadr deriv1 computes correct df/db value", { + g <- gammadr() + + # b=1, c=0, d=1, e=3 + dose <- c(2) + parm <- matrix(c(1, 0, 1, 3), nrow = 1, ncol = 4) + + result <- g$deriv1(dose, parm) + + # df/db = (d-c) * dgamma(b*x, e, 1) * x (chain rule: d/db[b*x] = x) + expected_db <- (1 - 0) * dgamma(1 * 2, 3, 1) * 2 + expect_equal(unname(result[1]), expected_db, tolerance = 1e-10) +}) + +# --- logGamma helper (called via deriv1) --- + +test_that("gammadr deriv1 exercises logGamma with x < 1e-10 (zero dose)", { + + g <- gammadr() + + # dose = 0 means b * dose = 0, which is < 1e-10 + # This triggers the ifelse branch in logGamma: retVec[i] <- 0 + dose <- c(0) + parm <- matrix(c(1, 0, 1, 2), nrow = 1, ncol = 4) + + result <- g$deriv1(dose, parm) + + # Single row with all 4 params free drops to a vector + expect_type(result, "double") + expect_true(all(is.finite(result))) +}) + +test_that("gammadr deriv1 exercises logGamma with x >= 1e-10 (positive dose)", { + g <- gammadr() + + # dose > 0 and b > 0, so b*dose > 1e-10 + # This triggers the integrate branch in logGamma + dose <- c(5) + parm <- matrix(c(1, 0, 1, 2), nrow = 1, ncol = 4) + + result <- g$deriv1(dose, parm) + + # Single row with all 4 params free drops to a vector + expect_type(result, "double") + expect_true(all(is.finite(result))) +}) + +test_that("gammadr deriv1 exercises logGamma with both branches in one call", { + g <- gammadr() + + # Mix of dose=0 (x < 1e-10) and dose>0 (x >= 1e-10) + dose <- c(0, 5) + parm <- matrix(c(1, 0, 1, 2, + 1, 0, 1, 2), + nrow = 2, byrow = TRUE) + + result <- g$deriv1(dose, parm) + + expect_true(is.matrix(result)) + expect_equal(nrow(result), 2) + expect_true(all(is.finite(result))) +}) + +# --- derivx (dose derivative) --- + +test_that("gammadr derivx returns correct structure", { + g <- gammadr() + + dose <- c(1, 2, 5) + parm <- matrix(c(1, 0, 1, 2), nrow = 3, ncol = 4, byrow = TRUE) + + result <- g$derivx(dose, parm) + + expect_type(result, "double") + expect_length(result, 3) + expect_true(all(is.finite(result))) +}) + +test_that("gammadr derivx works with fixed parameters", { + g <- gammadr(fixed = c(1, 0, NA, NA)) + + dose <- c(1, 2, 5) + parm <- matrix(c(1, 2), nrow = 3, ncol = 2, byrow = TRUE) + + result <- g$derivx(dose, parm) + + expect_type(result, "double") + expect_length(result, 3) +}) + +test_that("gammadr derivx computes correct values", { + g <- gammadr() + + dose <- c(2) + # b=1, c=0, d=1, e=3 + parm <- matrix(c(1, 0, 1, 3), nrow = 1, ncol = 4) + + result <- g$derivx(dose, parm) + + # (d - c) * dgamma(b * x, e, 1) * b + expected <- (1 - 0) * dgamma(1 * 2, 3, 1) * 1 + expect_equal(as.numeric(result), expected) +}) + +# --- ssfct (self-starter function) --- + +test_that("gammadr ssfct returns initial values", { + g <- gammadr() + + dframe <- data.frame( + dose = c(0.1, 0.5, 1, 2, 5, 10), + response = c(0.1, 0.3, 0.5, 0.7, 0.9, 1.0) + ) + + init_vals <- g$ssfct(dframe) + + expect_type(init_vals, "double") + expect_length(init_vals, 4) + expect_true(all(is.finite(init_vals))) +}) + +test_that("gammadr ssfct respects fixed parameters", { + g <- gammadr(fixed = c(1, NA, NA, NA)) + + dframe <- data.frame( + dose = c(0.1, 0.5, 1, 2, 5, 10), + response = c(0.1, 0.3, 0.5, 0.7, 0.9, 1.0) + ) + + init_vals <- g$ssfct(dframe) + + expect_type(init_vals, "double") + expect_length(init_vals, 3) # Only 3 free parameters +}) diff --git a/tests/testthat/test-gaussian.R b/tests/testthat/test-gaussian.R new file mode 100644 index 00000000..5aac1c34 --- /dev/null +++ b/tests/testthat/test-gaussian.R @@ -0,0 +1,387 @@ +# Test file for gaussian function + +# Test basic functionality and correctness + +test_that("gaussian returns correct structure with default arguments", { + result <- gaussian() + + expect_s3_class(result, "gaussian") + expect_type(result, "list") + expect_true(all(c("fct", "ssfct", "names", "deriv1", "deriv2", "derivx", "edfct", + "name", "text", "noParm", "lowerAs", "upperAs", "monoton", "fixed") %in% names(result))) + expect_equal(result$noParm, 5) + expect_equal(result$names, c("b", "c", "d", "e", "f")) + expect_equal(result$name, "gaussian") + expect_equal(result$text, "Gaussian") + expect_null(result$deriv2) + expect_true(is.na(result$monoton)) +}) + +test_that("gaussian works with custom fctName and fctText", { + result <- gaussian(fctName = "custom_name", fctText = "custom text") + + expect_equal(result$name, "custom_name") + expect_equal(result$text, "custom text") +}) + +test_that("gaussian works with fixed parameters", { + result <- gaussian(fixed = c(1, NA, NA, NA, 1)) + + expect_equal(result$noParm, 3) + expect_equal(result$names, c("c", "d", "e")) +}) + +test_that("gaussian works with custom parameter names", { + custom_names <- c("scale", "lower", "upper", "loc", "shape") + result <- gaussian(names = custom_names) + + expect_equal(result$names, custom_names) +}) + +test_that("gaussian works with all parameters fixed", { + result <- gaussian(fixed = c(1, 0, 1, 5, 2)) + + expect_equal(result$noParm, 0) + expect_length(result$names, 0) +}) + +test_that("gaussian works with only one parameter free", { + result <- gaussian(fixed = c(1, 0, 1, 5, NA)) + + expect_equal(result$noParm, 1) + expect_equal(result$names, "f") +}) + +test_that("gaussian works with partial fixed parameters in different positions", { + # Fix first and last + result1 <- gaussian(fixed = c(1, NA, NA, NA, 1)) + expect_equal(result1$noParm, 3) + + # Fix middle parameters + result2 <- gaussian(fixed = c(NA, 0, 1, NA, NA)) + expect_equal(result2$noParm, 3) + + # Fix alternating parameters + result3 <- gaussian(fixed = c(NA, 0, NA, 5, NA)) + expect_equal(result3$noParm, 3) +}) + +test_that("gaussian method argument accepts different values", { + result1 <- gaussian(method = "1") + result2 <- gaussian(method = "2") + result3 <- gaussian(method = "3") + result4 <- gaussian(method = "4") + + expect_s3_class(result1, "gaussian") + expect_s3_class(result2, "gaussian") + expect_s3_class(result3, "gaussian") + expect_s3_class(result4, "gaussian") +}) + +test_that("gaussian works with custom ssfct", { + custom_ssfct <- function(dframe) { + return(c(1, 0, 1, 5, 1)) + } + + result <- gaussian(ssfct = custom_ssfct) + + dframe <- data.frame(dose = 1:5, response = 5:1) + init_vals <- result$ssfct(dframe) + + expect_equal(init_vals, c(1, 0, 1, 5, 1)) +}) + +# Test fct (dose-response function) + +test_that("gaussian fct evaluates correctly", { + result <- gaussian() + + # Test with known parameters: c + (d-c) * exp(-0.5 * abs((dose-e)/b)^f) + dose <- c(0, 5, 10) + # b=2, c=0, d=1, e=5, f=2 + parm <- matrix(c(2, 0, 1, 5, 2), nrow = 1) + + output <- result$fct(dose, parm) + + expect_type(output, "double") + expect_length(output, length(dose)) + expect_true(all(is.finite(output))) + + # At dose=e=5, exponent is 0, so output should be d=1 + expect_equal(as.numeric(output[2]), 1, tolerance = 1e-10) +}) + +test_that("gaussian fct handles multiple dose values with single parameter set", { + result <- gaussian() + + dose <- c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10) + parm <- matrix(c(2, 0, 1, 5, 2), nrow = 1) + + output <- result$fct(dose, parm) + + expect_length(output, 10) + expect_true(all(is.finite(output))) +}) + +test_that("gaussian fct works with matrix parm (multiple rows)", { + result <- gaussian() + + dose <- c(1, 5, 10) + parm <- matrix(c(2, 0, 1, 5, 2, + 2, 0, 1, 5, 2, + 2, 0, 1, 5, 2), + nrow = 3, byrow = TRUE) + + output <- result$fct(dose, parm) + + expect_type(output, "double") + expect_length(output, length(dose)) +}) + +test_that("gaussian fct works with fixed parameters", { + # Fix b=2 and f=2 + result <- gaussian(fixed = c(2, NA, NA, NA, 2)) + + dose <- c(0, 5, 10) + # Only 3 free parameters: c, d, e + parm <- matrix(c(0, 1, 5), nrow = 1) + + output <- result$fct(dose, parm) + + expect_type(output, "double") + expect_length(output, length(dose)) + expect_true(all(is.finite(output))) +}) + +test_that("gaussian fct handles edge case doses", { + result <- gaussian() + parm <- matrix(c(2, 0, 1, 5, 2), nrow = 1) + + # Very small dose + output_small <- result$fct(1e-10, parm) + expect_true(is.finite(output_small)) + + # Very large dose + output_large <- result$fct(1e10, parm) + expect_true(is.finite(output_large)) +}) + +# Test deriv1 (derivatives w.r.t. parameters) + +test_that("gaussian deriv1 evaluates correctly", { + result <- gaussian() + + # Avoid dose=e exactly (causes numerical singularity in gradient) + dose <- c(1, 4, 10) + parm <- matrix(c(2, 0, 1, 5, 2), nrow = 1) + + derivs <- result$deriv1(dose, parm) + + expect_true(is.matrix(derivs)) + expect_equal(nrow(derivs), length(dose)) + expect_equal(ncol(derivs), 5) + expect_true(all(is.finite(derivs))) +}) + +test_that("gaussian deriv1 works with fixed parameters", { + result <- gaussian(fixed = c(2, NA, NA, NA, 2)) + + dose <- c(1, 5, 10) + parm <- matrix(c(0, 1, 5), nrow = 1) + + derivs <- result$deriv1(dose, parm) + + expect_true(is.matrix(derivs)) + expect_equal(nrow(derivs), length(dose)) + expect_equal(ncol(derivs), 3) # Only 3 free parameters +}) + +test_that("gaussian deriv1 handles edge case doses", { + result <- gaussian() + parm <- matrix(c(2, 0, 1, 5, 2), nrow = 1) + + derivs_small <- result$deriv1(1e-10, parm) + expect_true(all(is.finite(derivs_small))) + + derivs_large <- result$deriv1(1e10, parm) + expect_true(all(is.finite(derivs_large))) +}) + +# Test derivx (derivative w.r.t. dose) + +test_that("gaussian derivx evaluates correctly", { + result <- gaussian() + + # Avoid dose=e exactly (causes numerical singularity in gradient) + dose <- c(1, 4, 10) + parm <- matrix(c(2, 0, 1, 5, 2), nrow = 1) + + derivx_result <- result$derivx(dose, parm) + + expect_true(is.matrix(derivx_result)) + expect_equal(nrow(derivx_result), length(dose)) + expect_equal(ncol(derivx_result), 1) + expect_true(all(is.finite(derivx_result))) +}) + +test_that("gaussian derivx works with fixed parameters", { + result <- gaussian(fixed = c(2, NA, NA, NA, 2)) + + dose <- c(1, 5, 10) + parm <- matrix(c(0, 1, 5), nrow = 1) + + derivx_result <- result$derivx(dose, parm) + + expect_true(is.matrix(derivx_result)) + expect_equal(nrow(derivx_result), length(dose)) +}) + +test_that("gaussian derivx near dose=e returns near-zero derivative", { + result <- gaussian() + + # Near dose=e, the Gaussian is near its peak, derivative is near 0 + # Avoid exact dose=e due to numerical singularity with f>1 + dose <- c(5.001) + parm <- matrix(c(2, 0, 1, 5, 2), nrow = 1) + + derivx_result <- result$derivx(dose, parm) + expect_equal(as.numeric(derivx_result), 0, tolerance = 1e-3) +}) + +# Test edfct (effective dose function) + +test_that("gaussian edfct works with relative type", { + result <- gaussian() + + # Parameters: b=2, c=0, d=1, e=5, f=2 + parm <- c(2, 0, 1, 5, 2) + + ed_result <- result$edfct(parm, respl = 50, reference = "control", type = "relative") + + expect_type(ed_result, "list") + expect_length(ed_result, 2) + expect_type(ed_result[[1]], "double") + expect_type(ed_result[[2]], "double") + expect_length(ed_result[[2]], 5) +}) + +test_that("gaussian edfct works with absolute type", { + result <- gaussian() + + parm <- c(2, 0, 1, 5, 2) + + ed_result <- result$edfct(parm, respl = 0.5, reference = "control", type = "absolute") + + expect_type(ed_result, "list") + expect_length(ed_result, 2) +}) + +test_that("gaussian edfct works with relative type and negative b and control reference", { + result <- gaussian() + + # Parameters with negative b to trigger the control reference path + parm <- c(-2, 0, 1, 5, 2) + + ed_result <- result$edfct(parm, respl = 50, reference = "control", type = "relative") + + expect_type(ed_result, "list") + expect_length(ed_result, 2) +}) + +test_that("gaussian edfct works with relative type and positive b", { + result <- gaussian() + + parm <- c(2, 0, 1, 5, 2) + + ed_result <- result$edfct(parm, respl = 50, reference = "upper", type = "relative") + + expect_type(ed_result, "list") + expect_length(ed_result, 2) +}) + +test_that("gaussian edfct works with fixed parameters", { + result <- gaussian(fixed = c(2, NA, NA, NA, 2)) + + parm <- c(0, 1, 5) + + ed_result <- result$edfct(parm, respl = 50, reference = "control", type = "relative") + + expect_type(ed_result, "list") + expect_length(ed_result, 2) + expect_length(ed_result[[2]], 3) # Only 3 free parameters +}) + +# Test ssfct (self-starter) + +test_that("gaussian ssfct works with valid data", { + result <- gaussian() + + dframe <- data.frame( + dose = c(0.1, 0.5, 1, 2, 5, 10), + response = c(0.1, 0.5, 0.9, 1.0, 0.5, 0.1) + ) + + init_vals <- result$ssfct(dframe) + + expect_type(init_vals, "double") + expect_length(init_vals, 5) + expect_true(all(is.finite(init_vals))) +}) + +# Test lowerAs and upperAs + +test_that("gaussian lowerAs and upperAs return correct values", { + result <- gaussian() + + parm <- c(2, 0.5, 1.5, 5, 2) + lower_val <- result$lowerAs(parm) + upper_val <- result$upperAs(parm) + + expect_equal(lower_val, 0.5) + expect_equal(upper_val, 1.5) +}) + +test_that("gaussian lowerAs and upperAs with fixed parameters", { + # Fix c=0.2 and d=0.9 + result <- gaussian(fixed = c(NA, 0.2, 0.9, NA, NA)) + + # Only free: b, e, f + parm <- c(2, 5, 2) + lower_val <- result$lowerAs(parm) + upper_val <- result$upperAs(parm) + + expect_equal(lower_val, 0.2) + expect_equal(upper_val, 0.9) +}) + +# Test error handling + +test_that("gaussian errors with incorrect names argument - not character", { + expect_error( + gaussian(names = c(1, 2, 3, 4, 5)), + "Not correct 'names' argument" + ) +}) + +test_that("gaussian errors with incorrect names argument - wrong length", { + expect_error( + gaussian(names = c("b", "c", "d")), + "Not correct 'names' argument" + ) +}) + +test_that("gaussian errors with incorrect fixed argument - wrong length", { + expect_error( + gaussian(fixed = c(NA, NA, NA)), + "Not correct 'fixed' argument" + ) +}) + +# Test fixed field in return value + +test_that("gaussian returns fixed argument in result", { + fixed_vec <- c(1, NA, NA, NA, 2) + result <- gaussian(fixed = fixed_vec) + + expect_equal(result$fixed, fixed_vec) +}) diff --git a/tests/testthat/test-gaussian.ssf.R b/tests/testthat/test-gaussian.ssf.R new file mode 100644 index 00000000..a1686775 --- /dev/null +++ b/tests/testthat/test-gaussian.ssf.R @@ -0,0 +1,248 @@ +# Test file for gaussian.ssf function +# Note: gaussian.ssf is an internal function, accessed via ::: + +# Test basic functionality and correctness + +test_that("gaussian.ssf returns a function", { + result <- drc:::gaussian.ssf(method = "1", fixed = c(NA, NA, NA, NA, NA)) + + expect_type(result, "closure") + expect_true(is.function(result)) +}) + +test_that("gaussian.ssf with method 1 returns valid initial values", { + ssfct <- drc:::gaussian.ssf(method = "1", fixed = c(NA, NA, NA, NA, NA)) + + dframe <- data.frame( + dose = c(1, 2, 3, 5, 7, 10), + response = c(0.1, 0.5, 0.9, 1.0, 0.5, 0.1) + ) + + init_vals <- ssfct(dframe) + + expect_type(init_vals, "double") + expect_length(init_vals, 5) + expect_true(all(is.finite(init_vals))) +}) + +test_that("gaussian.ssf with different methods returns valid initial values", { + dframe <- data.frame( + dose = c(1, 2, 3, 5, 7, 10), + response = c(0.1, 0.5, 0.9, 1.0, 0.5, 0.1) + ) + + for (m in c("1", "2", "3", "4")) { + ssfct <- drc:::gaussian.ssf(method = m, fixed = c(NA, NA, NA, NA, NA)) + init_vals <- ssfct(dframe) + expect_type(init_vals, "double") + expect_length(init_vals, 5) + } +}) + +test_that("gaussian.ssf f parameter is always 1", { + ssfct <- drc:::gaussian.ssf(method = "1", fixed = c(NA, NA, NA, NA, NA)) + + dframe <- data.frame( + dose = c(1, 2, 3, 5, 7, 10), + response = c(0.1, 0.5, 0.9, 1.0, 0.5, 0.1) + ) + + init_vals <- ssfct(dframe) + + # The 5th parameter (f) should be 1 + expect_equal(init_vals[5], 1) +}) + +test_that("gaussian.ssf e parameter is x at max y", { + ssfct <- drc:::gaussian.ssf(method = "1", fixed = c(NA, NA, NA, NA, NA)) + + dframe <- data.frame( + dose = c(1, 2, 3, 5, 7, 10), + response = c(0.1, 0.5, 0.9, 1.0, 0.5, 0.1) + ) + + init_vals <- ssfct(dframe) + + # The 4th parameter (e) should be x[which.max(y)] = 5 + expect_equal(init_vals[4], 5) +}) + +test_that("gaussian.ssf c and d parameters use findcd", { + ssfct <- drc:::gaussian.ssf(method = "1", fixed = c(NA, NA, NA, NA, NA)) + + x <- c(1, 2, 3, 5, 7, 10) + y <- c(0.1, 0.5, 0.9, 1.0, 0.5, 0.1) + dframe <- data.frame(dose = x, response = y) + + init_vals <- ssfct(dframe) + + # findcd(x, y) returns c(min(y) - 0.001*diff(range(y)), max(y) + 0.001*diff(range(y))) + expected_cd <- drc:::findcd(x, y) + expect_equal(init_vals[2], expected_cd[1]) + expect_equal(init_vals[3], expected_cd[2]) +}) + +# Test logg parameter + +test_that("gaussian.ssf with logg=FALSE uses sd(x[...])", { + ssfct <- drc:::gaussian.ssf(method = "1", fixed = c(NA, NA, NA, NA, NA), logg = FALSE) + + dframe <- data.frame( + dose = c(1, 2, 3, 5, 7, 10), + response = c(0.1, 0.5, 0.9, 1.0, 0.5, 0.1) + ) + + init_vals <- ssfct(dframe) + + # b should be 0.75 * sd(x[y > quantile(y, .75)]) + x <- dframe[, 1] + y <- dframe[, 2] + expected_b <- 0.75 * sd(x[y > quantile(y, .75)]) + expect_equal(init_vals[1], expected_b) +}) + +test_that("gaussian.ssf with logg=TRUE uses sd(log(x[...]))", { + ssfct <- drc:::gaussian.ssf(method = "1", fixed = c(NA, NA, NA, NA, NA), logg = TRUE) + + dframe <- data.frame( + dose = c(1, 2, 3, 5, 7, 10), + response = c(0.1, 0.5, 0.9, 1.0, 0.5, 0.1) + ) + + init_vals <- ssfct(dframe) + + # b should be 0.75 * sd(log(x[y > quantile(y, .75)])) + x <- dframe[, 1] + y <- dframe[, 2] + expected_b <- 0.75 * sd(log(x[y > quantile(y, .75)])) + expect_equal(init_vals[1], expected_b) +}) + +# Test useFixed parameter + +test_that("gaussian.ssf with useFixed=TRUE does not error", { + ssfct <- drc:::gaussian.ssf(method = "1", fixed = c(NA, NA, NA, NA, NA), useFixed = TRUE) + + dframe <- data.frame( + dose = c(1, 2, 3, 5, 7, 10), + response = c(0.1, 0.5, 0.9, 1.0, 0.5, 0.1) + ) + + init_vals <- ssfct(dframe) + + expect_type(init_vals, "double") + expect_length(init_vals, 5) +}) + +test_that("gaussian.ssf with useFixed=FALSE works normally", { + ssfct <- drc:::gaussian.ssf(method = "1", fixed = c(NA, NA, NA, NA, NA), useFixed = FALSE) + + dframe <- data.frame( + dose = c(1, 2, 3, 5, 7, 10), + response = c(0.1, 0.5, 0.9, 1.0, 0.5, 0.1) + ) + + init_vals <- ssfct(dframe) + + expect_type(init_vals, "double") + expect_length(init_vals, 5) +}) + +# Test fixed parameters + +test_that("gaussian.ssf works with fixed parameters", { + ssfct <- drc:::gaussian.ssf(method = "1", fixed = c(1, NA, NA, NA, 1)) + + dframe <- data.frame( + dose = c(1, 2, 3, 5, 7, 10), + response = c(0.1, 0.5, 0.9, 1.0, 0.5, 0.1) + ) + + init_vals <- ssfct(dframe) + + # Should only return values for non-fixed parameters (c, d, e) + expect_length(init_vals, 3) +}) + +test_that("gaussian.ssf works with all parameters fixed", { + ssfct <- drc:::gaussian.ssf(method = "1", fixed = c(1, 0, 1, 5, 1)) + + dframe <- data.frame( + dose = c(1, 2, 3, 5, 7, 10), + response = c(0.1, 0.5, 0.9, 1.0, 0.5, 0.1) + ) + + init_vals <- ssfct(dframe) + + expect_length(init_vals, 0) +}) + +test_that("gaussian.ssf works with different fixed parameter combinations", { + dframe <- data.frame( + dose = c(1, 2, 3, 5, 7, 10), + response = c(0.1, 0.5, 0.9, 1.0, 0.5, 0.1) + ) + + # Fix only b + ssfct1 <- drc:::gaussian.ssf(method = "1", fixed = c(1, NA, NA, NA, NA)) + init1 <- ssfct1(dframe) + expect_length(init1, 4) + + # Fix c and d + ssfct2 <- drc:::gaussian.ssf(method = "1", fixed = c(NA, 0, 1, NA, NA)) + init2 <- ssfct2(dframe) + expect_length(init2, 3) + + # Fix e + ssfct3 <- drc:::gaussian.ssf(method = "1", fixed = c(NA, NA, NA, 5, NA)) + init3 <- ssfct3(dframe) + expect_length(init3, 4) +}) + +# Test error handling + +test_that("gaussian.ssf errors with invalid method", { + expect_error( + drc:::gaussian.ssf(method = "5", fixed = c(NA, NA, NA, NA, NA)), + "'arg' should be one of" + ) +}) + +test_that("gaussian.ssf errors with non-character method", { + expect_error( + drc:::gaussian.ssf(method = 1, fixed = c(NA, NA, NA, NA, NA)) + ) +}) + +# Test edge cases + +test_that("gaussian.ssf works with minimal data", { + ssfct <- drc:::gaussian.ssf(method = "1", fixed = c(NA, NA, NA, NA, NA)) + + dframe <- data.frame( + dose = c(1, 5, 10), + response = c(0.1, 1.0, 0.1) + ) + + init_vals <- ssfct(dframe) + + expect_type(init_vals, "double") + expect_length(init_vals, 5) +}) + +test_that("gaussian.ssf returns correct parameter order", { + ssfct <- drc:::gaussian.ssf(method = "1", fixed = c(NA, NA, NA, NA, NA)) + + dframe <- data.frame( + dose = c(1, 2, 3, 5, 7, 10), + response = c(0.1, 0.5, 0.9, 1.0, 0.5, 0.1) + ) + + init_vals <- ssfct(dframe) + + # Order should be: b, c, d, e, f + # f should be 1 + expect_equal(init_vals[5], 1) + # e should be x[which.max(y)] = 5 + expect_equal(init_vals[4], 5) +}) diff --git a/tests/testthat/test-getInitial.R b/tests/testthat/test-getInitial.R new file mode 100644 index 00000000..7995474f --- /dev/null +++ b/tests/testthat/test-getInitial.R @@ -0,0 +1,36 @@ +# Tests for getInitial function + +test_that("getInitial returns named vector of starting values for LL.4 model", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- getInitial(m1) + + expect_true(is.numeric(result)) + expect_true(!is.null(names(result))) + expect_length(result, 4) + expect_equal(names(result), c("b", "c", "d", "e")) +}) + +test_that("getInitial returns named vector for LL.3 model", { + m2 <- drm(rootl ~ conc, data = ryegrass, fct = LL.3()) + result <- getInitial(m2) + + expect_true(is.numeric(result)) + expect_length(result, 3) + expect_equal(names(result), c("b", "d", "e")) +}) + +test_that("getInitial returns named vector for LL.2 model with binomial type", { + m3 <- drm(r/n ~ dose, weights = n, data = deguelin, fct = LL.2(), type = "binomial") + result <- getInitial(m3) + + expect_true(is.numeric(result)) + expect_length(result, 2) + expect_equal(names(result), c("b", "e")) +}) + +test_that("getInitial values match object$start", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- getInitial(m1) + + expect_equal(as.numeric(result), m1$start) +}) diff --git a/tests/testthat/test-getMeanFunctions.R b/tests/testthat/test-getMeanFunctions.R new file mode 100644 index 00000000..14375a96 --- /dev/null +++ b/tests/testthat/test-getMeanFunctions.R @@ -0,0 +1,216 @@ +# Tests for getMeanFunctions.R +# Achieves 100% code coverage for the getMeanFunctions function. + +# ============================================================================= +# 1. Default call (no arguments) — all models, display = TRUE +# ============================================================================= + +test_that("getMeanFunctions() with no arguments returns all models invisibly", { + out <- capture.output(result <- getMeanFunctions()) + + # Returns an invisible list + + expect_type(result, "list") + expect_true(length(result) > 0) + + # Each element is a list of c(name, text) from the lapFct path + expect_true(all(vapply(result, length, integer(1)) == 2)) + + # Console output was produced (display = TRUE) + expect_true(length(out) > 0) +}) + +# ============================================================================= +# 2. Filter by noParm only +# ============================================================================= + +test_that("getMeanFunctions filters by noParm", { + result <- getMeanFunctions(noParm = 4, display = FALSE) + + expect_type(result, "list") + expect_true(length(result) > 0) + + # Every returned model must have noParm == 4 + for (mod in result) { + expect_equal(mod$noParm, 4) + } +}) + +test_that("getMeanFunctions filters by noParm = 2", { + result <- getMeanFunctions(noParm = 2, display = FALSE) + + expect_type(result, "list") + expect_true(length(result) > 0) + + for (mod in result) { + expect_equal(mod$noParm, 2) + } +}) + +test_that("getMeanFunctions returns empty list when noParm matches nothing", { + result <- getMeanFunctions(noParm = 99, display = FALSE) + + expect_type(result, "list") + expect_length(result, 0) +}) + +# ============================================================================= +# 3. Filter by fname only +# ============================================================================= + +test_that("getMeanFunctions filters by fname (single name)", { + result <- getMeanFunctions(fname = "LL.4", display = FALSE) + + expect_type(result, "list") + expect_true(length(result) >= 1) + + # At least one returned model should have name containing "LL.4" + names_found <- vapply(result, function(x) x$name, character(1)) + expect_true("LL.4" %in% names_found) +}) + +test_that("getMeanFunctions filters by fname (multiple names)", { + result <- getMeanFunctions(fname = c("LL.4", "W1.4"), display = FALSE) + + expect_type(result, "list") + expect_true(length(result) >= 2) + + names_found <- vapply(result, function(x) x$name, character(1)) + expect_true("LL.4" %in% names_found) + expect_true("W1.4" %in% names_found) +}) + +test_that("getMeanFunctions returns empty list when fname matches nothing", { + result <- getMeanFunctions(fname = "NONEXISTENT_MODEL", display = FALSE) + + expect_type(result, "list") + expect_length(result, 0) +}) + +# ============================================================================= +# 4. Filter by both noParm and fname +# ============================================================================= + +test_that("getMeanFunctions filters by both noParm and fname", { + result <- getMeanFunctions(noParm = 3, fname = c("LL.3", "W1.3"), display = FALSE) + + expect_type(result, "list") + expect_true(length(result) >= 2) + + for (mod in result) { + expect_equal(mod$noParm, 3) + } +}) + +# ============================================================================= +# 5. display = TRUE produces console output +# ============================================================================= + +test_that("getMeanFunctions display = TRUE prints model info", { + out <- capture.output(result <- getMeanFunctions(fname = "LL.4", display = TRUE)) + + expect_true(length(out) > 0) + # Output should mention the model name and number of parameters + combined <- paste(out, collapse = "\n") + expect_true(grepl("LL.4", combined)) + expect_true(grepl("4 parameters", combined)) + expect_true(grepl("In 'drc'", combined)) +}) + +# ============================================================================= +# 6. display = FALSE suppresses console output +# ============================================================================= + +test_that("getMeanFunctions display = FALSE suppresses output", { + out <- capture.output(result <- getMeanFunctions(fname = "LL.4", display = FALSE)) + + expect_equal(length(out), 0) + expect_type(result, "list") + expect_true(length(result) >= 1) +}) + +# ============================================================================= +# 7. Custom flist argument +# ============================================================================= + +test_that("getMeanFunctions uses custom flist instead of default", { + custom_list <- list(LL.4(), W1.4()) + result <- getMeanFunctions(flist = custom_list, display = FALSE) + + expect_type(result, "list") + # Should return name-text pairs since noParm = NA and fname = NULL + expect_true(length(result) == 2) +}) + +test_that("getMeanFunctions with custom flist and noParm filter", { + custom_list <- list(LL.2(), LL.4(), W1.4()) + result <- getMeanFunctions(noParm = 4, flist = custom_list, display = FALSE) + + expect_type(result, "list") + expect_true(length(result) >= 2) + + for (mod in result) { + expect_equal(mod$noParm, 4) + } +}) + +# ============================================================================= +# 8. Return structure: default path returns name-text pairs via lapFct +# ============================================================================= + +test_that("getMeanFunctions default returns list of name-text pairs", { + result <- getMeanFunctions(display = FALSE) + + expect_type(result, "list") + + # Each element should be a character vector of length 2 (name, text) + for (elem in result) { + expect_type(elem, "character") + expect_length(elem, 2) + } +}) + +# ============================================================================= +# 9. Return structure: filtered path returns model objects +# ============================================================================= + +test_that("getMeanFunctions filtered returns model list objects", { + result <- getMeanFunctions(noParm = 4, display = FALSE) + + expect_type(result, "list") + for (mod in result) { + expect_true(is.list(mod)) + expect_true("name" %in% names(mod)) + expect_true("noParm" %in% names(mod)) + } +}) + +# ============================================================================= +# 10. Edge case: noParm combined with fname that yields no results +# ============================================================================= + +test_that("getMeanFunctions combined filter with no matching results", { + # LL.4 has 4 parameters, filtering for noParm = 2 AND fname = "LL.4" yields nothing + result <- getMeanFunctions(noParm = 2, fname = "LL.4", display = FALSE) + + expect_type(result, "list") + expect_length(result, 0) +}) + +# ============================================================================= +# 11. Verify the displayFunction path where condition is FALSE (returns NULL) +# ============================================================================= + +test_that("getMeanFunctions filters out non-matching models correctly", { + # Only 2-parameter models, but display = TRUE to exercise the cat() path too + out <- capture.output(result <- getMeanFunctions(noParm = 2, display = TRUE)) + + # All returned models should have exactly 2 parameters + for (mod in result) { + expect_equal(mod$noParm, 2) + } + + # Models with other parameter counts should NOT appear + all_result <- getMeanFunctions(display = FALSE) + expect_true(length(result) < length(all_result)) +}) diff --git a/tests/testthat/test-gompertz-ssf.R b/tests/testthat/test-gompertz-ssf.R new file mode 100644 index 00000000..818f5a64 --- /dev/null +++ b/tests/testthat/test-gompertz-ssf.R @@ -0,0 +1,144 @@ +# tests/testthat/test-gompertz-ssf.R +# Comprehensive tests for R/gompertz.ssf.R: gompertz.ssf() +# Internal self-starter function for the Gompertz model + +# ======================================================================== +# Test: gompertz.ssf() method argument matching +# ======================================================================== + +test_that("gompertz.ssf() defaults to method '1'", { + ssf <- gompertz.ssf(fixed = c(NA, NA, NA, NA)) + expect_true(is.function(ssf)) +}) + +test_that("gompertz.ssf() accepts all valid methods", { + for (m in c("1", "2", "3", "4")) { + ssf <- gompertz.ssf(method = m, fixed = c(NA, NA, NA, NA)) + expect_true(is.function(ssf), info = paste("Method", m, "should return a function")) + } +}) + +test_that("gompertz.ssf() errors on invalid method", { + expect_error(gompertz.ssf(method = "5", fixed = c(NA, NA, NA, NA))) + expect_error(gompertz.ssf(method = "invalid", fixed = c(NA, NA, NA, NA))) +}) + +# ======================================================================== +# Test: gompertz.ssf() returned closure functionality +# ======================================================================== + +test_that("gompertz.ssf() method='1' returns valid initial values", { + ssf <- gompertz.ssf(method = "1", fixed = c(NA, NA, NA, NA)) + doses <- c(0, 1, 2, 3, 5, 8, 10, 15, 20) + responses <- 10 + (100 - 10) * exp(-exp(0.5 * (doses - 5))) + dframe <- data.frame(dose = doses, response = responses) + + result <- ssf(dframe) + expect_true(is.numeric(result)) + expect_length(result, 4) # 4 free parameters + expect_true(all(is.finite(result))) +}) + +test_that("gompertz.ssf() method='2' returns valid initial values", { + ssf <- gompertz.ssf(method = "2", fixed = c(NA, NA, NA, NA)) + doses <- c(0, 1, 2, 3, 5, 8, 10, 15, 20) + responses <- 10 + (100 - 10) * exp(-exp(0.5 * (doses - 5))) + dframe <- data.frame(dose = doses, response = responses) + + result <- ssf(dframe) + expect_true(is.numeric(result)) + expect_length(result, 4) + expect_true(all(is.finite(result))) +}) + +test_that("gompertz.ssf() method='3' returns valid initial values", { + ssf <- gompertz.ssf(method = "3", fixed = c(NA, NA, NA, NA)) + doses <- c(0, 1, 2, 3, 5, 8, 10, 15, 20) + responses <- 10 + (100 - 10) * exp(-exp(0.5 * (doses - 5))) + dframe <- data.frame(dose = doses, response = responses) + + result <- ssf(dframe) + expect_true(is.numeric(result)) + expect_length(result, 4) +}) + +test_that("gompertz.ssf() method='4' returns valid initial values", { + ssf <- gompertz.ssf(method = "4", fixed = c(NA, NA, NA, NA)) + doses <- c(0, 1, 2, 3, 5, 8, 10, 15, 20) + responses <- 10 + (100 - 10) * exp(-exp(0.5 * (doses - 5))) + dframe <- data.frame(dose = doses, response = responses) + + result <- ssf(dframe) + expect_true(is.numeric(result)) + expect_length(result, 4) +}) + +# ======================================================================== +# Test: gompertz.ssf() with fixed parameters +# ======================================================================== + +test_that("gompertz.ssf() returns fewer values when some parameters are fixed", { + # Fix b=0.5 (first parameter) + ssf <- gompertz.ssf(method = "1", fixed = c(0.5, NA, NA, NA)) + doses <- c(0, 1, 2, 3, 5, 8, 10, 15, 20) + responses <- 10 + (100 - 10) * exp(-exp(0.5 * (doses - 5))) + dframe <- data.frame(dose = doses, response = responses) + + result <- ssf(dframe) + expect_length(result, 3) # Only 3 free parameters (c, d, e) +}) + +test_that("gompertz.ssf() returns fewer values when two parameters are fixed", { + # Fix b=0.5, c=10 + ssf <- gompertz.ssf(method = "1", fixed = c(0.5, 10, NA, NA)) + doses <- c(0, 1, 2, 3, 5, 8, 10, 15, 20) + responses <- 10 + (100 - 10) * exp(-exp(0.5 * (doses - 5))) + dframe <- data.frame(dose = doses, response = responses) + + result <- ssf(dframe) + expect_length(result, 2) # Only 2 free parameters (d, e) +}) + +# ======================================================================== +# Test: gompertz.ssf() useFixed parameter +# ======================================================================== + +test_that("gompertz.ssf() with useFixed=TRUE executes without error", { + # useFixed=TRUE path is empty {} but should execute without error + ssf <- gompertz.ssf(method = "1", fixed = c(NA, NA, NA, NA), useFixed = TRUE) + doses <- c(0, 1, 2, 3, 5, 8, 10, 15, 20) + responses <- 10 + (100 - 10) * exp(-exp(0.5 * (doses - 5))) + dframe <- data.frame(dose = doses, response = responses) + + result <- ssf(dframe) + expect_true(is.numeric(result)) + expect_length(result, 4) +}) + +# ======================================================================== +# Test: gompertz.ssf() with different data patterns +# ======================================================================== + +test_that("gompertz.ssf() works with decreasing response data", { + ssf <- gompertz.ssf(method = "1", fixed = c(NA, NA, NA, NA)) + # Decreasing data: high response at low dose, low at high dose + doses <- c(0, 1, 2, 4, 8, 16, 32) + responses <- c(98, 95, 85, 60, 20, 5, 2) + dframe <- data.frame(dose = doses, response = responses) + + result <- ssf(dframe) + expect_true(is.numeric(result)) + expect_length(result, 4) +}) + +test_that("gompertz.ssf() works with increasing response data", { + ssf <- gompertz.ssf(method = "1", fixed = c(NA, NA, NA, NA)) + # Increasing data + doses <- c(0, 1, 2, 4, 8, 16, 32) + responses <- c(2, 5, 20, 60, 85, 95, 98) + dframe <- data.frame(dose = doses, response = responses) + + result <- ssf(dframe) + expect_true(is.numeric(result)) + expect_length(result, 4) +}) diff --git a/tests/testthat/test-gompertz.R b/tests/testthat/test-gompertz.R new file mode 100644 index 00000000..82d6d10c --- /dev/null +++ b/tests/testthat/test-gompertz.R @@ -0,0 +1,549 @@ +# tests/testthat/test-gompertz.R +# Comprehensive tests for R/gompertz.R: gompertz(), G.2(), G.3(), G.3u(), G.4() +# and nested functions: fct, deriv1, derivx, edfct + +# ======================================================================== +# Test: gompertz() argument validation +# ======================================================================== + +test_that("gompertz() errors on invalid 'names' argument", { + expect_error(gompertz(names = c("a", "b")), "Not correct 'names' argument") + expect_error(gompertz(names = 123), "Not correct 'names' argument") + expect_error(gompertz(names = c("a", "b", "c")), "Not correct 'names' argument") +}) + +test_that("gompertz() errors on invalid 'fixed' argument", { + expect_error(gompertz(fixed = c(NA, NA)), "Not correct 'fixed' argument") + expect_error(gompertz(fixed = c(NA, NA, NA)), "Not correct 'fixed' argument") + expect_error(gompertz(fixed = c(NA, NA, NA, NA, NA)), "Not correct 'fixed' argument") +}) + +# ======================================================================== +# Test: gompertz() return structure +# ======================================================================== + +test_that("gompertz() returns object of class 'gompertz'", { + result <- gompertz() + expect_s3_class(result, "gompertz") +}) + +test_that("gompertz() return list has correct structure", { + result <- gompertz() + expect_true(is.function(result$fct)) + expect_true(is.function(result$ssfct)) + expect_true(is.function(result$deriv1)) + expect_null(result$deriv2) + expect_true(is.function(result$derivx)) + expect_true(is.function(result$edfct)) + expect_equal(result$noParm, 4) + expect_equal(result$names, c("b", "c", "d", "e")) +}) + +test_that("gompertz() default name and text are correct", { + result <- gompertz() + expect_equal(result$name, "gompertz") + expect_equal(result$text, "Gompertz") +}) + +test_that("gompertz() custom fctName and fctText override defaults", { + result <- gompertz(fctName = "myModel", fctText = "my description") + expect_equal(result$name, "myModel") + expect_equal(result$text, "my description") +}) + +test_that("gompertz() respects custom parameter names", { + result <- gompertz(names = c("slope", "lower", "upper", "mid")) + expect_equal(result$names, c("slope", "lower", "upper", "mid")) +}) + +test_that("gompertz() handles fixed parameters correctly", { + result <- gompertz(fixed = c(NA, 0, NA, NA)) + expect_equal(result$noParm, 3) + expect_equal(result$names, c("b", "d", "e")) +}) + +test_that("gompertz() uses ssfct when provided", { + custom_ssfct <- function(dframe) { c(1, 0, 100, 5) } + result <- gompertz(ssfct = custom_ssfct) + expect_identical(result$ssfct, custom_ssfct) +}) + +test_that("gompertz() uses default ssfct when not provided", { + result <- gompertz() + expect_true(is.function(result$ssfct)) +}) + +test_that("gompertz() lowerAs, upperAs, monoton are functions", { + result <- gompertz() + expect_true(is.function(result$lowerAs)) + expect_true(is.function(result$upperAs)) + expect_true(is.function(result$monoton)) +}) + +# ======================================================================== +# Test: fct (the nonlinear function) +# Gompertz: f(x) = c + (d-c)*exp(-exp(b*(x-e))) +# ======================================================================== + +test_that("gompertz fct produces expected values with all parameters free", { + mod <- gompertz() + # Parameters: b, c, d, e + # b=1, c=0, d=100, e=5 + parm <- matrix(c(1, 0, 100, 5), nrow = 1) + + # At dose = e = 5: f(5) = 0 + (100-0)*exp(-exp(1*(5-5))) = 100*exp(-1) = 36.7879... + result <- mod$fct(5, parm) + expected <- 100 * exp(-exp(0)) + expect_equal(as.numeric(result), expected, tolerance = 1e-10) + + # At dose = 0: f(0) = 100*exp(-exp(1*(0-5))) = 100*exp(-exp(-5)) + result0 <- mod$fct(0, parm) + expected0 <- 100 * exp(-exp(-5)) + expect_equal(as.numeric(result0), expected0, tolerance = 1e-10) +}) + +test_that("gompertz fct handles fixed parameters", { + # Fix c=0 (like G.3 does) + mod <- gompertz(fixed = c(NA, 0, NA, NA)) + parm <- matrix(c(1, 100, 5), nrow = 1) # b, d, e + + result <- mod$fct(5, parm) + expected <- 100 * exp(-exp(0)) + expect_equal(as.numeric(result), expected, tolerance = 1e-10) +}) + +test_that("gompertz fct handles multiple doses", { + mod <- gompertz() + parm <- matrix(rep(c(1, 0, 100, 5), each = 3), nrow = 3) + doses <- c(0, 5, 100) + + result <- mod$fct(doses, parm) + expect_length(result, 3) + # At dose = 5 (inflection point): 100*exp(-1) + expect_equal(as.numeric(result[2]), 100 * exp(-1), tolerance = 1e-10) +}) + +test_that("gompertz fct returns gradient attribute", { + mod <- gompertz() + parm <- matrix(c(1, 0, 100, 5), nrow = 1) + + result <- mod$fct(5, parm) + expect_true(!is.null(attr(result, "gradient"))) + grad <- attr(result, "gradient") + expect_equal(ncol(grad), 4) +}) + +test_that("gompertz fct decreasing curve when b > 0", { + mod <- gompertz() + parm <- matrix(c(1, 0, 100, 5), nrow = 1) + + # Higher dose should give lower value for b > 0 (decreasing) + y_low <- mod$fct(0, parm) + y_high <- mod$fct(100, parm) + expect_true(as.numeric(y_low) > as.numeric(y_high)) +}) + +test_that("gompertz fct increasing curve when b < 0", { + mod <- gompertz() + parm <- matrix(c(-1, 0, 100, 5), nrow = 1) + + # Lower dose should give lower value for b < 0 (increasing) + y_low <- mod$fct(0, parm) + y_high <- mod$fct(100, parm) + expect_true(as.numeric(y_low) < as.numeric(y_high)) +}) + +# ======================================================================== +# Test: deriv1 (first derivatives in parameters) +# ======================================================================== + +test_that("gompertz deriv1 returns correct dimensions with all parameters free", { + mod <- gompertz() + parm <- matrix(c(1, 0, 100, 5), nrow = 1) + + result <- mod$deriv1(5, parm) + # Single row: gradient drops to vector + expect_length(result, 4) +}) + +test_that("gompertz deriv1 returns correct dimensions with fixed parameters", { + mod <- gompertz(fixed = c(NA, 0, NA, NA)) + parm <- matrix(c(1, 100, 5), nrow = 1) + + result <- mod$deriv1(5, parm) + expect_length(result, 3) # Only free parameters +}) + +test_that("gompertz deriv1 handles multiple rows", { + mod <- gompertz() + parm <- matrix(c(1, 0, 100, 5, + 2, 10, 90, 3), nrow = 2, byrow = TRUE) + doses <- c(5, 3) + + result <- mod$deriv1(doses, parm) + expect_true(is.matrix(result)) + expect_equal(nrow(result), 2) + expect_equal(ncol(result), 4) +}) + +test_that("gompertz deriv1 gradient at dose=e is correct", { + mod <- gompertz() + # b=1, c=0, d=100, e=5 + parm <- matrix(c(1, 0, 100, 5), nrow = 1) + + result <- mod$deriv1(5, parm) + # At dose=e=5: exp(b*(dose-e)) = exp(0) = 1, exp(-1) = 1/e + # dc/dc = 1 - exp(-1) + # dd/dd = exp(-1) + expect_equal(as.numeric(result[2]), 1 - exp(-1), tolerance = 1e-10) # dc + expect_equal(as.numeric(result[3]), exp(-1), tolerance = 1e-10) # dd +}) + +# ======================================================================== +# Test: derivx (first derivatives in x) +# ======================================================================== + +test_that("gompertz derivx returns correct dimensions", { + mod <- gompertz() + parm <- matrix(c(1, 0, 100, 5), nrow = 1) + + result <- mod$derivx(5, parm) + expect_length(result, 1) +}) + +test_that("gompertz derivx at dose=e has expected value", { + mod <- gompertz() + # b=1, c=0, d=100, e=5 + parm <- matrix(c(1, 0, 100, 5), nrow = 1) + + # df/dx = -(d-c)*exp(-exp(b*(x-e)))*exp(b*(x-e))*b + # At x=e: -(100)*exp(-1)*1*1 = -100/e + result <- mod$derivx(5, parm) + expected <- -100 * exp(-1) * 1 + expect_equal(as.numeric(result), expected, tolerance = 1e-10) +}) + +test_that("gompertz derivx handles fixed parameters", { + mod <- gompertz(fixed = c(NA, 0, NA, NA)) + parm <- matrix(c(1, 100, 5), nrow = 1) + + result <- mod$derivx(5, parm) + expected <- -100 * exp(-1) * 1 + expect_equal(as.numeric(result), expected, tolerance = 1e-10) +}) + +test_that("gompertz derivx handles multiple rows", { + mod <- gompertz() + parm <- matrix(c(1, 0, 100, 5, + 2, 10, 90, 3), nrow = 2, byrow = TRUE) + + result <- mod$derivx(c(5, 3), parm) + expect_length(result, 2) +}) + +# ======================================================================== +# Test: edfct (effective dose function) +# ======================================================================== + +test_that("edfct returns ED correctly for relative type", { + mod <- gompertz() + # b=1, c=0, d=100, e=5 + # For Gompertz: ED = e + log(-log((100-p)/100)) / b + parms <- c(1, 0, 100, 5) + + # ED50: e + log(-log(0.5)) / b = 5 + log(-log(0.5)) / 1 + result50 <- mod$edfct(parms, 50, reference = "control", type = "relative") + expected50 <- 5 + log(-log(0.5)) / 1 + expect_equal(result50[[1]], expected50, tolerance = 1e-10) + expect_true(is.numeric(result50[[2]])) + expect_length(result50[[2]], 4) +}) + +test_that("edfct returns correct ED values for various p", { + mod <- gompertz() + parms <- c(1, 0, 100, 5) + + # ED10: e + log(-log(0.9)) / b + result10 <- mod$edfct(parms, 10, reference = "control", type = "relative") + expected10 <- 5 + log(-log(0.9)) / 1 + expect_equal(result10[[1]], expected10, tolerance = 1e-10) + + # ED90: e + log(-log(0.1)) / b + result90 <- mod$edfct(parms, 90, reference = "control", type = "relative") + expected90 <- 5 + log(-log(0.1)) / 1 + expect_equal(result90[[1]], expected90, tolerance = 1e-10) +}) + +test_that("edfct returns gradients with correct length when parameters are fixed", { + mod <- gompertz(fixed = c(NA, 0, NA, NA)) + # Free: b, d, e (3 params) + result <- mod$edfct(c(1, 100, 5), 50, reference = "control", type = "relative") + + expect_true(is.numeric(result[[1]])) + expect_length(result[[2]], 3) # gradient for 3 free parameters +}) + +test_that("edfct gradient for 'e' equals EDp (current implementation)", { + mod <- gompertz() + result <- mod$edfct(c(1, 0, 100, 5), 50, reference = "control", type = "relative") + gradient <- result[[2]] + EDp <- result[[1]] + + # In the current implementation, EDder = EDp * c(-tempVal/b^2, 0, 0, 1) + # So gradient[4] = EDp * 1 = EDp + expect_equal(gradient[4], EDp, tolerance = 1e-10) +}) + +test_that("edfct gradient for 'c' and 'd' is 0", { + mod <- gompertz() + result <- mod$edfct(c(1, 0, 100, 5), 50, reference = "control", type = "relative") + gradient <- result[[2]] + + # c and d do not appear in ED formula directly + expect_equal(gradient[2], 0) + expect_equal(gradient[3], 0) +}) + +test_that("edfct works with negative b (increasing curve)", { + mod <- gompertz() + parms <- c(-1, 0, 100, 5) + + # For increasing curve (b < 0), EDhelper swaps p → 100-p + result <- mod$edfct(parms, 50, reference = "control", type = "relative") + expect_true(is.numeric(result[[1]])) + expect_length(result[[2]], 4) +}) + +# ======================================================================== +# Test: lowerAs, upperAs, monoton functions +# ======================================================================== + +test_that("lowerAs returns correct parameter", { + mod <- gompertz() + # lowerAs picks parameter 2 (c) + result <- mod$lowerAs(c(1, 0, 100, 5)) + expect_equal(result, 0) +}) + +test_that("upperAs returns correct parameter", { + mod <- gompertz() + # upperAs picks parameter 3 (d) + result <- mod$upperAs(c(1, 0, 100, 5)) + expect_equal(result, 100) +}) + +test_that("monoton returns -1 * b", { + mod <- gompertz() + # monoton picks parameter 1 (b) with sign -1 + result <- mod$monoton(c(1, 0, 100, 5)) + expect_equal(result, -1) +}) + +# ======================================================================== +# Test: G.2() (two-parameter Gompertz, c=0, d=upper fixed) +# ======================================================================== + +test_that("G.2() returns gompertz object with correct structure", { + result <- G.2() + expect_s3_class(result, "gompertz") + expect_equal(result$name, "G.2") + expect_equal(result$text, "Gompertz with lower limit at 0 and upper limit at 1") + expect_equal(result$noParm, 2) + expect_equal(result$names, c("b", "e")) +}) + +test_that("G.2() errors on invalid names argument", { + expect_error(G.2(names = c("a")), "Not correct 'names' argument") + expect_error(G.2(names = 123), "Not correct 'names' argument") +}) + +test_that("G.2() errors on invalid fixed argument", { + expect_error(G.2(fixed = c(NA)), "Not correct length of 'fixed' argument") + expect_error(G.2(fixed = c(NA, NA, NA)), "Not correct length of 'fixed' argument") +}) + +test_that("G.2() custom upper limit", { + result <- G.2(upper = 50) + expect_equal(result$text, "Gompertz with lower limit at 0 and upper limit at 50") + # Check fct produces expected value + parm <- matrix(c(1, 5), nrow = 1) # b, e + res <- result$fct(5, parm) + expected <- 50 * exp(-exp(0)) # c=0, d=50 + expect_equal(as.numeric(res), expected, tolerance = 1e-10) +}) + +test_that("G.2() fct gives expected response", { + mod <- G.2() + # b, e (c=0, d=1 are fixed) + parm <- matrix(c(1, 5), nrow = 1) + result <- mod$fct(5, parm) + expected <- 1 * exp(-exp(0)) # c=0, d=1 + expect_equal(as.numeric(result), expected, tolerance = 1e-10) +}) + +# ======================================================================== +# Test: G.3() (three-parameter Gompertz, c=0 fixed) +# ======================================================================== + +test_that("G.3() returns gompertz object with correct structure", { + result <- G.3() + expect_s3_class(result, "gompertz") + expect_equal(result$name, "G.3") + expect_equal(result$text, "Gompertz with lower limit at 0") + expect_equal(result$noParm, 3) + expect_equal(result$names, c("b", "d", "e")) +}) + +test_that("G.3() errors on invalid names argument", { + expect_error(G.3(names = c("a", "b")), "Not correct 'names' argument") + expect_error(G.3(names = 123), "Not correct 'names' argument") +}) + +test_that("G.3() errors on invalid fixed argument", { + expect_error(G.3(fixed = c(NA, NA)), "Not correct length of 'fixed' argument") + expect_error(G.3(fixed = c(NA, NA, NA, NA)), "Not correct length of 'fixed' argument") +}) + +test_that("G.3() fct gives expected response", { + mod <- G.3() + # b, d, e (c=0 fixed) + parm <- matrix(c(1, 100, 5), nrow = 1) + result <- mod$fct(5, parm) + expected <- 100 * exp(-exp(0)) + expect_equal(as.numeric(result), expected, tolerance = 1e-10) +}) + +test_that("G.3() edfct gives correct ED", { + mod <- G.3() + result <- mod$edfct(c(1, 100, 5), 50, reference = "control", type = "relative") + expect_true(is.numeric(result[[1]])) + expect_length(result[[2]], 3) +}) + +# ======================================================================== +# Test: G.3u() (three-parameter Gompertz, d=upper fixed) +# ======================================================================== + +test_that("G.3u() returns gompertz object with correct structure", { + result <- G.3u() + expect_s3_class(result, "gompertz") + expect_equal(result$name, "G.3u") + expect_equal(result$text, "Gompertz with upper limit at 1") + expect_equal(result$noParm, 3) + expect_equal(result$names, c("b", "c", "e")) +}) + +test_that("G.3u() errors on invalid names argument", { + expect_error(G.3u(names = c("a", "b")), "Not correct 'names' argument") + expect_error(G.3u(names = 123), "Not correct 'names' argument") +}) + +test_that("G.3u() errors on invalid fixed argument", { + expect_error(G.3u(fixed = c(NA, NA)), "Not correct length of 'fixed' argument") + expect_error(G.3u(fixed = c(NA, NA, NA, NA)), "Not correct length of 'fixed' argument") +}) + +test_that("G.3u() custom upper limit", { + result <- G.3u(upper = 200) + expect_equal(result$text, "Gompertz with upper limit at 200") +}) + +test_that("G.3u() fct gives expected response", { + mod <- G.3u() + # b, c, e (d=1 fixed) + parm <- matrix(c(1, 0, 5), nrow = 1) + result <- mod$fct(5, parm) + expected <- 0 + (1 - 0) * exp(-exp(1 * (5 - 5))) + expect_equal(as.numeric(result), expected, tolerance = 1e-10) +}) + +# ======================================================================== +# Test: G.4() (four-parameter Gompertz) +# ======================================================================== + +test_that("G.4() returns gompertz object with correct structure", { + result <- G.4() + expect_s3_class(result, "gompertz") + expect_equal(result$name, "G.4") + expect_equal(result$noParm, 4) + expect_equal(result$names, c("b", "c", "d", "e")) +}) + +test_that("G.4() errors on invalid names argument", { + expect_error(G.4(names = c("a", "b")), "Not correct names argument") + expect_error(G.4(names = 123), "Not correct names argument") +}) + +test_that("G.4() errors on invalid fixed argument", { + expect_error(G.4(fixed = c(NA, NA, NA)), "Not correct length of 'fixed' argument") + expect_error(G.4(fixed = c(NA, NA, NA, NA, NA)), "Not correct length of 'fixed' argument") +}) + +test_that("G.4() fct gives expected response", { + mod <- G.4() + parm <- matrix(c(1, 0, 100, 5), nrow = 1) + result <- mod$fct(5, parm) + expected <- 100 * exp(-exp(0)) + expect_equal(as.numeric(result), expected, tolerance = 1e-10) +}) + +test_that("G.4() passes additional arguments to gompertz()", { + custom_ss <- function(dframe) { c(1, 0, 100, 5) } + result <- G.4(ssfct = custom_ss) + expect_identical(result$ssfct, custom_ss) +}) + +# ======================================================================== +# Test: ssfct (self-starter function) via gompertz() +# ======================================================================== + +test_that("gompertz ssfct works with simple data frame", { + mod <- gompertz() + # Create a simple dose-response like data frame + set.seed(42) + doses <- c(0, 1, 2, 3, 5, 8, 10, 15, 20) + # Gompertz with b=0.5, c=10, d=100, e=5 + responses <- 10 + (100 - 10) * exp(-exp(0.5 * (doses - 5))) + dframe <- data.frame(dose = doses, response = responses) + + result <- mod$ssfct(dframe) + expect_true(is.numeric(result)) + expect_length(result, 4) # 4 free parameters + expect_true(all(is.finite(result))) +}) + +test_that("gompertz ssfct with method='2' works", { + mod <- gompertz(method = "2") + set.seed(42) + doses <- c(0, 1, 2, 3, 5, 8, 10, 15, 20) + responses <- 10 + (100 - 10) * exp(-exp(0.5 * (doses - 5))) + dframe <- data.frame(dose = doses, response = responses) + + result <- mod$ssfct(dframe) + expect_true(is.numeric(result)) + expect_length(result, 4) +}) + +test_that("gompertz ssfct with method='3' works", { + mod <- gompertz(method = "3") + set.seed(42) + doses <- c(0, 1, 2, 3, 5, 8, 10, 15, 20) + responses <- 10 + (100 - 10) * exp(-exp(0.5 * (doses - 5))) + dframe <- data.frame(dose = doses, response = responses) + + result <- mod$ssfct(dframe) + expect_true(is.numeric(result)) + expect_length(result, 4) +}) + +test_that("gompertz ssfct with method='4' works", { + mod <- gompertz(method = "4") + set.seed(42) + doses <- c(0, 1, 2, 3, 5, 8, 10, 15, 20) + responses <- 10 + (100 - 10) * exp(-exp(0.5 * (doses - 5))) + dframe <- data.frame(dose = doses, response = responses) + + result <- mod$ssfct(dframe) + expect_true(is.numeric(result)) + expect_length(result, 4) +}) diff --git a/tests/testthat/test-gompertzd.R b/tests/testthat/test-gompertzd.R new file mode 100644 index 00000000..20aeff82 --- /dev/null +++ b/tests/testthat/test-gompertzd.R @@ -0,0 +1,230 @@ +# tests/testthat/test-gompertzd.R +# Comprehensive tests for R/gompertzd.R: gompertzd() +# and nested functions: fct, ssfct, deriv1, derivx + +# ======================================================================== +# Test: gompertzd() argument validation +# ======================================================================== + +test_that("gompertzd() errors on invalid 'names' argument", { + expect_error(gompertzd(names = c("a")), "Not correct 'names' argument") + expect_error(gompertzd(names = 123), "Not correct 'names' argument") + expect_error(gompertzd(names = c("a", "b", "c")), "Not correct 'names' argument") +}) + +test_that("gompertzd() errors on invalid 'fixed' argument", { + expect_error(gompertzd(fixed = c(NA)), "Not correct 'fixed' argument") + expect_error(gompertzd(fixed = c(NA, NA, NA)), "Not correct 'fixed' argument") +}) + +# ======================================================================== +# Test: gompertzd() return structure +# ======================================================================== + +test_that("gompertzd() returns object of class 'gompertzd'", { + result <- gompertzd() + expect_s3_class(result, "gompertzd") +}) + +test_that("gompertzd() return list has correct structure", { + result <- gompertzd() + expect_true(is.function(result$fct)) + expect_true(is.function(result$ssfct)) + expect_true(is.function(result$deriv1)) + expect_null(result$deriv2) + expect_true(is.function(result$derivx)) + expect_null(result$edfct) + expect_equal(result$noParm, 2) + expect_equal(result$names, c("a", "b")) +}) + +test_that("gompertzd() default name and text are correct", { + result <- gompertzd() + expect_equal(result$name, "gompertzd") + expect_equal(result$text, "Gompertz derivative") +}) + +test_that("gompertzd() respects custom parameter names", { + result <- gompertzd(names = c("alpha", "beta")) + expect_equal(result$names, c("alpha", "beta")) +}) + +test_that("gompertzd() handles fixed parameters correctly", { + result <- gompertzd(fixed = c(2, NA)) + expect_equal(result$noParm, 1) + expect_equal(result$names, "b") +}) + +test_that("gompertzd() handles all parameters fixed", { + result <- gompertzd(fixed = c(2, 1)) + expect_equal(result$noParm, 0) + expect_equal(result$names, character(0)) +}) + +# ======================================================================== +# Test: fct (the nonlinear function) +# f(x) = a * exp(bx - (a/b)*(exp(bx) - 1)) +# ======================================================================== + +test_that("gompertzd fct produces expected values with all parameters free", { + mod <- gompertzd() + # Parameters: a=2, b=0.5 + parm <- matrix(c(2, 0.5), nrow = 1) + + # At dose=0: f(0) = a * exp(0 - (a/b)*(1-1)) = a * exp(0) = a = 2 + result0 <- mod$fct(0, parm) + expect_equal(as.numeric(result0), 2, tolerance = 1e-10) + + # At dose=1: f(1) = 2*exp(0.5*1 - (2/0.5)*(exp(0.5)-1)) + dose <- 1 + a <- 2; b <- 0.5 + innerT1 <- b * dose + innerT2 <- (a / b) * (exp(innerT1) - 1) + expected <- a * exp(innerT1 - innerT2) + result1 <- mod$fct(dose, parm) + expect_equal(as.numeric(result1), expected, tolerance = 1e-10) +}) + +test_that("gompertzd fct handles fixed parameters", { + # Fix a=2 + mod <- gompertzd(fixed = c(2, NA)) + parm <- matrix(0.5, nrow = 1) # only b is free + + result <- mod$fct(0, parm) + expect_equal(as.numeric(result), 2, tolerance = 1e-10) +}) + +test_that("gompertzd fct handles multiple doses", { + mod <- gompertzd() + parm <- matrix(rep(c(2, 0.5), each = 3), nrow = 3) + doses <- c(0, 1, 5) + + result <- mod$fct(doses, parm) + expect_length(result, 3) + # At dose=0: f(0) = a = 2 + expect_equal(as.numeric(result[1]), 2, tolerance = 1e-10) +}) + +test_that("gompertzd fct is decreasing for a>0 and b>0", { + mod <- gompertzd() + parm <- matrix(c(2, 0.5), nrow = 1) + + y0 <- mod$fct(0, parm) + y5 <- mod$fct(5, parm) + expect_true(as.numeric(y0) > as.numeric(y5)) +}) + +# ======================================================================== +# Test: ssfct (self-starter function) +# ======================================================================== + +test_that("gompertzd ssfct returns correct initial estimates", { + mod <- gompertzd() + doses <- c(0, 1, 2, 3, 5, 8, 10) + responses <- c(10, 8, 5, 3, 1, 0.5, 0.1) + dframe <- data.frame(dose = doses, response = responses) + + result <- mod$ssfct(dframe) + expect_true(is.numeric(result)) + expect_length(result, 2) # a, b + # aVal should be max(y) = 10 + expect_equal(result[1], 10) + # bVal should be 1 + expect_equal(result[2], 1) +}) + +# ======================================================================== +# Test: deriv1 (first derivatives in parameters) +# ======================================================================== + +test_that("gompertzd deriv1 returns correct dimensions with all parameters free", { + mod <- gompertzd() + parm <- matrix(c(2, 0.5), nrow = 1) + + result <- mod$deriv1(1, parm) + expect_length(result, 2) +}) + +test_that("gompertzd deriv1 returns correct dimensions with fixed parameters", { + mod <- gompertzd(fixed = c(2, NA)) + parm <- matrix(0.5, nrow = 1) + + result <- mod$deriv1(1, parm) + # Only 1 free parameter (b) + expect_length(result, 1) +}) + +test_that("gompertzd deriv1 handles multiple rows", { + mod <- gompertzd() + parm <- matrix(c(2, 0.5, + 3, 1.0), nrow = 2, byrow = TRUE) + doses <- c(1, 2) + + result <- mod$deriv1(doses, parm) + expect_true(is.matrix(result)) + expect_equal(nrow(result), 2) + expect_equal(ncol(result), 2) +}) + +test_that("gompertzd deriv1 at dose=0 is correct for parameter a", { + mod <- gompertzd() + a <- 2; b <- 0.5 + parm <- matrix(c(a, b), nrow = 1) + + result <- mod$deriv1(0, parm) + # At dose=0: fct=a, exp(b*0)=1, help3=0, help4=a/b + # deriva = a*(1/a - 0/b) = 1 + # derivb = a*(0 + (a/b)*0/b + (a/b)*1*0) = 0 + # but wait: derivb = help1*(dose + help4*help3/b + help4*help2*dose) + # = a*(0 + (a/b)*0/b + (a/b)*1*0) = 0 + # Actually wait, let me re-derive more carefully: + # At dose=0: + # help1 = fct(0, parm) = a + # help2 = exp(b*0) = 1 + # help3 = 1 - 1 = 0 + # help4 = a/b + # deriva = help1*(1/a - help3/b) = a*(1/a - 0) = 1 + expect_equal(as.numeric(result[1]), 1, tolerance = 1e-10) +}) + +# ======================================================================== +# Test: derivx (first derivatives in x) +# ======================================================================== + +test_that("gompertzd derivx returns correct dimensions", { + mod <- gompertzd() + parm <- matrix(c(2, 0.5), nrow = 1) + + result <- mod$derivx(1, parm) + expect_length(result, 1) +}) + +test_that("gompertzd derivx at dose=0 has expected value", { + mod <- gompertzd() + a <- 2; b <- 0.5 + parm <- matrix(c(a, b), nrow = 1) + + # derivx = fct(x, parm) * (b - a*exp(b*x)) + # At x=0: fct=a, derivx = a*(b - a*exp(0)) = a*(b - a) = 2*(0.5-2) = -3 + result <- mod$derivx(0, parm) + expected <- a * (b - a) + expect_equal(as.numeric(result), expected, tolerance = 1e-10) +}) + +test_that("gompertzd derivx handles fixed parameters", { + mod <- gompertzd(fixed = c(2, NA)) + parm <- matrix(0.5, nrow = 1) + + result <- mod$derivx(0, parm) + expected <- 2 * (0.5 - 2) + expect_equal(as.numeric(result), expected, tolerance = 1e-10) +}) + +test_that("gompertzd derivx handles multiple rows", { + mod <- gompertzd() + parm <- matrix(c(2, 0.5, + 3, 1.0), nrow = 2, byrow = TRUE) + + result <- mod$derivx(c(0, 1), parm) + expect_length(result, 2) +}) diff --git a/tests/testthat/test-idrm.R b/tests/testthat/test-idrm.R new file mode 100644 index 00000000..f48ee9a1 --- /dev/null +++ b/tests/testthat/test-idrm.R @@ -0,0 +1,132 @@ +# Tests for idrm() - interactive dose-response modelling +# idrm is an internal function called by drm() when separate = TRUE + +test_that("idrm works with a single function and multiple curves (separate = TRUE)", { + data(spinach) + result <- drm(SLOPE ~ DOSE, HERBICIDE, data = spinach, fct = LL.4(), separate = TRUE) + + # Should return a drc object + expect_s3_class(result, "drc") + + # Should have coefficients for both curves + cf <- coef(result) + expect_true(length(cf) == 8) # 4 params * 2 curves + expect_true(all(grepl(":", names(cf)))) # Names should have "param:curve" format + + # Check parameter name structure + pn <- result$parNames + expect_type(pn, "list") + expect_length(pn, 3) + + # Check that objList contains individual fits + expect_true(!is.null(result$objList)) + expect_length(result$objList, 2) # 2 curves + + # Check indexMat + expect_true(!is.null(result$indexMat)) + expect_equal(ncol(result$indexMat), 2) + expect_equal(nrow(result$indexMat), 4) # 4 parameters + + # Check data is combined + expect_true(nrow(result$data) > 0) + + # Check df.residual + expect_true(result$df.residual > 0) + + # Check minval + expect_true(is.numeric(result$minval)) + + # Check parmMat has correct dimensions + expect_equal(ncol(result$parmMat), 2) + + # Check curve function works (covers the plotFct closure on line 63) + curveFct <- result$curve[[1]] + pred <- curveFct(c(0.1, 1, 10)) + expect_true(is.matrix(pred)) + expect_equal(ncol(pred), 2) # 2 curves + expect_equal(nrow(pred), 3) # 3 dose values +}) + +test_that("idrm works with a list of functions (oneFunction = FALSE)", { + data(spinach) + # Call idrm directly with a list of fct specifications + # drm() validates fct before calling idrm(), so we need to call idrm directly + fctList <- list(LL.4(), LL.3()) + result <- drc:::idrm( + x = spinach$DOSE, + y = spinach$SLOPE, + curveid = spinach$HERBICIDE, + weights = rep(1, nrow(spinach)), + fct = fctList, + type = "continuous", + control = drmc() + ) + + # Should still return a drc object + expect_s3_class(result, "drc") +}) + +test_that("drm with separate = TRUE and only one curve gives warning", { + data(ryegrass) + # ryegrass has no curveid - only one level + expect_warning( + drm(rootl ~ conc, data = ryegrass, fct = LL.4(), separate = TRUE), + "Only one level" + ) +}) + +test_that("idrm result coefficients match individual fits", { + data(spinach) + # Fit with separate = TRUE + sep_fit <- drm(SLOPE ~ DOSE, HERBICIDE, data = spinach, fct = LL.4(), separate = TRUE) + + # Fit each curve individually + bentazon_fit <- drm(SLOPE ~ DOSE, data = subset(spinach, HERBICIDE == "bentazon"), fct = LL.4()) + diuron_fit <- drm(SLOPE ~ DOSE, data = subset(spinach, HERBICIDE == "diuron"), fct = LL.4()) + + # Coefficients should match between separate and individual fits + sep_coefs <- coef(sep_fit) + bent_coefs <- coef(bentazon_fit) + diur_coefs <- coef(diuron_fit) + + # Check bentazon coefficients + expect_equal(unname(sep_coefs[grep("bentazon", names(sep_coefs))]), + unname(bent_coefs), tolerance = 1e-4) + + # Check diuron coefficients + expect_equal(unname(sep_coefs[grep("diuron", names(sep_coefs))]), + unname(diur_coefs), tolerance = 1e-4) +}) + +test_that("idrm with separate = TRUE and three or more curves", { + # Create a dataset with 3 curves + set.seed(42) + dose <- rep(c(0, 1, 2, 5, 10, 20), each = 3) + n <- length(dose) + curve_id <- rep(c("A", "B", "C"), each = n) + dose_all <- rep(dose, 3) + + # Generate responses for 3 different curves + resp_A <- 1 / (1 + exp(2 * (log(dose + 0.001) - log(5)))) + rnorm(n, 0, 0.02) + resp_B <- 1 / (1 + exp(1.5 * (log(dose + 0.001) - log(3)))) + rnorm(n, 0, 0.02) + resp_C <- 1 / (1 + exp(1 * (log(dose + 0.001) - log(8)))) + rnorm(n, 0, 0.02) + resp_all <- c(resp_A, resp_B, resp_C) + + df <- data.frame(dose = dose_all, resp = resp_all, curve = factor(curve_id)) + + result <- drm(resp ~ dose, curve, data = df, fct = LL.4(), separate = TRUE) + + expect_s3_class(result, "drc") + expect_length(coef(result), 12) # 4 params * 3 curves + expect_equal(ncol(result$parmMat), 3) + expect_equal(ncol(result$indexMat), 3) + expect_length(result$objList, 3) +}) + +test_that("idrm dataList names are preserved from first fit", { + data(spinach) + result <- drm(SLOPE ~ DOSE, HERBICIDE, data = spinach, fct = LL.4(), separate = TRUE) + + # dataList should have a "names" element preserved from first fit + expect_true(!is.null(result$dataList$names)) +}) diff --git a/tests/testthat/test-isobole.R b/tests/testthat/test-isobole.R new file mode 100644 index 00000000..fe2892df --- /dev/null +++ b/tests/testthat/test-isobole.R @@ -0,0 +1,187 @@ +# tests/testthat/test-isobole.R +# Comprehensive tests for the isobole() function + +# --------------------------------------------------------------------------- +# Helper: fit the "free" (unconstrained EC50) model used by all isobole tests +# --------------------------------------------------------------------------- +fit_mecter_free <- function() { + drm(rgr ~ dose, pct, data = mecter, + fct = LL.4(), + pmodels = list(~1, ~1, ~1, ~factor(pct) - 1)) +} + +fit_acidiq_free <- function() { + drm(rgr ~ dose, pct, data = acidiq, + fct = LL.4(), + pmodels = list(~factor(pct), ~1, ~1, ~factor(pct) - 1)) +} + +# =========================================================================== +# 1. Basic / "happy path" – object1 only, default parameters +# =========================================================================== +test_that("isobole produces a plot with object1 only (default args)", { + m_free <- fit_mecter_free() + pdf(file = tempfile(fileext = ".pdf")) + on.exit(dev.off(), add = TRUE) + expect_no_error(isobole(m_free, exchange = 0.02)) +}) + +# =========================================================================== +# 2. Custom xlim / ylim supplied +# =========================================================================== +test_that("isobole respects user-supplied xlim and ylim", { + m_free <- fit_mecter_free() + pdf(file = tempfile(fileext = ".pdf")) + on.exit(dev.off(), add = TRUE) + expect_no_error( + isobole(m_free, exchange = 0.02, xlim = c(0, 500), ylim = c(0, 10)) + ) +}) + +# =========================================================================== +# 3. Custom xlab / ylab supplied +# =========================================================================== +test_that("isobole respects user-supplied xlab and ylab", { + m_free <- fit_mecter_free() + pdf(file = tempfile(fileext = ".pdf")) + on.exit(dev.off(), add = TRUE) + expect_no_error( + isobole(m_free, exchange = 0.02, xlab = "Substance A", ylab = "Substance B") + ) +}) + +# =========================================================================== +# 4. xaxis = "0" – axis swap path +# =========================================================================== +test_that("isobole swaps axes when xaxis = '0' (object1 only)", { + m_free <- fit_mecter_free() + pdf(file = tempfile(fileext = ".pdf")) + on.exit(dev.off(), add = TRUE) + expect_no_error(isobole(m_free, exchange = 0.02, xaxis = "0")) +}) + +# =========================================================================== +# 5. xaxis = "0" with custom labels (covers the else branch for labels) +# =========================================================================== +test_that("isobole with xaxis='0' auto-labels are '0' and '100'", { + m_free <- fit_mecter_free() + pdf(file = tempfile(fileext = ".pdf")) + on.exit(dev.off(), add = TRUE) + # Without explicit xlab/ylab, xaxis="0" should produce "0" and "100" as labels + + expect_no_error(isobole(m_free, exchange = 0.02, xaxis = "0")) +}) + +# =========================================================================== +# 6. object2 = CA model (concentration addition, lambda = 1) +# =========================================================================== +test_that("isobole draws CA isobole line", { + m_free <- fit_mecter_free() + m_ca <- mixture(m_free, model = "CA") + pdf(file = tempfile(fileext = ".pdf")) + on.exit(dev.off(), add = TRUE) + expect_no_error(isobole(m_free, m_ca, exchange = 0.02)) +}) + +# =========================================================================== +# 7. object2 = Hewlett model +# =========================================================================== +test_that("isobole draws Hewlett isobole line", { + m_free <- fit_mecter_free() + m_hew <- mixture(m_free, model = "Hewlett") + pdf(file = tempfile(fileext = ".pdf")) + on.exit(dev.off(), add = TRUE) + expect_no_error(isobole(m_free, m_hew, exchange = 0.02)) +}) + +# =========================================================================== +# 8. object2 = Voelund model +# =========================================================================== +test_that("isobole draws Voelund isobole line", { + m_free <- fit_mecter_free() + m_voe <- mixture(m_free, model = "Voelund") + pdf(file = tempfile(fileext = ".pdf")) + on.exit(dev.off(), add = TRUE) + expect_no_error(isobole(m_free, m_voe, exchange = 0.02)) +}) + +# =========================================================================== +# 9. object2 + xaxis = "0" (covers swap inside object2 block) +# =========================================================================== +test_that("isobole with object2 and xaxis='0' swaps correctly (CA)", { + m_free <- fit_mecter_free() + m_ca <- mixture(m_free, model = "CA") + pdf(file = tempfile(fileext = ".pdf")) + on.exit(dev.off(), add = TRUE) + expect_no_error(isobole(m_free, m_ca, exchange = 0.02, xaxis = "0")) +}) + +test_that("isobole with object2 and xaxis='0' swaps correctly (Voelund)", { + m_free <- fit_mecter_free() + m_voe <- mixture(m_free, model = "Voelund") + pdf(file = tempfile(fileext = ".pdf")) + on.exit(dev.off(), add = TRUE) + expect_no_error(isobole(m_free, m_voe, exchange = 0.02, xaxis = "0")) +}) + +# =========================================================================== +# 10. cifactor argument affects CI width +# =========================================================================== +test_that("isobole works with different cifactor values", { + m_free <- fit_mecter_free() + pdf(file = tempfile(fileext = ".pdf")) + on.exit(dev.off(), add = TRUE) + expect_no_error(isobole(m_free, exchange = 0.02, cifactor = 1)) +}) + +# =========================================================================== +# 11. Using a different dataset (acidiq) with Hewlett model +# =========================================================================== +test_that("isobole works with acidiq data and Hewlett model", { + m_free <- fit_acidiq_free() + m_hew <- mixture(m_free, model = "Hewlett") + pdf(file = tempfile(fileext = ".pdf")) + on.exit(dev.off(), add = TRUE) + expect_no_error( + isobole(m_free, m_hew, xlim = c(0, 400), ylim = c(0, 450)) + ) +}) + +# =========================================================================== +# 12. Hewlett model with xaxis = "0" (swap path inside non-voelund branch) +# =========================================================================== +test_that("isobole Hewlett with xaxis='0' swaps axes in object2 block", { + m_free <- fit_mecter_free() + m_hew <- mixture(m_free, model = "Hewlett") + pdf(file = tempfile(fileext = ".pdf")) + on.exit(dev.off(), add = TRUE) + expect_no_error(isobole(m_free, m_hew, exchange = 0.02, xaxis = "0")) +}) + +# =========================================================================== +# 13. All parameters supplied (full custom call) +# =========================================================================== +test_that("isobole with all custom parameters works", { + m_free <- fit_mecter_free() + m_voe <- mixture(m_free, model = "Voelund") + pdf(file = tempfile(fileext = ".pdf")) + on.exit(dev.off(), add = TRUE) + expect_no_error( + isobole(m_free, m_voe, exchange = 0.02, cifactor = 1, + xlab = "A", ylab = "B", xlim = c(0, 300), ylim = c(0, 6)) + ) +}) + +# =========================================================================== +# 14. Voelund with xaxis = "0" and custom limits +# =========================================================================== +test_that("isobole Voelund xaxis='0' with custom limits", { + m_free <- fit_mecter_free() + m_voe <- mixture(m_free, model = "Voelund") + pdf(file = tempfile(fileext = ".pdf")) + on.exit(dev.off(), add = TRUE) + expect_no_error( + isobole(m_free, m_voe, exchange = 0.02, xaxis = "0", + xlim = c(0, 10), ylim = c(0, 500)) + ) +}) diff --git a/tests/testthat/test-lgaussian.R b/tests/testthat/test-lgaussian.R new file mode 100644 index 00000000..ebd8680b --- /dev/null +++ b/tests/testthat/test-lgaussian.R @@ -0,0 +1,261 @@ +# Tests for lgaussian.R: lgaussian() function and its internal components + +# --- lgaussian() main function: structure and class --- + +test_that("lgaussian returns correct class and structure", { + lg <- lgaussian() + expect_s3_class(lg, "lgaussian") + expect_true(is.list(lg)) + expect_true(all(c("fct", "ssfct", "names", "deriv1", "deriv2", "derivx", + "edfct", "name", "text", "noParm", "fixed") %in% names(lg))) +}) + +test_that("lgaussian default names are b, c, d, e, f", { + lg <- lgaussian() + expect_equal(lg$names, c("b", "c", "d", "e", "f")) +}) + +test_that("lgaussian noParm reflects number of NA in fixed", { + lg_full <- lgaussian() + expect_equal(lg_full$noParm, 5) + + lg_partial <- lgaussian(fixed = c(1, NA, NA, NA, NA)) + expect_equal(lg_partial$noParm, 4) + expect_equal(lg_partial$names, c("c", "d", "e", "f")) +}) + +test_that("lgaussian uses default text when fctText not provided", { + lg <- lgaussian() + expect_equal(lg$text, "Log-Gaussian") +}) + +test_that("lgaussian uses provided fctText", { + lg <- lgaussian(fctText = "Custom text") + expect_equal(lg$text, "Custom text") +}) + +test_that("lgaussian uses provided fctName", { + lg <- lgaussian(fctName = "myFunc") + expect_equal(lg$name, "myFunc") +}) + +test_that("lgaussian default name when fctName not provided", { + lg <- lgaussian() + expect_equal(lg$name, "lgaussian") +}) + +# --- Error handling --- + +test_that("lgaussian errors on invalid names argument", { + expect_error(lgaussian(names = c("a", "b")), "Not correct 'names' argument") + expect_error(lgaussian(names = 123), "Not correct 'names' argument") +}) + +test_that("lgaussian errors on invalid fixed argument", { + expect_error(lgaussian(fixed = c(NA, NA)), "Not correct 'fixed' argument") + expect_error(lgaussian(fixed = c(NA, NA, NA)), "Not correct 'fixed' argument") +}) + +# --- Self-starter function (ssfct) --- + +test_that("lgaussian uses provided ssfct when not NULL", { + custom_ss <- function(dframe) { c(1, 0, 10, 5, 1) } + lg <- lgaussian(ssfct = custom_ss) + expect_identical(lg$ssfct, custom_ss) +}) + +test_that("lgaussian uses default ssfct when ssfct is NULL", { + lg <- lgaussian(ssfct = NULL) + expect_true(is.function(lg$ssfct)) +}) + +test_that("lgaussian method argument works for self-starter", { + # method selects different self-starter strategies in gaussian.ssf() + for (m in c("1", "2", "3", "4")) { + lg <- lgaussian(method = m) + expect_true(is.function(lg$ssfct)) + } +}) + +# --- loge parameter (present for API compatibility) --- + +test_that("lgaussian with loge=FALSE (default)", { + lg <- lgaussian(loge = FALSE) + expect_s3_class(lg, "lgaussian") + expect_true(is.function(lg$fct)) +}) + +test_that("lgaussian with loge=TRUE", { + lg <- lgaussian(loge = TRUE) + expect_s3_class(lg, "lgaussian") + expect_true(is.function(lg$fct)) +}) + +# --- fct (internal nonlinear function) --- + +test_that("lgaussian fct computes correct values", { + lg <- lgaussian() + # Parameters: b=1, c=0, d=100, e=5, f=2 + dose <- c(1, 5, 10) + parm <- matrix(c(1, 0, 100, 5, 2), nrow = 3, ncol = 5, byrow = TRUE) + result <- lg$fct(dose, parm) + # Model: c + (d-c)*exp(-0.5*(sqrt(((log(dose)-log(e))/b)^2))^f) + b <- 1; c_val <- 0; d_val <- 100; e_val <- 5; f_val <- 2 + expected <- c_val + (d_val - c_val) * exp(-0.5 * (sqrt(((log(dose) - log(e_val)) / b)^2))^f_val) + expect_equal(as.numeric(result), expected) +}) + +test_that("lgaussian fct at peak dose equals d parameter", { + lg <- lgaussian() + # At dose=e, log(dose)-log(e)=0, so result = c + (d-c)*exp(0) = d + dose <- c(5) + parm <- matrix(c(1, 0, 100, 5, 2), nrow = 1, ncol = 5, byrow = TRUE) + result <- lg$fct(dose, parm) + expect_equal(as.numeric(result), 100) +}) + +test_that("lgaussian fct works with fixed parameters", { + lg <- lgaussian(fixed = c(1, 0, NA, NA, 2)) + dose <- c(1, 5, 10) + # Only d and e are free + parm <- matrix(c(100, 5), nrow = 3, ncol = 2, byrow = TRUE) + result <- lg$fct(dose, parm) + b <- 1; c_val <- 0; d_val <- 100; e_val <- 5; f_val <- 2 + expected <- c_val + (d_val - c_val) * exp(-0.5 * (sqrt(((log(dose) - log(e_val)) / b)^2))^f_val) + expect_equal(as.numeric(result), expected) +}) + +test_that("lgaussian fct has gradient attribute", { + lg <- lgaussian() + dose <- c(1, 5, 10) + parm <- matrix(c(1, 0, 100, 5, 2), nrow = 3, ncol = 5, byrow = TRUE) + result <- lg$fct(dose, parm) + expect_true(!is.null(attr(result, "gradient"))) +}) + +# --- deriv1 (parameter derivatives) --- + +test_that("lgaussian deriv1 returns gradient matrix with correct dimensions", { + lg <- lgaussian() + dose <- c(1, 5, 10) + parm <- matrix(c(1, 0, 100, 5, 2), nrow = 3, ncol = 5, byrow = TRUE) + result <- lg$deriv1(dose, parm) + expect_true(is.matrix(result)) + expect_equal(nrow(result), 3) + expect_equal(ncol(result), 5) # all 5 params free +}) + +test_that("lgaussian deriv1 with fixed params reduces columns", { + lg <- lgaussian(fixed = c(1, 0, NA, NA, 2)) + dose <- c(1, 5, 10) + parm <- matrix(c(100, 5), nrow = 3, ncol = 2, byrow = TRUE) + result <- lg$deriv1(dose, parm) + expect_true(is.matrix(result)) + expect_equal(ncol(result), 2) # only d and e are free +}) + +# --- derivx (dose derivatives) --- + +test_that("lgaussian derivx returns gradient with correct dimensions", { + lg <- lgaussian() + dose <- c(1, 5, 10) + parm <- matrix(c(1, 0, 100, 5, 2), nrow = 3, ncol = 5, byrow = TRUE) + result <- lg$derivx(dose, parm) + expect_true(is.matrix(result)) + expect_equal(nrow(result), 3) + expect_equal(ncol(result), 1) +}) + +test_that("lgaussian derivx with fixed parameters", { + lg <- lgaussian(fixed = c(1, 0, NA, NA, 2)) + dose <- c(1, 5, 10) + parm <- matrix(c(100, 5), nrow = 3, ncol = 2, byrow = TRUE) + result <- lg$derivx(dose, parm) + expect_true(is.matrix(result)) + expect_equal(nrow(result), 3) + expect_equal(ncol(result), 1) +}) + +# --- edfct (effective dose function) --- + +test_that("lgaussian edfct returns list with ED and gradient (relative)", { + lg <- lgaussian() + parm <- c(1, 0, 100, 5, 2) + result <- lg$edfct(parm, respl = 50, reference = "control", type = "relative") + expect_true(is.list(result)) + expect_equal(length(result), 2) + expect_true(is.numeric(result[[1]])) + # Gradient should have 5 elements (all params free) + expect_equal(length(result[[2]]), 5) +}) + +test_that("lgaussian edfct works with absolute type", { + lg <- lgaussian() + parm <- c(1, 0, 100, 5, 2) + result <- lg$edfct(parm, respl = 50, reference = "control", type = "absolute") + expect_true(is.list(result)) + expect_equal(length(result), 2) + expect_true(is.numeric(result[[1]])) +}) + +test_that("lgaussian edfct works with negative b and control reference (relative)", { + lg <- lgaussian() + parm <- c(-1, 0, 100, 5, 2) + result <- lg$edfct(parm, respl = 50, reference = "control", type = "relative") + expect_true(is.list(result)) + expect_equal(length(result), 2) + expect_true(is.numeric(result[[1]])) +}) + +test_that("lgaussian edfct works with positive b and control reference (relative)", { + lg <- lgaussian() + parm <- c(1, 0, 100, 5, 2) + result <- lg$edfct(parm, respl = 50, reference = "control", type = "relative") + expect_true(is.list(result)) + expect_true(is.numeric(result[[1]])) +}) + +test_that("lgaussian edfct with fixed parameters", { + lg <- lgaussian(fixed = c(1, 0, NA, NA, 2)) + parm <- c(100, 5) + result <- lg$edfct(parm, respl = 50, reference = "control", type = "relative") + expect_true(is.list(result)) + expect_equal(length(result[[2]]), 2) # only free params +}) + +test_that("lgaussian edfct at different response levels", { + lg <- lgaussian() + parm <- c(1, 0, 100, 5, 2) + result10 <- lg$edfct(parm, respl = 10, reference = "control", type = "relative") + result90 <- lg$edfct(parm, respl = 90, reference = "control", type = "relative") + expect_true(is.numeric(result10[[1]])) + expect_true(is.numeric(result90[[1]])) +}) + +# --- lowerAs, upperAs, monoton --- + +test_that("lgaussian lowerAs and upperAs return correct values", { + lg <- lgaussian() + # lowerAs extracts parameter 2 (c), upperAs extracts parameter 3 (d) + parm <- c(1, 0, 100, 5, 2) + expect_equal(lg$lowerAs(parm), 0) + expect_equal(lg$upperAs(parm), 100) +}) + +test_that("lgaussian monoton is NA", { + lg <- lgaussian() + expect_true(is.na(lg$monoton)) +}) + +# --- Fixed parameter edge cases --- + +test_that("lgaussian with all parameters fixed", { + lg <- lgaussian(fixed = c(1, 0, 100, 5, 2)) + expect_equal(lg$noParm, 0) + expect_equal(length(lg$names), 0) +}) + +test_that("lgaussian deriv2 is NULL", { + lg <- lgaussian() + expect_null(lg$deriv2) +}) diff --git a/tests/testthat/test-lin.test.R b/tests/testthat/test-lin.test.R new file mode 100644 index 00000000..23a5d880 --- /dev/null +++ b/tests/testthat/test-lin.test.R @@ -0,0 +1,170 @@ +# Tests for lin.test() function +# Lack-of-fit test for the mean structure based on cumulated residuals + +# ---- Setup: create reusable model objects ---- + +# Model WITH replicates (ryegrass: 24 obs, 7 unique doses) +ryegrass_data <- data.frame( + rootl = c(7.58, 8.0, 8.33, 7.25, 7.37, 7.96, 8.36, 6.91, 7.75, + 6.87, 6.45, 5.92, 1.93, 2.89, 4.23, 1.19, 0.86, 1.06, + 0.69, 0.52, 0.82, 0.25, 0.22, 0.44), + conc = c(0, 0, 0, 0, 0, 0, 0.94, 0.94, 0.94, + 1.88, 1.88, 1.88, 3.75, 3.75, 3.75, 7.5, 7.5, 7.5, + 15, 15, 15, 30, 30, 30) +) + +# Model WITHOUT replicates (unique x values only) +norep_data <- data.frame( + resp = c(7.5, 7.0, 6.5, 5.5, 4.0, 2.5, 1.5, 0.8, 0.4, 0.2), + dose = c(0, 0.5, 1, 2, 4, 8, 16, 32, 64, 128) +) + + +# =========================================================== +# Test block 1: Basic functionality with replicates +# =========================================================== +test_that("lin.test returns numeric p-value with replicate data", { + m_rep <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + pval <- lin.test(m_rep, noksSim = 20, plotit = FALSE) + expect_true(is.numeric(pval)) + expect_length(pval, 1) + expect_true(pval >= 0 && pval <= 1) +}) + + +# =========================================================== +# Test block 2: Basic functionality without replicates +# =========================================================== +test_that("lin.test returns numeric p-value without replicate data", { + m_norep <- drm(resp ~ dose, data = norep_data, fct = LL.4()) + pval <- lin.test(m_norep, noksSim = 20, plotit = FALSE) + expect_true(is.numeric(pval)) + expect_length(pval, 1) + expect_true(pval >= 0 && pval <= 1) +}) + + +# =========================================================== +# Test block 3: Reproducibility via seed +# =========================================================== +test_that("lin.test produces reproducible results with same seed", { + m_rep <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + pval1 <- lin.test(m_rep, noksSim = 50, seed = 42, plotit = FALSE) + pval2 <- lin.test(m_rep, noksSim = 50, seed = 42, plotit = FALSE) + expect_identical(pval1, pval2) +}) + + +# =========================================================== +# Test block 4: seed = NULL path +# =========================================================== +test_that("lin.test works with seed = NULL", { + m_rep <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + pval <- lin.test(m_rep, noksSim = 20, seed = NULL, plotit = FALSE) + expect_true(is.numeric(pval)) + expect_length(pval, 1) + expect_true(pval >= 0 && pval <= 1) +}) + + +# =========================================================== +# Test block 5: Plotting with default parameters (log="", missing ylim/xlab/ylab) +# Covers: plotit=TRUE, log="" (else branch), missing(ylim), missing(xlab), missing(ylab) +# =========================================================== +test_that("lin.test plots with default parameters (replicates)", { + m_rep <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + pdf(NULL) # suppress graphical output + on.exit(dev.off(), add = TRUE) + pval <- lin.test(m_rep, noksSim = 10, plotit = TRUE) + expect_true(is.numeric(pval)) +}) + + +# =========================================================== +# Test block 6: Plotting with log="x" +# Covers: if (identical(log, "x")) branch +# =========================================================== +test_that("lin.test plots with log='x' scale (replicates)", { + m_rep <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + pdf(NULL) + on.exit(dev.off(), add = TRUE) + pval <- lin.test(m_rep, noksSim = 10, plotit = TRUE, log = "x") + expect_true(is.numeric(pval)) +}) + + +# =========================================================== +# Test block 7: Plotting with custom ylim +# Covers: else branch of if (missing(ylim)) +# =========================================================== +test_that("lin.test plots with custom ylim", { + m_rep <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + pdf(NULL) + on.exit(dev.off(), add = TRUE) + pval <- lin.test(m_rep, noksSim = 10, plotit = TRUE, ylim = c(-5, 5)) + expect_true(is.numeric(pval)) +}) + + +# =========================================================== +# Test block 8: Plotting with custom xlab and ylab +# Covers: non-missing xlab and ylab paths in ifelse() +# =========================================================== +test_that("lin.test plots with custom xlab and ylab", { + m_rep <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + pdf(NULL) + on.exit(dev.off(), add = TRUE) + pval <- lin.test(m_rep, noksSim = 10, plotit = TRUE, + xlab = "Dose (mg/L)", ylab = "Cum. Residuals") + expect_true(is.numeric(pval)) +}) + + +# =========================================================== +# Test block 9: Plotting without replicates (repAdjust=FALSE + plotit=TRUE) +# =========================================================== +test_that("lin.test plots without replicates (repAdjust=FALSE)", { + m_norep <- drm(resp ~ dose, data = norep_data, fct = LL.4()) + pdf(NULL) + on.exit(dev.off(), add = TRUE) + pval <- lin.test(m_norep, noksSim = 10, plotit = TRUE) + expect_true(is.numeric(pval)) +}) + + +# =========================================================== +# Test block 10: Plotting without replicates with log="x" +# =========================================================== +test_that("lin.test plots without replicates with log='x'", { + m_norep <- drm(resp ~ dose, data = norep_data, fct = LL.4()) + pdf(NULL) + on.exit(dev.off(), add = TRUE) + pval <- lin.test(m_norep, noksSim = 10, plotit = TRUE, log = "x") + expect_true(is.numeric(pval)) +}) + + +# =========================================================== +# Test block 11: All optional plot params together +# Covers: custom ylim + xlab + ylab + log="x" combined +# =========================================================== +test_that("lin.test plots with all custom parameters combined", { + m_rep <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + pdf(NULL) + on.exit(dev.off(), add = TRUE) + pval <- lin.test(m_rep, noksSim = 10, plotit = TRUE, + log = "x", ylim = c(-3, 3), + xlab = "Concentration", ylab = "Residuals") + expect_true(is.numeric(pval)) +}) + + +# =========================================================== +# Test block 12: Different noksSim values +# =========================================================== +test_that("lin.test works with different noksSim values", { + m_rep <- drm(rootl ~ conc, data = ryegrass_data, fct = LL.4()) + pval <- lin.test(m_rep, noksSim = 5, plotit = FALSE) + expect_true(is.numeric(pval)) + expect_length(pval, 1) +}) diff --git a/tests/testthat/test-llogistic.R b/tests/testthat/test-llogistic.R new file mode 100644 index 00000000..7b06815a --- /dev/null +++ b/tests/testthat/test-llogistic.R @@ -0,0 +1,249 @@ +# Tests for llogistic.R: llogistic(), LL.2(), LL.3(), LL.3u(), LL.4(), LL.5() + +# Create test dataset used throughout +ryegrass <- data.frame( + rootl = c( + 7.58, 8.00, 8.33, 7.25, 7.17, 7.00, 7.17, 7.83, 7.92, 7.58, + 6.17, 5.75, 5.83, 6.00, 5.83, 4.92, 4.50, 4.17, 4.42, 4.00, + 2.67, 2.08, 2.42, 2.50, 2.25, 1.17, 0.75, 0.92, 1.00, 0.58 + ), + conc = c( + rep(0, 5), rep(0.94, 5), rep(1.88, 5), + rep(3.75, 5), rep(7.50, 5), rep(15, 5) + ) +) + +# --- llogistic() main function --- + +test_that("llogistic returns correct class and structure", { + ll <- llogistic() + expect_s3_class(ll, "llogistic") + expect_true(is.list(ll)) + expect_true(all(c("fct", "ssfct", "names", "deriv1", "deriv2", + "edfct", "name", "text", "noParm") %in% names(ll))) +}) + +test_that("llogistic default names are b, c, d, e, f", { + ll <- llogistic() + expect_equal(ll$names, c("b", "c", "d", "e", "f")) +}) + +test_that("llogistic noParm reflects number of NA in fixed", { + ll_full <- llogistic() + expect_equal(ll_full$noParm, 5) + + ll_partial <- llogistic(fixed = c(1, NA, NA, NA, NA)) + expect_equal(ll_partial$noParm, 4) + expect_equal(ll_partial$names, c("c", "d", "e", "f")) +}) + +test_that("llogistic errors on invalid names argument", { + expect_error(llogistic(names = c("a", "b")), "Not correct 'names' argument") + expect_error(llogistic(names = 123), "Not correct 'names' argument") +}) + +test_that("llogistic errors on invalid fixed argument", { + expect_error(llogistic(fixed = c(NA, NA)), "Not correct 'fixed' argument") + expect_error(llogistic(fixed = c(NA, NA, NA)), "Not correct 'fixed' argument") +}) + +# --- fct function tests --- + +test_that("llogistic fct computes correct values", { + ll <- llogistic() + + # f(x) = c + (d-c) / (1 + exp(b*log(x/e)))^f + # b=1, c=0, d=1, e=2, f=1: f(2) = 0 + (1-0) / (1+exp(1*log(2/2)))^1 = 1 / (1+1)^1 = 0.5 + dose <- 2 + parm <- matrix(c(1, 0, 1, 2, 1), nrow = 1, ncol = 5) + result <- ll$fct(dose, parm) + expect_equal(as.numeric(result), 0.5, tolerance = 1e-10) +}) + +test_that("llogistic fct handles multiple doses", { + ll <- llogistic() + + dose <- c(1, 2, 4) + parm <- matrix(c(1, 0, 1, 2, 1), nrow = 3, ncol = 5, byrow = TRUE) + result <- ll$fct(dose, parm) + + # Manual calculations: f(x) = 1/(1 + exp(log(x/2)))^1 = 1/(1 + x/2) + expected <- 1 / (1 + dose / 2) + expect_equal(as.numeric(result), expected, tolerance = 1e-10) +}) + +test_that("llogistic fct at ED50 gives midpoint (f=1)", { + ll <- llogistic() + + # At dose = e, response should be (c + d)/2 for f=1 + dose <- 5 + parm <- matrix(c(2, 0, 10, 5, 1), nrow = 1, ncol = 5) + result <- ll$fct(dose, parm) + expected <- (0 + 10) / 2 + expect_equal(as.numeric(result), expected, tolerance = 1e-10) +}) + +test_that("llogistic fct works with f != 1 (asymmetric)", { + ll <- llogistic() + + # b=1, c=0, d=1, e=1, f=2 + dose <- 1 + parm <- matrix(c(1, 0, 1, 1, 2), nrow = 1, ncol = 5) + result <- ll$fct(dose, parm) + # f(1) = 0 + (1-0)/(1 + exp(0))^2 = 1/4 + expect_equal(as.numeric(result), 0.25, tolerance = 1e-10) +}) + +# --- LL.2 wrapper --- + +test_that("LL.2 returns correct class and structure", { + ll2 <- LL.2() + expect_s3_class(ll2, "llogistic") + expect_equal(ll2$noParm, 2) + expect_equal(ll2$names, c("b", "e")) +}) + +test_that("LL.2 text indicates fixed limits", { + ll2 <- LL.2(upper = 1) + expect_true(grepl("lower limit at 0", ll2$text)) + expect_true(grepl("upper limit at 1", ll2$text)) +}) + +test_that("LL.2 errors on invalid names", { + expect_error(LL.2(names = c("x")), "Not correct 'names' argument") + expect_error(LL.2(names = 99), "Not correct 'names' argument") +}) + +test_that("LL.2 errors on invalid fixed", { + expect_error(LL.2(fixed = c(NA)), "Not correct length of 'fixed' argument") +}) + +# --- LL.3 wrapper --- + +test_that("LL.3 returns correct class and structure", { + ll3 <- LL.3() + expect_s3_class(ll3, "llogistic") + expect_equal(ll3$noParm, 3) + expect_equal(ll3$names, c("b", "d", "e")) +}) + +test_that("LL.3 text indicates lower limit fixed", { + ll3 <- LL.3() + expect_true(grepl("lower limit at 0", ll3$text)) +}) + +test_that("LL.3 errors on invalid names", { + expect_error(LL.3(names = c("x")), "Not correct 'names' argument") + expect_error(LL.3(names = 99), "Not correct 'names' argument") +}) + +test_that("LL.3 errors on invalid fixed", { + expect_error(LL.3(fixed = c(NA, NA)), "Not correct length of 'fixed' argument") +}) + +# --- LL.3u wrapper --- + +test_that("LL.3u returns correct class and structure", { + ll3u <- LL.3u() + expect_s3_class(ll3u, "llogistic") + expect_equal(ll3u$noParm, 3) + expect_equal(ll3u$names, c("b", "c", "e")) +}) + +test_that("LL.3u text indicates upper limit fixed", { + ll3u <- LL.3u(upper = 1) + expect_true(grepl("upper limit at 1", ll3u$text)) +}) + +test_that("LL.3u errors on invalid names", { + expect_error(LL.3u(names = c("x")), "Not correct 'names' argument") + expect_error(LL.3u(names = 99), "Not correct 'names' argument") +}) + +test_that("LL.3u errors on invalid fixed", { + expect_error(LL.3u(fixed = c(NA, NA)), "Not correct length of 'fixed' argument") +}) + +# --- LL.4 wrapper --- + +test_that("LL.4 returns correct class and structure", { + ll4 <- LL.4() + expect_s3_class(ll4, "llogistic") + expect_equal(ll4$noParm, 4) + expect_equal(ll4$names, c("b", "c", "d", "e")) +}) + +test_that("LL.4 errors on invalid fixed", { + expect_error(LL.4(fixed = c(NA, NA, NA)), "Not correct length of 'fixed' argument") +}) + +test_that("LL.4 errors on invalid names", { + expect_error(LL.4(names = c("a", "b")), "Not correct names argument") + expect_error(LL.4(names = 123), "Not correct names argument") +}) + +# --- LL.5 wrapper --- + +test_that("LL.5 returns correct class and structure", { + ll5 <- LL.5() + expect_s3_class(ll5, "llogistic") + expect_equal(ll5$noParm, 5) + expect_equal(ll5$names, c("b", "c", "d", "e", "f")) +}) + +test_that("LL.5 text indicates generalized model", { + ll5 <- LL.5() + expect_true(grepl("Generalized", ll5$text)) +}) + +# --- Aliases --- + +test_that("l2, l3, l3u, l4, l5 are aliases for LL.2, LL.3, LL.3u, LL.4, LL.5", { + expect_identical(l2, LL.2) + expect_identical(l3, LL.3) + expect_identical(l3u, LL.3u) + expect_identical(l4, LL.4) + expect_identical(l5, LL.5) +}) + +# --- deriv1 tests --- + +test_that("llogistic deriv1 returns matrix with correct dimensions", { + ll <- llogistic() + dose <- c(1, 2, 5) + parm <- matrix(c(1, 0, 1, 2, 1), nrow = 3, ncol = 5, byrow = TRUE) + result <- ll$deriv1(dose, parm) + expect_true(is.matrix(result)) + expect_equal(nrow(result), 3) + expect_equal(ncol(result), 5) +}) + +test_that("llogistic deriv1 computes finite values", { + ll <- llogistic() + dose <- c(0.5, 1, 3) + parm <- matrix(c(2, 0, 1, 3, 1), nrow = 3, ncol = 5, byrow = TRUE) + result <- ll$deriv1(dose, parm) + expect_true(all(is.finite(result))) +}) + +# --- Integration tests using drm --- + +test_that("LL.4 works in drm model fitting", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + expect_s3_class(m1, "drc") + expect_equal(length(coef(m1)), 4) + preds <- predict(m1) + expect_true(all(is.finite(preds))) +}) + +test_that("LL.3 works in drm model fitting", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.3()) + expect_s3_class(m1, "drc") + expect_equal(length(coef(m1)), 3) +}) + +test_that("LL.5 works in drm model fitting", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.5()) + expect_s3_class(m1, "drc") + expect_equal(length(coef(m1)), 5) +}) diff --git a/tests/testthat/test-llogistic2.R b/tests/testthat/test-llogistic2.R new file mode 100644 index 00000000..f594ed6e --- /dev/null +++ b/tests/testthat/test-llogistic2.R @@ -0,0 +1,505 @@ +# Tests for llogistic2.R: llogistic2(), LL2.2(), LL2.3(), LL2.3u(), LL2.4(), LL2.5() +# and helper functions: lowFixed(), upFixed(), lowupFixed() + +# ============================================================================== +# Test: llogistic2() argument validation +# ============================================================================== + +test_that("llogistic2 errors on invalid 'names' argument", { + expect_error(llogistic2(names = c("a", "b")), "Not correct 'names' argument") + expect_error(llogistic2(names = 123), "Not correct 'names' argument") +}) + +test_that("llogistic2 errors on invalid 'fixed' argument", { + expect_error(llogistic2(fixed = c(NA, NA)), "Not correct 'fixed' argument") + expect_error(llogistic2(fixed = c(NA, NA, NA)), "Not correct 'fixed' argument") +}) + +# ============================================================================== +# Test: llogistic2() return structure +# ============================================================================== + +test_that("llogistic2 returns object of class 'llogistic'", { + result <- llogistic2() + expect_s3_class(result, "llogistic") + expect_true(is.list(result)) +}) + +test_that("llogistic2 return list has correct structure", { + result <- llogistic2() + expect_true(is.function(result$fct)) + expect_true(is.function(result$ssfct)) + expect_true(is.function(result$deriv1)) + expect_null(result$deriv2) + expect_true(is.function(result$derivx)) + expect_true(is.function(result$edfct)) + expect_true(is.function(result$inversion)) + expect_true(is.function(result$bfct)) + expect_equal(result$noParm, 5) + expect_equal(result$names, c("b", "c", "d", "e", "f")) +}) + +test_that("llogistic2 default name and text are correct", { + result <- llogistic2() + expect_equal(result$name, "llogistic2") + expect_equal(result$text, "Log-logistic (log(ED50) as parameter)") +}) + +test_that("llogistic2 custom fctName and fctText override defaults", { + result <- llogistic2(fctName = "myModel", fctText = "my description") + expect_equal(result$name, "myModel") + expect_equal(result$text, "my description") +}) + +test_that("llogistic2 handles fixed parameters correctly", { + result <- llogistic2(fixed = c(NA, 0, NA, NA, 1)) + expect_equal(result$noParm, 3) + expect_equal(result$names, c("b", "d", "e")) +}) + +test_that("llogistic2 uses custom ssfct when provided", { + custom_ss <- function(dframe) { c(1, 0, 100, 5, 1) } + result <- llogistic2(ssfct = custom_ss) + expect_identical(result$ssfct, custom_ss) +}) + +# ============================================================================== +# Test: bfct (basic nonlinear function) +# ============================================================================== + +test_that("llogistic2 bfct produces expected values", { + mod <- llogistic2() + # parm: b, c, d, e, f + # bfct(x, parm) = parm[2] + (parm[3]-parm[2])/((1+(x/exp(parm[4]))^parm[1]))^parm[5] + # With b=1, c=0, d=100, e=log(5), f=1: + # At x=5: 0 + 100/((1+(5/5)^1))^1 = 100/2 = 50 + result <- mod$bfct(5, c(1, 0, 100, log(5), 1)) + expect_equal(result, 50, tolerance = 1e-10) +}) + +# ============================================================================== +# Test: fct (nonlinear function) +# ============================================================================== + +test_that("llogistic2 fct produces expected values with all parameters free", { + mod <- llogistic2() + # Parameters: b, c, d, e(log scale), f + # fct = c + (d-c)/((1+exp(b*(log(dose)-e)))^f) + # With b=1, c=0, d=100, e=log(5), f=1: + # At dose=5: 0 + 100/((1+exp(1*(log(5)-log(5))))^1) = 100/(1+1) = 50 + parm <- matrix(c(1, 0, 100, log(5), 1), nrow = 1) + result <- mod$fct(5, parm) + expect_equal(result, 50, tolerance = 1e-10) +}) + +test_that("llogistic2 fct handles fixed parameters", { + mod <- llogistic2(fixed = c(NA, 0, NA, NA, 1)) + parm <- matrix(c(1, 100, log(5)), nrow = 1) + result <- mod$fct(5, parm) + expect_equal(result, 50, tolerance = 1e-10) +}) + +test_that("llogistic2 fct handles multiple doses", { + mod <- llogistic2() + parm <- matrix(rep(c(1, 0, 100, log(5), 1), each = 3), nrow = 3) + doses <- c(1, 5, 25) + result <- mod$fct(doses, parm) + expect_length(result, 3) + expect_equal(result[2], 50, tolerance = 1e-10) +}) + +# ============================================================================== +# Test: deriv1 (first derivatives in parameters) +# ============================================================================== + +test_that("llogistic2 deriv1 returns correct dimensions", { + mod <- llogistic2() + parm <- matrix(c(1, 0, 100, log(5), 1), nrow = 1) + result <- mod$deriv1(5, parm) + expect_length(result, 5) +}) + +test_that("llogistic2 deriv1 works with fixed parameters", { + mod <- llogistic2(fixed = c(NA, 0, NA, NA, 1)) + parm <- matrix(c(1, 100, log(5)), nrow = 1) + result <- mod$deriv1(5, parm) + expect_length(result, 3) +}) + +test_that("llogistic2 deriv1 handles multiple rows", { + mod <- llogistic2() + parm <- matrix(c(1, 0, 100, log(5), 1, + 2, 10, 90, log(3), 1), nrow = 2, byrow = TRUE) + doses <- c(5, 3) + result <- mod$deriv1(doses, parm) + expect_true(is.matrix(result)) + expect_equal(nrow(result), 2) + expect_equal(ncol(result), 5) +}) + +# ============================================================================== +# Test: derivx (first derivative in dose) +# ============================================================================== + +test_that("llogistic2 derivx returns correct structure", { + mod <- llogistic2() + dose <- c(1, 5, 10) + parm <- matrix(c(1, 0, 100, log(5), 1), nrow = 3, ncol = 5, byrow = TRUE) + result <- mod$derivx(dose, parm) + expect_length(result, 3) + expect_true(all(is.finite(result))) +}) + +test_that("llogistic2 derivx works with fixed parameters", { + mod <- llogistic2(fixed = c(NA, 0, NA, NA, 1)) + dose <- c(1, 5, 10) + parm <- matrix(c(1, 100, log(5)), nrow = 3, ncol = 3, byrow = TRUE) + result <- mod$derivx(dose, parm) + expect_length(result, 3) +}) + +# ============================================================================== +# Test: edfct (effective dose function) +# ============================================================================== + +test_that("llogistic2 edfct works with relative type", { + mod <- llogistic2() + parm <- c(1, 0, 100, log(5), 1) + result <- mod$edfct(parm, 50, reference = "control", type = "relative") + expect_true(is.list(result)) + expect_length(result, 2) + expect_true(is.numeric(result[[1]])) + # ED50: lEDp = e + log(100/(100-50)^(1/f) - 1)/b = log(5) + log(2^1 - 1)/1 = log(5) + 0 + expect_equal(result[[1]], log(5), tolerance = 1e-10) +}) + +test_that("llogistic2 edfct returns gradient of correct length with fixed params", { + mod <- llogistic2(fixed = c(NA, 0, NA, NA, 1)) + parm <- c(1, 100, log(5)) + result <- mod$edfct(parm, 50, reference = "control", type = "relative") + expect_length(result[[2]], 3) +}) + +# ============================================================================== +# Test: invfct (inverse function) +# ============================================================================== + +test_that("llogistic2 invfct returns correct value", { + mod <- llogistic2() + # b=1, c=0, d=100, e=log(5), f=1 + # invfct(y) = exp(log(((d-c)/(y-c))^(1/f) - 1)/b + e) + # invfct(50) = exp(log(((100-0)/(50-0))^1 - 1)/1 + log(5)) = exp(0 + log(5)) = 5 + result <- mod$inversion(50, c(1, 0, 100, log(5), 1)) + expect_equal(result, 5, tolerance = 1e-10) +}) + +test_that("llogistic2 invfct is consistent with fct", { + mod <- llogistic2() + parms <- c(1, 0, 100, log(5), 1) + dose <- 3 + parm_matrix <- matrix(parms, nrow = 1) + y <- mod$fct(dose, parm_matrix) + x_recovered <- mod$inversion(y, parms) + expect_equal(x_recovered, dose, tolerance = 1e-10) +}) + +test_that("llogistic2 invfct handles fixed parameters", { + mod <- llogistic2(fixed = c(NA, 0, NA, NA, 1)) + result <- mod$inversion(50, c(1, 100, log(5))) + expect_equal(result, 5, tolerance = 1e-10) +}) + +# ============================================================================== +# Test: Self-starter ss="1" (version 1, default) +# ============================================================================== + +test_that("llogistic2 ss=1 ssfct computes start values for normal data", { + mod <- llogistic2(ss = "1") + # Create typical dose-response data + dframe <- data.frame( + dose = c(0.1, 0.5, 1, 2, 5, 10, 50, 100), + resp = c(95, 85, 75, 55, 25, 10, 3, 1) + ) + result <- mod$ssfct(dframe) + expect_length(result, 5) + expect_true(all(is.finite(result))) +}) + +test_that("llogistic2 ss=1 ssfct returns early for single unique dose", { + mod <- llogistic2(ss = "1") + # All same dose + dframe <- data.frame(dose = rep(5, 5), resp = c(45, 50, 55, 48, 52)) + result <- mod$ssfct(dframe) + # Should return c(NA, NA, max(y)+0.001, NA, NA)[notFixed] which is all 5 values + # since all 5 params are free + expect_length(result, 5) + # Only d should be non-NA + expect_true(is.na(result[1])) # b is NA + expect_true(is.na(result[2])) # c is NA + expect_true(!is.na(result[3])) # d is max(y) + 0.001 + expect_true(is.na(result[4])) # e is NA + expect_true(is.na(result[5])) # f is NA +}) + +# ============================================================================== +# Test: Self-starter ss="2" (version 2) +# ============================================================================== + +test_that("llogistic2 ss=2 ssfct computes start values for normal data", { + mod <- llogistic2(ss = "2") + dframe <- data.frame( + dose = c(0.1, 0.5, 1, 2, 5, 10, 50, 100), + resp = c(95, 85, 75, 55, 25, 10, 3, 1) + ) + result <- mod$ssfct(dframe) + expect_length(result, 5) + expect_true(all(is.finite(result))) +}) + +test_that("llogistic2 ss=2 ssfct returns early for single unique dose", { + mod <- llogistic2(ss = "2") + dframe <- data.frame(dose = rep(5, 5), resp = c(45, 50, 55, 48, 52)) + result <- mod$ssfct(dframe) + expect_length(result, 5) + expect_true(is.na(result[1])) # b + expect_true(is.na(result[2])) # c + expect_true(!is.na(result[3])) # d + expect_true(is.na(result[4])) # e + expect_true(is.na(result[5])) # f +}) + +test_that("llogistic2 ss=2 ssfct uses fixed c and d when specified", { + mod <- llogistic2(ss = "2", fixed = c(NA, 0, 100, NA, NA)) + dframe <- data.frame( + dose = c(0.1, 0.5, 1, 2, 5, 10, 50, 100), + resp = c(95, 85, 75, 55, 25, 10, 3, 1) + ) + result <- mod$ssfct(dframe) + # With c=0 and d=100 fixed, only 3 free params: b, e, f + expect_length(result, 3) + expect_true(all(is.finite(result))) +}) + +# ============================================================================== +# Test: Self-starter ss="3" (version 3) +# ============================================================================== + +test_that("llogistic2 ss=3 ssfct computes start values for normal data", { + mod <- llogistic2(ss = "3") + dframe <- data.frame( + dose = c(1, 2, 3, 5, 10, 20, 50, 100), + resp = c(95, 85, 75, 55, 25, 10, 3, 1) + ) + result <- mod$ssfct(dframe) + expect_length(result, 5) + expect_true(all(is.finite(result))) +}) + +test_that("llogistic2 ss=3 ssfct returns early for single unique dose", { + mod <- llogistic2(ss = "3") + dframe <- data.frame(dose = rep(5, 5), resp = c(45, 50, 55, 48, 52)) + result <- mod$ssfct(dframe) + expect_length(result, 5) + expect_true(is.na(result[1])) + expect_true(is.na(result[2])) + expect_true(!is.na(result[3])) + expect_true(is.na(result[4])) + expect_true(is.na(result[5])) +}) + +test_that("llogistic2 ss=3 ssfct uses fixed c and d when specified", { + mod <- llogistic2(ss = "3", fixed = c(NA, 0, 100, NA, NA)) + dframe <- data.frame( + dose = c(1, 2, 3, 5, 10, 20, 50, 100), + resp = c(95, 85, 75, 55, 25, 10, 3, 1) + ) + result <- mod$ssfct(dframe) + expect_length(result, 3) + expect_true(all(is.finite(result))) +}) + +# ============================================================================== +# Test: lowerAs, upperAs, monoton helper functions +# ============================================================================== + +test_that("llogistic2 lowerAs and upperAs functions work", { + mod <- llogistic2() + parms <- c(1, 0, 100, log(5), 1) + expect_equal(mod$lowerAs(parms), 0) + expect_equal(mod$upperAs(parms), 100) +}) + +test_that("llogistic2 monoton function works", { + mod <- llogistic2() + parms <- c(1, 0, 100, log(5), 1) + result <- mod$monoton(parms) + # monoParm with signVal=-1 and parmNo=1: -1 * parmVec[1] = -1 * 1 = -1 + expect_equal(result, -1) +}) + +# ============================================================================== +# Test: LL2.2() wrapper +# ============================================================================== + +test_that("LL2.2 returns correct class and structure", { + result <- LL2.2() + expect_s3_class(result, "llogistic") + expect_equal(result$noParm, 2) + expect_equal(result$names, c("b", "e")) +}) + +test_that("LL2.2 with custom upper limit", { + result <- LL2.2(upper = 100) + expect_true(grepl("upper limit at 100", result$text)) +}) + +test_that("LL2.2 errors on invalid names", { + expect_error(LL2.2(names = c("a")), "Not correct 'names' argument") + expect_error(LL2.2(names = 42), "Not correct 'names' argument") +}) + +test_that("LL2.2 errors on invalid fixed", { + expect_error(LL2.2(fixed = c(NA)), "Not correct length of 'fixed' argument") + expect_error(LL2.2(fixed = c(NA, NA, NA)), "Not correct length of 'fixed' argument") +}) + +test_that("LL2.2 fct computes correctly", { + mod <- LL2.2(upper = 1) + dose <- c(0.5, 1, 2) + # free: b, e; fixed: c=0, d=1, f=1 + parm <- matrix(c(1, log(1)), nrow = 3, ncol = 2, byrow = TRUE) + result <- mod$fct(dose, parm) + # f(x) = 0 + (1-0)/((1+exp(1*(log(x)-log(1))))^1) = 1/(1+x) + expected <- 1 / (1 + dose) + expect_equal(result, expected, tolerance = 1e-10) +}) + +# ============================================================================== +# Test: LL2.3() wrapper +# ============================================================================== + +test_that("LL2.3 returns correct class and structure", { + result <- LL2.3() + expect_s3_class(result, "llogistic") + expect_equal(result$noParm, 3) + expect_equal(result$names, c("b", "d", "e")) +}) + +test_that("LL2.3 text indicates lower limit fixed at 0", { + result <- LL2.3() + expect_true(grepl("lower limit at 0", result$text)) +}) + +test_that("LL2.3 errors on invalid names", { + expect_error(LL2.3(names = c("a", "b")), "Not correct 'names' argument") + expect_error(LL2.3(names = 123), "Not correct 'names' argument") +}) + +test_that("LL2.3 errors on invalid fixed", { + expect_error(LL2.3(fixed = c(NA, NA)), "Not correct length of 'fixed' argument") +}) + +# ============================================================================== +# Test: LL2.3u() wrapper +# ============================================================================== + +test_that("LL2.3u returns correct class and structure", { + result <- LL2.3u() + expect_s3_class(result, "llogistic") + expect_equal(result$noParm, 3) + expect_equal(result$names, c("b", "c", "e")) +}) + +test_that("LL2.3u text indicates upper limit fixed", { + result <- LL2.3u(upper = 1) + expect_true(grepl("upper limit at 1", result$text)) +}) + +test_that("LL2.3u errors on invalid names", { + expect_error(LL2.3u(names = c("x")), "Not correct 'names' argument") + expect_error(LL2.3u(names = 99), "Not correct 'names' argument") +}) + +test_that("LL2.3u errors on invalid fixed", { + expect_error(LL2.3u(fixed = c(NA, NA)), "Not correct length of 'fixed' argument") +}) + +# ============================================================================== +# Test: LL2.4() wrapper +# ============================================================================== + +test_that("LL2.4 returns correct class and structure", { + result <- LL2.4() + expect_s3_class(result, "llogistic") + expect_equal(result$noParm, 4) + expect_equal(result$names, c("b", "c", "d", "e")) +}) + +test_that("LL2.4 errors on invalid names", { + expect_error(LL2.4(names = c("a", "b")), "Not correct names argument") + expect_error(LL2.4(names = 123), "Not correct names argument") +}) + +test_that("LL2.4 errors on invalid fixed", { + expect_error(LL2.4(fixed = c(NA, NA, NA)), "Not correct length of 'fixed' argument") +}) + +# ============================================================================== +# Test: LL2.5() wrapper +# ============================================================================== + +test_that("LL2.5 returns correct class and structure", { + result <- LL2.5() + expect_s3_class(result, "llogistic") + expect_equal(result$noParm, 5) + expect_equal(result$names, c("b", "c", "d", "e", "f")) + expect_equal(result$text, "Generalised log-logistic (log(ED50) as parameter)") +}) + +test_that("LL2.5 passes additional arguments to llogistic2", { + custom_ss <- function(dframe) { c(1, 0, 100, 5, 1) } + result <- LL2.5(ssfct = custom_ss) + expect_identical(result$ssfct, custom_ss) +}) + +# ============================================================================== +# Test: lowupFixed, lowFixed, upFixed helpers +# ============================================================================== + +test_that("lowupFixed returns correct string", { + result <- lowupFixed("Model A", 100) + expect_equal(result, "Model A with lower limit at 0 and upper limit at 100") +}) + +test_that("lowFixed returns correct string", { + result <- lowFixed("Model A") + expect_equal(result, "Model A with lower limit at 0") +}) + +test_that("upFixed returns correct string", { + result <- upFixed("Model A", 50) + expect_equal(result, "Model A with upper limit at 50") +}) + +# ============================================================================== +# Integration test: drm model fitting +# ============================================================================== + +test_that("LL2.4 works in drm model fitting", { + ryegrass <- data.frame( + rootl = c( + 7.58, 8.00, 8.33, 7.25, 7.17, 7.00, 7.17, 7.83, 7.92, 7.58, + 6.17, 5.75, 5.83, 6.00, 5.83, 4.92, 4.50, 4.17, 4.42, 4.00, + 2.67, 2.08, 2.42, 2.50, 2.25, 1.17, 0.75, 0.92, 1.00, 0.58 + ), + conc = c( + rep(0, 5), rep(0.94, 5), rep(1.88, 5), + rep(3.75, 5), rep(7.50, 5), rep(15, 5) + ) + ) + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL2.4()) + expect_s3_class(m1, "drc") + expect_equal(length(coef(m1)), 4) + preds <- predict(m1) + expect_true(all(is.finite(preds))) +}) diff --git a/tests/testthat/test-lnormal.R b/tests/testthat/test-lnormal.R new file mode 100644 index 00000000..88e514b1 --- /dev/null +++ b/tests/testthat/test-lnormal.R @@ -0,0 +1,508 @@ +# Tests for lnormal.R: lnormal(), LN.2(), LN.3(), LN.3u(), LN.4() +# and the internal edfct function + +# Create test dataset used throughout +ryegrass <- data.frame( + rootl = c( + 7.58, 8.00, 8.33, 7.25, 7.17, 7.00, 7.17, 7.83, 7.92, 7.58, + 6.17, 5.75, 5.83, 6.00, 5.83, 4.92, 4.50, 4.17, 4.42, 4.00, + 2.67, 2.08, 2.42, 2.50, 2.25, 1.17, 0.75, 0.92, 1.00, 0.58 + ), + conc = c( + rep(0, 5), rep(0.94, 5), rep(1.88, 5), + rep(3.75, 5), rep(7.50, 5), rep(15, 5) + ) +) + +# --- lnormal() main function --- + +test_that("lnormal returns correct class and structure", { + ln <- lnormal() + expect_s3_class(ln, "log-normal") + expect_true(is.list(ln)) + expect_true(all(c("fct", "ssfct", "names", "deriv1", "deriv2", "derivx", + "edfct", "name", "text", "noParm", "fixed") %in% names(ln))) +}) + +test_that("lnormal default names are b, c, d, e", { + ln <- lnormal() + expect_equal(ln$names, c("b", "c", "d", "e")) +}) + +test_that("lnormal noParm reflects number of NA in fixed", { + ln_full <- lnormal() + expect_equal(ln_full$noParm, 4) + + ln_partial <- lnormal(fixed = c(1, NA, NA, NA)) + expect_equal(ln_partial$noParm, 3) + expect_equal(ln_partial$names, c("c", "d", "e")) +}) + +test_that("lnormal uses default text when fctText not provided", { + ln <- lnormal() + expect_equal(ln$text, "Log-normal") +}) + +test_that("lnormal uses provided fctText", { + ln <- lnormal(fctText = "Custom text") + expect_equal(ln$text, "Custom text") +}) + +test_that("lnormal uses provided fctName", { + ln <- lnormal(fctName = "myFunc") + expect_equal(ln$name, "myFunc") +}) + +test_that("lnormal errors on invalid names argument", { + expect_error(lnormal(names = c("a", "b")), "Not correct 'names' argument") + expect_error(lnormal(names = 123), "Not correct 'names' argument") +}) + +test_that("lnormal errors on invalid fixed argument", { + expect_error(lnormal(fixed = c(NA, NA)), "Not correct 'fixed' argument") + expect_error(lnormal(fixed = c(NA, NA, NA)), "Not correct 'fixed' argument") +}) + +test_that("lnormal uses provided ssfct when not NULL", { + custom_ss <- function(dframe) { c(1, 0, 10, 5) } + ln <- lnormal(ssfct = custom_ss) + expect_identical(ln$ssfct, custom_ss) +}) + +test_that("lnormal uses default ssfct when ssfct is NULL", { + ln <- lnormal(ssfct = NULL) + expect_true(is.function(ln$ssfct)) +}) + +test_that("lnormal method argument works for self-starter", { + for (m in c("1", "2", "3", "4")) { + ln <- lnormal(method = m) + expect_true(is.function(ln$ssfct)) + } +}) + +test_that("lnormal with loge=FALSE (default)", { + ln <- lnormal(loge = FALSE) + expect_s3_class(ln, "log-normal") + expect_true(is.function(ln$fct)) +}) + +test_that("lnormal with loge=TRUE", { + ln <- lnormal(loge = TRUE) + expect_s3_class(ln, "log-normal") + expect_true(is.function(ln$fct)) +}) + +# --- fct (internal nonlinear function) --- + +test_that("lnormal fct computes correct values with loge=FALSE", { + ln <- lnormal() + # Parameters: b=1, c=0, d=100, e=5 + dose <- c(1, 5, 10) + parm <- matrix(c(1, 0, 100, 5), nrow = 3, ncol = 4, byrow = TRUE) + result <- ln$fct(dose, parm) + # f(x) = c + (d-c)*pnorm(b*(log(x)-log(e))) + expected <- 0 + (100 - 0) * pnorm(1 * (log(dose) - log(5))) + expect_equal(as.numeric(result), expected) +}) + +test_that("lnormal fct computes correct values with loge=TRUE", { + ln <- lnormal(loge = TRUE) + dose <- c(1, 5, 10) + parm <- matrix(c(1, 0, 100, log(5)), nrow = 3, ncol = 4, byrow = TRUE) + result <- ln$fct(dose, parm) + # f(x) = c + (d-c)*pnorm(b*(log(x)-e)) + expected <- 0 + (100 - 0) * pnorm(1 * (log(dose) - log(5))) + expect_equal(as.numeric(result), expected) +}) + +test_that("lnormal fct works with fixed parameters", { + ln <- lnormal(fixed = c(1, 0, NA, NA)) + dose <- c(1, 5, 10) + parm <- matrix(c(100, 5), nrow = 3, ncol = 2, byrow = TRUE) + result <- ln$fct(dose, parm) + expected <- 0 + (100 - 0) * pnorm(1 * (log(dose) - log(5))) + expect_equal(as.numeric(result), expected) +}) + +# --- deriv1 (parameter derivatives) --- + +test_that("lnormal deriv1 returns gradient matrix with correct dimensions (loge=FALSE)", { + ln <- lnormal() + dose <- c(1, 5, 10) + parm <- matrix(c(1, 0, 100, 5), nrow = 3, ncol = 4, byrow = TRUE) + result <- ln$deriv1(dose, parm) + expect_true(is.matrix(result)) + expect_equal(nrow(result), 3) + expect_equal(ncol(result), 4) # all 4 params free +}) + +test_that("lnormal deriv1 returns gradient matrix with correct dimensions (loge=TRUE)", { + ln <- lnormal(loge = TRUE) + dose <- c(1, 5, 10) + parm <- matrix(c(1, 0, 100, log(5)), nrow = 3, ncol = 4, byrow = TRUE) + result <- ln$deriv1(dose, parm) + expect_true(is.matrix(result)) + expect_equal(nrow(result), 3) + expect_equal(ncol(result), 4) +}) + +test_that("lnormal deriv1 with fixed params reduces columns", { + ln <- lnormal(fixed = c(1, 0, NA, NA)) + dose <- c(1, 5, 10) + parm <- matrix(c(100, 5), nrow = 3, ncol = 2, byrow = TRUE) + result <- ln$deriv1(dose, parm) + expect_true(is.matrix(result)) + expect_equal(ncol(result), 2) # only d and e are free +}) + +# --- derivx (dose derivatives) --- + +test_that("lnormal derivx returns gradient with correct dimensions (loge=FALSE)", { + ln <- lnormal() + dose <- c(1, 5, 10) + parm <- matrix(c(1, 0, 100, 5), nrow = 3, ncol = 4, byrow = TRUE) + result <- ln$derivx(dose, parm) + expect_true(is.matrix(result)) + expect_equal(nrow(result), 3) + expect_equal(ncol(result), 1) +}) + +test_that("lnormal derivx returns gradient with correct dimensions (loge=TRUE)", { + ln <- lnormal(loge = TRUE) + dose <- c(1, 5, 10) + parm <- matrix(c(1, 0, 100, log(5)), nrow = 3, ncol = 4, byrow = TRUE) + result <- ln$derivx(dose, parm) + expect_true(is.matrix(result)) + expect_equal(nrow(result), 3) + expect_equal(ncol(result), 1) +}) + +# --- edfct (effective dose function) --- + +test_that("lnormal edfct returns list with ED and gradient (loge=FALSE, relative)", { + ln <- lnormal() + parm <- c(1, 0, 100, 5) + result <- ln$edfct(parm, respl = 50, reference = "control", type = "relative") + expect_true(is.list(result)) + expect_equal(length(result), 2) + # ED50 for symmetric model should equal e=5 + expect_equal(as.numeric(result[[1]]), 5, tolerance = 1e-6) + # Gradient should have 4 elements (all params free) + expect_equal(length(result[[2]]), 4) +}) + +test_that("lnormal edfct returns list with ED and gradient (loge=TRUE, relative)", { + ln <- lnormal(loge = TRUE) + parm <- c(1, 0, 100, log(5)) + result <- ln$edfct(parm, respl = 50, reference = "control", type = "relative") + expect_true(is.list(result)) + expect_equal(length(result), 2) + # ED50 on log scale should be log(5) + expect_equal(as.numeric(result[[1]]), log(5), tolerance = 1e-6) + expect_equal(length(result[[2]]), 4) +}) + +test_that("lnormal edfct works with absolute type", { + ln <- lnormal() + parm <- c(1, 0, 100, 5) + result <- ln$edfct(parm, respl = 50, reference = "control", type = "absolute") + expect_true(is.list(result)) + expect_equal(length(result), 2) + expect_true(is.numeric(result[[1]])) +}) + +test_that("lnormal edfct works with negative b and control reference (relative)", { + ln <- lnormal() + parm <- c(-1, 0, 100, 5) + result <- ln$edfct(parm, respl = 50, reference = "control", type = "relative") + expect_true(is.list(result)) + expect_equal(length(result), 2) + expect_true(is.numeric(result[[1]])) +}) + +test_that("lnormal edfct works with positive b and control reference (relative)", { + ln <- lnormal() + parm <- c(1, 0, 100, 5) + result <- ln$edfct(parm, respl = 50, reference = "control", type = "relative") + expect_true(is.list(result)) + # For positive b, no reversal + expect_equal(as.numeric(result[[1]]), 5, tolerance = 1e-6) +}) + +test_that("lnormal edfct with fixed parameters", { + ln <- lnormal(fixed = c(1, 0, NA, NA)) + parm <- c(100, 5) + result <- ln$edfct(parm, respl = 50, reference = "control", type = "relative") + expect_true(is.list(result)) + expect_equal(length(result[[2]]), 2) # only free params +}) + +test_that("lnormal edfct at different response levels", { + ln <- lnormal() + parm <- c(1, 0, 100, 5) + # ED10 + + result10 <- ln$edfct(parm, respl = 10, reference = "control", type = "relative") + # ED90 + result90 <- ln$edfct(parm, respl = 90, reference = "control", type = "relative") + # ED10 < ED50 < ED90 (for positive b, decreasing curve) + expect_true(is.numeric(result10[[1]])) + expect_true(is.numeric(result90[[1]])) +}) + +test_that("lnormal edfct with loge=TRUE and absolute type", { + ln <- lnormal(loge = TRUE) + parm <- c(1, 0, 100, log(5)) + result <- ln$edfct(parm, respl = 50, reference = "control", type = "absolute") + expect_true(is.list(result)) + expect_true(is.numeric(result[[1]])) +}) + +test_that("lnormal edfct with loge=TRUE, negative b and control reference", { + ln <- lnormal(loge = TRUE) + parm <- c(-1, 0, 100, log(5)) + result <- ln$edfct(parm, respl = 50, reference = "control", type = "relative") + expect_true(is.list(result)) + expect_true(is.numeric(result[[1]])) +}) + +# --- fd function: edge case with non-finite values (loge=FALSE) --- + +test_that("lnormal fct handles dose=0 gracefully (loge=FALSE)", { + ln <- lnormal() + dose <- c(0, 1, 5) + parm <- matrix(c(1, 0, 100, 5), nrow = 3, ncol = 4, byrow = TRUE) + result <- ln$fct(dose, parm) + # dose=0 => log(0)=-Inf => pnorm(-Inf)=0, so result = c + (d-c)*0 = c = 0 + expect_equal(as.numeric(result[1]), 0) +}) + +test_that("lnormal fct handles dose=0 gracefully (loge=TRUE)", { + ln <- lnormal(loge = TRUE) + dose <- c(0, 1, 5) + parm <- matrix(c(1, 0, 100, log(5)), nrow = 3, ncol = 4, byrow = TRUE) + result <- ln$fct(dose, parm) + # dose=0 => log(0)=-Inf => b*(-Inf - e) = -Inf => pnorm(-Inf)=0 + expect_equal(as.numeric(result[1]), 0) +}) + +# --- lowerAs, upperAs, monoton --- + +test_that("lnormal lowerAs and upperAs return correct values", { + ln <- lnormal() + # lowerAs extracts parameter 2 (c), upperAs extracts parameter 3 (d) + parm <- c(1, 0, 100, 5) + expect_equal(ln$lowerAs(parm), 0) + expect_equal(ln$upperAs(parm), 100) +}) + +test_that("lnormal monoton returns correct sign", { + ln <- lnormal() + # monoton returns -1 * parmVec[1] (sign=-1, parmNo=1) + parm <- c(2, 0, 100, 5) + expect_equal(ln$monoton(parm), -2) +}) + +# --- LN.2 convenience function --- + +test_that("LN.2 returns correct structure", { + ln2 <- LN.2() + expect_s3_class(ln2, "log-normal") + expect_equal(ln2$noParm, 2) + expect_equal(ln2$names, c("b", "e")) +}) + +test_that("LN.2 has correct text with default upper=1", { + ln2 <- LN.2() + expect_true(grepl("lower limit at 0", ln2$text)) + expect_true(grepl("upper limit at 1", ln2$text)) +}) + +test_that("LN.2 with custom upper", { + ln2 <- LN.2(upper = 100) + expect_true(grepl("upper limit at 100", ln2$text)) +}) + +test_that("LN.2 errors on invalid names", { + expect_error(LN.2(names = c("a")), "Not correct 'names' argument") + expect_error(LN.2(names = 123), "Not correct 'names' argument") +}) + +test_that("LN.2 errors on invalid fixed", { + expect_error(LN.2(fixed = c(NA)), "Not correct length of 'fixed' argument") + expect_error(LN.2(fixed = c(NA, NA, NA)), "Not correct length of 'fixed' argument") +}) + +test_that("LN.2 fct computes correct values", { + ln2 <- LN.2(upper = 100) + dose <- c(1, 5, 10) + parm <- matrix(c(1, 5), nrow = 3, ncol = 2, byrow = TRUE) + result <- ln2$fct(dose, parm) + expected <- 0 + (100 - 0) * pnorm(1 * (log(dose) - log(5))) + expect_equal(as.numeric(result), expected) +}) + +test_that("LN.2 passes extra args to lnormal", { + ln2 <- LN.2(loge = TRUE) + expect_s3_class(ln2, "log-normal") +}) + +# --- LN.3 convenience function --- + +test_that("LN.3 returns correct structure", { + ln3 <- LN.3() + expect_s3_class(ln3, "log-normal") + expect_equal(ln3$noParm, 3) + expect_equal(ln3$names, c("b", "d", "e")) +}) + +test_that("LN.3 has correct text", { + ln3 <- LN.3() + expect_true(grepl("lower limit at 0", ln3$text)) +}) + +test_that("LN.3 errors on invalid names", { + expect_error(LN.3(names = c("a", "b")), "Not correct 'names' argument") + expect_error(LN.3(names = 123), "Not correct 'names' argument") +}) + +test_that("LN.3 errors on invalid fixed", { + expect_error(LN.3(fixed = c(NA, NA)), "Not correct length of 'fixed' argument") +}) + +test_that("LN.3 fct computes correct values", { + ln3 <- LN.3() + dose <- c(1, 5, 10) + # b, d, e (c is fixed at 0) + parm <- matrix(c(1, 100, 5), nrow = 3, ncol = 3, byrow = TRUE) + result <- ln3$fct(dose, parm) + expected <- 0 + (100 - 0) * pnorm(1 * (log(dose) - log(5))) + expect_equal(as.numeric(result), expected) +}) + +test_that("LN.3 passes extra args to lnormal", { + ln3 <- LN.3(loge = TRUE) + expect_s3_class(ln3, "log-normal") +}) + +# --- LN.3u convenience function --- + +test_that("LN.3u returns correct structure", { + ln3u <- LN.3u() + expect_s3_class(ln3u, "log-normal") + expect_equal(ln3u$noParm, 3) + expect_equal(ln3u$names, c("b", "c", "e")) +}) + +test_that("LN.3u has correct text with default upper=1", { + ln3u <- LN.3u() + expect_true(grepl("upper limit at 1", ln3u$text)) +}) + +test_that("LN.3u with custom upper", { + ln3u <- LN.3u(upper = 100) + expect_true(grepl("upper limit at 100", ln3u$text)) +}) + +test_that("LN.3u errors on invalid names", { + expect_error(LN.3u(names = c("a", "b")), "Not correct 'names' argument") + expect_error(LN.3u(names = 123), "Not correct 'names' argument") +}) + +test_that("LN.3u errors on invalid fixed", { + expect_error(LN.3u(fixed = c(NA, NA)), "Not correct length of 'fixed' argument") +}) + +test_that("LN.3u fct computes correct values", { + ln3u <- LN.3u(upper = 100) + dose <- c(1, 5, 10) + # b, c, e (d is fixed at upper=100) + parm <- matrix(c(1, 0, 5), nrow = 3, ncol = 3, byrow = TRUE) + result <- ln3u$fct(dose, parm) + expected <- 0 + (100 - 0) * pnorm(1 * (log(dose) - log(5))) + expect_equal(as.numeric(result), expected) +}) + +test_that("LN.3u passes extra args to lnormal", { + ln3u <- LN.3u(loge = TRUE) + expect_s3_class(ln3u, "log-normal") +}) + +# --- LN.4 convenience function --- + +test_that("LN.4 returns correct structure", { + ln4 <- LN.4() + expect_s3_class(ln4, "log-normal") + expect_equal(ln4$noParm, 4) + expect_equal(ln4$names, c("b", "c", "d", "e")) +}) + +test_that("LN.4 errors on invalid names", { + expect_error(LN.4(names = c("a", "b")), "Not correct names argument") + expect_error(LN.4(names = 123), "Not correct names argument") +}) + +test_that("LN.4 errors on invalid fixed", { + expect_error(LN.4(fixed = c(NA, NA)), "Not correct length of 'fixed' argument") +}) + +test_that("LN.4 fct computes correct values", { + ln4 <- LN.4() + dose <- c(1, 5, 10) + parm <- matrix(c(1, 0, 100, 5), nrow = 3, ncol = 4, byrow = TRUE) + result <- ln4$fct(dose, parm) + expected <- 0 + (100 - 0) * pnorm(1 * (log(dose) - log(5))) + expect_equal(as.numeric(result), expected) +}) + +test_that("LN.4 passes extra args to lnormal", { + ln4 <- LN.4(loge = TRUE) + expect_s3_class(ln4, "log-normal") +}) + +# --- Integration tests with drm --- + +test_that("LN.4 works in drm model fit", { + m <- drm(rootl ~ conc, data = ryegrass, fct = LN.4()) + expect_s3_class(m, "drc") + ed <- ED(m, 50, display = FALSE) + expect_true(is.matrix(ed)) + expect_true(ed[, "Estimate"] > 0) +}) + +test_that("LN.3 works in drm model fit", { + m <- drm(rootl ~ conc, data = ryegrass, fct = LN.3()) + expect_s3_class(m, "drc") + ed <- ED(m, 50, display = FALSE) + expect_true(ed[, "Estimate"] > 0) +}) + +test_that("LN.2 works in drm model fit with scaled data", { + # Scale rootl to 0-1 range for LN.2 with upper=1 + rg_scaled <- ryegrass + rg_scaled$rootl <- rg_scaled$rootl / max(rg_scaled$rootl) + m <- drm(rootl ~ conc, data = rg_scaled, fct = LN.2()) + expect_s3_class(m, "drc") +}) + +test_that("ED with absolute type works for LN.4 model", { + m <- drm(rootl ~ conc, data = ryegrass, fct = LN.4()) + ed_abs <- ED(m, 5, type = "absolute", display = FALSE) + expect_true(is.matrix(ed_abs)) + expect_true(ed_abs[, "Estimate"] > 0) +}) + +test_that("ED with relative type and multiple levels works for LN.4 model", { + m <- drm(rootl ~ conc, data = ryegrass, fct = LN.4()) + ed <- ED(m, c(10, 50, 90), display = FALSE) + expect_equal(nrow(ed), 3) + expect_true(all(ed[, "Estimate"] > 0)) +}) + +test_that("LN.4 with loge=TRUE works in drm model fit", { + m <- drm(rootl ~ conc, data = ryegrass, fct = LN.4(loge = TRUE)) + expect_s3_class(m, "drc") + ed <- ED(m, 50, display = FALSE) + expect_true(is.matrix(ed)) +}) diff --git a/tests/testthat/test-logistic.R b/tests/testthat/test-logistic.R new file mode 100644 index 00000000..cb0147e3 --- /dev/null +++ b/tests/testthat/test-logistic.R @@ -0,0 +1,382 @@ +# tests/testthat/test-logistic.R +# Comprehensive tests for R/logistic.R: logistic(), L.3(), L.4(), L.5() +# and nested functions: fct, deriv1, derivx, edfct, invfct + +# ======================================================================== +# Test: logistic() argument validation +# ======================================================================== + +test_that("logistic() errors on invalid 'names' argument", { + expect_error(logistic(names = c("a", "b")), "Not correct 'names' argument") + expect_error(logistic(names = 123), "Not correct 'names' argument") + expect_error(logistic(names = c("a", "b", "c", "d")), "Not correct 'names' argument") +}) + +test_that("logistic() errors on invalid 'fixed' argument", { + expect_error(logistic(fixed = c(NA, NA)), "Not correct 'fixed' argument") + expect_error(logistic(fixed = c(NA, NA, NA, NA)), "Not correct 'fixed' argument") + expect_error(logistic(fixed = c(NA, NA, NA, NA, NA, NA)), "Not correct 'fixed' argument") +}) + +test_that("logistic() returns object of class 'Boltzmann'", { + result <- logistic() + expect_s3_class(result, "Boltzmann") +}) + +test_that("logistic() return list has correct structure", { + result <- logistic() + expect_true(is.function(result$fct)) + expect_true(is.function(result$ssfct)) + expect_true(is.function(result$deriv1)) + expect_null(result$deriv2) + expect_true(is.function(result$derivx)) + expect_true(is.function(result$edfct)) + expect_true(is.function(result$inversion)) + expect_equal(result$noParm, 5) + expect_equal(result$fixed, c(NA, NA, NA, NA, NA)) + expect_equal(result$names, c("b", "c", "d", "e", "f")) +}) + +test_that("logistic() default name and text are correct", { + result <- logistic() + expect_equal(result$name, "logistic") + expect_equal(result$text, "Logistic (ED50 as parameter)") +}) + +test_that("logistic() custom fctName and fctText override defaults", { + result <- logistic(fctName = "myModel", fctText = "my description") + expect_equal(result$name, "myModel") + expect_equal(result$text, "my description") +}) + +test_that("logistic() respects custom parameter names", { + result <- logistic(names = c("slope", "lower", "upper", "mid", "asym")) + expect_equal(result$names, c("slope", "lower", "upper", "mid", "asym")) +}) + +test_that("logistic() handles fixed parameters correctly", { + result <- logistic(fixed = c(NA, 0, NA, NA, 1)) + expect_equal(result$noParm, 3) + expect_equal(result$names, c("b", "d", "e")) + expect_equal(result$fixed, c(NA, 0, NA, NA, 1)) +}) + +test_that("logistic() uses ssfct when provided", { + custom_ssfct <- function(dframe) { c(1, 0, 100, 5, 1) } + result <- logistic(ssfct = custom_ssfct) + expect_identical(result$ssfct, custom_ssfct) +}) + +# ======================================================================== +# Test: fct (the nonlinear function) +# ======================================================================== + +test_that("logistic fct produces expected values with all parameters free", { + mod <- logistic() + # Parameters: b, c, d, e, f + parm <- matrix(c(-1, 0, 100, 5, 1), nrow = 1) + + # At dose = e = 5: response = c + (d-c)/(1+exp(b*(dose-e)))^f = 0 + 100/(1+1)^1 = 50 + result <- mod$fct(5, parm) + expect_equal(result, 50) + + # At dose = 0: c + (d-c)/(1+exp(b*(-e)))^f = 0 + 100/(1+exp(5))^1 + result0 <- mod$fct(0, parm) + expect_equal(result0, 100 / (1 + exp(5)), tolerance = 1e-10) +}) + +test_that("logistic fct handles fixed parameters", { + # Fix c=0 and f=1 (like L.3 does) + mod <- logistic(fixed = c(NA, 0, NA, NA, 1)) + parm <- matrix(c(-1, 100, 5), nrow = 1) # b, d, e + + result <- mod$fct(5, parm) + expect_equal(result, 50) +}) + +test_that("logistic fct handles multiple doses", { + mod <- logistic() + parm <- matrix(rep(c(-1, 0, 100, 5, 1), each = 3), nrow = 3) + doses <- c(0, 5, 100) + + result <- mod$fct(doses, parm) + expect_length(result, 3) + expect_equal(result[2], 50) # at dose = e +}) + +# ======================================================================== +# Test: deriv1 (first derivatives in parameters) +# ======================================================================== + +test_that("logistic deriv1 returns correct dimensions with all parameters free", { + mod <- logistic() + parm <- matrix(c(-1, 0, 100, 5, 1), nrow = 1) + + result <- mod$deriv1(5, parm) + # Single row: cbind()[,notFixed] drops to vector + expect_length(result, 5) +}) + +test_that("logistic deriv1 returns correct dimensions with fixed parameters", { + mod <- logistic(fixed = c(NA, 0, NA, NA, 1)) + parm <- matrix(c(-1, 100, 5), nrow = 1) + + result <- mod$deriv1(5, parm) + expect_length(result, 3) # Only free parameters +}) + +test_that("logistic deriv1 at dose=e has expected structure", { + mod <- logistic() + parm <- matrix(c(-1, 0, 100, 5, 1), nrow = 1) + + result <- mod$deriv1(5, parm) + # At dose = e, exp(b*(dose-e)) = 1 + # dc/dc = 1 - 1/(1+1)^1 = 0.5 + # dd/dd = 1/(1+1)^1 = 0.5 + expect_equal(as.numeric(result[2]), 0.5, tolerance = 1e-10) # dc + expect_equal(as.numeric(result[3]), 0.5, tolerance = 1e-10) # dd +}) + +test_that("logistic deriv1 handles multiple rows", { + mod <- logistic() + parm <- matrix(c(-1, 0, 100, 5, 1, + -2, 10, 90, 3, 1), nrow = 2, byrow = TRUE) + doses <- c(5, 3) + + result <- mod$deriv1(doses, parm) + expect_true(is.matrix(result)) + expect_equal(nrow(result), 2) + expect_equal(ncol(result), 5) +}) + +# ======================================================================== +# Test: derivx (first derivatives in x) +# ======================================================================== + +test_that("logistic derivx returns correct dimensions", { + mod <- logistic() + parm <- matrix(c(-1, 0, 100, 5, 1), nrow = 1) + + result <- mod$derivx(5, parm) + expect_length(result, 1) +}) + +test_that("logistic derivx at dose=e has expected value", { + mod <- logistic() + # b=-1, c=0, d=100, e=5, f=1 + parm <- matrix(c(-1, 0, 100, 5, 1), nrow = 1) + + # At dose=e: derivx = (-f*(d-c)*1*b) / (1+1)^(f+1) = (-1*100*1*(-1)) / 4 = 25 + result <- mod$derivx(5, parm) + expect_equal(as.numeric(result), 25, tolerance = 1e-10) +}) + +test_that("logistic derivx handles fixed parameters", { + mod <- logistic(fixed = c(NA, 0, NA, NA, 1)) + parm <- matrix(c(-1, 100, 5), nrow = 1) + + result <- mod$derivx(5, parm) + expect_equal(as.numeric(result), 25, tolerance = 1e-10) +}) + +test_that("logistic derivx handles multiple rows", { + mod <- logistic() + parm <- matrix(c(-1, 0, 100, 5, 1, + -2, 10, 90, 3, 1), nrow = 2, byrow = TRUE) + + result <- mod$derivx(c(5, 3), parm) + expect_length(result, 2) +}) + +# ======================================================================== +# Test: edfct (effective dose function) +# ======================================================================== + +test_that("edfct returns ED50 correctly for symmetric logistic (f=1)", { + mod <- logistic() + # b=-1, c=0, d=100, e=5, f=1 + # ED50 = e + log((100/50)^(1/1) - 1) / b = 5 + log(1)/(-1) = 5 + 0 = 5 + result <- mod$edfct(c(-1, 0, 100, 5, 1), 50) + + expect_equal(result[[1]], 5, tolerance = 1e-10) + expect_true(is.numeric(result[[2]])) + expect_length(result[[2]], 5) # gradient for all 5 parameters +}) + +test_that("edfct returns correct ED values for various p", { + mod <- logistic() + parms <- c(-1, 0, 100, 5, 1) + + # ED10: e + log((100/10)^1 - 1) / b = 5 + log(9) / (-1) + result10 <- mod$edfct(parms, 10) + expected10 <- 5 + log((100/10)^1 - 1) / (-1) + expect_equal(result10[[1]], expected10, tolerance = 1e-10) + + # ED90: e + log((100/90)^1 - 1) / b = 5 + log(1/9) / (-1) + result90 <- mod$edfct(parms, 90) + expected90 <- 5 + log((100/90)^1 - 1) / (-1) + expect_equal(result90[[1]], expected90, tolerance = 1e-10) +}) + +test_that("edfct returns gradients with correct length when parameters are fixed", { + mod <- logistic(fixed = c(NA, 0, NA, NA, 1)) + # Free: b, d, e (3 params) + result <- mod$edfct(c(-1, 100, 5), 50) + + expect_equal(result[[1]], 5, tolerance = 1e-10) + expect_length(result[[2]], 3) # gradient for 3 free parameters +}) + +test_that("edfct gradient for 'e' is 1", { + mod <- logistic() + result <- mod$edfct(c(-1, 0, 100, 5, 1), 50) + gradient <- result[[2]] + + # The 'e' gradient should be 1 + expect_equal(gradient[4], 1, tolerance = 1e-10) +}) + +test_that("edfct gradient for 'c' and 'd' is 0", { + mod <- logistic() + result <- mod$edfct(c(-1, 0, 100, 5, 1), 50) + gradient <- result[[2]] + + # c and d do not appear in ED formula + expect_equal(gradient[2], 0) + expect_equal(gradient[3], 0) +}) + +test_that("edfct works with asymmetric model (f != 1)", { + mod <- logistic() + parms <- c(-1, 0, 100, 5, 2) + + # ED50 = e + log((100/50)^(1/2) - 1) / b = 5 + log(sqrt(2)-1)/(-1) + result <- mod$edfct(parms, 50) + expected <- 5 + log((100/50)^(1/2) - 1) / (-1) + expect_equal(result[[1]], expected, tolerance = 1e-10) +}) + +# ======================================================================== +# Test: invfct (inverse function) +# ======================================================================== + +test_that("invfct returns correct inverse for y at midpoint", { + mod <- logistic() + # b=-1, c=0, d=100, e=5, f=1 + # invfct(50) = log(((100-0)/(50-0))^(1/1) - 1)/(-1) + 5 = log(2-1)/(-1) + 5 = 5 + result <- mod$inversion(50, c(-1, 0, 100, 5, 1)) + expect_equal(result, 5, tolerance = 1e-10) +}) + +test_that("invfct is consistent with fct", { + mod <- logistic() + parms <- c(-1, 0, 100, 5, 1) + + # Compute f(3) then invert + dose <- 3 + parm_matrix <- matrix(parms, nrow = 1) + y <- mod$fct(dose, parm_matrix) + x_recovered <- mod$inversion(y, parms) + expect_equal(x_recovered, dose, tolerance = 1e-10) +}) + +test_that("invfct handles fixed parameters", { + mod <- logistic(fixed = c(NA, 0, NA, NA, 1)) + # Free: b, d, e + result <- mod$inversion(50, c(-1, 100, 5)) + expect_equal(result, 5, tolerance = 1e-10) +}) + +# ======================================================================== +# Test: L.3() +# ======================================================================== + +test_that("L.3() returns Boltzmann object with correct structure", { + result <- L.3() + expect_s3_class(result, "Boltzmann") + expect_equal(result$name, "L.3") + expect_equal(result$text, "Logistic (ED50 as parameter) with lower limit fixed at 0") + expect_equal(result$noParm, 3) + expect_equal(result$names, c("b", "d", "e")) +}) + +test_that("L.3() errors on invalid names argument", { + expect_error(L.3(names = c("a", "b")), "Not correct names argument") + expect_error(L.3(names = 123), "Not correct names argument") +}) + +test_that("L.3() errors on invalid fixed argument", { + expect_error(L.3(fixed = c(NA, NA)), "Not correct length of 'fixed' argument") + expect_error(L.3(fixed = c(NA, NA, NA, NA)), "Not correct length of 'fixed' argument") +}) + +test_that("L.3() fct gives expected response", { + mod <- L.3() + # b, d, e (c=0, f=1 are fixed) + parm <- matrix(c(-1, 100, 5), nrow = 1) + result <- mod$fct(5, parm) + expect_equal(result, 50) +}) + +test_that("L.3() edfct gives correct ED50", { + mod <- L.3() + result <- mod$edfct(c(-1, 100, 5), 50) + expect_equal(result[[1]], 5, tolerance = 1e-10) + expect_length(result[[2]], 3) +}) + +# ======================================================================== +# Test: L.4() +# ======================================================================== + +test_that("L.4() returns Boltzmann object with correct structure", { + result <- L.4() + expect_s3_class(result, "Boltzmann") + expect_equal(result$name, "L.4") + expect_equal(result$text, "Logistic (ED50 as parameter)") + expect_equal(result$noParm, 4) + expect_equal(result$names, c("b", "c", "d", "e")) +}) + +test_that("L.4() errors on invalid names argument", { + expect_error(L.4(names = c("a", "b")), "Not correct names argument") + expect_error(L.4(names = 123), "Not correct names argument") +}) + +test_that("L.4() errors on invalid fixed argument", { + expect_error(L.4(fixed = c(NA, NA, NA)), "Not correct length of 'fixed' argument") + expect_error(L.4(fixed = c(NA, NA, NA, NA, NA)), "Not correct length of 'fixed' argument") +}) + +test_that("L.4() fct gives expected response", { + mod <- L.4() + parm <- matrix(c(-1, 0, 100, 5), nrow = 1) + result <- mod$fct(5, parm) + expect_equal(result, 50) +}) + +test_that("L.4() edfct gives correct ED50", { + mod <- L.4() + result <- mod$edfct(c(-1, 0, 100, 5), 50) + expect_equal(result[[1]], 5, tolerance = 1e-10) + expect_length(result[[2]], 4) +}) + +# ======================================================================== +# Test: L.5() +# ======================================================================== + +test_that("L.5() returns Boltzmann object with correct structure", { + result <- L.5() + expect_s3_class(result, "Boltzmann") + expect_equal(result$name, "L.5") + expect_equal(result$text, "Generalised logistic (ED50 as parameter)") + expect_equal(result$noParm, 5) + expect_equal(result$names, c("b", "c", "d", "e", "f")) +}) + +test_that("L.5() passes additional arguments to logistic()", { + custom_ss <- function(dframe) { c(1, 0, 100, 5, 1) } + result <- L.5(ssfct = custom_ss) + expect_identical(result$ssfct, custom_ss) +}) diff --git a/tests/testthat/test-logistic.ssf.R b/tests/testthat/test-logistic.ssf.R new file mode 100644 index 00000000..92c4aa33 --- /dev/null +++ b/tests/testthat/test-logistic.ssf.R @@ -0,0 +1,187 @@ +# tests/testthat/test-logistic.ssf.R +# Tests for R/logistic.ssf.R: logistic.ssf() self-starter function + +# ============================================================================== +# Setup: Create a realistic dose-response data frame +# ============================================================================== + +# Standard decreasing logistic data for testing the returned closure +make_logistic_data <- function() { + data.frame( + dose = c(0, 1, 2, 3, 5, 7, 10, 15, 20), + response = c(95, 90, 80, 60, 40, 20, 10, 5, 2) + ) +} + +# ============================================================================== +# Test: logistic.ssf() returns a function (closure) +# ============================================================================== + +test_that("logistic.ssf returns a closure for each method", { + for (m in c("1", "2", "3", "4")) { + result <- drc:::logistic.ssf(method = m, fixed = c(NA, NA, NA, NA, NA)) + expect_type(result, "closure") + expect_true(is.function(result)) + } +}) + +# ============================================================================== +# Test: Calling the returned closure with method "1" +# Covers: line 14 (findbe1 + identity lambda), lines 21-34 (closure body), +# line 8 (ytrans body via findbe1's respTr) +# ============================================================================== + +test_that("logistic.ssf method '1' closure returns valid initial values", { + ssfct <- drc:::logistic.ssf(method = "1", fixed = c(NA, NA, NA, NA, NA)) + dframe <- make_logistic_data() + + result <- ssfct(dframe) + + expect_type(result, "double") + expect_length(result, 5) # b, c, d, e, f (all free) + expect_true(all(is.finite(result))) +}) + +# ============================================================================== +# Test: Calling the returned closure with method "2" (Anke) +# Covers: lines 9, 10 (bfct, efct bodies via findbe2) +# ============================================================================== + +test_that("logistic.ssf method '2' closure returns valid initial values", { + ssfct <- drc:::logistic.ssf(method = "2", fixed = c(NA, NA, NA, NA, NA)) + dframe <- make_logistic_data() + + result <- ssfct(dframe) + + expect_type(result, "double") + expect_length(result, 5) + expect_true(all(is.finite(result))) +}) + +# ============================================================================== +# Test: Calling the returned closure with method "3" +# ============================================================================== + +test_that("logistic.ssf method '3' closure returns valid initial values", { + ssfct <- drc:::logistic.ssf(method = "3", fixed = c(NA, NA, NA, NA, NA)) + dframe <- make_logistic_data() + + result <- ssfct(dframe) + + expect_type(result, "double") + expect_length(result, 5) + expect_true(all(is.finite(result))) +}) + +# ============================================================================== +# Test: Calling the returned closure with method "4" (Normolle) +# Also exercises bfct and efct +# ============================================================================== + +test_that("logistic.ssf method '4' closure returns valid initial values", { + ssfct <- drc:::logistic.ssf(method = "4", fixed = c(NA, NA, NA, NA, NA)) + dframe <- make_logistic_data() + + result <- ssfct(dframe) + + expect_type(result, "double") + expect_length(result, 5) + expect_true(all(is.finite(result))) +}) + +# ============================================================================== +# Test: Fixed parameters reduce the returned vector length +# Covers: line 34 subsetting with is.na(fixed) +# ============================================================================== + +test_that("logistic.ssf respects fixed parameters (L.3 style: c=0, f=1)", { + ssfct <- drc:::logistic.ssf( + method = "1", + fixed = c(NA, 0, NA, NA, 1) + ) + dframe <- make_logistic_data() + + result <- ssfct(dframe) + + # Only b, d, e are free (c=0 and f=1 are fixed) + expect_length(result, 3) + expect_true(all(is.finite(result))) +}) + +test_that("logistic.ssf respects fixed parameters (L.4 style: f=1)", { + ssfct <- drc:::logistic.ssf( + method = "2", + fixed = c(NA, NA, NA, NA, 1) + ) + dframe <- make_logistic_data() + + result <- ssfct(dframe) + + # Only b, c, d, e are free (f=1 is fixed) + expect_length(result, 4) + expect_true(all(is.finite(result))) +}) + +# ============================================================================== +# Test: Default method argument +# ============================================================================== + +test_that("logistic.ssf defaults to method '1'", { + ssfct_default <- drc:::logistic.ssf(fixed = c(NA, NA, NA, NA, NA)) + ssfct_explicit <- drc:::logistic.ssf(method = "1", fixed = c(NA, NA, NA, NA, NA)) + ssfct_method2 <- drc:::logistic.ssf(method = "2", fixed = c(NA, NA, NA, NA, NA)) + dframe <- make_logistic_data() + + result_default <- ssfct_default(dframe) + result_explicit <- ssfct_explicit(dframe) + result_method2 <- ssfct_method2(dframe) + + # Default should match method "1" exactly + + expect_equal(result_default, result_explicit) + # And differ from method "2" to confirm method "1" is truly the default + expect_false(isTRUE(all.equal(result_default, result_method2))) +}) + +# ============================================================================== +# Test: Invalid method argument +# ============================================================================== + +test_that("logistic.ssf errors on invalid method", { + expect_error( + drc:::logistic.ssf(method = "5", fixed = c(NA, NA, NA, NA, NA)), + "arg" + ) +}) + +# ============================================================================== +# Test: f parameter initial value is always 1 +# ============================================================================== + +test_that("logistic.ssf returns f=1 when f is free", { + ssfct <- drc:::logistic.ssf(method = "1", fixed = c(NA, NA, NA, NA, NA)) + dframe <- make_logistic_data() + + result <- ssfct(dframe) + + # The 5th element is fVal which should be 1 + expect_equal(result[5], 1) +}) + +# ============================================================================== +# Test: c and d initial values are near min/max of response +# ============================================================================== + +test_that("logistic.ssf c and d initial values bracket the response range", { + ssfct <- drc:::logistic.ssf(method = "1", fixed = c(NA, NA, NA, NA, NA)) + dframe <- make_logistic_data() + + result <- ssfct(dframe) + + # result order is: b, c, d, e, f + c_value <- result[2] # lower asymptote + d_value <- result[3] # upper asymptote + y <- dframe[, 2] + expect_true(c_value <= min(y)) + expect_true(d_value >= max(y)) +}) diff --git a/tests/testthat/test-maED.R b/tests/testthat/test-maED.R new file mode 100644 index 00000000..36f64d76 --- /dev/null +++ b/tests/testthat/test-maED.R @@ -0,0 +1,352 @@ +# Tests for maED() function - Model-averaged effective doses + +# Create test dataset (ryegrass) +ryegrass <- data.frame( + rootl = c( + 7.58, 8.00, 8.33, 7.25, 7.17, 7.00, 7.17, 7.83, 7.92, 7.58, + 6.17, 5.75, 5.83, 6.00, 5.83, 4.92, 4.50, 4.17, 4.42, 4.00, + 2.67, 2.08, 2.42, 2.50, 2.25, 1.17, 0.75, 0.92, 1.00, 0.58 + ), + conc = c( + rep(0, 5), rep(0.94, 5), rep(1.88, 5), + rep(3.75, 5), rep(7.50, 5), rep(15, 5) + ) +) + +# Multi-curve dataset +set.seed(42) +multi_data <- data.frame( + dose = rep(c(0, 0.5, 1, 2, 5, 10), each = 5, times = 2), + resp = c( + rnorm(5, 100, 5), rnorm(5, 95, 5), rnorm(5, 85, 5), + rnorm(5, 60, 5), rnorm(5, 20, 5), rnorm(5, 5, 5), + rnorm(5, 100, 5), rnorm(5, 90, 5), rnorm(5, 70, 5), + rnorm(5, 40, 5), rnorm(5, 10, 5), rnorm(5, 3, 5) + ), + group = rep(c("A", "B"), each = 30) +) + + +# --- Input validation tests --- + +test_that("maED errors when object is not of class drc", { + expect_error(maED("not_a_model", list(LL.5()), c(50)), "'object' must be of class 'drc'") + expect_error(maED(42, list(LL.5()), c(50)), "'object' must be of class 'drc'") +}) + +test_that("maED errors when respLev is invalid", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + expect_error(maED(m1, list(LL.5()), "abc"), "'respLev' must be a non-empty numeric vector") + expect_error(maED(m1, list(LL.5()), numeric(0)), "'respLev' must be a non-empty numeric vector") +}) + +test_that("maED errors when level is invalid", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + expect_error(maED(m1, list(LL.5()), 50, level = "a"), "'level' must be a single numeric value strictly between 0 and 1") + expect_error(maED(m1, list(LL.5()), 50, level = 0), "'level' must be a single numeric value strictly between 0 and 1") + expect_error(maED(m1, list(LL.5()), 50, level = 1), "'level' must be a single numeric value strictly between 0 and 1") + expect_error(maED(m1, list(LL.5()), 50, level = c(0.9, 0.95)), "'level' must be a single numeric value strictly between 0 and 1") +}) + +test_that("maED errors when linreg is invalid", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + expect_error(maED(m1, list(LL.5()), 50, linreg = "yes"), "'linreg' must be a single logical value") + expect_error(maED(m1, list(LL.5()), 50, linreg = c(TRUE, FALSE)), "'linreg' must be a single logical value") +}) + +test_that("maED errors when display is invalid", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + expect_error(maED(m1, list(LL.5()), 50, display = "yes"), "'display' must be a single logical value") +}) + +test_that("maED errors when na.rm is invalid", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + expect_error(maED(m1, list(LL.5()), 50, na.rm = "yes"), "'na.rm' must be a single logical value") +}) + +test_that("maED errors when extended is invalid", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + expect_error(maED(m1, list(LL.5()), 50, extended = "yes"), "'extended' must be a single logical value") +}) + + +# --- Happy path tests --- + +test_that("maED returns matrix with correct structure for interval='none'", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- maED(m1, list(LL.5(), W1.4()), c(10, 50, 90), display = FALSE) + + expect_true(is.matrix(result)) + expect_equal(nrow(result), 3) + expect_equal(ncol(result), 1) + expect_equal(colnames(result), "Estimate") + expect_true(all(result[, "Estimate"] > 0)) +}) + +test_that("maED returns matrix with correct structure for interval='buckland'", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- maED(m1, list(LL.5(), W1.4()), c(10, 50), interval = "buckland", display = FALSE) + + expect_true(is.matrix(result)) + expect_equal(nrow(result), 2) + expect_equal(ncol(result), 4) + expect_true(all(c("Estimate", "Std. Error", "Lower", "Upper") %in% colnames(result))) + expect_true(all(result[, "Lower"] < result[, "Estimate"])) + expect_true(all(result[, "Upper"] > result[, "Estimate"])) +}) + +test_that("maED returns matrix with correct structure for interval='kang'", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- maED(m1, list(LL.5(), W1.4()), c(10, 50), interval = "kang", display = FALSE) + + expect_true(is.matrix(result)) + expect_equal(nrow(result), 2) + expect_equal(ncol(result), 4) + expect_true(all(c("Estimate", "Std. Error", "Lower", "Upper") %in% colnames(result))) +}) + +test_that("maED works with a single response level", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- maED(m1, list(LL.5()), 50, display = FALSE) + + expect_true(is.matrix(result)) + expect_equal(nrow(result), 1) + expect_true(result[, "Estimate"] > 0) +}) + + +# --- Extended output --- + +test_that("maED returns list when extended = TRUE", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- maED(m1, list(LL.5(), W1.4()), c(10, 50), display = FALSE, extended = TRUE) + + expect_true(is.list(result)) + expect_true(all(c("estimates", "fits") %in% names(result))) + expect_true(is.matrix(result$estimates)) + expect_true(is.matrix(result$fits)) + expect_equal(nrow(result$fits), 3) # 1 original + 2 in fctList + expect_true("Weight" %in% colnames(result$fits)) +}) + + +# --- Display parameter --- + +test_that("maED prints when display = TRUE", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + expect_output(maED(m1, list(LL.5()), 50, display = TRUE), "Weight") +}) + +test_that("maED is silent when display = FALSE", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + expect_no_error( + suppressWarnings(result <- maED(m1, list(LL.5()), 50, display = FALSE)) + ) + expect_true(is.matrix(result)) +}) + + +# --- Linear regression option --- + +test_that("maED works with linreg = TRUE", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- maED(m1, list(LL.5()), c(10, 50), linreg = TRUE, display = FALSE) + + expect_true(is.matrix(result)) + expect_equal(nrow(result), 2) + expect_true(all(result[, "Estimate"] > 0)) +}) + +test_that("maED linreg = TRUE with extended returns fit info including Lin row", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- maED(m1, list(LL.5()), c(50), linreg = TRUE, display = FALSE, extended = TRUE) + + expect_true("Lin" %in% rownames(result$fits)) +}) + +test_that("maED linreg = TRUE with buckland interval", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- maED(m1, list(LL.5()), c(50), linreg = TRUE, interval = "buckland", display = FALSE) + + expect_true(is.matrix(result)) + expect_equal(ncol(result), 4) +}) + + +# --- Multi-curve handling --- + +test_that("maED handles multi-curve models", { + m_multi <- drm(resp ~ dose, curveid = group, data = multi_data, fct = LL.4()) + result <- maED(m_multi, list(LL.5()), 50, display = FALSE) + + expect_true(is.matrix(result)) + expect_equal(nrow(result), 2) # One row per curve +}) + +test_that("maED handles multi-curve with clevel filter", { + m_multi <- drm(resp ~ dose, curveid = group, data = multi_data, fct = LL.4()) + result <- maED(m_multi, list(LL.5()), 50, clevel = "A", display = FALSE) + + expect_true(is.matrix(result)) + expect_equal(nrow(result), 1) +}) + + +# --- type = "absolute" --- + +test_that("maED works with type = 'absolute'", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- maED(m1, list(LL.5()), 5, type = "absolute", display = FALSE) + + expect_true(is.matrix(result)) + expect_equal(nrow(result), 1) +}) + + +# --- na.rm option --- + +test_that("maED works with na.rm = TRUE", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- maED(m1, list(LL.5()), c(10, 50), na.rm = TRUE, display = FALSE) + + expect_true(is.matrix(result)) + expect_true(all(result[, "Estimate"] > 0)) +}) + + +# --- try-error handling for models that fail in fctList --- + +test_that("maED handles try-error from failed model in fctList", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + # LL.2 has fixed lower limit at 0, may produce different results; + # Use a function that might fail during update fitting + result <- maED(m1, list(LL.5(), LN.4(), W1.4(), W2.4()), c(10, 50, 90), + interval = "buckland", display = FALSE) + + expect_true(is.matrix(result)) + expect_equal(nrow(result), 3) +}) + + +# --- Non-finite ED value filtering --- + +# Algae dataset from the debug folder that causes LL.5 to return Inf for ED50 +# due to a negative f parameter estimate. +algae_data <- data.frame( + yield = c( + 824948.1, 874756.3, 818722.1, # conc = 10 + 289510.1, 345544.3, 280171.1, # conc = 10000 + 1077102.1, 653732.5, 824948.1, # conc = 1000 + 905886.4, 753348.9, 756461.9, # conc = 100 + 697314.7, 691088.6, 762687.9, # conc = 10 (second batch) + 880982.4, 747122.8, 803157.1, # conc = 1 (second batch) + 295736.1, 295736.1, 255267.0, 283284.1, 286397.1, 273945.0, # controls + 1503584.7, 1388403.3, 946355.6, 1195396.5, 1410194.4, # controls + 407804.6, 485629.8, 678636.6, 809383.1, 582133.2, # controls + 1049085.0, 884095.4, 715992.7, 986824.8, 905886.4 # controls + ), + conc = c( + rep(10, 3), rep(10000, 3), rep(1000, 3), rep(100, 3), + rep(10, 3), rep(1, 3), + rep(0, 21) + ) +) + +test_that("maED warns when a model produces non-finite ED values or fitting fails", { + m_algae <- drm(yield ~ conc, data = algae_data, + fct = LL.4(fixed = c(NA, 1e-9, NA, NA))) + + fcts <- list( + LL.5(fixed = c(NA, 1e-9, NA, NA, NA)), + W1.4(fixed = c(NA, 1e-9, NA, NA)) + ) + + # Some platforms/R versions may produce non-finite ED values for these + # models, triggering the exclusion warning. On others, all models converge + # successfully. We therefore check both paths: if a warning is produced it + # must match the expected pattern, and the result must always be valid. + exclusion_warned <- FALSE + result <- withCallingHandlers( + maED(m_algae, fcts, 50, display = FALSE), + warning = function(w) { + if (grepl("excluded from model-averaging", conditionMessage(w))) { + exclusion_warned <<- TRUE + } + invokeRestart("muffleWarning") + } + ) + + expect_true(is.matrix(result)) + expect_equal(nrow(result), 1) + expect_true(is.finite(result[, "Estimate"])) +}) + +test_that("maED extended output shows excluded models with zero weight", { + m_algae <- drm(yield ~ conc, data = algae_data, + fct = LL.4(fixed = c(NA, 1e-9, NA, NA))) + + fcts <- list( + LL.5(fixed = c(NA, 1e-9, NA, NA, NA)), + W1.4(fixed = c(NA, 1e-9, NA, NA)) + ) + + result <- suppressWarnings( + maED(m_algae, fcts, 50, display = FALSE, extended = TRUE) + ) + + expect_true(is.list(result)) + fits <- result$fits + + # On platforms where models produce non-finite ED values, excluded models + # get zero weight. On others, all models converge and all weights are + # positive. Either outcome is valid; we only check structural correctness. + expect_true(is.matrix(fits)) + expect_true("Weight" %in% colnames(fits)) + expect_true(all(fits[, "Weight"] >= 0)) + + # The model-averaged estimate should be finite + expect_true(is.finite(result$estimates[, "Estimate"])) +}) + +test_that("maED buckland interval works when models are excluded", { + m_algae <- drm(yield ~ conc, data = algae_data, + fct = LL.4(fixed = c(NA, 1e-9, NA, NA))) + + fcts <- list( + LL.5(fixed = c(NA, 1e-9, NA, NA, NA)), + W1.4(fixed = c(NA, 1e-9, NA, NA)) + ) + + result <- suppressWarnings( + maED(m_algae, fcts, 50, interval = "buckland", display = FALSE) + ) + + expect_true(is.matrix(result)) + expect_equal(ncol(result), 4) + expect_true(all(c("Estimate", "Std. Error", "Lower", "Upper") %in% colnames(result))) + # Result should be finite + expect_true(all(is.finite(result))) +}) + +test_that("maED without non-finite values produces no exclusion warning", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # These models all produce finite ED50 on ryegrass data. + # Internal optimization may emit "NaNs produced" warnings which are + # unrelated to model exclusion, so we only check that no exclusion + # warning is issued. + exclusion_warned <- FALSE + result <- withCallingHandlers( + maED(m1, list(W1.4(), W2.4()), 50, display = FALSE), + warning = function(w) { + if (grepl("excluded from model-averaging", conditionMessage(w))) { + exclusion_warned <<- TRUE + } + invokeRestart("muffleWarning") + } + ) + + expect_false(exclusion_warned) + expect_true(is.matrix(result)) + expect_true(is.finite(result[, "Estimate"])) +}) diff --git a/tests/testthat/test-mixture.R b/tests/testthat/test-mixture.R new file mode 100644 index 00000000..bd12e35f --- /dev/null +++ b/tests/testthat/test-mixture.R @@ -0,0 +1,398 @@ +# ============================================================================== +# Tests for mixture(), hewlett(), and voelund() functions +# ============================================================================== + +# --- Shared setup: fit free models used across multiple tests ----------------- + +# LL.4 free model (4-parameter log-logistic) +acidiq.free4 <- drm(rgr ~ dose, pct, data = acidiq, + fct = LL.4(), + pmodels = list(~1, ~1, ~1, ~factor(pct) - 1)) + +# LL.3 free model (3-parameter log-logistic) +acidiq.free3 <- drm(rgr ~ dose, pct, data = acidiq, + fct = LL.3(), + pmodels = list(~1, ~1, ~factor(pct) - 1)) + +# LL.2 free model (2-parameter log-logistic) +acidiq.free2 <- drm(rgr ~ dose, pct, data = acidiq, + fct = LL.2(), + pmodels = list(~1, ~factor(pct) - 1)) + +# LL.5 free model (5-parameter log-logistic, used for error tests) +acidiq.free5 <- drm(rgr ~ dose, pct, data = acidiq, + fct = LL.5(), + pmodels = list(~1, ~1, ~1, ~1, ~factor(pct) - 1)) + +# ============================================================================== +# Tests for mixture() - CA model +# ============================================================================== + +test_that("mixture CA works with LL.4 model", { + result <- mixture(acidiq.free4, model = "CA") + expect_s3_class(result, "drc") + expect_equal(result$text, "CA model") + expect_true(!is.null(result$pmodelsText)) + expect_true(!is.null(result$deviance)) + expect_equal(result$anova$test, "F") +}) + +test_that("mixture CA works with LL.3 model", { + result <- mixture(acidiq.free3, model = "CA") + expect_s3_class(result, "drc") + expect_equal(result$text, "CA model") +}) + +test_that("mixture CA works with LL.2 model", { + result <- mixture(acidiq.free2, model = "CA") + expect_s3_class(result, "drc") + expect_equal(result$text, "CA model") +}) + +test_that("mixture CA errors with LL.5 model", { + expect_error(mixture(acidiq.free5, model = "CA"), "Does not work for LL.5") +}) + +test_that("mixture CA uses default startm = NULL when missing", { + # When startm is missing for CA, it defaults to NULL + result <- mixture(acidiq.free4, model = "CA") + expect_s3_class(result, "drc") +}) + +test_that("mixture CA with explicit startm = NULL", { + result <- mixture(acidiq.free4, model = "CA", startm = NULL) + expect_s3_class(result, "drc") +}) + +test_that("mixture CA sets class to CA and name to ca", { + result <- mixture(acidiq.free4, model = "CA") + # The fct class should be CA (overridden from Hewlett) + expect_s3_class(result$fct, "CA") + expect_equal(result$fct$name, "ca") +}) + +# ============================================================================== +# Tests for mixture() - Hewlett model +# ============================================================================== + +test_that("mixture Hewlett works with LL.4 model", { + result <- mixture(acidiq.free4, model = "Hewlett") + expect_s3_class(result, "drc") + expect_equal(result$text, "Hewlett model") +}) + +test_that("mixture Hewlett works with LL.3 model", { + result <- mixture(acidiq.free3, model = "Hewlett") + expect_s3_class(result, "drc") + expect_equal(result$text, "Hewlett model") +}) + +test_that("mixture Hewlett works with LL.2 model", { + # LL.2 Hewlett may fail convergence on some datasets; test the error path + # or successful fitting if it converges + tryCatch({ + result <- mixture(acidiq.free2, model = "Hewlett") + expect_s3_class(result, "drc") + }, error = function(e) { + # Convergence failure is acceptable for this test + expect_true(grepl("Convergence|convergence|optim|finite", conditionMessage(e))) + }) +}) + +test_that("mixture Hewlett errors with LL.5 model", { + expect_error(mixture(acidiq.free5, model = "Hewlett"), "Does not work for LL.5") +}) + +test_that("mixture Hewlett uses default startm = 1 when missing", { + result <- mixture(acidiq.free4, model = "Hewlett") + expect_s3_class(result, "drc") +}) + +test_that("mixture Hewlett with explicit startm", { + result <- mixture(acidiq.free4, model = "Hewlett", startm = 2) + expect_s3_class(result, "drc") +}) + +# ============================================================================== +# Tests for mixture() - Voelund model +# ============================================================================== + +test_that("mixture Voelund works with LL.4 model", { + result <- mixture(acidiq.free4, model = "Voelund") + expect_s3_class(result, "drc") + expect_equal(result$text, "Voelund model") +}) + +test_that("mixture Voelund works with LL.3 model", { + result <- mixture(acidiq.free3, model = "Voelund") + expect_s3_class(result, "drc") + expect_equal(result$text, "Voelund model") +}) + +test_that("mixture Voelund works with LL.2 model", { + result <- mixture(acidiq.free2, model = "Voelund") + expect_s3_class(result, "drc") + expect_equal(result$text, "Voelund model") +}) + +test_that("mixture Voelund errors with LL.5 model", { + expect_error(mixture(acidiq.free5, model = "Voelund"), "Does not work for LL.5") +}) + +test_that("mixture Voelund uses default startm = c(3, 0.3) when missing", { + result <- mixture(acidiq.free4, model = "Voelund") + expect_s3_class(result, "drc") +}) + +test_that("mixture Voelund with explicit startm", { + result <- mixture(acidiq.free4, model = "Voelund", startm = c(2, 0.5)) + expect_s3_class(result, "drc") +}) + +# ============================================================================== +# Tests for mixture() - Error handling +# ============================================================================== + +test_that("mixture errors when pmodels collapse argument is missing", { + bad_obj <- drm(rgr ~ dose, data = subset(acidiq, pct == 999 | pct == 0), + fct = LL.4()) + expect_error(mixture(bad_obj, model = "CA"), + "collapse.*argument should be a formula") +}) + +test_that("mixture errors when Level 0 is missing from data", { + # Modify curveid to remove all levels containing '0' + obj_no0 <- acidiq.free4 + obj_no0$dataList$curveid <- factor(rep("17", length(acidiq.free4$dataList$curveid))) + expect_error(mixture(obj_no0, model = "CA"), "Level 0 is missing") +}) + +test_that("mixture errors when Level 100 is missing from data", { + # Modify curveid to remove level 100 (but keep levels with "0" substring) + obj_no100 <- acidiq.free4 + cids <- as.character(acidiq.free4$dataList$curveid) + cids[cids == "100"] <- "33" + obj_no100$dataList$curveid <- factor(cids) + expect_error(mixture(obj_no100, model = "CA"), "Level 100 is missing") +}) + +test_that("mixture works with custom start values", { + # Provide explicit start values to skip the default construction + sv <- coef(acidiq.free4) + # CA with LL.4 needs 5 start values (b, c, d, e0, e100) + start_ca <- c(-2, 0, 0.3, 1, 1) + result <- mixture(acidiq.free4, model = "CA", start = start_ca) + expect_s3_class(result, "drc") +}) + +test_that("mixture model argument uses match.arg", { + expect_error(mixture(acidiq.free4, model = "invalid"), + "'arg' should be one of") +}) + +test_that("mixture preserves anova structure", { + result <- mixture(acidiq.free4, model = "CA") + expect_equal(result$anova$test, "F") + # anovaFit is copied from the input object (may be NULL if not set) + expect_true("test" %in% names(result$anova)) +}) + +test_that("mixture with custom control parameter", { + ctrl <- drmc(maxIt = 500) + result <- mixture(acidiq.free4, model = "CA", control = ctrl) + expect_s3_class(result, "drc") +}) + +# ============================================================================== +# Tests for hewlett() function +# ============================================================================== + +test_that("hewlett returns correct structure with default parameters", { + h <- drc:::hewlett() + expect_s3_class(h, "Hewlett") + expect_equal(h$name, "hewlett") + expect_equal(h$text, "Hewlett mixture") + expect_equal(h$noParm, 6) + expect_equal(h$names, c("b", "c", "d", "e", "f", "g")) + expect_true(is.function(h$fct)) + expect_true(is.function(h$ssfct)) + expect_true(is.function(h$scaleFct)) + expect_null(h$deriv1) + expect_null(h$deriv2) + expect_null(h$edfct) + expect_null(h$sifct) +}) + +test_that("hewlett returns correct structure with fixed parameters", { + h <- drc:::hewlett(fixed = c(NA, 0, 1, NA, NA, 1)) + expect_equal(h$noParm, 3) + expect_equal(h$names, c("b", "e", "f")) +}) + +test_that("hewlett errors on incorrect names argument", { + expect_error(drc:::hewlett(names = c("a")), "Not correct 'names' argument") + expect_error(drc:::hewlett(names = c(1, 2, 3, 4, 5, 6)), "Not correct 'names' argument") +}) + +test_that("hewlett errors on incorrect fixed argument", { + expect_error(drc:::hewlett(fixed = c(NA, NA)), "Not correct 'fixed' argument") +}) + +test_that("hewlett fct computes correct values for normal doses", { + h <- drc:::hewlett() + dose <- c(0.1, 1, 10, 100) + parm <- matrix(c(-2, 0, 1, 10, 10, 1), nrow = length(dose), ncol = 6, byrow = TRUE) + result <- h$fct(dose, parm) + expect_length(result, 4) + expect_true(all(is.finite(result))) + # All values should be between c (0) and d (1) parameters + expect_true(all(result >= 0 & result <= 1)) +}) + +test_that("hewlett fct handles zero dose correctly", { + h <- drc:::hewlett() + dose <- c(0, 1, 10) + # b < 0 case: zero dose returns c parameter (lower limit) + parm_neg <- matrix(c(-2, 0.1, 1, 10, 10, 1), nrow = 3, ncol = 6, byrow = TRUE) + result_neg <- h$fct(dose, parm_neg) + expect_equal(result_neg[1], 0.1) # c parameter when b < 0 + + # b > 0 case: zero dose returns d parameter (upper limit) + parm_pos <- matrix(c(2, 0.1, 1, 10, 10, 1), nrow = 3, ncol = 6, byrow = TRUE) + result_pos <- h$fct(dose, parm_pos) + expect_equal(result_pos[1], 1) # d parameter when b > 0 +}) + +test_that("hewlett default ssfct returns valid starting values", { + h <- drc:::hewlett() + df <- data.frame(dose = c(0.01, 0.1, 1, 10, 100), + resp = c(1, 0.95, 0.5, 0.1, 0.01)) + ss <- h$ssfct(df) + expect_length(ss, 6) + expect_true(all(is.finite(ss))) +}) + +test_that("hewlett with custom ssfct", { + custom_ss <- function(dframe) rep(1, 6) + h <- drc:::hewlett(ssfct = custom_ss) + df <- data.frame(dose = 1:5, resp = 5:1) + result <- h$ssfct(df) + expect_equal(result, rep(1, 6)) +}) + +test_that("hewlett scaleFct returns correct scaling", { + h <- drc:::hewlett() + sf <- h$scaleFct(10, 100) + expect_equal(sf, c(1, 100, 100, 10, 10, 1)) +}) + +test_that("hewlett scaleFct respects fixed parameters", { + h <- drc:::hewlett(fixed = c(NA, 0, 1, NA, NA, NA)) + sf <- h$scaleFct(10, 100) + expect_equal(sf, c(1, 10, 10, 1)) +}) + +# ============================================================================== +# Tests for voelund() function +# ============================================================================== + +test_that("voelund returns correct structure with default parameters", { + v <- drc:::voelund() + expect_s3_class(v, "Voelund") + expect_equal(v$name, "voelund") + expect_equal(v$text, "Voelund mixture") + expect_equal(v$noParm, 7) + expect_equal(v$names, c("b", "c", "d", "e", "f", "g", "h")) + expect_true(is.function(v$fct)) + expect_true(is.function(v$ssfct)) + expect_null(v$deriv1) + expect_null(v$deriv2) + expect_null(v$edfct) + expect_null(v$sifct) +}) + +test_that("voelund returns correct structure with fixed parameters", { + v <- drc:::voelund(fixed = c(NA, 0, 1, NA, NA, NA, NA)) + expect_equal(v$noParm, 5) + expect_equal(v$names, c("b", "e", "f", "g", "h")) +}) + +test_that("voelund errors on incorrect names argument", { + expect_error(drc:::voelund(names = c("a")), "Not correct 'names' argument") + expect_error(drc:::voelund(names = c(1, 2, 3, 4, 5, 6, 7)), "Not correct 'names' argument") +}) + +test_that("voelund errors on incorrect fixed argument", { + expect_error(drc:::voelund(fixed = c(NA, NA)), "Not correct 'fixed' argument") +}) + +test_that("voelund fct computes correct values for normal doses", { + v <- drc:::voelund() + dose <- c(0.1, 1, 10, 100) + parm <- matrix(c(-2, 0, 1, 10, 10, 1, 1), nrow = 4, ncol = 7, byrow = TRUE) + result <- v$fct(dose, parm) + expect_length(result, 4) + expect_true(all(is.finite(result))) +}) + +test_that("voelund fct handles zero dose correctly", { + v <- drc:::voelund() + dose <- c(0, 1, 10) + parm <- matrix(c(-2, 0, 1, 10, 10, 1, 1), nrow = 3, ncol = 7, byrow = TRUE) + result <- v$fct(dose, parm) + # When dose < eps (zero), result should be d parameter + expect_equal(result[1], 1) # d parameter +}) + +test_that("voelund fct handles infinite e parameter", { + v <- drc:::voelund() + dose <- c(0.1, 1, 10) + parm <- matrix(c(-2, 0, 1, 10, 10, 1, 1), nrow = 3, ncol = 7, byrow = TRUE) + parm[2, 4] <- Inf # e parameter = Inf for row 2 + result <- v$fct(dose, parm) + expect_length(result, 3) + # When e is Inf, loge should use log(f) instead + expect_true(is.finite(result[1])) + expect_true(is.finite(result[3])) +}) + +test_that("voelund fct handles infinite f parameter", { + v <- drc:::voelund() + dose <- c(0.1, 1, 10) + parm <- matrix(c(-2, 0, 1, 10, 10, 1, 1), nrow = 3, ncol = 7, byrow = TRUE) + parm[2, 5] <- Inf # f parameter = Inf for row 2 + result <- v$fct(dose, parm) + expect_length(result, 3) + # When f is Inf, loge should use log(e) instead + expect_true(is.finite(result[1])) + expect_true(is.finite(result[3])) +}) + +test_that("voelund default ssfct returns valid starting values", { + v <- drc:::voelund() + df <- data.frame(dose = c(0.01, 0.1, 1, 10, 100), + resp = c(1, 0.95, 0.5, 0.1, 0.01)) + ss <- v$ssfct(df) + expect_length(ss, 7) + expect_true(all(is.finite(ss))) +}) + +test_that("voelund with custom ssfct", { + custom_ss <- function(dframe) rep(1, 7) + v <- drc:::voelund(ssfct = custom_ss) + df <- data.frame(dose = 1:5, resp = 5:1) + result <- v$ssfct(df) + expect_equal(result, rep(1, 7)) +}) + +test_that("voelund scaleFct returns correct scaling", { + v <- drc:::voelund() + sf <- v$scaleFct(10, 100) + expect_equal(sf, c(1, 100, 100, 10, 10, 1, 1)) +}) + +test_that("voelund scaleFct respects fixed parameters", { + v <- drc:::voelund(fixed = c(NA, 0, NA, NA, NA, NA, NA)) + sf <- v$scaleFct(10, 100) + expect_equal(sf, c(1, 100, 10, 10, 1, 1)) +}) diff --git a/tests/testthat/test-modelFit.R b/tests/testthat/test-modelFit.R new file mode 100644 index 00000000..9b37e729 --- /dev/null +++ b/tests/testthat/test-modelFit.R @@ -0,0 +1,264 @@ +# Tests for modelFit.R and all related functions +# Functions: modelFit, lofTest, gofTest, returnFct + +# ============================================================================== +# returnFct tests +# ============================================================================== + +test_that("returnFct with default arguments returns 'No test available' anova", { + result <- drc:::returnFct() + expect_s3_class(result, "anova") + expect_s3_class(result, "data.frame") + expect_equal(attr(result, "heading"), "No test available\n") + expect_equal(nrow(result), 2) + expect_equal(ncol(result), 5) + expect_true(all(is.na(result))) +}) + +test_that("returnFct with provided arguments creates proper anova table", { + result <- drc:::returnFct( + dfModel = c(10, 15), + loglik = c(100, 120), + dfDiff = c(NA, 5), + testStat = c(NA, 3.5), + pVal = c(NA, 0.02), + headName = "Test heading\n", + colNames = c("A", "B", "C", "D", "E"), + rowNames = c("Row1", "Row2") + ) + expect_s3_class(result, "anova") + expect_equal(attr(result, "heading"), "Test heading\n") + expect_equal(rownames(result), c("Row1", "Row2")) + expect_equal(colnames(result), c("A", "B", "C", "D", "E")) + expect_equal(result[1, 1], 10) + expect_equal(result[2, 1], 15) + expect_equal(result[2, 4], 3.5) + expect_equal(result[2, 5], 0.02) +}) + +# ============================================================================== +# modelFit tests: continuous data (F-test path via lofTest) +# ============================================================================== + +test_that("modelFit with continuous data performs lack-of-fit F-test", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- modelFit(m1) + + expect_s3_class(result, "anova") + expect_s3_class(result, "data.frame") + expect_equal(attr(result, "heading"), "Lack-of-fit test\n") + expect_equal(nrow(result), 2) + expect_equal(rownames(result), c("ANOVA", "DRC model")) + expect_equal(colnames(result), c("ModelDf", "RSS", "Df", "F value", "p value")) + + # ANOVA row should have ModelDf and RSS but NA for test stats + expect_false(is.na(result[1, "ModelDf"])) + expect_false(is.na(result[1, "RSS"])) + expect_true(is.na(result[1, "Df"])) + expect_true(is.na(result[1, "F value"])) + expect_true(is.na(result[1, "p value"])) + + # DRC model row should have all values + expect_false(is.na(result[2, "ModelDf"])) + expect_false(is.na(result[2, "RSS"])) + expect_false(is.na(result[2, "Df"])) + expect_false(is.na(result[2, "F value"])) + expect_false(is.na(result[2, "p value"])) + + # p-value should be valid + pval <- result[2, "p value"] + expect_true(pval >= 0 && pval <= 1) +}) + +test_that("modelFit with continuous data and Box-Cox uses bcAdd", { + m_bc <- drm(rootl ~ conc, data = ryegrass, fct = LL.4(), bcVal = 0.5, bcAdd = 1) + expect_false(is.null(m_bc$boxcox)) + expect_equal(m_bc$boxcox$bcAdd, 1) + + result <- modelFit(m_bc) + expect_s3_class(result, "anova") + expect_equal(attr(result, "heading"), "Lack-of-fit test\n") + expect_false(is.na(result[2, "p value"])) +}) + +test_that("modelFit returns 'No test available' when ANOVA has 0 residual df", { + # Create data with all unique doses (no replicates) so ANOVA has 0 df + set.seed(42) + dose_unique <- 1:20 + resp_unique <- 5 + 10 / (1 + (dose_unique / 5)^(-2)) + rnorm(20, 0, 0.5) + df_unique <- data.frame(dose = dose_unique, resp = resp_unique) + m_unique <- drm(resp ~ dose, data = df_unique, fct = LL.4()) + + result <- modelFit(m_unique) + expect_s3_class(result, "anova") + expect_equal(attr(result, "heading"), "No test available\n") +}) + +test_that("modelFit method argument is validated", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + # Valid methods + result_gof <- modelFit(m1, method = "gof") + expect_s3_class(result_gof, "anova") + result_cum <- modelFit(m1, method = "cum") + expect_s3_class(result_cum, "anova") + # Invalid method should error + expect_error(modelFit(m1, method = "invalid")) +}) + +# ============================================================================== +# modelFit tests: binomial data (gofTest path) +# ============================================================================== + +test_that("modelFit with binomial data performs goodness-of-fit test", { + m_binom <- drm(r / n ~ dose, weights = n, data = deguelin, fct = LL.2(), + type = "binomial") + result <- modelFit(m_binom) + + expect_s3_class(result, "anova") + expect_equal(attr(result, "heading"), "Goodness-of-fit test\n") + expect_equal(nrow(result), 2) + + # Check Chisq value and p value + chisq_val <- result[2, "Chisq value"] + pval <- result[2, "p value"] + expect_true(!is.na(chisq_val)) + expect_true(!is.na(pval)) + expect_true(pval >= 0 && pval <= 1) +}) + +# ============================================================================== +# modelFit tests: Poisson data +# ============================================================================== + +test_that("modelFit with Poisson type returns NULL", { + set.seed(42) + dose_p <- rep(c(0, 1, 2, 5, 10, 20), each = 3) + count_p <- rpois(18, lambda = 50 * exp(-0.1 * dose_p)) + df_p <- data.frame(dose = dose_p, count = count_p) + m_p <- drm(count ~ dose, data = df_p, fct = LL.4(), type = "Poisson") + + result <- modelFit(m_p) + expect_null(result) +}) + +# ============================================================================== +# lofTest: direct tests for edge cases +# ============================================================================== + +test_that("lofTest with NULL anovaTest returns 'No test available'", { + result <- drc:::lofTest(object = NULL, anovaTest = NULL) + expect_s3_class(result, "anova") + expect_equal(attr(result, "heading"), "No test available\n") +}) + +test_that("lofTest with F-test and NaN test statistic returns NA p-value", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Create a mock anovaTest that returns a fit with 0 deviance and 0 residual df + # This causes testStat = (nlsSS - 0) / dfDiff / (0 / 0) = NaN + mock_anovaTest_nan <- function(formula, ds) { + fit <- lm(formula, data = ds) + # Create a mock fit where deviance = 0 and df.residual = 0 + mock_fit <- list( + residuals = rep(0, nrow(ds)), + rank = ncol(model.matrix(formula, data = ds)), + fitted.values = fit$fitted.values, + assign = fit$assign, + df.residual = 0L # Force 0 residual df + ) + class(mock_fit) <- "lm" + list(test = "F", anovaFit = mock_fit) + } + + result <- drc:::lofTest(m1, mock_anovaTest_nan) + expect_s3_class(result, "anova") + # p-value should be NA when test stat is NaN + expect_true(is.na(result[2, "p value"])) +}) + +test_that("lofTest with F-test and infinite test statistic returns NA p-value", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Create a mock anovaTest that returns a fit with 0 deviance but positive df + # This causes testStat = (nlsSS - 0) / dfDiff / (0 / anovaDF) = Inf + mock_anovaTest_inf <- function(formula, ds) { + fit <- lm(formula, data = ds) + mock_fit <- list( + residuals = rep(0, nrow(ds)), + rank = ncol(model.matrix(formula, data = ds)), + fitted.values = fit$fitted.values, + assign = fit$assign, + df.residual = fit$df.residual # Keep positive df + ) + class(mock_fit) <- "lm" + list(test = "F", anovaFit = mock_fit) + } + + result <- drc:::lofTest(m1, mock_anovaTest_inf) + expect_s3_class(result, "anova") + # p-value should be NA when test stat is infinite + expect_true(is.na(result[2, "p value"])) +}) + +test_that("lofTest with F-test and negative test statistic returns p-value of 1", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Create a mock anovaTest where anovaSS > nlsSS, producing negative F-stat + # testStat = (nlsSS - anovaSS) / dfDiff / (anovaSS / anovaDF) + # If anovaSS is very large, testStat will be negative + mock_anovaTest_neg <- function(formula, ds) { + fit <- lm(formula, data = ds) + # Create a mock fit with very large residuals (large deviance) + mock_fit <- fit + mock_fit$residuals <- fit$residuals * 1000 # Makes deviance much larger than nlsSS + list(test = "F", anovaFit = mock_fit) + } + + result <- drc:::lofTest(m1, mock_anovaTest_neg) + expect_s3_class(result, "anova") + # p-value should be 1 for negative F-stat + expect_equal(result[2, "p value"], 1) +}) + +test_that("lofTest lr test path works correctly", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Create a mock anovaTest that returns test = "lr" + mock_anovaTest_lr <- function(formula, ds) { + fit <- glm(formula, data = ds) + list(test = "lr", anovaFit = fit) + } + + result <- drc:::lofTest(m1, mock_anovaTest_lr) + expect_s3_class(result, "anova") + expect_equal(attr(result, "heading"), "Goodness-of-fit test\n") + expect_equal(rownames(result), c("ANOVA", "DRC model")) + expect_equal(colnames(result), c("ModelDf", "Log lik", "Df", "Chisq value", "p value")) +}) + +# ============================================================================== +# gofTest: direct tests +# ============================================================================== + +test_that("gofTest with NULL gofTest result returns 'No test available'", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Create a mock gofTest function that returns NULL + mock_gof <- function(resp, weights, fitted, dfres) NULL + + result <- drc:::gofTest(m1, mock_gof) + expect_s3_class(result, "anova") + expect_equal(attr(result, "heading"), "No test available\n") +}) + +test_that("gofTest with valid result returns goodness-of-fit table", { + m_binom <- drm(r / n ~ dose, weights = n, data = deguelin, fct = LL.2(), + type = "binomial") + + # Use the actual gofTest from drmLOFbinomial + binom_fns <- drc:::drmLOFbinomial() + result <- drc:::gofTest(m_binom, binom_fns$gofTest) + + expect_s3_class(result, "anova") + expect_equal(attr(result, "heading"), "Goodness-of-fit test\n") +}) diff --git a/tests/testthat/test-modelFunction.R b/tests/testthat/test-modelFunction.R new file mode 100644 index 00000000..7b8485fb --- /dev/null +++ b/tests/testthat/test-modelFunction.R @@ -0,0 +1,413 @@ +# Tests for modelFunction (R/modelFunction.R) +# An internal function that creates a model evaluation closure (multCurves) + +# --- Helper setup --- + +# Simple parm2mat: converts a parameter vector into a matrix +# For n observations and p parameters, returns n x p matrix +make_parm2mat <- function(n, p) { + function(parm) { + matrix(parm, nrow = n, ncol = p, byrow = TRUE) + } +} + +# Simple drcFct: linear dose-response f(dose, parm) = parm[,1] * dose + parm[,2] +simple_drcFct <- function(dose, parm) { + parm[, 1] * dose + parm[, 2] +} + +# ============================================================ +# Test Block 1: Basic functionality with cm = NULL, retFct = NULL, pshifts = NULL +# ============================================================ +test_that("modelFunction returns a function when cm=NULL, retFct=NULL, pshifts=NULL", { + n <- 5 + dose <- c(0, 1, 2, 3, 4) + parm2mat <- make_parm2mat(n, 2) + isFinite <- rep(TRUE, n) + + result <- drc:::modelFunction( + dose = dose, parm2mat = parm2mat, drcFct = simple_drcFct, + cm = NULL, assayNoOld = rep(1, n), upperPos = 2, + retFct = NULL, doseScaling = 1, respScaling = 1, + isFinite = isFinite, pshifts = NULL + ) + + expect_true(is.function(result)) +}) + +test_that("modelFunction (cm=NULL) evaluates correctly with simple linear function", { + n <- 5 + dose <- c(0, 1, 2, 3, 4) + parm2mat <- make_parm2mat(n, 2) + isFinite <- rep(TRUE, n) + + multCurves <- drc:::modelFunction( + dose = dose, parm2mat = parm2mat, drcFct = simple_drcFct, + cm = NULL, assayNoOld = rep(1, n), upperPos = 2, + retFct = NULL, doseScaling = 1, respScaling = 1, + isFinite = isFinite, pshifts = NULL + ) + + # parm = c(2, 3) -> each row is [2, 3] + # f(dose, parm) = 2*dose + 3 + out <- multCurves(dose, c(2, 3)) + expected <- 2 * dose + 3 + expect_equal(out, expected) +}) + +# ============================================================ +# Test Block 2: retFct is not NULL +# ============================================================ +test_that("modelFunction uses retFct to replace drcFct when retFct is not NULL", { + n <- 3 + dose <- c(1, 2, 3) + parm2mat <- make_parm2mat(n, 2) + isFinite <- rep(TRUE, n) + + # retFct returns a function that scales dose response by doseScaling * respScaling + my_retFct <- function(doseScaling, respScaling) { + scale <- doseScaling * respScaling + function(dose, parm) { + scale * (parm[, 1] * dose + parm[, 2]) + } + } + + multCurves <- drc:::modelFunction( + dose = dose, parm2mat = parm2mat, drcFct = simple_drcFct, + cm = NULL, assayNoOld = rep(1, n), upperPos = 2, + retFct = my_retFct, doseScaling = 2, respScaling = 3, + isFinite = isFinite, pshifts = NULL + ) + + out <- multCurves(dose, c(1, 0)) + # scale = 2*3 = 6; f = 6 * (1*dose + 0) = 6*dose + expect_equal(out, 6 * dose) +}) + +# ============================================================ +# Test Block 3: pshifts is not NULL (cm = NULL path) +# ============================================================ +test_that("modelFunction applies pshifts when dimensions match (cm=NULL path)", { + n <- 3 + dose <- c(1, 2, 3) + parm2mat <- make_parm2mat(n, 2) + isFinite <- rep(TRUE, n) + + # pshifts adds [1, 1] to each row of parmVal + pshifts <- matrix(1, nrow = n, ncol = 2) + + multCurves <- drc:::modelFunction( + dose = dose, parm2mat = parm2mat, drcFct = simple_drcFct, + cm = NULL, assayNoOld = rep(1, n), upperPos = 2, + retFct = NULL, doseScaling = 1, respScaling = 1, + isFinite = isFinite, pshifts = pshifts + ) + + # parm = c(2, 3) -> parmVal = [[2,3],[2,3],[2,3]] + # pshifts = [[1,1],[1,1],[1,1]] + # parmVal + pshifts = [[3,4],[3,4],[3,4]] + # f(dose, parm) = 3*dose + 4 + out <- multCurves(dose, c(2, 3)) + expected <- 3 * dose + 4 + expect_equal(out, expected) +}) + +test_that("modelFunction does NOT apply pshifts when dimensions do not match (cm=NULL)", { + n <- 3 + dose <- c(1, 2, 3) + parm2mat <- make_parm2mat(n, 2) + isFinite <- rep(TRUE, n) + + # Wrong dimensions: 4 x 2 instead of 3 x 2 + pshifts <- matrix(1, nrow = 4, ncol = 2) + + multCurves <- drc:::modelFunction( + dose = dose, parm2mat = parm2mat, drcFct = simple_drcFct, + cm = NULL, assayNoOld = rep(1, n), upperPos = 2, + retFct = NULL, doseScaling = 1, respScaling = 1, + isFinite = isFinite, pshifts = pshifts + ) + + # pshifts not applied because dim mismatch + out <- multCurves(dose, c(2, 3)) + expected <- 2 * dose + 3 + expect_equal(out, expected) +}) + +# ============================================================ +# Test Block 4: cm is NOT NULL (control measurement path) +# ============================================================ +test_that("modelFunction with cm != NULL separates control and non-control observations", { + n <- 4 + dose <- c(0, 1, 2, 3) + parm2mat <- make_parm2mat(n, 2) + isFinite <- rep(TRUE, n) + assayNoOld <- c(1, 1, 2, 2) + cm <- 1 # assay 1 is control + upperPos <- 2 # second column is the upper asymptote + + multCurves <- drc:::modelFunction( + dose = dose, parm2mat = parm2mat, drcFct = simple_drcFct, + cm = cm, assayNoOld = assayNoOld, upperPos = upperPos, + retFct = NULL, doseScaling = 1, respScaling = 1, + isFinite = isFinite, pshifts = NULL + ) + + parm <- c(2, 5) + out <- multCurves(dose, parm) + + # iv = isFinite & (assayNoOld == cm) -> TRUE, TRUE, FALSE, FALSE + # niv = FALSE, FALSE, TRUE, TRUE + # parmVal (each row [2, 5]): + # For iv (obs 1,2): fctEval = parmVal[, upperPos] = 5 + # For niv (obs 3,4): fctEval = simple_drcFct(dose[niv], parmVal[niv,]) = 2*dose + 5 + expected <- c(5, 5, 2 * 2 + 5, 2 * 3 + 5) + expect_equal(out, expected) +}) + +# ============================================================ +# Test Block 5: cm != NULL with pshifts +# ============================================================ +test_that("modelFunction with cm != NULL applies pshifts when dimensions match", { + n <- 4 + dose <- c(0, 1, 2, 3) + parm2mat <- make_parm2mat(n, 2) + isFinite <- rep(TRUE, n) + assayNoOld <- c(1, 1, 2, 2) + cm <- 1 + upperPos <- 2 + + pshifts <- matrix(c(0.5, 1), nrow = n, ncol = 2, byrow = TRUE) + + multCurves <- drc:::modelFunction( + dose = dose, parm2mat = parm2mat, drcFct = simple_drcFct, + cm = cm, assayNoOld = assayNoOld, upperPos = upperPos, + retFct = NULL, doseScaling = 1, respScaling = 1, + isFinite = isFinite, pshifts = pshifts + ) + + parm <- c(2, 5) + out <- multCurves(dose, parm) + + # parmVal (each row [2,5]) + pshifts (each row [0.5,1]) = each row [2.5, 6] + # iv (obs 1,2): fctEval = parmVal[, 2] = 6 + # niv (obs 3,4): fctEval = 2.5 * dose + 6 + expected <- c(6, 6, 2.5 * 2 + 6, 2.5 * 3 + 6) + expect_equal(out, expected) +}) + +test_that("modelFunction with cm != NULL does NOT apply pshifts when dims don't match", { + n <- 4 + dose <- c(0, 1, 2, 3) + parm2mat <- make_parm2mat(n, 2) + isFinite <- rep(TRUE, n) + assayNoOld <- c(1, 1, 2, 2) + cm <- 1 + upperPos <- 2 + + # Wrong dims + pshifts <- matrix(1, nrow = 5, ncol = 2) + + multCurves <- drc:::modelFunction( + dose = dose, parm2mat = parm2mat, drcFct = simple_drcFct, + cm = cm, assayNoOld = assayNoOld, upperPos = upperPos, + retFct = NULL, doseScaling = 1, respScaling = 1, + isFinite = isFinite, pshifts = pshifts + ) + + parm <- c(2, 5) + out <- multCurves(dose, parm) + + # pshifts NOT applied + expected <- c(5, 5, 2 * 2 + 5, 2 * 3 + 5) + expect_equal(out, expected) +}) + +# ============================================================ +# Test Block 6: retFct with cm != NULL +# ============================================================ +test_that("modelFunction with retFct and cm != NULL uses retFct for drcFct", { + n <- 4 + dose <- c(0, 1, 2, 3) + parm2mat <- make_parm2mat(n, 2) + isFinite <- rep(TRUE, n) + assayNoOld <- c(1, 1, 2, 2) + cm <- 1 + upperPos <- 2 + + # retFct: returns a scaled drcFct + my_retFct <- function(doseScaling, respScaling) { + scale <- doseScaling * respScaling + function(dose, parm) { + scale * (parm[, 1] * dose + parm[, 2]) + } + } + + multCurves <- drc:::modelFunction( + dose = dose, parm2mat = parm2mat, drcFct = simple_drcFct, + cm = cm, assayNoOld = assayNoOld, upperPos = upperPos, + retFct = my_retFct, doseScaling = 2, respScaling = 3, + isFinite = isFinite, pshifts = NULL + ) + + parm <- c(1, 10) + out <- multCurves(dose, parm) + + # Note: in the cm != NULL path, drcFct is replaced by retFct result + # BUT the cm path uses drcFct directly (not drcFct1), so retFct replacement affects both paths + # iv: fctEval = parmVal[, upperPos] = 10 (not through drcFct) + # niv: drcFct(dose[niv], parmVal[niv,]) = 6 * (1*dose + 10) + expected <- c(10, 10, 6 * (1 * 2 + 10), 6 * (1 * 3 + 10)) + expect_equal(out, expected) +}) + +# ============================================================ +# Test Block 7: isFinite with some FALSE values (cm=NULL path) +# ============================================================ +test_that("modelFunction with isFinite subset (cm=NULL)", { + n <- 4 + dose <- c(0, 1, 2, 3) + isFinite <- rep(TRUE, n) + + # parm2mat needs to return n x p matrix + parm2mat <- make_parm2mat(n, 2) + + # drcFct receives only the rows where isFinite is TRUE + drcFct_sub <- function(dose, parm) { + parm[, 1] * dose + parm[, 2] + } + + multCurves <- drc:::modelFunction( + dose = dose, parm2mat = parm2mat, drcFct = drcFct_sub, + cm = NULL, assayNoOld = rep(1, n), upperPos = 2, + retFct = NULL, doseScaling = 1, respScaling = 1, + isFinite = isFinite, pshifts = NULL + ) + + out <- multCurves(dose, c(2, 3)) + # All isFinite = TRUE, so all rows selected + # drcFct(dose, parmVal) = 2*dose + 3 + expected <- 2 * dose + 3 + expect_equal(out, expected) + expect_equal(length(out), n) +}) + +# ============================================================ +# Test Block 8: Edge case - single observation +# ============================================================ +test_that("modelFunction works with single observation (cm=NULL)", { + n <- 1 + dose <- 5 + parm2mat <- make_parm2mat(n, 2) + isFinite <- TRUE + + multCurves <- drc:::modelFunction( + dose = dose, parm2mat = parm2mat, drcFct = simple_drcFct, + cm = NULL, assayNoOld = 1, upperPos = 2, + retFct = NULL, doseScaling = 1, respScaling = 1, + isFinite = isFinite, pshifts = NULL + ) + + out <- multCurves(dose, c(2, 3)) + expect_equal(out, 2 * 5 + 3) +}) + +test_that("modelFunction works with single observation (cm != NULL, control)", { + n <- 1 + dose <- 5 + parm2mat <- make_parm2mat(n, 2) + isFinite <- TRUE + assayNoOld <- 1 + cm <- 1 # this obs is control + upperPos <- 2 + + multCurves <- drc:::modelFunction( + dose = dose, parm2mat = parm2mat, drcFct = simple_drcFct, + cm = cm, assayNoOld = assayNoOld, upperPos = upperPos, + retFct = NULL, doseScaling = 1, respScaling = 1, + isFinite = isFinite, pshifts = NULL + ) + + out <- multCurves(dose, c(2, 5)) + # iv = TRUE (obs matches cm), niv = FALSE + # fctEval[iv] = parmVal[, upperPos] = 5 + expect_equal(out, 5) +}) + +# ============================================================ +# Test Block 9: Both retFct and pshifts (cm=NULL) +# ============================================================ +test_that("modelFunction with both retFct and pshifts (cm=NULL)", { + n <- 3 + dose <- c(1, 2, 3) + parm2mat <- make_parm2mat(n, 2) + isFinite <- rep(TRUE, n) + pshifts <- matrix(c(0.1, 0.2), nrow = n, ncol = 2, byrow = TRUE) + + my_retFct <- function(doseScaling, respScaling) { + function(dose, parm) { + parm[, 1] * dose + parm[, 2] + } + } + + multCurves <- drc:::modelFunction( + dose = dose, parm2mat = parm2mat, drcFct = simple_drcFct, + cm = NULL, assayNoOld = rep(1, n), upperPos = 2, + retFct = my_retFct, doseScaling = 1, respScaling = 1, + isFinite = isFinite, pshifts = pshifts + ) + + out <- multCurves(dose, c(1, 2)) + # parmVal = [[1,2],[1,2],[1,2]] + [[0.1,0.2],[0.1,0.2],[0.1,0.2]] = [[1.1, 2.2],...] + # f(dose, parm) = 1.1*dose + 2.2 + expected <- 1.1 * dose + 2.2 + expect_equal(out, expected) +}) + +# ============================================================ +# Test Block 10: cm != NULL, all obs are non-control +# ============================================================ +test_that("modelFunction cm != NULL where no obs match control", { + n <- 3 + dose <- c(1, 2, 3) + parm2mat <- make_parm2mat(n, 2) + isFinite <- rep(TRUE, n) + assayNoOld <- c(2, 2, 2) + cm <- 1 # no obs have assayNoOld==1 + + multCurves <- drc:::modelFunction( + dose = dose, parm2mat = parm2mat, drcFct = simple_drcFct, + cm = cm, assayNoOld = assayNoOld, upperPos = 2, + retFct = NULL, doseScaling = 1, respScaling = 1, + isFinite = isFinite, pshifts = NULL + ) + + out <- multCurves(dose, c(2, 5)) + # all are niv -> drcFct applied to all + expected <- 2 * dose + 5 + expect_equal(out, expected) +}) + +# ============================================================ +# Test Block 11: cm != NULL, all obs are control +# ============================================================ +test_that("modelFunction cm != NULL where ALL obs match control", { + n <- 3 + dose <- c(1, 2, 3) + parm2mat <- make_parm2mat(n, 2) + isFinite <- rep(TRUE, n) + assayNoOld <- c(1, 1, 1) + cm <- 1 # all obs are control + + multCurves <- drc:::modelFunction( + dose = dose, parm2mat = parm2mat, drcFct = simple_drcFct, + cm = cm, assayNoOld = assayNoOld, upperPos = 2, + retFct = NULL, doseScaling = 1, respScaling = 1, + isFinite = isFinite, pshifts = NULL + ) + + out <- multCurves(dose, c(2, 5)) + # all are iv -> fctEval = parmVal[, upperPos] = 5 + expected <- c(5, 5, 5) + expect_equal(out, expected) +}) diff --git a/tests/testthat/test-mr.test.R b/tests/testthat/test-mr.test.R new file mode 100644 index 00000000..58564b59 --- /dev/null +++ b/tests/testthat/test-mr.test.R @@ -0,0 +1,107 @@ +# Test suite for mr.test() +# Achieves 100% code coverage for R/mr.test.R + +# ---- Setup: create model fixtures ---- +# etmotc dataset: dose-response data for testing +# Using first 15 observations as in the documented example +data(etmotc) +etmotc_sub <- etmotc[1:15, ] + +# Null model: 4-parameter log-logistic +m1 <- drm(rgr1 ~ dose1, data = etmotc_sub, fct = LL.4()) + +# Alternative model: 4-parameter Weibull type 1 +m2 <- update(m1, fct = W1.4()) + +# Fitted model under alternative: fit the null model's fitted values using +# the alternative model structure +m3 <- drm(fitted(m1) ~ dose1, data = etmotc_sub, fct = W1.4()) + +# Dose vector with zeros replaced by small value (as per docs example) +xVec <- etmotc_sub$dose1 +xVec[xVec == 0] <- 1e-10 + +# ---- Tests for var.equal = TRUE (default path) ---- + +test_that("mr.test with var.equal=TRUE returns correct structure", { + result <- mr.test(m1, m2, m3, xVec, var.equal = TRUE) + expect_type(result, "double") + expect_length(result, 4) + expect_named(result, c("Statistic", "p-value", "Difference", "SE")) +}) + +test_that("mr.test with var.equal=TRUE returns valid statistics", { + result <- mr.test(m1, m2, m3, xVec, var.equal = TRUE) + # p-value must be between 0 and 1 + expect_true(result["p-value"] >= 0 && result["p-value"] <= 1) + # SE must be positive + expect_true(result["SE"] > 0) + # Statistic should be finite + expect_true(is.finite(result["Statistic"])) +}) + +test_that("mr.test default var.equal is TRUE", { + result_default <- mr.test(m1, m2, m3, xVec) + result_explicit <- mr.test(m1, m2, m3, xVec, var.equal = TRUE) + expect_equal(result_default, result_explicit) +}) + +# ---- Tests for var.equal = FALSE (heteroscedastic path) ---- + +test_that("mr.test with var.equal=FALSE returns correct structure", { + result <- mr.test(m1, m2, m3, xVec, var.equal = FALSE) + expect_type(result, "double") + expect_length(result, 4) + expect_named(result, c("Statistic", "p-value", "Difference", "SE")) +}) + +test_that("mr.test with var.equal=FALSE returns valid statistics", { + result <- mr.test(m1, m2, m3, xVec, var.equal = FALSE) + # p-value must be between 0 and 1 + expect_true(result["p-value"] >= 0 && result["p-value"] <= 1) + # SE must be positive + expect_true(result["SE"] > 0) + # Statistic should be finite + expect_true(is.finite(result["Statistic"])) +}) + +test_that("mr.test var.equal=TRUE and FALSE give different results", { + result_equal <- mr.test(m1, m2, m3, xVec, var.equal = TRUE) + result_unequal <- mr.test(m1, m2, m3, xVec, var.equal = FALSE) + # Results should differ due to different variance estimation + expect_false(identical(result_equal, result_unequal)) +}) + +# ---- Tests for component parameter ---- + +test_that("mr.test with different component values", { + result_c1 <- mr.test(m1, m2, m3, xVec, component = 1) + result_c2 <- mr.test(m1, m2, m3, xVec, component = 2) + result_c3 <- mr.test(m1, m2, m3, xVec, component = 3) + result_c4 <- mr.test(m1, m2, m3, xVec, component = 4) + # Each component should give different results + expect_false(identical(result_c1, result_c2)) + # All should have the standard structure + expect_named(result_c2, c("Statistic", "p-value", "Difference", "SE")) + expect_named(result_c3, c("Statistic", "p-value", "Difference", "SE")) + expect_named(result_c4, c("Statistic", "p-value", "Difference", "SE")) +}) + +test_that("mr.test with component and var.equal=FALSE", { + result <- mr.test(m1, m2, m3, xVec, var.equal = FALSE, component = 2) + expect_type(result, "double") + expect_length(result, 4) + expect_named(result, c("Statistic", "p-value", "Difference", "SE")) + expect_true(result["p-value"] >= 0 && result["p-value"] <= 1) +}) + +# ---- Reproducibility test with documented example values ---- + +test_that("mr.test reproduces documented example output", { + # Using the exact example from the roxygen docs + result <- mr.test(m1, m2, m3, xVec, var.equal = FALSE) + # Verify the result is a named numeric vector of length 4 + expect_type(result, "double") + expect_length(result, 4) + expect_named(result, c("Statistic", "p-value", "Difference", "SE")) +}) diff --git a/tests/testthat/test-mrdrm.R b/tests/testthat/test-mrdrm.R new file mode 100644 index 00000000..77e5e57d --- /dev/null +++ b/tests/testthat/test-mrdrm.R @@ -0,0 +1,834 @@ +# Test suite for mrdrm.R functions +# Covers: mrdrm, leaveOneOut, pressWeights, dfFct, predFct, +# loessEst, hat.loess, hat.drc, hat.mr, se.mr, +# predict.mrdrc, inverseRegBasic, inverseReg, EDprint, +# ED.mrdrc, plot.mrdrc, print.mrdrc, EDboot, pava + +# --- Setup --- +# Continuous data +data(ryegrass) +m1_cont <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +m2_cont <- loess(rootl ~ conc, data = ryegrass, degree = 1) + +# Binomial data +data(deguelin) +m1_binom <- drm(r/n ~ dose, weights = n, data = deguelin, fct = LL.2(), type = "binomial") +m2_binom <- loess(r/n ~ dose, data = deguelin, degree = 1) + +# ---- pava ---- + +test_that("pava returns input for single element", { + expect_equal(drc:::pava(5), 5) +}) + +test_that("pava returns input for already sorted sequence", { + x <- c(1, 2, 3, 4) + expect_equal(drc:::pava(x), x) +}) + +test_that("pava pools adjacent violators", { + x <- c(1, 3, 2, 4) + result <- drc:::pava(x) + expect_equal(result, c(1, 2.5, 2.5, 4)) +}) + +test_that("pava handles weighted input", { + x <- c(3, 1, 2) + wt <- c(1, 2, 1) + result <- drc:::pava(x, wt) + expect_true(all(diff(result) >= 0)) +}) + +test_that("pava handles all-equal input", { + x <- c(5, 5, 5) + expect_equal(drc:::pava(x), x) +}) + +test_that("pava handles fully decreasing input", { + x <- c(4, 3, 2, 1) + result <- drc:::pava(x) + expect_true(all(diff(result) >= 0)) + expect_equal(result, rep(mean(x), 4)) +}) + +# ---- loessEst ---- + +test_that("loessEst returns correct structure", { + result <- drc:::loessEst(5, ryegrass$conc, ryegrass$rootl, 0.75) + expect_type(result, "list") + expect_length(result, 2) + expect_true(is.numeric(result[[1]])) + expect_true(is.numeric(result[[2]])) + expect_length(result[[2]], nrow(ryegrass)) +}) + +test_that("loessEst works with logScale = TRUE", { + result <- drc:::loessEst(5, ryegrass$conc, ryegrass$rootl, 0.75, logScale = TRUE) + expect_true(is.numeric(result[[1]])) +}) + +# ---- hat.loess ---- + +test_that("hat.loess returns a matrix", { + x <- deguelin$dose + H <- drc:::hat.loess(x, m2_binom$pars$span) + expect_true(is.matrix(H)) + expect_equal(dim(H), c(length(x), length(x))) +}) + +test_that("hat.loess works with x0 different from x", { + x <- deguelin$dose + x0 <- c(5, 15, 25) + H <- drc:::hat.loess(x, m2_binom$pars$span, x0 = x0) + expect_equal(dim(H), c(length(x0), length(x))) +}) + +# ---- hat.drc ---- + +test_that("hat.drc works for continuous data", { + x <- m1_cont$data[, 1] + H <- drc:::hat.drc(m1_cont, x) + expect_true(is.matrix(H)) + expect_equal(nrow(H), length(x)) +}) + +test_that("hat.drc works for binomial data", { + x <- m1_binom$data[, 1] + H <- drc:::hat.drc(m1_binom, x) + expect_true(is.matrix(H)) + expect_equal(nrow(H), length(x)) +}) + +test_that("hat.drc works with x0 different from x", { + x <- m1_cont$data[, 1] + x0 <- c(0, 5, 10) + H <- drc:::hat.drc(m1_cont, x, x0 = x0) + expect_equal(nrow(H), length(x0)) + expect_equal(ncol(H), length(x)) +}) + +# ---- hat.mr ---- + +test_that("hat.mr returns a matrix", { + suppressWarnings({ + mr_b <- drc:::mrdrm(m1_binom, m2_binom) + }) + H <- drc:::hat.mr(mr_b) + expect_true(is.matrix(H)) +}) + +# ---- se.mr ---- + +test_that("se.mr works for continuous data", { + mr_c <- drc:::mrdrm(m1_cont, m2_cont) + se <- drc:::se.mr(mr_c, mr_c$dose) + expect_true(is.numeric(se)) + expect_length(se, length(mr_c$dose)) +}) + +test_that("se.mr works for binomial data", { + suppressWarnings({ + mr_b <- drc:::mrdrm(m1_binom, m2_binom) + }) + se <- drc:::se.mr(mr_b, mr_b$dose) + expect_true(is.numeric(se)) + expect_length(se, length(mr_b$dose)) +}) + +# ---- dfFct ---- + +test_that("dfFct returns a function", { + fn <- drc:::dfFct(m1_cont, m2_cont) + expect_type(fn, "closure") + df_val <- fn(0.5) + expect_true(is.numeric(df_val)) + expect_length(df_val, 1) +}) + +# ---- predFct ---- + +test_that("predFct returns a function", { + looList <- list(pred1 = rep(1, 10), pred2 = rep(2, 10)) + fn <- drc:::predFct(looList) + expect_type(fn, "closure") + result <- fn(0.5) + expect_equal(result, rep(1.5, 10)) +}) + +test_that("predFct handles lambda = 0 and lambda = 1", { + looList <- list(pred1 = c(1, 2, 3), pred2 = c(4, 5, 6)) + fn <- drc:::predFct(looList) + expect_equal(fn(0), c(1, 2, 3)) + expect_equal(fn(1), c(4, 5, 6)) +}) + +# ---- leaveOneOut ---- + +test_that("leaveOneOut returns correct structure for continuous data", { + dataSet <- m1_cont$origData + dose <- m1_cont$data[, 1] + resp <- m1_cont$data[, 2] + result <- drc:::leaveOneOut(m1_cont, m2_cont, dose, dataSet, resp, fixedEnd = FALSE) + expect_type(result, "list") + expect_named(result, c("pred1", "pred2")) + expect_true(is.numeric(result$pred1)) + expect_true(is.numeric(result$pred2)) +}) + +test_that("leaveOneOut with fixedEnd = TRUE modifies boundary values", { + dataSet <- m1_cont$origData + dose <- m1_cont$data[, 1] + resp <- m1_cont$data[, 2] + result_nofix <- drc:::leaveOneOut(m1_cont, m2_cont, dose, dataSet, resp, fixedEnd = FALSE) + result_fix <- drc:::leaveOneOut(m1_cont, m2_cont, dose, dataSet, resp, fixedEnd = TRUE) + # Source code sets pred2Vec[1] and pred2Vec[lenUd] where lenUd = length(unique(dose)) + # This matches exactly the indexing used in leaveOneOut() + uniDose <- sort(unique(dose)) + lenUd <- length(uniDose) + expect_equal(result_fix$pred2[1], mean(resp[dose == uniDose[1]])) + expect_equal(result_fix$pred2[lenUd], mean(resp[dose == uniDose[lenUd]])) +}) + +# ---- pressWeights ---- + +test_that("pressWeights 'none' returns vector of ones", { + result <- drc:::pressWeights("none", 10, rep(1, 10), m1_cont, rep(0.5, 10), m2_cont) + expect_equal(result, rep(1, 10)) +}) + +test_that("pressWeights 'par' uses parametric predictions", { + nVec <- m1_binom$weights + resp <- m1_binom$data[, 2] + lenData <- length(resp) + result <- drc:::pressWeights("par", lenData, nVec, m1_binom, resp, m2_binom) + expect_true(is.numeric(result)) + expect_length(result, lenData) +}) + +test_that("pressWeights 'nonpar' uses non-parametric predictions", { + nVec <- m1_binom$weights + resp <- m1_binom$data[, 2] + lenData <- length(resp) + result <- drc:::pressWeights("nonpar", lenData, nVec, m1_binom, resp, m2_binom) + expect_true(is.numeric(result)) + expect_length(result, lenData) +}) + +test_that("pressWeights 'response' uses response values", { + nVec <- m1_binom$weights + resp <- m1_binom$data[, 2] + lenData <- length(resp) + result <- drc:::pressWeights("response", lenData, nVec, m1_binom, resp, m2_binom) + expect_true(is.numeric(result)) + expect_length(result, lenData) +}) + +test_that("pressWeights 'ad hoc' adjusts for boundary values", { + nVec <- m1_binom$weights + resp <- m1_binom$data[, 2] + lenData <- length(resp) + result <- drc:::pressWeights("ad hoc", lenData, nVec, m1_binom, resp, m2_binom) + expect_true(is.numeric(result)) + expect_length(result, lenData) +}) + +# ---- mrdrm main function ---- + +test_that("mrdrm returns an object of class mrdrc", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + expect_s3_class(mr, "mrdrc") +}) + +test_that("mrdrm return object has expected structure", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + expected_names <- c("pressVal", "lambda", "fitted", "gof", "object1", "object2", + "dose", "EDmethod", "ll", "ls.weights", "df") + expect_named(mr, expected_names) + expect_true(is.numeric(mr$lambda)) + expect_true(is.numeric(mr$fitted)) + expect_true(is.numeric(mr$gof)) + expect_named(mr$gof, c("mr.gof", "p.gof", "aic", "rv")) + expect_equal(mr$EDmethod, "inverse") +}) + +test_that("mrdrm creates loess object internally when object2 is missing", { + mr <- drc:::mrdrm(m1_cont) + expect_s3_class(mr, "mrdrc") + expect_s3_class(mr$object2, "loess") +}) + +test_that("mrdrm errors with non-linear loess (degree > 1)", { + m2_quad <- loess(rootl ~ conc, data = ryegrass, degree = 2) + expect_error(drc:::mrdrm(m1_cont, m2_quad), "Local regression fit not linear!") +}) + +test_that("mrdrm works with continuous data and GCV criterion", { + mr <- drc:::mrdrm(m1_cont, m2_cont, criterion = "gcv") + expect_s3_class(mr, "mrdrc") + expect_true(is.null(mr$ll)) # GCV doesn't use leave-one-out + expect_true(is.null(mr$ls.weights)) + # For continuous data, critFct is forced to "ls" and ls.weights to "none" + expect_equal(mr$gof["rv"], mr$gof["mr.gof"] / mr$df, ignore_attr = TRUE) +}) + +test_that("mrdrm works with continuous data and LCV criterion", { + mr <- drc:::mrdrm(m1_cont, m2_cont, criterion = "lcv") + expect_s3_class(mr, "mrdrc") + expect_false(is.null(mr$ll)) # LCV uses leave-one-out + expect_false(is.null(mr$ls.weights)) +}) + +test_that("mrdrm works with binomial data and GCV criterion", { + suppressWarnings({ + mr <- drc:::mrdrm(m1_binom, m2_binom, criterion = "gcv") + }) + expect_s3_class(mr, "mrdrc") + expect_true(is.na(mr$gof["rv"])) # Binomial has NA for rv +}) + +test_that("mrdrm works with binomial data and LCV criterion", { + suppressWarnings({ + mr <- drc:::mrdrm(m1_binom, m2_binom, criterion = "lcv") + }) + expect_s3_class(mr, "mrdrc") + expect_false(is.null(mr$ll)) +}) + +test_that("mrdrm works with binomial data and LL criterion", { + suppressWarnings({ + mr <- drc:::mrdrm(m1_binom, m2_binom, critFct = "ll") + }) + expect_s3_class(mr, "mrdrc") + expect_false(is.null(mr$ll)) + expect_true(is.null(mr$ls.weights)) +}) + +test_that("mrdrm with single lambda value", { + mr <- drc:::mrdrm(m1_cont, m2_cont, lambda = 0.5) + expect_equal(mr$lambda, 0.5) + expect_true(is.na(mr$pressVal)) +}) + +test_that("mrdrm with unitScale = TRUE", { + mr <- drc:::mrdrm(m1_cont, m2_cont, unitScale = TRUE) + expect_s3_class(mr, "mrdrc") +}) + +test_that("mrdrm with fixedEnd = TRUE for LCV criterion", { + mr <- drc:::mrdrm(m1_cont, m2_cont, criterion = "lcv", fixedEnd = TRUE) + expect_s3_class(mr, "mrdrc") +}) + +test_that("mrdrm with different ls.weights for binomial LCV", { + for (w in c("nonpar", "ad hoc", "par", "response")) { + suppressWarnings({ + mr <- drc:::mrdrm(m1_binom, m2_binom, criterion = "lcv", ls.weights = w) + }) + expect_s3_class(mr, "mrdrc") + } +}) + +test_that("mrdrm forces ls critFct and none weights for continuous data", { + # Even if user passes different values, continuous data overrides + mr <- drc:::mrdrm(m1_cont, m2_cont, critFct = "ll", ls.weights = "par") + expect_s3_class(mr, "mrdrc") + # The override to "ls"/"none" means no weights are stored (ls.weights = NULL with GCV) + # and residual variance (gof[4]) is computed (only happens with "ls" criterion) + expect_false(is.na(mr$gof["rv"])) +}) + +# ---- predict.mrdrc ---- + +test_that("predict.mrdrc returns fitted values without newdata", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + pred <- predict(mr) + expect_true(is.numeric(pred)) + expect_length(pred, length(mr$fitted)) + expect_equal(as.numeric(pred), as.numeric(mr$fitted)) +}) + +test_that("predict.mrdrc works with newdata", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + newdf <- data.frame(conc = c(0, 1, 5, 10)) + pred <- predict(mr, newdata = newdf) + expect_true(is.numeric(pred)) + expect_length(pred, 4) +}) + +test_that("predict.mrdrc returns SE when se.fit = TRUE", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + pred <- predict(mr, se.fit = TRUE) + expect_true(is.matrix(pred)) + expect_equal(ncol(pred), 2) + expect_equal(colnames(pred), c("Prediction", "SE")) +}) + +test_that("predict.mrdrc returns confidence intervals", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + pred <- predict(mr, interval = "confidence") + expect_true(is.matrix(pred)) + expect_equal(ncol(pred), 3) + expect_equal(colnames(pred), c("Prediction", "Lower CI", "Upper CI")) +}) + +test_that("predict.mrdrc returns prediction intervals", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + pred <- predict(mr, interval = "prediction") + expect_true(is.matrix(pred)) + expect_equal(ncol(pred), 3) + expect_equal(colnames(pred), c("Prediction", "Lower PI", "Upper PI")) +}) + +test_that("predict.mrdrc with pava for decreasing curve (coef[1] > 0)", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + # ryegrass LL.4 has positive b parameter (decreasing) + expect_true(coef(mr$object1)[1] > 0) + pred <- predict(mr, pava = TRUE) + expect_true(is.numeric(pred)) + expect_length(pred, length(mr$fitted)) +}) + +test_that("predict.mrdrc with pava for increasing curve (coef[1] < 0)", { + suppressWarnings({ + mr_b <- drc:::mrdrm(m1_binom, m2_binom) + }) + # LL.2 on deguelin has negative b parameter (increasing) + expect_true(coef(mr_b$object1)[1] < 0) + pred <- predict(mr_b, pava = TRUE) + expect_true(is.numeric(pred)) +}) + +test_that("predict.mrdrc with se.fit for binomial", { + suppressWarnings({ + mr_b <- drc:::mrdrm(m1_binom, m2_binom) + }) + pred <- predict(mr_b, se.fit = TRUE) + expect_true(is.matrix(pred)) + expect_equal(ncol(pred), 2) +}) + +test_that("predict.mrdrc with confidence interval for binomial", { + suppressWarnings({ + mr_b <- drc:::mrdrm(m1_binom, m2_binom) + }) + pred <- predict(mr_b, interval = "confidence") + expect_true(is.matrix(pred)) + expect_equal(ncol(pred), 3) +}) + +test_that("predict.mrdrc with newdata and se.fit", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + newdf <- data.frame(conc = c(0, 1, 5, 10)) + pred <- predict(mr, newdata = newdf, se.fit = TRUE) + expect_true(is.matrix(pred)) + expect_equal(nrow(pred), 4) + expect_equal(ncol(pred), 2) +}) + +# ---- inverseRegBasic ---- + +test_that("inverseRegBasic returns 3-element vector with bisection method", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + result <- drc:::inverseRegBasic(mr, 50, 0.95, "approximate", "bisection", + 20, 100, NULL, NULL, "confidence", "response") + expect_length(result, 3) + expect_true(is.numeric(result[1])) +}) + +test_that("inverseRegBasic returns 3-element vector with grid method", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + result <- drc:::inverseRegBasic(mr, 50, 0.95, "approximate", "grid", + 20, 100, NULL, NULL, "confidence", "response") + expect_length(result, 3) + expect_true(is.numeric(result[1])) +}) + +test_that("inverseRegBasic with interval = none", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + result <- drc:::inverseRegBasic(mr, 50, 0.95, "none", "bisection", + 20, 100, NULL, NULL, "confidence", "response") + expect_length(result, 3) + # With "none" interval, min1l and min1u are NA + expect_true(is.na(result[2])) + expect_true(is.na(result[3])) +}) + +test_that("inverseRegBasic warns when ED cannot be estimated", { + suppressWarnings({ + mr_b <- drc:::mrdrm(m1_binom, m2_binom) + }) + # For binomial with increasing curve (coef[1] < 0): val = perc/100 + # Use perc = 1 so val = 0.01, which is below min(predict(mr_b)) ≈ 0.29 + expect_warning( + result <- drc:::inverseRegBasic(mr_b, 1, 0.95, "none", "bisection", + 20, 100, NULL, NULL, "confidence", "response"), + "cannot be estimated" + ) + expect_equal(result, rep(NA, 3)) +}) + +test_that("inverseRegBasic with lower and upper specified", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + result <- drc:::inverseRegBasic(mr, 50, 0.95, "none", "bisection", + 20, 100, 0, 8, "confidence", "response") + expect_length(result, 3) + expect_true(is.numeric(result[1])) +}) + +test_that("inverseRegBasic with minmax = dose", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + result <- drc:::inverseRegBasic(mr, 50, 0.95, "none", "bisection", + 20, 100, NULL, NULL, "confidence", "dose") + expect_length(result, 3) +}) + +test_that("inverseRegBasic with prediction interval type", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + result <- drc:::inverseRegBasic(mr, 50, 0.95, "approximate", "bisection", + 20, 100, NULL, NULL, "prediction", "response") + expect_length(result, 3) +}) + +test_that("inverseRegBasic warns when bisection fails for CI limits", { + suppressWarnings({ + mr_b <- drc:::mrdrm(m1_binom, m2_binom) + }) + suppressWarnings({ + result <- drc:::inverseRegBasic(mr_b, 35, 0.95, "approximate", "bisection", + 20, 100, NULL, NULL, "confidence", "response") + }) + expect_length(result, 3) +}) + +test_that("inverseRegBasic warns when bisection fails for main estimate (column 1)", { + # Create data where bisection fails for the main estimate with small cgridsize + dose_vals <- c(rep(0, 3), rep(0.5, 3), rep(1, 3), rep(5, 3), rep(10, 3), rep(30, 3)) + resp_vals <- c(8, 8.2, 7.8, 7.5, 7.8, 7.2, 7.0, 6.8, 7.2, 3.5, 3.0, 4.0, 1.0, 0.8, 1.2, 0.3, 0.2, 0.4) + m1_t <- drm(resp_vals ~ dose_vals, fct = LL.4()) + m2_t <- loess(resp_vals ~ dose_vals, degree = 1) + mr_t <- drc:::mrdrm(m1_t, m2_t, lambda = 0.9) + expect_warning( + result <- drc:::inverseRegBasic(mr_t, 75, 0.95, "approximate", "bisection", + 3, 100, NULL, NULL, "confidence", "response"), + "cannot be estimated" + ) + # retVec[1] is NA -> triggers return(rep(NA, 3)) + expect_equal(result, rep(NA, 3)) +}) + +test_that("inverseRegBasic adjusts CI boundaries (truncation and unbounding)", { + # Use data with small dose start so lower CI ≈ minx triggers truncation to 0 + dose_vals <- c(0.001, 0.5, 1, 2, 5, 10, 20, 30) + resp_vals <- c(8, 7.8, 7.5, 7.0, 3.5, 1.0, 0.3, 0.2) + m1_t <- drm(resp_vals ~ dose_vals, fct = LL.4()) + m2_t <- loess(resp_vals ~ dose_vals, degree = 1) + mr_t <- drc:::mrdrm(m1_t, m2_t) + + # ED0.5 with grid: lower CI ≈ minx -> truncated to 0 + suppressWarnings({ + result_low <- drc:::inverseRegBasic(mr_t, 0.5, 0.95, "approximate", "grid", + 100, 1000, NULL, NULL, "confidence", "response") + }) + expect_equal(result_low[2], 0) + + # ED99 with grid: upper CI ≈ maxx -> set to Inf + suppressWarnings({ + result_high <- drc:::inverseRegBasic(mr_t, 99, 0.95, "approximate", "grid", + 100, 1000, NULL, NULL, "confidence", "response") + }) + expect_equal(result_high[3], Inf) +}) + +test_that("inverseRegBasic for binomial data", { + suppressWarnings({ + mr_b <- drc:::mrdrm(m1_binom, m2_binom) + }) + result <- drc:::inverseRegBasic(mr_b, 50, 0.95, "none", "bisection", + 20, 100, NULL, NULL, "confidence", "response") + expect_length(result, 3) + expect_true(is.numeric(result[1])) +}) + +test_that("inverseRegBasic with decreasing curve swaps percentage", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + # coef[1] > 0 means decreasing, so newPerc = 100 - perc + expect_true(coef(mr$object1)[1] > 0) + result <- drc:::inverseRegBasic(mr, 50, 0.95, "none", "bisection", + 20, 100, NULL, NULL, "confidence", "response") + expect_length(result, 3) +}) + +# ---- inverseReg ---- + +test_that("inverseReg is vectorized over perc", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + result <- drc:::inverseReg(mr, c(10, 50), 0.95, "none", "bisection", + 20, 100, NULL, NULL, "confidence", "response") + expect_true(is.matrix(result)) + expect_equal(ncol(result), 2) + expect_equal(nrow(result), 3) +}) + +# ---- EDprint ---- + +test_that("EDprint displays output when display = TRUE", { + EDmat <- matrix(c(3, 2, 4), nrow = 1) + rownames(EDmat) <- "50" + colnames(EDmat) <- c("Estimate", "Lower", "Upper") + expect_output( + drc:::EDprint(EDmat, "approximate", "Approximate variance formula", TRUE), + "Estimated effective doses" + ) +}) + +test_that("EDprint shows CI text when ci is not 'none'", { + EDmat <- matrix(c(3, 2, 4), nrow = 1) + rownames(EDmat) <- "50" + colnames(EDmat) <- c("Estimate", "Lower", "Upper") + expect_output( + drc:::EDprint(EDmat, "approximate", "Approximate variance formula", TRUE), + "confidence interval" + ) +}) + +test_that("EDprint does not show CI text when ci = 'none'", { + EDmat <- matrix(3, nrow = 1) + rownames(EDmat) <- "50" + colnames(EDmat) <- "Estimate" + output <- capture.output(drc:::EDprint(EDmat, "none", "", TRUE)) + expect_false(any(grepl("confidence interval", output))) +}) + +test_that("EDprint returns invisible EDmat when display = FALSE", { + EDmat <- matrix(3, nrow = 1) + rownames(EDmat) <- "50" + colnames(EDmat) <- "Estimate" + result <- drc:::EDprint(EDmat, "none", "", FALSE) + expect_equal(result, EDmat) +}) + +# ---- ED.mrdrc ---- + +test_that("ED.mrdrc returns estimate for continuous data", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + ed <- ED(mr, 50, display = FALSE) + expect_true(is.matrix(ed)) + expect_equal(nrow(ed), 1) + expect_equal(colnames(ed), "Estimate") + expect_true(ed[1, 1] > 0) +}) + +test_that("ED.mrdrc returns multiple ED values", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + ed <- ED(mr, c(10, 50, 90), display = FALSE) + expect_equal(nrow(ed), 3) + expect_equal(rownames(ed), c("10", "50", "90")) +}) + +test_that("ED.mrdrc with approximate interval", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + ed <- ED(mr, 50, interval = "approximate", display = FALSE) + expect_equal(ncol(ed), 3) + expect_equal(colnames(ed), c("Estimate", "Lower", "Upper")) +}) + +test_that("ED.mrdrc with grid method", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + ed <- ED(mr, 50, interval = "approximate", method = "grid", display = FALSE) + expect_equal(ncol(ed), 3) + expect_true(ed[1, 1] > 0) +}) + +test_that("ED.mrdrc with bootstrap interval", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + ed <- ED(mr, 50, interval = "bootstrap", n = 5, display = FALSE) + expect_equal(ncol(ed), 3) + expect_equal(colnames(ed), c("Estimate", "Lower", "Upper")) +}) + +test_that("ED.mrdrc with display = TRUE and no interval", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + expect_output(ED(mr, 50, display = TRUE), "Estimated effective doses") +}) + +test_that("ED.mrdrc with display = TRUE and approximate interval", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + expect_output( + ED(mr, 50, interval = "approximate", display = TRUE), + "confidence interval" + ) +}) + +test_that("ED.mrdrc with lower and upper specified", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + ed <- ED(mr, 50, display = FALSE, lower = 0, upper = 8) + expect_true(is.matrix(ed)) +}) + +test_that("ED.mrdrc with intType = prediction", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + ed <- ED(mr, 50, interval = "approximate", intType = "prediction", display = FALSE) + expect_equal(ncol(ed), 3) +}) + +test_that("ED.mrdrc with minmax = dose", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + ed <- ED(mr, 50, display = FALSE, minmax = "dose") + expect_true(is.matrix(ed)) +}) + +test_that("ED.mrdrc for binomial data", { + suppressWarnings({ + mr_b <- drc:::mrdrm(m1_binom, m2_binom) + }) + ed <- ED(mr_b, 50, display = FALSE) + expect_true(is.matrix(ed)) + expect_true(ed[1, 1] > 0) +}) + +# ---- EDboot ---- + +test_that("EDboot returns CI matrix for single ED value (continuous)", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + result <- drc:::EDboot(5, mr, 50, 123, 0.95) + expect_true(is.matrix(result)) + expect_equal(nrow(result), 1) + expect_equal(ncol(result), 2) +}) + +test_that("EDboot returns CI matrix for multiple ED values (continuous)", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + result <- drc:::EDboot(5, mr, c(10, 50), 123, 0.95) + expect_true(is.matrix(result)) + expect_equal(nrow(result), 2) + expect_equal(ncol(result), 2) +}) + +test_that("EDboot works for binomial data", { + suppressWarnings({ + mr_b <- drc:::mrdrm(m1_binom, m2_binom) + }) + suppressWarnings({ + result <- drc:::EDboot(5, mr_b, 50, 123, 0.95) + }) + expect_true(is.matrix(result)) + expect_equal(nrow(result), 1) +}) + +test_that("EDboot handles bootstrap iterations that fail (try-error path)", { + # Use high-noise continuous data where some bootstrap samples cause fitting failures + set.seed(42) + dose_vals <- c(rep(0, 5), rep(1, 5), rep(5, 5), rep(10, 5), rep(30, 5)) + resp_vals <- c(10 + rnorm(5, 0, 3), 8 + rnorm(5, 0, 3), 5 + rnorm(5, 0, 3), + 2 + rnorm(5, 0, 3), 0.5 + rnorm(5, 0, 3)) + m1_noisy <- drm(resp_vals ~ dose_vals, fct = LL.4()) + m2_noisy <- loess(resp_vals ~ dose_vals, degree = 1) + mr_noisy <- drc:::mrdrm(m1_noisy, m2_noisy) + # With large residual variance, some bootstrap samples will be degenerate + # The try() wrapper should catch these errors and return NAs + suppressWarnings({ + result <- drc:::EDboot(20, mr_noisy, 50, 12345, 0.95) + }) + expect_true(is.matrix(result)) + expect_equal(nrow(result), 1) + expect_equal(ncol(result), 2) +}) + +test_that("ED.mrdrc bootstrap for multiple ED values", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + ed <- ED(mr, c(10, 50), interval = "bootstrap", n = 5, display = FALSE) + expect_equal(nrow(ed), 2) + expect_equal(ncol(ed), 3) + expect_equal(colnames(ed), c("Estimate", "Lower", "Upper")) +}) + +test_that("ED.mrdrc bootstrap with display = TRUE", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + expect_output( + ED(mr, 50, interval = "bootstrap", n = 5, display = TRUE), + "Bootstrap" + ) +}) + +# ---- plot.mrdrc ---- + +test_that("plot.mrdrc works for continuous data", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + pdf(nullfile()) + on.exit(dev.off()) + expect_no_error(plot(mr)) +}) + +test_that("plot.mrdrc works with pava = TRUE", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + pdf(nullfile()) + on.exit(dev.off()) + expect_no_error(plot(mr, pava = TRUE)) +}) + +# ---- print.mrdrc ---- + +test_that("print.mrdrc displays output for continuous data with mixing", { + mr <- drc:::mrdrm(m1_cont, m2_cont, lambda = 0.5) + expect_output(print(mr), "model-robust dose-response fit") + expect_output(print(mr), "Mixing coefficient:") + expect_output(print(mr), "Residual sum of squares:") + expect_output(print(mr), "Residual standard error:") + expect_output(print(mr), "AIC:") + expect_output(print(mr), "for purely parametric fit:") +}) + +test_that("print.mrdrc displays output for continuous data without mixing", { + mr <- drc:::mrdrm(m1_cont, m2_cont, lambda = 0) + output <- capture.output(print(mr)) + combined <- paste(output, collapse = "\n") + expect_true(grepl("Mixing coefficient: 0", combined)) + # When lambda = 0, no "for purely parametric fit" lines + expect_false(grepl("for purely parametric fit", combined)) +}) + +test_that("print.mrdrc displays output for binomial data with mixing", { + suppressWarnings({ + mr_b <- drc:::mrdrm(m1_binom, m2_binom) + }) + expect_true(mr_b$lambda > 0) + expect_output(print(mr_b), "Pearson's chi-square:") + expect_output(print(mr_b), "for purely parametric fit:") + expect_output(print(mr_b), "AIC:") +}) + +test_that("print.mrdrc displays output for binomial data without mixing", { + suppressWarnings({ + mr_b0 <- drc:::mrdrm(m1_binom, m2_binom, lambda = 0) + }) + output <- capture.output(print(mr_b0)) + combined <- paste(output, collapse = "\n") + expect_true(grepl("Pearson's chi-square:", combined)) + expect_false(grepl("for purely parametric fit", combined)) +}) + +test_that("print.mrdrc returns the object invisibly", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + result <- capture.output(ret <- print(mr)) + expect_equal(ret, mr) +}) + +# ---- Grid search in inverseRegBasic ---- + +test_that("inverseRegBasic grid method with approximate interval", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + result <- drc:::inverseRegBasic(mr, 50, 0.95, "approximate", "grid", + 20, 100, NULL, NULL, "confidence", "response") + expect_length(result, 3) + expect_true(!is.na(result[1])) +}) + +test_that("inverseRegBasic grid method with none interval", { + mr <- drc:::mrdrm(m1_cont, m2_cont) + result <- drc:::inverseRegBasic(mr, 50, 0.95, "none", "grid", + 20, 100, NULL, NULL, "confidence", "response") + expect_length(result, 3) + # With "none", min1l and min1u are NA, so grid returns NA for limits + expect_true(is.na(result[2])) + expect_true(is.na(result[3])) +}) diff --git a/tests/testthat/test-mselect.R b/tests/testthat/test-mselect.R new file mode 100644 index 00000000..bc2b0634 --- /dev/null +++ b/tests/testthat/test-mselect.R @@ -0,0 +1,264 @@ +# Test mselect() function + +# Create test dataset (ryegrass) +ryegrass <- data.frame( + rootl = c( + 7.58, 8.00, 8.33, 7.25, 7.17, 7.00, 7.17, 7.83, 7.92, 7.58, + 6.17, 5.75, 5.83, 6.00, 5.83, 4.92, 4.50, 4.17, 4.42, 4.00, + 2.67, 2.08, 2.42, 2.50, 2.25, 1.17, 0.75, 0.92, 1.00, 0.58 + ), + conc = c( + rep(0, 5), rep(0.94, 5), rep(1.88, 5), + rep(3.75, 5), rep(7.50, 5), rep(15, 5) + ) +) + +test_that("mselect returns non-zero Lack of fit p-values when nested = FALSE", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + fctList <- list(LL.3(), W1.4(), W2.4()) + + result <- mselect(m1, fctList = fctList, nested = FALSE) + + # "Lack of fit" column should contain meaningful p-values, not all zeros + lof_col <- result[, "Lack of fit"] + expect_true(any(lof_col > 0, na.rm = TRUE), + info = "Lack of fit p-values should not all be zero when nested = FALSE") +}) + +test_that("mselect Lack of fit values match between nested = TRUE and nested = FALSE", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + fctList <- list(LL.3(), W1.4(), W2.4()) + + result_nested <- mselect(m1, fctList = fctList, nested = TRUE) + result_plain <- mselect(m1, fctList = fctList, nested = FALSE) + + # The "Lack of fit" column should have the same values regardless of 'nested' + expect_equal( + result_nested[, "Lack of fit"], + result_plain[, "Lack of fit"], + info = "Lack of fit p-values should be the same whether nested is TRUE or FALSE" + ) +}) + +test_that("mselect with nested = TRUE does not produce NaN in Nested F test column", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + fctList <- list(LL.3(), W1.4(), W2.4()) + + # Suppress benign warnings from the optimization process (log of negative values + # during parameter search), which are unrelated to the F-test computation + result <- suppressWarnings(mselect(m1, fctList = fctList, nested = TRUE)) + + # The "Nested F test" column should have valid p-values (or NA for first model), + # but never NaN + ftest_col <- result[, "Nested F test"] + expect_true(all(is.na(ftest_col) | is.finite(ftest_col)), + info = "Nested F test column should not contain NaN values") +}) + +test_that("anova.drc returns p-value of 1 when F statistic is negative", { + # Comparing non-nested models with same df can produce negative F statistics + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + m2 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) + + # Should not produce NaN warnings from pf() and p-value should be valid + result <- anova(m1, m2, details = FALSE) + pval <- result[2, 5] + fstat <- result[2, 4] + expect_true(!is.nan(pval), info = "p-value should not be NaN") + # If the F statistic was negative, p-value should be 1 + if (!is.na(fstat) && fstat < 0) { + expect_equal(pval, 1, info = "Negative F statistic should give p-value of 1") + } + # If the F statistic is a valid positive number, p-value should be between 0 and 1 + if (!is.na(fstat) && is.finite(fstat) && fstat >= 0) { + expect_true(pval >= 0 && pval <= 1, + info = "Positive F statistic should give p-value between 0 and 1") + } +}) + +test_that("anova.drc returns valid p-values for truly nested models", { + # LL.3 is nested within LL.4 (LL.3 fixes one parameter) + m_full <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + m_reduced <- drm(rootl ~ conc, data = ryegrass, fct = LL.3()) + + result <- anova(m_reduced, m_full, details = FALSE) + pval <- result[2, 5] + fstat <- result[2, 4] + + # For truly nested models, F statistic should be non-negative and p-value valid + expect_true(!is.na(pval), info = "p-value should not be NA for nested models") + expect_true(!is.nan(pval), info = "p-value should not be NaN for nested models") + expect_true(pval >= 0 && pval <= 1, + info = "p-value should be between 0 and 1 for nested models") +}) + +test_that("mselect with nested = FALSE returns correct column names", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + fctList <- list(LL.3()) + + result <- mselect(m1, fctList = fctList, nested = FALSE) + expect_true("Lack of fit" %in% colnames(result)) + expect_true("logLik" %in% colnames(result)) + expect_true("IC" %in% colnames(result)) + expect_true("Res var" %in% colnames(result)) + expect_false("Nested F test" %in% colnames(result)) +}) + +test_that("mselect with nested = TRUE returns Nested F test column", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + fctList <- list(LL.3()) + + result <- mselect(m1, fctList = fctList, nested = TRUE) + expect_true("Nested F test" %in% colnames(result)) +}) + +test_that("mselect Res var column contains numeric values, not try-error objects", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + fctList <- list(LL.3(), W1.4()) + + result <- mselect(m1, fctList = fctList, nested = FALSE) + + # The "Res var" column should contain numeric values, never try-error objects + # This tests the fix for inherits("tryRV", "try-error") bug where the string + # literal was checked instead of the variable + resvar_col <- result[, "Res var"] + expect_true(is.numeric(resvar_col), + info = "Res var column should be numeric") + expect_true(all(resvar_col > 0, na.rm = TRUE), + info = "Res var values should be positive for continuous data") +}) + +test_that("modelFit does not produce NaN p-values", { + # Test that modelFit returns valid p-values even in edge cases + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + result <- modelFit(m1) + pval <- result[2, 5] + + # p-value should not be NaN + expect_true(!is.nan(pval), + info = "modelFit p-value should not be NaN") + # p-value should be between 0 and 1 (or NA) + if (!is.na(pval)) { + expect_true(pval >= 0 && pval <= 1, + info = "modelFit p-value should be between 0 and 1") + } +}) + +# --- Tests for uncovered code paths --- + +test_that("mselect errors when nested is not logical", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + expect_error( + mselect(m1, nested = "yes"), + "'nested' argument takes only the values: FALSE, TRUE" + ) + expect_error( + mselect(m1, nested = 1), + "'nested' argument takes only the values: FALSE, TRUE" + ) +}) + +test_that("mselect with linreg = TRUE includes polynomial fits", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + result <- mselect(m1, fctList = list(LL.3()), linreg = TRUE) + + # Should have rows for Lin, Quad, Cubic in addition to DRC models + expect_true("Lin" %in% rownames(result)) + expect_true("Quad" %in% rownames(result)) + expect_true("Cubic" %in% rownames(result)) + + # Result should be a matrix with correct columns + expect_true(is.matrix(result)) + expect_true("logLik" %in% colnames(result)) + expect_true("IC" %in% colnames(result)) + expect_true("Lack of fit" %in% colnames(result)) + expect_true("Res var" %in% colnames(result)) + + # Polynomial fit rows should have NA for "Lack of fit" + expect_true(is.na(result["Lin", "Lack of fit"])) + expect_true(is.na(result["Quad", "Lack of fit"])) + expect_true(is.na(result["Cubic", "Lack of fit"])) + + # logLik, IC, and Res var should be numeric for polynomial fits + expect_true(is.finite(result["Lin", "logLik"])) + expect_true(is.finite(result["Quad", "IC"])) + expect_true(is.finite(result["Cubic", "Res var"])) +}) + +test_that("mselect with linreg = TRUE and nested = TRUE drops Nested F test column", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + result <- mselect(m1, fctList = list(LL.3()), linreg = TRUE, nested = TRUE) + + # When linreg = TRUE, the Nested F test column should be removed + expect_false("Nested F test" %in% colnames(result)) + # Should still have the first 4 columns + expect_equal(ncol(result), 4) + expect_equal(colnames(result), c("logLik", "IC", "Lack of fit", "Res var")) +}) + +test_that("mselect handles model fitting failure gracefully (line 109)", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Create a dose-response function whose starting values always error, + # guaranteeing update() returns a try-error + bad_fct <- LL.3() + bad_fct$name <- "BadModel" + bad_fct$ssfct <- function(...) stop("Cannot compute starting values") + + result <- suppressWarnings( + mselect(m1, fctList = list(bad_fct), nested = FALSE) + ) + + expect_true(is.matrix(result)) + # The first model (LL.4) should always have valid values + expect_true(is.finite(result["LL.4", "logLik"])) + # The bad model should have all NA values + expect_true(all(is.na(result["BadModel", ]))) +}) + +test_that("mselect handles summary failure for initial model resVar (line 71)", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Corrupt the initial model so summary.drc fails on it: + # Setting robust to "Tukey's biweight" triggers a code path in summary.drc + # that calls solve(hessian); a zero hessian causes solve() to error + m1$robust <- "Tukey's biweight" + m1$fit$hessian <- matrix(0, 4, 4) + + result <- mselect(m1, nested = FALSE, sorted = "no") + + expect_true(is.matrix(result)) + # The initial model's Res var should be NA because summary failed + expect_true(is.na(result[1, "Res var"])) +}) + +test_that("mselect handles summary failure for updated model resVar (line 100)", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Capture the original summary.drc before mocking + orig_summary_drc <- drc:::summary.drc + call_count <- 0L + + # Use with_mocked_bindings to make summary.drc fail only on the second call + # (first call processes the initial model, second processes the updated model) + result <- with_mocked_bindings( + mselect(m1, fctList = list(LL.3()), nested = FALSE, sorted = "no"), + summary.drc = function(object, ...) { + call_count <<- call_count + 1L + if (call_count > 1L) { + stop("Simulated summary failure for updated model") + } + orig_summary_drc(object, ...) + }, + .package = "drc" + ) + + expect_true(is.matrix(result)) + # The initial model's Res var should be valid (first summary call succeeds) + expect_true(is.finite(result["LL.4", "Res var"])) + # The updated model's Res var should be NA (second summary call fails) + expect_true(is.na(result["LL.3", "Res var"])) +}) diff --git a/tests/testthat/test-multi2.R b/tests/testthat/test-multi2.R new file mode 100644 index 00000000..0e695e39 --- /dev/null +++ b/tests/testthat/test-multi2.R @@ -0,0 +1,328 @@ +# tests/testthat/test-multi2.R +# Comprehensive tests for R/multi2.R: multi2() and all nested functions +# (fct, fd, dFct, deriv1, derivx, edfct, ssfct) + +# ======================================================================== +# Test: multi2() argument validation +# ======================================================================== + +test_that("multi2() errors on invalid 'names' argument", { + expect_error(multi2(names = c("a", "b")), "Not correct 'names' argument") + expect_error(multi2(names = 123), "Not correct 'names' argument") + expect_error(multi2(names = c("a", "b", "c", "d")), "Not correct 'names' argument") +}) + +test_that("multi2() errors on invalid 'fixed' argument", { + expect_error(multi2(fixed = c(NA, NA)), "Not correct 'fixed' argument") + expect_error(multi2(fixed = c(NA, NA, NA)), "Not correct 'fixed' argument") + expect_error(multi2(fixed = c(NA, NA, NA, NA, NA, NA)), "Not correct 'fixed' argument") +}) + +# ======================================================================== +# Test: multi2() return structure +# ======================================================================== + +test_that("multi2() returns object of class 'multistage'", { + result <- multi2() + expect_s3_class(result, "multistage") +}) + +test_that("multi2() return list has correct structure", { + result <- multi2() + expect_true(is.function(result$fct)) + expect_true(is.function(result$ssfct)) + expect_true(is.function(result$deriv1)) + expect_null(result$deriv2) + expect_true(is.function(result$derivx)) + expect_true(is.function(result$edfct)) + expect_equal(result$noParm, 5) + expect_equal(result$names, c("b1", "b2", "b3", "c", "d")) +}) + +test_that("multi2() default name and text are correct", { + result <- multi2() + expect_equal(result$name, "multi2") + expect_equal(result$text, "Multistage") +}) + +test_that("multi2() custom fctName and fctText override defaults", { + result <- multi2(fctName = "myModel", fctText = "my description") + expect_equal(result$name, "myModel") + expect_equal(result$text, "my description") +}) + +test_that("multi2() custom names are applied", { + result <- multi2(names = c("p1", "p2", "p3", "p4", "p5")) + expect_equal(result$names, c("p1", "p2", "p3", "p4", "p5")) +}) + +# ======================================================================== +# Test: multi2() with fixed parameters +# ======================================================================== + +test_that("multi2() with some fixed parameters updates noParm and names", { + result <- multi2(fixed = c(0, NA, NA, NA, NA)) + expect_equal(result$noParm, 4) + expect_equal(result$names, c("b2", "b3", "c", "d")) + + result2 <- multi2(fixed = c(0, NA, 0, NA, 1)) + expect_equal(result2$noParm, 2) + expect_equal(result2$names, c("b2", "c")) +}) + +# ======================================================================== +# Test: fct (mean function) calculations +# ======================================================================== + +test_that("multi2 fct computes correct model values", { + m <- multi2() + # f(x) = c + (d-c)*(1 - exp(-b1 - b2*x - b3*x^2)) + # With b1=0, b2=1, b3=0, c=0, d=100: + # f(0) = 0 + 100*(1 - exp(0 - 0 - 0)) = 100*(1-1) = 0 + # f(1) = 0 + 100*(1 - exp(0 - 1 - 0)) = 100*(1 - exp(-1)) ≈ 63.21 + dose <- c(0, 1, 2) + parm <- matrix(c(0, 1, 0, 0, 100), nrow = 1) + result <- m$fct(dose, parm) + expected <- 0 + (100 - 0) * (1 - exp(-0 - 1 * dose - 0 * dose^2)) + expect_equal(as.numeric(result), expected, tolerance = 1e-10) +}) + +test_that("multi2 fct works with multiple observations (rows)", { + m <- multi2() + dose <- c(0, 1, 2, 3) + parm <- matrix(c(0, 1, 0, 0, 100), nrow = 4, ncol = 5, byrow = TRUE) + result <- m$fct(dose, parm) + expected <- 0 + 100 * (1 - exp(-0 - 1 * dose - 0 * dose^2)) + expect_equal(as.numeric(result), expected, tolerance = 1e-10) +}) + +test_that("multi2 fct handles fixed parameters correctly", { + # Fix b1=0 and b3=0 + m <- multi2(fixed = c(0, NA, 0, NA, NA)) + dose <- c(0, 1, 2) + # Only free parameters: b2, c, d + parm <- matrix(c(1, 0, 100), nrow = 1) + result <- m$fct(dose, parm) + expected <- 0 + 100 * (1 - exp(-0 - 1 * dose - 0 * dose^2)) + expect_equal(as.numeric(result), expected, tolerance = 1e-10) +}) + +test_that("multi2 fct with quadratic term produces correct results", { + m <- multi2() + dose <- c(0, 0.5, 1, 2) + # b1=0.1, b2=0.5, b3=0.2, c=10, d=90 + parm <- matrix(c(0.1, 0.5, 0.2, 10, 90), nrow = 1) + result <- m$fct(dose, parm) + expected <- 10 + (90 - 10) * (1 - exp(-0.1 - 0.5 * dose - 0.2 * dose^2)) + expect_equal(as.numeric(result), expected, tolerance = 1e-10) +}) + +# ======================================================================== +# Test: deriv1 (parameter derivatives) +# ======================================================================== + +test_that("multi2 deriv1 returns gradient matrix with correct dimensions", { + m <- multi2() + dose <- c(0, 1, 2) + parm <- matrix(c(0, 1, 0, 0, 100), nrow = 1) + grad <- m$deriv1(dose, parm) + # Should have nrow = length(dose), ncol = 5 (all free parameters) + expect_equal(nrow(grad), length(dose)) + expect_equal(ncol(grad), 5) +}) + +test_that("multi2 deriv1 with fixed parameters returns reduced gradient", { + m <- multi2(fixed = c(0, NA, 0, NA, NA)) + dose <- c(0, 1, 2) + # free: b2, c, d + parm <- matrix(c(1, 0, 100), nrow = 1) + grad <- m$deriv1(dose, parm) + expect_equal(nrow(grad), length(dose)) + expect_equal(ncol(grad), 3) +}) + +test_that("multi2 deriv1 computes correct gradient values (numerical check)", { + m <- multi2() + dose <- c(1) + b1 <- 0; b2 <- 1; b3 <- 0.5; cc <- 0; dd <- 100 + parm <- matrix(c(b1, b2, b3, cc, dd), nrow = 1) + grad <- m$deriv1(dose, parm) + + # Numerical derivatives via finite differences + eps <- 1e-7 + params <- c(b1, b2, b3, cc, dd) + numgrad <- numeric(5) + for (i in 1:5) { + params_up <- params + params_up[i] <- params_up[i] + eps + f_up <- cc + (dd - cc) * (1 - exp(-params_up[1] - params_up[2] * dose - params_up[3] * dose^2)) + # Parameters c (index 4) and d (index 5) appear outside the exponential term + # in the model f(x) = c + (d-c)*(1 - exp(...)), so perturbing them requires + # recomputing the full expression with the perturbed value in both places. + if (i == 4) { + f_up <- params_up[4] + (dd - params_up[4]) * (1 - exp(-b1 - b2 * dose - b3 * dose^2)) + } + if (i == 5) { + f_up <- cc + (params_up[5] - cc) * (1 - exp(-b1 - b2 * dose - b3 * dose^2)) + } + f_base <- cc + (dd - cc) * (1 - exp(-b1 - b2 * dose - b3 * dose^2)) + numgrad[i] <- (f_up - f_base) / eps + } + expect_equal(as.numeric(grad), numgrad, tolerance = 1e-5) +}) + +# ======================================================================== +# Test: derivx (dose derivative) +# ======================================================================== + +test_that("multi2 derivx returns gradient matrix with correct dimensions", { + m <- multi2() + dose <- c(0, 1, 2) + parm <- matrix(c(0, 1, 0, 0, 100), nrow = 1) + dfdx <- m$derivx(dose, parm) + expect_equal(nrow(dfdx), length(dose)) + expect_equal(ncol(dfdx), 1) +}) + +test_that("multi2 derivx computes correct dose derivative (numerical check)", { + m <- multi2() + dose <- c(1) + b1 <- 0; b2 <- 1; b3 <- 0.5; cc <- 0; dd <- 100 + parm <- matrix(c(b1, b2, b3, cc, dd), nrow = 1) + dfdx <- m$derivx(dose, parm) + + # Numerical derivative w.r.t. dose + eps <- 1e-7 + f <- function(x) cc + (dd - cc) * (1 - exp(-b1 - b2 * x - b3 * x^2)) + numderiv <- (f(dose + eps) - f(dose)) / eps + expect_equal(as.numeric(dfdx), numderiv, tolerance = 1e-5) +}) + +test_that("multi2 derivx with fixed parameters", { + m <- multi2(fixed = c(0, NA, 0, NA, NA)) + dose <- c(1) + parm <- matrix(c(1, 0, 100), nrow = 1) + dfdx <- m$derivx(dose, parm) + expect_equal(nrow(dfdx), 1) + expect_equal(ncol(dfdx), 1) +}) + +# ======================================================================== +# Test: edfct (effective dose) +# ======================================================================== + +test_that("multi2 edfct returns list with ED value and derivatives", { + m <- multi2() + # b1=0, b2=1, b3=0.1, c=0, d=100 + parm <- c(0, 1, 0.1, 0, 100) + result <- m$edfct(parm, respl = 50, reference = "control", type = "relative") + expect_true(is.list(result)) + expect_equal(length(result), 2) + expect_true(is.numeric(result[[1]])) + expect_true(is.numeric(result[[2]])) +}) + +test_that("multi2 edfct with type='absolute'", { + m <- multi2() + # b1=0, b2=1, b3=0.1, c=0, d=100 + parm <- c(0, 1, 0.1, 0, 100) + result <- m$edfct(parm, respl = 50, reference = "control", type = "absolute") + expect_true(is.list(result)) + expect_true(is.numeric(result[[1]])) +}) + +test_that("multi2 edfct with type='relative' and negative b1 and reference='control'", { + m <- multi2() + # b1=-0.5 (negative), b2=1, b3=0.1, c=0, d=100 + parm <- c(-0.5, 1, 0.1, 0, 100) + result <- m$edfct(parm, respl = 50, reference = "control", type = "relative") + expect_true(is.list(result)) + expect_true(is.numeric(result[[1]])) +}) + +test_that("multi2 edfct with type='relative' and positive b1", { + m <- multi2() + # b1=0.5 (positive), b2=1, b3=0.1, c=0, d=100 + # This path does NOT trigger the `100 - p` reversal + parm <- c(0.5, 1, 0.1, 0, 100) + result <- m$edfct(parm, respl = 50, reference = "control", type = "relative") + expect_true(is.list(result)) + expect_true(is.numeric(result[[1]])) +}) + +test_that("multi2 edfct with type='relative' and reference != 'control'", { + m <- multi2() + parm <- c(-0.5, 1, 0.1, 0, 100) + # reference is NOT "control", so second reversal should not apply + result <- m$edfct(parm, respl = 50, reference = "upper", type = "relative") + expect_true(is.list(result)) + expect_true(is.numeric(result[[1]])) +}) + +test_that("multi2 edfct with fixed parameters", { + m <- multi2(fixed = c(0, NA, 0, NA, NA)) + # free params: b2, c, d + parm <- c(1, 0, 100) + result <- m$edfct(parm, respl = 50, reference = "control", type = "relative") + expect_true(is.list(result)) + expect_equal(length(result[[2]]), 3) # 3 free parameters +}) + +# ======================================================================== +# Test: ssfct (self-starter function) +# ======================================================================== + +test_that("multi2 default ssfct returns initial parameter estimates", { + m <- multi2() + # Create a simple dose-response data frame + dose <- c(0, 0.5, 1, 2, 5, 10, 20) + response <- c(0, 5, 15, 40, 70, 90, 98) + dframe <- data.frame(dose, response) + result <- m$ssfct(dframe) + expect_true(is.numeric(result)) + expect_equal(length(result), 5) # 5 free parameters +}) + +test_that("multi2 custom ssfct is used when provided", { + custom_ss <- function(dframe) { + rep(1, 5) + } + m <- multi2(ssfct = custom_ss) + dframe <- data.frame(dose = c(0, 1, 10), response = c(0, 50, 100)) + result <- m$ssfct(dframe) + expect_equal(result, rep(1, 5)) +}) + +test_that("multi2 default ssfct with fixed parameters returns correct length", { + m <- multi2(fixed = c(0, NA, 0, NA, NA)) + dose <- c(0, 0.5, 1, 2, 5, 10, 20) + response <- c(0, 5, 15, 40, 70, 90, 98) + dframe <- data.frame(dose, response) + result <- m$ssfct(dframe) + expect_true(is.numeric(result)) + expect_equal(length(result), 3) # 3 free parameters +}) + +# ======================================================================== +# Test: Model mathematical properties +# ======================================================================== + +test_that("multi2 model: at dose=0 with b1=0, response equals c (lower asymptote)", { + m <- multi2() + dose <- 0 + # b1=0, b2=1, b3=0.5, c=10, d=90 + parm <- matrix(c(0, 1, 0.5, 10, 90), nrow = 1) + result <- m$fct(dose, parm) + # f(0) = c + (d-c)*(1 - exp(-b1)) = 10 + 80*(1 - 1) = 10 + expect_equal(as.numeric(result), 10, tolerance = 1e-10) +}) + +test_that("multi2 model: at large dose, response approaches d (upper asymptote)", { + m <- multi2() + dose <- 1000 + # b1=0, b2=1, b3=0.5, c=10, d=90 + parm <- matrix(c(0, 1, 0.5, 10, 90), nrow = 1) + result <- m$fct(dose, parm) + # At large dose, exp(-b1-b2*x-b3*x^2) → 0, so f → c + (d-c)*1 = d = 90 + expect_equal(as.numeric(result), 90, tolerance = 1e-10) +}) diff --git a/tests/testthat/test-nec.R b/tests/testthat/test-nec.R new file mode 100644 index 00000000..e804b8fd --- /dev/null +++ b/tests/testthat/test-nec.R @@ -0,0 +1,295 @@ +# ============================================================================ +# Tests for NEC (No Effect Concentration) dose-response model functions +# Functions: NEC, NEC.2, NEC.3, NEC.4 from R/nec.R +# ============================================================================ + +# --- NEC.4 (Full four-parameter model) --- + +test_that("NEC.4() returns object of class 'NEC'", { + result <- NEC.4() + expect_s3_class(result, "NEC") +}) + +test_that("NEC.4() returns correct list structure", { + result <- NEC.4() + expected_names <- c("fct", "ssfct", "names", "deriv1", "deriv2", + "derivx", "edfct", "name", "text", "noParm") + expect_named(result, expected_names) + expect_true(is.function(result$fct)) + expect_true(is.function(result$ssfct)) + expect_equal(result$names, c("b", "c", "d", "e")) + expect_null(result$deriv1) + expect_null(result$deriv2) + expect_null(result$derivx) + expect_null(result$edfct) + expect_equal(result$name, "NEC.4") + expect_equal(result$text, "NEC") + expect_equal(result$noParm, 4) +}) + +test_that("NEC.4() fct computes correct response below threshold", { + result <- NEC.4() + # b=1, c=0, d=100, e=5 -> dose <= 5 should give d=100 + parm <- matrix(c(1, 0, 100, 5), nrow = 1) + dose <- c(0, 2, 5) + response <- result$fct(dose, parm) + expect_equal(response, c(100, 100, 100)) +}) + +test_that("NEC.4() fct computes correct response above threshold", { + result <- NEC.4() + # b=1, c=0, d=100, e=5 -> dose > 5: c + (d-c)*exp(-b*(dose-e)) + parm <- matrix(c(1, 0, 100, 5), nrow = 1) + dose <- c(7, 10) + response <- result$fct(dose, parm) + expected <- 0 + (100 - 0) * exp(-1 * (dose - 5)) + expect_equal(response, expected) +}) + +test_that("NEC.4() fct handles multiple rows in parm", { + result <- NEC.4() + # Two different parameter sets + parm <- matrix(c(1, 2, 0, 10, 100, 50, 5, 3), nrow = 2) + dose <- c(7, 1) # first above threshold, second below + response <- result$fct(dose, parm) + # Row 1: b=1, c=0, d=100, e=5 -> dose=7 > 5: 0 + 100*exp(-1*2) = 100*exp(-2) + # Row 2: b=2, c=10, d=50, e=3 -> dose=1 <= 3: response = d = 50 + expected <- c(100 * exp(-2), 50) + expect_equal(response, expected) +}) + +test_that("NEC.4() with fixed parameters works correctly", { + # Fix c=0 + result <- NEC.4(fixed = c(NA, 0, NA, NA)) + expect_equal(result$names, c("b", "d", "e")) + expect_equal(result$noParm, 3) + + # Test fct with 3 free parameters (b, d, e) + parm <- matrix(c(1, 100, 5), nrow = 1) + dose <- c(0, 7) + response <- result$fct(dose, parm) + # dose=0 <= 5: c + (d-c)*1 = 0 + 100 = 100 + # dose=7 > 5: 0 + 100*exp(-1*2) = 100*exp(-2) + expected <- c(100, 100 * exp(-2)) + expect_equal(response, expected) +}) + +test_that("NEC.4() with all parameters fixed works", { + result <- NEC.4(fixed = c(1, 0, 100, 5)) + expect_equal(result$names, character(0)) + expect_equal(result$noParm, 0) +}) + +test_that("NEC.4() with custom names works", { + result <- NEC.4(names = c("slope", "lower", "upper", "threshold")) + expect_equal(result$names, c("slope", "lower", "upper", "threshold")) +}) + +test_that("NEC.4() errors on invalid names", { + expect_error(NEC.4(names = c("a", "b")), "Not correct 'names' argument") + expect_error(NEC.4(names = 1:4), "Not correct 'names' argument") +}) + +test_that("NEC.4() errors on invalid fixed", { + expect_error(NEC.4(fixed = c(NA, NA)), "Not correct length of 'fixed' argument") + expect_error(NEC.4(fixed = c(NA, NA, NA, NA, NA)), "Not correct length of 'fixed' argument") +}) + + +# --- NEC.3 (Three-parameter, lower limit fixed at 0) --- + +test_that("NEC.3() returns object of class 'NEC'", { + result <- NEC.3() + expect_s3_class(result, "NEC") +}) + +test_that("NEC.3() returns correct structure", { + result <- NEC.3() + expect_equal(result$names, c("b", "d", "e")) + expect_equal(result$noParm, 3) + expect_equal(result$name, "NEC.3") + expect_match(result$text, "NEC") + expect_match(result$text, "lower limit at 0") +}) + +test_that("NEC.3() fct computes correctly with lower limit fixed at 0", { + result <- NEC.3() + # b=1, d=100, e=5 (c is fixed at 0) + parm <- matrix(c(1, 100, 5), nrow = 1) + dose <- c(0, 5, 7, 10) + response <- result$fct(dose, parm) + # dose <= 5: 0 + (100-0)*1 = 100 + # dose=7: 0 + 100*exp(-1*2) = 100*exp(-2) + # dose=10: 0 + 100*exp(-1*5) = 100*exp(-5) + expected <- c(100, 100, 100 * exp(-2), 100 * exp(-5)) + expect_equal(response, expected) +}) + +test_that("NEC.3() with fixed parameters works", { + result <- NEC.3(fixed = c(1, NA, NA)) + expect_equal(result$names, c("d", "e")) + expect_equal(result$noParm, 2) +}) + +test_that("NEC.3() errors on invalid names", { + expect_error(NEC.3(names = c("a", "b")), "Not correct 'names' argument") + expect_error(NEC.3(names = 1:3), "Not correct 'names' argument") +}) + +test_that("NEC.3() errors on invalid fixed length", { + expect_error(NEC.3(fixed = c(NA, NA)), "Not correct length of 'fixed' argument") + expect_error(NEC.3(fixed = c(NA, NA, NA, NA)), "Not correct length of 'fixed' argument") +}) + + +# --- NEC.2 (Two-parameter, lower=0, upper fixed) --- + +test_that("NEC.2() returns object of class 'NEC'", { + result <- NEC.2() + expect_s3_class(result, "NEC") +}) + +test_that("NEC.2() returns correct structure", { + result <- NEC.2() + expect_equal(result$names, c("b", "e")) + expect_equal(result$noParm, 2) + expect_equal(result$name, "NEC.2") + expect_match(result$text, "NEC") + expect_match(result$text, "lower limit at 0") + expect_match(result$text, "upper limit at 1") +}) + +test_that("NEC.2() fct computes correctly with defaults (upper=1)", { + result <- NEC.2() + # b=1, e=0.5 (c=0, d=1) + parm <- matrix(c(1, 0.5), nrow = 1) + dose <- c(0, 0.3, 0.5, 0.8, 1) + response <- result$fct(dose, parm) + # dose <= 0.5: 0 + (1-0)*1 = 1 + # dose=0.8: 0 + 1*exp(-1*0.3) = exp(-0.3) + # dose=1: 0 + 1*exp(-1*0.5) = exp(-0.5) + expected <- c(1, 1, 1, exp(-0.3), exp(-0.5)) + expect_equal(response, expected) +}) + +test_that("NEC.2() with custom upper limit works", { + result <- NEC.2(upper = 50) + parm <- matrix(c(1, 5), nrow = 1) + dose <- c(0, 7) + response <- result$fct(dose, parm) + # dose=0 <= 5: 0 + (50-0)*1 = 50 + # dose=7 > 5: 0 + 50*exp(-1*2) = 50*exp(-2) + expected <- c(50, 50 * exp(-2)) + expect_equal(response, expected) + expect_match(result$text, "upper limit at 50") +}) + +test_that("NEC.2() with fixed parameters works", { + result <- NEC.2(fixed = c(1, NA)) + expect_equal(result$names, c("e")) + expect_equal(result$noParm, 1) +}) + +test_that("NEC.2() errors on invalid names", { + expect_error(NEC.2(names = c("a")), "Not correct 'names' argument") + expect_error(NEC.2(names = 1:2), "Not correct 'names' argument") +}) + +test_that("NEC.2() errors on invalid fixed length", { + expect_error(NEC.2(fixed = c(NA)), "Not correct length of 'fixed' argument") + expect_error(NEC.2(fixed = c(NA, NA, NA)), "Not correct length of 'fixed' argument") +}) + + +# --- Base NEC function (called through NEC.4/NEC.3/NEC.2) --- + +test_that("NEC base function errors on invalid names", { + expect_error(NEC.4(names = c("a", "b", "c")), "Not correct 'names' argument") +}) + +test_that("NEC base function errors on invalid fixed length", { + expect_error(NEC.4(fixed = c(NA, NA, NA)), "Not correct length of 'fixed' argument") +}) + +test_that("NEC base function uses fctName when provided (via NEC.4)", { + result <- NEC.4() + expect_equal(result$name, "NEC.4") +}) + +test_that("NEC base function uses fctText when provided (via NEC.3)", { + result <- NEC.3() + expect_match(result$text, "NEC with lower limit at 0") +}) + +test_that("NEC base function errors on invalid names directly", { + necFn <- drc:::NEC + expect_error(necFn(names = c("a", "b")), "Not correct 'names' argument") + expect_error(necFn(names = 1:4), "Not correct 'names' argument") +}) + +test_that("NEC base function errors on invalid fixed directly", { + necFn <- drc:::NEC + expect_error(necFn(fixed = c(NA, NA)), "Not correct 'fixed' argument") +}) + +test_that("NEC base function defaults name/text when missing", { + # Call NEC directly (not through convenience functions) + # NEC is not exported, so assign to a local variable to get a clean match.call() + necFn <- drc:::NEC + result <- necFn() + expect_equal(result$name, "necFn") + expect_equal(result$text, "NEC") +}) + + +# --- ssfct (self-starter function) tests --- + +test_that("NEC.4() ssfct returns initial parameter estimates", { + result <- NEC.4() + + # Create a simple data frame mimicking dose-response data + # Need columns: dose, response (at minimum) + dose <- c(0, 0.1, 0.5, 1, 2, 5, 10, 20) + response <- c(100, 100, 98, 90, 60, 20, 5, 1) + dframe <- data.frame(dose = dose, response = response) + + initVals <- result$ssfct(dframe) + expect_type(initVals, "double") + expect_length(initVals, 4) # 4 free parameters + expect_true(all(is.finite(initVals))) +}) + +test_that("NEC.3() ssfct returns 3 initial values", { + result <- NEC.3() + dose <- c(0, 0.1, 0.5, 1, 2, 5, 10, 20) + response <- c(100, 100, 98, 90, 60, 20, 5, 1) + dframe <- data.frame(dose = dose, response = response) + + initVals <- result$ssfct(dframe) + expect_type(initVals, "double") + expect_length(initVals, 3) +}) + +test_that("NEC.2() ssfct returns 2 initial values", { + result <- NEC.2(upper = 100) + dose <- c(0, 0.1, 0.5, 1, 2, 5, 10, 20) + response <- c(100, 100, 98, 90, 60, 20, 5, 1) + dframe <- data.frame(dose = dose, response = response) + + initVals <- result$ssfct(dframe) + expect_type(initVals, "double") + expect_length(initVals, 2) +}) + + +# --- Integration test with drm --- + +test_that("NEC.4() works with drm() on ryegrass data", { + data(ryegrass, package = "drc") + model <- drm(rootl ~ conc, data = ryegrass, fct = NEC.4()) + expect_s3_class(model, "drc") + + coefs <- coef(model) + expect_length(coefs, 4) + expect_true(all(is.finite(coefs))) +}) diff --git a/tests/testthat/test-neill.test.R b/tests/testthat/test-neill.test.R new file mode 100644 index 00000000..b5940db2 --- /dev/null +++ b/tests/testthat/test-neill.test.R @@ -0,0 +1,155 @@ +# Test suite for neill.test() and neill.default() +# Achieves 100% code coverage for R/neill.test.R + +# ---- Setup: create model fixtures ---- +# ryegrass dataset: 24 obs, 7 unique dose levels, LL.4() has 4 parameters +ryegrass_m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + +# ---- Tests for neill.test() with explicit grouping ---- + +test_that("neill.test with explicit grouping and display=TRUE returns anova", { + result <- neill.test(ryegrass_m1, ryegrass$conc) + expect_s3_class(result, "anova") + expect_s3_class(result, "data.frame") + expect_named(result, c("F value", "p value")) + expect_equal(nrow(result), 1) + expect_true(result[["F value"]] >= 0) + expect_true(result[["p value"]] >= 0 && result[["p value"]] <= 1) + expect_true(grepl("Neill", attr(result, "heading"))) +}) + +test_that("neill.test with explicit grouping and display=FALSE returns p-value", { + result <- neill.test(ryegrass_m1, ryegrass$conc, display = FALSE) + expect_type(result, "double") + expect_length(result, 1) + expect_true(result >= 0 && result <= 1) +}) + +# ---- Tests for grouping methods (missing grouping) ---- + +test_that("neill.test with method='finest' generates pairwise grouping", { + result <- neill.test(ryegrass_m1, method = "finest") + expect_s3_class(result, "anova") + expect_named(result, c("F value", "p value")) + expect_true(result[["p value"]] >= 0 && result[["p value"]] <= 1) +}) + +test_that("neill.test with method='c-finest' generates clustering grouping", { + result <- neill.test(ryegrass_m1, method = "c-finest") + expect_s3_class(result, "anova") + expect_named(result, c("F value", "p value")) + expect_true(result[["p value"]] >= 0 && result[["p value"]] <= 1) +}) + +test_that("neill.test with method='percentiles' generates percentile grouping", { + result <- neill.test(ryegrass_m1, method = "percentiles") + expect_s3_class(result, "anova") + expect_named(result, c("F value", "p value")) + expect_true(result[["p value"]] >= 0 && result[["p value"]] <= 1) +}) + +# ---- Tests for breakp parameter ---- + +test_that("neill.test with breakp overrides method-based grouping", { + result <- neill.test(ryegrass_m1, breakp = c(0.5, 1, 2, 4, 8, 16)) + expect_s3_class(result, "anova") + expect_named(result, c("F value", "p value")) + expect_true(result[["p value"]] >= 0 && result[["p value"]] <= 1) +}) + +# ---- Tests for display=FALSE with each method ---- + +test_that("neill.test display=FALSE with method='finest' returns p-value", { + result <- neill.test(ryegrass_m1, method = "finest", display = FALSE) + expect_type(result, "double") + expect_length(result, 1) + expect_true(result >= 0 && result <= 1) +}) + +test_that("neill.test display=FALSE with method='c-finest' returns p-value", { + result <- neill.test(ryegrass_m1, method = "c-finest", display = FALSE) + expect_type(result, "double") + expect_length(result, 1) + expect_true(result >= 0 && result <= 1) +}) + +test_that("neill.test display=FALSE with method='percentiles' returns p-value", { + result <- neill.test(ryegrass_m1, method = "percentiles", display = FALSE) + expect_type(result, "double") + expect_length(result, 1) + expect_true(result >= 0 && result <= 1) +}) + +test_that("neill.test display=FALSE with breakp returns p-value", { + result <- neill.test(ryegrass_m1, breakp = c(0.5, 1, 2, 4, 8, 16), + display = FALSE) + expect_type(result, "double") + expect_length(result, 1) + expect_true(result >= 0 && result <= 1) +}) + +# ---- Error handling tests for neill.default() ---- + +test_that("neill.test errors with too many groups", { + # 24 groups for 24 observations -> denDF = 24 - 24 = 0 + expect_error( + neill.test(ryegrass_m1, grouping = 1:24), + "Too many groups" + ) +}) + +test_that("neill.test errors with too few groups", { + # 1 group for 4-param model -> numDF = 1 - 4 = -3 + expect_error( + neill.test(ryegrass_m1, grouping = rep(1, 24)), + "Too few groups" + ) +}) + +test_that("neill.test errors when M equals p (numDF = 0)", { + # 4 groups for 4-param model -> numDF = 4 - 4 = 0 + expect_error( + neill.test(ryegrass_m1, grouping = rep(1:4, each = 6)), + "Too few groups" + ) +}) + +# ---- Tests for neill.default() output formatting ---- + +test_that("neill.default anova output has correct heading", { + result <- neill.test(ryegrass_m1, ryegrass$conc) + expect_equal(attr(result, "heading"), "Neill's lack-of-fit test\n") +}) + +test_that("neill.default non-display mode returns matrix with F and p", { + # Access internal function directly for more targeted testing + result <- neill.test(ryegrass_m1, ryegrass$conc, display = FALSE) + # When display=FALSE, returns the p-value extracted from [1,2] of the matrix + expect_true(is.numeric(result)) +}) + +# ---- Test for method partial matching ---- + +test_that("neill.test method argument supports partial matching", { + # "perc" should match "percentiles" + result <- neill.test(ryegrass_m1, method = "perc") + expect_s3_class(result, "anova") +}) + +# ---- Verify consistent results ---- + +test_that("explicit conc grouping and c-finest give same result for replicated data", { + # ryegrass has replicates, so c-finest should recover original dose grouping + r_explicit <- neill.test(ryegrass_m1, ryegrass$conc, display = FALSE) + r_cfin <- neill.test(ryegrass_m1, method = "c-finest", display = FALSE) + expect_equal(r_explicit, r_cfin) +}) + +# ---- Grouping display output test ---- + +test_that("neill.test with display=TRUE prints grouping info", { + expect_output( + neill.test(ryegrass_m1, ryegrass$conc), + "Grouping used" + ) +}) diff --git a/tests/testthat/test-noEffect.R b/tests/testthat/test-noEffect.R new file mode 100644 index 00000000..0ca44d91 --- /dev/null +++ b/tests/testthat/test-noEffect.R @@ -0,0 +1,51 @@ +# Tests for noEffect function +# Tests the likelihood ratio test for dose effect significance + +test_that("noEffect returns correct structure for continuous model", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- noEffect(m1) + + expect_true(is.numeric(result)) + expect_length(result, 3) + expect_named(result, c("Chi-square test", "Df", "p-value")) +}) + +test_that("noEffect returns correct values for continuous model", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- noEffect(m1) + + # Chi-square test statistic should be positive + expect_true(result["Chi-square test"] > 0) + # Degrees of freedom should be positive integer + expect_true(result["Df"] > 0) + # p-value should be between 0 and 1 + expect_true(result["p-value"] >= 0 && result["p-value"] <= 1) + # For ryegrass data, there is a strong dose effect, so p-value should be very small + expect_true(result["p-value"] < 0.05) +}) + +test_that("noEffect works for binomial model", { + m_bin <- drm(number / total ~ dose, weights = total, data = earthworms, + fct = LL.2(), type = "binomial") + result <- noEffect(m_bin) + + expect_true(is.numeric(result)) + expect_length(result, 3) + expect_named(result, c("Chi-square test", "Df", "p-value")) + expect_true(is.finite(result["Chi-square test"])) + expect_true(result["Df"] > 0) + expect_true(result["p-value"] >= 0 && result["p-value"] <= 1) +}) + +test_that("noEffect works for Poisson model", { + m_pois <- drm(count ~ conc, data = decontaminants, fct = LL.3(), + type = "Poisson") + result <- noEffect(m_pois) + + expect_true(is.numeric(result)) + expect_length(result, 3) + expect_named(result, c("Chi-square test", "Df", "p-value")) + expect_true(result["Chi-square test"] > 0) + expect_true(result["Df"] > 0) + expect_true(result["p-value"] >= 0 && result["p-value"] <= 1) +}) diff --git a/tests/testthat/test-otrace.R b/tests/testthat/test-otrace.R new file mode 100644 index 00000000..65462d21 --- /dev/null +++ b/tests/testthat/test-otrace.R @@ -0,0 +1,29 @@ +# Test that otrace correctly controls error message display + +test_that("drmc() otrace default is FALSE", { + ctrl <- drmc() + expect_false(ctrl$otrace) +}) + +test_that("otrace=TRUE allows successful convergence", { + fit <- drm(rootl ~ conc, data = ryegrass, fct = LL.4(), + control = drmc(otrace = TRUE)) + expect_s3_class(fit, "drc") +}) + +test_that("otrace=FALSE allows successful convergence", { + fit <- drm(rootl ~ conc, data = ryegrass, fct = LL.4(), + control = drmc(otrace = FALSE)) + expect_s3_class(fit, "drc") +}) + +test_that("drm() matches drm_legacy() with otrace=TRUE", { + fit1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4(), + control = drmc(otrace = TRUE)) + fit2 <- drc:::drm_legacy(rootl ~ conc, data = ryegrass, fct = LL.4(), + control = drmc(otrace = TRUE)) + + expect_s3_class(fit1, "drc") + expect_s3_class(fit2, "drc") + expect_equal(coef(fit1), coef(fit2), tolerance = 1e-6) +}) diff --git a/tests/testthat/test-plot.R b/tests/testthat/test-plot.R new file mode 100644 index 00000000..2d78dbf7 --- /dev/null +++ b/tests/testthat/test-plot.R @@ -0,0 +1,473 @@ +# Test plot.drc() function - Plotting dose-response curves + +# Create test datasets +ryegrass <- data.frame( + rootl = c( + 7.58, 8.00, 8.33, 7.25, 7.17, 7.00, 7.17, 7.83, 7.92, 7.58, + 6.17, 5.75, 5.83, 6.00, 5.83, 4.92, 4.50, 4.17, 4.42, 4.00, + 2.67, 2.08, 2.42, 2.50, 2.25, 1.17, 0.75, 0.92, 1.00, 0.58 + ), + conc = c( + rep(0, 5), rep(0.94, 5), rep(1.88, 5), + rep(3.75, 5), rep(7.50, 5), rep(15, 5) + ) +) + +set.seed(42) +multi_data <- data.frame( + dose = rep(c(0, 0.5, 1, 2, 5, 10), each = 5, times = 2), + resp = c( + rnorm(5, 100, 5), rnorm(5, 95, 5), rnorm(5, 85, 5), + rnorm(5, 60, 5), rnorm(5, 20, 5), rnorm(5, 5, 5), + rnorm(5, 100, 5), rnorm(5, 90, 5), rnorm(5, 70, 5), + rnorm(5, 40, 5), rnorm(5, 10, 5), rnorm(5, 3, 5) + ), + group = rep(c("A", "B"), each = 30) +) + +# Basic plot tests + +test_that("plot.drc creates plot without error", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + expect_no_error({ + pdf(file = tempfile()) + plot(m1) + dev.off() + }) +}) + +test_that("plot.drc returns data frame invisibly", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + pdf(file = tempfile()) + result <- plot(m1) + dev.off() + + expect_true(is.data.frame(result)) +}) + +test_that("plot.drc works with different plot types", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Test different type parameters + types <- c("average", "all", "bars", "none", "obs") + + for (plot_type in types) { + expect_no_error({ + pdf(file = tempfile()) + plot(m1, type = plot_type) + dev.off() + }) + } +}) + +test_that("plot.drc type = 'confidence' creates confidence bands", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + expect_no_error({ + pdf(file = tempfile()) + plot(m1, type = "confidence") + dev.off() + }) +}) + +# Tests with multi-curve models + +test_that("plot.drc works with multi-curve models", { + m_multi <- drm(resp ~ dose, curveid = group, data = multi_data, fct = LL.4()) + + expect_no_error({ + pdf(file = tempfile()) + plot(m_multi) + dev.off() + }) +}) + +test_that("plot.drc can plot specific curves using level", { + m_multi <- drm(resp ~ dose, curveid = group, data = multi_data, fct = LL.4()) + + expect_no_error({ + pdf(file = tempfile()) + plot(m_multi, level = "A") + dev.off() + }) +}) + +test_that("plot.drc with multiple levels", { + m_multi <- drm(resp ~ dose, curveid = group, data = multi_data, fct = LL.4()) + + expect_no_error({ + pdf(file = tempfile()) + plot(m_multi, level = c("A", "B")) + dev.off() + }) +}) + +# Tests with graphical parameters + +test_that("plot.drc respects col parameter", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + expect_no_error({ + pdf(file = tempfile()) + plot(m1, col = "blue") + dev.off() + }) +}) + +test_that("plot.drc respects lty parameter", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + expect_no_error({ + pdf(file = tempfile()) + plot(m1, lty = 2) + dev.off() + }) +}) + +test_that("plot.drc respects pch parameter", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + expect_no_error({ + pdf(file = tempfile()) + plot(m1, pch = 19) + dev.off() + }) +}) + +test_that("plot.drc with custom axis labels", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + expect_no_error({ + pdf(file = tempfile()) + plot(m1, xlab = "Concentration", ylab = "Root Length") + dev.off() + }) +}) + +test_that("plot.drc with custom xlim and ylim", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + expect_no_error({ + pdf(file = tempfile()) + plot(m1, xlim = c(0, 20), ylim = c(0, 10)) + dev.off() + }) +}) + +# Tests with log scale + +test_that("plot.drc with log = 'x'", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + expect_no_error({ + pdf(file = tempfile()) + plot(m1, log = "x") + dev.off() + }) +}) + +test_that("plot.drc with log = ''", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + expect_no_error({ + pdf(file = tempfile()) + plot(m1, log = "") + dev.off() + }) +}) + +# Tests with broken axis + +test_that("plot.drc with broken = TRUE", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + expect_no_error({ + pdf(file = tempfile()) + plot(m1, broken = TRUE) + dev.off() + }) +}) + +# Tests with gridsize + +test_that("plot.drc respects gridsize parameter", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + expect_no_error({ + pdf(file = tempfile()) + plot(m1, gridsize = 50) + dev.off() + }) + + expect_no_error({ + pdf(file = tempfile()) + plot(m1, gridsize = 200) + dev.off() + }) +}) + +# Tests with legend + +test_that("plot.drc with legend = TRUE", { + m_multi <- drm(resp ~ dose, curveid = group, data = multi_data, fct = LL.4()) + + expect_no_error({ + pdf(file = tempfile()) + plot(m_multi, legend = TRUE) + dev.off() + }) +}) + +test_that("plot.drc with legend = FALSE", { + m_multi <- drm(resp ~ dose, curveid = group, data = multi_data, fct = LL.4()) + + expect_no_error({ + pdf(file = tempfile()) + plot(m_multi, legend = FALSE) + dev.off() + }) +}) + +# Tests with normalization + +test_that("plot.drc with normal = TRUE normalizes data", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + expect_no_error({ + pdf(file = tempfile()) + plot(m1, normal = TRUE) + dev.off() + }) +}) + +# Tests with confidence level + +test_that("plot.drc respects confidence.level parameter", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + expect_no_error({ + pdf(file = tempfile()) + plot(m1, type = "bars", confidence.level = 0.90) + dev.off() + }) + + expect_no_error({ + pdf(file = tempfile()) + plot(m1, type = "confidence", confidence.level = 0.99) + dev.off() + }) +}) + +# Tests with different model types + +test_that("plot.drc works with LL.3 model", { + m_ll3 <- drm(rootl ~ conc, data = ryegrass, fct = LL.3()) + + expect_no_error({ + pdf(file = tempfile()) + plot(m_ll3) + dev.off() + }) +}) + +test_that("plot.drc works with Weibull models", { + m_w1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) + + expect_no_error({ + pdf(file = tempfile()) + plot(m_w1) + dev.off() + }) +}) + +test_that("plot.drc works with binomial type data", { + binom_data <- data.frame( + dose = c(0, 0.1, 0.5, 1, 2, 5, 10), + resp = c(0, 0.05, 0.15, 0.35, 0.65, 0.90, 0.98), + n = rep(50, 7) + ) + m_binom <- drm(resp ~ dose, data = binom_data, fct = LL.2(), type = "binomial", weights = n) + + expect_no_error({ + pdf(file = tempfile()) + plot(m_binom) + dev.off() + }) +}) + +test_that("plot.drc works with Poisson type data", { + poisson_data <- data.frame( + dose = c(0, 1, 2, 4, 8, 16, 32), + count = c(50, 48, 40, 25, 10, 3, 1) + ) + m_poisson <- drm(count ~ dose, data = poisson_data, fct = LL.4(), type = "Poisson") + + expect_no_error({ + pdf(file = tempfile()) + plot(m_poisson) + dev.off() + }) +}) + +# Tests with multiple graphical parameters combined + +test_that("plot.drc with multiple graphical parameters", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + expect_no_error({ + pdf(file = tempfile()) + plot(m1, + col = "red", + lty = 2, + pch = 19, + xlab = "Concentration (mM)", + ylab = "Root length (cm)", + main = "Ryegrass dose-response", + xlim = c(0, 20), + ylim = c(0, 10) + ) + dev.off() + }) +}) + +# Tests for edge cases + +test_that("plot.drc handles models with zero dose", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # ryegrass data includes zero doses + expect_no_error({ + pdf(file = tempfile()) + plot(m1, log = "x") # log scale with zero dose + dev.off() + }) +}) + +test_that("plot.drc with robust estimation", { + m_robust <- drm(rootl ~ conc, data = ryegrass, fct = LL.4(), robust = "median") + + expect_no_error({ + pdf(file = tempfile()) + plot(m_robust) + dev.off() + }) +}) + +test_that("plot.drc works after model update", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + m2 <- update(m1, fct = LL.3()) + + expect_no_error({ + pdf(file = tempfile()) + plot(m2) + dev.off() + }) +}) + +# Tests with colors for multi-curve + +test_that("plot.drc with vector of colors for multi-curve", { + m_multi <- drm(resp ~ dose, curveid = group, data = multi_data, fct = LL.4()) + + expect_no_error({ + pdf(file = tempfile()) + plot(m_multi, col = c("red", "blue")) + dev.off() + }) +}) + +test_that("plot.drc with logical col = TRUE for auto colors", { + m_multi <- drm(resp ~ dose, curveid = group, data = multi_data, fct = LL.4()) + + expect_no_error({ + pdf(file = tempfile()) + plot(m_multi, col = TRUE) + dev.off() + }) +}) + +# Integration tests + +test_that("plot.drc can be called multiple times", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + expect_no_error({ + pdf(file = tempfile()) + plot(m1) + plot(m1, col = "blue") + dev.off() + }) +}) + +test_that("plot.drc works with par() settings", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + expect_no_error({ + pdf(file = tempfile()) + old_par <- par(mfrow = c(2, 2)) + plot(m1) + plot(m1, type = "bars") + plot(m1, type = "confidence") + plot(m1, log = "") + par(old_par) + dev.off() + }) +}) + +test_that("plot.drc works after predictions", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Make some predictions first + newdata <- data.frame(conc = c(1, 2, 3)) + pred <- predict(m1, newdata = newdata) + + # Plot should still work + expect_no_error({ + pdf(file = tempfile()) + plot(m1) + dev.off() + }) +}) + +test_that("plot.drc consistent across calls", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Both plots should work without interfering + expect_no_error({ + pdf(file = tempfile()) + plot(m1) + dev.off() + + pdf(file = tempfile()) + plot(m1) + dev.off() + }) +}) + +# Tests to ensure plot doesn't crash with various argument combinations + +test_that("plot.drc with type = 'all' and col vector", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + expect_no_error({ + pdf(file = tempfile()) + plot(m1, type = "all", col = "darkgreen") + dev.off() + }) +}) + +test_that("plot.drc with add = TRUE parameter if supported", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # First plot + expect_no_error({ + pdf(file = tempfile()) + plot(m1) + # Try to add to existing plot (if add parameter exists) + # This may or may not be supported, so we just test it doesn't crash + try(plot(m1, add = TRUE), silent = TRUE) + dev.off() + }) +}) diff --git a/tests/testthat/test-predict.R b/tests/testthat/test-predict.R new file mode 100644 index 00000000..9fa6bb70 --- /dev/null +++ b/tests/testthat/test-predict.R @@ -0,0 +1,422 @@ +# Test predict.drc() function - Prediction for dose-response models + +# Create test datasets +ryegrass <- data.frame( + rootl = c( + 7.58, 8.00, 8.33, 7.25, 7.17, 7.00, 7.17, 7.83, 7.92, 7.58, + 6.17, 5.75, 5.83, 6.00, 5.83, 4.92, 4.50, 4.17, 4.42, 4.00, + 2.67, 2.08, 2.42, 2.50, 2.25, 1.17, 0.75, 0.92, 1.00, 0.58 + ), + conc = c( + rep(0, 5), rep(0.94, 5), rep(1.88, 5), + rep(3.75, 5), rep(7.50, 5), rep(15, 5) + ) +) + +set.seed(42) +multi_data <- data.frame( + dose = rep(c(0, 0.5, 1, 2, 5, 10), each = 5, times = 2), + resp = c( + rnorm(5, 100, 5), rnorm(5, 95, 5), rnorm(5, 85, 5), + rnorm(5, 60, 5), rnorm(5, 20, 5), rnorm(5, 5, 5), + rnorm(5, 100, 5), rnorm(5, 90, 5), rnorm(5, 70, 5), + rnorm(5, 40, 5), rnorm(5, 10, 5), rnorm(5, 3, 5) + ), + group = rep(c("A", "B"), each = 30) +) + +# Basic prediction tests + +test_that("predict.drc returns fitted values when newdata is missing", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + predictions <- predict(m1) + + expect_true(is.numeric(predictions)) + expect_equal(length(predictions), nrow(ryegrass)) +}) + +test_that("predict.drc returns predictions for new dose values", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + newdata <- data.frame(conc = c(0.5, 1.0, 2.0)) + predictions <- predict(m1, newdata = newdata) + + expect_true(is.numeric(predictions)) + expect_equal(length(predictions), 3) +}) + +test_that("predict.drc predictions are within reasonable bounds", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + newdata <- data.frame(conc = c(0, 5, 10, 15)) + predictions <- predict(m1, newdata = newdata) + + # Predictions should be positive and within reasonable range + expect_true(all(predictions > 0)) + expect_true(all(predictions < 10)) # Based on ryegrass data range +}) + +# Tests with standard errors + +test_that("predict.drc returns standard errors when requested", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + newdata <- data.frame(conc = c(1, 2, 3)) + result <- predict(m1, newdata = newdata, se.fit = TRUE) + + expect_true(is.matrix(result)) + expect_equal(ncol(result), 2) + expect_true("Prediction" %in% colnames(result)) + expect_true("SE" %in% colnames(result)) + expect_true(all(result[, "SE"] > 0)) +}) + +# Tests with confidence intervals + +test_that("predict.drc returns confidence intervals", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + newdata <- data.frame(conc = c(1, 2, 3)) + result <- predict(m1, newdata = newdata, interval = "confidence") + + expect_true(is.matrix(result)) + expect_equal(ncol(result), 3) + expect_true(all(c("Prediction", "Lower", "Upper") %in% colnames(result))) + expect_true(all(result[, "Lower"] < result[, "Prediction"])) + expect_true(all(result[, "Upper"] > result[, "Prediction"])) +}) + +test_that("predict.drc returns prediction intervals", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + newdata <- data.frame(conc = c(1, 2, 3)) + result <- predict(m1, newdata = newdata, interval = "prediction") + + expect_true(is.matrix(result)) + expect_equal(ncol(result), 3) + expect_true(all(result[, "Lower"] < result[, "Prediction"])) + expect_true(all(result[, "Upper"] > result[, "Prediction"])) +}) + +test_that("predict.drc prediction intervals are wider than confidence intervals", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + newdata <- data.frame(conc = c(1, 2, 3)) + + result_conf <- predict(m1, newdata = newdata, interval = "confidence") + result_pred <- predict(m1, newdata = newdata, interval = "prediction") + + width_conf <- result_conf[, "Upper"] - result_conf[, "Lower"] + width_pred <- result_pred[, "Upper"] - result_pred[, "Lower"] + + expect_true(all(width_pred > width_conf)) +}) + +test_that("predict.drc confidence level affects interval width", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + newdata <- data.frame(conc = c(2)) + + result_95 <- predict(m1, newdata = newdata, interval = "confidence", level = 0.95) + result_90 <- predict(m1, newdata = newdata, interval = "confidence", level = 0.90) + + width_95 <- result_95[, "Upper"] - result_95[, "Lower"] + width_90 <- result_90[, "Upper"] - result_90[, "Lower"] + + expect_true(width_90 < width_95) +}) + +# Tests with multi-curve models + +test_that("predict.drc works with multi-curve models", { + m_multi <- drm(resp ~ dose, curveid = group, data = multi_data, fct = LL.4()) + predictions <- predict(m_multi) + + expect_true(is.numeric(predictions)) + expect_equal(length(predictions), nrow(multi_data)) +}) + +test_that("predict.drc predicts for specific curves in newdata", { + m_multi <- drm(resp ~ dose, curveid = group, data = multi_data, fct = LL.4()) + newdata <- data.frame(dose = c(1, 2, 3), group = c("A", "A", "B")) + predictions <- predict(m_multi, newdata = newdata) + + expect_equal(length(predictions), 3) + expect_true(all(is.finite(predictions))) +}) + +test_that("predict.drc handles missing curve ID in newdata", { + m_multi <- drm(resp ~ dose, curveid = group, data = multi_data, fct = LL.4()) + newdata <- data.frame(dose = c(1, 2, 3)) # No group column + predictions <- predict(m_multi, newdata = newdata) + + expect_equal(length(predictions), 3) +}) + +# Tests with different model types + +test_that("predict.drc works with binomial type data", { + binom_data <- data.frame( + dose = c(0, 0.1, 0.5, 1, 2, 5, 10), + resp = c(0, 0.05, 0.15, 0.35, 0.65, 0.90, 0.98), + n = rep(50, 7) + ) + m_binom <- drm(resp ~ dose, data = binom_data, fct = LL.2(), type = "binomial", weights = n) + predictions <- predict(m_binom) + + expect_true(all(predictions >= 0 & predictions <= 1)) +}) + +test_that("predict.drc constrains binomial predictions to [0, 1]", { + binom_data <- data.frame( + dose = c(0, 0.1, 0.5, 1, 2, 5, 10), + resp = c(0, 0.05, 0.15, 0.35, 0.65, 0.90, 0.98), + n = rep(50, 7) + ) + m_binom <- drm(resp ~ dose, data = binom_data, fct = LL.2(), type = "binomial", weights = n) + result <- predict(m_binom, interval = "confidence") + + # Upper limit should not exceed 1 + expect_true(all(result[, "Upper"] <= 1)) +}) + +test_that("predict.drc works with Poisson type data", { + poisson_data <- data.frame( + dose = c(0, 1, 2, 4, 8, 16, 32), + count = c(50, 48, 40, 25, 10, 3, 1) + ) + m_poisson <- drm(count ~ dose, data = poisson_data, fct = LL.4(), type = "Poisson") + predictions <- predict(m_poisson) + + expect_true(all(predictions >= 0)) + expect_equal(length(predictions), 7) +}) + +test_that("predict.drc constrains non-continuous predictions to >= 0", { + poisson_data <- data.frame( + dose = c(0, 1, 2, 4, 8, 16, 32), + count = c(50, 48, 40, 25, 10, 3, 1) + ) + m_poisson <- drm(count ~ dose, data = poisson_data, fct = LL.4(), type = "Poisson") + result <- predict(m_poisson, interval = "confidence") + + # Lower limit should not be negative + expect_true(all(result[, "Lower"] >= 0)) +}) + +# Tests with constrain parameter + +test_that("predict.drc respects constrain = FALSE", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + newdata <- data.frame(conc = c(0.1)) + + result_constrained <- predict(m1, newdata = newdata, interval = "confidence", constrain = TRUE) + result_unconstrained <- predict(m1, newdata = newdata, interval = "confidence", constrain = FALSE) + + # Both should return results, but unconstrained might have different bounds + expect_true(is.matrix(result_constrained)) + expect_true(is.matrix(result_unconstrained)) +}) + +# Tests with vcov parameter + +test_that("predict.drc accepts custom vcov function", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + newdata <- data.frame(conc = c(2)) + + custom_vcov <- function(x) vcov(x) * 2 + result_default <- predict(m1, newdata = newdata, se.fit = TRUE) + result_custom <- predict(m1, newdata = newdata, se.fit = TRUE, vcov. = custom_vcov) + + # Standard errors should be different (larger with scaled vcov) + expect_true(result_custom[, "SE"] > result_default[, "SE"]) +}) + +# Tests with od (over-dispersion) parameter + +test_that("predict.drc respects od parameter for binomial data", { + binom_data <- data.frame( + dose = c(0, 0.1, 0.5, 1, 2, 5, 10), + resp = c(0, 0.05, 0.15, 0.35, 0.65, 0.90, 0.98), + n = rep(50, 7) + ) + m_binom <- drm(resp ~ dose, data = binom_data, fct = LL.2(), type = "binomial", weights = n) + newdata <- data.frame(dose = c(1)) + + result_no_od <- predict(m_binom, newdata = newdata, se.fit = TRUE, od = FALSE) + result_with_od <- predict(m_binom, newdata = newdata, se.fit = TRUE, od = TRUE) + + # Standard errors might differ with od adjustment + expect_true(is.matrix(result_no_od)) + expect_true(is.matrix(result_with_od)) +}) + +# Tests for models without derivatives + +test_that("predict.drc returns only predictions when derivatives unavailable", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + # Remove derivatives to simulate unavailable derivatives + m1$fct$deriv1 <- NULL + newdata <- data.frame(conc = c(1, 2)) + + predictions <- predict(m1, newdata = newdata) + + expect_true(is.numeric(predictions)) + expect_equal(length(predictions), 2) +}) + +# Tests with se.fit and interval together + +test_that("predict.drc returns SE and confidence interval columns together", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + newdata <- data.frame(conc = c(1, 2)) + + result <- predict(m1, newdata = newdata, se.fit = TRUE, interval = "confidence") + + expect_true(is.matrix(result)) + expect_equal(ncol(result), 4) + expect_true(all(c("Prediction", "SE", "Lower", "Upper") %in% colnames(result))) +}) + +test_that("predict.drc with se.fit = FALSE and interval returns no SE", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + newdata <- data.frame(conc = c(1, 2)) + + result <- predict(m1, newdata = newdata, se.fit = FALSE, interval = "confidence") + + expect_equal(ncol(result), 3) + expect_false("SE" %in% colnames(result)) +}) + +# Tests with checkND parameter + +test_that("predict.drc with checkND = FALSE accepts non-standard newdata", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Pass a vector instead of data frame + newdata <- c(1, 2, 3) + predictions <- predict(m1, newdata = newdata, checkND = FALSE) + + expect_equal(length(predictions), 3) +}) + +# Edge cases and error conditions + +test_that("predict.drc handles zero dose values", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + newdata <- data.frame(conc = c(0, 0.01, 0.1)) + predictions <- predict(m1, newdata = newdata) + + expect_equal(length(predictions), 3) + expect_true(all(is.finite(predictions))) +}) + +test_that("predict.drc handles very large dose values", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + newdata <- data.frame(conc = c(100, 1000)) + predictions <- predict(m1, newdata = newdata) + + expect_equal(length(predictions), 2) + expect_true(all(is.finite(predictions))) +}) + +test_that("predict.drc returns consistent predictions", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + newdata <- data.frame(conc = c(2)) + + pred1 <- predict(m1, newdata = newdata) + pred2 <- predict(m1, newdata = newdata) + + expect_equal(pred1, pred2) +}) + +test_that("predict.drc fitted values match original data size", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + fitted_vals <- predict(m1) + + expect_equal(length(fitted_vals), nrow(ryegrass)) +}) + +# Tests with different response types + +test_that("predict.drc uses correct distribution for continuous data", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + newdata <- data.frame(conc = c(2)) + + # For continuous data, should use t-distribution + result <- predict(m1, newdata = newdata, interval = "confidence") + + expect_true(is.matrix(result)) + expect_equal(ncol(result), 3) +}) + +test_that("predict.drc uses correct distribution for binomial data", { + binom_data <- data.frame( + dose = c(0, 0.1, 0.5, 1, 2, 5, 10), + resp = c(0, 0.05, 0.15, 0.35, 0.65, 0.90, 0.98), + n = rep(50, 7) + ) + m_binom <- drm(resp ~ dose, data = binom_data, fct = LL.2(), type = "binomial", weights = n) + newdata <- data.frame(dose = c(1)) + + # For binomial data, should use normal distribution + result <- predict(m_binom, newdata = newdata, interval = "confidence") + + expect_true(is.matrix(result)) + expect_equal(ncol(result), 3) +}) + +# Integration tests + +test_that("predict.drc predictions are monotonic for monotonic models", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + newdata <- data.frame(conc = c(0.5, 1, 2, 4, 8)) + predictions <- predict(m1, newdata = newdata) + + # For decreasing dose-response, predictions should decrease + expect_true(all(diff(predictions) <= 0.01)) # Allow small numerical errors +}) + +test_that("predict.drc standard errors increase at extreme doses", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Predictions at middle range + middle <- predict(m1, newdata = data.frame(conc = c(2)), se.fit = TRUE) + + # Predictions at extremes + extreme <- predict(m1, newdata = data.frame(conc = c(0.01, 100)), se.fit = TRUE) + + # Generally, SE at extremes should be larger (though not always guaranteed) + expect_true(is.matrix(middle)) + expect_true(is.matrix(extreme)) +}) + +# Tests for models with fixed parameters + +test_that("predict.drc works with EXD.3 model with two fixed parameters", { + df <- data.frame( + conc = c(10, 1, 10000, 10, 1000, 100, 1, 0, 0, 0), + growthrate_d = c(1.525017, 4.232832, 0.000000, 1.006102, 0.000000, + 2.578778, 3.202289, 2.723128, 2.202485, 1.667510) + ) + lower <- 0 + upper <- mean(df[df$conc == 0, "growthrate_d"]) + + m2 <- drm( + formula = growthrate_d ~ conc, + data = df, + fct = EXD.3(fixed = c(lower, upper, NA)) + ) + + newdata <- data.frame(conc = c(0.5, 5, 50, 500, 5000)) + + # Plain prediction should work + pred <- predict(m2, newdata = newdata) + expect_true(is.numeric(pred)) + expect_equal(length(pred), 5) + + # Prediction with confidence interval should work (was failing before fix) + result <- predict(m2, newdata = newdata, interval = "confidence") + expect_true(is.matrix(result)) + expect_equal(nrow(result), 5) + expect_equal(ncol(result), 3) + expect_true(all(c("Prediction", "Lower", "Upper") %in% colnames(result))) + + # Prediction with se.fit should work + result_se <- predict(m2, newdata = newdata, se.fit = TRUE) + expect_true(is.matrix(result_se)) + expect_equal(ncol(result_se), 2) +}) diff --git a/tests/testthat/test-print-summary.R b/tests/testthat/test-print-summary.R new file mode 100644 index 00000000..91794c95 --- /dev/null +++ b/tests/testthat/test-print-summary.R @@ -0,0 +1,319 @@ +# Test print.drc() and summary.drc() functions + +# Create test datasets +ryegrass <- data.frame( + rootl = c( + 7.58, 8.00, 8.33, 7.25, 7.17, 7.00, 7.17, 7.83, 7.92, 7.58, + 6.17, 5.75, 5.83, 6.00, 5.83, 4.92, 4.50, 4.17, 4.42, 4.00, + 2.67, 2.08, 2.42, 2.50, 2.25, 1.17, 0.75, 0.92, 1.00, 0.58 + ), + conc = c( + rep(0, 5), rep(0.94, 5), rep(1.88, 5), + rep(3.75, 5), rep(7.50, 5), rep(15, 5) + ) +) + +set.seed(42) +multi_data <- data.frame( + dose = rep(c(0, 0.5, 1, 2, 5, 10), each = 5, times = 2), + resp = c( + rnorm(5, 100, 5), rnorm(5, 95, 5), rnorm(5, 85, 5), + rnorm(5, 60, 5), rnorm(5, 20, 5), rnorm(5, 5, 5), + rnorm(5, 100, 5), rnorm(5, 90, 5), rnorm(5, 70, 5), + rnorm(5, 40, 5), rnorm(5, 10, 5), rnorm(5, 3, 5) + ), + group = rep(c("A", "B"), each = 30) +) + +# Tests for print.drc() + +test_that("print.drc prints model information", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Capture output + output <- capture.output(print(m1)) + + expect_true(length(output) > 0) + expect_true(any(grepl("drc", output))) + expect_true(any(grepl("Call:", output))) + expect_true(any(grepl("Coefficients:", output))) +}) + +test_that("print.drc returns object invisibly", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Should return the object invisibly + result <- capture.output(returned_obj <- print(m1)) + + expect_identical(returned_obj, m1) +}) + +test_that("print.drc displays coefficients", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + output <- capture.output(print(m1)) + + # Should show parameter names + expect_true(any(grepl("b:", output) | grepl("Coefficients", output))) +}) + +test_that("print.drc respects digits parameter", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + output_3 <- capture.output(print(m1, digits = 3)) + output_6 <- capture.output(print(m1, digits = 6)) + + # More digits should produce longer output strings + expect_true(length(output_3) > 0) + expect_true(length(output_6) > 0) +}) + +test_that("print.drc handles model with no coefficients", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + # Simulate model with no coefficients + m1_copy <- m1 + m1_copy$coefficients <- numeric(0) + + output <- capture.output(print(m1_copy)) + + expect_true(any(grepl("No coefficients", output))) +}) + +test_that("print.drc works with multi-curve models", { + m_multi <- drm(resp ~ dose, curveid = group, data = multi_data, fct = LL.4()) + + output <- capture.output(print(m_multi)) + + expect_true(length(output) > 0) + expect_true(any(grepl("drc", output))) +}) + +# Tests for summary.drc() + +test_that("summary.drc returns summary object", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + summ <- summary(m1) + + expect_true(is.list(summ)) + expect_true("resVar" %in% names(summ)) + expect_true("varMat" %in% names(summ) | length(summ) > 0) +}) + +test_that("summary.drc contains residual standard error", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + summ <- summary(m1) + + expect_true("resVar" %in% names(summ)) + expect_true(is.numeric(summ$resVar)) + expect_true(summ$resVar > 0) +}) + +test_that("summary.drc contains coefficient matrix", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + summ <- summary(m1) + + expect_true("coefficients" %in% names(summ)) + expect_true(is.matrix(summ$coefficients)) + expect_equal(nrow(summ$coefficients), length(coef(m1))) +}) + +test_that("summary.drc coefficient matrix has correct columns", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + summ <- summary(m1) + + coef_mat <- summ$coefficients + expect_true("Estimate" %in% colnames(coef_mat)) + expect_true("Std. Error" %in% colnames(coef_mat)) + expect_true("t-value" %in% colnames(coef_mat) | "z-value" %in% colnames(coef_mat)) + expect_true("p-value" %in% colnames(coef_mat)) +}) + +test_that("summary.drc p-values are between 0 and 1", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + summ <- summary(m1) + + p_values <- summ$coefficients[, "p-value"] + expect_true(all(p_values >= 0 & p_values <= 1)) +}) + +test_that("summary.drc standard errors are positive", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + summ <- summary(m1) + + std_errors <- summ$coefficients[, "Std. Error"] + expect_true(all(std_errors > 0)) +}) + +test_that("summary.drc works with over-dispersion adjustment", { + binom_data <- data.frame( + dose = c(0, 0.1, 0.5, 1, 2, 5, 10), + resp = c(0, 0.05, 0.15, 0.35, 0.65, 0.90, 0.98), + n = rep(50, 7) + ) + m_binom <- drm(resp ~ dose, data = binom_data, fct = LL.2(), type = "binomial", weights = n) + + summ_no_od <- summary(m_binom, od = FALSE) + summ_with_od <- summary(m_binom, od = TRUE) + + expect_true(is.list(summ_no_od)) + expect_true(is.list(summ_with_od)) + + # Standard errors might differ with OD adjustment + se_no_od <- summ_no_od$coefficients[, "Std. Error"] + se_with_od <- summ_with_od$coefficients[, "Std. Error"] + + expect_equal(length(se_no_od), length(se_with_od)) +}) + +test_that("summary.drc with pool = FALSE for multi-curve models", { + m_multi <- drm(resp ~ dose, curveid = group, data = multi_data, fct = LL.4()) + + summ_pooled <- summary(m_multi, pool = TRUE) + summ_unpooled <- summary(m_multi, pool = FALSE) + + expect_true(is.list(summ_pooled)) + expect_true(is.list(summ_unpooled)) +}) + +test_that("summary.drc contains residual standard error matrix", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + summ <- summary(m1) + + expect_true("rseMat" %in% names(summ)) + expect_true(is.matrix(summ$rseMat)) + expect_true("rse" %in% colnames(summ$rseMat)) + expect_true("df" %in% colnames(summ$rseMat)) +}) + +test_that("summary.drc degrees of freedom are positive integers", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + summ <- summary(m1) + + df <- summ$rseMat[, "df"] + expect_true(all(df > 0)) + expect_true(all(df == floor(df))) +}) + +# Tests with different model types + +test_that("summary.drc works with binomial type data", { + binom_data <- data.frame( + dose = c(0, 0.1, 0.5, 1, 2, 5, 10), + resp = c(0, 0.05, 0.15, 0.35, 0.65, 0.90, 0.98), + n = rep(50, 7) + ) + m_binom <- drm(resp ~ dose, data = binom_data, fct = LL.2(), type = "binomial", weights = n) + summ <- summary(m_binom) + + expect_true(is.list(summ)) + expect_true("coefficients" %in% names(summ)) +}) + +test_that("summary.drc uses z-values for non-continuous data", { + binom_data <- data.frame( + dose = c(0, 0.1, 0.5, 1, 2, 5, 10), + resp = c(0, 0.05, 0.15, 0.35, 0.65, 0.90, 0.98), + n = rep(50, 7) + ) + m_binom <- drm(resp ~ dose, data = binom_data, fct = LL.2(), type = "binomial", weights = n) + summ <- summary(m_binom) + + # Binomial data should use z-values (normal distribution) + expect_true("z-value" %in% colnames(summ$coefficients) | + "z value" %in% colnames(summ$coefficients) | + "t-value" %in% colnames(summ$coefficients)) +}) + +test_that("summary.drc uses t-values for continuous data", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + summ <- summary(m1) + + # Continuous data should use t-values + expect_true("t-value" %in% colnames(summ$coefficients) | + "t value" %in% colnames(summ$coefficients)) +}) + +test_that("summary.drc works with Poisson type data", { + poisson_data <- data.frame( + dose = c(0, 1, 2, 4, 8, 16, 32), + count = c(50, 48, 40, 25, 10, 3, 1) + ) + m_poisson <- drm(count ~ dose, data = poisson_data, fct = LL.4(), type = "Poisson") + summ <- summary(m_poisson) + + expect_true(is.list(summ)) + expect_true("coefficients" %in% names(summ)) +}) + +test_that("summary.drc handles robust estimation methods", { + m_robust <- drm(rootl ~ conc, data = ryegrass, fct = LL.4(), robust = "median") + summ <- summary(m_robust) + + expect_true(is.list(summ)) + expect_true("coefficients" %in% names(summ)) +}) + +# Tests for print.summary.drc (if it exists) + +test_that("summary.drc object can be printed", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + summ <- summary(m1) + + # Should be able to print summary without error + expect_no_error({ + output <- capture.output(print(summ)) + }) +}) + +# Integration tests + +test_that("print and summary work together", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Both should work without errors + expect_no_error({ + print_output <- capture.output(print(m1)) + summ <- summary(m1) + summary_output <- capture.output(print(summ)) + }) +}) + +test_that("summary.drc estimates match coef", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + summ <- summary(m1) + + coef_from_summary <- summ$coefficients[, "Estimate"] + coef_direct <- coef(m1) + + expect_equal(coef_from_summary, coef_direct) +}) + +test_that("summary.drc is consistent across calls", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + summ1 <- summary(m1) + summ2 <- summary(m1) + + expect_equal(summ1$coefficients, summ2$coefficients) + expect_equal(summ1$resVar, summ2$resVar) +}) + +test_that("summary.drc with different LL models", { + m_ll3 <- drm(rootl ~ conc, data = ryegrass, fct = LL.3()) + m_ll4 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + summ_ll3 <- summary(m_ll3) + summ_ll4 <- summary(m_ll4) + + # LL.3 has fewer parameters + expect_equal(nrow(summ_ll3$coefficients), 3) + expect_equal(nrow(summ_ll4$coefficients), 4) +}) + +test_that("summary.drc with Weibull models", { + m_w1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) + summ <- summary(m_w1) + + expect_true(is.list(summ)) + expect_equal(nrow(summ$coefficients), 4) +}) diff --git a/tests/testthat/test-rdrm.R b/tests/testthat/test-rdrm.R new file mode 100644 index 00000000..cb1a6a7f --- /dev/null +++ b/tests/testthat/test-rdrm.R @@ -0,0 +1,167 @@ +# tests/testthat/test-rdrm.R +# Comprehensive tests for the rdrm() function + +# ---- Happy Path: Continuous (rnorm) with numeric xerror, onlyY = FALSE ---- +test_that("rdrm returns x and y with numeric xerror and rnorm (default)", { + set.seed(42) + doses <- c(0, 1, 2, 5, 10) + mpar <- c(1, 1, 0, 1) # LL.4 parameters: b, c, d, e + result <- rdrm(3, LL.4(), mpar, xerror = doses) + + + expect_type(result, "list") + expect_named(result, c("x", "y")) + expect_true(is.matrix(result$x)) + expect_true(is.matrix(result$y)) + expect_equal(nrow(result$x), 3) + expect_equal(ncol(result$x), length(doses)) + expect_equal(nrow(result$y), 3) + expect_equal(ncol(result$y), length(doses)) + # x values should be sorted doses repeated + + expect_equal(as.numeric(result$x[1, ]), sort(doses)) + expect_equal(as.numeric(result$x[2, ]), sort(doses)) +}) + +# ---- Happy Path: Continuous (rnorm) with numeric xerror, onlyY = TRUE ---- +test_that("rdrm returns only y when onlyY = TRUE with rnorm", { + set.seed(42) + doses <- c(0, 1, 5, 10) + mpar <- c(1, 1, 0, 1) + result <- rdrm(2, LL.4(), mpar, xerror = doses, onlyY = TRUE) + + expect_type(result, "list") + expect_named(result, "y") + expect_true(is.matrix(result$y)) + expect_equal(nrow(result$y), 2) + expect_equal(ncol(result$y), length(doses)) +}) + +# ---- Happy Path: xerror as character string (function name) ---- +test_that("rdrm works with xerror as character string (runif)", { + set.seed(42) + mpar <- c(1, 1, 0, 1) + result <- rdrm(2, LL.4(), mpar, xerror = "runif", xpar = c(5, 0, 10)) + + expect_type(result, "list") + expect_named(result, c("x", "y")) + expect_true(is.matrix(result$x)) + expect_true(is.matrix(result$y)) + expect_equal(nrow(result$x), 2) + expect_equal(ncol(result$x), 5) # 5 dose values from runif(5, 0, 10) +}) + +# ---- Happy Path: Binomial (rbinom) with ypar length > 1, onlyY = FALSE ---- +test_that("rdrm works with rbinom and ypar length > 1", { + set.seed(42) + doses <- c(0, 1, 5, 10) + mpar <- c(1, 0.5) # LL.2 parameters: b, e + weights <- c(20, 20, 20, 20) + result <- rdrm(2, LL.2(), mpar, xerror = doses, + yerror = "rbinom", ypar = weights) + + expect_type(result, "list") + expect_named(result, c("x", "w", "y")) + expect_true(is.matrix(result$x)) + expect_true(is.matrix(result$w)) + expect_true(is.matrix(result$y)) + expect_equal(nrow(result$x), 2) + expect_equal(ncol(result$x), length(doses)) + expect_equal(nrow(result$w), 2) + expect_equal(ncol(result$w), length(doses)) + expect_equal(nrow(result$y), 2) + expect_equal(ncol(result$y), length(doses)) +}) + +# ---- Happy Path: Binomial (rbinom) with ypar length == 1 ---- +test_that("rdrm works with rbinom and ypar length == 1", { + set.seed(42) + doses <- c(0, 1, 5, 10) + mpar <- c(1, 0.5) # LL.2 parameters + result <- rdrm(2, LL.2(), mpar, xerror = doses, + yerror = "rbinom", ypar = 20) + + expect_type(result, "list") + expect_named(result, c("x", "w", "y")) + expect_true(is.matrix(result$x)) + expect_true(is.matrix(result$w)) + expect_true(is.matrix(result$y)) + # All weights should be 20 + expect_true(all(result$w == 20)) +}) + +# ---- Binomial with onlyY = TRUE ---- +test_that("rdrm with rbinom and onlyY = TRUE returns only y", { + set.seed(42) + doses <- c(0, 1, 5, 10) + mpar <- c(1, 0.5) + result <- rdrm(2, LL.2(), mpar, xerror = doses, + yerror = "rbinom", ypar = c(20, 20, 20, 20), onlyY = TRUE) + + expect_type(result, "list") + expect_named(result, "y") + expect_true(is.matrix(result$y)) + expect_equal(nrow(result$y), 2) + expect_equal(ncol(result$y), length(doses)) +}) + +# ---- Binomial with onlyY = TRUE and ypar length == 1 ---- +test_that("rdrm with rbinom, ypar length 1, and onlyY = TRUE", { + set.seed(42) + doses <- c(0, 1, 5) + mpar <- c(1, 0.5) + result <- rdrm(2, LL.2(), mpar, xerror = doses, + yerror = "rbinom", ypar = 10, onlyY = TRUE) + + expect_type(result, "list") + expect_named(result, "y") + expect_true(is.matrix(result$y)) +}) + +# ---- Edge case: Single dose value ---- +test_that("rdrm works with a single dose value", { + set.seed(42) + result <- rdrm(2, LL.4(), c(1, 0, 1, 5), xerror = 5) + + expect_type(result, "list") + expect_equal(ncol(result$x), 1) + expect_equal(ncol(result$y), 1) +}) + +# ---- Edge case: nosim = 1 ---- +test_that("rdrm works with nosim = 1", { + set.seed(42) + doses <- c(0, 1, 5, 10) + result <- rdrm(1, LL.4(), c(1, 0, 1, 5), xerror = doses) + + expect_type(result, "list") + expect_equal(nrow(result$x), 1) + expect_equal(nrow(result$y), 1) +}) + +# ---- Reproducibility with set.seed ---- +test_that("rdrm produces reproducible results with set.seed", { + doses <- c(0, 1, 5, 10) + mpar <- c(1, 0, 1, 5) + + set.seed(123) + r1 <- rdrm(3, LL.4(), mpar, xerror = doses) + + set.seed(123) + r2 <- rdrm(3, LL.4(), mpar, xerror = doses) + + expect_equal(r1$x, r2$x) + expect_equal(r1$y, r2$y) +}) + +# ---- xerror as character with xpar default ---- +test_that("rdrm works with xerror as character and xpar = 1 (default)", { + set.seed(42) + mpar <- c(1, 0, 1, 5) + result <- rdrm(2, LL.4(), mpar, xerror = "rnorm", xpar = c(5, 0, 1)) + + expect_type(result, "list") + expect_named(result, c("x", "y")) + expect_equal(nrow(result$x), 2) + expect_equal(ncol(result$x), 5) # 5 values from rnorm(5, 0, 1) +}) diff --git a/tests/testthat/test-relpot.R b/tests/testthat/test-relpot.R new file mode 100644 index 00000000..f1ab21d6 --- /dev/null +++ b/tests/testthat/test-relpot.R @@ -0,0 +1,201 @@ +# tests/testthat/test-relpot.R +# Comprehensive tests for relpot() and commatFct() + +# ============================================================ +# Setup: create model fixtures used across multiple tests +# ============================================================ + +# Decreasing 2-curve model (monoton < 0): spinach data +data(spinach, package = "drc") +m_dec <- drm(SLOPE ~ DOSE, HERBICIDE, data = spinach, fct = LL.4()) + +# Increasing 2-curve model (monoton > 0): synthetic data +set.seed(42) +inc_data <- rbind( + data.frame( + dose = rep(c(0, 0.5, 1, 2, 5, 10), each = 3), + resp = c(rnorm(3, 0.5, 0.1), rnorm(3, 1, 0.1), rnorm(3, 2, 0.1), + rnorm(3, 3, 0.1), rnorm(3, 4.5, 0.1), rnorm(3, 5, 0.1)), + group = "A" + ), + data.frame( + dose = rep(c(0, 0.5, 1, 2, 5, 10), each = 3), + resp = c(rnorm(3, 0.3, 0.1), rnorm(3, 0.8, 0.1), rnorm(3, 1.5, 0.1), + rnorm(3, 2.5, 0.1), rnorm(3, 3.5, 0.1), rnorm(3, 4.8, 0.1)), + group = "B" + ) +) +m_inc <- drm(resp ~ dose, group, data = inc_data, fct = LL.4()) + +# ============================================================ +# commatFct tests +# ============================================================ + +test_that("commatFct returns full parmMat when compMatch is NULL", { + result <- drc:::commatFct(m_dec, NULL) + expect_equal(result, m_dec$parmMat) +}) + +test_that("commatFct filters columns when compMatch is specified", { + result <- drc:::commatFct(m_dec, c("bentazon", "diuron")) + expect_equal(ncol(result), 2) + expect_true(all(c("bentazon", "diuron") %in% colnames(result))) +}) + +# ============================================================ +# relpot: return structure (happy path) +# ============================================================ + +test_that("relpot returns a list with x, y, percVec components (plotit=FALSE)", { + r <- relpot(m_dec, plotit = FALSE) + expect_type(r, "list") + expect_named(r, c("x", "y", "percVec")) + expect_true(is.numeric(r$x)) + expect_true(is.numeric(r$y)) + expect_true(is.numeric(r$percVec)) + # Default type="relative", scale="original" gives 99 x-values + expect_length(r$x, 99) + expect_length(r$y, 99) + # No NAs in the output + expect_false(any(is.na(r$y))) +}) + +# ============================================================ +# relpot: type="relative" with all three scale options +# ============================================================ + +test_that("relpot with type='relative', scale='original' (default)", { + r <- relpot(m_dec, plotit = FALSE, type = "relative", scale = "original") + expect_length(r$x, 99) + expect_length(r$y, 99) + # percVec should have 99 elements (101 minus endpoints) + expect_length(r$percVec, 99) +}) + +test_that("relpot with type='relative', scale='percent'", { + r <- relpot(m_dec, plotit = FALSE, type = "relative", scale = "percent") + expect_length(r$x, 99) + # xVec should equal percVec when scale is "percent" + expect_equal(r$x, r$percVec) +}) + +test_that("relpot with type='relative', scale='unconstrained'", { + r <- relpot(m_dec, plotit = FALSE, type = "relative", scale = "unconstrained") + # unconstrained overrides percVec to 1:99 + expect_equal(r$percVec, 1:99) + expect_length(r$y, 99) + # xVec should equal percVec for unconstrained + expect_equal(r$x, r$percVec) +}) + +# ============================================================ +# relpot: type="absolute" +# ============================================================ + +test_that("relpot with type='absolute' auto-generates percVec", { + r <- relpot(m_dec, plotit = FALSE, type = "absolute") + expect_length(r$percVec, 100) + expect_length(r$y, 100) + # xVec should equal percVec for absolute type + expect_equal(r$x, r$percVec) +}) + +test_that("relpot with type='absolute' and custom percVec", { + # Use percVec values within the model's response range to avoid NaN + parmMat <- m_dec$parmMat + low <- max(apply(parmMat, 2, m_dec$fct$lowerAs)) + up <- min(apply(parmMat, 2, m_dec$fct$upperAs)) + custom_perc <- seq(low * 1.1, up * 0.9, length.out = 20) + r <- relpot(m_dec, plotit = FALSE, type = "absolute", percVec = custom_perc) + expect_equal(r$percVec, custom_perc) + expect_length(r$y, 20) + expect_equal(r$x, custom_perc) +}) + +# ============================================================ +# relpot: monoton < 0 vs monoton > 0 (decreasing vs increasing) +# ============================================================ + +test_that("relpot handles decreasing curves (monoton < 0)", { + # m_dec has monoton < 0 + expect_true(m_dec$fct$monoton(m_dec$parmMat[, 1]) < 0) + r <- relpot(m_dec, plotit = FALSE) + expect_false(any(is.na(r$y))) +}) + +test_that("relpot handles increasing curves (monoton > 0)", { + # m_inc has monoton > 0 + expect_true(m_inc$fct$monoton(m_inc$parmMat[, 1]) > 0) + r <- relpot(m_inc, plotit = FALSE) + expect_false(any(is.na(r$y))) +}) + +# ============================================================ +# relpot: interval != "none" (confidence interval path) +# ============================================================ + +test_that("relpot with interval='delta' computes confidence bands", { + custom_perc <- seq(40, 60, by = 10) + r <- relpot(m_dec, plotit = FALSE, interval = "delta", percVec = custom_perc) + expect_type(r, "list") + expect_length(r$y, 3) + expect_false(any(is.na(r$y))) +}) + +# ============================================================ +# relpot: custom percVec with type="relative" +# ============================================================ + +test_that("relpot with custom percVec skips auto-determination", { + custom_perc <- c(30, 40, 50, 60, 70) + r <- relpot(m_dec, plotit = FALSE, percVec = custom_perc) + expect_equal(r$percVec, custom_perc) + expect_length(r$y, 5) +}) + +# ============================================================ +# relpot: plotit=TRUE tests (all plot code paths) +# ============================================================ + +test_that("relpot plots with type='relative', scale='original', interval='none'", { + pdf(NULL) + on.exit(dev.off(), add = TRUE) + r <- relpot(m_dec, plotit = TRUE, type = "relative", scale = "original") + expect_type(r, "list") +}) + +test_that("relpot plots with type='relative', scale='percent'", { + pdf(NULL) + on.exit(dev.off(), add = TRUE) + r <- relpot(m_dec, plotit = TRUE, type = "relative", scale = "percent") + expect_type(r, "list") +}) + +test_that("relpot plots with type='relative', scale='unconstrained'", { + pdf(NULL) + on.exit(dev.off(), add = TRUE) + r <- relpot(m_dec, plotit = TRUE, type = "relative", scale = "unconstrained") + expect_type(r, "list") +}) + +test_that("relpot plots with type='absolute', interval='none'", { + pdf(NULL) + on.exit(dev.off(), add = TRUE) + r <- relpot(m_dec, plotit = TRUE, type = "absolute") + expect_type(r, "list") +}) + +test_that("relpot plots with interval='delta' (confidence bands)", { + pdf(NULL) + on.exit(dev.off(), add = TRUE) + # Use auto-generated percVec for consistency + r <- relpot(m_dec, plotit = TRUE, interval = "delta") + expect_type(r, "list") +}) + +test_that("relpot plots with interval='delta', type='absolute' (no reference line)", { + pdf(NULL) + on.exit(dev.off(), add = TRUE) + r <- relpot(m_dec, plotit = TRUE, interval = "delta", type = "absolute") + expect_type(r, "list") +}) diff --git a/tests/testthat/test-repChar.R b/tests/testthat/test-repChar.R new file mode 100644 index 00000000..e806fc6d --- /dev/null +++ b/tests/testthat/test-repChar.R @@ -0,0 +1,146 @@ +# Tests for repChar (R/repChar.R) and its nested helper functions +# repChar is an internal function used in 'mixdrc' for replacing characters +# in strings and building function/formula strings. + +# ------------------------------------------------------------------- +# Tests for repChar +# ------------------------------------------------------------------- + +test_that("repChar works with basic inputs and no fixed values (NULL fixed)", { + + # When fixed is NULL, it should be replaced with rep(NA, length(names)) + # This tests the is.null(fixed) == TRUE branch + result <- drc:::repChar( + str = "b + c * DOSE", + names = c("b", "c"), + fixed = NULL, + keep = c("DOSE") + ) + + expect_true(is.list(result)) + expect_length(result, 2) + + # First element is the function string + expect_true(is.character(result[[1]])) + # Second element is the formula string + expect_true(is.character(result[[2]])) + + # Since fixed is NULL (all NA), all names should appear in argNames + expect_true(grepl("b", result[[1]])) + expect_true(grepl("c", result[[1]])) + expect_true(grepl("DOSE", result[[1]])) + + # The formula string should contain all unfixed argument names + expect_true(grepl("b,c", result[[2]])) +}) + +test_that("repChar works with some fixed values (fixed is not NULL)", { + # This tests the is.null(fixed) == FALSE branch + # and the !is.na(fixed[i]) == TRUE branch in the inner loop + + result <- drc:::repChar( + str = "b + c * DOSE", + names = c("b", "c"), + fixed = c(5, NA), + keep = c("DOSE") + ) + + expect_true(is.list(result)) + expect_length(result, 2) + + # "b" should be replaced by its fixed value "5" in the body string + expect_true(grepl("5", result[[1]])) + # "c" is unfixed (NA), so it should remain in the function string + expect_true(grepl("c", result[[1]])) + # DOSE should be preserved (kept) + expect_true(grepl("DOSE", result[[1]])) + + # The formula string should only contain unfixed argument names + # Only "c" is unfixed + expect_true(grepl("c", result[[2]])) +}) + +test_that("repChar works when all values are fixed", { + # All names are fixed, no unfixed names should appear in argNames + result <- drc:::repChar( + str = "b + c * DOSE", + names = c("b", "c"), + fixed = c(5, 10), + keep = c("DOSE") + ) + + expect_true(is.list(result)) + expect_length(result, 2) + + # Both b and c should be substituted with their fixed values + expect_true(grepl("5", result[[1]])) + expect_true(grepl("10", result[[1]])) + # DOSE should be preserved + expect_true(grepl("DOSE", result[[1]])) +}) + +test_that("repChar handles multiple keep patterns", { + # Tests that the for-loop over keep works with multiple elements + # The sep parameter defaults to c(",", ";") so two keep patterns use "," and ";" + result <- drc:::repChar( + str = "b * DOSE + c * CONC", + names = c("b", "c"), + fixed = c(NA, 3), + keep = c("DOSE", "CONC") + ) + + expect_true(is.list(result)) + expect_length(result, 2) + + # "c" should be replaced by "3" + expect_true(grepl("3", result[[1]])) + # "b" should remain (unfixed) + expect_true(grepl("b", result[[1]])) + # Both DOSE and CONC should be preserved + expect_true(grepl("DOSE", result[[1]])) + expect_true(grepl("CONC", result[[1]])) +}) + +test_that("repChar builds correct function header string", { + result <- drc:::repChar( + str = "b + c * DOSE", + names = c("b", "c"), + fixed = c(NA, NA), + keep = c("DOSE") + ) + + # The function string should have the form: + # "function(DOSE, b,c){( b + c * DOSE ^lambda - 1)/lambda}" + expect_true(grepl("function\\(DOSE,", result[[1]])) + expect_true(grepl("lambda", result[[1]])) +}) + +test_that("repChar builds correct formula string", { + result <- drc:::repChar( + str = "b + c * DOSE", + names = c("b", "c"), + fixed = c(NA, NA), + keep = c("DOSE") + ) + + # The formula string should have the form: + # "formula(respVar ~ opfct(doseVar, b,c))" + expect_true(grepl("formula\\(respVar", result[[2]])) + expect_true(grepl("opfct\\(doseVar,", result[[2]])) + expect_true(grepl("b,c", result[[2]])) +}) + +test_that("repChar with single name and single keep", { + result <- drc:::repChar( + str = "a * DOSE", + names = c("a"), + fixed = c(NA), + keep = c("DOSE") + ) + + expect_true(is.list(result)) + expect_length(result, 2) + expect_true(grepl("a", result[[1]])) + expect_true(grepl("DOSE", result[[1]])) + expect_true(grepl("a", result[[2]])) +}) diff --git a/tests/testthat/test-rss.R b/tests/testthat/test-rss.R new file mode 100644 index 00000000..f531102b --- /dev/null +++ b/tests/testthat/test-rss.R @@ -0,0 +1,187 @@ +# Tests for rss() +# Residual Sum of Squares for dose-response models + +# ============================================================================= +# Test Data Setup +# ============================================================================= + +# Standard continuous data (ryegrass-like) +ryegrass_test <- data.frame( + rootl = c( + 7.58, 8.00, 8.33, 7.25, 7.17, 7.00, 7.17, 7.83, 7.92, 7.58, + 6.17, 5.75, 5.83, 6.00, 5.83, 4.92, 4.50, 4.17, 4.42, 4.00, + 2.67, 2.08, 2.42, 2.50, 2.25, 1.17, 0.75, 0.92, 1.00, 0.58 + ), + conc = c( + rep(0, 5), rep(0.94, 5), rep(1.88, 5), + rep(3.75, 5), rep(7.50, 5), rep(15, 5) + ) +) + +# Multi-curve data +set.seed(42) +multi_data_test <- data.frame( + dose = rep(c(0, 0.5, 1, 2, 5, 10), each = 5, times = 2), + resp = c( + rnorm(5, 100, 5), rnorm(5, 95, 5), rnorm(5, 85, 5), + rnorm(5, 60, 5), rnorm(5, 20, 5), rnorm(5, 5, 5), + rnorm(5, 100, 5), rnorm(5, 90, 5), rnorm(5, 70, 5), + rnorm(5, 40, 5), rnorm(5, 10, 5), rnorm(5, 3, 5) + ), + group = rep(c("A", "B"), each = 30) +) + +# ============================================================================= +# Tests for rss() +# ============================================================================= + +# --- Single curve model --- + +test_that("rss returns correct structure for single-curve model", { + m1 <- drm(rootl ~ conc, data = ryegrass_test, fct = LL.4()) + result <- rss(m1) + + expect_true(is.matrix(result)) + expect_equal(nrow(result), 1) + expect_equal(ncol(result), 1) + expect_equal(colnames(result), "") + expect_equal(rownames(result), "") +}) + +test_that("rss value matches manual calculation for single-curve model", { + m1 <- drm(rootl ~ conc, data = ryegrass_test, fct = LL.4()) + result <- rss(m1) + + expected_rss <- sum(residuals(m1)^2) + expect_equal(as.numeric(result), expected_rss, tolerance = 1e-10) +}) + +test_that("rss returns value invisibly", { + m1 <- drm(rootl ~ conc, data = ryegrass_test, fct = LL.4()) + output <- capture.output(result <- rss(m1)) + + expect_true(is.matrix(result)) + expect_true(length(output) > 0) +}) + +test_that("rss prints header for single-curve model", { + m1 <- drm(rootl ~ conc, data = ryegrass_test, fct = LL.4()) + output <- capture.output(rss(m1)) + + expect_true(any(grepl("Residual sum of squares", output))) +}) + +test_that("rss value is non-negative", { + m1 <- drm(rootl ~ conc, data = ryegrass_test, fct = LL.4()) + result <- rss(m1) + + expect_true(as.numeric(result) >= 0) +}) + +# --- Multi-curve model --- + +test_that("rss returns correct structure for multi-curve model", { + m2 <- drm(resp ~ dose, curveid = group, data = multi_data_test, fct = LL.4()) + result <- rss(m2) + + expect_true(is.matrix(result)) + expect_equal(nrow(result), 3) # 2 curves + total + expect_equal(ncol(result), 1) + expect_equal(rownames(result), c("A", "B", "Total")) +}) + +test_that("rss total equals sum of per-curve values for multi-curve model", { + m2 <- drm(resp ~ dose, curveid = group, data = multi_data_test, fct = LL.4()) + result <- rss(m2) + + per_curve_sum <- sum(result[1:2, 1]) + total <- result[3, 1] + expect_equal(per_curve_sum, total, tolerance = 1e-10) +}) + +test_that("rss prints header for multi-curve model", { + m2 <- drm(resp ~ dose, curveid = group, data = multi_data_test, fct = LL.4()) + output <- capture.output(rss(m2)) + + expect_true(any(grepl("Residual sums of squares", output))) +}) + +test_that("rss per-curve values match manual calculation", { + m2 <- drm(resp ~ dose, curveid = group, data = multi_data_test, fct = LL.4()) + result <- rss(m2) + + resids <- residuals(m2) + curve <- m2$data[, 4] + expected_rss <- tapply(resids^2, curve, sum) + + expect_equal(as.numeric(result[1:2, 1]), as.numeric(expected_rss), tolerance = 1e-10) +}) + +# --- Consistency with Rsq --- + +test_that("rss is consistent with the numerator in Rsq calculation", { + m1 <- drm(rootl ~ conc, data = ryegrass_test, fct = LL.4()) + rss_val <- as.numeric(rss(m1)) + + # RSS should equal sum of squared residuals (used in R² = 1 - RSS/TSS) + expected <- sum(residuals(m1)^2) + expect_equal(rss_val, expected, tolerance = 1e-10) +}) + +test_that("Rsq uses rss internally and produces correct R-squared", { + m1 <- drm(rootl ~ conc, data = ryegrass_test, fct = LL.4()) + rss_val <- as.numeric(rss(m1)) + rsq_val <- as.numeric(Rsq(m1)) + + response <- ryegrass_test$rootl + tss <- sum((response - mean(response))^2) + expected_rsq <- 1 - rss_val / tss + + expect_equal(rsq_val, expected_rsq, tolerance = 1e-10) +}) + +# --- print parameter --- + +test_that("rss suppresses output when print = FALSE", { + m1 <- drm(rootl ~ conc, data = ryegrass_test, fct = LL.4()) + output <- capture.output(result <- rss(m1, print = FALSE)) + + expect_true(is.matrix(result)) + expect_equal(length(output), 0) +}) + +test_that("rss with print = FALSE returns same values as print = TRUE", { + m1 <- drm(rootl ~ conc, data = ryegrass_test, fct = LL.4()) + r1 <- rss(m1, print = FALSE) + capture.output(r2 <- rss(m1, print = TRUE)) + + expect_equal(r1, r2) +}) + +# --- Different model types --- + +test_that("rss works with LL.3 model", { + m3 <- drm(rootl ~ conc, data = ryegrass_test, fct = LL.3()) + result <- rss(m3) + + expect_true(is.matrix(result)) + expect_true(as.numeric(result) >= 0) + expect_equal(as.numeric(result), sum(residuals(m3)^2), tolerance = 1e-10) +}) + +test_that("rss works with W1.4 model", { + m_w <- drm(rootl ~ conc, data = ryegrass_test, fct = W1.4()) + result <- rss(m_w) + + expect_true(is.matrix(result)) + expect_true(as.numeric(result) >= 0) + expect_equal(as.numeric(result), sum(residuals(m_w)^2), tolerance = 1e-10) +}) + +test_that("rss is consistent across repeated calls", { + m1 <- drm(rootl ~ conc, data = ryegrass_test, fct = LL.4()) + r1 <- rss(m1) + r2 <- rss(m1) + + expect_equal(r1, r2) +}) diff --git a/tests/testthat/test-sandwich.R b/tests/testthat/test-sandwich.R new file mode 100644 index 00000000..efbad122 --- /dev/null +++ b/tests/testthat/test-sandwich.R @@ -0,0 +1,284 @@ +# Tests for estfun.drc() and bread.drc() from R/sandwich.R + +# ============================================================================ +# Setup: Create test data and models for different types +# ============================================================================ + +# --- Continuous type (single curve) --- +test_that("estfun.drc works for continuous type (single curve)", { + data(ryegrass) + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + ef <- estfun.drc(m1) + + # Should return a matrix + expect_true(is.matrix(ef)) + + # Number of rows should match number of observations + expect_equal(nrow(ef), nrow(ryegrass)) + + # Number of columns should match number of parameters + expect_equal(ncol(ef), length(coef(m1))) + + # Column names should match coefficient names + expect_equal(colnames(ef), names(coef(m1))) + + # Values should be numeric and finite + expect_true(all(is.finite(ef))) +}) + +# --- Continuous type (multi-curve) --- +test_that("estfun.drc works for continuous type (multi-curve)", { + data(ryegrass) + # Create multi-curve data + multi_data <- data.frame( + resp = c(ryegrass$rootl, ryegrass$rootl * 0.8), + dose = c(ryegrass$conc, ryegrass$conc), + group = factor(rep(c("A", "B"), each = nrow(ryegrass))) + ) + m2 <- drm(resp ~ dose, curveid = group, data = multi_data, fct = LL.4()) + + ef <- estfun.drc(m2) + + expect_true(is.matrix(ef)) + expect_equal(nrow(ef), nrow(multi_data)) + expect_equal(ncol(ef), length(coef(m2))) + expect_equal(colnames(ef), names(coef(m2))) +}) + +# --- Binomial type --- +test_that("estfun.drc works for binomial type", { + data(selenium) + m3 <- drm(dead / total ~ conc, weights = total, data = selenium, + fct = LL.2(), type = "binomial") + + ef <- estfun.drc(m3) + + expect_true(is.matrix(ef)) + expect_equal(nrow(ef), nrow(selenium)) + expect_equal(ncol(ef), length(coef(m3))) + expect_equal(colnames(ef), names(coef(m3))) +}) + +# --- Poisson type --- +test_that("estfun.drc works for Poisson type", { + # Create Poisson-distributed data + set.seed(42) + poisson_data <- data.frame( + dose = rep(c(0, 0.1, 0.5, 1, 2, 5, 10), each = 3), + count = c(rpois(3, 20), rpois(3, 18), rpois(3, 15), + rpois(3, 10), rpois(3, 5), rpois(3, 2), rpois(3, 1)) + ) + m4 <- drm(count ~ dose, data = poisson_data, fct = LL.4(), type = "Poisson") + + ef <- estfun.drc(m4) + + expect_true(is.matrix(ef)) + expect_equal(nrow(ef), nrow(poisson_data)) + expect_equal(ncol(ef), length(coef(m4))) + expect_equal(colnames(ef), names(coef(m4))) +}) + +# --- Binomial type (multi-curve, tests is.matrix(indexMat0) == TRUE branch) --- +test_that("estfun.drc works for binomial type (multi-curve)", { + data(selenium) + multi_binom <- data.frame( + dead = c(selenium$dead, selenium$dead), + total = c(selenium$total, selenium$total), + conc = c(selenium$conc, selenium$conc), + group = factor(rep(c("A", "B"), each = nrow(selenium))) + ) + m5 <- drm(dead / total ~ conc, curveid = group, weights = total, + data = multi_binom, fct = LL.2(), type = "binomial") + + ef <- estfun.drc(m5) + + expect_true(is.matrix(ef)) + expect_equal(nrow(ef), nrow(multi_binom)) + expect_equal(ncol(ef), length(coef(m5))) + expect_equal(colnames(ef), names(coef(m5))) +}) + +# --- Poisson type (multi-curve) --- +test_that("estfun.drc works for Poisson type (multi-curve)", { + set.seed(42) + poisson_data_mc <- data.frame( + dose = rep(rep(c(0, 0.5, 1, 5, 10), each = 3), 2), + count = c(rpois(15, c(rep(20, 3), rep(10, 3), rep(5, 3), rep(2, 3), rep(1, 3))), + rpois(15, c(rep(15, 3), rep(8, 3), rep(4, 3), rep(2, 3), rep(1, 3)))), + group = factor(rep(c("A", "B"), each = 15)) + ) + m6 <- drm(count ~ dose, curveid = group, data = poisson_data_mc, + fct = LL.4(), type = "Poisson") + + ef <- estfun.drc(m6) + + expect_true(is.matrix(ef)) + expect_equal(nrow(ef), nrow(poisson_data_mc)) + expect_equal(ncol(ef), length(coef(m6))) + expect_equal(colnames(ef), names(coef(m6))) +}) + +# ============================================================================ +# bread.drc tests +# ============================================================================ + +test_that("bread.drc works for continuous type", { + data(ryegrass) + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + br <- bread.drc(m1) + + # Should return a matrix + expect_true(is.matrix(br)) + + # Should be square with dimension = number of parameters + np <- length(coef(m1)) + expect_equal(dim(br), c(np, np)) + + # Should be finite + expect_true(all(is.finite(br))) +}) + +test_that("bread.drc works for binomial type (non-continuous path)", { + data(selenium) + m3 <- drm(dead / total ~ conc, weights = total, data = selenium, + fct = LL.2(), type = "binomial") + + br <- bread.drc(m3) + + expect_true(is.matrix(br)) + np <- length(coef(m3)) + expect_equal(dim(br), c(np, np)) + expect_true(all(is.finite(br))) +}) + +test_that("bread.drc works for Poisson type (non-continuous path)", { + set.seed(42) + poisson_data <- data.frame( + dose = rep(c(0, 0.1, 0.5, 1, 2, 5, 10), each = 3), + count = c(rpois(3, 20), rpois(3, 18), rpois(3, 15), + rpois(3, 10), rpois(3, 5), rpois(3, 2), rpois(3, 1)) + ) + m4 <- drm(count ~ dose, data = poisson_data, fct = LL.4(), type = "Poisson") + + br <- bread.drc(m4) + + expect_true(is.matrix(br)) + np <- length(coef(m4)) + expect_equal(dim(br), c(np, np)) +}) + +# ============================================================================ +# Integration: bread and estfun work together +# ============================================================================ + +test_that("bread and estfun are consistent for continuous model", { + data(ryegrass) + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + ef <- estfun.drc(m1) + br <- bread.drc(m1) + + # Both should have compatible dimensions + expect_equal(ncol(ef), nrow(br)) + expect_equal(ncol(ef), ncol(br)) +}) + +test_that("bread and estfun are consistent for binomial model", { + data(selenium) + m3 <- drm(dead / total ~ conc, weights = total, data = selenium, + fct = LL.2(), type = "binomial") + + ef <- estfun.drc(m3) + br <- bread.drc(m3) + + expect_equal(ncol(ef), nrow(br)) + expect_equal(ncol(ef), ncol(br)) +}) + +# ============================================================================ +# Edge case: single curve with indexMat0 not being a matrix (vector branch) +# ============================================================================ + +test_that("estfun.drc handles non-matrix indexMat0 (single curve)", { + data(ryegrass) + # Single curve model - indexMat2 may be a vector + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Verify indexMat2 structure for single curve + # This should exercise the is.matrix() == FALSE branch + ef <- estfun.drc(m1) + expect_true(is.matrix(ef)) + expect_equal(ncol(ef), length(coef(m1))) +}) + +# ============================================================================ +# Event type +# ============================================================================ + +test_that("estfun.drc works for event type (single curve)", { + data(chickweed) + m_event <- drm(count ~ start + end, data = chickweed, fct = LL.3(), type = "event") + + ef <- estfun.drc(m_event) + + expect_true(is.matrix(ef)) + expect_equal(nrow(ef), nrow(m_event$data)) + expect_equal(ncol(ef), length(coef(m_event))) + expect_equal(colnames(ef), names(coef(m_event))) +}) + +test_that("estfun.drc works for event type (multi-curve)", { + data(germination) + germ_sub <- germination[germination$species == "wheat" & + germination$temp %in% c(10, 22), ] + m_event_mc <- drm(germinated ~ start + end, factor(temp), + data = germ_sub, fct = LL.3(), type = "event") + + ef <- estfun.drc(m_event_mc) + + expect_true(is.matrix(ef)) + expect_equal(nrow(ef), nrow(m_event_mc$data)) + expect_equal(ncol(ef), length(coef(m_event_mc))) + expect_equal(colnames(ef), names(coef(m_event_mc))) +}) + +test_that("bread.drc works for event type (non-continuous path)", { + data(chickweed) + m_event <- drm(count ~ start + end, data = chickweed, fct = LL.3(), type = "event") + + br <- bread.drc(m_event) + + expect_true(is.matrix(br)) + np <- length(coef(m_event)) + expect_equal(dim(br), c(np, np)) +}) + +# ============================================================================ +# Correctness checks +# ============================================================================ + +test_that("estfun.drc returns correct values structure for continuous", { + data(ryegrass) + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + ef <- estfun.drc(m1) + + # Sum of estimating functions should be close to zero at MLE + col_sums <- colSums(ef) + expect_true(all(is.numeric(col_sums))) + expect_true(all(abs(col_sums) < 1)) +}) + +test_that("bread.drc is consistent with vcov for continuous", { + data(ryegrass) + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + br <- bread.drc(m1) + vc <- vcov(m1) + + # Both should be square matrices of same size + + expect_equal(dim(br), dim(vc)) +}) diff --git a/tests/testthat/test-searchdrc.R b/tests/testthat/test-searchdrc.R new file mode 100644 index 00000000..9f889e2e --- /dev/null +++ b/tests/testthat/test-searchdrc.R @@ -0,0 +1,204 @@ +# Tests for searchdrc function + +# ---------- Helper: create a valid drc model for reuse ---------- +local_model <- function() { + drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +} + +# ================================================================ +# 1. Happy-path / Correctness tests +# ================================================================ + +test_that("searchdrc returns a drc object when convergence is achieved", { + m1 <- local_model() + result <- searchdrc(m1, which = "b", range = c(0.1, 10)) + expect_s3_class(result, "drc") +}) + +test_that("searchdrc respects len parameter", { + m1 <- local_model() + result <- searchdrc(m1, which = "e", range = c(1, 10), len = 5) + expect_s3_class(result, "drc") +}) + +test_that("searchdrc works with different model specifications", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) + result <- searchdrc(m1, which = "e", range = c(1, 10)) + expect_s3_class(result, "drc") +}) + +# ================================================================ +# 2. Verbose output tests +# ================================================================ + +test_that("searchdrc prints attempt messages when verbose = TRUE", { + m1 <- local_model() + expect_message( + searchdrc(m1, which = "b", range = c(0.1, 10), len = 3, verbose = TRUE), + "\\[searchdrc\\] Attempt" + ) +}) + +test_that("searchdrc prints convergence message when verbose = TRUE", { + m1 <- local_model() + expect_message( + searchdrc(m1, which = "b", range = c(0.1, 10), len = 3, verbose = TRUE), + "Convergence achieved" + ) +}) + +# ================================================================ +# 3. Input validation error tests +# ================================================================ + +test_that("searchdrc errors when object is not class 'drc'", { + expect_error( + searchdrc(object = list(a = 1), which = "b", range = c(1, 10)), + "'object' must be of class 'drc'" + ) + expect_error( + searchdrc(object = "not_a_model", which = "b", range = c(1, 10)), + "'object' must be of class 'drc'" + ) +}) + +test_that("searchdrc errors when object has no $start", { + m1 <- local_model() + m1$start <- NULL + expect_error( + searchdrc(m1, which = "b", range = c(1, 10)), + "\\$start.*\\$parNames" + ) +}) + +test_that("searchdrc errors when object has no $parNames", { + m1 <- local_model() + m1$parNames <- NULL + expect_error( + searchdrc(m1, which = "b", range = c(1, 10)), + "\\$start.*\\$parNames" + ) +}) + +test_that("searchdrc errors when 'which' is not a single non-empty string", { + m1 <- local_model() + # Not a character + expect_error( + searchdrc(m1, which = 42, range = c(1, 10)), + "'which' must be a single non-empty character string" + ) + # Length > 1 + expect_error( + searchdrc(m1, which = c("b", "c"), range = c(1, 10)), + "'which' must be a single non-empty character string" + ) + # Empty string + expect_error( + searchdrc(m1, which = "", range = c(1, 10)), + "'which' must be a single non-empty character string" + ) + # Whitespace-only + expect_error( + searchdrc(m1, which = " ", range = c(1, 10)), + "'which' must be a single non-empty character string" + ) +}) + +test_that("searchdrc errors when 'range' is not numeric or not length 2", { + m1 <- local_model() + # Not numeric + expect_error( + searchdrc(m1, which = "b", range = c("a", "b")), + "'range' must be a numeric vector of exactly length 2" + ) + # Length 1 + expect_error( + searchdrc(m1, which = "b", range = 5), + "'range' must be a numeric vector of exactly length 2" + ) + # Length 3 + expect_error( + searchdrc(m1, which = "b", range = c(1, 2, 3)), + "'range' must be a numeric vector of exactly length 2" + ) +}) + +test_that("searchdrc errors when range endpoints are equal", { + m1 <- local_model() + expect_error( + searchdrc(m1, which = "b", range = c(5, 5)), + "two endpoints of 'range' must be different" + ) +}) + +test_that("searchdrc errors when 'len' is invalid", { + m1 <- local_model() + # Not numeric + expect_error( + searchdrc(m1, which = "b", range = c(1, 10), len = "ten"), + "'len' must be a single numeric value of at least 2" + ) + # Less than 2 + expect_error( + searchdrc(m1, which = "b", range = c(1, 10), len = 1), + "'len' must be a single numeric value of at least 2" + ) + # Length > 1 + expect_error( + searchdrc(m1, which = "b", range = c(1, 10), len = c(5, 10)), + "'len' must be a single numeric value of at least 2" + ) +}) + +test_that("searchdrc errors when 'verbose' is invalid", { + m1 <- local_model() + # Not logical + expect_error( + searchdrc(m1, which = "b", range = c(1, 10), verbose = "yes"), + "'verbose' must be a single logical value" + ) + # Length > 1 + expect_error( + searchdrc(m1, which = "b", range = c(1, 10), verbose = c(TRUE, FALSE)), + "'verbose' must be a single logical value" + ) +}) + +# ================================================================ +# 4. Parameter matching tests +# ================================================================ + +test_that("searchdrc errors when parameter name is not found", { + m1 <- local_model() + expect_error( + searchdrc(m1, which = "nonexistent", range = c(0.1, 10)), + "No such parameter" + ) +}) + +test_that("searchdrc warns when multiple parameters match", { + m1 <- local_model() + # Duplicate the "b" parameter entry so two indices match "^b(:|$)" + m1$parNames[[2]] <- c("b", "b", "c", "d") + m1$start <- rep(m1$start[1], 4) # match length + expect_warning( + searchdrc(m1, which = "b", range = c(0.1, 10), len = 3), + "Multiple parameters matched" + ) +}) + +# ================================================================ +# 5. Convergence failure test +# ================================================================ + +test_that("searchdrc warns when convergence fails across all attempts", { + m1 <- local_model() + # Force convergence failure by corrupting the model call + m1$call$fct <- quote(LL.2()) + + expect_warning( + result <- searchdrc(m1, which = "b", range = c(1e10, 1e11), len = 2), + "Convergence failed" + ) + expect_null(result) +}) diff --git a/tests/testthat/test-siInner.R b/tests/testthat/test-siInner.R new file mode 100644 index 00000000..636dbb53 --- /dev/null +++ b/tests/testthat/test-siInner.R @@ -0,0 +1,344 @@ +# Tests for siInner (R/siInner.R) and fieller (R/EDcomp.R) +# These are internal functions used by EDcomp for selectivity index calculations + +# Helper: create a minimal mock sifct function +# Returns a list with $val, $der (and optionally $der1, $der2, $valnum, $valden for fieller) +make_sifct <- function(val = 2.0, der = c(0.1, -0.05, 0.2, -0.1), + der1 = NULL, der2 = NULL, + valnum = NULL, valden = NULL) { + function(parm1, parm2, pVec, jInd, kInd, reference, type) { + list(val = val, der = der, + der1 = der1, der2 = der2, + valnum = valnum, valden = valden) + } +} + +# Helper: create basic test inputs for siInner +make_test_inputs <- function(interval = "none", obj_type = "continuous", + logBase = NULL, level = 0.95, degfree = 10) { + npar <- 4 + ncurves <- 2 + # indexMat: maps parameters to positions + + indexMat <- matrix(1:(npar * ncurves), nrow = npar, ncol = ncurves) + # parmMat: parameter estimates for each curve + parmMat <- matrix(c(1, 2, 3, 4, 5, 6, 7, 8), nrow = npar, ncol = ncurves) + # varMat: variance-covariance matrix (must match der length = npar * ncurves) + ncoef <- npar * ncurves + set.seed(42) + A <- matrix(rnorm(ncoef^2), ncoef, ncoef) + varMat <- A %*% t(A) + diag(ncoef) # positive definite + + list( + indPair = c(1, 2), + pVec = c(50, 50), + compMatch = NULL, + object = list(type = obj_type), + indexMat = indexMat, + parmMat = parmMat, + varMat = varMat, + level = level, + reference = "control", + type = "relative", + sifct = make_sifct(val = 2.0, der = rep(0.1, ncoef)), + interval = interval, + degfree = degfree, + logBase = logBase + ) +} + +# ------------------------------------------------------------------- +# Tests for siInner +# ------------------------------------------------------------------- + +test_that("siInner works with interval='none' and continuous data", { + inputs <- make_test_inputs(interval = "none", obj_type = "continuous") + result <- drc:::siInner( + indPair = inputs$indPair, pVec = inputs$pVec, + compMatch = inputs$compMatch, object = inputs$object, + indexMat = inputs$indexMat, parmMat = inputs$parmMat, + varMat = inputs$varMat, level = inputs$level, + reference = inputs$reference, type = inputs$type, + sifct = inputs$sifct, interval = inputs$interval, + degfree = inputs$degfree, logBase = inputs$logBase + ) + # Result should be a numeric vector: c(siMatRow[1:4], dSIval) + expect_true(is.numeric(result)) + ncoef <- nrow(inputs$indexMat) * ncol(inputs$indexMat) + expect_length(result, 4 + ncoef) + + # First element is SIval = 2.0 + + expect_equal(result[1], 2.0) + + # Second element is standard error + expect_true(result[2] > 0) + + # Third element is t-statistic = (SI - 1) / SE + expect_equal(result[3], (result[1] - 1) / result[2]) + + # Fourth element is p-value (two-sided, t-distribution) + tstat <- result[3] + expected_p <- pt(-abs(tstat), inputs$degfree) + (1 - pt(abs(tstat), inputs$degfree)) + expect_equal(result[4], expected_p) +}) + +test_that("siInner works with interval='none' and non-continuous data (normal dist)", { + inputs <- make_test_inputs(interval = "none", obj_type = "binomial") + result <- drc:::siInner( + indPair = inputs$indPair, pVec = inputs$pVec, + compMatch = inputs$compMatch, object = inputs$object, + indexMat = inputs$indexMat, parmMat = inputs$parmMat, + varMat = inputs$varMat, level = inputs$level, + reference = inputs$reference, type = inputs$type, + sifct = inputs$sifct, interval = inputs$interval, + degfree = inputs$degfree, logBase = inputs$logBase + ) + expect_true(is.numeric(result)) + expect_equal(result[1], 2.0) + + # For non-continuous, uses pnorm instead of pt + tstat <- result[3] + expected_p <- pnorm(-abs(tstat)) + (1 - pnorm(abs(tstat))) + expect_equal(result[4], expected_p) +}) + +test_that("siInner works with interval='delta' and continuous data", { + inputs <- make_test_inputs(interval = "delta", obj_type = "continuous") + result <- drc:::siInner( + indPair = inputs$indPair, pVec = inputs$pVec, + compMatch = inputs$compMatch, object = inputs$object, + indexMat = inputs$indexMat, parmMat = inputs$parmMat, + varMat = inputs$varMat, level = inputs$level, + reference = inputs$reference, type = inputs$type, + sifct = inputs$sifct, interval = inputs$interval, + degfree = inputs$degfree, logBase = inputs$logBase + ) + expect_true(is.numeric(result)) + expect_equal(result[1], 2.0) + + # Slots 2 and 3 are lower and upper CI bounds (delta method) + # Lower bound < SIval < Upper bound + expect_true(result[2] < result[1]) + expect_true(result[3] > result[1]) + # Slot 4 is NA (not set for delta) + expect_true(is.na(result[4])) +}) + +test_that("siInner works with interval='delta' and non-continuous data", { + inputs <- make_test_inputs(interval = "delta", obj_type = "binomial") + result <- drc:::siInner( + indPair = inputs$indPair, pVec = inputs$pVec, + compMatch = inputs$compMatch, object = inputs$object, + indexMat = inputs$indexMat, parmMat = inputs$parmMat, + varMat = inputs$varMat, level = inputs$level, + reference = inputs$reference, type = inputs$type, + sifct = inputs$sifct, interval = inputs$interval, + degfree = inputs$degfree, logBase = inputs$logBase + ) + expect_true(is.numeric(result)) + # Uses qnorm for non-continuous + tquan <- qnorm(1 - (1 - inputs$level) / 2) + expect_true(result[2] < result[1]) + expect_true(result[3] > result[1]) +}) + +test_that("siInner works with interval='fls' without logBase", { + inputs <- make_test_inputs(interval = "fls", obj_type = "continuous", logBase = NULL) + result <- drc:::siInner( + indPair = inputs$indPair, pVec = inputs$pVec, + compMatch = inputs$compMatch, object = inputs$object, + indexMat = inputs$indexMat, parmMat = inputs$parmMat, + varMat = inputs$varMat, level = inputs$level, + reference = inputs$reference, type = inputs$type, + sifct = inputs$sifct, interval = inputs$interval, + degfree = inputs$degfree, logBase = inputs$logBase + ) + expect_true(is.numeric(result)) + expect_equal(result[1], 2.0) + # Lower and upper CI computed by delta method + expect_true(result[2] < result[1]) + expect_true(result[3] > result[1]) +}) + +test_that("siInner works with interval='fls' with logBase (from log scale)", { + inputs <- make_test_inputs(interval = "fls", obj_type = "continuous", logBase = 10) + result <- drc:::siInner( + indPair = inputs$indPair, pVec = inputs$pVec, + compMatch = inputs$compMatch, object = inputs$object, + indexMat = inputs$indexMat, parmMat = inputs$parmMat, + varMat = inputs$varMat, level = inputs$level, + reference = inputs$reference, type = inputs$type, + sifct = inputs$sifct, interval = inputs$interval, + degfree = inputs$degfree, logBase = inputs$logBase + ) + expect_true(is.numeric(result)) + # With logBase=10, siMatRow values are transformed: logBase^(original) + # Original SIval = 2.0, so result[1] = 10^2 = 100 + expect_equal(result[1], 10^2) + # Lower and upper bounds are also transformed + expect_true(result[2] > 0) + expect_true(result[3] > 0) +}) + +test_that("siInner works with interval='tfls' and continuous data", { + inputs <- make_test_inputs(interval = "tfls", obj_type = "continuous") + result <- drc:::siInner( + indPair = inputs$indPair, pVec = inputs$pVec, + compMatch = inputs$compMatch, object = inputs$object, + indexMat = inputs$indexMat, parmMat = inputs$parmMat, + varMat = inputs$varMat, level = inputs$level, + reference = inputs$reference, type = inputs$type, + sifct = inputs$sifct, interval = inputs$interval, + degfree = inputs$degfree, logBase = inputs$logBase + ) + expect_true(is.numeric(result)) + expect_equal(result[1], 2.0) + # Lower and upper are exp(log(SIval) +/- tquan * lsdVal) + expect_true(result[2] > 0) + expect_true(result[3] > 0) + expect_true(result[2] < result[1]) + expect_true(result[3] > result[1]) +}) + +test_that("siInner works with interval='tfls' and non-continuous data", { + inputs <- make_test_inputs(interval = "tfls", obj_type = "binomial") + result <- drc:::siInner( + indPair = inputs$indPair, pVec = inputs$pVec, + compMatch = inputs$compMatch, object = inputs$object, + indexMat = inputs$indexMat, parmMat = inputs$parmMat, + varMat = inputs$varMat, level = inputs$level, + reference = inputs$reference, type = inputs$type, + sifct = inputs$sifct, interval = inputs$interval, + degfree = inputs$degfree, logBase = inputs$logBase + ) + expect_true(is.numeric(result)) + expect_equal(result[1], 2.0) + expect_true(result[2] > 0) + expect_true(result[3] > 0) +}) + +test_that("siInner works with interval='fieller' and continuous data", { + npar <- 4 + ncurves <- 2 + ncoef <- npar * ncurves + + # For fieller, sifct must return der1, der2, valnum, valden + sifct_fieller <- make_sifct( + val = 2.0, + der = rep(0.1, ncoef), + der1 = rep(0.05, ncoef), + der2 = rep(0.03, ncoef), + valnum = 10.0, + valden = 5.0 + ) + + inputs <- make_test_inputs(interval = "fieller", obj_type = "continuous") + inputs$sifct <- sifct_fieller + + result <- drc:::siInner( + indPair = inputs$indPair, pVec = inputs$pVec, + compMatch = inputs$compMatch, object = inputs$object, + indexMat = inputs$indexMat, parmMat = inputs$parmMat, + varMat = inputs$varMat, level = inputs$level, + reference = inputs$reference, type = inputs$type, + sifct = inputs$sifct, interval = inputs$interval, + degfree = inputs$degfree, logBase = inputs$logBase + ) + expect_true(is.numeric(result)) + expect_equal(result[1], 2.0) + # Fieller CI: slots 2 and 3 + expect_false(is.na(result[2])) + expect_false(is.na(result[3])) +}) + +test_that("siInner works with interval='fieller' and non-continuous data", { + npar <- 4 + ncurves <- 2 + ncoef <- npar * ncurves + + sifct_fieller <- make_sifct( + val = 2.0, + der = rep(0.1, ncoef), + der1 = rep(0.05, ncoef), + der2 = rep(0.03, ncoef), + valnum = 10.0, + valden = 5.0 + ) + + inputs <- make_test_inputs(interval = "fieller", obj_type = "binomial") + inputs$sifct <- sifct_fieller + + result <- drc:::siInner( + indPair = inputs$indPair, pVec = inputs$pVec, + compMatch = inputs$compMatch, object = inputs$object, + indexMat = inputs$indexMat, parmMat = inputs$parmMat, + varMat = inputs$varMat, level = inputs$level, + reference = inputs$reference, type = inputs$type, + sifct = inputs$sifct, interval = inputs$interval, + degfree = inputs$degfree, logBase = inputs$logBase + ) + expect_true(is.numeric(result)) + expect_equal(result[1], 2.0) + # Fieller CI: slots 2 and 3 + expect_false(is.na(result[2])) + expect_false(is.na(result[3])) +}) + +test_that("siInner return vector has correct structure", { + inputs <- make_test_inputs(interval = "none", obj_type = "continuous") + result <- drc:::siInner( + indPair = inputs$indPair, pVec = inputs$pVec, + compMatch = inputs$compMatch, object = inputs$object, + indexMat = inputs$indexMat, parmMat = inputs$parmMat, + varMat = inputs$varMat, level = inputs$level, + reference = inputs$reference, type = inputs$type, + sifct = inputs$sifct, interval = inputs$interval, + degfree = inputs$degfree, logBase = inputs$logBase + ) + ncoef <- nrow(inputs$indexMat) * ncol(inputs$indexMat) + # siMatRow (4 elements) + dSIval (ncoef elements) + expect_length(result, 4 + ncoef) +}) + +# ------------------------------------------------------------------- +# Tests for fieller (helper in EDcomp.R) +# ------------------------------------------------------------------- + +test_that("fieller computes standard Fieller CI (finney=FALSE)", { + mu <- c(10, 5) # numerator and denominator + df <- 20 + vcMat <- matrix(c(1, 0.2, 0.2, 0.5), 2, 2) + + result <- drc:::fieller(mu, df, vcMat, level = 0.95) + expect_true(is.numeric(result)) + expect_length(result, 2) + # Lower < ratio < Upper + expect_true(result[1] < mu[1] / mu[2]) + expect_true(result[2] > mu[1] / mu[2]) +}) + +test_that("fieller computes Finney variant (finney=TRUE)", { + mu <- c(10, 5) + df <- 20 + vcMat <- matrix(c(1, 0.2, 0.2, 0.5), 2, 2) + resVar <- 2.0 + + result <- drc:::fieller(mu, df, vcMat, level = 0.95, finney = TRUE, resVar = resVar) + expect_true(is.numeric(result)) + expect_length(result, 2) + expect_true(result[1] < result[2]) +}) + +test_that("fieller with finney=TRUE throws error when g >= 1", { + mu <- c(10, 0.5) # small denominator + df <- 20 + # Large vcMat[2,2] relative to mu[2]^2 so g >= 1 + vcMat <- matrix(c(1, 0.2, 0.2, 50), 2, 2) + resVar <- 2.0 + + expect_error( + drc:::fieller(mu, df, vcMat, level = 0.95, finney = TRUE, resVar = resVar), + "Fieller's theorem not useful" + ) +}) diff --git a/tests/testthat/test-simDR.R b/tests/testthat/test-simDR.R new file mode 100644 index 00000000..5cd3e8c5 --- /dev/null +++ b/tests/testthat/test-simDR.R @@ -0,0 +1,145 @@ +# tests/testthat/test-simDR.R +# Comprehensive tests for simDR() in R/simDR.R + +# ============================================================================== +# Helper: fit a model and extract parameters for tests +# ============================================================================== +get_test_params <- function() { + data(ryegrass, package = "drc") + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + list( + mpar = coef(m1), + sigma = sqrt(summary(m1)$resVar), + conc = c(1.88, 3.75, 7.50, 0.94, 15, 0.47, 30, 0.23, 60) + ) +} + +# ============================================================================== +# Happy path tests +# ============================================================================== + +test_that("simDR returns correct structure with default edVec", { + p <- get_test_params() + + result <- expect_output( + simDR(p$mpar, p$sigma, LL.4(), noSim = 2, conc = p$conc, seedVal = 12345), + "Concentrations used" + ) + + # Return value is a list with element "se" + expect_type(result, "list") + expect_named(result, "se") + + # se is an array: (length(conc)-4) x 6 x length(edVec) + # Default edVec = c(10, 50) => 2 ED values + expect_equal(dim(result$se), c(5, 6, 2)) + expect_true(is.numeric(result$se)) +}) + +test_that("simDR handles single ED value in edVec", { + p <- get_test_params() + + result <- expect_output( + simDR(p$mpar, p$sigma, LL.4(), noSim = 2, conc = p$conc, + edVec = c(50), seedVal = 12345), + "ED value considered: 50" + ) + + # Single ED value => third dimension is 1 + expect_equal(dim(result$se), c(5, 6, 1)) +}) + +test_that("simDR handles three ED values in edVec", { + p <- get_test_params() + + result <- expect_output( + simDR(p$mpar, p$sigma, LL.4(), noSim = 2, conc = p$conc, + edVec = c(10, 50, 90), seedVal = 12345), + "ED value considered: 90" + ) + + expect_equal(dim(result$se), c(5, 6, 3)) +}) + +# ============================================================================== +# Output tests +# ============================================================================== + +test_that("simDR output includes concentrations and ED information", { + p <- get_test_params() + + output <- capture.output( + result <- simDR(p$mpar, p$sigma, LL.4(), noSim = 2, conc = p$conc, + edVec = c(10, 50), seedVal = 12345) + ) + + expect_true(any(grepl("Concentrations used:", output))) + expect_true(any(grepl("ED value considered: 10", output))) + expect_true(any(grepl("ED value considered: 50", output))) + expect_true(any(grepl("Conc. no.\\Replicates:", output, fixed = TRUE))) +}) + +test_that("simDR returns result invisibly", { + p <- get_test_params() + + expect_invisible( + simDR(p$mpar, p$sigma, LL.4(), noSim = 2, conc = p$conc, seedVal = 12345) + ) +}) + +# ============================================================================== +# Row/column naming tests (bug fix: dynamic rownames) +# ============================================================================== + +test_that("simDR correctly labels rows for different conc lengths", { + p <- get_test_params() + + # 9 concentrations: rows should be named 5:9 + output9 <- capture.output( + res9 <- simDR(p$mpar, p$sigma, LL.4(), noSim = 2, conc = p$conc, seedVal = 12345) + ) + mat9 <- res9$se[, , 1] + expect_equal(nrow(mat9), 5) + + # Verify row names are correctly set in the output by checking for "5" and "9" + expect_true(any(grepl("^5 ", output9))) + expect_true(any(grepl("^9 ", output9))) +}) + +# ============================================================================== +# Seed reproducibility test +# ============================================================================== + +test_that("simDR is reproducible with same seed", { + p <- get_test_params() + + output1 <- capture.output( + res1 <- simDR(p$mpar, p$sigma, LL.4(), noSim = 2, conc = p$conc, seedVal = 999) + ) + + output2 <- capture.output( + res2 <- simDR(p$mpar, p$sigma, LL.4(), noSim = 2, conc = p$conc, seedVal = 999) + ) + + expect_equal(res1$se, res2$se) +}) + +# ============================================================================== +# try-error branch test +# ============================================================================== + +test_that("simDR handles drm fitting failures gracefully", { + p <- get_test_params() + + # Use extremely large sigma to increase chance of fitting failures. + # Even if all fits succeed, the function should still run without error. + # Use very small noSim to keep test fast. + output <- capture.output( + result <- simDR(p$mpar, sigma = 1e6, LL.4(), noSim = 2, + conc = p$conc, seedVal = 42) + ) + + expect_type(result, "list") + expect_named(result, "se") + expect_equal(dim(result$se), c(5, 6, 2)) +}) diff --git a/tests/testthat/test-simFct.R b/tests/testthat/test-simFct.R new file mode 100644 index 00000000..7db3f4fa --- /dev/null +++ b/tests/testthat/test-simFct.R @@ -0,0 +1,513 @@ +# tests/testthat/test-simFct.R +# Comprehensive tests for simFct() and coverFct() in R/simFct.R + +# ============================================================================== +# Helper: access internal functions +# ============================================================================== +simFct <- drc:::simFct +coverFct <- drc:::coverFct + +# ============================================================================== +# Tests for simFct() +# ============================================================================== + +# --- Parametric + Binomial + method "p" --- +test_that("simFct parametric binomial method='p' returns correct structure", { + # Use deguelin dataset for binomial dose-response + data(deguelin, package = "drc") + m1 <- drm(r / n ~ dose, weights = n, data = deguelin, fct = LL.2(), type = "binomial") + + # Small simulation (2 sims) for speed + res <- expect_output( + simFct( + noSim = 2, + edVal = c(10, 50), + type = "parametric", + response = "bin", + fct = LL.2(), + coefVec = coef(m1), + method = "p", + doseVec = deguelin$dose, + nVec = deguelin$n, + pfct = LL.2() + ) + ) + + expect_type(res, "list") + expect_named(res, c("edArray", "mixVec", "edVal", "aicVec", "spanVec")) + expect_equal(dim(res$edArray), c(2, 3, 2)) + expect_equal(length(res$mixVec), 2) + expect_equal(res$edVal, c(10, 50)) + expect_equal(length(res$aicVec), 2) + expect_equal(length(res$spanVec), 2) + # For method "p", mixVec should be 0 (purely parametric) + expect_true(all(res$mixVec == 0, na.rm = TRUE)) +}) + +# --- Parametric + Continuous + method "p" --- +test_that("simFct parametric continuous method='p' returns correct structure", { + data(ryegrass, package = "drc") + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + res <- expect_output( + simFct( + noSim = 2, + edVal = c(50), + type = "parametric", + response = "con", + fct = LL.4(), + coefVec = coef(m1), + method = "p", + doseVec = sort(unique(ryegrass$conc)), + resVar = summary(m1)$resVar, + pfct = LL.4() + ) + ) + + expect_type(res, "list") + expect_equal(dim(res$edArray)[1], 1) + expect_equal(dim(res$edArray)[3], 2) + expect_equal(res$edVal, 50) +}) + +# --- Non-parametric + Binomial + method "p" --- +test_that("simFct non-parametric binomial method='p' returns correct structure", { + doseVec <- c(0, 1, 2, 5, 10, 20, 50) + nVec <- rep(20, 7) + pVec <- c(0.01, 0.05, 0.15, 0.4, 0.7, 0.9, 0.99) + + res <- expect_output( + simFct( + noSim = 2, + edVal = c(50), + type = "non-parametric", + response = "bin", + method = "p", + doseVec = doseVec, + nVec = nVec, + pVec = pVec, + pfct = LL.2() + ) + ) + + expect_type(res, "list") + expect_equal(dim(res$edArray), c(1, 3, 2)) +}) + +# --- Non-parametric + Continuous + method "p" --- +test_that("simFct non-parametric continuous method='p' returns correct structure", { + doseVec <- c(0, 1, 2, 5, 10, 20, 50) + pVec <- c(7, 6.5, 5.5, 4, 2.5, 1.5, 0.5) + + res <- expect_output( + simFct( + noSim = 2, + edVal = c(50), + type = "non-parametric", + response = "con", + method = "p", + doseVec = doseVec, + pVec = pVec, + resVar = 0.5, + pfct = LL.4() + ) + ) + + expect_type(res, "list") + expect_equal(dim(res$edArray), c(1, 3, 2)) +}) + +# --- Semi-parametric method "sp" with span provided --- +test_that("simFct parametric continuous method='sp' with span works", { + data(ryegrass, package = "drc") + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # method "sp" requires semi-parametric (loess + parametric) + # Using a fixed span to avoid GCV + res <- expect_output( + simFct( + noSim = 2, + edVal = c(50), + type = "parametric", + response = "con", + fct = LL.4(), + coefVec = coef(m1), + method = "sp", + doseVec = sort(unique(ryegrass$conc)), + resVar = summary(m1)$resVar, + pfct = LL.4(), + span = 0.75 + ) + ) + + expect_type(res, "list") + expect_equal(dim(res$edArray), c(1, 3, 2)) + # spanVec should all be 0.75 + expect_equal(res$spanVec, rep(0.75, 2)) +}) + +# --- Semi-parametric method "sp" with span=NA triggers GCV --- +test_that("simFct parametric continuous method='sp' with span=NA triggers GCV", { + data(ryegrass, package = "drc") + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + res <- expect_output( + simFct( + noSim = 2, + edVal = c(50), + type = "parametric", + response = "con", + fct = LL.4(), + coefVec = coef(m1), + method = "sp", + doseVec = sort(unique(ryegrass$conc)), + resVar = summary(m1)$resVar, + pfct = LL.4(), + span = NA + ) + ) + + expect_type(res, "list") + # spanVec should NOT be NA (GCV should have found values) + expect_true(all(!is.na(res$spanVec))) +}) + +# --- Semi-parametric method "sp" with binomial --- +test_that("simFct parametric binomial method='sp' works", { + data(deguelin, package = "drc") + m1 <- drm(r / n ~ dose, weights = n, data = deguelin, fct = LL.2(), type = "binomial") + + res <- expect_output( + simFct( + noSim = 2, + edVal = c(50), + type = "parametric", + response = "bin", + fct = LL.2(), + coefVec = coef(m1), + method = "sp", + doseVec = deguelin$dose, + nVec = deguelin$n, + pfct = LL.2(), + span = 0.75 + ) + ) + + expect_type(res, "list") +}) + +# --- Method "p" with drm failure (try-error path) --- +test_that("simFct handles drm failure in method='p' gracefully", { + # Use dose values and parameters that will cause drm to fail + # Very few points and extreme values + doseVec <- c(0, 100) + pVec <- c(0.5, 0.5) # flat response - hard to fit + nVec <- rep(2, 2) + + res <- expect_output( + simFct( + noSim = 2, + edVal = c(50), + type = "non-parametric", + response = "bin", + method = "p", + doseVec = doseVec, + nVec = nVec, + pVec = pVec, + pfct = LL.2() + ) + ) + + expect_type(res, "list") + # Some or all should be NA due to fitting failures + expect_equal(dim(res$edArray), c(1, 3, 2)) +}) + +# --- Multiple ED values --- +test_that("simFct works with multiple ED values", { + data(ryegrass, package = "drc") + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + res <- expect_output( + simFct( + noSim = 2, + edVal = c(10, 20, 50, 90), + type = "parametric", + response = "con", + fct = LL.4(), + coefVec = coef(m1), + method = "p", + doseVec = sort(unique(ryegrass$conc)), + resVar = summary(m1)$resVar, + pfct = LL.4() + ) + ) + + expect_equal(dim(res$edArray)[1], 4) + expect_equal(res$edVal, c(10, 20, 50, 90)) +}) + +# --- match.arg validation --- +test_that("simFct validates method argument", { + expect_error( + simFct( + noSim = 1, method = "invalid", + doseVec = 1:5, type = "parametric", + response = "con" + ), + "arg" + ) +}) + +test_that("simFct validates response argument", { + expect_error( + simFct( + noSim = 1, method = "p", + doseVec = 1:5, type = "parametric", + response = "invalid" + ), + "arg" + ) +}) + +test_that("simFct validates type argument", { + expect_error( + simFct( + noSim = 1, method = "p", + doseVec = 1:5, type = "invalid", + response = "con" + ), + "arg" + ) +}) + +# --- mrdrm try-error path (line 133) --- +test_that("simFct handles mrdrm try-error in method='sp'", { + data(ryegrass, package = "drc") + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + local_mocked_bindings( + mrdrm = function(...) structure("mock mrdrm error", class = "try-error"), + .package = "drc" + ) + + res <- expect_output( + simFct( + noSim = 1, + edVal = c(50), + type = "parametric", + response = "con", + fct = LL.4(), + coefVec = coef(m1), + method = "sp", + doseVec = sort(unique(ryegrass$conc)), + resVar = summary(m1)$resVar, + pfct = LL.4(), + span = 0.75 + ) + ) + + expect_true(all(is.na(res$edArray))) +}) + +# --- ED try-error path in method "p" (lines 158-159) --- +test_that("simFct handles ED try-error in method='p'", { + data(ryegrass, package = "drc") + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + local_mocked_bindings( + ED.drc = function(...) stop("mock ED failure"), + .package = "drc" + ) + + res <- expect_output( + simFct( + noSim = 1, + edVal = c(50), + type = "parametric", + response = "con", + fct = LL.4(), + coefVec = coef(m1), + method = "p", + doseVec = sort(unique(ryegrass$conc)), + resVar = summary(m1)$resVar, + pfct = LL.4() + ) + ) + + expect_true(all(is.na(res$edArray))) + expect_true(all(is.na(res$mixVec))) +}) + +# ============================================================================== +# Tests for coverFct() +# ============================================================================== + +test_that("coverFct with provided edVec returns correct structure", { + # Create a mock simulation result + # 2 ED levels, 3 columns (estimate, lower, upper), 10 sims + edArray <- array(NA, c(2, 3, 10)) + # Fill with plausible values + set.seed(42) + for (i in 1:10) { + edArray[1, 1, i] <- rnorm(1, 5, 0.5) # ED10 estimate ~5 + edArray[1, 2, i] <- edArray[1, 1, i] - 1 # lower bound + edArray[1, 3, i] <- edArray[1, 1, i] + 1 # upper bound + edArray[2, 1, i] <- rnorm(1, 10, 1) # ED50 estimate ~10 + edArray[2, 2, i] <- edArray[2, 1, i] - 2 + edArray[2, 3, i] <- edArray[2, 1, i] + 2 + } + + simres <- list( + edArray = edArray, + mixVec = rep(0, 10), + edVal = c(10, 50), + aicVec = rep(-10, 10), + spanVec = rep(0.75, 10) + ) + + res <- coverFct(mfit = NULL, simres = simres, edVec = c(5, 10)) + + expect_type(res, "list") + expect_named(res, c("coverage", "covLow", "covUp", "true", "mean", "width", "notNAs", "NAs", "mixingAverage")) + expect_equal(length(res$coverage), 2) + expect_equal(res$true, c(5, 10)) + expect_true(is.numeric(res$coverage)) + expect_true(all(res$coverage >= 0 & res$coverage <= 1)) + expect_equal(res$mixingAverage, 0) + expect_equal(length(res$notNAs), 2) + expect_equal(length(res$NAs), 2) +}) + +test_that("coverFct with NULL edVec computes ED from model", { + data(ryegrass, package = "drc") + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Create simulation result matching m1 + edArray <- array(NA, c(1, 3, 5)) + trueED <- ED(m1, 50, display = FALSE)[, 1] + for (i in 1:5) { + edArray[1, 1, i] <- trueED + rnorm(1, 0, 0.1) + edArray[1, 2, i] <- edArray[1, 1, i] - 0.5 + edArray[1, 3, i] <- edArray[1, 1, i] + 0.5 + } + + simres <- list( + edArray = edArray, + mixVec = rep(0, 5), + edVal = c(50), + aicVec = rep(-10, 5), + spanVec = rep(NA, 5) + ) + + res <- coverFct(mfit = m1, simres = simres, edVec = NULL) + + expect_type(res, "list") + expect_equal(length(res$coverage), 1) + expect_true(!is.na(res$true)) +}) + +test_that("coverFct handles NA values in edArray", { + # Create simulation result with some NAs + edArray <- array(NA, c(1, 3, 10)) + for (i in 1:7) { + edArray[1, 1, i] <- rnorm(1, 5, 0.5) + edArray[1, 2, i] <- edArray[1, 1, i] - 1 + edArray[1, 3, i] <- edArray[1, 1, i] + 1 + } + # Leave i=8,9,10 as NA + + simres <- list( + edArray = edArray, + mixVec = c(rep(0, 7), rep(NA, 3)), + edVal = c(50), + aicVec = rep(NA, 10), + spanVec = rep(NA, 10) + ) + + res <- coverFct(mfit = NULL, simres = simres, edVec = c(5)) + + expect_type(res, "list") + # notNAs should be 7 (the ones that have both lower and upper) + expect_equal(res$notNAs, 7) + expect_equal(res$NAs, 3) +}) + +test_that("coverFct handles partial NAs (only lower or only upper is NA)", { + # Create simulation result where some have only lower NA, some only upper NA + edArray <- array(NA, c(1, 3, 6)) + # Normal cases + for (i in 1:2) { + edArray[1, 1, i] <- 5 + edArray[1, 2, i] <- 4 + edArray[1, 3, i] <- 6 + } + # Lower NA, upper present and > true value + edArray[1, 1, 3] <- 5 + edArray[1, 2, 3] <- NA + edArray[1, 3, 3] <- 6 # upper > 5 + + # Lower NA, upper present but < true value + edArray[1, 1, 4] <- 5 + edArray[1, 2, 4] <- NA + edArray[1, 3, 4] <- 4 # upper < 5 + + # Upper NA, lower present and < true value + edArray[1, 1, 5] <- 5 + edArray[1, 2, 5] <- 4 # lower < 5 + edArray[1, 3, 5] <- NA + + # Upper NA, lower present but > true value + edArray[1, 1, 6] <- 5 + edArray[1, 2, 6] <- 6 # lower > 5 + edArray[1, 3, 6] <- NA + + simres <- list( + edArray = edArray, + mixVec = rep(0, 6), + edVal = c(50), + aicVec = rep(NA, 6), + spanVec = rep(NA, 6) + ) + + res <- coverFct(mfit = NULL, simres = simres, edVec = c(5)) + + expect_type(res, "list") + # Only observations with both lower and upper non-NA count for notNAs + expect_equal(res$notNAs, 2) + expect_equal(res$NAs, 4) + # covLow counts: lower NA AND upper > true. Obs 3 qualifies (NA lower, upper=6>5) + expect_equal(res$covLow, 1) + # covUp counts: upper NA AND lower < true. Obs 5 qualifies (NA upper, lower=4<5) + expect_equal(res$covUp, 1) +}) + +# ============================================================================== +# Integration test: simFct + coverFct together +# ============================================================================== + +test_that("simFct and coverFct work together end-to-end", { + data(deguelin, package = "drc") + m1 <- drm(r / n ~ dose, weights = n, data = deguelin, fct = LL.2(), type = "binomial") + + simres <- expect_output( + simFct( + noSim = 3, + edVal = c(50), + type = "parametric", + response = "bin", + fct = LL.2(), + coefVec = coef(m1), + method = "p", + doseVec = deguelin$dose, + nVec = deguelin$n, + pfct = LL.2() + ) + ) + + covRes <- coverFct(mfit = m1, simres = simres) + + expect_type(covRes, "list") + expect_equal(length(covRes$coverage), 1) + expect_true(is.numeric(covRes$coverage)) +}) diff --git a/tests/testthat/test-summary.drc.R b/tests/testthat/test-summary.drc.R new file mode 100644 index 00000000..614bea40 --- /dev/null +++ b/tests/testthat/test-summary.drc.R @@ -0,0 +1,475 @@ +# Comprehensive tests for summary.drc() and print.summary.drc() +# Targeting 100% code coverage + +# ============================================================================= +# Test Data Setup +# ============================================================================= + +# Standard continuous data (ryegrass-like) +ryegrass_test <- data.frame( + rootl = c( + 7.58, 8.00, 8.33, 7.25, 7.17, 7.00, 7.17, 7.83, 7.92, 7.58, + 6.17, 5.75, 5.83, 6.00, 5.83, 4.92, 4.50, 4.17, 4.42, 4.00, + 2.67, 2.08, 2.42, 2.50, 2.25, 1.17, 0.75, 0.92, 1.00, 0.58 + ), + conc = c( + rep(0, 5), rep(0.94, 5), rep(1.88, 5), + rep(3.75, 5), rep(7.50, 5), rep(15, 5) + ) +) + +# Multi-curve data for independent fits +set.seed(42) +multi_data_test <- data.frame( + dose = rep(c(0, 0.5, 1, 2, 5, 10), each = 5, times = 2), + resp = c( + rnorm(5, 100, 5), rnorm(5, 95, 5), rnorm(5, 85, 5), + rnorm(5, 60, 5), rnorm(5, 20, 5), rnorm(5, 5, 5), + rnorm(5, 100, 5), rnorm(5, 90, 5), rnorm(5, 70, 5), + rnorm(5, 40, 5), rnorm(5, 10, 5), rnorm(5, 3, 5) + ), + group = rep(c("A", "B"), each = 30) +) + +# Binomial data +binom_data_test <- data.frame( + dose = c(0, 0.1, 0.5, 1, 2, 5, 10), + resp = c(0, 0.05, 0.15, 0.35, 0.65, 0.90, 0.98), + n = rep(50, 7) +) + +# Poisson data +poisson_data_test <- data.frame( + dose = c(0, 1, 2, 4, 8, 16, 32), + count = c(50, 48, 40, 25, 10, 3, 1) +) + +# ============================================================================= +# Tests for summary.drc() +# ============================================================================= + +# --- Happy Path: Basic continuous model --- + +test_that("summary.drc returns correct structure for continuous model", { + m1 <- drm(rootl ~ conc, data = ryegrass_test, fct = LL.4()) + summ <- summary(m1) + + # Check class + expect_s3_class(summ, "summary.drc") + + # Check all named elements + expected_names <- c("resVar", "varMat", "coefficients", "boxcox", "fctName", + "robust", "varParm", "type", "df.residual", + "cov.unscaled", "text", "noParm", "rseMat") + expect_equal(names(summ), expected_names) + + # Check types of key elements + expect_true(is.numeric(summ$resVar)) + expect_true(is.matrix(summ$varMat)) + expect_true(is.matrix(summ$coefficients)) + expect_true(is.matrix(summ$rseMat)) + expect_equal(summ$type, "continuous") + expect_null(summ$robust) + expect_null(summ$varParm) +}) + +test_that("summary.drc coefficient matrix has correct structure", { + m1 <- drm(rootl ~ conc, data = ryegrass_test, fct = LL.4()) + summ <- summary(m1) + coef_mat <- summ$coefficients + + expect_equal(ncol(coef_mat), 4) + expect_equal(colnames(coef_mat), c("Estimate", "Std. Error", "t-value", "p-value")) + expect_equal(nrow(coef_mat), 4) # LL.4 has 4 parameters + + # Estimates should match coef() + expect_equal(coef_mat[, "Estimate"], coef(m1), ignore_attr = TRUE) + + # Standard errors should be positive + expect_true(all(coef_mat[, "Std. Error"] > 0)) + + # p-values should be in [0, 1] + expect_true(all(coef_mat[, "p-value"] >= 0 & coef_mat[, "p-value"] <= 1)) +}) + +test_that("summary.drc uses t-distribution for continuous data", { + m1 <- drm(rootl ~ conc, data = ryegrass_test, fct = LL.4()) + summ <- summary(m1) + coef_mat <- summ$coefficients + + # Manually compute expected p-values using t-distribution + t_vals <- coef_mat[, "t-value"] + df_val <- df.residual(m1) + expected_pvals <- pt(-abs(t_vals), df_val) + (1 - pt(abs(t_vals), df_val)) + expect_equal(coef_mat[, "p-value"], expected_pvals, tolerance = 1e-10) +}) + +test_that("summary.drc rseMat is correct for single-curve model", { + m1 <- drm(rootl ~ conc, data = ryegrass_test, fct = LL.4()) + summ <- summary(m1) + + expect_equal(nrow(summ$rseMat), 1) + expect_equal(ncol(summ$rseMat), 2) + expect_equal(colnames(summ$rseMat), c("rse", "df")) + expect_true(summ$rseMat[1, "rse"] > 0) + expect_equal(summ$rseMat[1, "df"], df.residual(m1)) +}) + +test_that("summary.drc computes cov.unscaled for continuous data", { + m1 <- drm(rootl ~ conc, data = ryegrass_test, fct = LL.4()) + summ <- summary(m1) + + expect_true(is.matrix(summ$cov.unscaled)) + expect_false(is.null(summ$cov.unscaled)) +}) + +# --- Non-continuous models (pnorm branch + varMat.us NULL) --- + +test_that("summary.drc uses pnorm for binomial data", { + m_binom <- drm(resp ~ dose, data = binom_data_test, fct = LL.2(), + type = "binomial", weights = n) + summ <- summary(m_binom) + + expect_s3_class(summ, "summary.drc") + expect_equal(summ$type, "binomial") + + # p-values should use normal distribution + coef_mat <- summ$coefficients + z_vals <- coef_mat[, "t-value"] + expected_pvals <- pnorm(-abs(z_vals)) + (1 - pnorm(abs(z_vals))) + expect_equal(coef_mat[, "p-value"], expected_pvals, tolerance = 1e-10) +}) + +test_that("summary.drc sets cov.unscaled to NULL for non-continuous data", { + m_binom <- drm(resp ~ dose, data = binom_data_test, fct = LL.2(), + type = "binomial", weights = n) + summ <- summary(m_binom) + + # resVar should be NA for binomial + expect_true(is.na(summ$resVar)) + + # cov.unscaled should be NULL (not a matrix of NAs) + expect_null(summ$cov.unscaled) +}) + +test_that("summary.drc works with Poisson data", { + m_poisson <- drm(count ~ dose, data = poisson_data_test, fct = LL.4(), + type = "Poisson") + summ <- summary(m_poisson) + + expect_s3_class(summ, "summary.drc") + expect_equal(summ$type, "Poisson") + expect_true(is.na(summ$resVar)) + expect_null(summ$cov.unscaled) +}) + +# --- Multi-curve models with pool=FALSE (unpooled path) --- + +test_that("summary.drc with pool=FALSE for multi-curve independent model", { + skip_if_not_installed("magic") + library(magic) + data(spinach) + m_sep <- drm(SLOPE ~ DOSE, HERBICIDE, data = spinach, + fct = LL.4(), separate = TRUE) + summ_unpooled <- summary(m_sep, pool = FALSE) + + expect_s3_class(summ_unpooled, "summary.drc") + + # rseMat should have multiple rows (one per curve) + expect_true(nrow(summ_unpooled$rseMat) > 1) + expect_equal(colnames(summ_unpooled$rseMat), c("rse", "df")) + + # All RSEs should be positive + expect_true(all(summ_unpooled$rseMat[, "rse"] > 0)) + expect_true(all(summ_unpooled$rseMat[, "df"] > 0)) +}) + +test_that("summary.drc with pool=TRUE for multi-curve independent model", { + skip_if_not_installed("magic") + library(magic) + data(spinach) + m_sep <- drm(SLOPE ~ DOSE, HERBICIDE, data = spinach, + fct = LL.4(), separate = TRUE) + summ_pooled <- summary(m_sep, pool = TRUE) + + expect_s3_class(summ_pooled, "summary.drc") + + # rseMat should have 1 row when pooled + expect_equal(nrow(summ_pooled$rseMat), 1) +}) + +# --- Robust estimation methods --- +# Note: robust models use eval in parent.frame() so we must use package data + +test_that("summary.drc with robust='trimmed' (metric trimming)", { + data(ryegrass) + m_robust <- drm(rootl ~ conc, data = ryegrass, fct = LL.4(), + robust = "trimmed") + summ <- summary(m_robust) + + expect_s3_class(summ, "summary.drc") + expect_equal(summ$robust, "metric trimming") + + # Standard errors should be computed via Hessian + expect_true(all(summ$coefficients[, "Std. Error"] > 0)) + expect_true(all(is.finite(summ$coefficients[, "Std. Error"]))) +}) + +test_that("summary.drc with robust='tukey' (Tukey's biweight)", { + data(ryegrass) + m_robust <- drm(rootl ~ conc, data = ryegrass, fct = LL.4(), + robust = "tukey") + summ <- summary(m_robust) + + expect_s3_class(summ, "summary.drc") + expect_equal(summ$robust, "Tukey's biweight") + expect_true(all(summ$coefficients[, "Std. Error"] > 0)) +}) + +test_that("summary.drc with robust='winsor' (metric Winsorizing)", { + data(ryegrass) + # Winsorizing may fail to converge with some datasets + m_robust <- tryCatch( + drm(rootl ~ conc, data = ryegrass, fct = LL.4(), robust = "winsor"), + error = function(e) NULL + ) + skip_if(is.null(m_robust), "Winsorizing model did not converge") + summ <- summary(m_robust) + + expect_s3_class(summ, "summary.drc") + expect_equal(summ$robust, "metric Winsorizing") + expect_true(all(summ$coefficients[, "Std. Error"] > 0)) +}) + +# --- Over-dispersion --- + +test_that("summary.drc with od=TRUE for binomial data", { + m_binom <- drm(resp ~ dose, data = binom_data_test, fct = LL.2(), + type = "binomial", weights = n) + + summ_no_od <- summary(m_binom, od = FALSE) + summ_od <- summary(m_binom, od = TRUE) + + expect_s3_class(summ_no_od, "summary.drc") + expect_s3_class(summ_od, "summary.drc") +}) + +# --- Consistency tests --- + +test_that("summary.drc is consistent across repeated calls", { + m1 <- drm(rootl ~ conc, data = ryegrass_test, fct = LL.4()) + s1 <- summary(m1) + s2 <- summary(m1) + + expect_equal(s1$coefficients, s2$coefficients) + expect_equal(s1$resVar, s2$resVar) + expect_equal(s1$varMat, s2$varMat) +}) + +# ============================================================================= +# Tests for print.summary.drc() +# ============================================================================= + +# --- Basic print --- + +test_that("print.summary.drc produces output and returns invisibly", { + m1 <- drm(rootl ~ conc, data = ryegrass_test, fct = LL.4()) + summ <- summary(m1) + + output <- capture.output(result <- print(summ)) + expect_true(length(output) > 0) + expect_identical(result, summ) # returns invisibly +}) + +test_that("print.summary.drc shows model text and noParm", { + m1 <- drm(rootl ~ conc, data = ryegrass_test, fct = LL.4()) + summ <- summary(m1) + + output <- capture.output(print(summ)) + # Should contain model fitted text with noParm + expect_true(any(grepl("Model fitted:", output))) + expect_true(any(grepl("parms", output))) +}) + +test_that("print.summary.drc handles noParm = NULL", { + m1 <- drm(rootl ~ conc, data = ryegrass_test, fct = LL.4()) + summ <- summary(m1) + + # Manually set noParm to NULL + summ$noParm <- NULL + + output <- capture.output(print(summ)) + expect_true(any(grepl("Model fitted:", output))) + # Should NOT contain "parms" since noParm is NULL + expect_false(any(grepl("parms", output))) +}) + +test_that("print.summary.drc shows robust estimation info", { + data(ryegrass) + m_robust <- drm(rootl ~ conc, data = ryegrass, fct = LL.4(), + robust = "trimmed") + summ <- summary(m_robust) + + output <- capture.output(print(summ)) + expect_true(any(grepl("Robust estimation:", output))) + expect_true(any(grepl("metric trimming", output))) +}) + +test_that("print.summary.drc shows multiple RSEs for multi-curve unpooled", { + skip_if_not_installed("magic") + library(magic) + data(spinach) + m_sep <- drm(SLOPE ~ DOSE, HERBICIDE, data = spinach, + fct = LL.4(), separate = TRUE) + summ <- summary(m_sep, pool = FALSE) + + output <- capture.output(print(summ)) + # Should print "Residual standard errors:" (with 's') + expect_true(any(grepl("Residual standard errors:", output))) +}) + +test_that("print.summary.drc shows single RSE for pooled model", { + m1 <- drm(rootl ~ conc, data = ryegrass_test, fct = LL.4()) + summ <- summary(m1) + + output <- capture.output(print(summ)) + # Should show "Residual standard error:" (without trailing 's') + expect_true(any(grepl("Residual standard error:", output))) +}) + +test_that("print.summary.drc warns when df.residual < 1", { + m1 <- drm(rootl ~ conc, data = ryegrass_test, fct = LL.4()) + summ <- summary(m1) + + # Set df.residual to 0 to trigger warning + summ$df.residual <- 0 + + output <- capture.output(print(summ)) + expect_true(any(grepl("Too complex model fitted", output))) +}) + +test_that("print.summary.drc skips RSE section for non-continuous data", { + m_binom <- drm(resp ~ dose, data = binom_data_test, fct = LL.2(), + type = "binomial", weights = n) + summ <- summary(m_binom) + + output <- capture.output(print(summ)) + # Should NOT show "Residual standard error" for binomial + expect_false(any(grepl("Residual standard error", output))) +}) + +# --- varComp tests (using mock) --- + +test_that("print.summary.drc shows varComp when present", { + m1 <- drm(rootl ~ conc, data = ryegrass_test, fct = LL.4()) + summ <- summary(m1) + + # Add mock varComp + summ$varComp <- matrix(c(1.5, 0.3, 5.0, 0.001), nrow = 1, + dimnames = list("sigma", c("Estimate", "Std. Error", + "t-value", "p-value"))) + + output <- capture.output(print(summ)) + expect_true(any(grepl("Estimated variance components:", output))) +}) + +# --- varParm tests (using mock) --- + +test_that("print.summary.drc shows varParm with varPower type (single row)", { + m1 <- drm(rootl ~ conc, data = ryegrass_test, fct = LL.4()) + summ <- summary(m1) + + # Mock varParm with single row estimates (varPower) + summ$varParm <- list( + type = "varPower", + estimates = matrix(c(2.0, 0.5, 4.0, 0.001), nrow = 1, + dimnames = list("theta", c("Estimate", "Std. Error", + "t-value", "p-value"))) + ) + + output <- capture.output(print(summ)) + expect_true(any(grepl("power-of-the-mean variance model", output))) +}) + +test_that("print.summary.drc shows varParm with varPower type (multi-row)", { + m1 <- drm(rootl ~ conc, data = ryegrass_test, fct = LL.4()) + summ <- summary(m1) + + # Mock varParm with multiple row estimates (varPower) + summ$varParm <- list( + type = "varPower", + estimates = matrix(c(1.0, 2.0, 0.3, 0.5, 3.33, 4.0, 0.01, 0.001), + nrow = 2, + dimnames = list(c("sigma", "theta"), + c("Estimate", "Std. Error", + "t-value", "p-value"))) + ) + + output <- capture.output(print(summ)) + expect_true(any(grepl("power-of-the-mean variance model", output))) +}) + +test_that("print.summary.drc shows varParm with hetvar type", { + m1 <- drm(rootl ~ conc, data = ryegrass_test, fct = LL.4()) + summ <- summary(m1) + + # Mock varParm with hetvar type + summ$varParm <- list( + type = "hetvar", + estimates = matrix(c(1.0, 2.0, 0.3, 0.5, 3.33, 4.0, 0.01, 0.001), + nrow = 2, + dimnames = list(c("var1", "var2"), + c("Estimate", "Std. Error", + "t-value", "p-value"))) + ) + + output <- capture.output(print(summ)) + expect_true(any(grepl("Estimated heterogeneous variances:", output))) +}) + +# --- boxcox tests --- + +test_that("print.summary.drc shows boxcox with lambda and CI", { + m1 <- drm(rootl ~ conc, data = ryegrass_test, fct = LL.4()) + summ <- summary(m1) + + # Mock boxcox with lambda and CI + summ$boxcox <- list(lambda = 0.5, ci = c(0.2, 0.8)) + + output <- capture.output(print(summ)) + expect_true(any(grepl("Box-Cox transformation", output))) + expect_true(any(grepl("Estimated lambda:", output))) + expect_true(any(grepl("Confidence interval for lambda:", output))) +}) + +test_that("print.summary.drc shows boxcox with specified lambda (NA CI)", { + m1 <- drm(rootl ~ conc, data = ryegrass_test, fct = LL.4()) + summ <- summary(m1) + + # Mock boxcox with lambda but NA CI + summ$boxcox <- list(lambda = 1.0, ci = c(NA, NA)) + + output <- capture.output(print(summ)) + expect_true(any(grepl("Box-Cox transformation", output))) + expect_true(any(grepl("Specified lambda:", output))) +}) + +test_that("print.summary.drc handles boxcox with NA lambda", { + m1 <- drm(rootl ~ conc, data = ryegrass_test, fct = LL.4()) + summ <- summary(m1) + + # Mock boxcox with NA lambda (should print nothing) + summ$boxcox <- list(lambda = NA) + + output <- capture.output(print(summ)) + expect_false(any(grepl("Box-Cox transformation", output))) +}) + +test_that("print.summary.drc handles NULL boxcox", { + m1 <- drm(rootl ~ conc, data = ryegrass_test, fct = LL.4()) + summ <- summary(m1) + summ$boxcox <- NULL + + output <- capture.output(print(summ)) + expect_false(any(grepl("Box-Cox transformation", output))) +}) diff --git a/tests/testthat/test-threephase.R b/tests/testthat/test-threephase.R new file mode 100644 index 00000000..1f5052ae --- /dev/null +++ b/tests/testthat/test-threephase.R @@ -0,0 +1,150 @@ +# Test file for threephase function + +# ---- Correctness: Default arguments ---- + +test_that("threephase returns correct structure with default arguments", { + result <- threephase() + + expect_s3_class(result, "three-phase") + expect_type(result, "list") + expect_true(all(c("fct", "ssfct", "names", "deriv1", "deriv2", + "derivx", "edfct", "name", "text", "noParm") %in% names(result))) + expect_equal(result$noParm, 10) + expect_equal(result$names, c("b1", "c1", "d1", "e1", "b2", "d2", "e2", "b3", "d3", "e3")) + expect_equal(result$name, "threephase") + expect_equal(result$text, "Three-phase") + expect_null(result$deriv1) + expect_null(result$deriv2) + expect_null(result$derivx) + expect_null(result$edfct) +}) + +# ---- Correctness: Custom fctName and fctText ---- + +test_that("threephase works with custom fctName and fctText", { + result <- threephase(fctName = "custom_name", fctText = "custom text") + + expect_equal(result$name, "custom_name") + expect_equal(result$text, "custom text") +}) + +# ---- Correctness: Fixed parameters ---- + +test_that("threephase works with some fixed parameters", { + result <- threephase(fixed = c(1, NA, NA, NA, NA, NA, NA, NA, NA, NA)) + + expect_equal(result$noParm, 9) + expect_equal(result$names, c("c1", "d1", "e1", "b2", "d2", "e2", "b3", "d3", "e3")) +}) + +test_that("threephase works with multiple fixed parameters", { + result <- threephase(fixed = c(1, 0, NA, NA, 2, NA, NA, 3, NA, NA)) + + expect_equal(result$noParm, 6) + expect_equal(result$names, c("d1", "e1", "d2", "e2", "d3", "e3")) +}) + +# ---- Correctness: Custom parameter names ---- + +test_that("threephase works with custom parameter names", { + custom_names <- c("a1", "a2", "a3", "a4", "a5", "a6", "a7", "a8", "a9", "a10") + result <- threephase(names = custom_names) + + expect_equal(result$names, custom_names) +}) + +# ---- Correctness: fct evaluates correctly ---- + +test_that("threephase fct evaluates correctly with single row parm", { + result <- threephase() + + dose <- c(0.1, 1, 10) + # 10 parameters: b1, c1, d1, e1, b2, d2, e2, b3, d3, e3 + parm <- matrix(c(1, 0, 1, 1, 1, 1, 1, 1, 1, 1), nrow = 1) + + output <- result$fct(dose, parm) + + expect_type(output, "double") + expect_length(output, length(dose)) + expect_true(all(is.finite(output))) +}) + +test_that("threephase fct evaluates correctly with multiple rows", { + result <- threephase() + + dose <- c(0.1, 1, 10) + parm <- matrix(rep(c(1, 0, 1, 1, 1, 1, 1, 1, 1, 1), 3), nrow = 3, byrow = TRUE) + + output <- result$fct(dose, parm) + + expect_type(output, "double") + expect_length(output, 3) + expect_true(all(is.finite(output))) +}) + +test_that("threephase fct works with fixed parameters", { + # Fix b1=1 and b2=2 + result <- threephase(fixed = c(1, NA, NA, NA, 2, NA, NA, NA, NA, NA)) + + dose <- c(0.1, 1, 10) + # parm should have 8 values (the 8 free parameters) + parm <- matrix(c(0, 1, 1, 1, 1, 1, 1, 1), nrow = 1) + + output <- result$fct(dose, parm) + + expect_type(output, "double") + expect_length(output, length(dose)) + expect_true(all(is.finite(output))) +}) + +# ---- Correctness: ssfct self-starter function ---- + +test_that("threephase ssfct works with valid data", { + result <- threephase() + + dframe <- data.frame( + dose = c(0.1, 0.5, 1, 2, 5, 10), + response = c(0.9, 0.7, 0.5, 0.3, 0.1, 0.05) + ) + + init_vals <- result$ssfct(dframe) + + expect_type(init_vals, "double") + expect_length(init_vals, 10) + expect_true(all(is.finite(init_vals))) +}) + +test_that("threephase ssfct works with fixed parameters", { + result <- threephase(fixed = c(1, NA, NA, NA, NA, NA, NA, NA, NA, NA)) + + dframe <- data.frame( + dose = c(0.1, 0.5, 1, 2, 5, 10), + response = c(0.9, 0.7, 0.5, 0.3, 0.1, 0.05) + ) + + init_vals <- result$ssfct(dframe) + + expect_type(init_vals, "double") + expect_length(init_vals, 9) + expect_true(all(is.finite(init_vals))) +}) + +# ---- Error Handling: Invalid names argument ---- + +test_that("threephase errors with non-character names", { + expect_error(threephase(names = 1:10), "Not correct 'names' argument") +}) + +test_that("threephase errors with wrong length names", { + expect_error(threephase(names = c("a", "b")), "Not correct 'names' argument") +}) + +# ---- Error Handling: Invalid fixed argument ---- + +test_that("threephase errors with wrong length fixed", { + expect_error(threephase(fixed = c(NA, NA)), "Not correct 'fixed' argument") +}) + +test_that("threephase errors with too long fixed", { + expect_error(threephase(fixed = rep(NA, 11)), "Not correct 'fixed' argument") +}) diff --git a/tests/testthat/test-twophase.R b/tests/testthat/test-twophase.R new file mode 100644 index 00000000..9d435723 --- /dev/null +++ b/tests/testthat/test-twophase.R @@ -0,0 +1,219 @@ +# tests/testthat/test-twophase.R +# Comprehensive test suite for the twophase() function + +# --- Argument Validation --- + +test_that("twophase rejects invalid 'names' argument", { + # names must be character + +expect_error(twophase(names = 1:7), "Not correct 'names' argument") + # names wrong length + expect_error(twophase(names = c("a", "b")), "Not correct 'names' argument") + # names not character (logical) + expect_error(twophase(names = rep(TRUE, 7)), "Not correct 'names' argument") +}) + +test_that("twophase rejects invalid 'fixed' argument", { + # fixed wrong length + expect_error(twophase(fixed = c(NA, NA)), "Not correct 'fixed' argument") + expect_error(twophase(fixed = rep(NA, 8)), "Not correct 'fixed' argument") +}) + +# --- Default Behavior (Happy Path) --- + +test_that("twophase returns correct structure with default arguments", { + res <- twophase() + + # Class + expect_s3_class(res, "two-phase") + + # All expected list elements + expect_true(is.list(res)) + expected_names <- c("fct", "ssfct", "names", "deriv1", "deriv2", + "derivx", "edfct", "name", "text", "noParm") + expect_equal(names(res), expected_names) + + # Parameter names (all 7 free) + expect_equal(res$names, c("b1", "c1", "d1", "e1", "b2", "d2", "e2")) + + # noParm should be 7 + expect_equal(res$noParm, 7) + + # name should be "twophase" (from match.call) + expect_equal(res$name, "twophase") + + # text should be "Two-phase" + expect_equal(res$text, "Two-phase") + + # NULL fields + expect_null(res$deriv1) + expect_null(res$deriv2) + expect_null(res$derivx) + expect_null(res$edfct) + + # Functions + expect_true(is.function(res$fct)) + expect_true(is.function(res$ssfct)) +}) + +# --- Fixed Parameters --- + +test_that("twophase handles fixed parameters correctly", { + # Fix b1 at 1 and c1 at 0 + res <- twophase(fixed = c(1, 0, NA, NA, NA, NA, NA)) + expect_equal(res$names, c("d1", "e1", "b2", "d2", "e2")) + expect_equal(res$noParm, 5) + + # Fix all parameters + res_all <- twophase(fixed = c(1, 0, 100, 5, 2, 50, 10)) + expect_equal(res_all$noParm, 0) + expect_equal(length(res_all$names), 0) +}) + +# --- Custom Names --- + +test_that("twophase accepts custom parameter names", { + custom_names <- c("slope1", "lower", "upper1", "ed501", "slope2", "upper2", "ed502") + res <- twophase(names = custom_names) + expect_equal(res$names, custom_names) +}) + +# --- fctName and fctText Arguments --- + +test_that("twophase uses provided fctName and fctText", { + res <- twophase(fctName = "myModel", fctText = "My custom text") + expect_equal(res$name, "myModel") + expect_equal(res$text, "My custom text") +}) + +test_that("twophase uses defaults when fctName and fctText are missing", { + res <- twophase() + expect_equal(res$name, "twophase") + expect_equal(res$text, "Two-phase") +}) + +# --- fct function (dose-response evaluation) --- + +test_that("twophase fct computes dose-response values correctly", { + res <- twophase() + + # Use known parameter values + # b1=1, c1=0, d1=50, e1=5, b2=1, d2=50, e2=50 + parm <- matrix(c(1, 0, 50, 5, 1, 50, 50), nrow = 1) + dose <- c(1, 5, 10, 50, 100) + + values <- res$fct(dose, parm) + expect_true(is.numeric(values)) + expect_equal(length(values), length(dose)) + + # At e1=5 (dose=5), first component should be at midpoint (d1-c1)/2 = 25 + # LL.4 at e1: c + (d-c)/2 = 0 + 50/2 = 25 + # LL.3 at dose=5: d2/(1+exp(b2*(log(5)-log(50)))) = 50/(1+exp(1*log(0.1))) + # = 50/(1+0.1) = 50/1.1 ≈ 45.45 + # Total ≈ 25 + 45.45 ≈ 70.45 + val_at_5 <- res$fct(5, parm) + expect_true(val_at_5 > 60 && val_at_5 < 80) +}) + +test_that("twophase fct works with multiple rows in parm matrix", { + res <- twophase() + + # Two sets of parameters + parm <- matrix(c(1, 0, 50, 5, 1, 50, 50, + 2, 10, 80, 3, 2, 40, 20), nrow = 2, byrow = TRUE) + dose <- c(1, 10) + + values <- res$fct(dose, parm) + expect_equal(length(values), 2) + expect_true(is.numeric(values)) +}) + +test_that("twophase fct works with fixed parameters", { + # Fix b1=1 and c1=0 + res <- twophase(fixed = c(1, 0, NA, NA, NA, NA, NA)) + + # parm should only have 5 columns (d1, e1, b2, d2, e2) + parm <- matrix(c(50, 5, 1, 50, 50), nrow = 1) + dose <- c(1, 5, 10) + + values <- res$fct(dose, parm) + expect_equal(length(values), 3) + expect_true(is.numeric(values)) + + # Compare with full model using same parameter values + res_full <- twophase() + parm_full <- matrix(c(1, 0, 50, 5, 1, 50, 50), nrow = 1) + values_full <- res_full$fct(dose, parm_full) + + expect_equal(values, values_full) +}) + +# --- ssfct function (self-starter) --- + +test_that("twophase ssfct returns initial parameter values", { + res <- twophase() + + # Create a mock data frame similar to what drm passes to ssfct + # ssfct expects a data frame with dose and response + set.seed(42) + dose <- c(0.1, 0.5, 1, 2, 5, 10, 20, 50, 100) + response <- c(5, 10, 20, 40, 60, 75, 85, 95, 100) + dframe <- data.frame(dose, response) + + init_vals <- res$ssfct(dframe) + + # Should return 7 values (all params free) + expect_equal(length(init_vals), 7) + expect_true(is.numeric(init_vals)) +}) + +test_that("twophase ssfct respects fixed parameters", { + res <- twophase(fixed = c(1, 0, NA, NA, NA, NA, NA)) + + dose <- c(0.1, 0.5, 1, 2, 5, 10, 20, 50, 100) + response <- c(5, 10, 20, 40, 60, 75, 85, 95, 100) + dframe <- data.frame(dose, response) + + init_vals <- res$ssfct(dframe) + + # Should return 5 values (only non-fixed params) + expect_equal(length(init_vals), 5) + expect_true(is.numeric(init_vals)) +}) + +# --- Integration with drm --- + +test_that("twophase works with drm for model fitting", { + skip_if_not_installed("drc") + + # Create synthetic two-phase data + set.seed(123) + dose <- rep(c(0.01, 0.1, 0.5, 1, 2, 5, 10, 20, 50, 100, 200, 500), each = 3) + # Two-phase response: LL.4 component + LL.3 component + b1 <- 1 + c1 <- 0 + d1 <- 50 + e1 <- 5 + b2 <- 1 + d2 <- 50 + e2 <- 100 + response <- c1 + (d1 - c1) / (1 + exp(b1 * (log(dose) - log(e1)))) + + d2 / (1 + exp(b2 * (log(dose) - log(e2)))) + + rnorm(length(dose), 0, 2) + + dat <- data.frame(dose = dose, response = response) + + # Should not error when fitting + expect_no_error( + mod <- drm(response ~ dose, data = dat, fct = twophase()) + ) +}) + +# --- invisible return --- + +test_that("twophase returns invisibly", { + # The function uses invisible(), so direct assignment should work + # but printing should not show output + res <- twophase() + expect_s3_class(res, "two-phase") +}) diff --git a/tests/testthat/test-ucedergreen.R b/tests/testthat/test-ucedergreen.R new file mode 100644 index 00000000..ed6fe39c --- /dev/null +++ b/tests/testthat/test-ucedergreen.R @@ -0,0 +1,389 @@ +# Test suite for ucedergreen function +# Benchmarked against the cedergreen test suite + +# Test data setup +test_dose <- c(0.1, 0.5, 1, 2, 5, 10, 20) +test_response <- c(102, 105, 95, 80, 40, 25, 20) +test_data <- data.frame(dose = test_dose, response = test_response) + +# ============================================================================== +# Tests for ucedergreen() main function +# ============================================================================== + +test_that("ucedergreen returns correct structure with default arguments", { + result <- ucedergreen(alpha = 0.5) + + expect_true(is.list(result)) + expect_s3_class(result, "UCRS") + expect_true("fct" %in% names(result)) + expect_true("ssfct" %in% names(result)) + expect_true("names" %in% names(result)) + expect_true("deriv1" %in% names(result)) + expect_true("deriv2" %in% names(result)) + expect_true("edfct" %in% names(result)) + expect_true("maxfct" %in% names(result)) + expect_equal(result$noParm, 5) +}) + +test_that("ucedergreen works with different alpha values", { + result1 <- ucedergreen(alpha = 1) + result2 <- ucedergreen(alpha = 0.5) + result3 <- ucedergreen(alpha = 0.25) + + expect_s3_class(result1, "UCRS") + expect_s3_class(result2, "UCRS") + expect_s3_class(result3, "UCRS") +}) + +test_that("ucedergreen works with fixed parameters", { + # Fix c parameter to 0 + result <- ucedergreen(fixed = c(NA, 0, NA, NA, NA), alpha = 1) + + expect_equal(result$noParm, 4) # Only 4 parameters to estimate + expect_equal(length(result$names), 4) + expect_false("c" %in% result$names) +}) + +test_that("ucedergreen works with multiple fixed parameters", { + # Fix b and c + result <- ucedergreen(fixed = c(2, 0, NA, NA, NA), alpha = 1) + + expect_equal(result$noParm, 3) # Only 3 parameters to estimate + expect_false("b" %in% result$names) + expect_false("c" %in% result$names) +}) + +test_that("ucedergreen works with all different methods", { + result1 <- ucedergreen(method = "loglinear", alpha = 1) + result2 <- ucedergreen(method = "anke", alpha = 1) + result3 <- ucedergreen(method = "method3", alpha = 1) + result4 <- ucedergreen(method = "normolle", alpha = 1) + + expect_s3_class(result1, "UCRS") + expect_s3_class(result2, "UCRS") + expect_s3_class(result3, "UCRS") + expect_s3_class(result4, "UCRS") +}) + +test_that("ucedergreen validates method argument via match.arg", { + expect_error( + ucedergreen(method = "invalid_method", alpha = 1), + "'arg' should be one of" + ) +}) + +test_that("ucedergreen works with custom parameter names", { + custom_names <- c("slope", "lower", "upper", "ed50", "hormesis") + result <- ucedergreen(names = custom_names, alpha = 1) + + expect_equal(result$names, custom_names) +}) + +test_that("ucedergreen works with custom fctName and fctText", { + result <- ucedergreen(alpha = 1, fctName = "MyUModel", fctText = "My U-shaped model") + + expect_equal(result$name, "MyUModel") + expect_equal(result$text, "My U-shaped model") +}) + +test_that("ucedergreen sets default fctName and fctText when missing", { + result <- ucedergreen(alpha = 1) + + expect_equal(result$name, "ucedergreen") + expect_equal(result$text, "U-shaped Cedergreen-Ritz-Streibig") +}) + +test_that("ucedergreen works with custom ssfct", { + custom_ssfct <- function(dframe) { + return(c(1, 0, 100, 1, 10)) + } + + result <- ucedergreen(ssfct = custom_ssfct, alpha = 1) + + expect_identical(result$ssfct, custom_ssfct) +}) + +# ============================================================================== +# Tests for the fct (model) function - Issue #1: missing +c term +# ============================================================================== + +test_that("ucedergreen fct function can be called", { + result <- ucedergreen(alpha = 1) + + dose_vec <- c(0.1, 1, 10) + parm_mat <- matrix(c(2, 0, 100, 1, 10), nrow = 1) + + response <- result$fct(dose_vec, parm_mat) + + expect_true(is.numeric(response)) + expect_equal(length(response), length(dose_vec)) + expect_true(all(is.finite(response))) +}) + +test_that("ucedergreen fct implements correct u-shaped formula f(x)=c+d-numTerm/denTerm", { + # f(x) = c + d - (d - c + f*exp(-1/x^alpha)) / (1 + exp(b*(log(x) - log(e)))) + result <- ucedergreen(alpha = 1) + + dose <- 1 + b <- 2; c_val <- 10; d <- 100; e <- 5; f_val <- 20 + parm_mat <- matrix(c(b, c_val, d, e, f_val), nrow = 1) + + response <- result$fct(dose, parm_mat) + + # Manual calculation + numTerm <- d - c_val + f_val * exp(-1/dose^1) + denTerm <- 1 + exp(b * (log(dose) - log(e))) + expected <- c_val + d - numTerm/denTerm + + expect_equal(response, expected) +}) + +test_that("ucedergreen fct handles fixed c parameter correctly", { + # When c is fixed to 0, the formula should use c=0 + result <- ucedergreen(fixed = c(NA, 0, NA, NA, NA), alpha = 1) + + dose <- 1 + # Parameters are only the non-fixed ones: b, d, e, f + parm_mat <- matrix(c(2, 100, 5, 20), nrow = 1) + + response <- result$fct(dose, parm_mat) + + # Manual calculation with c=0 + b <- 2; c_val <- 0; d <- 100; e <- 5; f_val <- 20 + numTerm <- d - c_val + f_val * exp(-1/dose) + denTerm <- 1 + exp(b * (log(dose) - log(e))) + expected <- c_val + d - numTerm/denTerm + + expect_equal(response, expected) +}) + +test_that("ucedergreen fct handles multiple parameter sets", { + result <- ucedergreen(alpha = 1) + + dose_vec <- c(1, 10) + parm_mat <- matrix(c(2, 0, 100, 1, 10, + 3, 5, 95, 2, 15), nrow = 2, byrow = TRUE) + + response <- result$fct(dose_vec, parm_mat) + + expect_equal(length(response), length(dose_vec)) +}) + +# ============================================================================== +# Tests for the deriv1 function - Issue #3: xlogx availability, Issue #10 +# ============================================================================== + +test_that("ucedergreen deriv1 function can be called", { + result <- ucedergreen(alpha = 1) + + dose_vec <- c(0.1, 1, 10) + parm_mat <- matrix(c(2, 0, 100, 1, 10), nrow = 1) + + derivs <- result$deriv1(dose_vec, parm_mat) + + expect_true(is.matrix(derivs) || is.numeric(derivs)) +}) + +test_that("ucedergreen deriv1 c-derivative is 1 + 1/t3 (not 1/t3)", { + # Verify derivative with respect to c for U-shaped model + result <- ucedergreen(alpha = 1) + + dose <- 5 + b <- 2; c_val <- 10; d <- 100; e <- 5; f_val <- 20 + parm_mat <- matrix(c(b, c_val, d, e, f_val), nrow = 1) + + derivs <- result$deriv1(dose, parm_mat) + + # Manual: d/dc of (c + d - numTerm/denTerm) + # = 1 + 1/denTerm (since numTerm has -c) + t2 <- exp(b * (log(dose) - log(e))) + t3 <- 1 + t2 + expected_dc <- 1 + 1/t3 + + # Second column should be c-derivative + expect_equal(derivs[2], expected_dc, tolerance = 1e-10) +}) + +# ============================================================================== +# Tests for edfct - Issue #2: signature mismatch +# ============================================================================== + +test_that("ucedergreen edfct function accepts correct signature", { + result <- ucedergreen(alpha = 1) + parm_vec <- c(2, 0, 100, 1, 10) + + # Should accept (parm, respl, reference, type, ...) like cedergreen + ed_result <- result$edfct(parm_vec, respl = 50, reference = "control", type = "relative") + + expect_true(is.list(ed_result)) + expect_equal(length(ed_result), 2) +}) + +# ============================================================================== +# Tests for maxfct - Issue #7: signature mismatch +# ============================================================================== + +test_that("ucedergreen maxfct function can be called", { + result <- ucedergreen(alpha = 1) + parm_vec <- c(2, 0, 100, 1, 50) + + max_result <- result$maxfct(parm_vec) + + expect_true(is.numeric(max_result)) + expect_equal(length(max_result), 2) +}) + +test_that("ucedergreen maxfct handles custom bounds", { + result <- ucedergreen(alpha = 1) + parm_vec <- c(2, 0, 100, 1, 10) + + max_result <- result$maxfct(parm_vec, lower = 0.001, upper = 100) + + expect_true(is.numeric(max_result)) + expect_equal(length(max_result), 2) +}) + +test_that("ucedergreen maxfct with fixed parameters reconstructs correctly", { + # Fix c to 0 + result <- ucedergreen(fixed = c(NA, 0, NA, NA, NA), alpha = 1) + parm_vec <- c(2, 100, 1, 50) # b, d, e, f (c is fixed) + + max_result <- result$maxfct(parm_vec) + + expect_true(is.numeric(max_result)) + expect_equal(length(max_result), 2) +}) + +# ============================================================================== +# Error Handling Tests +# ============================================================================== + +test_that("ucedergreen errors when names is not character", { + expect_error( + ucedergreen(names = c(1, 2, 3, 4, 5), alpha = 1), + "Not correct 'names' argument" + ) +}) + +test_that("ucedergreen errors when names has wrong length", { + expect_error( + ucedergreen(names = c("b", "c", "d"), alpha = 1), + "Not correct 'names' argument" + ) +}) + +test_that("ucedergreen errors when fixed has wrong length", { + expect_error( + ucedergreen(fixed = c(NA, NA, NA), alpha = 1), + "Not correct 'fixed' argument" + ) +}) + +test_that("ucedergreen errors when alpha is missing", { + expect_error( + ucedergreen(), + "'alpha' argument must be specified" + ) +}) + +# ============================================================================== +# Tests for self-starter function - Issue #6, #8, #9 +# ============================================================================== + +test_that("ucedergreen ssfct delegates to cedergreen.ssf and negates b", { + result <- ucedergreen(alpha = 1) + + # Create a simple data frame to test the self-starter + dframe <- data.frame(dose = c(0.1, 0.5, 1, 5, 10, 50, 100), + response = c(99, 95, 80, 50, 30, 15, 10)) + + initval <- result$ssfct(dframe) + + # b should be negated (negative for U-shaped) + expect_true(is.numeric(initval)) + expect_equal(length(initval), 5) +}) + +test_that("ucedergreen ssfct respects useFixed flag", { + # Fix c to 0 - should only return 4 initial values + result <- ucedergreen(fixed = c(NA, 0, NA, NA, NA), alpha = 1) + + dframe <- data.frame(dose = c(0.1, 0.5, 1, 5, 10, 50, 100), + response = c(99, 95, 80, 50, 30, 15, 10)) + + initval <- result$ssfct(dframe) + + # Only 4 non-fixed parameters + expect_equal(length(initval), 4) +}) + +# ============================================================================== +# Tests for wrapper functions - Issue #5 (|| vs |), Issue #13 +# ============================================================================== + +test_that("UCRS.4a returns correct structure", { + result <- UCRS.4a() + + expect_s3_class(result, "UCRS") + expect_equal(result$noParm, 4) + expect_equal(length(result$names), 4) +}) + +test_that("UCRS.4b returns correct structure", { + result <- UCRS.4b() + + expect_s3_class(result, "UCRS") + expect_equal(result$noParm, 4) +}) + +test_that("UCRS.4c returns correct structure", { + result <- UCRS.4c() + + expect_s3_class(result, "UCRS") + expect_equal(result$noParm, 4) +}) + +test_that("UCRS.5a returns correct structure", { + result <- UCRS.5a() + + expect_s3_class(result, "UCRS") + expect_equal(result$noParm, 5) + expect_equal(length(result$names), 5) +}) + +test_that("UCRS.5b returns correct structure", { + result <- UCRS.5b() + + expect_s3_class(result, "UCRS") + expect_equal(result$noParm, 5) +}) + +test_that("UCRS.5c returns correct structure", { + result <- UCRS.5c() + + expect_s3_class(result, "UCRS") + expect_equal(result$noParm, 5) +}) + +test_that("UCRS.4a errors with wrong names length", { + expect_error( + UCRS.4a(names = c("a", "b")), + "Not correct 'names' argument" + ) +}) + +test_that("UCRS.5a errors with wrong names length", { + expect_error( + UCRS.5a(names = c("a", "b")), + "Not correct 'names' argument" + ) +}) + +test_that("Aliases work correctly", { + expect_identical(uml3a, UCRS.4a) + expect_identical(uml3b, UCRS.4b) + expect_identical(uml3c, UCRS.4c) + expect_identical(uml4a, UCRS.5a) + expect_identical(uml4b, UCRS.5b) + expect_identical(uml4c, UCRS.5c) +}) diff --git a/tests/testthat/test-ursa.R b/tests/testthat/test-ursa.R new file mode 100644 index 00000000..8908b2e1 --- /dev/null +++ b/tests/testthat/test-ursa.R @@ -0,0 +1,286 @@ +# tests/testthat/test-ursa.R +# Comprehensive tests for R/ursa.R: ursa() and all nested functions + +# ======================================================================== +# Test: ursa() argument validation +# ======================================================================== + +test_that("ursa() errors on invalid 'names' argument - non-character", { + expect_error(ursa(names = c(1, 2, 3, 4, 5, 6, 7)), "Not correct 'names' argument") +}) + +test_that("ursa() errors on invalid 'names' argument - wrong length", { + expect_error(ursa(names = c("a", "b", "c")), "Not correct 'names' argument") +}) + +test_that("ursa() errors on invalid 'fixed' argument - wrong length", { + expect_error(ursa(fixed = c(NA, NA, NA)), "Not correct 'fixed' argument") +}) + +# ======================================================================== +# Test: ursa() return structure with defaults +# ======================================================================== + +test_that("ursa() returns object of class 'ursa'", { + result <- ursa() + expect_s3_class(result, "ursa") +}) + +test_that("ursa() return list has correct structure", { + result <- ursa() + expect_type(result, "list") + expect_true(is.function(result$fct)) + expect_true(is.function(result$ssfct)) + expect_null(result$deriv1) + expect_null(result$deriv2) + expect_null(result$edfct) + expect_null(result$sifct) + expect_equal(result$name, "ursa") + expect_equal(result$text, "URSA") + expect_equal(result$noParm, 7) + expect_equal(result$names, c("b1", "b2", "c", "d", "e1", "e2", "f")) +}) + +# ======================================================================== +# Test: ursa() with fixed parameters +# ======================================================================== + +test_that("ursa() handles fixed parameters correctly", { + result <- ursa(fixed = c(NA, NA, 0, NA, NA, NA, NA)) + expect_equal(result$noParm, 6) + expect_equal(result$names, c("b1", "b2", "d", "e1", "e2", "f")) +}) + +test_that("ursa() handles multiple fixed parameters", { + result <- ursa(fixed = c(-2, -2, 0, NA, NA, NA, 0)) + expect_equal(result$noParm, 3) + expect_equal(result$names, c("d", "e1", "e2")) +}) + +test_that("ursa() handles all parameters fixed", { + result <- ursa(fixed = c(-2, -2, 0, 100, 5, 0.5, 0)) + expect_equal(result$noParm, 0) + expect_length(result$names, 0) +}) + +# ======================================================================== +# Test: ursa() with custom parameter names +# ======================================================================== + +test_that("ursa() respects custom parameter names", { + custom <- c("slope1", "slope2", "lower", "upper", "ed1", "ed2", "syn") + result <- ursa(names = custom) + expect_equal(result$names, custom) +}) + +# ======================================================================== +# Test: ursa() custom ssfct handling +# ======================================================================== + +test_that("ursa() uses custom ssfct when provided", { + custom_ssfct <- function(dframe) { + c(-2, -2, 0, 100, 5, 0.5, 0) + } + result <- ursa(ssfct = custom_ssfct) + dframe <- data.frame(x = 1:5, y = 5:1, z = 1:5) + expect_equal(result$ssfct(dframe), c(-2, -2, 0, 100, 5, 0.5, 0)) +}) + +# ======================================================================== +# Test: fct (the nonlinear model function) +# ======================================================================== + +test_that("ursa fct returns d when both doses are zero (both infinite path)", { + # When both dose components are 0, e1/dose1 and e2/dose2 are Inf + # The function should return d (the upper asymptote) + result <- ursa(fixed = c(NA, NA, 0, NA, NA, NA, NA)) + + dose <- matrix(c(0, 0), ncol = 2, byrow = TRUE) + # parm columns: b1, b2, d, e1, e2, f (c fixed at 0) + parm <- matrix(c(-2, -2, 100, 5, 0.5, 0), ncol = 6, byrow = TRUE) + + res <- result$fct(dose, parm) + expect_equal(res, 100) +}) + +test_that("ursa fct computes correct values for normal doses", { + result <- ursa(fixed = c(NA, NA, 0, NA, NA, NA, NA)) + + # Both drugs present + dose <- matrix(c(10, 1), ncol = 2, byrow = TRUE) + parm <- matrix(c(-2, -2, 100, 5, 0.5, 0), ncol = 6, byrow = TRUE) + + res <- result$fct(dose, parm) + expect_type(res, "double") + expect_length(res, 1) + expect_true(is.finite(res)) + # Response should be between c (0) and d (100) + expect_gt(res, 0) + expect_lt(res, 100) +}) + +test_that("ursa fct handles multiple observations", { + result <- ursa(fixed = c(NA, NA, 0, NA, NA, NA, NA)) + + dose <- matrix(c( + 0, 0, # both zero + 10, 0, # only drug 1 + 0, 1, # only drug 2 + 10, 1 # both drugs + ), ncol = 2, byrow = TRUE) + + parm <- matrix( + rep(c(-2, -2, 100, 5, 0.5, 0), 4), + ncol = 6, byrow = TRUE + ) + + res <- result$fct(dose, parm) + expect_length(res, 4) + # First observation (0,0) should return d=100 + expect_equal(res[1], 100) + # All others should be finite + expect_true(all(is.finite(res))) +}) + +test_that("ursa fct returns NA when bisection fails (try-error path)", { + result <- ursa(fixed = c(NA, NA, 0, NA, NA, NA, NA)) + + dose <- matrix(c(10, 1), ncol = 2, byrow = TRUE) + # b1 = 0 causes 1/b1 = Inf, leading to error in bisection + parm <- matrix(c(0, -2, 100, 5, 0.5, 0), ncol = 6, byrow = TRUE) + + res <- result$fct(dose, parm) + expect_true(is.na(res)) +}) + +test_that("ursa fct covers both branches of bisec if/else", { + # The bisec function has: if (fu(fuMiddle) > 0) {fuHigh <- fuMiddle} else {fuLow <- fuMiddle} + # Normal use of fct exercises both branches during the 25-iteration bisection + result <- ursa(fixed = c(NA, NA, 0, NA, NA, NA, NA)) + + dose <- matrix(c(5, 0.5), ncol = 2, byrow = TRUE) + parm <- matrix(c(-2, -2, 100, 10, 1, 0), ncol = 6, byrow = TRUE) + + res <- result$fct(dose, parm) + expect_true(is.finite(res)) + expect_gt(res, 0) + expect_lt(res, 100) +}) + +# ======================================================================== +# Test: fct with only one dose component zero (one infinite path) +# ======================================================================== + +test_that("ursa fct handles one drug zero, other nonzero", { + result <- ursa(fixed = c(NA, NA, 0, NA, NA, NA, NA)) + + # Drug 2 is zero → dose[,2] is 0 → parmVec[6] = e2/0 = Inf + # Only parmVec[5] is finite → else branch taken + dose_d2zero <- matrix(c(10, 0), ncol = 2, byrow = TRUE) + parm <- matrix(c(-2, -2, 100, 5, 0.5, 0), ncol = 6, byrow = TRUE) + + res <- result$fct(dose_d2zero, parm) + expect_true(is.finite(res)) + expect_gt(res, 0) + expect_lt(res, 100) + + # Drug 1 is zero → dose[,1] is 0 → parmVec[5] = e1/0 = Inf + dose_d1zero <- matrix(c(0, 1), ncol = 2, byrow = TRUE) + + res2 <- result$fct(dose_d1zero, parm) + expect_true(is.finite(res2)) + expect_gt(res2, 0) + expect_lt(res2, 100) +}) + +# ======================================================================== +# Test: default ssfct - both branches +# ======================================================================== + +test_that("ursa default ssfct works with b >= 0 path", { + # The Greco example data produces positive b from LL.4 + d1 <- c(0, 0, 0, 0, 0, 0, 0, 0, 2, 5, 10, 20, 50, 2, 2, 2, + 2, 2, 5, 5, 5, 5, 5, 10, 10, 10, 10, 10, 20, 20, 20, 20, + 20, 50, 50, 50, 50, 50) + d2 <- c(0, 0, 0, 0.2, 0.5, 1, 2, 5, 0, 0, 0, 0, 0, 0.2, + 0.5, 1, 2, 5, 0.2, 0.5, 1, 2, 5, 0.2, 0.5, 1, 2, 5, 0.2, + 0.5, 1, 2, 5, 0.2, 0.5, 1, 2, 5) + effect <- c(106, 99.2, 115, 79.2, 70.1, 49, 21, 3.83, 74.2, + 71.5, 48.1, 30.9, 16.3, 76.3, 48.8, 44.5, 15.5, 3.21, + 56.7, 47.5, 26.8, 16.9, 3.25, 46.7, 35.6, 21.5, 11.1, + 2.94, 24.8, 21.6, 17.3, 7.78, 1.84, 13.6, 11.1, 6.43, + 3.34, 0.89) + dframe <- data.frame(d1, d2, effect) + + result <- ursa(fixed = c(NA, NA, 0, NA, NA, NA, NA)) + ss <- result$ssfct(dframe) + + expect_type(ss, "double") + expect_length(ss, 6) # 6 free parameters (c is fixed) + expect_true(all(is.finite(ss))) +}) + +test_that("ursa default ssfct works with b < 0 path", { + # Inverted data produces negative b from LL.4 + d1 <- c(0, 0, 0, 0, 0, 0, 0, 0, 2, 5, 10, 20, 50, 2, 2, 2, + 2, 2, 5, 5, 5, 5, 5, 10, 10, 10, 10, 10, 20, 20, 20, 20, + 20, 50, 50, 50, 50, 50) + d2 <- c(0, 0, 0, 0.2, 0.5, 1, 2, 5, 0, 0, 0, 0, 0, 0.2, + 0.5, 1, 2, 5, 0.2, 0.5, 1, 2, 5, 0.2, 0.5, 1, 2, 5, 0.2, + 0.5, 1, 2, 5, 0.2, 0.5, 1, 2, 5) + effect_raw <- c(106, 99.2, 115, 79.2, 70.1, 49, 21, 3.83, 74.2, + 71.5, 48.1, 30.9, 16.3, 76.3, 48.8, 44.5, 15.5, 3.21, + 56.7, 47.5, 26.8, 16.9, 3.25, 46.7, 35.6, 21.5, 11.1, + 2.94, 24.8, 21.6, 17.3, 7.78, 1.84, 13.6, 11.1, 6.43, + 3.34, 0.89) + # Invert the response to get negative b + effect <- 120 - effect_raw + dframe <- data.frame(d1, d2, effect) + + result <- ursa(fixed = c(NA, NA, 0, NA, NA, NA, NA)) + ss <- result$ssfct(dframe) + + expect_type(ss, "double") + expect_length(ss, 6) # 6 free parameters (c is fixed) + expect_true(all(is.finite(ss))) +}) + +# ======================================================================== +# Test: Full model fitting with drm (integration test) +# ======================================================================== + +test_that("ursa works with drm for the Greco example", { + d1 <- c(0, 0, 0, 0, 0, 0, 0, 0, 2, 5, 10, 20, 50, 2, 2, 2, + 2, 2, 5, 5, 5, 5, 5, 10, 10, 10, 10, 10, 20, 20, 20, 20, + 20, 50, 50, 50, 50, 50) + d2 <- c(0, 0, 0, 0.2, 0.5, 1, 2, 5, 0, 0, 0, 0, 0, 0.2, + 0.5, 1, 2, 5, 0.2, 0.5, 1, 2, 5, 0.2, 0.5, 1, 2, 5, 0.2, + 0.5, 1, 2, 5, 0.2, 0.5, 1, 2, 5) + effect <- c(106, 99.2, 115, 79.2, 70.1, 49, 21, 3.83, 74.2, + 71.5, 48.1, 30.9, 16.3, 76.3, 48.8, 44.5, 15.5, 3.21, + 56.7, 47.5, 26.8, 16.9, 3.25, 46.7, 35.6, 21.5, 11.1, + 2.94, 24.8, 21.6, 17.3, 7.78, 1.84, 13.6, 11.1, 6.43, + 3.34, 0.89) + greco <- data.frame(d1, d2, effect) + + greco_model <- drm(effect ~ d1 + d2, data = greco, + fct = ursa(fixed = c(NA, NA, 0, NA, NA, NA, NA))) + + expect_s3_class(greco_model, "drc") + expect_length(coef(greco_model), 6) +}) + +# ======================================================================== +# Test: fct with all parameters free (no fixed) +# ======================================================================== + +test_that("ursa fct works with all 7 parameters free", { + result <- ursa() + + dose <- matrix(c(10, 1), ncol = 2, byrow = TRUE) + # All 7 parameters: b1, b2, c, d, e1, e2, f + parm <- matrix(c(-2, -2, 0, 100, 5, 0.5, 0), ncol = 7, byrow = TRUE) + + res <- result$fct(dose, parm) + expect_true(is.finite(res)) +}) diff --git a/tests/testthat/test-utilities.R b/tests/testthat/test-utilities.R new file mode 100644 index 00000000..b68c3e71 --- /dev/null +++ b/tests/testthat/test-utilities.R @@ -0,0 +1,564 @@ +# Test additional utility and model functions + +# Create test datasets +ryegrass <- data.frame( + rootl = c( + 7.58, 8.00, 8.33, 7.25, 7.17, 7.00, 7.17, 7.83, 7.92, 7.58, + 6.17, 5.75, 5.83, 6.00, 5.83, 4.92, 4.50, 4.17, 4.42, 4.00, + 2.67, 2.08, 2.42, 2.50, 2.25, 1.17, 0.75, 0.92, 1.00, 0.58 + ), + conc = c( + rep(0, 5), rep(0.94, 5), rep(1.88, 5), + rep(3.75, 5), rep(7.50, 5), rep(15, 5) + ) +) + +set.seed(42) +multi_data <- data.frame( + dose = rep(c(0, 0.5, 1, 2, 5, 10), each = 5, times = 2), + resp = c( + rnorm(5, 100, 5), rnorm(5, 95, 5), rnorm(5, 85, 5), + rnorm(5, 60, 5), rnorm(5, 20, 5), rnorm(5, 5, 5), + rnorm(5, 100, 5), rnorm(5, 90, 5), rnorm(5, 70, 5), + rnorm(5, 40, 5), rnorm(5, 10, 5), rnorm(5, 3, 5) + ), + group = rep(c("A", "B"), each = 30) +) + +# Tests for update.drc() + +test_that("update.drc can update model function", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + m2 <- update(m1, fct = LL.3()) + + expect_true(inherits(m2, "drc")) + expect_equal(length(coef(m2)), 3) + expect_equal(length(coef(m1)), 4) +}) + +test_that("update.drc can update data", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Create modified dataset + ryegrass_subset <- ryegrass[1:20, ] + m2 <- update(m1, data = ryegrass_subset) + + expect_true(inherits(m2, "drc")) + expect_equal(nrow(m2$data), 20) +}) + +test_that("update.drc preserves original model when nothing changed", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + m2 <- update(m1) + + expect_equal(coef(m1), coef(m2)) +}) + +test_that("update.drc works when model fitted inside lapply (unresolvable data symbol)", { + datasets <- list(ryegrass, ryegrass) + models <- lapply(datasets, function(.x) { + drm(rootl ~ conc, data = .x, fct = LL.4()) + }) + + # update() should work even though .x is no longer in scope + m2 <- update(models[[1]], fct = LL.3()) + expect_true(inherits(m2, "drc")) + expect_equal(length(coef(m2)), 3) + + # update() with no changes should also work + m3 <- update(models[[1]]) + expect_equal(coef(models[[1]]), coef(m3)) +}) + +# Tests for logLik.drc() + +test_that("logLik.drc returns log-likelihood value", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + ll <- logLik(m1) + + expect_true(is.numeric(ll)) + expect_equal(length(ll), 1) + expect_true(ll < 0) # Log-likelihood is typically negative +}) + +test_that("logLik.drc has df attribute", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + ll <- logLik(m1) + + expect_true("df" %in% names(attributes(ll))) + # df includes model parameters plus the error variance parameter + expect_equal(attr(ll, "df"), length(coef(m1)) + 1) +}) + +test_that("logLik.drc works with different model types", { + m_ll3 <- drm(rootl ~ conc, data = ryegrass, fct = LL.3()) + m_ll4 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + ll3 <- logLik(m_ll3) + ll4 <- logLik(m_ll4) + + # LL.4 should have higher log-likelihood (better fit with more parameters) + expect_true(ll4 > ll3) +}) + +# Tests for anova.drc() + +test_that("anova.drc compares two models", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.3()) + m2 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + result <- anova(m1, m2) + + expect_true(is.data.frame(result) || is.matrix(result)) + expect_true(nrow(result) >= 2) +}) + +test_that("anova.drc returns valid p-values", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.3()) + m2 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + result <- anova(m1, m2, details = FALSE) + + # Find p-value column + p_col <- which(grepl("p.value|p value|Pr\\(", colnames(result), ignore.case = TRUE)) + if (length(p_col) > 0) { + p_values <- result[, p_col] + p_values <- p_values[!is.na(p_values)] + if (length(p_values) > 0) { + expect_true(all(p_values >= 0 & p_values <= 1)) + } + } +}) + +test_that("anova.drc with single model directs to modelFit", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + expect_error(anova(m1, test = "Chi"), "modelFit") +}) + +test_that("modelFit performs lack-of-fit test for single model", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + result <- modelFit(m1) + + expect_true(is.data.frame(result) || inherits(result, "anova")) +}) + +# Tests for df.residual() + +test_that("df.residual returns correct degrees of freedom", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + df <- df.residual(m1) + + expect_true(is.numeric(df)) + expect_equal(length(df), 1) + expect_true(df > 0) + expect_equal(df, nrow(ryegrass) - length(coef(m1))) +}) + +# Tests for AIC and BIC + +test_that("AIC works with drc models", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + aic_val <- AIC(m1) + + expect_true(is.numeric(aic_val)) + expect_equal(length(aic_val), 1) +}) + +test_that("BIC works with drc models", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + bic_val <- BIC(m1) + + expect_true(is.numeric(bic_val)) + expect_equal(length(bic_val), 1) +}) + +test_that("AIC and BIC can compare models", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.3()) + m2 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + aic1 <- AIC(m1) + aic2 <- AIC(m2) + + bic1 <- BIC(m1) + bic2 <- BIC(m2) + + # Both should be numeric + expect_true(is.numeric(aic1) && is.numeric(aic2)) + expect_true(is.numeric(bic1) && is.numeric(bic2)) +}) + +# Tests for boxcox.drc() + +test_that("boxcox.drc works with Box-Cox transformation", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4(), bcVal = 0) + + expect_true(!is.null(m1$boxcox)) + expect_true(is.list(m1$boxcox)) +}) + +test_that("boxcox.drc model can make predictions", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4(), bcVal = 0) + + predictions <- predict(m1) + expect_true(length(predictions) == nrow(ryegrass)) + expect_true(all(is.finite(predictions))) +}) + +# Tests for modelFit() and related functions + +test_that("drm creates valid model object structure", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Check essential components + expect_true("coefficients" %in% names(m1)) + expect_true("fct" %in% names(m1)) + expect_true("fit" %in% names(m1)) + expect_true("data" %in% names(m1)) + expect_true("call" %in% names(m1)) +}) + +test_that("drm with start values", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4(), + start = c(2, 0.5, 8, 3)) + + expect_true(inherits(m1, "drc")) + expect_equal(length(coef(m1)), 4) +}) + +test_that("drm with weights", { + weights <- rep(1, nrow(ryegrass)) + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4(), + weights = weights) + + expect_true(inherits(m1, "drc")) + expect_true(!is.null(m1$weights)) +}) + +test_that("drm with subset", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4(), + subset = conc < 10) + + expect_true(inherits(m1, "drc")) + expect_true(nrow(m1$data) < nrow(ryegrass)) +}) + +# Tests for formula handling + +test_that("drm formula with different specifications", { + # Standard formula + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + expect_true(inherits(m1, "drc")) + + # With curveid + m2 <- drm(resp ~ dose, curveid = group, data = multi_data, fct = LL.4()) + expect_true(inherits(m2, "drc")) +}) + +# Tests for different dose-response functions + +test_that("drm works with log-logistic functions", { + m_ll2 <- drm(rootl ~ conc, data = ryegrass, fct = LL.2()) + m_ll3 <- drm(rootl ~ conc, data = ryegrass, fct = LL.3()) + m_ll4 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + m_ll5 <- drm(rootl ~ conc, data = ryegrass, fct = LL.5()) + + expect_equal(length(coef(m_ll2)), 2) + expect_equal(length(coef(m_ll3)), 3) + expect_equal(length(coef(m_ll4)), 4) + expect_equal(length(coef(m_ll5)), 5) +}) + +test_that("drm works with Weibull functions", { + m_w12 <- drm(rootl ~ conc, data = ryegrass, fct = W1.2()) + m_w13 <- drm(rootl ~ conc, data = ryegrass, fct = W1.3()) + m_w14 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) + + expect_equal(length(coef(m_w12)), 2) + expect_equal(length(coef(m_w13)), 3) + expect_equal(length(coef(m_w14)), 4) +}) + +test_that("drm works with two-parameter Weibull", { + m_w22 <- drm(rootl ~ conc, data = ryegrass, fct = W2.2()) + m_w23 <- drm(rootl ~ conc, data = ryegrass, fct = W2.3()) + m_w24 <- drm(rootl ~ conc, data = ryegrass, fct = W2.4()) + + expect_equal(length(coef(m_w22)), 2) + expect_equal(length(coef(m_w23)), 3) + expect_equal(length(coef(m_w24)), 4) +}) + +# Tests for control parameters + +test_that("drm with drmc control", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4(), + control = drmc(errorm = FALSE)) + + expect_true(inherits(m1, "drc")) +}) + +test_that("drm with maxIt control", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4(), + control = drmc(maxIt = 500)) + + expect_true(inherits(m1, "drc")) +}) + +# Tests for robust estimation + +test_that("drm with robust = 'median'", { + m_robust <- drm(rootl ~ conc, data = ryegrass, fct = LL.4(), + robust = "median") + + expect_true(inherits(m_robust, "drc")) + expect_true(!is.null(m_robust$robust)) + expect_equal(m_robust$robust, "median") +}) + +# Tests for different data types + +test_that("drm handles binomial data correctly", { + binom_data <- data.frame( + dose = c(0, 0.1, 0.5, 1, 2, 5, 10), + resp = c(0, 0.05, 0.15, 0.35, 0.65, 0.90, 0.98), + n = rep(50, 7) + ) + m_binom <- drm(resp ~ dose, data = binom_data, fct = LL.2(), + type = "binomial", weights = n) + + expect_true(inherits(m_binom, "drc")) + expect_equal(m_binom$type, "binomial") +}) + +test_that("drm handles Poisson data correctly", { + poisson_data <- data.frame( + dose = c(0, 1, 2, 4, 8, 16, 32), + count = c(50, 48, 40, 25, 10, 3, 1) + ) + m_poisson <- drm(count ~ dose, data = poisson_data, fct = LL.4(), + type = "Poisson") + + expect_true(inherits(m_poisson, "drc")) + expect_equal(m_poisson$type, "Poisson") +}) + +# Tests for model validation functions + +test_that("drm model has proper class", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + expect_true(inherits(m1, "drc")) + expect_equal(class(m1), "drc") +}) + +test_that("drm coefficients are named", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + coeffs <- coef(m1) + + expect_true(!is.null(names(coeffs))) + expect_equal(length(names(coeffs)), length(coeffs)) +}) + +# Tests for hatvalues (leverage) + +test_that("hatvalues.drc returns leverage values", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Check if hatvalues function exists for drc + if (exists("hatvalues.drc") || "hatvalues" %in% methods(class = "drc")) { + hv <- hatvalues(m1) + expect_true(is.numeric(hv)) + expect_equal(length(hv), nrow(ryegrass)) + expect_true(all(hv >= 0 & hv <= 1)) + } +}) + +# Tests for cooks.distance + +test_that("cooks.distance.drc returns influence measures", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Check if cooks.distance function exists for drc + if (exists("cooks.distance.drc") || "cooks.distance" %in% methods(class = "drc")) { + cd <- cooks.distance(m1) + expect_true(is.numeric(cd)) + expect_equal(length(cd), nrow(ryegrass)) + expect_true(all(cd >= 0)) + } +}) + +# Integration tests + +test_that("Complete workflow: fit, summarize, predict, plot", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Summarize + summ <- summary(m1) + expect_true(is.list(summ)) + + # Predict + newdata <- data.frame(conc = c(1, 2, 3)) + pred <- predict(m1, newdata = newdata) + expect_equal(length(pred), 3) + + # ED values + ed50 <- ED(m1, 50, display = FALSE) + expect_true(is.matrix(ed50)) + + # Plot + expect_no_error({ + pdf(file = tempfile()) + plot(m1) + dev.off() + }) +}) + +test_that("Model comparison workflow", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.3()) + m2 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + + # Compare AIC + aic1 <- AIC(m1) + aic2 <- AIC(m2) + expect_true(is.numeric(aic1) && is.numeric(aic2)) + + # ANOVA comparison + comp <- anova(m1, m2) + expect_true(nrow(comp) >= 2) + + # Log-likelihood comparison + ll1 <- logLik(m1) + ll2 <- logLik(m2) + expect_true(ll2 > ll1) # More parameters should give better fit +}) + +# Tests for comped() input validation + +test_that("comped validates est parameter", { + expect_error(comped(est = "not numeric", se = c(1, 2)), + "'est' must be a numeric vector of length 2") + expect_error(comped(est = c(1), se = c(1, 2)), + "'est' must be a numeric vector of length 2") + expect_error(comped(est = c(1, 2, 3), se = c(1, 2)), + "'est' must be a numeric vector of length 2") + expect_error(comped(est = NULL, se = c(1, 2)), + "'est' must be a numeric vector of length 2") +}) + +test_that("comped validates se parameter", { + expect_error(comped(est = c(1, 2), se = "not numeric"), + "'se' must be a numeric vector of length 2") + expect_error(comped(est = c(1, 2), se = c(-1, 2)), + "'se' must contain non-negative values") +}) + +test_that("comped validates level parameter", { + expect_error(comped(est = c(1, 2), se = c(0.5, 0.5), level = 0), + "'level' must be a single numeric value between 0 and 1") + expect_error(comped(est = c(1, 2), se = c(0.5, 0.5), level = 1), + "'level' must be a single numeric value between 0 and 1") + expect_error(comped(est = c(1, 2), se = c(0.5, 0.5), level = 1.5), + "'level' must be a single numeric value between 0 and 1") +}) + +test_that("comped works correctly with valid inputs", { + result <- comped(c(28.396, 65.573), c(1.875, 5.619), log = FALSE, operator = "/") + expect_true(is.matrix(result)) + expect_equal(ncol(result), 4) # Estimate, Std. Error, Lower, Upper +}) + +# Tests for compParm() input validation + +test_that("compParm validates strVal parameter", { + m1 <- drm(resp ~ dose, group, data = multi_data, fct = LL.4()) + expect_error(compParm(m1, strVal = 123), + "'strVal' must be a single character string") + expect_error(compParm(m1, strVal = c("b", "c")), + "'strVal' must be a single character string") +}) + +test_that("compParm validates operator parameter", { + m1 <- drm(resp ~ dose, group, data = multi_data, fct = LL.4()) + expect_error(compParm(m1, strVal = "b", operator = "*"), + "'operator' must be either '/' or '-'") +}) + +# Tests for Rsq() + +test_that("Rsq returns valid R-squared for single curve model", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + result <- capture.output(rsq <- Rsq(m1)) + expect_true(is.matrix(rsq)) + expect_equal(nrow(rsq), 1) + expect_equal(ncol(rsq), 1) + expect_true(rsq[1, 1] >= 0 && rsq[1, 1] <= 1) +}) + +test_that("Rsq returns per-curve and total R-squared for multi-curve model", { + m1 <- drm(resp ~ dose, group, data = multi_data, fct = LL.4()) + result <- capture.output(rsq <- Rsq(m1)) + expect_true(is.matrix(rsq)) + expect_equal(nrow(rsq), 3) # 2 curves + total + expect_true(all(rsq[, 1] >= 0 & rsq[, 1] <= 1)) + expect_equal(rownames(rsq)[3], "Total") +}) + +# Tests for absToRel() + +test_that("absToRel converts absolute to relative correctly", { + parmVec <- c(1, 0, 100) # b, lower, upper + result <- absToRel(parmVec, 50, "absolute") + expect_equal(result, 50) + + result2 <- absToRel(parmVec, 75, "absolute") + expect_equal(result2, 25) +}) + +test_that("absToRel returns input unchanged for non-absolute type", { + parmVec <- c(1, 0, 100) + result <- absToRel(parmVec, 50, "relative") + expect_equal(result, 50) +}) + +test_that("absToRel errors when upper equals lower asymptote", { + parmVec <- c(1, 50, 50) # upper == lower + expect_error(absToRel(parmVec, 50, "absolute"), + "upper and lower asymptotes are equal") +}) + +test_that("compParm passes od and pool to vcov when using default vcov", { + # Create binomial multi-curve data + binom_multi <- data.frame( + dose = rep(c(0, 0.1, 0.5, 1, 2, 5, 10), times = 2), + resp = c(0, 0.05, 0.15, 0.35, 0.65, 0.90, 0.98, + 0, 0.03, 0.10, 0.25, 0.55, 0.85, 0.95), + n = rep(50, 14), + group = rep(c("A", "B"), each = 7) + ) + m_binom <- drm(resp ~ dose, curveid = group, data = binom_multi, fct = LL.2(), + type = "binomial", weights = n) + + # compParm with od=FALSE (default) should work + result_no_od <- compParm(m_binom, "b", operator = "-", display = FALSE) + expect_true(is.matrix(result_no_od)) + expect_equal(ncol(result_no_od), 4) + + # compParm with od=TRUE should produce different standard errors + result_od <- compParm(m_binom, "b", operator = "-", od = TRUE, display = FALSE) + expect_true(is.matrix(result_od)) + expect_equal(ncol(result_od), 4) + + # Estimates should be the same, but SEs may differ with od adjustment + expect_equal(result_no_od[, 1], result_od[, 1]) +}) + +test_that("compParm works with custom vcov function without od/pool", { + m1 <- drm(resp ~ dose, group, data = multi_data, fct = LL.4()) + # Custom vcov function that only accepts object + custom_vcov <- function(object) vcov(object) + result <- compParm(m1, "b", operator = "-", vcov. = custom_vcov, display = FALSE) + expect_true(is.matrix(result)) + expect_equal(ncol(result), 4) +}) diff --git a/tests/testthat/test-vcov.drc.R b/tests/testthat/test-vcov.drc.R new file mode 100644 index 00000000..dd9d0fad --- /dev/null +++ b/tests/testthat/test-vcov.drc.R @@ -0,0 +1,47 @@ +# Regression test for DoseResponse/drc#36: +# summary() must not crash for binomial models with a singular Hessian. + +test_that("vcDisc returns NA matrix (not an error) for a singular Hessian", { + # Use a negative definite Hessian so that all fallback paths fail: + # solve() fails (singular/non-invertible in the expected sense), + # chol() fails (not positive definite), and the regularised + # chol(0.99*H + 0.01*I) also fails (still not positive definite). + fake_obj <- list(fit = list(hessian = matrix(c(-100, 0, 0, -100), 2, 2))) + expect_warning( + result <- drc:::vcDisc(fake_obj), + "Hessian is singular" + ) + expect_true(is.matrix(result)) + expect_equal(dim(result), c(2L, 2L)) + expect_true(all(is.na(result))) +}) + +test_that("summary() does not error for increasing-trend binomial W1.4 model", { + # Exact reproducer from DoseResponse/drc#36 + dataframe <- data.frame( + conc = c(0, 0.944, 2.18, 4.14, 8.37, 16.1), + total = c(160, 80, 80, 80, 80, 80), + response = c(3, 1, 1, 5, 8, 80) + ) + m <- drm(response / total ~ conc, weights = total, data = dataframe, + fct = W1.4(), type = "binomial") + # Must not throw; may produce NA standard errors if Hessian is singular + expect_no_error(suppressWarnings(summary(m))) + summ <- suppressWarnings(summary(m)) + expect_s3_class(summ, "summary.drc") + expect_true("coefficients" %in% names(summ)) +}) + +test_that("summary() still works for well-conditioned binomial model (non-regression)", { + binom_data <- data.frame( + dose = c(0, 0.1, 0.5, 1, 2, 5, 10), + resp = c(0, 0.05, 0.15, 0.35, 0.65, 0.90, 0.98), + n = rep(50, 7) + ) + m <- drm(resp ~ dose, data = binom_data, fct = LL.2(), + type = "binomial", weights = n) + summ <- summary(m) + expect_s3_class(summ, "summary.drc") + # Standard errors should be finite for a well-conditioned fit + expect_true(all(is.finite(summ$coefficients[, "Std. Error"]))) +}) diff --git a/tests/testthat/test-voelund.R b/tests/testthat/test-voelund.R new file mode 100644 index 00000000..97a0602e --- /dev/null +++ b/tests/testthat/test-voelund.R @@ -0,0 +1,131 @@ +# ============================================================================== +# Tests for voelund() function from R/voelund.R +# ============================================================================== + +# --- Correctness: Default construction ---------------------------------------- + +test_that("voelund returns correct structure with default parameters", { + v <- voelund() + expect_s3_class(v, "Voelund") + expect_equal(v$name, "voelund") + expect_equal(v$text, "Voelund mixture") + expect_equal(v$noParm, 7) + expect_equal(v$names, c("b", "c", "d", "e", "f", "g", "h")) + expect_true(is.function(v$fct)) + expect_true(is.function(v$ssfct)) + expect_true(is.function(v$scaleFct)) + expect_null(v$deriv1) + expect_null(v$deriv2) + expect_null(v$edfct) + expect_null(v$sifct) +}) + +# --- Correctness: Fixed parameters -------------------------------------------- + +test_that("voelund returns correct structure with fixed parameters", { + v <- voelund(fixed = c(NA, 0, 1, NA, NA, NA, NA)) + expect_equal(v$noParm, 5) + expect_equal(v$names, c("b", "e", "f", "g", "h")) +}) + +# --- Error handling: invalid names argument ----------------------------------- + +test_that("voelund errors on incorrect names argument", { + # Wrong length + expect_error(voelund(names = c("a")), "Not correct 'names' argument") + # Not character type + expect_error(voelund(names = c(1, 2, 3, 4, 5, 6, 7)), "Not correct 'names' argument") +}) + +# --- Error handling: invalid fixed argument ----------------------------------- + +test_that("voelund errors on incorrect fixed argument", { + expect_error(voelund(fixed = c(NA, NA)), "Not correct 'fixed' argument") +}) + +# --- Correctness: fct computes correct values for normal doses ---------------- + +test_that("voelund fct computes correct values for normal doses", { + v <- voelund() + dose <- c(0.1, 1, 10, 100) + parm <- matrix(c(-2, 0, 1, 10, 10, 1, 1), nrow = 4, ncol = 7, byrow = TRUE) + result <- v$fct(dose, parm) + expect_length(result, 4) + expect_true(all(is.finite(result))) +}) + +# --- Edge case: zero dose handled by eps threshold ---------------------------- + +test_that("voelund fct handles zero dose correctly", { + v <- voelund() + dose <- c(0, 1, 10) + parm <- matrix(c(-2, 0, 1, 10, 10, 1, 1), nrow = 3, ncol = 7, byrow = TRUE) + result <- v$fct(dose, parm) + # When dose < eps (zero), result should be d parameter (column 3) + expect_equal(result[1], 1) +}) + +# --- Edge case: infinite e parameter ----------------------------------------- + +test_that("voelund fct handles infinite e parameter", { + v <- voelund() + dose <- c(0.1, 1, 10) + parm <- matrix(c(-2, 0, 1, 10, 10, 1, 1), nrow = 3, ncol = 7, byrow = TRUE) + parm[2, 4] <- Inf # e parameter = Inf for row 2 + result <- v$fct(dose, parm) + expect_length(result, 3) + # When e is Inf, loge should use log(f) instead + expect_true(is.finite(result[1])) + expect_true(is.finite(result[3])) +}) + +# --- Edge case: infinite f parameter ----------------------------------------- + +test_that("voelund fct handles infinite f parameter", { + v <- voelund() + dose <- c(0.1, 1, 10) + parm <- matrix(c(-2, 0, 1, 10, 10, 1, 1), nrow = 3, ncol = 7, byrow = TRUE) + parm[2, 5] <- Inf # f parameter = Inf for row 2 + result <- v$fct(dose, parm) + expect_length(result, 3) + # When f is Inf, loge should use log(e) instead + expect_true(is.finite(result[1])) + expect_true(is.finite(result[3])) +}) + +# --- Correctness: default ssfct returns valid starting values ----------------- + +test_that("voelund default ssfct returns valid starting values", { + v <- voelund() + df <- data.frame(dose = c(0.01, 0.1, 1, 10, 100), + resp = c(1, 0.95, 0.5, 0.1, 0.01)) + ss <- v$ssfct(df) + expect_length(ss, 7) + expect_true(all(is.finite(ss))) +}) + +# --- Correctness: custom ssfct is used when provided -------------------------- + +test_that("voelund with custom ssfct", { + custom_ss <- function(dframe) rep(1, 7) + v <- voelund(ssfct = custom_ss) + df <- data.frame(dose = 1:5, resp = 5:1) + result <- v$ssfct(df) + expect_equal(result, rep(1, 7)) +}) + +# --- Correctness: scaleFct returns correct scaling ---------------------------- + +test_that("voelund scaleFct returns correct scaling", { + v <- voelund() + sf <- v$scaleFct(10, 100) + expect_equal(sf, c(1, 100, 100, 10, 10, 1, 1)) +}) + +# --- Correctness: scaleFct respects fixed parameters -------------------------- + +test_that("voelund scaleFct respects fixed parameters", { + v <- voelund(fixed = c(NA, 0, NA, NA, NA, NA, NA)) + sf <- v$scaleFct(10, 100) + expect_equal(sf, c(1, 100, 10, 10, 1, 1)) +}) diff --git a/tests/testthat/test-weibull1.R b/tests/testthat/test-weibull1.R new file mode 100644 index 00000000..cab54cae --- /dev/null +++ b/tests/testthat/test-weibull1.R @@ -0,0 +1,291 @@ +# Tests for weibull1.R: weibull1(), W1.2(), W1.3(), W1.3u(), W1.4() + +# Create test dataset used throughout +ryegrass <- data.frame( + rootl = c( + 7.58, 8.00, 8.33, 7.25, 7.17, 7.00, 7.17, 7.83, 7.92, 7.58, + 6.17, 5.75, 5.83, 6.00, 5.83, 4.92, 4.50, 4.17, 4.42, 4.00, + 2.67, 2.08, 2.42, 2.50, 2.25, 1.17, 0.75, 0.92, 1.00, 0.58 + ), + conc = c( + rep(0, 5), rep(0.94, 5), rep(1.88, 5), + rep(3.75, 5), rep(7.50, 5), rep(15, 5) + ) +) + +# --- weibull1() main function --- + +test_that("weibull1 returns correct class and structure", { + w1 <- weibull1() + expect_s3_class(w1, "Weibull-1") + expect_true(is.list(w1)) + expect_true(all(c("fct", "ssfct", "names", "deriv1", "deriv2", "derivx", + "edfct", "name", "text", "noParm") %in% names(w1))) +}) + +test_that("weibull1 default names are b, c, d, e", { + w1 <- weibull1() + expect_equal(w1$names, c("b", "c", "d", "e")) +}) + +test_that("weibull1 noParm reflects number of NA in fixed", { + w1_full <- weibull1() + expect_equal(w1_full$noParm, 4) + + w1_partial <- weibull1(fixed = c(1, NA, NA, NA)) + expect_equal(w1_partial$noParm, 3) + expect_equal(w1_partial$names, c("c", "d", "e")) +}) + +test_that("weibull1 errors on invalid names argument", { + expect_error(weibull1(names = c("a", "b")), "Not correct 'names' argument") + expect_error(weibull1(names = 123), "Not correct 'names' argument") +}) + +test_that("weibull1 errors on invalid fixed argument", { + expect_error(weibull1(fixed = c(NA, NA)), "Not correct 'fixed' argument") + expect_error(weibull1(fixed = c(NA, NA, NA)), "Not correct 'fixed' argument") +}) + +test_that("weibull1 uses provided ssfct when not NULL", { + custom_ss <- function(dframe) { c(1, 0, 10, 5) } + w1 <- weibull1(ssfct = custom_ss) + expect_identical(w1$ssfct, custom_ss) +}) + +# --- fct function tests --- + +test_that("weibull1 fct computes correct values", { + w1 <- weibull1() + + # f(x) = c + (d - c) * exp(-exp(b*(log(x) - log(e)))) + # b=1, c=0, d=1, e=2: f(2) = 0 + (1-0)*exp(-exp(1*(log(2)-log(2)))) = exp(-exp(0)) = exp(-1) + dose <- 2 + parm <- matrix(c(1, 0, 1, 2), nrow = 1, ncol = 4) + result <- w1$fct(dose, parm) + expect_equal(as.numeric(result), exp(-1), tolerance = 1e-10) +}) + +test_that("weibull1 fct handles multiple doses", { + w1 <- weibull1() + + dose <- c(1, 2, 4) + parm <- matrix(c(1, 0, 1, 2), nrow = 3, ncol = 4, byrow = TRUE) + result <- w1$fct(dose, parm) + + # Manual calculations + expected <- exp(-exp(1 * (log(dose) - log(2)))) + expect_equal(as.numeric(result), expected, tolerance = 1e-10) +}) + +test_that("weibull1 fct works with fixed parameters", { + # Fix b=1 and c=0 + w1 <- weibull1(fixed = c(1, 0, NA, NA)) + dose <- c(2) + parm <- matrix(c(1, 2), nrow = 1, ncol = 2) # only d and e free + result <- w1$fct(dose, parm) + expected <- 0 + (1 - 0) * exp(-exp(1 * (log(2) - log(2)))) + expect_equal(as.numeric(result), expected, tolerance = 1e-10) +}) + +# --- deriv1 tests --- + +test_that("weibull1 deriv1 returns matrix with correct dimensions", { + w1 <- weibull1() + dose <- c(1, 2, 5) + parm <- matrix(c(1, 0, 1, 2), nrow = 3, ncol = 4, byrow = TRUE) + result <- w1$deriv1(dose, parm) + expect_true(is.matrix(result)) + expect_equal(nrow(result), 3) + expect_equal(ncol(result), 4) +}) + +test_that("weibull1 deriv1 computes finite values", { + w1 <- weibull1() + dose <- c(0.5, 1, 3) + parm <- matrix(c(2, 0, 1, 3), nrow = 3, ncol = 4, byrow = TRUE) + result <- w1$deriv1(dose, parm) + expect_true(all(is.finite(result))) +}) + +# --- derivx tests --- + +test_that("weibull1 derivx returns correct structure", { + w1 <- weibull1() + dose <- c(1, 2, 5) + parm <- matrix(c(1, 0, 1, 2), nrow = 3, ncol = 4, byrow = TRUE) + result <- w1$derivx(dose, parm) + expect_type(result, "double") + expect_length(result, 3) + expect_true(all(is.finite(result))) +}) + +# --- W1.2 wrapper --- + +test_that("W1.2 returns correct class and structure", { + w12 <- W1.2() + expect_s3_class(w12, "Weibull-1") + expect_equal(w12$noParm, 2) + expect_equal(w12$names, c("b", "e")) +}) + +test_that("W1.2 text indicates fixed limits", { + w12 <- W1.2(upper = 1) + expect_true(grepl("lower limit at 0", w12$text)) + expect_true(grepl("upper limit at 1", w12$text)) +}) + +test_that("W1.2 errors on invalid names", { + expect_error(W1.2(names = c("x")), "Not correct 'names' argument") + expect_error(W1.2(names = 99), "Not correct 'names' argument") +}) + +test_that("W1.2 errors on invalid fixed", { + expect_error(W1.2(fixed = c(NA)), "Not correct length of 'fixed' argument") +}) + +# --- W1.3 wrapper --- + +test_that("W1.3 returns correct class and structure", { + w13 <- W1.3() + expect_s3_class(w13, "Weibull-1") + expect_equal(w13$noParm, 3) + expect_equal(w13$names, c("b", "d", "e")) +}) + +test_that("W1.3 text indicates lower limit fixed", { + w13 <- W1.3() + expect_true(grepl("lower limit at 0", w13$text)) +}) + +test_that("W1.3 errors on invalid names", { + expect_error(W1.3(names = c("x")), "Not correct 'names' argument") + expect_error(W1.3(names = 99), "Not correct 'names' argument") +}) + +test_that("W1.3 errors on invalid fixed", { + expect_error(W1.3(fixed = c(NA, NA)), "Not correct length of 'fixed' argument") +}) + +# --- W1.3u wrapper --- + +test_that("W1.3u returns correct class and structure", { + w13u <- W1.3u() + expect_s3_class(w13u, "Weibull-1") + expect_equal(w13u$noParm, 3) + expect_equal(w13u$names, c("b", "c", "e")) +}) + +test_that("W1.3u text indicates upper limit fixed", { + w13u <- W1.3u(upper = 1) + expect_true(grepl("upper limit at 1", w13u$text)) +}) + +test_that("W1.3u errors on invalid names", { + expect_error(W1.3u(names = c("x")), "Not correct 'names' argument") + expect_error(W1.3u(names = 99), "Not correct 'names' argument") +}) + +test_that("W1.3u errors on invalid fixed", { + expect_error(W1.3u(fixed = c(NA, NA)), "Not correct length of 'fixed' argument") +}) + +# --- W1.4 wrapper --- + +test_that("W1.4 returns correct class and structure", { + w14 <- W1.4() + expect_s3_class(w14, "Weibull-1") + expect_equal(w14$noParm, 4) + expect_equal(w14$names, c("b", "c", "d", "e")) +}) + +test_that("W1.4 text is standard", { + w14 <- W1.4() + expect_equal(w14$text, "Weibull (type 1)") +}) + +test_that("W1.4 errors on invalid fixed", { + expect_error(W1.4(fixed = c(NA, NA, NA)), "Not correct length of 'fixed' argument") +}) + +test_that("W1.4 errors on invalid names", { + expect_error(W1.4(names = c("a", "b")), "Not correct 'names' argument") + expect_error(W1.4(names = 123), "Not correct 'names' argument") +}) + +# --- Aliases --- + +test_that("w2, w3, w4 are aliases for W1.2, W1.3, W1.4", { + expect_identical(w2, W1.2) + expect_identical(w3, W1.3) + expect_identical(w4, W1.4) +}) + +# --- deriv2 is NULL --- + +test_that("weibull1 deriv2 is NULL", { + w1 <- weibull1() + expect_null(w1$deriv2) +}) + +# --- Integration tests using drm --- + +test_that("W1.4 works in drm model fitting", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) + expect_s3_class(m1, "drc") + expect_equal(length(coef(m1)), 4) + preds <- predict(m1) + expect_true(all(is.finite(preds))) +}) + +test_that("W1.3 works in drm model fitting", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.3()) + expect_s3_class(m1, "drc") + expect_equal(length(coef(m1)), 3) +}) + +# --- EXD.2 wrapper --- + +test_that("EXD.2 returns correct class and structure", { + exd2 <- EXD.2() + expect_s3_class(exd2, "Weibull-1") + expect_equal(exd2$noParm, 2) + expect_equal(exd2$names, c("d", "e")) +}) + +test_that("EXD.2 text indicates lower limit fixed", { + exd2 <- EXD.2() + expect_true(grepl("lower limit at 0", exd2$text)) +}) + +test_that("EXD.2 errors on invalid names", { + expect_error(EXD.2(names = c("x")), "Not correct 'names' argument") + expect_error(EXD.2(names = 99), "Not correct 'names' argument") +}) + +test_that("EXD.2 errors on invalid fixed", { + expect_error(EXD.2(fixed = c(NA)), "Not correct length of 'fixed' argument") +}) + +# --- EXD.3 wrapper --- + +test_that("EXD.3 returns correct class and structure", { + exd3 <- EXD.3() + expect_s3_class(exd3, "Weibull-1") + expect_equal(exd3$noParm, 3) + expect_equal(exd3$names, c("c", "d", "e")) +}) + +test_that("EXD.3 text is correct", { + exd3 <- EXD.3() + expect_equal(exd3$text, "Shifted exponential decay") +}) + +test_that("EXD.3 errors on invalid fixed", { + expect_error(EXD.3(fixed = c(NA, NA)), "Not correct length of 'fixed' argument") +}) + +test_that("EXD.3 errors on invalid names", { + expect_error(EXD.3(names = c("a", "b")), "Not correct 'names' argument") + expect_error(EXD.3(names = 123), "Not correct 'names' argument") +}) diff --git a/tests/testthat/test-weibull2.R b/tests/testthat/test-weibull2.R new file mode 100644 index 00000000..a5ebefdd --- /dev/null +++ b/tests/testthat/test-weibull2.R @@ -0,0 +1,371 @@ +# Tests for weibull2.R: weibull2(), W2.2(), W2.3(), W2.3u(), W2.4(), AR.2(), AR.3() + +# Create test dataset used throughout +ryegrass <- data.frame( + rootl = c( + 7.58, 8.00, 8.33, 7.25, 7.17, 7.00, 7.17, 7.83, 7.92, 7.58, + 6.17, 5.75, 5.83, 6.00, 5.83, 4.92, 4.50, 4.17, 4.42, 4.00, + 2.67, 2.08, 2.42, 2.50, 2.25, 1.17, 0.75, 0.92, 1.00, 0.58 + ), + conc = c( + rep(0, 5), rep(0.94, 5), rep(1.88, 5), + rep(3.75, 5), rep(7.50, 5), rep(15, 5) + ) +) + +# --- weibull2() main function --- + +test_that("weibull2 returns correct class and structure", { + w2 <- weibull2() + expect_s3_class(w2, "Weibull-2") + expect_true(is.list(w2)) + expect_true(all(c("fct", "ssfct", "names", "deriv1", "deriv2", "derivx", + "edfct", "name", "text", "noParm", "fixed") %in% names(w2))) +}) + +test_that("weibull2 default names are b, c, d, e", { + w2 <- weibull2() + expect_equal(w2$names, c("b", "c", "d", "e")) +}) + +test_that("weibull2 noParm reflects number of NA in fixed", { + w2_full <- weibull2() + expect_equal(w2_full$noParm, 4) + + w2_partial <- weibull2(fixed = c(1, NA, NA, NA)) + expect_equal(w2_partial$noParm, 3) + expect_equal(w2_partial$names, c("c", "d", "e")) +}) + +test_that("weibull2 uses default text when fctText not provided", { + w2 <- weibull2() + expect_equal(w2$text, "Weibull (type 2)") +}) + +test_that("weibull2 uses provided fctText", { + w2 <- weibull2(fctText = "Custom text") + expect_equal(w2$text, "Custom text") +}) + +test_that("weibull2 uses provided fctName", { + w2 <- weibull2(fctName = "myFunc") + expect_equal(w2$name, "myFunc") +}) + +test_that("weibull2 errors on invalid names argument", { + expect_error(weibull2(names = c("a", "b")), "Not correct 'names' argument") + expect_error(weibull2(names = 123), "Not correct 'names' argument") +}) + +test_that("weibull2 errors on invalid fixed argument", { + expect_error(weibull2(fixed = c(NA, NA)), "Not correct 'fixed' argument") + expect_error(weibull2(fixed = c(NA, NA, NA)), "Not correct 'fixed' argument") +}) + +test_that("weibull2 uses provided ssfct when not NULL", { + custom_ss <- function(dframe) { c(1, 0, 10, 5) } + w2 <- weibull2(ssfct = custom_ss) + expect_identical(w2$ssfct, custom_ss) +}) + +test_that("weibull2 uses default ssfct when ssfct is NULL", { + w2 <- weibull2(ssfct = NULL) + expect_true(is.function(w2$ssfct)) +}) + +test_that("weibull2 method argument works for self-starter", { + for (m in c("1", "2", "3", "4")) { + w2 <- weibull2(method = m) + expect_true(is.function(w2$ssfct)) + } +}) + +# --- fct (internal nonlinear function) --- + +test_that("weibull2 fct computes correct values", { + w2 <- weibull2() + # Parameters: b=1, c=0, d=100, e=5 + dose <- c(1, 5, 10) + parm <- matrix(c(1, 0, 100, 5), nrow = 3, ncol = 4, byrow = TRUE) + result <- w2$fct(dose, parm) + # f(x) = c + (d - c)(1 - exp(-exp(b(log(x) - log(e))))) + expected <- 0 + (100 - 0) * (1 - exp(-exp(1 * (log(dose) - log(5))))) + expect_equal(result, expected) +}) + +test_that("weibull2 fct works with fixed parameters", { + w2 <- weibull2(fixed = c(1, 0, NA, NA)) + dose <- c(1, 5, 10) + parm <- matrix(c(100, 5), nrow = 3, ncol = 2, byrow = TRUE) + result <- w2$fct(dose, parm) + expected <- 0 + (100 - 0) * (1 - exp(-exp(1 * (log(dose) - log(5))))) + expect_equal(result, expected) +}) + +# --- deriv1 (parameter derivatives) --- + +test_that("weibull2 deriv1 returns matrix with correct dimensions", { + w2 <- weibull2() + dose <- c(1, 5, 10) + parm <- matrix(c(1, 0, 100, 5), nrow = 3, ncol = 4, byrow = TRUE) + result <- w2$deriv1(dose, parm) + expect_true(is.matrix(result)) + expect_equal(nrow(result), 3) + expect_equal(ncol(result), 4) +}) + +test_that("weibull2 deriv1 works with fixed parameters", { + w2 <- weibull2(fixed = c(1, NA, NA, NA)) + dose <- c(1, 5, 10) + parm <- matrix(c(0, 100, 5), nrow = 3, ncol = 3, byrow = TRUE) + result <- w2$deriv1(dose, parm) + expect_true(is.matrix(result)) + expect_equal(ncol(result), 3) +}) + +# --- derivx (dose derivative) --- + +test_that("weibull2 derivx returns correct structure", { + w2 <- weibull2() + dose <- c(1, 5, 10) + parm <- matrix(c(1, 0, 100, 5), nrow = 3, ncol = 4, byrow = TRUE) + result <- w2$derivx(dose, parm) + expect_true(is.matrix(result) || is.array(result)) + expect_equal(nrow(result), 3) +}) + +test_that("weibull2 derivx works with fixed parameters", { + w2 <- weibull2(fixed = c(1, 0, NA, NA)) + dose <- c(1, 5, 10) + parm <- matrix(c(100, 5), nrow = 3, ncol = 2, byrow = TRUE) + result <- w2$derivx(dose, parm) + expect_true(is.matrix(result) || is.array(result)) +}) + +# --- edfct (ED function) --- + +test_that("weibull2 edfct works with relative type", { + w2 <- weibull2() + parm <- c(1, 0, 100, 5) + result <- w2$edfct(parm, 50, reference = "control", type = "relative") + expect_true(is.list(result)) + expect_true(length(result) == 2) + expect_true(is.numeric(result[[1]])) +}) + +test_that("weibull2 edfct works with absolute type and b>0 and control", { + w2 <- weibull2() + # b=1 (>0), reference = "control", type = "absolute" + parm <- c(1, 0, 100, 5) + result <- w2$edfct(parm, 50, reference = "control", type = "absolute") + expect_true(is.list(result)) + expect_true(is.numeric(result[[1]])) +}) + +test_that("weibull2 edfct with absolute type, b<=0, control", { + w2 <- weibull2() + # b=-1 (<0), reference = "control", type = "absolute" + parm <- c(-1, 0, 100, 5) + result <- w2$edfct(parm, 50, reference = "control", type = "absolute") + expect_true(is.list(result)) +}) + +test_that("weibull2 edfct with absolute type and non-control reference", { + w2 <- weibull2() + parm <- c(1, 0, 100, 5) + result <- w2$edfct(parm, 50, reference = "upper", type = "absolute") + expect_true(is.list(result)) +}) + +# --- W2.2 wrapper --- + +test_that("W2.2 returns correct class and structure", { + w22 <- W2.2() + expect_s3_class(w22, "Weibull-2") + expect_equal(w22$noParm, 2) + expect_equal(w22$names, c("b", "e")) +}) + +test_that("W2.2 with custom upper limit", { + w22 <- W2.2(upper = 100) + expect_s3_class(w22, "Weibull-2") + expect_true(grepl("upper limit at 100", w22$text)) +}) + +test_that("W2.2 errors on invalid names", { + expect_error(W2.2(names = c("a")), "Not correct 'names' argument") + expect_error(W2.2(names = 42), "Not correct 'names' argument") +}) + +test_that("W2.2 errors on invalid fixed", { + expect_error(W2.2(fixed = c(NA)), "Not correct length of 'fixed' argument") + expect_error(W2.2(fixed = c(NA, NA, NA)), "Not correct length of 'fixed' argument") +}) + +test_that("W2.2 fct computes correctly", { + w22 <- W2.2(upper = 1) + dose <- c(0.5, 1, 2) + parm <- matrix(c(1, 5), nrow = 3, ncol = 2, byrow = TRUE) + result <- w22$fct(dose, parm) + expected <- 0 + (1 - 0) * (1 - exp(-exp(1 * (log(dose) - log(5))))) + expect_equal(result, expected) +}) + +# --- W2.3 wrapper --- + +test_that("W2.3 returns correct class and structure", { + w23 <- W2.3() + expect_s3_class(w23, "Weibull-2") + expect_equal(w23$noParm, 3) + expect_equal(w23$names, c("b", "d", "e")) +}) + +test_that("W2.3 text indicates lower limit fixed at 0", { + w23 <- W2.3() + expect_true(grepl("lower limit at 0", w23$text)) +}) + +test_that("W2.3 errors on invalid names", { + expect_error(W2.3(names = c("a", "b")), "Not correct 'names' argument") + expect_error(W2.3(names = 123), "Not correct 'names' argument") +}) + +test_that("W2.3 errors on invalid fixed", { + expect_error(W2.3(fixed = c(NA, NA)), "Not correct length of 'fixed' argument") +}) + +# --- W2.3u wrapper --- + +test_that("W2.3u returns correct class and structure", { + w23u <- W2.3u() + expect_s3_class(w23u, "Weibull-2") + expect_equal(w23u$noParm, 3) + expect_equal(w23u$names, c("b", "c", "e")) +}) + +test_that("W2.3u text indicates upper limit fixed", { + w23u <- W2.3u(upper = 1) + expect_true(grepl("upper limit at 1", w23u$text)) +}) + +test_that("W2.3u errors on invalid names", { + expect_error(W2.3u(names = c("x")), "Not correct 'names' argument") + expect_error(W2.3u(names = 99), "Not correct 'names' argument") +}) + +test_that("W2.3u errors on invalid fixed", { + expect_error(W2.3u(fixed = c(NA, NA)), "Not correct length of 'fixed' argument") +}) + +# --- W2.4 wrapper --- + +test_that("W2.4 returns correct class and structure", { + w24 <- W2.4() + expect_s3_class(w24, "Weibull-2") + expect_equal(w24$noParm, 4) + expect_equal(w24$names, c("b", "c", "d", "e")) +}) + +test_that("W2.4 text is standard", { + w24 <- W2.4() + expect_equal(w24$text, "Weibull (type 2)") +}) + +test_that("W2.4 errors on invalid fixed", { + expect_error(W2.4(fixed = c(NA, NA, NA)), "Not correct length of 'fixed' argument") +}) + +test_that("W2.4 errors on invalid names", { + expect_error(W2.4(names = c("a", "b")), "Not correct 'names' argument") + expect_error(W2.4(names = 123), "Not correct 'names' argument") +}) + +# --- AR.2 wrapper --- + +test_that("AR.2 returns correct class and structure", { + ar2 <- AR.2() + expect_s3_class(ar2, "Weibull-2") + expect_equal(ar2$noParm, 2) + expect_equal(ar2$names, c("d", "e")) +}) + +test_that("AR.2 text indicates asymptotic regression with lower fixed", { + ar2 <- AR.2() + expect_true(grepl("Asymptotic regression", ar2$text)) + expect_true(grepl("lower limit at 0", ar2$text)) +}) + +test_that("AR.2 errors on invalid names", { + expect_error(AR.2(names = c("a")), "Not correct 'names' argument") + expect_error(AR.2(names = 42), "Not correct 'names' argument") +}) + +test_that("AR.2 errors on invalid fixed", { + expect_error(AR.2(fixed = c(NA)), "Not correct length of 'fixed' argument") +}) + +# --- AR.3 wrapper --- + +test_that("AR.3 returns correct class and structure", { + ar3 <- AR.3() + expect_s3_class(ar3, "Weibull-2") + expect_equal(ar3$noParm, 3) + expect_equal(ar3$names, c("c", "d", "e")) +}) + +test_that("AR.3 text is shifted asymptotic regression", { + ar3 <- AR.3() + expect_equal(ar3$text, "Shifted asymptotic regression") +}) + +test_that("AR.3 errors on invalid names", { + expect_error(AR.3(names = c("a")), "Not correct 'names' argument") + expect_error(AR.3(names = 42), "Not correct 'names' argument") +}) + +test_that("AR.3 errors on invalid fixed", { + expect_error(AR.3(fixed = c(NA, NA)), "Not correct length of 'fixed' argument") +}) + +# --- Integration tests using drm --- + +test_that("W2.4 works in drm model fitting", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = W2.4()) + expect_s3_class(m1, "drc") + expect_equal(length(coef(m1)), 4) + preds <- predict(m1) + expect_true(all(is.finite(preds))) +}) + +test_that("W2.3 works in drm model fitting", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = W2.3()) + expect_s3_class(m1, "drc") + expect_equal(length(coef(m1)), 3) +}) + +test_that("AR.2 works in drm model fitting", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = AR.2()) + expect_s3_class(m1, "drc") + expect_equal(length(coef(m1)), 2) +}) + +test_that("AR.3 works in drm model fitting", { + m1 <- drm(rootl ~ conc, data = ryegrass, fct = AR.3()) + expect_s3_class(m1, "drc") + expect_equal(length(coef(m1)), 3) +}) + +# --- deriv2 is NULL --- + +test_that("weibull2 deriv2 is NULL", { + w2 <- weibull2() + expect_null(w2$deriv2) +}) + +# --- fixed field preserved --- + +test_that("weibull2 fixed field is preserved", { + fixed_vals <- c(1, NA, NA, NA) + w2 <- weibull2(fixed = fixed_vals) + expect_equal(w2$fixed, fixed_vals) +}) diff --git a/tests/testthat/test-weibull2x.R b/tests/testthat/test-weibull2x.R new file mode 100644 index 00000000..ccea3d73 --- /dev/null +++ b/tests/testthat/test-weibull2x.R @@ -0,0 +1,286 @@ +# Tests for weibull2x.R: weibull2x(), W2x.3(), W2x.4() + +# --- weibull2x() main function --- + +test_that("weibull2x returns correct class and structure", { + w2x <- weibull2x() + expect_s3_class(w2x, "Weibull-2") + expect_true(is.list(w2x)) + expect_true(all(c("fct", "ssfct", "names", "deriv1", "deriv2", "derivx", + "edfct", "name", "text", "noParm", "fixed") %in% names(w2x))) +}) + +test_that("weibull2x default names are b, c, d, e, t0", { + w2x <- weibull2x() + expect_equal(w2x$names, c("b", "c", "d", "e", "t0")) +}) + +test_that("weibull2x noParm reflects number of NA in fixed", { + w2x_full <- weibull2x() + expect_equal(w2x_full$noParm, 5) + + w2x_partial <- weibull2x(fixed = c(1, NA, NA, NA, NA)) + expect_equal(w2x_partial$noParm, 4) + expect_equal(w2x_partial$names, c("c", "d", "e", "t0")) +}) + +test_that("weibull2x uses default text when fctText not provided", { + w2x <- weibull2x() + expect_equal(w2x$text, "Weibull (type 2)") +}) + +test_that("weibull2x uses provided fctText", { + w2x <- weibull2x(fctText = "Custom text") + expect_equal(w2x$text, "Custom text") +}) + +test_that("weibull2x uses provided fctName", { + w2x <- weibull2x(fctName = "myFunc") + expect_equal(w2x$name, "myFunc") +}) + +test_that("weibull2x uses default fctName from match.call", { + w2x <- weibull2x() + expect_equal(w2x$name, "weibull2x") +}) + +test_that("weibull2x derivatives are NULL", { + w2x <- weibull2x() + expect_null(w2x$deriv1) + expect_null(w2x$deriv2) + expect_null(w2x$derivx) +}) + +test_that("weibull2x fixed field is preserved", { + fixed_vals <- c(1, NA, NA, NA, NA) + w2x <- weibull2x(fixed = fixed_vals) + expect_equal(w2x$fixed, fixed_vals) +}) + +# --- Error handling for weibull2x --- + +test_that("weibull2x errors on invalid names argument", { + expect_error(weibull2x(names = c("a", "b")), "Not correct 'names' argument") + expect_error(weibull2x(names = 123), "Not correct 'names' argument") +}) + +test_that("weibull2x errors on invalid fixed argument", { + expect_error(weibull2x(fixed = c(NA, NA)), "Not correct 'fixed' argument") + expect_error(weibull2x(fixed = c(NA, NA, NA)), "Not correct 'fixed' argument") +}) + +test_that("weibull2x errors when t0 (fixed[5]) is not NA", { + expect_error(weibull2x(fixed = c(NA, NA, NA, NA, 0)), "The lag time cannot be fixed") + expect_error(weibull2x(fixed = c(1, 0, 100, 5, 10)), "The lag time cannot be fixed") +}) + +# --- fct (internal nonlinear function) --- + +test_that("weibull2x fct computes correct values for dose > t0", { + w2x <- weibull2x() + # Parameters: b=1, c=0, d=100, e=5, t0=1 + dose <- c(3, 6, 11) + parm <- matrix(c(1, 0, 100, 5, 1), nrow = 3, ncol = 5, byrow = TRUE) + result <- w2x$fct(dose, parm) + expected <- 0 + (100 - 0) * (1 - exp(-exp(1 * (log(dose - 1) - log(5))))) + expect_equal(result, expected) +}) + +test_that("weibull2x fct returns c when dose <= t0", { + w2x <- weibull2x() + # Parameters: b=1, c=5, d=100, e=10, t0=3 + dose <- c(1, 2, 3) # all <= t0=3 + parm <- matrix(c(1, 5, 100, 10, 3), nrow = 3, ncol = 5, byrow = TRUE) + result <- w2x$fct(dose, parm) + expect_equal(result, c(5, 5, 5)) +}) + +test_that("weibull2x fct handles mix of dose > t0 and dose <= t0", { + w2x <- weibull2x() + # Parameters: b=1, c=0, d=100, e=5, t0=5 + dose <- c(2, 5, 10) # first two <= t0, last > t0 + parm <- matrix(c(1, 0, 100, 5, 5), nrow = 3, ncol = 5, byrow = TRUE) + # NaN warning is expected from log(dose - t0) when dose <= t0 + result <- suppressWarnings(w2x$fct(dose, parm)) + # dose=2 <= t0=5: result = c = 0 + # dose=5 <= t0=5: result = c = 0 (not strictly > t0) + # dose=10 > t0=5: Weibull formula + expected_10 <- 0 + (100 - 0) * (1 - exp(-exp(1 * (log(10 - 5) - log(5))))) + expect_equal(result[1], 0) + expect_equal(result[2], 0) + expect_equal(result[3], expected_10) +}) + +test_that("weibull2x fct works with fixed parameters", { + w2x <- weibull2x(fixed = c(1, 0, NA, NA, NA)) + dose <- c(6, 11) + # Only free params: d, e, t0 + parm <- matrix(c(100, 5, 1), nrow = 2, ncol = 3, byrow = TRUE) + result <- w2x$fct(dose, parm) + expected <- 0 + (100 - 0) * (1 - exp(-exp(1 * (log(dose - 1) - log(5))))) + expect_equal(result, expected) +}) + +# --- ssfct (self-starter function) --- + +test_that("weibull2x uses provided ssfct when not NULL", { + custom_ss <- function(dframe) { c(1, 0, 10, 5, 0) } + w2x <- weibull2x(ssfct = custom_ss) + expect_identical(w2x$ssfct, custom_ss) +}) + +test_that("weibull2x uses default ssfct when ssfct is NULL", { + w2x <- weibull2x(ssfct = NULL) + expect_true(is.function(w2x$ssfct)) +}) + +test_that("weibull2x default ssfct returns correct number of values", { + w2x <- weibull2x() + # Create a simple test data frame + dframe <- data.frame(x = c(1, 2, 5, 10, 20), y = c(0, 10, 40, 80, 95)) + result <- w2x$ssfct(dframe) + # Should return 5 values for the 5 free parameters + expect_length(result, 5) + expect_true(all(is.finite(result))) +}) + +test_that("weibull2x method argument works for self-starter", { + for (m in c("1", "2", "3", "4")) { + w2x <- weibull2x(method = m) + expect_true(is.function(w2x$ssfct)) + } +}) + +# --- edfct (ED function) --- + +test_that("weibull2x edfct works with b > 0 and control reference", { + w2x <- weibull2x() + # b=1 (>0), reference="control" -> p = 100-p, reference set to "upper" + parm <- c(1, 0, 100, 5, 1) + result <- w2x$edfct(parm, 50, reference = "control", type = "relative") + expect_true(is.list(result)) + expect_true(length(result) == 2) + expect_true(is.numeric(result[[1]])) +}) + +test_that("weibull2x edfct works with b < 0 and control reference", { + w2x <- weibull2x() + # b=-1 (<0), reference="control" -> p = 100-p (no reference change) + parm <- c(-1, 0, 100, 5, 1) + result <- w2x$edfct(parm, 50, reference = "control", type = "relative") + expect_true(is.list(result)) + expect_true(is.numeric(result[[1]])) +}) + +test_that("weibull2x edfct works with non-control reference", { + w2x <- weibull2x() + parm <- c(1, 0, 100, 5, 1) + result <- w2x$edfct(parm, 50, reference = "upper", type = "relative") + expect_true(is.list(result)) + expect_true(is.numeric(result[[1]])) +}) + +test_that("weibull2x edfct adds t0 to the result", { + # The ED result should be offset by the t0 value + w2x_t0_1 <- weibull2x() + parm_t0_1 <- c(1, 0, 100, 5, 1) + result_1 <- w2x_t0_1$edfct(parm_t0_1, 50, reference = "upper", type = "relative") + + w2x_t0_2 <- weibull2x() + parm_t0_2 <- c(1, 0, 100, 5, 2) + result_2 <- w2x_t0_2$edfct(parm_t0_2, 50, reference = "upper", type = "relative") + + # Result with t0=2 should be 1 more than result with t0=1 (same underlying Weibull) + expect_equal(result_2[[1]] - result_1[[1]], 1) +}) + +# --- W2x.3 wrapper --- + +test_that("W2x.3 returns correct class and structure", { + w2x3 <- W2x.3() + expect_s3_class(w2x3, "Weibull-2") + expect_equal(w2x3$noParm, 3) + expect_equal(w2x3$names, c("d", "e", "t0")) +}) + +test_that("W2x.3 has b=1 and c=0 fixed", { + w2x3 <- W2x.3() + expect_equal(w2x3$fixed, c(1, 0, NA, NA, NA)) +}) + +test_that("W2x.3 text indicates lower limit fixed at 0", { + w2x3 <- W2x.3() + expect_equal(w2x3$text, "Weibull (type 2) with lower limit at 0") +}) + +test_that("W2x.3 errors on invalid names", { + expect_error(W2x.3(names = c("a", "b")), "Not correct 'names' argument") + expect_error(W2x.3(names = 123), "Not correct 'names' argument") +}) + +test_that("W2x.3 errors on invalid fixed length", { + expect_error(W2x.3(fixed = c(NA, NA)), "Not correct length of 'fixed' argument") + expect_error(W2x.3(fixed = c(NA)), "Not correct length of 'fixed' argument") +}) + +test_that("W2x.3 with partial fixed values", { + w2x3 <- W2x.3(fixed = c(100, NA, NA)) + expect_equal(w2x3$noParm, 2) + expect_equal(w2x3$names, c("e", "t0")) +}) + +# --- W2x.4 wrapper --- + +test_that("W2x.4 returns correct class and structure", { + w2x4 <- W2x.4() + expect_s3_class(w2x4, "Weibull-2") + expect_equal(w2x4$noParm, 4) + expect_equal(w2x4$names, c("c", "d", "e", "t0")) +}) + +test_that("W2x.4 has b=1 fixed", { + w2x4 <- W2x.4() + expect_equal(w2x4$fixed, c(1, NA, NA, NA, NA)) +}) + +test_that("W2x.4 text is standard Weibull type 2", { + w2x4 <- W2x.4() + expect_equal(w2x4$text, "Weibull (type 2)") +}) + +test_that("W2x.4 errors on invalid names", { + expect_error(W2x.4(names = c("a", "b")), "Not correct 'names' argument") + expect_error(W2x.4(names = 42), "Not correct 'names' argument") +}) + +test_that("W2x.4 errors on invalid fixed length", { + expect_error(W2x.4(fixed = c(NA, NA)), "Not correct length of 'fixed' argument") + expect_error(W2x.4(fixed = c(NA)), "Not correct length of 'fixed' argument") +}) + +test_that("W2x.4 with partial fixed values", { + w2x4 <- W2x.4(fixed = c(0, 100, NA, NA)) + expect_equal(w2x4$noParm, 2) + expect_equal(w2x4$names, c("e", "t0")) +}) + +# --- Integration tests using drm --- + +test_that("W2x.4 works in drm model fitting", { + ryegrass <- data.frame( + rootl = c( + 7.58, 8.00, 8.33, 7.25, 7.17, 7.00, 7.17, 7.83, 7.92, 7.58, + 6.17, 5.75, 5.83, 6.00, 5.83, 4.92, 4.50, 4.17, 4.42, 4.00, + 2.67, 2.08, 2.42, 2.50, 2.25, 1.17, 0.75, 0.92, 1.00, 0.58 + ), + conc = c( + rep(0, 5), rep(0.94, 5), rep(1.88, 5), + rep(3.75, 5), rep(7.50, 5), rep(15, 5) + ) + ) + m1 <- drm(rootl ~ conc, data = ryegrass, fct = W2x.4()) + expect_s3_class(m1, "drc") + expect_equal(length(coef(m1)), 4) + preds <- predict(m1) + expect_true(all(is.finite(preds))) +}) diff --git a/tests/testthat/test-yieldLoss.R b/tests/testthat/test-yieldLoss.R new file mode 100644 index 00000000..47212678 --- /dev/null +++ b/tests/testthat/test-yieldLoss.R @@ -0,0 +1,163 @@ +# Tests for yieldLoss() and genFixedFct() from R/yieldLoss.R + +# --- Setup: Fit a Michaelis-Menten model using the methionine dataset --- +# This mirrors the example from the function's documentation +met.mm.m1 <- drm(gain ~ dose, product, data = methionine, fct = MM.3(), + pmodels = list(~1, ~factor(product), ~factor(product))) + +# ============================================================================= +# Tests for yieldLoss() +# ============================================================================= + +# --- Happy Path: interval = "none" (default) --- +test_that("yieldLoss returns correct structure with interval='none'", { + result <- yieldLoss(met.mm.m1, display = FALSE) + + expect_type(result, "list") + expect_named(result, c("A", "I")) + + expect_true(is.matrix(result$A)) + expect_true(is.matrix(result$I)) + + # With interval="none", should have 2 columns: Estimate and Std. Error + expect_equal(ncol(result$A), 2) + expect_equal(ncol(result$I), 2) + expect_equal(colnames(result$A), c("Estimate", "Std. Error")) + expect_equal(colnames(result$I), c("Estimate", "Std. Error")) + + # Row names should match curve names from the model + expect_equal(rownames(result$A), colnames(met.mm.m1$parmMat)) + expect_equal(rownames(result$I), colnames(met.mm.m1$parmMat)) + + # Estimates and standard errors should be finite numeric values + expect_true(all(is.finite(result$A))) + expect_true(all(is.finite(result$I))) + + # Standard errors should be positive + expect_true(all(result$A[, "Std. Error"] > 0)) + expect_true(all(result$I[, "Std. Error"] > 0)) +}) + +# --- Happy Path: interval = "as" with continuous model --- +test_that("yieldLoss returns confidence intervals with interval='as'", { + result <- yieldLoss(met.mm.m1, interval = "as", display = FALSE) + + expect_type(result, "list") + expect_named(result, c("A", "I")) + + # With interval="as", should have 4 columns + expect_equal(ncol(result$A), 4) + expect_equal(ncol(result$I), 4) + expect_equal(colnames(result$A), c("Estimate", "Std. Error", "Lower", "Upper")) + expect_equal(colnames(result$I), c("Estimate", "Std. Error", "Lower", "Upper")) + + # Lower should be less than Estimate, Upper should be greater + expect_true(all(result$A[, "Lower"] < result$A[, "Estimate"])) + expect_true(all(result$A[, "Upper"] > result$A[, "Estimate"])) + expect_true(all(result$I[, "Lower"] < result$I[, "Estimate"])) + expect_true(all(result$I[, "Upper"] > result$I[, "Estimate"])) +}) + +# --- Happy Path: different confidence levels --- +test_that("yieldLoss respects the level parameter", { + result_95 <- yieldLoss(met.mm.m1, interval = "as", level = 0.95, display = FALSE) + result_99 <- yieldLoss(met.mm.m1, interval = "as", level = 0.99, display = FALSE) + + # 99% CIs should be wider than 95% CIs + width_95_A <- result_95$A[, "Upper"] - result_95$A[, "Lower"] + width_99_A <- result_99$A[, "Upper"] - result_99$A[, "Lower"] + expect_true(all(width_99_A > width_95_A)) +}) + +# --- Display behavior --- +test_that("yieldLoss prints output when display=TRUE", { + output <- capture.output(result <- yieldLoss(met.mm.m1, display = TRUE)) + expect_true(length(output) > 0) + expect_true(any(grepl("Estimated A parameters", output))) + expect_true(any(grepl("Estimated I parameters", output))) +}) + +test_that("yieldLoss suppresses output when display=FALSE", { + output <- capture.output(result <- yieldLoss(met.mm.m1, display = FALSE)) + expect_equal(length(output), 0) +}) + +# --- Display with interval = "as" --- +test_that("yieldLoss displays correctly with interval='as'", { + output <- capture.output(result <- yieldLoss(met.mm.m1, interval = "as", display = TRUE)) + expect_true(length(output) > 0) + expect_true(any(grepl("Estimated A parameters", output))) +}) + +# --- Error handling: invalid interval argument --- +test_that("yieldLoss errors on invalid interval argument", { + expect_error(yieldLoss(met.mm.m1, interval = "invalid")) +}) + +# --- Non-continuous model type path (covers qnorm branch in ciFct) --- +test_that("yieldLoss uses qnorm for non-continuous model types with interval='as'", { + # Create a modified copy of the model with non-continuous type + mock_model <- met.mm.m1 + mock_model$type <- "binomial" + + result <- yieldLoss(mock_model, interval = "as", display = FALSE) + + expect_type(result, "list") + expect_named(result, c("A", "I")) + expect_equal(ncol(result$A), 4) + expect_equal(ncol(result$I), 4) + + # Verify the CIs differ from the continuous case (qt vs qnorm) + result_cont <- yieldLoss(met.mm.m1, interval = "as", display = FALSE) + # CIs should differ because qt and qnorm give different quantiles + expect_false(identical(result$A[, "Lower"], result_cont$A[, "Lower"])) +}) + +# ============================================================================= +# Tests for genFixedFct() (internal helper) +# ============================================================================= + +test_that("genFixedFct works with allComp=TRUE", { + # fixed vector with some NAs (free parameters) and some fixed values + fixed <- c(-1, NA, NA, NA, 1) + fct <- drc:::genFixedFct(fixed) + + # Provide values for the 3 free parameters (c, d, e) + result <- fct(c(10, 20, 30), allComp = TRUE) + expect_equal(result, c(-1, 10, 20, 30, 1)) +}) + +test_that("genFixedFct works with allComp=FALSE", { + fixed <- c(-1, NA, NA, NA, 1) + fct <- drc:::genFixedFct(fixed) + + # With allComp=FALSE, it should filter the parm vector to free positions + parm <- c(100, 200, 300, 400, 500) + result <- fct(parm, allComp = FALSE) + # notFixed positions are 2, 3, 4 (the NA positions) + expect_equal(result, c(200, 300, 400)) +}) + +test_that("genFixedFct handles all-fixed parameters", { + fixed <- c(1, 2, 3) + fct <- drc:::genFixedFct(fixed) + + # allComp=TRUE: all positions are fixed, parm should be ignored + result <- fct(numeric(0), allComp = TRUE) + expect_equal(result, c(1, 2, 3)) + + # allComp=FALSE: no free parameters, return empty + result2 <- fct(c(10, 20, 30), allComp = FALSE) + expect_length(result2, 0) +}) + +test_that("genFixedFct handles all-free parameters", { + fixed <- c(NA, NA, NA) + fct <- drc:::genFixedFct(fixed) + + result <- fct(c(10, 20, 30), allComp = TRUE) + expect_equal(result, c(10, 20, 30)) + + result2 <- fct(c(10, 20, 30), allComp = FALSE) + expect_equal(result2, c(10, 20, 30)) +}) diff --git a/vignettes/.gitignore b/vignettes/.gitignore new file mode 100644 index 00000000..d751e463 --- /dev/null +++ b/vignettes/.gitignore @@ -0,0 +1,3 @@ +*.html +*.R +*.pdf diff --git a/vignettes/dose-response-workflow.Rmd b/vignettes/dose-response-workflow.Rmd new file mode 100644 index 00000000..62462d07 --- /dev/null +++ b/vignettes/dose-response-workflow.Rmd @@ -0,0 +1,747 @@ +--- +title: "A Practical Workflow for Dose-Response Analysis" +author: "Hannes Reinwald" +date: "`r Sys.Date()`" +output: rmarkdown::html_vignette +vignette: > + %\VignetteTitle{A Practical Workflow for Dose-Response Analysis} + %\VignetteIndexEntry{A Practical Workflow for Dose-Response Analysis} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r setup, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>", + fig.width = 7, + fig.height = 5 +) +library(drc) +``` + +## Executive Summary + +This vignette provides a comprehensive, step-by-step workflow for conducting proper dose-response analysis using the `drc` package. We demonstrate the complete analysis process from initial model fitting through model selection, validation, and interpretation. By following this workflow, even inexperienced users can perform rigorous dose-response modeling while avoiding common pitfalls. + +## Introduction + +Dose-response analysis is fundamental in toxicology, ecotoxicology, pharmacology, and related fields. The relationship between dose (or concentration) and biological response often follows non-linear patterns that require specialized statistical models. The `drc` package provides a comprehensive framework for fitting, comparing, and interpreting dose-response models. + +### What You Will Learn + +This vignette demonstrates a complete workflow including: + +1. Initial exploratory model fitting +2. Visual assessment of model adequacy +3. Statistical evaluation of model fit +4. Systematic model comparison and selection +5. Model-averaged estimation for robust inference +6. Understanding the impact of parameter constraints +7. Choosing appropriate models for different data types + +### The Example Dataset + +We will use the `ryegrass` dataset, which contains measurements of root length in perennial ryegrass (*Lolium perenne L.*) exposed to different concentrations of ferulic acid, a phenolic compound that inhibits plant growth. + +```{r load-data, fig.alt="Scatter plot showing ryegrass root length (cm) versus ferulic acid concentration (mM), displaying a decreasing dose-response relationship"} +# Load the ryegrass dataset +data(ryegrass) + +# Examine the data structure +head(ryegrass, 10) + +# Summary statistics +summary(ryegrass) + +# Simple exploratory plot +plot(rootl ~ conc, data = ryegrass, + xlab = "Ferulic acid concentration (mM)", + ylab = "Root length (cm)", + main = "Ryegrass Root Growth vs. Ferulic Acid Concentration", + pch = 16, cex = 1.2) +``` + +The dataset contains 24 observations with: +- `conc`: Ferulic acid concentration in millimolar (mM) +- `rootl`: Root length in centimeters (cm) + +We observe a clear dose-response relationship: as the concentration increases, root length decreases, indicating an inhibitory effect of ferulic acid on ryegrass root growth. + +## Step 1: Initial Model Fitting + +### Choosing a Starting Model + +For a typical monotonic dose-response curve, the four-parameter log-logistic model (`LL.4`) is an excellent starting point. It is flexible, well-characterized, and commonly used in toxicology. + +The `LL.4` model has the form: + +$$f(x) = c + \frac{d-c}{1 + \exp(b(\log(x) - \log(e)))}$$ + +where: +- **b**: Slope parameter (steepness of the curve) +- **c**: Lower asymptote (response at infinite dose) +- **d**: Upper asymptote (response at zero dose, control response) +- **e**: ED50 or EC50 (dose producing 50% of the maximal effect) + +### Fitting the Initial Model + +```{r initial-fit} +# Fit a four-parameter log-logistic model +ryegrass.LL4 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + +# Display model summary +summary(ryegrass.LL4) +``` + +The summary provides: +- Parameter estimates and their standard errors +- Residual standard error +- Model convergence information + +**Interpretation of Parameters:** +- The `d` parameter (upper limit) represents the control root length (at zero concentration) +- The `c` parameter (lower limit) represents the minimum root length at high concentrations +- The `e` parameter (ED50) is the concentration causing 50% reduction from control +- The `b` parameter controls the steepness of the dose-response curve + +## Step 2: Visual Assessment of Model Fit + +Visual diagnostics are crucial for assessing whether the fitted model adequately describes the data. We use two primary tools: the standard dose-response plot and quantile-quantile (Q-Q) plots. + +### Standard Dose-Response Plot + +```{r basic-plot, fig.alt="Dose-response curve showing LL.4 model fit to ryegrass data with observed data points and fitted sigmoid curve"} +# Plot the fitted model with data points +plot(ryegrass.LL4, type = "all", + main = "LL.4 Model Fit to Ryegrass Data", + xlab = "Ferulic acid concentration (mM)", + ylab = "Root length (cm)", + lwd = 2, cex = 1.2) +``` + +The plot shows: +- Observed data points +- Fitted dose-response curve +- Overall pattern of fit + +**What to Look For:** +- Do the fitted values follow the general trend of the data? +- Are there systematic deviations (e.g., all points above or below the curve in certain regions)? +- Are there outliers that might influence the fit? + +### Quantile-Quantile (Q-Q) Plot + +Q-Q plots assess whether the model residuals follow a normal distribution, which is an assumption of the fitting procedure. + +```{r qq-plot, fig.alt="Normal Q-Q plot of residuals from LL.4 model showing points approximately along the diagonal reference line"} +# Create Q-Q plot for residual diagnostics +qqnorm(residuals(ryegrass.LL4), + main = "Normal Q-Q Plot of Residuals (LL.4)", + pch = 16, cex = 1.2) +qqline(residuals(ryegrass.LL4), col = "red", lwd = 2) +``` + +**Interpretation:** +- Points should fall approximately along the diagonal line +- Systematic deviations suggest non-normality of residuals +- Deviations at the extremes are common and often acceptable +- Severe deviations may indicate model inadequacy or outliers + +### Residual Plot + +An additional useful diagnostic is plotting residuals against fitted values: + +```{r residual-plot, fig.alt="Residual plot showing residuals versus fitted values with random scatter around zero horizontal line"} +# Residuals vs. Fitted values +plot(fitted(ryegrass.LL4), residuals(ryegrass.LL4), + xlab = "Fitted values", + ylab = "Residuals", + main = "Residual Plot (LL.4)", + pch = 16, cex = 1.2) +abline(h = 0, col = "red", lwd = 2, lty = 2) +``` + +**What to Look For:** +- Random scatter around zero (no systematic pattern) +- Constant variance across fitted values (homoscedasticity) +- No obvious outliers or influential points + +## Step 3: Statistical Evaluation of Model Fit + +Beyond visual assessment, we use formal statistical tests to evaluate model adequacy and significance. + +### Test for Dose Effect: noEffect() + +The `noEffect()` function performs a likelihood ratio test comparing the dose-response model to a null model (no dose effect). + +```{r no-effect} +# Test whether there is a significant dose effect +noEffect(ryegrass.LL4) +``` + +**Interpretation:** +- The null hypothesis is "no dose effect" (all responses are equal) +- A significant p-value (< 0.05) indicates that the dose-response model fits significantly better than the null model +- This confirms that ferulic acid concentration has a significant effect on root length + +### Goodness-of-Fit Test: modelFit() + +The `modelFit()` function assesses whether the model adequately describes the data using a lack-of-fit test. + +```{r model-fit} +# Perform goodness-of-fit test +modelFit(ryegrass.LL4) +``` + +**Interpretation:** +- This test compares the fitted model to a saturated model (perfect fit) +- A **non-significant** p-value suggests adequate fit (model is not significantly worse than perfect fit) +- A significant p-value indicates lack of fit (model may be inadequate) +- **Note:** This test requires replication at dose levels + +### Estimating Effective Doses: ED() + +Effective dose (ED) or effective concentration (EC) values are key outputs in dose-response analysis. They represent the dose required to produce a specified level of effect. + +```{r ed-estimates} +# Estimate EC10, EC20, and EC50 with 95% confidence intervals +# Using delta method for confidence intervals +ed_values <- ED(ryegrass.LL4, respLev = c(10, 20, 50), interval = "delta") +ed_values +``` + +**Understanding ED Values:** +- **EC10**: Concentration causing 10% effect (reduction in root length) +- **EC20**: Concentration causing 20% effect +- **EC50**: Concentration causing 50% effect (often used as a summary measure of potency) + +**Confidence Intervals:** +- The `interval = "delta"` argument uses the delta method for CI estimation +- Alternative methods include `"fls"` (fieller), `"tfls"` (transformed fieller) +- Narrower CIs indicate more precise estimates + +### Alternative Confidence Interval Methods + +```{r ed-comparison} +# Compare different confidence interval methods +cat("Delta method:\n") +ED(ryegrass.LL4, respLev = 50, interval = "delta") + +cat("\nFieller method:\n") +ED(ryegrass.LL4, respLev = 50, interval = "fls") +``` + +The Fieller method is often preferred for ED50 estimation as it accounts for the ratio nature of the parameter. + +## Step 4: Model Comparison and Selection + +A critical step in dose-response analysis is comparing alternative models to select the most appropriate one. Different model families may fit the data better depending on the underlying biological mechanism. + +### Comparing Multiple Models + +We'll compare the initial LL.4 model with several alternatives: + +- **LN.4**: Four-parameter log-normal model +- **W1.4**: Four-parameter Weibull type 1 model +- **W2.4**: Four-parameter Weibull type 2 model +- **BC.4**: Four-parameter Brain-Cousens hormesis model +- **LL.5**: Five-parameter log-logistic model (asymmetric) +- **EXD.3**: Three-parameter exponential decay model + +```{r model-selection} +# Use mselect() to compare multiple models +# This fits each model and compares using AIC +model_comparison <- suppressWarnings( + mselect( + ryegrass.LL4, + fctList = list(LN.4(), W1.4(), W2.4(), BC.4(), LL.5(), EXD.3()) + ) + ) +model_comparison +``` + +**Understanding the Output:** + +The table shows: +- **logLik**: Log-likelihood (higher is better, but penalized for parameters) +- **IC**: Information criterion (AIC by default; **lower is better**) +- **Res var**: Residual variance (lower is better) +- **Lack of fit**: P-value for lack-of-fit test (non-significant is better) + +Models are sorted by IC (AIC), with the best-fitting model at the top. + +### Selecting the Best Model + +```{r best-model} +# Based on mselect results, fit the best model +# (In this example, we'll use the model with lowest AIC from the comparison) +# For ryegrass data, typically W1.4 or LL.4 performs well + +ryegrass.best <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) + +# Summary of best model +summary(ryegrass.best) + +# ED estimates for best model +ed_best <- ED(ryegrass.best, respLev = c(10, 20, 50), interval = "delta") +ed_best +``` + +### Visual Comparison of Models + +Plotting multiple models together helps visualize differences in fit: + +```{r model-comparison-plot, fig.alt="Comparison of LL.4 and W1.4 model fits showing two overlapping dose-response curves in blue (LL.4) and red dashed line (W1.4)"} +# Plot initial LL.4 model +plot(ryegrass.LL4, type = "all", + main = "Comparison: LL.4 vs W1.4 Models", + xlab = "Ferulic acid concentration (mM)", + ylab = "Root length (cm)", + lwd = 2, cex = 1.2, col = "blue", + legend = FALSE) + +# Overlay the best model (W1.4) +plot(ryegrass.best, add = TRUE, type = "none", lwd = 2, col = "red", lty = 2) + +# Add legend +legend("topright", legend = c("LL.4 (initial)", "W1.4 (best)"), + col = c("blue", "red"), lwd = 2, lty = c(1, 2), cex = 1.1) +``` + +### Comparing ED Estimates Between Models + +```{r ed-comparison-models} +# Compare EC50 estimates between models +cat("EC50 from LL.4 model:\n") +ED(ryegrass.LL4, respLev = 50, interval = "delta") + +cat("\nEC50 from W1.4 model:\n") +ED(ryegrass.best, respLev = 50, interval = "delta") +``` + +**Important Notes:** +- Different models may yield different ED estimates +- Model selection should be based on both statistical criteria (AIC) and biological plausibility +- Small differences in AIC (< 2) suggest models are essentially equivalent + +## Step 5: Model-Averaged ED Estimation + +When multiple models fit similarly well, model averaging provides a robust approach that accounts for model uncertainty. The `maED()` function computes model-averaged ED estimates using AIC-based weights. + +### Computing Model-Averaged EDs + +```{r model-averaging} +# Model-averaged EC50 estimation using top 3 models +# Based on our mselect results, we'll average over several competitive models +ma_results <- maED(ryegrass.LL4, + fctList = list(W1.4(), W2.4(), LL.5()), + respLev = 50, + interval = "buckland") + +ma_results +``` + +**Understanding Model Averaging:** + +- Each model receives a weight based on its AIC value +- Better-fitting models (lower AIC) receive higher weights +- The final estimate is a weighted average across models +- Confidence intervals account for both parameter uncertainty and model uncertainty + +### Comparing Single-Model vs Model-Averaged Estimates + +```{r ma-comparison} +# Compare model-averaged EC50 with single-model estimates +cat("Single model (W1.4) EC50:\n") +ED(ryegrass.best, respLev = 50, interval = "delta") + +cat("\nModel-averaged EC50 (top 3 models):\n") +print(ma_results) +``` + +**When to Use Model Averaging:** +- Multiple models have similar AIC values (ΔAIC < 2-4) +- You want robust estimates that don't depend on selecting a single model +- Regulatory or risk assessment contexts requiring conservative estimates + +**When to Use Single Model:** +- One model is clearly superior (ΔAIC > 10) +- Strong biological rationale for a specific model form +- Simpler interpretation needed + +## Step 6: Impact of Fixing Asymptotes + +The upper and lower asymptotes (parameters `d` and `c`) can be estimated from the data or fixed based on prior knowledge. Understanding when and how to fix these parameters is crucial for proper model fitting. + +### Understanding Asymptote Parameters + +- **d (upper limit)**: Response at zero dose (control response) +- **c (lower limit)**: Response at infinite dose (maximal effect) + +### Models with Different Asymptote Constraints + +```{r asymptote-comparison} +# LL.4: Both asymptotes free (4 parameters) +ryegrass.LL4 <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) + +# LL.3: Lower asymptote fixed at 0 (3 parameters) +ryegrass.LL3 <- drm(rootl ~ conc, data = ryegrass, fct = LL.3()) + +# LL.3u: Upper asymptote fixed at 1 (3 parameters) +# Note: Requires normalized data for this to be meaningful +ryegrass_norm <- ryegrass +ryegrass_norm$rootl_norm <- ryegrass$rootl / max(ryegrass$rootl) +ryegrass.LL3u <- drm(rootl_norm ~ conc, data = ryegrass_norm, fct = LL.3u()) + +# LL.2: Both asymptotes fixed (2 parameters) +ryegrass.LL2 <- drm(rootl_norm ~ conc, data = ryegrass_norm, fct = LL.2()) + +# Compare models +cat("LL.4 (both free):\n") +summary(ryegrass.LL4) + +cat("\nLL.3 (lower = 0):\n") +summary(ryegrass.LL3) + +cat("\nAIC Comparison:\n") +cat("LL.4 (4 params):", AIC(ryegrass.LL4), "\n") +cat("LL.3 (3 params):", AIC(ryegrass.LL3), "\n") +``` + +### Visual Comparison of Constrained Models + +```{r asymptote-plot, fig.alt="Comparison of LL.4 and LL.3 models showing effect of asymptote constraints with black solid line (LL.4) and blue dashed line (LL.3)"} +# Plot models with different constraints +plot(ryegrass.LL4, type = "all", + main = "Effect of Asymptote Constraints", + xlab = "Ferulic acid concentration (mM)", + ylab = "Root length (cm)", + lwd = 2, col = "black", legend = FALSE, cex = 1.2) + +plot(ryegrass.LL3, add = TRUE, type = "none", lwd = 2, col = "blue", lty = 2) + +legend("topright", + legend = c("LL.4 (both free)", "LL.3 (c = 0)"), + col = c("black", "blue"), + lwd = 2, lty = c(1, 2), + cex = 1.1) +``` + +### Implications of Fixing Asymptotes + +**Benefits of Fixing Asymptotes:** +1. **Reduced parameter count**: Simpler model, fewer parameters to estimate +2. **Improved stability**: Fewer parameters can mean more stable fits +3. **Biological relevance**: Incorporating prior knowledge (e.g., c = 0 when complete inhibition is impossible) +4. **Identifiability**: Some datasets may not contain enough information to estimate all parameters + +**When to Fix Asymptotes:** +- **Fix c = 0** when: + - Response cannot go below zero (e.g., growth, survival) + - Biological knowledge indicates complete inhibition doesn't occur + - Data doesn't extend to high enough doses to estimate c + +- **Fix d** when: + - Control response is known from independent measurements + - Data is normalized to a known maximum (e.g., 100%) + - You want to focus on relative potency comparisons + +**When to Keep Asymptotes Free:** +- Data extends over a wide dose range +- Both asymptotes are clearly identifiable in the data +- No strong prior knowledge about asymptote values +- Model comparison/selection workflow + +### Effect on ED Estimates + +```{r asymptote-ed} +# Compare ED estimates with different constraints +cat("EC50 with LL.4 (both asymptotes free):\n") +ED(ryegrass.LL4, respLev = 50, interval = "delta") + +cat("\nEC50 with LL.3 (lower asymptote = 0):\n") +ED(ryegrass.LL3, respLev = 50, interval = "delta") +``` + +**Important Note:** The choice of asymptote constraints can substantially affect ED estimates, especially for EC10 and EC20 values which depend more heavily on the asymptote values than EC50. + +## Step 7: Overview of Available Models + +The `drc` package provides numerous dose-response models suitable for different types of data and biological mechanisms. Understanding which model to use is crucial for proper analysis. + +### Monotonic (Non-Hormesis) Models + +Monotonic models describe dose-response relationships that are either strictly increasing or strictly decreasing. These are appropriate when the response changes consistently in one direction as dose increases. + +#### Log-Logistic Models (LL family) + +**Characteristics:** +- Symmetric on log-dose scale +- Most commonly used in toxicology +- S-shaped curve +- Parameters: b (slope), c (lower), d (upper), e (ED50) + +**Variants:** +- `LL.2()`: 2 parameters (c=0, d=1 fixed) +- `LL.3()`: 3 parameters (c=0) +- `LL.3u()`: 3 parameters (d=1) +- `LL.4()`: 4 parameters (most flexible) +- `LL.5()`: 5 parameters (asymmetric, f parameter) + +**Best for:** +- General dose-response data +- Toxicity studies +- EC50/ED50 estimation + +**Example:** +```{r ll-example, fig.alt="Log-logistic model (LL.4) fitted to ryegrass data showing typical S-shaped dose-response curve"} +# Standard application of log-logistic model +example.LL <- drm(rootl ~ conc, data = ryegrass, fct = LL.4()) +plot(example.LL, main = "Log-Logistic Model (LL.4)") +``` + +#### Weibull Models (W1 and W2 families) + +**Characteristics:** +- Asymmetric on log-dose scale +- Two types: W1 (increasing asymmetry) and W2 (decreasing asymmetry) +- Flexible shape +- Same parameter structure as log-logistic + +**Variants:** +- `W1.2()`, `W1.3()`, `W1.4()`: Weibull type 1 +- `W2.2()`, `W2.3()`, `W2.4()`: Weibull type 2 + +**Best for:** +- Data with asymmetric dose-response curves +- Time-to-event data +- Germination/mortality studies + +**Example:** +```{r weibull-example, fig.alt="Comparison of Weibull Type 1 (blue) and Type 2 (red dashed) models showing asymmetric dose-response curves"} +# Weibull models often fit plant growth data well +example.W1 <- drm(rootl ~ conc, data = ryegrass, fct = W1.4()) +example.W2 <- drm(rootl ~ conc, data = ryegrass, fct = W2.4()) + +# Compare +plot(example.W1, type = "all", main = "Weibull Type 1 vs Type 2", + lwd = 2, col = "blue", legend = FALSE) +plot(example.W2, add = TRUE, type = "none", lwd = 2, col = "red", lty = 2) +legend("topright", legend = c("W1.4", "W2.4"), + col = c("blue", "red"), lwd = 2, lty = c(1, 2)) +``` + +#### Log-Normal Models (LN family) + +**Characteristics:** +- Based on log-normal distribution +- Symmetric on log-dose scale +- Similar to log-logistic but different tail behavior + +**Variants:** +- `LN.2()`, `LN.3()`, `LN.3u()`, `LN.4()` + +**Best for:** +- Data with normal distribution on log scale +- Particle size distributions +- Alternative to log-logistic when AIC suggests + +**Example:** +```{r lognormal-example} +example.LN <- drm(rootl ~ conc, data = ryegrass, fct = LN.4()) +``` + +#### Exponential Decay Models (EXD family) + +**Characteristics:** +- Exponential decrease +- No lower asymptote (unless constrained) +- Simpler than sigmoidal models + +**Variants:** +- `EXD.2()`: 2 parameters +- `EXD.3()`: 3 parameters + +**Best for:** +- Exponential decay processes +- Radioactive decay +- Simple inhibition without clear asymptote + +**Example:** +```{r exd-example} +example.EXD <- drm(rootl ~ conc, data = ryegrass, fct = EXD.3()) +``` + +### Hormesis (Non-Monotonic) Models + +Hormesis describes a biphasic dose-response relationship where low doses stimulate a response (increase) while high doses inhibit (decrease). This creates a characteristic inverted U-shape or J-shape curve. + +#### Brain-Cousens Models (BC family) + +**Characteristics:** +- Adds hormesis parameter to log-logistic model +- Peak response at intermediate dose +- Widely used for hormetic data + +**Variants:** +- `BC.4()`: 4 parameters (c=0 fixed) +- `BC.5()`: 5 parameters (all free) + +**Parameters:** +- Standard LL parameters plus `f`: hormesis parameter (controls magnitude of stimulation) + +**Best for:** +- Plant growth stimulation at low herbicide doses +- Pharmaceutical hormesis +- Toxicological hormesis + +**Example (conceptual):** +```{r bc-example, eval=FALSE} +# Example with hormetic data (not ryegrass which is monotonic) +# hormetic.model <- drm(response ~ dose, data = hormetic_data, fct = BC.5()) +# plot(hormetic.model) +``` + +#### Cedergreen-Ritz-Streibig Models (CRS family) + +**Characteristics:** +- More flexible hormesis models +- Multiple parameterizations (a, b, c variants) +- Better for pronounced hormesis + +**Variants:** +- `CRS.4a()`, `CRS.4b()`, `CRS.4c()`: 4-parameter variants +- `CRS.5a()`, `CRS.5b()`, `CRS.5c()`: 5-parameter variants +- `CRS.6()`: 6 parameters (most flexible) + +**Best for:** +- Strong hormesis effects +- When BC models don't fit well +- Detailed hormesis characterization + +#### U-Shaped Cedergreen Models (UCRS family) + +**Characteristics:** +- U-shaped response (opposite of hormesis) +- Low and high doses harmful, intermediate doses beneficial +- Less common than hormesis + +**Variants:** +- `UCRS.4a()`, `UCRS.4b()`, `UCRS.4c()` +- `UCRS.5a()`, `UCRS.5b()`, `UCRS.5c()` + +**Best for:** +- Essential nutrients (deficiency and toxicity) +- Biphasic therapeutic responses + +### Model Selection Decision Tree + +``` +Is your dose-response curve monotonic? +│ +├─ YES (Monotonic/No Hormesis) +│ │ +│ ├─ Standard S-shaped curve? → Start with LL.4 +│ ├─ Asymmetric curve? → Try W1.4 or W2.4 +│ ├─ Simple decay? → Try EXD.3 +│ └─ Unknown? → Compare LL.4, W1.4, W2.4, LN.4 using mselect() +│ +└─ NO (Non-Monotonic/Hormesis) + │ + ├─ Inverted U-shape (stimulation then inhibition)? → Try BC.5 + ├─ Strong hormesis? → Try CRS.5a + ├─ U-shaped (harm-benefit-harm)? → Try UCRS.5a + └─ Unknown? → Compare BC.5, CRS.5a with mselect() +``` + +### Practical Recommendations + +1. **Start Simple**: Begin with LL.4 or W1.4 for monotonic data +2. **Use Model Selection**: Always compare multiple models with `mselect()` +3. **Check Residuals**: Visual diagnostics are essential +4. **Consider Biology**: Model choice should make biological sense +5. **Parameter Constraints**: Use simpler models (LL.3, LL.2) when appropriate +6. **Hormesis Testing**: If you suspect hormesis, explicitly test with BC or CRS models + +### Comprehensive Model Comparison Example + +```{r comprehensive-comparison} +# Compare a wide range of monotonic models for ryegrass data +comprehensive <- suppressWarnings( + mselect(ryegrass.LL4, nested = TRUE, + fctList = list(LL.3(), LL.5(), + W1.3(), W1.4(), + W2.3(), W2.4(), + LN.3(), LN.4(), + EXD.3())) +) +comprehensive +``` + +## Conclusion + +This vignette has demonstrated a comprehensive workflow for dose-response analysis using the `drc` package. By following these steps, you can: + +### Key Takeaways + +1. **Always Start with Exploration**: Visualize your data before fitting models +2. **Fit Multiple Models**: Don't rely on a single model without comparison +3. **Use Visual Diagnostics**: Q-Q plots and residual plots are essential +4. **Perform Statistical Tests**: Use `noEffect()` and `modelFit()` to validate your model +5. **Compare Systematically**: Use `mselect()` with AIC for objective model selection +6. **Consider Model Averaging**: Use `maED()` when multiple models fit similarly +7. **Understand Parameter Constraints**: Know when to fix or free asymptotes (c, d parameters) +8. **Choose Models Based on Data Type**: Distinguish between monotonic and hormetic responses + +### Common Pitfalls to Avoid + +1. **Fitting only one model**: Always compare alternatives +2. **Ignoring diagnostics**: Visual and statistical checks are crucial +3. **Over-parameterization**: More parameters isn't always better +4. **Inappropriate constraints**: Don't fix parameters without justification +5. **Ignoring biology**: Statistical fit should align with biological plausibility +6. **Using hormesis models for monotonic data**: This can lead to spurious hormesis +7. **Not reporting confidence intervals**: Point estimates without uncertainty are incomplete + +### Recommended Workflow Summary + +1. **Explore** your data with plots +2. **Fit** an initial general model (e.g., LL.4) +3. **Assess** fit visually (Q-Q plots, residual plots) +4. **Test** statistically (noEffect, modelFit) +5. **Compare** multiple models (mselect) +6. **Select** the best model or use model averaging +7. **Estimate** EDs/ECs with appropriate confidence intervals +8. **Evaluate** parameter constraints if needed +9. **Interpret** results in biological context +10. **Report** model choice, fit statistics, and ED estimates with CIs + +### Further Resources + +- See `?drm` for detailed function documentation +- See `?LL.4`, `?W1.4`, etc. for specific model documentation +- See `?mselect` for model selection details +- See `?ED` for effective dose estimation options +- See the "Understanding NEC Models" vignette for threshold models + +## References + +Ritz, C., Baty, F., Streibig, J. C., Gerhard, D. (2015). Dose-Response Analysis Using R. *PLOS ONE*, **10**(12), e0146021. + +Ritz, C., Streibig, J. C. (2005). Bioassay analysis using R. *Journal of Statistical Software*, **12**(5), 1-22. + +Brain, P., Cousens, R. (1989). An equation to describe dose-responses where there is stimulation of growth at low doses. *Weed Research*, **29**, 93-96. + +Cedergreen, N., Ritz, C., Streibig, J. C. (2005). Improved empirical models describing hormesis. *Environmental Toxicology and Chemistry*, **24**, 3166-3172. + +Inderjit, Streibig, J. C., Olofsdotter, M. (2002). Joint action of phenolic acid mixtures and its significance in allelopathy research. *Physiologia Plantarum*, **114**, 422-428. + +## See Also + +- `vignette("nec-models")` - Understanding NEC Models in the drc Package +- `?drm` - Main function for fitting dose-response models +- `?ED` - Estimating effective doses +- `?mselect` - Model selection +- `?modelFit` - Goodness-of-fit testing +- `?plot.drc` - Plotting dose-response curves diff --git a/vignettes/nec-models.Rmd b/vignettes/nec-models.Rmd new file mode 100644 index 00000000..e880892a --- /dev/null +++ b/vignettes/nec-models.Rmd @@ -0,0 +1,392 @@ +--- +title: "Understanding NEC Models in the drc Package" +author: "Hannes Reinwald" +date: "`r Sys.Date()`" +output: rmarkdown::html_vignette +vignette: > + %\VignetteTitle{Understanding NEC Models in the drc Package} + %\VignetteIndexEntry{Understanding NEC Models in the drc Package} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r setup, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>", + fig.width = 7, + fig.height = 5 +) +library(drc) +``` + +## Executive Summary + +The `drc` R package contains 4 NEC (No Effect Concentration) functions: `NEC`, `NEC.2`, `NEC.3`, and `NEC.4`. After thorough analysis, **all functions are necessary and serve distinct purposes**. There is no redundancy. + +## Introduction + +The No Effect Concentration (NEC) model is a dose-response model with a threshold below which the response is assumed constant and equal to the control response. It has been proposed as an alternative to both the classical NOEC (No Observed Effect Concentration) and the regression-based EC/ED approach (Pires et al., 2002). + +This vignette explains the differences between the four NEC functions available in the drc package and provides guidance on when to use each variant. + +## The NEC Model Equation + +The NEC model function proposed by Pires et al. (2002) is: + +$$f(x) = c + (d-c) \exp(-b(x-e)I(x-e))$$ + +where $I(x-e)$ is an indicator function equal to 0 for $x \leq e$ and 1 for $x > e$. + +### Model Parameters + +- **b**: Slope/rate parameter controlling the steepness of the dose-response curve above the threshold +- **c**: Lower limit (control response) - the response level below the threshold +- **d**: Upper limit (maximum response) - the asymptotic response at high doses +- **e**: NEC threshold (no effect concentration) - the dose below which there is no effect + +## Function Overview + +### Base Implementation: NEC (Not Exported) + +The `NEC` function is the core implementation that provides the flexible NEC dose-response model. It is **not exported** in the package NAMESPACE and serves as an internal implementation engine. + +**Key Features:** + +- Accepts a `fixed` argument to specify which parameters should be fixed +- Uses log-logistic self-starter function for initialization +- Returns a model list with nonlinear function, self starter, and parameter names + +This function is called internally by all the numbered variants (NEC.2, NEC.3, NEC.4) with specific parameter constraints. + +### NEC.2: Two-Parameter NEC Model + +**Purpose:** Convenience wrapper for highly constrained scenarios where both lower and upper limits are known. + +**Free Parameters:** 2 + +- `b`: Slope parameter +- `e`: NEC threshold + +**Fixed Parameters:** + +- `c`: Fixed at 0 +- `d`: Fixed at user-specified value (default 1) + +**Use Cases:** + +- Response bounded on a known scale (e.g., 0-1 for proportions, 0-100 for percentages) +- Both bounds are well-defined from experimental design +- Focus estimation on slope and threshold only +- Reduces model complexity and improves parameter identifiability + +**Example:** + +```{r nec2-example, fig.alt="NEC.2 model fitted to normalized ryegrass proportion data showing threshold dose-response relationship"} +# Example with proportion data (bounded 0-1) +# Using ryegrass data, normalizing to 0-1 scale +data(ryegrass) +ryegrass$prop_rootl <- ryegrass$rootl / max(ryegrass$rootl) + +# Fit NEC.2 model with upper limit fixed at 1 +nec2.model <- drm(prop_rootl ~ conc, data = ryegrass, fct = NEC.2()) +summary(nec2.model) +``` + +### NEC.3: Three-Parameter NEC Model + +**Purpose:** Most common variant - assumes zero baseline response with variable maximum. + +**Free Parameters:** 3 + +- `b`: Slope parameter +- `d`: Upper limit +- `e`: NEC threshold + +**Fixed Parameters:** + +- `c`: Fixed at 0 + +**Use Cases:** + +- Standard toxicological/biological scenarios +- Baseline response is zero (no treatment/exposure) +- Maximum response varies by treatment +- Balances flexibility with model stability +- Reduces overfitting compared to NEC.4 + +**Example:** + +```{r nec3-example, fig.alt="NEC.3 model for ryegrass root length showing threshold effect at low concentrations followed by exponential decline"} +# Fit NEC.3 model - most common case +# Assumes zero baseline response +nec3.model <- drm(rootl ~ conc, data = ryegrass, fct = NEC.3()) +summary(nec3.model) + +# Plot the fitted model +plot(nec3.model, type = "all", log = "", + main = "NEC.3 Model for Ryegrass Root Length", + xlab = "Ferulic acid concentration (mM)", + ylab = "Root length (cm)") +``` + +### NEC.4: Four-Parameter NEC Model + +**Purpose:** Full flexibility - all parameters estimated from data. + +**Free Parameters:** 4 + +- `b`: Slope parameter +- `c`: Lower limit +- `d`: Upper limit +- `e`: NEC threshold + +**Use Cases:** + +- No biological constraints on parameters +- Both baseline and maximum responses vary +- Model selection and comparison workflows +- Maximum flexibility when data supports it +- Cases where control/baseline response is non-zero and unknown + +**Example:** + +```{r nec4-example} +# Fit NEC.4 model - full flexibility +nec4.model <- drm(rootl ~ conc, data = ryegrass, fct = NEC.4()) +summary(nec4.model) + +# Compare parameter estimates +coef(nec4.model) +``` + +## Comparison of NEC Variants + +The following table summarizes the key differences between the NEC functions: + +| Aspect | NEC (base) | NEC.2 | NEC.3 | NEC.4 | +|--------|-----------|-------|-------|-------| +| **Exported** | No | Yes | Yes | Yes | +| **Free Parameters** | Configurable | 2 (b, e) | 3 (b, d, e) | 4 (b, c, d, e) | +| **Fixed c (lower)** | Configurable | 0 | 0 | Free | +| **Fixed d (upper)** | Configurable | User-defined | Free | Free | +| **Model Complexity** | Depends | Lowest | Medium | Highest | +| **When to Use** | Internal only | Known bounds | Zero baseline | Full flexibility | +| **Identifiability** | Depends | Excellent | Good | May be challenging | + +## Model Comparison Example + +Let's compare the three exported NEC variants on the ryegrass dataset: + +```{r model-comparison, fig.alt=c("NEC.2 model fitted to ryegrass data with both asymptotes constrained", "NEC.3 model fitted to ryegrass data with lower asymptote fixed at zero", "NEC.4 model fitted to ryegrass data with all parameters estimated")} +# Fit all three models +nec2.fit <- drm(rootl ~ conc, data = ryegrass, fct = NEC.2(upper = max(ryegrass$rootl))) +nec3.fit <- drm(rootl ~ conc, data = ryegrass, fct = NEC.3()) +nec4.fit <- drm(rootl ~ conc, data = ryegrass, fct = NEC.4()) + +# Compare models using AIC +cat("Model Comparison (AIC values):\n") +cat("NEC.2:", AIC(nec2.fit), "\n") +cat("NEC.3:", AIC(nec3.fit), "\n") +cat("NEC.4:", AIC(nec4.fit), "\n") + +# Plot all three models together +my_plot = function(mod, col = "black", lwd = 2, pch = 16) { + plot(mod, type = "all", + main = mod$fct$name, + col = col, lwd = lwd, pch = pch, + xlab = "Ferulic acid concentration (mM)", + ylab = "Root length (cm)") +} +my_plot(nec2.fit) +my_plot(nec3.fit, col = "darkblue", lwd = 2) +my_plot(nec4.fit, col = "darkred", lwd = 2) +``` + +## Design Pattern in the drc Package + +The NEC functions follow the **standard drc package design pattern** used consistently across all model families: + +### Examples of Similar Patterns: + +1. **Log-logistic models:** `llogistic`, `LL.2`, `LL.3`, `LL.3u`, `LL.4`, `LL.5` +2. **Weibull type 1:** `weibull1`, `W1.2`, `W1.3`, `W1.3u`, `W1.4` +3. **Weibull type 2:** `weibull2`, `W2.2`, `W2.3`, `W2.3u`, `W2.4` +4. **Gompertz:** `gompertz`, `G.2`, `G.3`, `G.3u`, `G.4` +5. **Log-normal:** `lnormal`, `LN.2`, `LN.3`, `LN.3u`, `LN.4` + +### Pattern Structure: + +1. **Base function** (e.g., `llogistic`, `NEC`) + - Provides core implementation with full parameter flexibility + - Often not exported (used internally) + - Accepts `fixed` argument for parameter constraints + +2. **Numbered variants** (e.g., `LL.2`, `LL.3`, `LL.4`, `LL.5`) + - Convenience wrappers with common parameter combinations + - Exported for user convenience + - Number indicates count of free parameters + - Each serves specific biological/experimental scenarios + +### Benefits of This Design: + +- **User convenience**: Common cases are easy to specify +- **Parameter identifiability**: Constraining parameters when appropriate improves estimation +- **Model selection**: Easy to compare nested models +- **Biological meaning**: Parameter constraints reflect experimental knowledge +- **Backwards compatibility**: Adding variants doesn't break existing code +- **Documentation clarity**: Each variant can have specific use-case documentation + +## Choosing the Right NEC Variant + +Here's a decision guide to help you choose the appropriate NEC function: + +1. **Do you know both the lower and upper response limits?** + - Yes → Use **NEC.2** + - No → Go to step 2 + +2. **Is your baseline (control) response zero or can it be assumed to be zero?** + - Yes → Use **NEC.3** (most common case) + - No → Go to step 3 + +3. **Do you need to estimate all parameters from the data?** + - Yes → Use **NEC.4** + - Unsure → Start with **NEC.3** and compare with **NEC.4** using model selection criteria (AIC, BIC) + +### Example Decision Process: + +```{r decision-example, eval=FALSE} +# Toxicology study with percentage mortality (0-100%) +# Known bounds: lower = 0%, upper = 100% +# → Use NEC.2 +mortality.model <- drm(mortality ~ dose, data = mydata, fct = NEC.2(upper = 100)) + +# Plant growth study measuring root length +# Control (no treatment) shows some growth (not zero) +# → Try both NEC.3 and NEC.4, compare with AIC +model3 <- drm(rootlength ~ concentration, data = mydata, fct = NEC.3()) +model4 <- drm(rootlength ~ concentration, data = mydata, fct = NEC.4()) +mselect(model3, model4) + +# Standard dose-response with zero baseline +# Maximum response unknown +# → Use NEC.3 +response.model <- drm(response ~ dose, data = mydata, fct = NEC.3()) +``` + +## Redundancy Assessment + +### Are any NEC functions redundant? + +**Answer: NO - All functions are necessary.** + +### Reasoning: + +1. **NEC (base function)** + - Cannot be removed: Contains the actual mathematical implementation + - All other functions are wrappers that call `NEC` with specific constraints + - Removing it would break NEC.2, NEC.3, and NEC.4 + +2. **NEC.2** + - Unique purpose: Only variant with both upper and lower limits fixed + - Distinct use case: Bounded response scales (proportions, percentages) + - Cannot be replicated: NEC.3 fixes only lower limit, NEC.4 fixes nothing + - Statistical benefit: Reduces parameters from 4 to 2, greatly improving identifiability + +3. **NEC.3** + - Most common scenario: Standard toxicology with zero baseline + - Optimal balance: More flexible than NEC.2, more stable than NEC.4 + - Common convention: Matches typical experimental designs where control = 0 + - Unique constraint: Only variant fixing lower limit while freeing upper limit + +4. **NEC.4** + - Essential for flexibility: Only way to estimate all 4 parameters + - Model selection: Needed for comparing against constrained models + - Non-zero baselines: Only option when control response is unknown and non-zero + - Diagnostic tool: Helps determine if constraints are appropriate + +### User Experience Comparison: + +If functions were combined, users would need to manually specify constraints: + +```{r user-experience, eval=FALSE} +# Current approach (user-friendly): +drm(y ~ x, data = mydata, fct = NEC.3()) + +# If combined (cumbersome and error-prone): +drm(y ~ x, data = mydata, fct = NEC(fixed = c(NA, 0, NA, NA))) +``` + +The current design: +- Reduces usability barriers +- Prevents errors from wrong constraint specifications +- Provides helpful documentation for common cases +- Maintains backwards compatibility +- Follows established drc package conventions + +## Practical Tips + +### 1. Starting with Model Selection + +When unsure which variant to use, start with NEC.3 (most common) and compare with other variants: + +```{r tips-model-selection, eval=FALSE} +# Fit an initial model, then compare with alternative NEC variants +m3 <- drm(response ~ dose, data = mydata, fct = NEC.3()) + +# Compare using model selection (mselect takes one fitted model + a list of alternatives) +mselect(m3, fctList = list(NEC.2(), NEC.4())) +``` + +### 2. Checking Parameter Identifiability + +If your NEC.4 model shows very large standard errors or fails to converge, consider constraining parameters: + +```{r tips-identifiability, eval=FALSE} +# If NEC.4 has convergence issues, try NEC.3 +summary(nec4.model) # Check standard errors +# If c is close to 0 with large SE, use NEC.3 +nec3.model <- drm(response ~ dose, data = mydata, fct = NEC.3()) +``` + +### 3. Interpreting the Threshold Parameter + +The `e` parameter represents the NEC threshold - the concentration below which there is no effect: + +```{r tips-threshold, eval=FALSE} +# Extract the threshold estimate +threshold <- coef(nec3.model)["e:(Intercept)"] +cat("Estimated NEC threshold:", threshold, "\n") + +# Get confidence interval for the threshold +confint(nec3.model) +``` + +## Conclusion + +All 4 NEC functions serve distinct and necessary purposes in the drc package: + +- **NEC**: Internal implementation engine +- **NEC.2**: Highly constrained models with known bounds (2 parameters) +- **NEC.3**: Standard case with zero baseline (3 parameters) - **most commonly used** +- **NEC.4**: Full flexibility for complex scenarios (4 parameters) + +The design represents: + +1. **Sound software architecture**: Internal implementation separated from user interface +2. **Statistical best practice**: Providing appropriate model complexity for different scenarios +3. **User experience optimization**: Common cases are simple, complex cases are possible +4. **Package consistency**: Matches the established pattern used for all other model families + +## References + +Pires, A. M., Branco, J. A., Picado, A., Mendonca, E. (2002) Models for the estimation of a 'no effect concentration', *Environmetrics*, **13**, 15-27. + +## See Also + +- `?NEC` - Base NEC function documentation +- `?NEC.2` - Two-parameter NEC model +- `?NEC.3` - Three-parameter NEC model +- `?NEC.4` - Four-parameter NEC model +- `?drm` - Main function for fitting dose-response models +- `?mselect` - Model selection function diff --git a/vignettes/package-version-comparative-analysis.Rmd b/vignettes/package-version-comparative-analysis.Rmd new file mode 100644 index 00000000..ce29e074 --- /dev/null +++ b/vignettes/package-version-comparative-analysis.Rmd @@ -0,0 +1,438 @@ +--- +title: "Comparative Analysis: hreinwald/drc vs DoseResponse/drc" +author: "Hannes Reinwald" +date: "2026-04-24" +output: rmarkdown::html_vignette +vignette: > + %\VignetteTitle{Comparative Analysis: hreinwald/drc vs DoseResponse/drc} + %\VignetteIndexEntry{Comparative Analysis: hreinwald/drc vs DoseResponse/drc} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r setup, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +## For: *"Reviving drc: A corrected and modernized R package for dose-response analysis"* + +--- + +## Executive Summary + +The `drc` R package (Ritz et al., 2015, *PLOS ONE*) is among the most widely deployed tools for dose-response analysis in bioassay, toxicology, pharmacology, and ecotoxicology. The version maintained at `DoseResponse/drc` (v3.2-0, last updated January 2021) harbors multiple correctness bugs of varying severity that silently corrupt downstream results. The fork at `hreinwald/drc` (`dev` branch, v3.3.2) addresses these systematically. The most critical bug discovered is a missing lower-asymptote term (`c` parameter) in the U-shaped Cedergreen-Ritz-Streibig hormesis models (`UCRS.*`), rendering every result computed with those functions incorrect. Secondary bugs include incorrect gradient vectors for absolute-type effective dose (ED) standard errors across at least seven model families, a wrong derivative in `gammadr()`, and a function-level edfct signature mismatch in the logistic model family. + +Beyond bug correction, `hreinwald/drc` delivers a substantially refactored codebase: dead code removed from 70+ source files, file naming standardized, a comprehensive test suite of 79 `testthat` files added (versus 3 ad-hoc test scripts in the original), and full `pkgdown` documentation deployed at https://hreinwald.github.io/drc/. CI/CD is integrated through three GitHub Actions workflows (R-CMD-check, code coverage, pkgdown deployment). The fork source lacks equivalent infrastructure: it has only a deprecated Travis CI configuration, no `CITATION.cff`, and a seven-line README. + +Taken together, the evidence supports the framing of this as not a mere maintenance release but a substantive correction to the scientific record. Users who computed ED confidence intervals using `type="absolute"` with Weibull, log-logistic, log-normal, logistic, Brain-Cousens, or fplogistic models—or who fitted any UCRS hormesis model—may have published incorrect standard errors or incorrect fitted values. + +--- + +## 1. Critical Bugs Identified + +### 1.1 Missing Lower Asymptote (`c`) in U-shaped CRS Model — SEVERITY: **CRITICAL** + +**Affected model/function:** `ucedergreen()` and all convenience wrappers `UCRS.4a`, `UCRS.4b`, `UCRS.4c`, `UCRS.5a`, `UCRS.5b`, `UCRS.5c` + +**File:** `R/ucedergreen.R` + +**Original (incorrect) code** (`DoseResponse/drc`, `R/ucedergreen.R`, line ~32): +```{r, eval = FALSE} +fct <- function(dose, parm) +{ + parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE) + parmMat[, notFixed] <- parm + + numTerm <- parmMat[, 3] - parmMat[, 2] + parmMat[, 5]*exp(-1/dose^alpha) + denTerm <- 1 + exp(parmMat[, 1]*(log(dose) - log(parmMat[, 4]))) + parmMat[, 3] - numTerm/denTerm # WRONG: missing parmMat[, 2] (c parameter) +} +``` + +**Fixed code** (`hreinwald/drc`, `R/ucedergreen.R`, line ~56): +```{r, eval = FALSE} +fct <- function(dose, parm) +{ + parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE) + parmMat[, notFixed] <- parm + + numTerm <- parmMat[, 3] - parmMat[, 2] + parmMat[, 5]*exp(-1/dose^alpha) + denTerm <- 1 + exp(parmMat[, 1]*(log(dose) - log(parmMat[, 4]))) + parmMat[, 2] + parmMat[, 3] - numTerm/denTerm # CORRECT: c + d - numTerm/denTerm +} +``` + +**Scientific impact:** The published model formula (Cedergreen, Ritz & Streibig, 2005, *Environ. Toxicol. Chem.* 24:3166) is: + +$$f(x) = c + d - \frac{d - c + f\,e^{-1/x^\alpha}}{1 + \exp(b(\log x - \log e))}$$ + +The original implementation returns `d - numTerm/denTerm`, i.e., the fitted response is shifted upward by `c` (the lower horizontal asymptote) for all dose values. When `c = 0` (the most common case for UCRS.4x models), the result is numerically coincidentally correct; however, when `c` is estimated (UCRS.5x) or is supplied as a non-zero fixed value, every fitted value is wrong by exactly `c`. Any paper that used `UCRS.5a`, `UCRS.5b`, or `UCRS.5c` with estimated `c ≠ 0` and reported dose-response parameters, EC values, or hormesis estimates has incorrect results that propagate to all downstream comparisons. + +Additionally, the `deriv1` (gradient with respect to the `c` parameter) in the original code is `1/t3` (positive), whereas the corrected formula's partial derivative is `1 + 1/t3`. This means even if fitted values were not perceptibly shifted (because `c ≈ 0`), standard errors for the c-parameter estimate were systematically wrong. + +--- + +### 1.2 Wrong Multiplier in `gammadr()` Gradient — SEVERITY: **HIGH** + +**Affected model/function:** `gammadr()` — Gamma dose-response model + +**File:** `R/gammadr.r` (DoseResponse) vs `R/gammadr.R` (hreinwald) + +**Original (incorrect) code** (`DoseResponse/drc`, `R/gammadr.r`, inside `deriv1`): +```{r, eval = FALSE} +cbind( + t1 * dgamma(parmMat[, 1] * dose, parmMat[, 4], 1) * parmMat[, 1], # WRONG: uses b not dose + 1 - t2, + t2, + t1 * logGamma(parmMat[, 1] * dose, parmMat[, 4]) +)[, notFixed] +``` + +**Fixed code** (`hreinwald/drc`, `R/gammadr.R`, inside `deriv1`): +```{r, eval = FALSE} +cbind( + t1 * dgamma(parmMat[, 1] * dose, parmMat[, 4], 1) * dose, # CORRECT: uses dose + 1 - t2, + t2, + t1 * logGamma(parmMat[, 1] * dose, parmMat[, 4]) +)[, notFixed] +``` + +**Scientific impact:** The derivative of `f(x) = c + (d-c) · pgamma(b·x, e, 1)` with respect to `b` is `(d-c) · dgamma(b·x, e, 1) · x`. The original uses `b` instead of `x` in this product, yielding a gradient vector that scales incorrectly with the dose. This corrupts the delta-method standard errors for the `b` parameter and propagates to standard errors for any derived quantities (ED values, predicted values with CIs) computed from models fit with `gammadr()`. + +--- + +### 1.3 Zero Gradients for Absolute-Type ED Standard Errors (7 Model Families) — SEVERITY: **HIGH** + +**Affected models/functions:** `braincousens()`, `fplogistic()`, `llogistic()`, `llogistic2()`, `lnormal()`, `weibull1()`, `weibull2()` + +**Files:** Respective `R/*.R` files in both repositories + +**Root cause (shared pattern, shown for `weibull1()`)**: + +Original code (`DoseResponse/drc`, `R/weibull1.r`, `edfct`): +```{r, eval = FALSE} +edfct <- function(parm, respl, reference, type, ...) +{ + parmVec[notFixed] <- parm + p <- EDhelper(parmVec, respl, reference, type) + + tempVal <- log(-log((100-p)/100)) + EDp <- exp(tempVal/parmVec[1] + log(parmVec[4])) + + EDder <- EDp*c(-tempVal/(parmVec[1]^2), 0, 0, 1/parmVec[4]) + # ^^^ derivatives for c and d are always 0 — correct only for relative type + return(list(EDp, EDder[notFixed])) +} +``` + +Fixed code (`hreinwald/drc`, `R/weibull1.R`, `edfct`): +```{r, eval = FALSE} +edfct <- function(parm, respl, reference, type, ...) +{ + parmVec[notFixed] <- parm + p <- EDhelper(parmVec, respl, reference, type) + + tempVal <- log(-log((100-p)/100)) + EDp <- exp(tempVal/parmVec[1] + log(parmVec[4])) + EDder <- EDp*c(-tempVal/(parmVec[1]^2), 0, 0, 1/parmVec[4]) + + ## Fix: correct c and d derivatives for absolute type using central differences. + if (identical(type, "absolute")) { + .edval <- function(pv) { ... } # full chain-rule evaluation + for (.i in c(2, 3)) { + .h <- ... + EDder[.i] <- (.edval(.pvUp) - .edval(.pvDn)) / (2 * .h) + } + } + return(list(EDp, EDder[notFixed])) +} +``` + +**Scientific impact:** When users call `ED(model, respLev, type="absolute", interval="delta")`, the delta-method standard errors reported for the ED values are incorrect because ∂ED/∂c and ∂ED/∂d are set to zero. The absolute-to-relative conversion (`absToRel`/`EDhelper`) makes `p` a function of both `c` and `d`; the chain rule therefore requires non-zero partial derivatives. The magnitude of the error depends on the spread of the response: for data with large ranges between `c` and `d`, the absolute type conversion creates large sensitivity to asymptote estimates, and zeroing those terms can substantially underestimate the true confidence interval width. Any published confidence intervals for absolute ED values from the original package are potentially too narrow. + +--- + +### 1.4 `logistic()` `edfct` Signature Mismatch and Wrong p-swap — SEVERITY: **HIGH** + +**Affected model/function:** `logistic()` and all convenience wrappers `L.3`, `L.4`, `L.5` + +**File:** `R/logistic.r` (DoseResponse) vs `R/logistic.R` (hreinwald) + +**Original (incorrect) code** (`DoseResponse/drc`, `R/logistic.r`, `edfct`): +```{r, eval = FALSE} +edfct <- function(parm, p, ...) +{ + parmVec[notFixed] <- parm + # ... (no reference or type handling) + # ... always uses p directly, no type="absolute" support + return(list(EDp, EDder[notFixed])) +} +``` + +**Fixed code** (`hreinwald/drc`, `R/logistic.R`, `edfct`): +```{r, eval = FALSE} +edfct <- function(parm, respl, reference = "control", type = "relative", ...) +{ + parmVec[notFixed] <- parm + if (identical(type, "absolute")) { + p <- 100 * ((parmVec[3] - respl) / (parmVec[3] - parmVec[2])) + } else { + p <- respl + } + ## NOTE: unlike log-logistic models, logistic model has b < 0 = increasing, + ## so EDhelper's p-swap for b < 0 would be incorrect here. + ... +} +``` + +**Scientific impact:** The logistic model (`L.3`, `L.4`, `L.5`) uses raw dose values (not `log(dose)`), so the sign convention of `b` is reversed compared to log-logistic models. The original code ignores `type` and `reference` arguments, meaning `ED(model, type="absolute")` would silently return wrong values (no error is thrown; the wrong formula runs). Furthermore, the original code would delegate to `EDhelper` which applies an incorrect p-swap for this model family, yielding ED values computed at the complementary percentile (e.g., computing ED10 instead of ED90). + +--- + +### 1.5 `ucedergreen()` — Additional Bugs (17 Total) — SEVERITY: **CRITICAL/HIGH/MEDIUM** + +The `ucedergreen()` function in DoseResponse/drc contained 17 separate bugs documented in the hreinwald NEWS.md for v3.3.0.02. A summary of the most impactful: + +| Sub-Bug | Location | Severity | +|---|---|---| +| Missing `+c` in fct (see §1.1) | `fct()` | CRITICAL | +| `edfct` signature mismatch (`p` vs `respl`, missing `reference`/`type`) | `edfct()` | HIGH | +| `deriv1`: wrong sign/formula for c-column (`1/t3` vs `1 + 1/t3`) | `deriv1()` | HIGH | +| Undefined `xlogx` call in `deriv1` (uses unset closure) | `deriv1()` | HIGH | +| Missing `match.arg()` for `method` | top-level | MEDIUM | +| Vectorized `\|` in scalar `if()` guards | top-level | MEDIUM | +| Missing `useFixed` flag computation | self-starter | MEDIUM | +| `maxfct` signature mismatch | `maxfct()` | MEDIUM | +| Broken self-starter ignoring `alpha`/`method`/`useFixed` | `ssfct()` | MEDIUM | +| Missing `fctName`/`fctText` parameters | return list | LOW | +| `deriv1` excluded from return list | return list | HIGH | + +The absence of `deriv1` in the return list means that all Newton-type optimizers relying on gradient information would fail silently or fall back to finite differences, producing degraded convergence. + +--- + +### 1.6 `mselect()` Parse Error — SEVERITY: **MEDIUM** + +**File:** `R/mselect.r` / `R/mselect.R` + +**Bug:** Two missing closing braces in `mselect()`. This caused a parse error when the function was sourced directly from the file (though it would load correctly via the compiled package). Any user attempting to modify or source-load the function would encounter a confusing parse failure. + +--- + +### 1.7 `ED.lin.R` Incorrect Delta Method for Quadratic Models — SEVERITY: **MEDIUM** + +**File:** `R/ED.lin.R` + +**Bugs fixed in hreinwald:** +- Duplicate `if`-block (dead code evaluating the same condition twice) +- Stray debug `print()` statement (emits output during analysis) +- Missing `parameterNames = c("b0", "b1", "b2")` argument in `deltaMethod()` call for quadratic models — causing incorrect parameter mapping and therefore wrong confidence intervals for ED values from quadratic linear models. + +--- + +### 1.8 `drmOpt()` Inverted Trace/Silent Logic — SEVERITY: **MEDIUM** + +**File:** `R/drmOpt.R` + +**Bug:** The `otrace`/`silentVal` logic was inverted: `otrace=TRUE` (intending verbose output) incorrectly caused `silent=TRUE` in `try(optim())`, suppressing error messages rather than displaying them. This would cause optimization failures to be silently ignored during debugging sessions. + +--- + +## 2. Justification for Refactoring + +The codebase at `DoseResponse/drc` has been effectively unmaintained since January 2021 (version 3.2-0). During this time, multiple bugs have accumulated that undermine the scientific validity of results produced by the package. The justification for refactoring rests on five concrete lines of evidence: + +**1. Mathematical incorrectness in production models.** The missing `c` parameter in `ucedergreen()` (§1.1), the wrong multiplier in `gammadr()` (§1.2), and the zero-gradient errors in seven model families (§1.3) constitute mathematical errors that silently corrupt numerical results. These are not software bugs in the traditional sense (crashes, type errors) — they pass silently and deliver plausible-looking but wrong numbers. + +**2. API mismatch with the framework's own calling conventions.** The `edfct` function is called by `ED.drc` with the signature `(parm, respl, reference, type, ...)`. The logistic model's `edfct` only accepted `(parm, p, ...)`, silently dropping `reference` and `type`. Similarly, `ucedergreen()`'s `edfct` dropped `reference` and `type`. This is not a documentation problem; it is an undetected interface violation that causes incorrect behavior whenever users deviate from default parameters. + +**3. Dead code and commented-out experiments in production files.** Across 70+ source files, `if(FALSE){...}` blocks (sometimes hundreds of lines), stray `print()` debug statements, and large sections of commented-out alternative implementations existed in the production codebase. This constitutes significant technical debt that impedes maintenance, review, and the ability to reason about what code paths are active. + +**4. Non-standard file naming.** Many R source files used lowercase extensions (`.r` instead of `.R`): `backfit.r`, `baro5.r`, `comped.r`, `drmc.r`, `fct2list.r`, `gammadr.r`, `gompertz.r`, `hewlett.r`, `iband.r`, `idrm.r`, `isobole.r`, `lnormal.r`, `logistic.r`, `max.r`, `mixture.r`, `mrdrm.r`, `mselect.r`, `multi2.r`, `nec.r`, `pr.r`, `rdrm.r`, `relpot.r`, `sandwich.r`, `twophase.r`, `ursa.r`, `voelund.r`, `weibull1.r`, `weibull2.r`, `xlogx.r`. On case-sensitive file systems (Linux, most CI environments), this can cause load failures. + +**5. Complete absence of automated testing.** `DoseResponse/drc` contains 3 ad-hoc test scripts (`test1.r`, `test2.r`, `test3.r`) plus one seed-germination script — no `testthat` framework, no assertions, no coverage tracking. `hreinwald/drc` introduces 79 `testthat` test files covering all major model families, utility functions, and edge cases. + +--- + +## 3. Documentation Improvements + +### 3.1 README + +| Aspect | DoseResponse/drc | hreinwald/drc | +|---|---|---| +| File | `README.md` (7 lines) | `README.md` (~250 lines) | +| Status badges | CRAN, Travis CI (deprecated), Downloads | GitHub version, R-CMD-check, Codecov, lifecycle, CRAN, Downloads, License, Last-commit, Contributions | +| Package description | 1 sentence | Full description with 7-item feature list | +| Installation instructions | 3 lines (devtools only) | Multi-section: recommended GitHub install, tar.gz local install, CRAN (explicitly discouraged) | +| Quick Start | None | 3 worked examples with `drm()`, `ED()`, `EDcomp()`, `mselect()` | +| Model table | None | Complete table of all model families with descriptions | +| Key functions table | None | Complete table of core functions with descriptions | +| Data types | None | Complete table of `type=` options | +| Dependencies | None | Full list | +| Logo | None | Custom logo in `man/figures/logo.png` | + +### 3.2 Roxygen2 Documentation Quality + +`DoseResponse/drc` uses Roxygen2 version 6.1.1 (declared in DESCRIPTION). Most model files have minimal or no `@param`, `@return`, `@examples`, or `@details` tags — functions are defined with no Roxygen headers at all. + +`hreinwald/drc` uses Roxygen2 7.3.3 with markdown support (`Roxygen: list(markdown = TRUE)`). Every exported function has: + +- `@title` and `@description` +- `@param` for each argument with type and purpose +- `@return` describing the return structure +- `@details` with the mathematical formula in LaTeX +- `@examples` with working, runnable code +- `@seealso` cross-references +- `@references` with full bibliographic citations +- `@author` attributions +- `@keywords` + +Example of improvement — `weibull1()` documentation added: + +- 4-item describe block explaining each of the 4 self-starter methods +- LaTeX formula for the Weibull type 1 model +- Complete `@param` for each of 7 arguments +- 3 working examples across `W1.2`, `W1.3`, `W1.4`, `EXD.2`, `EXD.3` + +### 3.3 GitHub Pages Documentation + +| Aspect | DoseResponse/drc | hreinwald/drc | +|---|---|---| +| pkgdown site | Present (minimal, no GitHub Pages deployment) | Full site deployed at https://hreinwald.github.io/drc/ | +| Reference index | Basic auto-generated | Organized by category in `_pkgdown.yml` (3,265 bytes vs 1,863 bytes) | +| Vignettes | None | 2 vignettes: `dose-response-workflow.Rmd` (28KB), `nec-models.Rmd` (14KB) | +| Favicon/branding | None | Custom favicon and logo | +| Accessibility | None | Alt-text on all images | + +### 3.4 Vignettes + +`hreinwald/drc` introduces two new vignettes absent from `DoseResponse/drc`: + +1. **`dose-response-workflow.Rmd`** (28,149 bytes): A complete end-to-end workflow demonstrating data loading, model fitting, ED estimation, multi-curve comparison, model selection with `mselect()`, and result visualization. References the corrected ED output format. + +2. **`nec-models.Rmd`** (14,499 bytes): Dedicated documentation of No-Effect Concentration (NEC) models with scientific context, fitting examples, and interpretation guidance. + +### 3.5 CITATION.cff + +`DoseResponse/drc` has a plain-text `inst/citation` file (517 bytes) with no structured metadata. + +`hreinwald/drc` has a proper `CITATION.cff` (1,523 bytes) with CFF version 1.2.0, author ORCID identifiers for all four original authors, version, DOI, release date, and two structured `references` entries (PLoS ONE 2015 article and CRC Press 2019 book). + +--- + +## 4. New Features & Improvements + +### 4.1 New Functions + +| Function | File | Description | +|---|---|---| +| `rss()` | `R/rss.R` | Residual sum of squares for fitted `drc` objects; `Rsq()` now reuses `rss()` internally | +| `ED_robust()` (internal) | `R/ED_robust.R` | Robust ED estimation using `rlang` (replaces deprecated `lazyeval`) | +| `absToRel()` | `R/absToRel.R` | Exported utility: absolute-to-relative response level conversion | +| `commatFct()` | `R/commatFct.R` | Internal helper for formatting comma-separated parameter texts | +| `drm_legacy()` | `R/drm_legacy.R` | Legacy-compatible `drm()` interface for backward compatibility | +| `simFct()` / `simDR()` | `R/simFct.R` / `R/simDR.R` | Simulation functions for dose-response data generation | +| `onAttach()` | `R/onAttach.R` | Package attachment message with version info and repository URL | + +### 4.2 New Model Variants + +- All `UCRS` models (`UCRS.4a/4b/4c`, `UCRS.5a/5b/5c`) were completely rewritten — while they existed in DoseResponse/drc, they were functionally broken (see §1.1, §1.5) and are effectively new working implementations. +- `CRS.4a`, `CRS.4b`, `CRS.4c` display text fixes (e.g., `CRS.4b` now correctly shows "alpha=0.5" instead of "alpha="). + +### 4.3 Enhancements to Existing Functions + +- **`ED()` / `ED.drc()`**: Multiple robustness improvements — correct matrix handling when `indexMat` is a vector (single-parameter models), NaN/Inf handling in LL.5, dynamic curve loop with post-hoc `clevel` filtering, `drop=FALSE` for covariance matrix slices, unnamed gradient vectors. +- **`maED()`**: Excludes models with non-finite ED estimates or fitting errors from model-averaged estimate; returns `NA` instead of `NaN` when all candidates fail. +- **`predict.drc()`**: Fixed "incorrect number of dimensions" for models with many fixed parameters. +- **`plot.drc()`**: New `errbar.col` parameter to control error bar colors; default now matches curve colors. +- **`anova.drc()`**: Corrected documentation to accurately reflect actual behavior; improved error handling. +- **`mselect()`**: Fixed parse error from missing closing braces. +- **`noEffect()`**: Added warning when degrees of freedom difference ≤ 0. +- **`searchdrc()`**: Fixed regex error and convergence failure behavior. +- **`drmOpt()`**: Fixed inverted `otrace`/`silentVal` logic. + +### 4.4 Dependency Updates + +| Aspect | DoseResponse/drc | hreinwald/drc | +|---|---|---| +| R minimum version | ≥ 2.0.0 | ≥ 4.0.0 | +| `lazyeval` | Used | Replaced with `rlang` | +| `drcData` (separate package) | Required | Removed (data bundled or sourced differently) | +| `data.table`, `dplyr` | Not present | Added to Imports | +| `lifecycle` | Not present | Added to Imports (for deprecation warnings) | +| `testthat` | Not present in Suggests | Added (≥ 3.0.0) | +| `knitr`, `rmarkdown` | Not present | Added for vignettes | + +### 4.5 Test Coverage + +| Aspect | DoseResponse/drc | hreinwald/drc | +|---|---|---| +| Test framework | Ad-hoc R scripts | `testthat` v3 | +| Number of test files | 3 scripts + 1 data file | 79 test files | +| Models with dedicated tests | 0 | All major model families (llogistic, weibull1/2, logistic, gompertz, lnormal, braincousens, cedergreen, ucedergreen, NEC, gammadr, baro5, etc.) | +| Utility function tests | 0 | ED, ED.lin, EDcomp, maED, mselect, anova, modelFit, predict, CIcompX, rss, and many more | +| Code coverage tracking | None | Codecov integration via GitHub Actions | + +--- + +## 5. Version Control & Project Hygiene + +| Aspect | DoseResponse/drc | hreinwald/drc | +|---|---|---| +| Current version | 3.2-0 | 3.3.2 | +| Last substantive update | January 2021 | May 2026 | +| Commit quality | Sparse, terse messages | Structured commits with clear descriptions referencing issues | +| Active branches | Only `master` | `dev` (primary), `main_beta` (stable beta), multiple feature branches | +| CI/CD | `.travis.yml` (Travis CI — deprecated/inactive) | 3 GitHub Actions workflows: `R-CMD-check.yaml`, `test-coverage.yaml`, `static.yml` (pkgdown) | +| `CITATION.cff` | Absent | Present (CFF 1.2.0, ORCIDs, DOI, two references) | +| `NEWS.md` | `news` (plain text, no markdown) | `NEWS.md` (properly formatted, categorized, 36KB) | +| Issue tracker | Not actively used | Used with references in commit messages | +| pkgdown deployment | Not deployed | Auto-deployed via `static.yml` to GitHub Pages | +| License | GPL-2 | GPL-2 (correctly inherited) | +| Maintainer | Christian Ritz (inactive) | Hannes Reinwald (`cre` role) | +| Authors in DESCRIPTION | Ritz + Streibig | Ritz + Streibig + Reinwald (as `aut`, `cre`) | +| Roxygen version | 6.1.1 | 7.3.3 | +| File naming convention | Mixed `.r`/`.R` | Standardized `.R` throughout | + +--- + +## 6. Publication Readiness Summary + +### Items That Strengthen the Submission Now: + +- **Bug evidence is documented and reproducible.** The `NEWS.md` provides a detailed bug report for each fix. The 79 `testthat` tests provide regression guards. +- **The `ucedergreen()` bug** is a compelling primary justification: it is unambiguous, affects a named published model family, and affects all previous users. +- **Breadth of fixes** across 7 model families for the absolute-type ED gradient bug provides evidence of systematic, not incidental, review. + +### Items Recommended Before Submission (JSS / JOSS / The R Journal): + +1. **Benchmark study**: Quantify the numerical difference between old and new results on synthetic or real datasets (e.g., table showing correct vs. incorrect ED confidence intervals under `type="absolute"` for W1.4, LN.4, LL.4 — critical for reviewers to assess impact magnitude). + + +2. **Version stability**: The `dev` branch is still the primary development branch. A stable tagged release on `main` (or `main_beta` promoted) would be expected by most journal submission processes. + +3. **CRAN submission**: The README explicitly discourages the CRAN version. A corrected CRAN submission would maximally reach the user community and is required for R Journal papers referencing a package. + +4. **Vignette for the corrected bugs**: A dedicated vignette showing before/after comparisons (old vs. new results) for the most critical bugs would directly serve the paper's narrative. + +5. **Acknowledgment of original authors**: The paper should prominently acknowledge Ritz, Baty, Streibig & Gerhard as originators. The framing as "corrected and modernized" is already appropriately respectful. + +6. **Test coverage metric**: The README references a Codecov badge. A coverage percentage of ≥ 70% on key model functions would be a strong claim for a methods paper. + +--- + +## 7. Suggested Abstract Draft + +> The `drc` R package (Ritz *et al.*, 2015) provides a widely-used framework for parametric dose-response modeling in bioassay, toxicology, and ecotoxicology. Since its last CRAN release (v3.2-0, January 2021), the package has received no substantive maintenance despite continued use in the scientific literature. We present `drc` v3.3.2, a corrected and modernized version of the package, addressing a series of bugs ranging in severity from silently incorrect fitted values to systematically underestimated confidence intervals. The most critical error, discovered in the U-shaped Cedergreen-Ritz-Streibig hormesis model family (`UCRS.*`), omits the lower horizontal asymptote parameter from the model function, rendering every fitted value incorrect whenever the lower asymptote differs from zero. Additionally, the gradient functions used in delta-method standard error calculations for absolute-type effective dose (ED) estimates were incorrect in seven model families (Weibull type 1 and 2, log-logistic, log-normal, logistic, Brain-Cousens, and fractional polynomial logistic), consistently setting chain-rule contributions to zero and producing confidence intervals that are potentially too narrow. A further gradient error in the Gamma model inverted the rate-parameter derivative. These bugs affect published results obtained using the original package. Beyond correctness, the refactored package introduces 79 `testthat` unit tests (versus zero in the original), comprehensive Roxygen2 documentation with mathematical formulae and worked examples, a pkgdown documentation website, three GitHub Actions CI/CD workflows, and a `CITATION.cff` metadata file. The package is available from https://github.com/hreinwald/drc and is fully backward compatible with the existing `drm()` interface. + +--- + +## Source Repositories + +- **Refactored package (subject):** https://github.com/hreinwald/drc (branch: `dev`, commit `508f602`) +- **Fork source (baseline):** https://github.com/DoseResponse/drc (default branch `master`, commit `8719d43`) +- **GitHub Pages:** https://hreinwald.github.io/drc/