diff --git a/..travis.yml.swp b/..travis.yml.swp deleted file mode 100644 index 8462e693..00000000 Binary files a/..travis.yml.swp and /dev/null differ diff --git a/.Rbuildignore b/.Rbuildignore index e1482534..3f2e071c 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -2,3 +2,4 @@ ^\.Rproj\.user$ ^\.travis\.yml$ ^appveyor\.yml$ +^LICENSE\.md$ diff --git a/.gitignore b/.gitignore index f4f606b0..ce8cc485 100644 --- a/.gitignore +++ b/.gitignore @@ -3,3 +3,4 @@ .RData .Ruserdata *.Rproj +inst/doc diff --git a/BCEA.Rproj b/BCEA.Rproj index 0b3ba41d..0b985cb4 100644 --- a/BCEA.Rproj +++ b/BCEA.Rproj @@ -15,4 +15,4 @@ LaTeX: pdfLaTeX BuildType: Package PackageUseDevtools: Yes PackageInstallArgs: --no-multiarch --with-keep.source -PackageRoxygenize: rd,collate +PackageRoxygenize: rd,collate,vignette diff --git a/DESCRIPTION b/DESCRIPTION index a86985a5..98b56736 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -31,11 +31,12 @@ Suggests: Imports: MASS, dplyr, rlang Additional_repositories: https://inla.r-inla-download.org/R/stable/ Description: Produces an economic evaluation of a Bayesian model in the form of MCMC simulations. Given suitable variables of cost and effectiveness / utility for two or more interventions, This package computes the most cost-effective alternative and produces graphical summaries and probabilistic sensitivity analysis. -License: GPL (>=2) +License: GPL-3 URL: http://www.statistica.it/gianluca/BCEA, http://www.statistica.it/gianluca, https://github.com/giabaio/BCEA Depends: R (>= 2.10) NeedsCompilation: no -RoxygenNote: 6.1.1 +RoxygenNote: 7.1.0 Encoding: UTF-8 +VignetteBuilder: knitr diff --git a/LICENSE b/LICENSE new file mode 100644 index 00000000..70a6eb51 --- /dev/null +++ b/LICENSE @@ -0,0 +1,2 @@ +YEAR: 2020 +COPYRIGHT HOLDER: G Baio diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 index 00000000..c36b7c86 --- /dev/null +++ b/LICENSE.md @@ -0,0 +1,595 @@ +GNU General Public License +========================== + +_Version 3, 29 June 2007_ +_Copyright © 2007 Free Software Foundation, Inc. <>_ + +Everyone is permitted to copy and distribute verbatim copies of this license +document, but changing it is not allowed. + +## Preamble + +The GNU General Public License is a free, copyleft license for software and other +kinds of works. + +The licenses for most software and other practical works are designed to take away +your freedom to share and change the works. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change all versions of a +program--to make sure it remains free software for all its users. We, the Free +Software Foundation, use the GNU General Public License for most of our software; it +applies also to any other work released this way by its authors. You can apply it to +your programs, too. + +When we speak of free software, we are referring to freedom, not price. Our General +Public Licenses are designed to make sure that you have the freedom to distribute +copies of free software (and charge for them if you wish), that you receive source +code or can get it if you want it, that you can change the software or use pieces of +it in new free programs, and that you know you can do these things. + +To protect your rights, we need to prevent others from denying you these rights or +asking you to surrender the rights. Therefore, you have certain responsibilities if +you distribute copies of the software, or if you modify it: responsibilities to +respect the freedom of others. + +For example, if you distribute copies of such a program, whether gratis or for a fee, +you must pass on to the recipients the same freedoms that you received. You must make +sure that they, too, receive or can get the source code. And you must show them these +terms so they know their rights. + +Developers that use the GNU GPL protect your rights with two steps: **(1)** assert +copyright on the software, and **(2)** offer you this License giving you legal permission +to copy, distribute and/or modify it. + +For the developers' and authors' protection, the GPL clearly explains that there is +no warranty for this free software. For both users' and authors' sake, the GPL +requires that modified versions be marked as changed, so that their problems will not +be attributed erroneously to authors of previous versions. + +Some devices are designed to deny users access to install or run modified versions of +the software inside them, although the manufacturer can do so. This is fundamentally +incompatible with the aim of protecting users' freedom to change the software. The +systematic pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we have designed +this version of the GPL to prohibit the practice for those products. If such problems +arise substantially in other domains, we stand ready to extend this provision to +those domains in future versions of the GPL, as needed to protect the freedom of +users. + +Finally, every program is threatened constantly by software patents. States should +not allow patents to restrict development and use of software on general-purpose +computers, but in those that do, we wish to avoid the special danger that patents +applied to a free program could make it effectively proprietary. To prevent this, the +GPL assures that patents cannot be used to render the program non-free. + +The precise terms and conditions for copying, distribution and modification follow. + +## TERMS AND CONDITIONS + +### 0. Definitions + +“This License” refers to version 3 of the GNU General Public License. + +“Copyright” also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + +“The Program” refers to any copyrightable work licensed under this +License. Each licensee is addressed as “you”. “Licensees” and +“recipients” may be individuals or organizations. + +To “modify” a work means to copy from or adapt all or part of the work in +a fashion requiring copyright permission, other than the making of an exact copy. The +resulting work is called a “modified version” of the earlier work or a +work “based on” the earlier work. + +A “covered work” means either the unmodified Program or a work based on +the Program. + +To “propagate” a work means to do anything with it that, without +permission, would make you directly or secondarily liable for infringement under +applicable copyright law, except executing it on a computer or modifying a private +copy. Propagation includes copying, distribution (with or without modification), +making available to the public, and in some countries other activities as well. + +To “convey” a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through a computer +network, with no transfer of a copy, is not conveying. + +An interactive user interface displays “Appropriate Legal Notices” to the +extent that it includes a convenient and prominently visible feature that **(1)** +displays an appropriate copyright notice, and **(2)** tells the user that there is no +warranty for the work (except to the extent that warranties are provided), that +licensees may convey the work under this License, and how to view a copy of this +License. If the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + +### 1. Source Code + +The “source code” for a work means the preferred form of the work for +making modifications to it. “Object code” means any non-source form of a +work. + +A “Standard Interface” means an interface that either is an official +standard defined by a recognized standards body, or, in the case of interfaces +specified for a particular programming language, one that is widely used among +developers working in that language. + +The “System Libraries” of an executable work include anything, other than +the work as a whole, that **(a)** is included in the normal form of packaging a Major +Component, but which is not part of that Major Component, and **(b)** serves only to +enable use of the work with that Major Component, or to implement a Standard +Interface for which an implementation is available to the public in source code form. +A “Major Component”, in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system (if any) on which +the executable work runs, or a compiler used to produce the work, or an object code +interpreter used to run it. + +The “Corresponding Source” for a work in object code form means all the +source code needed to generate, install, and (for an executable work) run the object +code and to modify the work, including scripts to control those activities. However, +it does not include the work's System Libraries, or general-purpose tools or +generally available free programs which are used unmodified in performing those +activities but which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for the work, and +the source code for shared libraries and dynamically linked subprograms that the work +is specifically designed to require, such as by intimate data communication or +control flow between those subprograms and other parts of the work. + +The Corresponding Source need not include anything that users can regenerate +automatically from other parts of the Corresponding Source. + +The Corresponding Source for a work in source code form is that same work. + +### 2. Basic Permissions + +All rights granted under this License are granted for the term of copyright on the +Program, and are irrevocable provided the stated conditions are met. This License +explicitly affirms your unlimited permission to run the unmodified Program. The +output from running a covered work is covered by this License only if the output, +given its content, constitutes a covered work. This License acknowledges your rights +of fair use or other equivalent, as provided by copyright law. + +You may make, run and propagate covered works that you do not convey, without +conditions so long as your license otherwise remains in force. You may convey covered +works to others for the sole purpose of having them make modifications exclusively +for you, or provide you with facilities for running those works, provided that you +comply with the terms of this License in conveying all material for which you do not +control copyright. Those thus making or running the covered works for you must do so +exclusively on your behalf, under your direction and control, on terms that prohibit +them from making any copies of your copyrighted material outside their relationship +with you. + +Conveying under any other circumstances is permitted solely under the conditions +stated below. Sublicensing is not allowed; section 10 makes it unnecessary. + +### 3. Protecting Users' Legal Rights From Anti-Circumvention Law + +No covered work shall be deemed part of an effective technological measure under any +applicable law fulfilling obligations under article 11 of the WIPO copyright treaty +adopted on 20 December 1996, or similar laws prohibiting or restricting circumvention +of such measures. + +When you convey a covered work, you waive any legal power to forbid circumvention of +technological measures to the extent such circumvention is effected by exercising +rights under this License with respect to the covered work, and you disclaim any +intention to limit operation or modification of the work as a means of enforcing, +against the work's users, your or third parties' legal rights to forbid circumvention +of technological measures. + +### 4. Conveying Verbatim Copies + +You may convey verbatim copies of the Program's source code as you receive it, in any +medium, provided that you conspicuously and appropriately publish on each copy an +appropriate copyright notice; keep intact all notices stating that this License and +any non-permissive terms added in accord with section 7 apply to the code; keep +intact all notices of the absence of any warranty; and give all recipients a copy of +this License along with the Program. + +You may charge any price or no price for each copy that you convey, and you may offer +support or warranty protection for a fee. + +### 5. Conveying Modified Source Versions + +You may convey a work based on the Program, or the modifications to produce it from +the Program, in the form of source code under the terms of section 4, provided that +you also meet all of these conditions: + +* **a)** The work must carry prominent notices stating that you modified it, and giving a +relevant date. +* **b)** The work must carry prominent notices stating that it is released under this +License and any conditions added under section 7. This requirement modifies the +requirement in section 4 to “keep intact all notices”. +* **c)** You must license the entire work, as a whole, under this License to anyone who +comes into possession of a copy. This License will therefore apply, along with any +applicable section 7 additional terms, to the whole of the work, and all its parts, +regardless of how they are packaged. This License gives no permission to license the +work in any other way, but it does not invalidate such permission if you have +separately received it. +* **d)** If the work has interactive user interfaces, each must display Appropriate Legal +Notices; however, if the Program has interactive interfaces that do not display +Appropriate Legal Notices, your work need not make them do so. + +A compilation of a covered work with other separate and independent works, which are +not by their nature extensions of the covered work, and which are not combined with +it such as to form a larger program, in or on a volume of a storage or distribution +medium, is called an “aggregate” if the compilation and its resulting +copyright are not used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work in an aggregate +does not cause this License to apply to the other parts of the aggregate. + +### 6. Conveying Non-Source Forms + +You may convey a covered work in object code form under the terms of sections 4 and +5, provided that you also convey the machine-readable Corresponding Source under the +terms of this License, in one of these ways: + +* **a)** Convey the object code in, or embodied in, a physical product (including a +physical distribution medium), accompanied by the Corresponding Source fixed on a +durable physical medium customarily used for software interchange. +* **b)** Convey the object code in, or embodied in, a physical product (including a +physical distribution medium), accompanied by a written offer, valid for at least +three years and valid for as long as you offer spare parts or customer support for +that product model, to give anyone who possesses the object code either **(1)** a copy of +the Corresponding Source for all the software in the product that is covered by this +License, on a durable physical medium customarily used for software interchange, for +a price no more than your reasonable cost of physically performing this conveying of +source, or **(2)** access to copy the Corresponding Source from a network server at no +charge. +* **c)** Convey individual copies of the object code with a copy of the written offer to +provide the Corresponding Source. This alternative is allowed only occasionally and +noncommercially, and only if you received the object code with such an offer, in +accord with subsection 6b. +* **d)** Convey the object code by offering access from a designated place (gratis or for +a charge), and offer equivalent access to the Corresponding Source in the same way +through the same place at no further charge. You need not require recipients to copy +the Corresponding Source along with the object code. If the place to copy the object +code is a network server, the Corresponding Source may be on a different server +(operated by you or a third party) that supports equivalent copying facilities, +provided you maintain clear directions next to the object code saying where to find +the Corresponding Source. Regardless of what server hosts the Corresponding Source, +you remain obligated to ensure that it is available for as long as needed to satisfy +these requirements. +* **e)** Convey the object code using peer-to-peer transmission, provided you inform +other peers where the object code and Corresponding Source of the work are being +offered to the general public at no charge under subsection 6d. + +A separable portion of the object code, whose source code is excluded from the +Corresponding Source as a System Library, need not be included in conveying the +object code work. + +A “User Product” is either **(1)** a “consumer product”, which +means any tangible personal property which is normally used for personal, family, or +household purposes, or **(2)** anything designed or sold for incorporation into a +dwelling. In determining whether a product is a consumer product, doubtful cases +shall be resolved in favor of coverage. For a particular product received by a +particular user, “normally used” refers to a typical or common use of +that class of product, regardless of the status of the particular user or of the way +in which the particular user actually uses, or expects or is expected to use, the +product. A product is a consumer product regardless of whether the product has +substantial commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + +“Installation Information” for a User Product means any methods, +procedures, authorization keys, or other information required to install and execute +modified versions of a covered work in that User Product from a modified version of +its Corresponding Source. The information must suffice to ensure that the continued +functioning of the modified object code is in no case prevented or interfered with +solely because modification has been made. + +If you convey an object code work under this section in, or with, or specifically for +use in, a User Product, and the conveying occurs as part of a transaction in which +the right of possession and use of the User Product is transferred to the recipient +in perpetuity or for a fixed term (regardless of how the transaction is +characterized), the Corresponding Source conveyed under this section must be +accompanied by the Installation Information. But this requirement does not apply if +neither you nor any third party retains the ability to install modified object code +on the User Product (for example, the work has been installed in ROM). + +The requirement to provide Installation Information does not include a requirement to +continue to provide support service, warranty, or updates for a work that has been +modified or installed by the recipient, or for the User Product in which it has been +modified or installed. Access to a network may be denied when the modification itself +materially and adversely affects the operation of the network or violates the rules +and protocols for communication across the network. + +Corresponding Source conveyed, and Installation Information provided, in accord with +this section must be in a format that is publicly documented (and with an +implementation available to the public in source code form), and must require no +special password or key for unpacking, reading or copying. + +### 7. Additional Terms + +“Additional permissions” are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. Additional +permissions that are applicable to the entire Program shall be treated as though they +were included in this License, to the extent that they are valid under applicable +law. If additional permissions apply only to part of the Program, that part may be +used separately under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + +When you convey a copy of a covered work, you may at your option remove any +additional permissions from that copy, or from any part of it. (Additional +permissions may be written to require their own removal in certain cases when you +modify the work.) You may place additional permissions on material, added by you to a +covered work, for which you have or can give appropriate copyright permission. + +Notwithstanding any other provision of this License, for material you add to a +covered work, you may (if authorized by the copyright holders of that material) +supplement the terms of this License with terms: + +* **a)** Disclaiming warranty or limiting liability differently from the terms of +sections 15 and 16 of this License; or +* **b)** Requiring preservation of specified reasonable legal notices or author +attributions in that material or in the Appropriate Legal Notices displayed by works +containing it; or +* **c)** Prohibiting misrepresentation of the origin of that material, or requiring that +modified versions of such material be marked in reasonable ways as different from the +original version; or +* **d)** Limiting the use for publicity purposes of names of licensors or authors of the +material; or +* **e)** Declining to grant rights under trademark law for use of some trade names, +trademarks, or service marks; or +* **f)** Requiring indemnification of licensors and authors of that material by anyone +who conveys the material (or modified versions of it) with contractual assumptions of +liability to the recipient, for any liability that these contractual assumptions +directly impose on those licensors and authors. + +All other non-permissive additional terms are considered “further +restrictions” within the meaning of section 10. If the Program as you received +it, or any part of it, contains a notice stating that it is governed by this License +along with a term that is a further restriction, you may remove that term. If a +license document contains a further restriction but permits relicensing or conveying +under this License, you may add to a covered work material governed by the terms of +that license document, provided that the further restriction does not survive such +relicensing or conveying. + +If you add terms to a covered work in accord with this section, you must place, in +the relevant source files, a statement of the additional terms that apply to those +files, or a notice indicating where to find the applicable terms. + +Additional terms, permissive or non-permissive, may be stated in the form of a +separately written license, or stated as exceptions; the above requirements apply +either way. + +### 8. Termination + +You may not propagate or modify a covered work except as expressly provided under +this License. Any attempt otherwise to propagate or modify it is void, and will +automatically terminate your rights under this License (including any patent licenses +granted under the third paragraph of section 11). + +However, if you cease all violation of this License, then your license from a +particular copyright holder is reinstated **(a)** provisionally, unless and until the +copyright holder explicitly and finally terminates your license, and **(b)** permanently, +if the copyright holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + +Moreover, your license from a particular copyright holder is reinstated permanently +if the copyright holder notifies you of the violation by some reasonable means, this +is the first time you have received notice of violation of this License (for any +work) from that copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + +Termination of your rights under this section does not terminate the licenses of +parties who have received copies or rights from you under this License. If your +rights have been terminated and not permanently reinstated, you do not qualify to +receive new licenses for the same material under section 10. + +### 9. Acceptance Not Required for Having Copies + +You are not required to accept this License in order to receive or run a copy of the +Program. Ancillary propagation of a covered work occurring solely as a consequence of +using peer-to-peer transmission to receive a copy likewise does not require +acceptance. However, nothing other than this License grants you permission to +propagate or modify any covered work. These actions infringe copyright if you do not +accept this License. Therefore, by modifying or propagating a covered work, you +indicate your acceptance of this License to do so. + +### 10. Automatic Licensing of Downstream Recipients + +Each time you convey a covered work, the recipient automatically receives a license +from the original licensors, to run, modify and propagate that work, subject to this +License. You are not responsible for enforcing compliance by third parties with this +License. + +An “entity transaction” is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an organization, or +merging organizations. If propagation of a covered work results from an entity +transaction, each party to that transaction who receives a copy of the work also +receives whatever licenses to the work the party's predecessor in interest had or +could give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if the predecessor +has it or can get it with reasonable efforts. + +You may not impose any further restrictions on the exercise of the rights granted or +affirmed under this License. For example, you may not impose a license fee, royalty, +or other charge for exercise of rights granted under this License, and you may not +initiate litigation (including a cross-claim or counterclaim in a lawsuit) alleging +that any patent claim is infringed by making, using, selling, offering for sale, or +importing the Program or any portion of it. + +### 11. Patents + +A “contributor” is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The work thus +licensed is called the contributor's “contributor version”. + +A contributor's “essential patent claims” are all patent claims owned or +controlled by the contributor, whether already acquired or hereafter acquired, that +would be infringed by some manner, permitted by this License, of making, using, or +selling its contributor version, but do not include claims that would be infringed +only as a consequence of further modification of the contributor version. For +purposes of this definition, “control” includes the right to grant patent +sublicenses in a manner consistent with the requirements of this License. + +Each contributor grants you a non-exclusive, worldwide, royalty-free patent license +under the contributor's essential patent claims, to make, use, sell, offer for sale, +import and otherwise run, modify and propagate the contents of its contributor +version. + +In the following three paragraphs, a “patent license” is any express +agreement or commitment, however denominated, not to enforce a patent (such as an +express permission to practice a patent or covenant not to sue for patent +infringement). To “grant” such a patent license to a party means to make +such an agreement or commitment not to enforce a patent against the party. + +If you convey a covered work, knowingly relying on a patent license, and the +Corresponding Source of the work is not available for anyone to copy, free of charge +and under the terms of this License, through a publicly available network server or +other readily accessible means, then you must either **(1)** cause the Corresponding +Source to be so available, or **(2)** arrange to deprive yourself of the benefit of the +patent license for this particular work, or **(3)** arrange, in a manner consistent with +the requirements of this License, to extend the patent license to downstream +recipients. “Knowingly relying” means you have actual knowledge that, but +for the patent license, your conveying the covered work in a country, or your +recipient's use of the covered work in a country, would infringe one or more +identifiable patents in that country that you have reason to believe are valid. + +If, pursuant to or in connection with a single transaction or arrangement, you +convey, or propagate by procuring conveyance of, a covered work, and grant a patent +license to some of the parties receiving the covered work authorizing them to use, +propagate, modify or convey a specific copy of the covered work, then the patent +license you grant is automatically extended to all recipients of the covered work and +works based on it. + +A patent license is “discriminatory” if it does not include within the +scope of its coverage, prohibits the exercise of, or is conditioned on the +non-exercise of one or more of the rights that are specifically granted under this +License. You may not convey a covered work if you are a party to an arrangement with +a third party that is in the business of distributing software, under which you make +payment to the third party based on the extent of your activity of conveying the +work, and under which the third party grants, to any of the parties who would receive +the covered work from you, a discriminatory patent license **(a)** in connection with +copies of the covered work conveyed by you (or copies made from those copies), or **(b)** +primarily for and in connection with specific products or compilations that contain +the covered work, unless you entered into that arrangement, or that patent license +was granted, prior to 28 March 2007. + +Nothing in this License shall be construed as excluding or limiting any implied +license or other defenses to infringement that may otherwise be available to you +under applicable patent law. + +### 12. No Surrender of Others' Freedom + +If conditions are imposed on you (whether by court order, agreement or otherwise) +that contradict the conditions of this License, they do not excuse you from the +conditions of this License. If you cannot convey a covered work so as to satisfy +simultaneously your obligations under this License and any other pertinent +obligations, then as a consequence you may not convey it at all. For example, if you +agree to terms that obligate you to collect a royalty for further conveying from +those to whom you convey the Program, the only way you could satisfy both those terms +and this License would be to refrain entirely from conveying the Program. + +### 13. Use with the GNU Affero General Public License + +Notwithstanding any other provision of this License, you have permission to link or +combine any covered work with a work licensed under version 3 of the GNU Affero +General Public License into a single combined work, and to convey the resulting work. +The terms of this License will continue to apply to the part which is the covered +work, but the special requirements of the GNU Affero General Public License, section +13, concerning interaction through a network will apply to the combination as such. + +### 14. Revised Versions of this License + +The Free Software Foundation may publish revised and/or new versions of the GNU +General Public License from time to time. Such new versions will be similar in spirit +to the present version, but may differ in detail to address new problems or concerns. + +Each version is given a distinguishing version number. If the Program specifies that +a certain numbered version of the GNU General Public License “or any later +version” applies to it, you have the option of following the terms and +conditions either of that numbered version or of any later version published by the +Free Software Foundation. If the Program does not specify a version number of the GNU +General Public License, you may choose any version ever published by the Free +Software Foundation. + +If the Program specifies that a proxy can decide which future versions of the GNU +General Public License can be used, that proxy's public statement of acceptance of a +version permanently authorizes you to choose that version for the Program. + +Later license versions may give you additional or different permissions. However, no +additional obligations are imposed on any author or copyright holder as a result of +your choosing to follow a later version. + +### 15. Disclaimer of Warranty + +THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. +EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM “AS IS” WITHOUT WARRANTY OF ANY KIND, EITHER +EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE +QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE +DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + +### 16. Limitation of Liability + +IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY +COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS THE PROGRAM AS +PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, +INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE +PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE +OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE +WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + +### 17. Interpretation of Sections 15 and 16 + +If the disclaimer of warranty and limitation of liability provided above cannot be +given local legal effect according to their terms, reviewing courts shall apply local +law that most closely approximates an absolute waiver of all civil liability in +connection with the Program, unless a warranty or assumption of liability accompanies +a copy of the Program in return for a fee. + +_END OF TERMS AND CONDITIONS_ + +## How to Apply These Terms to Your New Programs + +If you develop a new program, and you want it to be of the greatest possible use to +the public, the best way to achieve this is to make it free software which everyone +can redistribute and change under these terms. + +To do so, attach the following notices to the program. It is safest to attach them +to the start of each source file to most effectively state the exclusion of warranty; +and each file should have at least the “copyright” line and a pointer to +where the full notice is found. + + + Copyright (C) 2020 G Baio + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + +If the program does terminal interaction, make it output a short notice like this +when it starts in an interactive mode: + + BCEA Copyright (C) 2020 G Baio + This program comes with ABSOLUTELY NO WARRANTY; for details type 'show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type 'show c' for details. + +The hypothetical commands `show w` and `show c` should show the appropriate parts of +the General Public License. Of course, your program's commands might be different; +for a GUI interface, you would use an “about box”. + +You should also get your employer (if you work as a programmer) or school, if any, to +sign a “copyright disclaimer” for the program, if necessary. For more +information on this, and how to apply and follow the GNU GPL, see +<>. + +The GNU General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may consider it +more useful to permit linking proprietary applications with the library. If this is +what you want to do, use the GNU Lesser General Public License instead of this +License. But first, please read +<>. diff --git a/NAMESPACE b/NAMESPACE index a8e08d55..953ba79b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -12,7 +12,7 @@ S3method(bcea, default) S3method(evppi, default) export(BCEAweb) export(CEriskav) -export(CreateInputs) +export(createInputs) export(bcea) export(ceac.plot) export(ceaf.plot) @@ -26,7 +26,6 @@ export(evi.plot) export(evppi) export(ib.plot) export(info.rank) -export(mce.plot) export(mixedAn) export(multi.ce) export(plot.CEriskav) diff --git a/NEWS.md b/NEWS.md new file mode 100644 index 00000000..f2a665c1 --- /dev/null +++ b/NEWS.md @@ -0,0 +1,120 @@ +# BCEA 2.3-2 + +* Added a `NEWS.md` file to track changes to the package. +* Major refactoring of code base +* Testing suite written + +## Feature updates + +* Deprecated `mce.plot()`. Now dispatched on `ceac.plot()` for both `multi.ce()` and `bcea()` outputs. +* `new_bcea()` constructor + + +## Fixes + +# BCEA 2.3-1.1 +26 Aug 2019 + +# BCEA 2.3-1^ + +# BCEA 2.2-6^ +* Fix in `evppi` to allow N to be selected in all methods +* Fix `diag.evppi` + +# BCEA 2.2-5^ + +* Some changes to EVPPI + +# BCEA v2.2.4 +Nov 2016 + +* Fixes for new ggplot2 version (`legend.spacing()` and `plot.title` hjust argument) + +# BCEA 2.2-3^ +May 2016 + +* Major update for the EVPPI to include PFC +* Fixed issues with info.rank + +# BCEA 2.2-2^ +January 2016 + +* Minor change to `ceef.plot` to align with ggplot2 v2.0.0 + +# BCEA v2.2.1 +October 2015 + +* Adds the info-rank plot + +# BCEA v2.2 +October 2015 + +* Cleaned up and aligned with R's settings +* `EVPPI` function polished up + +# BCEA 2.1-1^ +April/July 2015 + +* New function for EVPPI using SPDE-INLA +* Modifications to the EVPPI functions +* Documentation updated +* Allows xlim & ylim in the `ceplane.plot`, `contour` and `contour2` functions +* It is now possible to run bcea for a scalar wtp +* Old evppi function and method has been renamed `evppi0`, which means there's also a new `plot.evppi0` method + +# BCEA 2.1-0^ +October 2014 + +* Migrated from `if(require())` to `if(requireNamespace(,quietly=TRUE))` +* Documentation updated +* Added threshold argument to `ceef.plot` function + +# BCEA v2.1.0-pre2 +October 2014 + +* modifications to `ceef.plot`, `createInputs`, `struct.psa` + +# BCEA v2.1-0-pre1 +September 2014 + +* Documentation updated +* Smoking dataset and `ceef.plot` function included, additional modifications + +# BCEA v2.0-2c +July, 2014 + +# BCEA v2.0-2b +February 2014 + +* `ceac.plot` and `eib.plot`: option comparison included for base graphics + +# BCEA 2.0-2^ +November 2013 + +# BCEA 2.0-1^ +July, 2013 + +# BCEA 2.0^ + +## Feature updates + +* Implements two quick and general methods to compute the EVPPI +* Function `CreateInputs()`, which takes as input an object in the class rjags or bugs +* Compute the EVPPI for one or more parameters calling the function `evppi()` +* Results can be visualised using the specific method plot for the class evppi and show the overall EVPI with the EVPPI for the selected parameter(s) + +# BCEA 1.3-1 + +# BCEA 1.3-0^ +June 2013 + +# BCEA 1.2 +17 September 2012 + +# BCEA 1.1.1^ + +# BCEA 1.1^ +14 September 2012 + +# BCEA 1.0^ +4 January 2012 diff --git a/R/BCEA-package.R b/R/BCEA-package.R index f47b41e0..77268db4 100644 --- a/R/BCEA-package.R +++ b/R/BCEA-package.R @@ -1,5 +1,4 @@ - #' BCEA: A package for Bayesian Cost-Effectiveness Analysis #' #' A package to post-process the results of a Bayesian health economic model @@ -12,163 +11,29 @@ #' variables of costs and clinical benefits for two or more interventions, #' produces a health economic evaluation. Compares one of the interventions #' (the "reference") to the others ("comparators"). Produces many summary and -#' plots to analyse the results +#' plots to analyse the results. #' -#' @name BCEA-package #' @aliases BCEA-package BCEA -#' @docType package +#' #' @author Gianluca Baio, Andrea Berardi, Anna Heath +#' #' Maintainer: Gianluca Baio #' -#' Maintainer: Gianluca Baio #' @references Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity #' Analysis in Health Economics. Statistical Methods in Medical Research #' doi:10.1177/0962280211419832. #' #' Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, -#' London +#' London. #' #' Baio G., Berardi A., Heath A. (forthcoming). Bayesian Cost Effectiveness #' Analysis with the R package BCEA. Springer #' @keywords Bayesian models Health economic evaluation -NULL - - - - - -#' Data set for the Bayesian model for the cost-effectiveness of smoking -#' cessation interventions -#' -#' This data set contains the results of the Bayesian analysis used to model -#' the clinical output and the costs associated with the health economic -#' evaluation of four different smoking cessation interventions. -#' -#' -#' @name Smoking -#' @aliases Smoking data life.years pi smoking smoking_output -#' @docType data -#' @format A data list including the variables needed for the smoking cessation -#' cost-effectiveness analysis. The variables are as follows: \describe{ -#' \item{list("c")}{a matrix of 500 simulations from the posterior distribution -#' of the overall costs associated with the four strategies} -#' \item{list("data")}{a dataset containing the characteristics of the smokers -#' in the UK population} \item{list("e")}{a matrix of 500 simulations from the -#' posterior distribution of the clinical benefits associated with the four -#' strategies} \item{list("life.years")}{a matrix of 500 simulations from the -#' posterior distribution of the life years gained with each strategy} -#' \item{list("pi")}{a matrix of 500 simulations from the posterior -#' distribution of the event of smoking cessation with each strategy} -#' \item{list("smoking")}{a data frame containing the inputs needed for the -#' network meta-analysis model. The \code{data.frame} object contains: -#' \code{nobs}: the record ID number, \code{s}: the study ID number, \code{i}: -#' the intervention ID number, \code{r_i}: the number of patients who quit -#' smoking, \code{n_i}: the total number of patients for the row-specific arm -#' and \code{b_i}: the reference intervention for each study} -#' \item{list("smoking_output")}{a \code{rjags} object obtained by running the -#' network meta-analysis model based on the data contained in the -#' \code{smoking} object} \item{list("smoking_mat")}{a matrix obtained by -#' running the network meta-analysis model based on the data contained in the -#' \code{smoking} object} \item{list("treats")}{a vector of labels associated -#' with the four strategies} } -#' @references Baio G. (2012). Bayesian Methods in Health Economics. -#' CRC/Chapman Hall, London -#' @source Effectiveness data adapted from Hasselblad V. (1998). Meta-analysis -#' of Multitreatment Studies. Medical Decision Making 1998;18:37-43. -#' -#' Cost and population characteristics data adapted from various sources: -#' \itemize{ \item Taylor, D.H. Jr, et al. (2002). Benefits of smoking -#' cessation on longevity. American Journal of Public Health 2002;92(6) \item -#' ASH: Action on Smoking and Health (2013). ASH fact sheet on smoking -#' statistics, \cr \code{http://ash.org.uk/files/documents/ASH_106.pdf} \item -#' Flack, S., et al. (2007). Cost-effectiveness of interventions for smoking -#' cessation. York Health Economics Consortium, January 2007 \item McGhan, -#' W.F.D., and Smith, M. (1996). Pharmacoeconomic analysis of smoking-cessation -#' interventions. American Journal of Health-System Pharmacy 1996;53:45-52 } -#' @keywords datasets -#' @examples -#' -#' data(Smoking) -#' -#' \donttest{ -#' m=bcea(e,c,ref=4,interventions=treats,Kmax=500) -#' } -#' -NULL - - - - - -#' Data set for the Bayesian model for the cost-effectiveness of influenza -#' vaccination -#' -#' This data set contains the results of the Bayesian analysis used to model -#' the clinical output and the costs associated with an influenza vaccination. -#' -#' -#' @name Vaccine -#' @aliases Vaccine c cost.GP cost.hosp cost.otc cost.time.off cost.time.vac -#' cost.travel cost.trt1 cost.trt2 cost.vac e N N.outcomes N.resources -#' QALYs.adv QALYs.death QALYs.hosp QALYs.inf QALYs.pne treats vaccine -#' @docType data -#' @format A data list including the variables needed for the influenza -#' vaccination. The variables are as follows: -#' -#' \describe{ \item{list("c")}{a matrix of simulations from the posterior -#' distribution of the overall costs associated with the two treatments} -#' \item{list("cost.GP")}{a matrix of simulations from the posterior -#' distribution of the costs for GP visits associated with the two treatments} -#' \item{list("cost.hosp")}{a matrix of simulations from the posterior -#' distribution of the costs for hospitalisations associated with the two -#' treatments} \item{list("cost.otc")}{a matrix of simulations from the -#' posterior distribution of the costs for over-the-counter medications -#' associated with the two treatments} \item{list("cost.time.off")}{a matrix of -#' simulations from the posterior distribution of the costs for time off work -#' associated with the two treatments} \item{list("cost.time.vac")}{a matrix of -#' simulations from the posterior distribution of the costs for time needed to -#' get the vaccination associated with the two treatments} -#' \item{list("cost.travel")}{a matrix of simulations from the posterior -#' distribution of the costs for travel to get vaccination associated with the -#' two treatments} \item{list("cost.trt1")}{a matrix of simulations from the -#' posterior distribution of the overall costs for first line of treatment -#' associated with the two interventions} \item{list("cost.trt2")}{a matrix of -#' simulations from the posterior distribution of the overall costs for second -#' line of treatment associated with the two interventions} -#' \item{list("cost.vac")}{a matrix of simulations from the posterior -#' distribution of the costs for vaccination} \item{list("e")}{a matrix of -#' simulations from the posterior distribution of the clinical benefits -#' associated with the two treatments} \item{list("N")}{the number of subjects -#' in the reference population} \item{list("N.outcomes")}{the number of -#' clinical outcomes analysed} \item{list("N.resources")}{the number of -#' health-care resources under study} \item{list("QALYs.adv")}{a vector from -#' the posterior distribution of the QALYs associated with advert events} -#' \item{list("QALYs.death")}{a vector from the posterior distribution of the -#' QALYs associated with death} \item{list("QALYs.hosp")}{a vector from the -#' posterior distribution of the QALYs associated with hospitalisation} -#' \item{list("QALYs.inf")}{a vector from the posterior distribution of the -#' QALYs associated with influenza infection} \item{list("QALYs.pne")}{a vector -#' from the posterior distribution of the QALYs associated with penumonia} -#' \item{list("treats")}{a vector of labels associated with the two treatments} -#' \item{list("vaccine")}{a \code{rjags} object containing the simulations for -#' the parameters used in the original model} \item{list("vaccine_mat")}{a -#' matrix containing the simulations for the parameters used in the original -#' model} } -#' @references Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity -#' Analysis in Health Economics. Statistical Methods in Medical Research -#' doi:10.1177/0962280211419832. -#' @source Adapted from Turner D, Wailoo A, Cooper N, Sutton A, Abrams K, -#' Nicholson K. The cost-effectiveness of influenza vaccination of healthy -#' adults 50-64 years of age. Vaccine. 2006;24:1035-1043. -#' @keywords datasets -#' @examples #' -#' data(Vaccine) -#' -#' \donttest{ -#' m=bcea(e,c,ref=1,interventions=treats) -#' } +#' @docType package +#' @name BCEA-package #' +#' @import dplyr +#' @import ggplot2 +#' @import purrr +#' @import reshape2 NULL - - - diff --git a/R/BCEAweb.R b/R/BCEAweb.R index fcd62f8f..f89b6b91 100644 --- a/R/BCEAweb.R +++ b/R/BCEAweb.R @@ -39,9 +39,9 @@ BCEAweb <- function(e=NULL,c=NULL,parameters=NULL,...) { if(exists("launch.browser",exArgs)) {launch.browser=exArgs$launch.browser} else {launch.browser=TRUE} # This makes the possible inputs available to the webapp! - # First uses BCEA::CreateInputs to process the simulations for the model parameters + # First uses BCEA::createInputs to process the simulations for the model parameters # (this means the user can pass a BUGS, JAGS, Stan, or xls object and BCEA will know what to do. Also eliminates need with further dependencies). - if(!is.null(parameters)){parameters=CreateInputs(parameters)$mat} + if(!is.null(parameters)){parameters = createInputs(parameters)$mat} if(!is.null(e)){e=as.matrix(e)} if(!is.null(c)){c=as.matrix(c)} diff --git a/R/CEriskav.R b/R/CEriskav.R index 576782c1..ed71a44e 100644 --- a/R/CEriskav.R +++ b/R/CEriskav.R @@ -1,12 +1,9 @@ -###CEriskav################################################################################################### - #' Cost-effectiveness analysis including a parameter of risk aversion #' #' Extends the standard cost-effectiveness analysis to modify the utility #' function so that risk aversion of the decision maker is explicitly accounted -#' for -#' +#' for. #' #' @aliases CEriskav CEriskav.default #' @param he A \code{bcea} object containing the results of the Bayesian diff --git a/R/CEriskav.default.R b/R/CEriskav.default.R index caf351c3..a6f2a549 100644 --- a/R/CEriskav.default.R +++ b/R/CEriskav.default.R @@ -1,45 +1,57 @@ -CEriskav.default <- function(he,r=NULL,comparison=1) { + +# +CEriskav.default <- function(he, + r = NULL, + comparison = 1) { ### COMPARISON IS USED TO SELECT THE COMPARISON FOR WHICH THE ANALYSIS IS CARRIED OUT!!! # Reference: Baio G, Dawid AP (2011). # Default vector of risk aversion parameters - if(is.null(r)==TRUE){ - r <- c(0.000000000001,0.0000025,.000005) + + if (is.null(r)) { + r <- c(1e-11, 0.0000025, 0.000005) } # Computes expected utilities & EVPI for the risk aversion cases K <- length(he$k) R <- length(r) - Ur <- array(NA,c(dim(he$U),R)) - Urstar <- array(NA,c(dim(he$Ustar),R)) - for (i in 1:K) { - for (l in 1:R) { - for (j in 1:he$n.comparators) { - Ur[,i,j,l] <- (1/r[l])*(1-exp(-r[l]*he$U[,i,j])) + Ur <- array(NA, c(dim(he$U),R)) + Urstar <- array(NA, c(dim(he$Ustar),R)) + + for (i in seq_len(K)) { + for (l in seq_len(R)) { + for (j in seq_len(he$n.comparators)) { + Ur[, i, j, l] <- (1/r[l])*(1 - exp(-r[l]*he$U[, i, j])) } - Urstar[,i,l] <- apply(Ur[,i,,l],1,max) + Urstar[, i, l] <- apply(Ur[, i, , l], 1, max) } } - if (he$n.comparisons==1){ - IBr <- Ur[,,he$ref,] - Ur[,,he$comp,] + if (he$n.comparisons == 1) { + IBr <- Ur[, , he$ref, ] - Ur[, , he$comp, ] } - if (he$n.comparisons>1){ - IBr <- Ur[,,he$ref,] - Ur[,,he$comp[comparison],] + if (he$n.comparisons > 1) { + IBr <- Ur[, , he$ref, ] - Ur[, , he$comp[comparison], ] } - eibr <- apply(IBr,c(2,3),mean) - vir <- array(NA,c(he$n.sim,K,R)) - for (i in 1:K) { - for (l in 1:R) { - vir[,i,l] <- Urstar[,i,l] - max(apply(Ur[,i,,l],2,mean)) + eibr <- apply(IBr, c(2,3), mean) + vir <- array(NA, c(he$n.sim,K,R)) + + for (i in seq_len(K)) { + for (l in seq_len(R)) { + vir[, i, l] <- Urstar[, i, l] - max(apply(Ur[, i, , l], 2, mean)) } } - evir <- apply(vir,c(2,3),mean) + evir <- apply(vir, c(2,3) ,mean) - ## Outputs of the function - cr <- list( - Ur=Ur,Urstar=Urstar,IBr=IBr,eibr=eibr,vir=vir,evir=evir,R=R,r=r,k=he$k - ) - class(cr) <- "CEriskav" - cr + structure( + list(Ur = Ur, + Urstar = Urstar, + IBr = IBr, + eibr = eibr, + vir = vir, + evir = evir, + R = R, + r = r, + k = he$k), + class = "CEriskav") } \ No newline at end of file diff --git a/R/CreateInputs.R b/R/CreateInputs.R index a086bb40..f7f8740c 100644 --- a/R/CreateInputs.R +++ b/R/CreateInputs.R @@ -1,7 +1,5 @@ -######CreateInputs############################################################################################## - -#' CreateInputs +#' create_inputs_evpi #' #' Creates an object containing the matrix with the parameters simulated using #' the MCMC procedure (using JAGS, BUGS or Stan) and a vector of parameters @@ -11,76 +9,113 @@ #' constant values and removes them to only leave the fundamental parameters #' (to run VoI analysis). This also deals with simulations stored in a #' \code{.csv} or \code{.txt} file (eg as obtained using bootstrapping from a -#' non-Bayesian model) +#' non-Bayesian model). #' #' -#' @param x A \code{rjags}, \code{bugs} or \code{stanfit} object, containing +#' @param inputs A \code{rjags}, \code{bugs} or \code{stanfit} object, containing #' the results of a call to either \code{jags}, (under \code{R2jags}), bugs #' (under \code{R2WinBUGS} or \code{R2OpenBUGS}), or \code{stan} (under #' \code{rstan}). -#' @param print.lincom A TRUE/FALSE indicator. If set to \code{TRUE} (default) +#' @param print_is_linear_comb A TRUE/FALSE indicator. If set to \code{TRUE} (default) #' then prints the output of the procedure trying to assess whether there are #' some parameters that are a linear combination of others (in which case #' they are removed). +#' #' @return \item{mat}{A data.frame contaning all the simulations for all the #' monitored parameters} \item{parameters}{A character vectors listing the #' names of all the monitored parameters} +#' #' @author Gianluca Baio and Mark Strong #' @seealso \code{\link{bcea}}, \code{\link{evppi}} #' @keywords R2jags R2WinBUGS R2OpenBUGS -#' @export CreateInputs -CreateInputs <- function(x,print.lincom=TRUE) { - # Utility function --- creates inputs for the EVPPI - if(class(x)=="rjags") { - inputs <- x$BUGSoutput$sims.matrix - } - if(class(x)=="bugs") { - inputs <- x$sims.matrix - } - if(class(x)=="stanfit") { - inputs <- x - } - if(class(x)%in%c("data.frame","matrix","numeric")) { - inputs <- x - } - - # Removes the deviance (which is not relevant for VOI computations - if (class(x)%in%c("bugs","rjags")) { - if("deviance"%in%colnames(inputs)) { - inputs <- inputs[,-which(colnames(inputs)=="deviance")] - } - else { - if(class(x)=="stanfit") { - inputs <- inputs[,-which(colnames(inputs)=="lp__")] - } +#' @export +#' +#' @examples +#' +create_inputs_evpi <- function(inputs, + print_is_linear_comb = TRUE) { + + # removes deviance (not relevant for VOI computations) + inputs <- inputs[, !colnames(inputs) %in% c("lp__", "deviance")] + + # remove redundant parameters (linear combination of columns or constant columns) + # by M Strong + cols_keep <- colnames(inputs) + const_params <- apply(inputs, 2, var) == 0 + if (sum(const_params) > 0) cols_keep <- cols_keep[!const_params] + + paramSet <- inputs[, cols_keep, drop = FALSE] + + rankifremoved <- function(paramSet) + sapply(1:NCOL(paramSet), function (x) qr(paramSet[, -x])$rank) + + rank_if_removed <- rankifremoved(paramSet) + + while (length(unique(rank_if_removed)) > 1) { + + linear_combs <- which(rank_if_removed == max(rank_if_removed)) + + if (print_is_linear_comb) { + print(linear_combs) + print(paste("Linear dependence: removing column", colnames(paramSet)[max(linear_combs)])) } + paramSet <- cbind(paramSet[, -max(linear_combs), drop = FALSE]) + rank_if_removed <- rankifremoved(paramSet) } - # Now removes redundant parameters (linear combination of columns or columns that are constant) - # Code by Mark Strong - sets=colnames(inputs) - constantParams <- (apply(inputs, 2, var) == 0) - if (sum(constantParams) > 0) sets <- sets[-which(constantParams)] # remove constants - paramSet <- cbind(cbind(inputs)[, sets, drop=FALSE]) # now with constants removed - rankifremoved <- sapply(1:NCOL(paramSet), function (x) qr(paramSet[,-x])$rank) - while(length(unique(rankifremoved)) > 1) { - linearCombs <- which(rankifremoved == max(rankifremoved)) - if(print.lincom==TRUE){ - print(linearCombs) - print(paste("Linear dependence: removing column", colnames(paramSet)[max(linearCombs)])) + while (qr(paramSet)$rank == rank_if_removed[1]) { + + if (print_is_linear_comb) { + print(paste("Linear dependence... removing column", colnames(paramSet)[1])) } - paramSet <- cbind(paramSet[, -max(linearCombs), drop=FALSE]) - rankifremoved <- sapply(1:NCOL(paramSet), function (x) qr(paramSet[,-x])$rank) - } - while(qr(paramSet)$rank == rankifremoved[1]) { - if(print.lincom==TRUE){ - print(paste("Linear dependence... removing column", colnames(paramSet)[1])) - } - paramSet <- cbind(paramSet[, -1, drop=FALSE]) # special case only lincomb left - rankifremoved <- sapply(1:NCOL(paramSet), function (x) qr(paramSet[,-x])$rank) + paramSet <- cbind(paramSet[, -1, drop = FALSE]) # special case only linear combination remains + rank_if_removed <- rankifremoved(paramSet) } + + list(mat = data.frame(paramSet), + parameters = colnames(data.frame(paramSet))) +} + - # Now saves the output to a relevant list - list(mat=data.frame(paramSet),parameters=colnames(data.frame(paramSet))) +createInputs <- function(inputs, + print_is_linear_comb = TRUE) { + UseMethod("createInputs") +} + +createInputs.rjags <- function(inputs, print_is_linear_comb) { + + inputs <- inputs$BUGSoutput$sims.matrix + create_inputs_evpi(inputs, print_is_linear_comb) +} + +createInputs.bugs <- function(inputs, print_is_linear_comb) { + + inputs <- inputs$sims.matrix + create_inputs_evpi(inputs, print_is_linear_comb) +} + +createInputs.stanfit <- function(inputs, print_is_linear_comb) { + + create_inputs_evpi(inputs, print_is_linear_comb) +} + +createInputs.data.frame <- function(inputs, print_is_linear_comb) { + + create_inputs_evpi(inputs, print_is_linear_comb) +} + +createInputs.matrix <- function(inputs, print_is_linear_comb) { + + create_inputs_evpi(inputs, print_is_linear_comb) +} + +createInputs.numeric <- function(inputs, print_is_linear_comb) { + + create_inputs_evpi(inputs, print_is_linear_comb) +} + +createInputs.default <- function(inputs, print_is_linear_comb) { + + stop("MCMC variable not of required type.", call. = FALSE) } diff --git a/R/adjust_for_comparison.R b/R/adjust_for_comparison.R new file mode 100644 index 00000000..e235bef3 --- /dev/null +++ b/R/adjust_for_comparison.R @@ -0,0 +1,22 @@ + +# +adjust_for_comparison <- function(he, + comparison) { + + he$comp <- he$comp[comparison] + he$delta.e <- he$delta.e[, comparison] + he$delta.c <- he$delta.c[, comparison] + he$n.comparators <- length(comparison) + 1 + he$n.comparisons <- length(comparison) + he$interventions <- he$interventions[sort(c(he$ref, he$comp))] + he$ICER <- he$ICER[comparison] + he$ib <- he$ib[, , comparison] + he$eib <- he$eib[, comparison] + he$U <- he$U[, , sort(c(he$ref, comparison + 1))] + he$ceac <- he$ceac[, comparison] + he$ref <- rank(c(he$ref, he$comp))[1] + he$comp <- rank(c(he$ref, he$comp))[-1] + he$mod <- TRUE + + he +} \ No newline at end of file diff --git a/R/bcea.R b/R/bcea.R index 2f00e564..94bd2f3d 100644 --- a/R/bcea.R +++ b/R/bcea.R @@ -1,32 +1,3 @@ -###INTRO############################################################################################# -## Define Classes & Methods -## v1.0. 4 January, 2012 -## v1.1. 14 September, 2012 -## v1.2. 17 September 2012 -## v1.3-0 June, 2013 -## v2.0-1 July, 2013 -## v2.0-2 November, 2013 -## v2.0-2b February, 2014 - ceac.plot and eib.plot: option comparison included for base graphics -## v2.0-2c July, 2014 -## v2.1-0-pre1 AB September, 2014: documentation updated, Smoking dataset and ceef.plot function included, additional modifications -## v2.1.0-pre2 GB October, 2014: modifications to ceef.plot, CreateInputs, struct.psa -## v2.1.0 AB October, 2014: migrated from if(require()) to if(requireNamespace(,quietly=TRUE)); documentation updated -## v2.1.0 AB December, 2014: added threshold argument to ceef.plot function; documentation updated -## v2.1.1 GB+AH April/July 2015: new function for EVPPI using SPDE-INLA; modifications to the EVPPI functions; -## documentation updated; allows xlim & ylim in the ceplane.plot, contour and contour2 functions; -## it is now possible to run bcea for a scalar wtp; the old evppi function and method has been renamed -## evppi0, which means there's also a new plot.evppi0 method -## v2.2 GB October 2015: cleaned up and aligned with R's settings. EVPPI function polished up -## v2.2.1 GB+AH October 2015: adds the info-rank plot -## v2.2.2 AB January 2016: minor change to ceef.plot to align with ggplot2 v2.0.0 -## v2.2.3 AH+GB May 2016: major update for the EVPPI to include PFC + fixed issues with info.rank -## v2.2.4 AB Nov 2016: fixes for new ggplot2 version (legend.spacing() and plot.title hjust argument) -## v2.2.5 Some changes to EVPPI -## v2.2.6 Fix in evppi to allow N to be selected in all methods + fix diag.evppi -## (C) Gianluca Baio + contributions by Andrea Berardi, Chris Jackson, Mark Strong & Anna Heath - -###bcea############################################################################################## - #' Bayesian Cost-Effectiveness Analysis #' @@ -59,7 +30,7 @@ #' @param wtp A(n optional) vector wtp including the values of the willingness #' to pay grid. If not specified then BCEA will construct a grid of 501 values #' from 0 to Kmax. This option is useful when performing intensive computations -#' (eg for the EVPPI). +#' (e.g. for the EVPPI). #' @param plot A logical value indicating whether the function should produce #' the summary plot or not. #' @return An object of the class "bcea" containing the following elements @@ -106,7 +77,7 @@ #' #' Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, #' London -#' @keywords Health economic evaluation +#' @keywords manip Health economic evaluation #' @examples #' #' # See Baio G., Dawid A.P. (2011) for a detailed description of the @@ -114,7 +85,7 @@ #' # #' # Load the processed results of the MCMC simulation model #' data(Vaccine) -#' # +#' #' # Runs the health economic evaluation using BCEA #' m <- bcea(e=e,c=c, # defines the variables of #' # effectiveness and cost @@ -127,9 +98,9 @@ #' # in a grid from the interval (0,Kmax) #' plot=TRUE # plots the results #' ) -#' # +#' #' # Creates a summary table -#' summary(m, # uses the results of the economic evalaution +#' summary(m, # uses the results of the economic evaluation #' # (a "bcea" object) #' wtp=25000 # selects the particular value for k #' ) @@ -225,33 +196,5 @@ #' } #' #' @export bcea -bcea <- function(e,c,ref=1,interventions=NULL,Kmax=50000,wtp=NULL,plot=FALSE) UseMethod("bcea") - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +bcea <- function(e, c, ref = 1, interventions = NULL, Kmax = 50000, wtp = NULL, plot = FALSE) + UseMethod("bcea") diff --git a/R/bcea.default.R b/R/bcea.default.R index d53a5190..7c47c824 100644 --- a/R/bcea.default.R +++ b/R/bcea.default.R @@ -1,173 +1,103 @@ #' Default function #' -#' Compute a Bayesian cost-effectiveness analysis of two or more interventions +#' Compute a Bayesian cost-effectiveness analysis of two or more interv_names #' #' INPUTS: -#' 1. Two objects (e,c). These can be directly computed in a simulation object "sim" from JAGS/BUGS, -#' or derived by postprocessing of "sim" in R. The objects (e,c) have dimension (n.sim x number of -#' interventions) and contain n.sim simulated values for the measures of effectiveness and costs +#' 1. Two objects (`e`,`c`). These can be directly computed in a simulation object `sim` from JAGS/BUGS, +#' or derived by postprocessing of `sim` in R. The objects (`e`,`c`) have dimension (`n_sim` x number of +#' interv_names) and contain n_sim simulated values for the measures of effectiveness and costs #' for each intervention being compared. -#' 2. The reference intervention as a numeric value. Each intervention is a column in the matrices e -#' and c so if ref=1 the first column is assumed to be associated with the reference intervention. +#' 2. The reference intervention as a numeric value. Each intervention is a column in the matrices `e` +#' and `c` so if `ref` = 1 the first column is assumed to be associated with the reference intervention. #' Intervention 1 is assumed the default reference. All others are considered comparators. -#' 3. A string vector "interventions" including the names of the interventions. If none is provided +#' 3. A string vector "interv_names" including the names of the interv_names. If none is provided #' then labels each as "intervention1",...,"interventionN". -#' 4. The value Kmax which represents the maximum value for the willingness to pay parameter. If none -#' is provided, then it is assumed Kmax=50000. +#' 4. The value `Kmax` which represents the maximum value for the willingness to pay parameter. If none +#' is provided, then it is assumed `Kmax` = 50000. #' 5. A(n optional) vector wtp including the values of the willingness to pay grid. If not specified -#' then BCEA will construct a grid of 501 values from 0 to Kmax. This option is useful when -#' performing intensive computations (eg for the EVPPI) +#' then `bcea` will construct a grid of 501 values from 0 to `Kmax`. This option is useful when +#' performing intensive computations (e.g. for the EVPPI) #' -#' @param e -#' @param c -#' @param ref -#' @param interventions -#' @param Kmax -#' @param wtp -#' @param plot -#' -#' @return Graphs & computed values for CE Plane, ICER, EIB, CEAC, EVPI +#' @return List of computed values for CE Plane, ICER, EIB, CEAC, EVPI #' @export #' -#' @examples -bcea.default <- function(e, - c, +bcea.default <- function(eff, + cost, ref = 1, interventions = NULL, Kmax = 50000, wtp = NULL, plot = FALSE) { - # Set the working directory to wherever the user is working, if not externally set - if(!exists("working.dir")){working.dir <- here::here()} + ##TODO: S3 only dispatches on the first argument so how does e and c work? change to list? + ## in fact why is this S3? + ##TODO: how to check that e and c are the right way round? + ##TODO: can we dispatch directly on jags/BUGS output? - # Number of simulations & interventions analysed - n.sim <- dim(e)[1] - n.comparators <- dim(e)[2] - # Define reference & comparator intervention (different labels can be given here if available!) - if(is.null(interventions)){interventions <- paste("intervention", 1:n.comparators)} - ints <- 1:n.comparators + if (!is.matrix(cost) | !is.matrix(eff)) + stop("eff and cost must be matrices.", call. = FALSE) - # Define intervention i (where i can be a number in [1,...,n.comparators]) as the reference - # and the other(s) as comparator(s). Default is the first intervention (first column of e or c) - comp <- ints[-ref] - n.comparisons <- n.comparators - 1 + if (ncol(cost) == 1 | ncol(eff) == 1) + stop("Require at least 2 comparators.", call. = FALSE) - # Compute Effectiveness & Cost differentials (wrt to reference intervention) - delta.e <- e[, ref] - e[, comp] - delta.c <- c[, ref] - c[, comp] + if (!is.null(interventions) & length(interventions) != ncol(eff)) + stop("interventions names wrong length.", call. = FALSE) - # Compute the ICER - if(n.comparisons == 1) { - ICER <- mean(delta.c)/mean(delta.e) - } - if(n.comparisons > 1) { - ICER <- colMeans(delta.c)/colMeans(delta.e) #apply(delta.c,2,mean)/apply(delta.e,2,mean) - } + if (any(dim(eff) != dim(cost))) + stop("eff and cost are not the same dimensions.", call. = FALSE) + + if (!is.double(ref) | ref < 1 | ref > ncol(eff)) + stop("reference is not in available interventions.", call. = FALSE) + + n_sim <- dim(eff)[1] + n_intervs <- dim(eff)[2] + intervs <- 1:n_intervs + + interv_names <- + if (is.null(interventions)) { + paste("intervention", intervs) + } else { + interventions} - # Compute and plot CEAC & EIB - if(!exists("Kmax")){Kmax <- 50000} - # Lets you select the willingness to pay grid --- useful when doing EVPPI (computationally intensive) if (!is.null(wtp)) { - wtp <- sort(unique(wtp)) - npoints <- length(wtp) - 1 - Kmax <- max(wtp) - step <- NA - k <- wtp - K <- npoints + 1 + k <- sort(unique(wtp)) } else { - npoints <- 500 - step <- Kmax/npoints + step <- Kmax/500 k <- seq(0, Kmax, by = step) - K <- length(k) } - if(n.comparisons == 1) { - ib <- scale(k %*% t(delta.e), delta.c, scale = FALSE) - ceac <- rowMeans(ib > 0) #apply(ib>0,1,mean) - } - if(n.comparisons > 1) { - ib <- array(rep(delta.e, K)*rep(k, each=n.sim*n.comparisons)-as.vector(delta.c), - dim=c(n.sim, n.comparisons, K)) - ib <- aperm(ib, c(3,1,2)) - ### ib <- sweep(apply(delta.e,c(1,2),function(x) k%*%t(x)),c(2,3),delta.c,"-") - ceac <- apply(ib > 0, c(1,3), mean) - } + # create complete data input dataframe + ##TODO: convert to matrix for faster computation? - # Select the best option for each value of the willingness to pay parameter - if(n.comparisons == 1) { - eib <- rowMeans(ib) #apply(ib,1,mean) - best <- rep(ref,K) - best[which(eib < 0)] <- comp - ## Finds the k for which the optimal decision changes - check <- c(0, diff(best)) - kstar <- k[check != 0] - } - if(n.comparisons > 1) { - eib <- apply(ib, 3, function(x) apply(x,1,mean)) - if (is.null(dim(eib))) { - tmp <- min(eib) - tmp2 <- which.min(eib) - } else { - tmp <- apply(eib,1,min) - tmp2 <- apply(eib,1,which.min) - } - best <- ifelse(tmp > 0,ref,comp[tmp2]) - # Finds the k for which the optimal decision changes - check <- c(0,diff(best)) - kstar <- k[check != 0] - } + df_ce <- + data.frame( + sim = 1:n_sim, + ref = ref, + ints = rep(intervs, each = n_sim), + eff = matrix(eff, ncol = 1), + cost = matrix(cost, ncol = 1)) + + df_ce <- + df_ce %>% + select(-ref) %>% + rename(ref = ints) %>% + merge(df_ce, + by = c("ref", "sim"), + suffixes = c("0", "1"), + all.x = FALSE) %>% + mutate(delta_e = eff0 - eff1, + delta_c = cost0 - cost1) ##TODO: is this the wrong way around?... - # Compute EVPI - U <- array(rep(e, K)*rep(k, each=n.sim*n.comparators) - as.vector(c), - dim=c(n.sim, n.comparators, K)) - U <- aperm(U, c(1,3,2)) - rowMax <- function(x){do.call(pmax, as.data.frame(x))} - Ustar <- vi <- ol <- matrix(NA,n.sim,K) - for (i in 1:K) { - Ustar[,i] <- rowMax(U[,i,]) - cmd <- paste("ol[,i] <- Ustar[,i] - U[,i,",best[i],"]",sep="") - eval(parse(text=cmd)) - vi[,i] <- Ustar[,i] - max(apply(U[,i,],2,mean)) - } - evi <- colMeans(ol) - - ## Outputs of the function - he <- list( - n.sim = n.sim, - n.comparators = n.comparators, - n.comparisons = n.comparisons, - delta.e = delta.e, - delta.c = delta.c, - ICER = ICER, - Kmax = Kmax, - k = k, - ceac = ceac, - ib = ib, - eib = eib, - kstar = kstar, - best = best, - U = U, - vi = vi, - Ustar = Ustar, - ol = ol, - evi = evi, - interventions = interventions, - ref = ref, - comp = comp, - step = step, - e = e, - c = c) - - class(he) <- "bcea" - if(plot) + df_ce$interv_names <- interv_names[df_ce$ints] + + he <- new_bcea(df_ce, k) + + ##TODO: should separate out this really + if (plot) plot(he) return(he) } - - - diff --git a/R/best_interv_given_k.R b/R/best_interv_given_k.R new file mode 100644 index 00000000..11b8303b --- /dev/null +++ b/R/best_interv_given_k.R @@ -0,0 +1,40 @@ + +#' Select best option for each value of willingness to pay +#' +#' @param eib Expected incremental benefit +#' +#' @return +#' @export +#' +#' @examples +#' +best_interv_given_k <- function(eib, + ref, + comp) { + + if (length(comp) == 1) { + + best <- rep(ref, length(eib)) + best[eib < 0] <- comp ##TODO: why isnt it eib > 0? + + } else { + + ##TODO: what cases would this be NULL? + if (is.null(dim(eib))) { + + min_eib <- min(eib) + which_eib <- which.min(eib) + + } else { + + min_eib <- apply(eib, 1, min) + which_eib <- apply(eib, 1, which.min) + } + + best <- ifelse(min_eib > 0, + yes = ref, + no = comp[which_eib]) + } + + best +} diff --git a/R/ceac.plot.R b/R/ceac.plot.R index 7695d3f9..09976ea2 100644 --- a/R/ceac.plot.R +++ b/R/ceac.plot.R @@ -1,25 +1,23 @@ -# ceac.plot ----- #' Cost-Effectiveness Acceptability Curve (CEAC) plot #' #' Produces a plot of the Cost-Effectiveness Acceptability Curve (CEAC) against -#' the willingness to pay threshold +#' the willingness to pay threshold. +#' +#' @rdname plot-bcea +#' +#' @template args-he +#' @template args-comparison #' -#' @param he A \code{bcea} object containing the results of the Bayesian -#' modelling and the economic evaluation. -#' @param comparison Selects the comparator, in case of more than two -#' interventions being analysed. Default as NULL plots all the comparisons -#' together. Any subset of the possible comparisons can be selected (e.g., -#' \code{comparison=c(1,3)} or \code{comparison=2}). #' @param pos Parameter to set the position of the legend (only relevant for #' multiple interventions, ie more than 2 interventions being compared). Can be #' given in form of a string \code{(bottom|top)(right|left)} for base graphics -#' and \code{bottom}, \code{top}, \code{left} or \code{right} for ggplot2. It -#' can be a two-elements vector, which specifies the relative position on the x -#' and y axis respectively, or alternatively it can be in form of a logical +#' and \code{bottom}, \code{top}, \code{left} or \code{right} for *ggplot2*. +#' It can be a two-elements vector, which specifies the relative position on the x +#' and y axis respectively, or alternatively in form of a logical #' variable, with \code{FALSE} indicating to use the default position and #' \code{TRUE} to place it on the bottom of the plot. Default value is -#' \code{c(1,0)}, that is the bottomright corner inside the plot area. +#' \code{c(1,0)}, that is the bottom right corner inside the plot area. #' @param graph A string used to select the graphical engine to use for #' plotting. Should (partial-)match the three options \code{"base"}, #' \code{"ggplot2"} or \code{"plotly"}. Default value is \code{"base"}. @@ -30,7 +28,8 @@ #' \item \code{line_types}: specifies the line type(s) as lty numeric values - all graph types. #' \item \code{area_include}: logical, include area under the CEAC curves - plotly only. #' \item \code{area_color}: specifies the AUC colour - plotly only.} -#' @return \item{ceac}{ If \code{graph="ggplot2"} a ggplot object, or if \code{graph="plotly"} +#' +#' @return \item{ceac} {If \code{graph="ggplot2"} a ggplot object, or if \code{graph="plotly"} #' a plotly object containing the requested plot. Nothing is returned when \code{graph="base"}, #' the default.} The function produces a plot of the #' cost-effectiveness acceptability curve against the discrete grid of possible @@ -38,336 +37,65 @@ #' indicate that uncertainty in the cost-effectiveness of the reference #' intervention is very low. Similarly, values of the CEAC closer to 0 indicate #' that uncertainty in the cost-effectiveness of the comparator is very low. +#' #' @author Gianluca Baio, Andrea Berardi #' @seealso \code{\link{bcea}} #' @references Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity -#' Analysis in Health Economics. Statistical Methods in Medical Research +#' Analysis in Health Economics. Statistical Methods in Medical Research #' doi:10.1177/0962280211419832. #' -#' Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, -#' London -#' @keywords Health economic evaluation Cost Effectiveness Acceptability Curve -#' @export ceac.plot -ceac.plot <- function(he, comparison = NULL, pos = c(1, 0), graph = c("base", "ggplot2", "plotly"), ...) { - options(scipen = 10) +#' Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, London. +#' @keywords hplot +#' @export +#' +#' @importFrom ggplot2 +#' +#' @examples +#' +#' data("Vaccine") +#' he <- BCEA::bcea(e, c) +#' ceac.plot(he) +#' +#' ceac.plot(he, graph = "base") +#' ceac.plot(he, graph = "ggplot2") +#' ceac.plot(he, graph = "plotly") +#' +#' ceac.plot(he, graph = "ggplot2", title = "my title", line = list(colors = "green"), theme = theme_dark()) +# +#' he2 <- BCEA::bcea(cbind(e,e - 0.0002), cbind(c,c + 5)) +#' mypalette <- RColorBrewer::brewer.pal(3, "Accent") +#' ceac.plot(he2, graph = "ggplot2", title = "my title", theme = theme_dark(), pos = TRUE, line = mypalette) +# +#' ceac.plot(he, graph = "base", title = "my title", line = list(colors = "green")) +# +#' ceac.plot(he2, graph = "base") +#' +ceac.plot <- function(he, + pos = c(1, 0), + graph = c("base", "ggplot2", "plotly"), + ...) { - alt.legend <- pos - # choose graphical engine - if (is.null(graph) || is.na(graph)) graph = "base" - graph_choice <- pmatch(graph[1], c("base", "ggplot2", "plotly"), nomatch = 1) - # check feasibility - if (graph_choice == 2 && !requireNamespace("ggplot2", quietly = TRUE) & requireNamespace("grid", quietly = TRUE)) { - warning("Package ggplot2 and grid not found; eib.plot will be rendered using base graphics.") - graph_choice <- 1 - } - if (graph_choice == 3 && !requireNamespace("plotly", quietly = TRUE)) { - warning("Package plotly not found; eib.plot will be rendered using base graphics.") - graph_choice <- 1 - } + graph <- match.arg(graph) - # evaluate additional arguments ----- - exArgs <- list(...) - plot_annotations <- list("exist" = list("title" = FALSE, "xlab" = FALSE, "ylab" = FALSE)) - plot_aes <- list("area" = list("include" = TRUE, "color" = NULL), - "line" = list("colors" = "black", "types" = NULL)) - plot_aes_args = c("area_include", "area_color", "line_colors", "line_types") - if (length(exArgs) >= 1) { - # if existing, read and store title, xlab and ylab - for (annotation in names(plot_annotations$exist)) { - if (exists(annotation, where = exArgs)) { - plot_annotations$exist[[annotation]] <- TRUE - plot_annotations[[annotation]] <- exArgs[[annotation]] - } - } - # if existing, read and store graphical options - for (aes_arg in plot_aes_args) { - if (exists(aes_arg, where = exArgs)) { - aes_cat <- strsplit(aes_arg, "_")[[1]][1] - aes_name <- paste0(strsplit(aes_arg, "_")[[1]][-1], collapse = "_") - plot_aes[[aes_cat]][[aes_name]] <- exArgs[[aes_arg]] - } - } - } - # default plot annotations ----- - if (!plot_annotations$exist$title) - plot_annotations$title = "Cost Effectiveness Acceptability Curve" - if (!plot_annotations$exist$xlab) - plot_annotations$xlab = "Willingness to pay" - if (!plot_annotations$exist$ylab) - plot_annotations$ylab = "Probability of cost effectiveness" + graph_type <- select_plot_type(graph) + + graph_params <- prepare_graph_params(...) - if (graph_choice == 1) { - # base graphics version ----- - if (is.numeric(alt.legend) & length(alt.legend) == 2) { - temp <- "" - if (alt.legend[2] == 1) - temp <- paste0(temp, "top") - else - temp <- paste0(temp, "bottom") - if (alt.legend[1] == 0) - temp <- paste0(temp, "left") - else - temp <- paste0(temp, "right") - alt.legend <- temp - if (length(grep("^(bottom|top)(left|right)$", temp)) == 0) - alt.legend <- FALSE - } - if (is.logical(alt.legend)) { - if (!alt.legend) - alt.legend = "bottomright" - else - alt.legend = "bottomleft" - } + if (graph_type == 1) { - if (he$n.comparisons == 1) { - plot( - he$k, he$ceac, t = "l", - xlab = plot_annotations$xlab, ylab = plot_annotations$ylab, - ylim = c(0, 1), main = plot_annotations$title, - lty = ifelse(is.null(plot_aes$line$types), 1, plot_aes$line$types[1]), - col = plot_aes$line$colors[1]) - } - if (he$n.comparisons > 1 & is.null(comparison)) { - lwd = ifelse(he$n.comparisons <= 6, 1, 1.5) - # linetype is the indicator - if (is.null(plot_aes$line$types)) - plot_aes$line$types = rep_len(1:6, he$n.comparisons) - # adjust provided aes lengths - if (length(plot_aes$line$types) < he$n.comparisons) - plot_aes$line$types <- rep_len(plot_aes$line$types, he$n.comparisons) - if (!exists("line_colors", where = exArgs)) { - plot_aes$line$colors <- - if (he$n.comparisons <= 6) rep(1,he$n.comparisons) else - colors()[floor(seq(262, 340, length.out = he$n.comparisons))] # gray scale - } else { - if (length(plot_aes$line$colors) < he$n.comparisons) - plot_aes$line$colors <- rep_len(plot_aes$line$colors, he$n.comparisons) - } - plot( - he$k, he$ceac[,1], t = "l", - main = plot_annotations$title, - xlab = plot_annotations$xlab, ylab = plot_annotations$ylab, - ylim = c(0, 1), lwd = lwd, - lty = plot_aes$line$types[1], col = plot_aes$line$colors[1]) - for (j in 2:he$n.comparisons) - points(he$k, he$ceac[,j], t = "l", lwd = lwd, - col = plot_aes$line$colors[j], lty = plot_aes$line$types[j]) - text <- paste(he$interventions[he$ref]," vs ",he$interventions[he$comp]) - legend( - alt.legend, text, cex = .7, bty = "n", - lty = plot_aes$line$types, col = plot_aes$line$colors) - } - if (he$n.comparisons > 1 & !is.null(comparison)) { - # adjusts bcea object for the correct number of dimensions and comparators - he$comp <- he$comp[comparison] - he$delta.e <- he$delta.e[, comparison] - he$delta.c <- he$delta.c[, comparison] - he$n.comparators <- length(comparison) + 1 - he$n.comparisons <- length(comparison) - he$interventions <- he$interventions[sort(c(he$ref, he$comp))] - he$ICER <- he$ICER[comparison] - he$ib <- he$ib[, , comparison] - he$eib <- he$eib[, comparison] - he$U <- he$U[, , sort(c(he$ref, comparison + 1))] - he$ceac <- he$ceac[, comparison] - he$ref <- rank(c(he$ref, he$comp))[1] - he$comp <- rank(c(he$ref, he$comp))[-1] - he$mod <- TRUE # - - ceac.plot(he, pos = alt.legend, graph = "base", ...) - } - } else if (graph_choice == 2) { - # ggplot2 version ----- - if (!isTRUE( - requireNamespace("ggplot2", quietly = TRUE) & - requireNamespace("grid", quietly = TRUE) - )) { - message("falling back to base graphics\n") - ceac.plot(he, pos = alt.legend, graph = "base", ...) - return(invisible(NULL)) - } + ceac_plot_base(he, + pos_legend = pos, + graph_params) - if (he$n.comparisons > 1 & is.null(comparison) == FALSE) { - # adjusts bcea object for the correct number of dimensions and comparators - he$comp <- he$comp[comparison] - he$delta.e <- he$delta.e[, comparison] - he$delta.c <- he$delta.c[, comparison] - he$n.comparators <- length(comparison) + 1 - he$n.comparisons <- length(comparison) - he$interventions <- he$interventions[sort(c(he$ref, he$comp))] - he$ICER <- he$ICER[comparison] - he$ib <- he$ib[, , comparison] - he$eib <- he$eib[, comparison] - he$U <- he$U[, , sort(c(he$ref, comparison + 1))] - he$ceac <- he$ceac[, comparison] - he$ref <- rank(c(he$ref, he$comp))[1] - he$comp <- rank(c(he$ref, he$comp))[-1] - he$mod <- TRUE # - return(ceac.plot(he, pos = alt.legend, graph = "ggplot2", ...)) - } - # no visible binding note - k = NA_real_ - if (he$n.comparisons == 1) { - data.psa <- data.frame("k" = he$k, "ceac" = he$ceac) - if (is.null(plot_aes$line$types)) - plot_aes$line$types <- 1 - ceac <- ggplot2::ggplot(data.psa, ggplot2::aes(k,ceac)) + - ggplot2::geom_line( - linetype = plot_aes$line$types[1], - colour = plot_aes$line$colors[1]) - } - if (he$n.comparisons > 1 & is.null(comparison) == TRUE) { - data.psa <- with( - he, data.frame( - "k" = c(k), "ceac" = c(ceac), - "comparison" = as.factor(c( - sapply(1:he$n.comparisons, function(x) rep(x, length(he$k))) - )))) - # labels for legend - comparisons.label <- with(he,paste0(interventions[ref]," vs ",interventions[comp])) - # linetype is the indicator - if (is.null(plot_aes$line$types)) - plot_aes$line$types = rep_len(1:6, he$n.comparisons) - # adjust provided aes lengths - if (length(plot_aes$line$types) < length(comparisons.label)) - plot_aes$line$types <- rep_len(plot_aes$line$types, length(comparisons.label)) - if (length(plot_aes$line$colors) < length(comparisons.label)) - plot_aes$line$colors <- rep_len(plot_aes$line$colors, length(comparisons.label)) - ceac <- ggplot2::ggplot( - data.psa, - ggplot2::aes(k, ceac, linetype = comparison, colour = comparison)) + - ggplot2::geom_line() + - ggplot2::scale_linetype_manual( - "", labels = comparisons.label, values = plot_aes$line$types) + - ggplot2::scale_colour_manual( - "", labels = comparisons.label, values = plot_aes$line$colors) - } - ceac <- ceac + ggplot2::theme_bw() + - ggplot2::scale_y_continuous(limits = c(0,1)) + - ggplot2::labs( - title = plot_annotations$title, - x = plot_annotations$xlab, y = plot_annotations$ylab) - jus <- NULL - if (isTRUE(alt.legend)) { - alt.legend = "bottom" - ceac <- ceac + ggplot2::theme(legend.direction = "vertical") - } - else{ - if (is.character(alt.legend)) { - choices <- c("left", "right", "bottom", "top") - alt.legend <- choices[pmatch(alt.legend, choices)] - jus = "center" - if (is.na(alt.legend)) alt.legend = FALSE - } - if (length(alt.legend) > 1) jus <- alt.legend - if (length(alt.legend) == 1 & !is.character(alt.legend)) { - alt.legend <- c(1, 0); jus <- alt.legend - } - } - # opt theme retrieval, if any - opt.theme <- ggplot2::theme() - for (obj in exArgs) - if (ggplot2::is.theme(obj)) - opt.theme <- opt.theme + obj - # theme refinement - ceac <- ceac + - ggplot2::theme( - legend.position = alt.legend, - legend.justification = jus, - legend.title = ggplot2::element_blank(), - legend.background = ggplot2::element_blank(), - text = ggplot2::element_text(size = 11), - legend.key.size = grid::unit(.66, "lines"), - legend.spacing = grid::unit(-1.25, "line"), - panel.grid = ggplot2::element_blank(), - legend.key = ggplot2::element_blank(), - legend.text.align = 0, - plot.title = ggplot2::element_text( - lineheight = 1.05, - face = "bold", - size = 14.3, - hjust = 0.5 - )) + - opt.theme - return(ceac) - } else if (graph_choice == 3) { - # plotly version ----- - if (he$n.comparisons > 1 & is.null(comparison) == FALSE) { - # adjusts bcea object for the correct number of dimensions and comparators - he$comp <- he$comp[comparison] - he$delta.e <- he$delta.e[, comparison] - he$delta.c <- he$delta.c[, comparison] - he$n.comparators <- length(comparison) + 1 - he$n.comparisons <- length(comparison) - he$interventions <- he$interventions[sort(c(he$ref, he$comp))] - he$ICER <- he$ICER[comparison] - he$ib <- he$ib[, , comparison] - he$eib <- he$eib[, comparison] - he$U <- he$U[, , sort(c(he$ref, comparison + 1))] - he$ceac <- he$ceac[, comparison] - he$ref <- rank(c(he$ref, he$comp))[1] - he$comp <- rank(c(he$ref, he$comp))[-1] - he$mod <- TRUE # - return(ceac.plot(he, pos = alt.legend, graph = "plotly", ...)) - } - # plot labels - comparisons.label <- with(he,paste0(interventions[ref]," vs ",interventions[comp])) - # data frame - data.psa <- data.frame( - "k" = c(he$k), "ceac" = c(he$ceac), - "comparison" = as.factor(c( - sapply(1:he$n.comparisons, function(x) rep(x, length(he$k))) - )), - "label" = as.factor(c( - sapply(comparisons.label, function(x) rep(x, length(he$k))) - ))) - # aes management - if (is.null(plot_aes$line$types)) - plot_aes$line$types = rep_len(1:6, he$n.comparisons) - # opacities - if (!is.null(plot_aes$area$color)) - plot_aes$area$color <- sapply(plot_aes$area$color, function(x) - ifelse(grepl(pattern = "^rgba\\(", x = x), x, plotly::toRGB(x, 0.4))) - # adjust provided aes lengths - if (length(plot_aes$line$types) < length(comparisons.label)) - plot_aes$line$types <- rep_len(plot_aes$line$types, length(comparisons.label)) - if (length(plot_aes$line$colors) < length(comparisons.label)) - plot_aes$line$colors <- rep_len(plot_aes$line$colors, length(comparisons.label)) + } else if (graph_type == 2) { - ceac <- plotly::plot_ly(data.psa, x = ~k) - ceac <- plotly::add_trace( - ceac, - y = ~ceac, type = "scatter", mode = "lines", - fill = ifelse(plot_aes$area$include, "tozeroy", "none"), - name = ~label, - fillcolor = plot_aes$area$color, - color = ~comparison, - colors = plot_aes$line$colors, - linetype = ~comparison, - linetypes = plot_aes$line$types) + ceac_plot_ggplot(he, + pos_legend = pos, + graph_params, ...) - # legend positioning not great - must be customized case by case - legend_list = list(orientation = "h", xanchor = "center", x = 0.5) - if (is.character(alt.legend)) - legend_list = switch( - alt.legend, - "left" = list(orientation = "v", x = 0, y = 0.5), - "right" = list(orientation = "v", x = 0, y = 0.5), - "bottom" = list(orienation = "h", x = .5, y = 0, xanchor = "center"), - "top" = list(orientation = "h", x = .5, y = 100, xanchor = "center")) + } else if (graph_type == 3) { - ceac <- plotly::layout( - ceac, - title = plot_annotations$title, - xaxis = list( - hoverformat = ".2f", - title = plot_annotations$xlab), - yaxis = list( - title = plot_annotations$ylab, - range = c(0,1.005)), - showlegend = TRUE, - legend = legend_list) - ceac <- plotly::config(ceac, displayModeBar = FALSE) - return(ceac) + ##TODO: + # ceac_plot_plotly() } } diff --git a/R/ceac_plot_base.R b/R/ceac_plot_base.R new file mode 100644 index 00000000..8b160775 --- /dev/null +++ b/R/ceac_plot_base.R @@ -0,0 +1,43 @@ + +#' @keywords hplot +ceac_plot_base <- function(he, ...) UseMethod("ceac_plot_base", he) + +# +ceac_plot_base.pairwise <- function(he, + pos_legend, + graph_params) { + ceac_matplot(he, + pos_legend, + graph_params, + "p_best_interv") +} + +#' @keywords hplot +ceac_plot_base.default <- function(he, + pos_legend, + graph_params) { + ceac_matplot(he, + pos_legend, + graph_params, + "ceac") +} + +#' @noRd +#' +#' @keywords hplot +ceac_matplot <- function(he, + pos_legend, + graph_params, + ceac) { + + base_params <- helper_base_params(he, graph_params) + + legend_params <- make_legend_base(he, pos_legend, base_params) + + do.call("matplot", c(list(x = he$k, + y = he[[ceac]]), + base_params), quote = TRUE) + + do.call(legend, legend_params) +} + diff --git a/R/ceac_plot_ggplot.R b/R/ceac_plot_ggplot.R new file mode 100644 index 00000000..109c7df5 --- /dev/null +++ b/R/ceac_plot_ggplot.R @@ -0,0 +1,68 @@ + +#' @keywords hplot +#' +ceac_plot_ggplot <- function(he, + pos_legend, + graph_params, ...) UseMethod("ceac_plot_ggplot", he) + +# +ceac_plot_ggplot.pairwise <- function(he, + pos_legend, + graph_params, ...) { + ceac_ggplot(he, + pos_legend, + graph_params, + "p_best_interv", ...) +} + +#' @keywords hplot +#' +ceac_plot_ggplot.default <- function(he, + pos_legend, + graph_params, ...) { + ceac_ggplot(he, + pos_legend, + graph_params, + "ceac", ...) +} + +#' @noRd +#' +#' @keywords hplot +#' +ceac_ggplot <- function(he, + pos_legend, + graph_params, + ceac, ...) { + + extra_params <- list(...) + + ceac_dat <- he[[ceac]] + n_lines <- ncol(ceac_dat) + + data_psa <- + tibble(k = rep(he$k, + times = n_lines), + ceac = c(ceac_dat), + comparison = as.factor(rep(1:n_lines, + each = length(he$k)))) + + graph_params <- helper_ggplot_params(he, graph_params) + legend_params <- make_legend_ggplot(he, pos_legend) + theme_add <- purrr::keep(extra_params, is.theme) + + ggplot(data_psa, aes(k, ceac)) + + geom_line(aes(linetype = comparison, + colour = factor(comparison))) + + theme_ceac() + + theme_add + # theme + scale_y_continuous(limits = c(0, 1)) + + do.call(labs, graph_params$annot) + # text + do.call(theme, legend_params) + # legend + scale_linetype_manual("", # lines + labels = graph_params$plot$labels, + values = graph_params$plot$line$types) + + scale_color_manual("", + labels = graph_params$plot$labels, # colours + values = graph_params$plot$line$colors) +} diff --git a/R/ceac_plot_plotly.R b/R/ceac_plot_plotly.R new file mode 100644 index 00000000..30afff4f --- /dev/null +++ b/R/ceac_plot_plotly.R @@ -0,0 +1,83 @@ + +#' @noRd +#' +.ceac_plot_plotly <- function() { + + if (he$n.comparisons > 1 & is.null(comparison) == FALSE) { + # adjusts bcea object for the correct number of dimensions and comparators + he$comp <- he$comp[comparison] + he$delta.e <- he$delta.e[, comparison] + he$delta.c <- he$delta.c[, comparison] + he$n.comparators <- length(comparison) + 1 + he$n.comparisons <- length(comparison) + he$interventions <- he$interventions[sort(c(he$ref, he$comp))] + he$ICER <- he$ICER[comparison] + he$ib <- he$ib[, , comparison] + he$eib <- he$eib[, comparison] + he$U <- he$U[, , sort(c(he$ref, comparison + 1))] + he$ceac <- he$ceac[, comparison] + he$ref <- rank(c(he$ref, he$comp))[1] + he$comp <- rank(c(he$ref, he$comp))[-1] + he$mod <- TRUE # + return(ceac.plot(he, pos = alt.legend, graph = "plotly", ...)) + } + # plot labels + comparisons.label <- with(he,paste0(interventions[ref]," vs ",interventions[comp])) + # data frame + data.psa <- data.frame( + "k" = c(he$k), "ceac" = c(he$ceac), + "comparison" = as.factor(c( + sapply(1:he$n.comparisons, function(x) rep(x, length(he$k))) + )), + "label" = as.factor(c( + sapply(comparisons.label, function(x) rep(x, length(he$k))) + ))) + # aes management + if (is.null(plot_aes$line$types)) + plot_aes$line$types = rep_len(1:6, he$n.comparisons) + # opacities + if (!is.null(plot_aes$area$color)) + plot_aes$area$color <- sapply(plot_aes$area$color, function(x) + ifelse(grepl(pattern = "^rgba\\(", x = x), x, plotly::toRGB(x, 0.4))) + # adjust provided aes lengths + if (length(plot_aes$line$types) < length(comparisons.label)) + plot_aes$line$types <- rep_len(plot_aes$line$types, length(comparisons.label)) + if (length(plot_aes$line$colors) < length(comparisons.label)) + plot_aes$line$colors <- rep_len(plot_aes$line$colors, length(comparisons.label)) + + ceac <- plotly::plot_ly(data.psa, x = ~k) + ceac <- plotly::add_trace( + ceac, + y = ~ceac, type = "scatter", mode = "lines", + fill = ifelse(plot_aes$area$include, "tozeroy", "none"), + name = ~label, + fillcolor = plot_aes$area$color, + color = ~comparison, + colors = plot_aes$line$colors, + linetype = ~comparison, + linetypes = plot_aes$line$types) + + # legend positioning not great - must be customized case by case + legend_list = list(orientation = "h", xanchor = "center", x = 0.5) + if (is.character(alt.legend)) + legend_list = switch( + alt.legend, + "left" = list(orientation = "v", x = 0, y = 0.5), + "right" = list(orientation = "v", x = 0, y = 0.5), + "bottom" = list(orienation = "h", x = .5, y = 0, xanchor = "center"), + "top" = list(orientation = "h", x = .5, y = 100, xanchor = "center")) + + ceac <- plotly::layout( + ceac, + title = plot_annotations$title, + xaxis = list( + hoverformat = ".2f", + title = plot_annotations$xlab), + yaxis = list( + title = plot_annotations$ylab, + range = c(0,1.005)), + showlegend = TRUE, + legend = legend_list) + + plotly::config(ceac, displayModeBar = FALSE) +} \ No newline at end of file diff --git a/R/ceaf.plot.R b/R/ceaf.plot.R index da9c66f0..43c7d286 100644 --- a/R/ceaf.plot.R +++ b/R/ceaf.plot.R @@ -63,32 +63,47 @@ #' ceaf.plot(mce) #' } #' -#' @export ceaf.plot -ceaf.plot <- function(mce,graph=c("base","ggplot2")){ - base.graphics <- ifelse(isTRUE(pmatch(graph,c("base","ggplot2"))==2),FALSE,TRUE) - if(base.graphics) { - plot(mce$k,mce$ceaf,t="l",lty=1, - ylim=c(0,1),xlab="Willingness to pay", - ylab="Probability of most cost effectiveness", - main="Cost-effectiveness acceptability frontier") +#' @export +#' +ceaf.plot <- function(mce,graph = c("base","ggplot2")) { + + base_graphics <- pmatch(graph, c("base","ggplot2")) != 2 + + if (!isTRUE(requireNamespace("ggplot2", quietly=TRUE) & requireNamespace("grid", quietly=TRUE))){ + message("Falling back to base graphics\n") + base_graphics <- TRUE } - else{ - if(!isTRUE(requireNamespace("ggplot2",quietly=TRUE)&requireNamespace("grid",quietly=TRUE))){ - message("Falling back to base graphics\n") - ceaf.plot(mce,graph="base") - return(invisible(NULL)) - } + + if (base_graphics) { + plot(x = mce$k, + y = mce$ceaf, + t = "l", + lty = 1, + ylim = c(0,1), + xlab = "Willingness to pay", + ylab = "Probability of most cost effectiveness", + main = "Cost-effectiveness acceptability frontier") + } else { # no visible binding note k <- NA_real_ df <- data.frame("k"=mce$k,"ceaf"=mce$ceaf) - ceaf <- ggplot2::ggplot(df,ggplot2::aes(x=k,y=ceaf)) + ggplot2::theme_bw() + - ggplot2::geom_line() + ggplot2::coord_cartesian(ylim=c(-0.05,1.05)) + - ggplot2::theme(text=ggplot2::element_text(size=11),legend.key.size=grid::unit(.66,"lines"),legend.spacing=grid::unit(-1.25,"line"), - panel.grid=ggplot2::element_blank(),legend.key=ggplot2::element_blank()) + - ggplot2::labs(title="Cost-effectiveness acceptability frontier",x="Willingness to pay",y="Probability of most cost-effectiveness") + - ggplot2::theme(plot.title = ggplot2::element_text(lineheight=1.05, face="bold",size=14.3,hjust=0.5)) + ceaf <- + ggplot2::ggplot(df,ggplot2::aes(x=k,y=ceaf)) + + ggplot2::theme_bw() + + ggplot2::geom_line() + + ggplot2::coord_cartesian(ylim=c(-0.05,1.05)) + + ggplot2::theme(text=ggplot2::element_text(size=11), + legend.key.size=grid::unit(.66,"lines"), + legend.spacing=grid::unit(-1.25,"line"), + panel.grid=ggplot2::element_blank(), + legend.key=ggplot2::element_blank()) + + ggplot2::labs(title="Cost-effectiveness acceptability frontier", + x="Willingness to pay", + y="Probability of most cost-effectiveness") + + ggplot2::theme(plot.title = ggplot2::element_text(lineheight=1.05, face="bold", size=14.3, hjust=0.5)) + return(ceaf) } } diff --git a/R/ceplane.plot.R b/R/ceplane.plot.R index ec4187aa..49c6afea 100644 --- a/R/ceplane.plot.R +++ b/R/ceplane.plot.R @@ -1,4 +1,3 @@ -# ceplane.plot ----- #' Cost-effectiveness plane plot #' @@ -50,6 +49,7 @@ #' acceptability area (default is TRUE). #' \item \code{area_color}: a color specifying the colour of the cost-effectiveness acceptability area #' } +#' #' @return \item{ceplane}{ If \code{graph="ggplot2"} a ggplot object, or if \code{graph="plotly"} #' a plotly object containing the requested plot. Nothing is returned when \code{graph="base"}, #' the default.} @@ -65,6 +65,7 @@ #' @details In the plotly version, point_colors, ICER_colors and area_color can also be specified #' as rgba colours using either the \code{\link[plotly]{toRGB}{plotly::toRGB}} function or #' a rgba colour string, e.g. \code{'rgba(1, 1, 1, 1)'}. +#' #' @author Gianluca Baio, Andrea Berardi #' @seealso \code{\link{bcea}} #' @references Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity @@ -74,6 +75,7 @@ #' Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, #' London #' @keywords Health economic evaluation Cost Effectiveness Plane +#' #' @examples #' #' ### create the bcea object m for the smoking cessation example @@ -88,7 +90,8 @@ #' ceplane.plot(m,wtp=200,pos="right",ICER_sizes=2,graph="ggplot2") #' } #' -#' @export ceplane.plot +#' @export +#' ceplane.plot <- function(he, comparison = NULL, wtp = 25000, @@ -98,715 +101,32 @@ ceplane.plot <- function(he, xlim = NULL, ylim = NULL, ...) { - # Forces R to avoid scientific format for graphs labels - options(scipen = 10) + + graph <- match.arg(graph) + + ##TODO: what is this?.. ### hidden options for ggplot2 ### # ICER.size = # changes ICER point size # label.pos = FALSE # uses alternate position for wtp label (old specification) - alt.legend <- pos - # choose graphical engine - if (is.null(graph) || is.na(graph)) graph = "base" - graph_choice <- pmatch(graph[1], c("base", "ggplot2", "plotly"), nomatch = 1) - # check feasibility - if (graph_choice == 2 && !requireNamespace("ggplot2", quietly = TRUE) & requireNamespace("grid", quietly = TRUE)) { - warning("Package ggplot2 and grid not found; eib.plot will be rendered using base graphics.") - graph_choice <- 1 - } - if (graph_choice == 3 && !requireNamespace("plotly", quietly = TRUE)) { - warning("Package plotly not found; eib.plot will be rendered using base graphics.") - graph_choice <- 1 - } - # evaluate additional arguments ----- - exArgs <- list(...) - plot_annotations <- list("exist" = list("title" = FALSE, "xlab" = FALSE, "ylab" = FALSE)) - plot_aes <- list("area" = list("include" = TRUE, "color" = "light gray", "line_color" = "black"), - "point" = list("colors" = "black", "sizes" = 4), - "ICER" = list("colors" = "red", "sizes" = 8), - "exist" = list("area" = list("include" = FALSE, "color" = FALSE, "line_color" = FALSE), - "point" = list("colors" = FALSE, "sizes" = FALSE), - "ICER" = list("colors" = FALSE, "sizes" = FALSE))) - plot_aes_args = c("area_include", "area_color", "area_line_color", - "point_colors", "point_sizes", - "ICER_colors", "ICER_sizes") - if (length(exArgs) >= 1) { - # if existing, read and store title, xlab and ylab - for (annotation in names(plot_annotations$exist)) { - if (exists(annotation, where = exArgs)) { - plot_annotations$exist[[annotation]] <- TRUE - plot_annotations[[annotation]] <- exArgs[[annotation]] - } - } - # if existing, read and store graphical options - for (aes_arg in plot_aes_args) { - if (exists(aes_arg, where = exArgs)) { - aes_cat <- strsplit(aes_arg, "_")[[1]][1] - aes_name <- paste0(strsplit(aes_arg, "_")[[1]][-1], collapse = "_") - plot_aes[[aes_cat]][[aes_name]] <- exArgs[[aes_arg]] - plot_aes$exist[[aes_cat]][[aes_name]] <- TRUE - } - } - } - # Args compatibility - if (exists("ICER.size", where = exArgs)) { - if (plot_aes$exist$ICER$sizes) { - warning("Both ICER.size and ICER_sizes arguments specified. ICER_sizes will be used.") - } else { - warning("ICER.size is softly deprecated. Please use ICER_sizes instead.") - plot_aes$exist$ICER$sizes <- TRUE - plot_aes$ICER$sizes <- exArgs$ICER.size - } - } - if (exists("ICER.col", where = exArgs)) { - if (plot_aes$exist$ICER$colors) { - warning("Both ICER.col and ICER_col arguments specified. ICER_col will be used.") - } else { - warning("ICER.col is softly deprecated. Please use ICER_col instead.") - plot_aes$exist$ICER$colors <- TRUE - plot_aes$ICER$colors <- exArgs$ICER.col - } - } - if (exists("col", where = exArgs)) { - if (plot_aes$exist$point$colors) { - warning("Both col and point_colors arguments specified. point_colors will be used.") - } else { - warning("col argument is softly deprecated. Please use point_colors instead.") - plot_aes$exist$point$colors <- TRUE - plot_aes$point$colors <- exArgs$col - } - } - # set default colour scheme - if (!plot_aes$exist$point$colors) { - if (he$n.comparisons > 1 & (is.null(comparison) || length(comparison) > 1)) { - plot_aes$point$colors <- colors()[floor(seq(262, 340, length.out = he$n.comparisons))] - } else { - plot_aes$point$colors <- "grey55" - } - } - # default plot annotations ----- - if (!plot_annotations$exist$title) - plot_annotations$title <- with(he, paste0( - "Cost-Effectiveness Plane", - ifelse( - n.comparisons == 1 | (n.comparisons > 1 & (!is.null(comparison) && length(comparison) == 1)), - paste0("\n", interventions[ref], " vs ", interventions[-ref]), - paste0(ifelse( - isTRUE(he$mod), - paste0( - "\n", - interventions[ref], - " vs ", - paste0(interventions[comp], collapse = ", ") - ), - "" - )) - ) - )) - if (!plot_annotations$exist$xlab) - plot_annotations$xlab = "Effectiveness differential" - if (!plot_annotations$exist$ylab) - plot_annotations$ylab = "Cost differential" - if (graph_choice == 1) { - # base graphics version ----- - if(!is.null(size)) - message("option size will be ignored using base graphics") - if(is.numeric(alt.legend)&length(alt.legend)==2){ - temp <- "" - if(alt.legend[2]==0) - temp <- paste0(temp,"bottom") - else - temp <- paste0(temp,"top") - if(alt.legend[1]==0) - temp <- paste0(temp,"left") - else - temp <- paste0(temp,"right") - alt.legend <- temp - if(length(grep("^(bottom|top)(left|right)$",temp))==0) - alt.legend <- FALSE - } - if(is.logical(alt.legend)){ - if(!alt.legend) - alt.legend="topright" - else - alt.legend="topleft" - } + plot_type <- select_plot_type(graph) + + graph_params <- prepare_graph_params_ceplane(...) + + if (graph_type == 1) { + + ##TODO:... + # ceplane_plot_base() + + } else if (graph_type == 2) { + + ##TODO:... + # ceplane_plot_ggplot() - # Encodes characters so that the graph can be saved as ps or pdf - ps.options(encoding="CP1250") - pdf.options(encoding="CP1250") + } else if (graph_type == 3) { - if(he$n.comparisons==1) { - m.e <- range(he$delta.e)[1] - M.e <- range(he$delta.e)[2] - m.c <- range(he$delta.c)[1] - M.c <- range(he$delta.c)[2] - step <- (M.e-m.e)/10 - m.e <- ifelse(m.e<0,m.e,-m.e) - m.c <- ifelse(m.c<0,m.c,-m.c) - x.pt <- .95*m.e - y.pt <- ifelse(x.pt*wtp1 & is.null(comparison)==TRUE) { - if(is.null(xlim)) {xlim <- range(he$delta.e)} - if(is.null(ylim)) {ylim <- range(he$delta.c)} - plot( - he$delta.e[, 1], - he$delta.c[, 1], - pch = 20, - cex = ifelse( - !plot_aes$exist$point$sizes, - .35, - plot_aes$point$sizes[1]), - col = plot_aes$point$colors[1], - xlim = xlim, - ylim = ylim, - xlab = plot_annotations$xlab, - ylab = plot_annotations$ylab, - main = plot_annotations$title - ) - for (i in 2:he$n.comparisons) { - points( - he$delta.e[,i],he$delta.c[,i],pch=20, - cex = ifelse( - !plot_aes$exist$point$sizes, - .35, - plot_aes$point$sizes[i]), - col = plot_aes$point$colors[i]) - } - abline(h=0,col="dark grey") - abline(v=0,col="dark grey") - text <- paste(he$interventions[he$ref]," vs ",he$interventions[he$comp]) - legend(alt.legend,text,col=plot_aes$point$colors,cex=.7,bty="n",lty=1) - } else if(he$n.comparisons>1 & is.null(comparison)==FALSE & length(comparison)==1) { - m.e <- range(he$delta.e[,comparison])[1] - M.e <- range(he$delta.e[,comparison])[2] - m.c <- range(he$delta.c[,comparison])[1] - M.c <- range(he$delta.c[,comparison])[2] - step <- (M.e-m.e)/10 - m.e <- ifelse(m.e<0,m.e,-m.e) - m.c <- ifelse(m.c<0,m.c,-m.c) - x.pt <- .95*m.e - y.pt <- ifelse(x.pt*wtp1&is.null(comparison)==FALSE&length(comparison)!=1) { - stopifnot(all(comparison %in% 1:he$n.comparisons)) - # adjusts bcea object for the correct number of dimensions and comparators - he$comp <- he$comp[comparison] - he$delta.e <- he$delta.e[,comparison] - he$delta.c <- he$delta.c[,comparison] - he$n.comparators=length(comparison)+1 - he$n.comparisons=length(comparison) - he$interventions=he$interventions[sort(c(he$ref,he$comp))] - he$ICER=he$ICER[comparison] - he$ib=he$ib[,,comparison] - he$eib=he$eib[,comparison] - he$U=he$U[,,sort(c(he$ref,comparison+1))] - he$ceac=he$ceac[,comparison] - he$ref=rank(c(he$ref,he$comp))[1] - he$comp=rank(c(he$ref,he$comp))[-1] - he$mod <- TRUE # - return(ceplane.plot(he,wtp=wtp,pos=alt.legend,graph="base",size=size,...)) - } - } else if (graph_choice == 2) { - # ggplot2 version ----- - if(!isTRUE(requireNamespace("ggplot2",quietly=TRUE) & requireNamespace("grid",quietly=TRUE))){ - message("Falling back to base graphics\n") - ceplane.plot(he,comparison=comparison,wtp=wtp,pos=alt.legend,graph="base"); return(invisible(NULL)) - } - # no visible binding note - delta.e <- delta.c <- lambda.e <- lambda.c <- NULL - if (is.null(size)) - size <- ggplot2::rel(3.5) - label.pos <- TRUE - opt.theme <- ggplot2::theme() - if (!plot_aes$exist$ICER$sizes) - plot_aes$ICER$sizes <- ifelse(he$n.comparisons == 1, 2, 0) - if (length(exArgs) >= 1) { - if (exists("label.pos", where = exArgs)) - if (is.logical(exArgs$label.pos)) - label.pos <- exArgs$label.pos - for (obj in exArgs) - if (ggplot2::is.theme(obj)) - opt.theme <- opt.theme + obj - } - if (he$n.comparisons == 1) { - kd <- data.frame(he$delta.e,he$delta.c) - names(kd) <- c("delta.e","delta.c") - # for scale_x_continuous(oob=) - do.nothing=function(x,limits) return(x) - # plot limits - range.e <- range(kd$delta.e) - range.c <- range(kd$delta.c) - range.e[1] <- ifelse(range.e[1]<0,range.e[1],-range.e[1]) - range.c[1] <- ifelse(range.c[1]<0,range.c[1],-range.c[1]) - # ce plane data - x1 <- range.e[1]-2*abs(diff(range.e)) - x2 <- range.e[2]+2*abs(diff(range.e)) - x3 <- x2 - x <- c(x1,x2,x3) - y <- x*wtp; y[3] <- x1*wtp - plane <- data.frame(x=x,y=y) - # build a trapezoidal plane instead of a triangle if the y value is less than the minimum difference on costs - if(y[1]>1.2*range.c[1]) { - plane <- rbind(plane, - c(x2,2*range.c[1]), #new bottom-right vertex - c(x1,2*range.c[1])) #new bottom-left vertex - } - # actual plot - ceplane <- ggplot2::ggplot(kd, ggplot2::aes(delta.e,delta.c)) + - ggplot2::theme_bw() + - ggplot2::scale_x_continuous(limits=range.e,oob=do.nothing) + - ggplot2::scale_y_continuous(limits=range.c,oob=do.nothing) + - ggplot2::scale_color_manual( - "",labels=paste0("ICER = ",format(he$ICER,digits=6,nsmall=2)," "), - values = ifelse(!plot_aes$exist$ICER$colors, "red", plot_aes$ICER$colors[1])) + - ggplot2::geom_line( - data = plane[1:2,], ggplot2::aes(x = x, y = y), - color = ifelse(!plot_aes$exist$area$line_color, "black", plot_aes$area$line_color), - linetype = 1) + - ggplot2::geom_polygon( - data = plane,ggplot2::aes(x = x, y = y), - fill = ifelse(is.null(plot_aes$area$color), "light gray", plot_aes$area$color), - alpha = .3) + - ggplot2::geom_hline(ggplot2::aes(yintercept=0),colour="grey") + - ggplot2::geom_vline(ggplot2::aes(xintercept=0),colour="grey") + - ggplot2::geom_point( - size = ifelse(!plot_aes$exist$point$sizes, 1, plot_aes$point$sizes[1]), - colour = plot_aes$point$colors[1]) + - ggplot2::geom_point( - ggplot2::aes( - mean(delta.e),mean(delta.c), - color = as.factor(1)), - size = plot_aes$ICER$sizes[1]) - if(!label.pos) { - # moves the wtp label depending on whether the line crosses the y-axis - ceplane <- ceplane + - ggplot2::annotate( - geom = "text", - x = ifelse(range.c[1] / wtp > range.e[1], range.c[1] / wtp, range.e[1]), - y = range.c[1], - label = paste0("k = ", format(wtp, digits = 6)), - hjust = -.15, - size = size) - } - else{ - m.e <- ifelse(range.e[1]<0,range.e[1],-range.e[1]) - m.c <- ifelse(range.c[1]<0,range.c[1],-range.c[1]) - x.pt <- .95*m.e - y.pt <- ifelse(x.pt*wtp1&is.null(comparison)==TRUE) { - # create dataframe for plotting - kd <- with(he,data.frame("delta.e" = c(delta.e), "delta.c" = c(delta.c))) - kd$comparison <- as.factor(sort(rep(1:he$n.comparisons,dim(he$delta.e)[1]))) - # dataset for ICERs - means <- matrix(NA_real_,nrow=he$n.comparisons,ncol=2) - for (i in 1:he$n.comparisons) - means[i,] <- colMeans(kd[kd$comparison == i, -3]) - means <- data.frame(means) - means$comparison <- factor(1:he$n.comparisons) - names(means) <- c("lambda.e","lambda.c","comparison") - # labels for legend - comparisons.label <- with(he,paste0(interventions[ref]," vs ",interventions[comp])) - # polygon - do.nothing = function(x,limits) return(x) - # plot limits - range.e <- range(kd$delta.e) - range.c <- range(kd$delta.c) - range.e[1] <- ifelse(range.e[1]<0,range.e[1],-range.e[1]) - range.c[1] <- ifelse(range.c[1]<0,range.c[1],-range.c[1]) - # ce plane data - x1 <- range.e[1]-2*abs(diff(range.e)) - x2 <- range.e[2]+2*abs(diff(range.e)) - x3 <- x2 - x <- c(x1,x2,x3) - y <- x*wtp; y[3] <- x1*wtp - plane <- data.frame(x=x,y=y,comparison=factor(rep(he$n.comparisons+1,3))) - # build a trapezoidal plane instead of a triangle if the y value is less than the minimum difference on costs - if(y[1]>min(kd$delta.c)) { - plane <- rbind(plane, - c(x2,2*min(kd$delta.c),he$n.comparisons+1), #new bottom-right vertex - c(x1,2*min(kd$delta.c),he$n.comparisons+1)) #new bottom-left vertex - } - ceplane <- - ggplot2::ggplot(kd,ggplot2::aes(x=delta.e,y=delta.c,col=comparison)) + - ggplot2::theme_bw() + - ggplot2::scale_color_manual( - labels = comparisons.label, - values = plot_aes$point$colors, - na.value = "black") + - ggplot2::scale_size_manual( - labels = comparisons.label, - values = if(!plot_aes$exist$point$sizes) - rep_len(1, length(comparisons.label)) else - rep_len(plot_aes$point$sizes, length(comparisons.label)), - na.value = 1) + - ggplot2::scale_x_continuous(limits=range.e,oob=do.nothing) + - ggplot2::scale_y_continuous(limits=range.c,oob=do.nothing) + - ggplot2::annotate( - "line", - x = plane[1:2,1], y = plane[1:2,2], - color = ifelse(!plot_aes$exist$area$line_color, "black", plot_aes$area$line_color)) + - ggplot2::annotate( - "polygon", - plane$x, plane$y, - fill = ifelse(is.null(plot_aes$area$color), "light gray", plot_aes$area$color), - alpha = .3) + - ggplot2::geom_hline(ggplot2::aes(yintercept=0),colour="grey") + ggplot2::geom_vline(ggplot2::aes(xintercept=0),colour="grey") + - ggplot2::geom_point( - ggplot2::aes(size = comparison)) - if (!all(plot_aes$ICER$sizes <= 0)) { - ceplane <- ceplane + - ggplot2::geom_point( - data = means, - ggplot2::aes(x = lambda.e, y = lambda.c), - colour = plot_aes$ICER$colors, - size = plot_aes$ICER$sizes) - } - # wtp label - if (!label.pos) { - ceplane <- ceplane + - ggplot2::annotate(geom="text", - x=ifelse(range.c[1]/wtp>range.e[1],range.c[1]/wtp,range.e[1]), - y=range.c[1], - label=paste0("k = ",format(wtp,digits=6)," "),hjust=.15,size=size - ) - } else { - m.e <- ifelse(range.e[1]<0,range.e[1],-range.e[1]) - m.c <- ifelse(range.c[1]<0,range.c[1],-range.c[1]) - x.pt <- .95*m.e - y.pt <- ifelse(x.pt*wtp 1 & is.null(comparison) == FALSE) { - # adjusts bcea object for the correct number of dimensions and comparators - he$comp <- he$comp[comparison] - he$delta.e <- he$delta.e[, comparison] - he$delta.c <- he$delta.c[, comparison] - he$n.comparators <- length(comparison) + 1 - he$n.comparisons <- length(comparison) - he$interventions <- he$interventions[sort(c(he$ref, he$comp))] - he$ICER <- he$ICER[comparison] - he$ib <- he$ib[, , comparison] - he$eib <- he$eib[, comparison] - he$U <- he$U[, , sort(c(he$ref, comparison + 1))] - he$ceac <- he$ceac[, comparison] - he$ref <- rank(c(he$ref, he$comp))[1] - he$comp <- rank(c(he$ref, he$comp))[-1] - he$mod <- TRUE # - return(ceplane.plot(he,wtp=wtp,pos=alt.legend,graph="ggplot2",size=size,...)) - } - ceplane <- ceplane + - ggplot2::labs( - title = plot_annotations$title, - x = plot_annotations$xlab, - y = plot_annotations$ylab) - jus <- NULL - if (isTRUE(alt.legend)) { - alt.legend="bottom" - ceplane <- ceplane + ggplot2::theme(legend.direction="vertical") - } else { - if (is.character(alt.legend)) { - choices <- c("left", "right", "bottom", "top") - alt.legend <- choices[pmatch(alt.legend,choices)] - jus="center" - if (is.na(alt.legend)) - alt.legend = FALSE - } - if (length(alt.legend) > 1) - jus <- alt.legend - if (length(alt.legend) == 1 & !is.character(alt.legend)) { - alt.legend <- c(1,1) - jus <- alt.legend - } - } - ceplane <- ceplane + - ggplot2::theme(legend.position=alt.legend,legend.justification=jus,legend.title=ggplot2::element_blank(),legend.background=ggplot2::element_blank()) + - ggplot2::theme(text=ggplot2::element_text(size=11),legend.key.size=grid::unit(.66,"lines"),legend.spacing=grid::unit(-1.25,"line"),panel.grid=ggplot2::element_blank(),legend.key=ggplot2::element_blank(),legend.text.align=0) + - ggplot2::theme(plot.title = ggplot2::element_text(lineheight=1.05, face="bold",size=14.3,hjust=0.5)) - if (he$n.comparisons == 1) - ceplane <- ceplane + ggplot2::theme(legend.key.size=grid::unit(.1,"lines")) - ceplane <- ceplane + opt.theme - return(ceplane) - } else if (graph_choice == 3) { - # plotly version ----- - if (he$n.comparisons > 1 & is.null(comparison) == FALSE) { - # adjusts bcea object for the correct number of dimensions and comparators - he$comp <- he$comp[comparison] - he$delta.e <- he$delta.e[, comparison] - he$delta.c <- he$delta.c[, comparison] - he$n.comparators <- length(comparison) + 1 - he$n.comparisons <- length(comparison) - he$interventions <- he$interventions[sort(c(he$ref, he$comp))] - he$ICER <- he$ICER[comparison] - he$ib <- he$ib[, , comparison] - he$eib <- he$eib[, comparison] - he$U <- he$U[, , sort(c(he$ref, comparison + 1))] - he$ceac <- he$ceac[, comparison] - he$ref <- rank(c(he$ref, he$comp))[1] - he$comp <- rank(c(he$ref, he$comp))[-1] - he$mod <- TRUE # - return(ceplane.plot(he, wtp = wtp, pos = alt.legend, graph = "plotly", ...)) - } - if (exists("ICER.size", where = exArgs)) { - ICER.size <- exArgs$ICER.size - } else { - ICER.size <- ifelse(he$n.comparisons == 1, 8, 0) - } - # plot labels - comparisons.label <- with(he,paste0(interventions[ref]," vs ",interventions[comp])) - kd <- data.frame( - "delta.e" = c(he$delta.e), "delta.c" = c(he$delta.c), - "comparison" = as.factor(c( - sapply(1:he$n.comparisons, function(x) rep(x, nrow(as.matrix(he$delta.e)))) - )), - "label" = as.factor(c( - sapply(comparisons.label, function(x) rep(x, nrow(as.matrix(he$delta.e)))) - ))) - if (length(plot_aes$point$colors) != length(comparisons.label)) - plot_aes$point$colors <- rep_len(plot_aes$point$colors, length(comparisons.label)) - if (length(plot_aes$point$sizes) != length(comparisons.label)) - plot_aes$point$sizes <- rep_len(plot_aes$point$sizes, length(comparisons.label)) - if (length(plot_aes$ICER$colors) != length(comparisons.label)) - plot_aes$ICER$colors <- rep_len(plot_aes$ICER$colors, length(comparisons.label)) - if (length(plot_aes$ICER$sizes) != length(comparisons.label)) - plot_aes$ICER$sizes <- rep_len(plot_aes$ICER$sizes, length(comparisons.label)) - # plot limits - range.e <- range(kd$delta.e) - range.c <- range(kd$delta.c) - range.e[1] <- ifelse(range.e[1] < 0, range.e[1], -range.e[1]) - range.c[1] <- ifelse(range.c[1] < 0, range.c[1], -range.c[1]) - # ce plane data - x1 <- range.e[1] - 2*abs(diff(range.e)) - x2 <- range.e[2] + 2*abs(diff(range.e)) - x = c(x1, x2, x2) - y = c(x1*wtp, x2*wtp, x1*wtp) - plane <- data.frame(x = x, y = y) - # build a trapezoidal plane instead of a triangle if - # the y value is less than the minimum difference on costs - if (y[1] > 1.2*range.c[1]) - plane <- rbind(plane, - c(x2,2*range.c[1]), #new bottom-right vertex - c(x1,2*range.c[1])) #new bottom-left vertex - xrng = c(ifelse(prod(range.e) < 0, - range.e[1]*1.1, - ifelse(range.e[1] < 0, - range.e[1]*1.1, - -(range.e[2] - range.e[1])*0.1)), - ifelse(prod(range.e) < 0, range.e[2]*1.1, - ifelse(range.e[2] > 0, - range.e[2]*1.1, - (range.e[2] - range.e[1])*0.1))) - yrng = c(ifelse(prod(range.c) < 0, - range.c[1]*1.1, - ifelse(range.c[1] < 0, - range.c[1]*1.1, - -(range.c[2] - range.c[1])*0.1)), - ifelse(prod(range.c) < 0, - range.c[2]*1.1, - ifelse(range.c[2] > 0, - range.c[2]*1.1, - (range.c[2] - range.c[1])*0.1))) - # Calculates dataset for ICERs from bcea object - # @param he A BCEA object - # @param comparisons.label Optional vector of strings with comparison labels - # @return A data.frame object including mean outcomes, comparison identifier, - # comparison label and associated ICER - tabulate_means = function(he, comparisons.label = NULL) { - if (is.null(comparisons.label)) - comparisons.label <- 1:he$n.comparisons - data.frame( - "lambda.e" = sapply(1:he$n.comparisons, function(x) mean(as.matrix(he$delta.e)[,x])), - "lambda.c" = sapply(1:he$n.comparisons, function(x) mean(as.matrix(he$delta.c)[,x])), - "comparison" = as.factor(1:he$n.comparisons), - "label" = comparisons.label, - "ICER" = he$ICER - ) - } - # actual plot - ceplane <- plotly::plot_ly() - # CEA area - if (plot_aes$area$include) - ceplane <- plotly::add_trace( - ceplane, - type = "scatter", mode = "lines", - data = plane, - x = ~x, y = ~y, - fill = "tonext", - fillcolor = ifelse( - grepl(pattern = "^rgba\\(", x = plot_aes$area$color), - plot_aes$area$color, - plotly::toRGB(plot_aes$area$color, 0.5)), - line = list(color = ifelse( - grepl(pattern = "^rgba\\(", x = plot_aes$area$line_color), - plot_aes$area$line_color, - plotly::toRGB(plot_aes$area$line_color, 1))), - name = "CEA area") - # cloud - for (comp in 1:he$n.comparisons) { - ceplane <- plotly::add_trace( - ceplane, - type = "scatter", mode = "markers", - data = kd[kd$comparison == levels(kd$comparison)[comp],], - y = ~delta.c, - x = ~delta.e, - marker = list( - color = ifelse( - grepl(pattern = "^rgba\\(", x = plot_aes$point$colors[comp]), - plot_aes$point$colors[comp], - plotly::toRGB(plot_aes$point$colors[comp])), - size = plot_aes$point$sizes[comp] - ), - hoverinfo = "name+x+y", - name = ~label) - } - # ICER - if (!all(plot_aes$ICER$sizes <= 0)) { - means_table = tabulate_means(he, comparisons.label) - for (comp in 1:he$n.comparisons) { - ceplane <- plotly::add_trace( - ceplane, - type = "scatter", mode = "markers", - data = means_table[comp,], - x = ~lambda.e, - y = ~lambda.c, - marker = list( - color = plot_aes$ICER$colors[comp], - size = plot_aes$ICER$sizes[comp] - ), - name = ~paste( - ifelse(he$n.comparisons > 1, as.character(label), ""), - "ICER:", - prettyNum(round(ICER,2), big.mark = ",")) - ) - } - } - # layout - legend_list = list(orientation = "h", xanchor = "center", x = 0.5) - ceplane <- plotly::layout( - ceplane, - title = plot_annotations$title, - xaxis = list( - hoverformat = ".2f", range = xrng, - title = plot_annotations$xlab - ), - yaxis = list( - hoverformat = ".2f", range = yrng, - title = plot_annotations$ylab - ), - showlegend = TRUE, - legend = legend_list - ) - ceplane <- plotly::config(ceplane, displayModeBar = FALSE) - return(ceplane) + ##TODO:... + # ceplane_plot_plotly() } } diff --git a/R/ceplane_plot_base.R b/R/ceplane_plot_base.R new file mode 100644 index 00000000..a692825d --- /dev/null +++ b/R/ceplane_plot_base.R @@ -0,0 +1,197 @@ + +ceplane_plot_base <- function() { + + if(!is.null(size)) + message("option size will be ignored using base graphics") + if(is.numeric(alt.legend)&length(alt.legend)==2){ + temp <- "" + if(alt.legend[2]==0) + temp <- paste0(temp,"bottom") + else + temp <- paste0(temp,"top") + if(alt.legend[1]==0) + temp <- paste0(temp,"left") + else + temp <- paste0(temp,"right") + alt.legend <- temp + if(length(grep("^(bottom|top)(left|right)$",temp))==0) + alt.legend <- FALSE + } + if(is.logical(alt.legend)){ + if(!alt.legend) + alt.legend="topright" + else + alt.legend="topleft" + } + + # Encodes characters so that the graph can be saved as ps or pdf + ps.options(encoding="CP1250") + pdf.options(encoding="CP1250") + + if(he$n.comparisons==1) { + m.e <- range(he$delta.e)[1] + M.e <- range(he$delta.e)[2] + m.c <- range(he$delta.c)[1] + M.c <- range(he$delta.c)[2] + step <- (M.e-m.e)/10 + m.e <- ifelse(m.e<0,m.e,-m.e) + m.c <- ifelse(m.c<0,m.c,-m.c) + x.pt <- .95*m.e + y.pt <- ifelse(x.pt*wtp 1 & is.null(comparison)) { + if(is.null(xlim)) {xlim <- range(he$delta.e)} + if(is.null(ylim)) {ylim <- range(he$delta.c)} + plot( + he$delta.e[, 1], + he$delta.c[, 1], + pch = 20, + cex = ifelse( + !plot_aes$exist$point$sizes, + .35, + plot_aes$point$sizes[1]), + col = plot_aes$point$colors[1], + xlim = xlim, + ylim = ylim, + xlab = plot_annotations$xlab, + ylab = plot_annotations$ylab, + main = plot_annotations$title + ) + for (i in 2:he$n.comparisons) { + points( + he$delta.e[,i],he$delta.c[,i],pch=20, + cex = ifelse( + !plot_aes$exist$point$sizes, + .35, + plot_aes$point$sizes[i]), + col = plot_aes$point$colors[i]) + } + abline(h=0,col="dark grey") + abline(v=0,col="dark grey") + text <- paste(he$interventions[he$ref]," vs ",he$interventions[he$comp]) + legend(alt.legend,text,col=plot_aes$point$colors,cex=.7,bty="n",lty=1) + } else if(he$n.comparisons > 1 & !is.null(comparison) & length(comparison) == 1) { + m.e <- range(he$delta.e[,comparison])[1] + M.e <- range(he$delta.e[,comparison])[2] + m.c <- range(he$delta.c[,comparison])[1] + M.c <- range(he$delta.c[,comparison])[2] + step <- (M.e-m.e)/10 + m.e <- ifelse(m.e<0,m.e,-m.e) + m.c <- ifelse(m.c<0,m.c,-m.c) + x.pt <- .95*m.e + y.pt <- ifelse(x.pt*wtp1&is.null(comparison)==FALSE&length(comparison)!=1) { + stopifnot(all(comparison %in% 1:he$n.comparisons)) + # adjusts bcea object for the correct number of dimensions and comparators + he$comp <- he$comp[comparison] + he$delta.e <- he$delta.e[,comparison] + he$delta.c <- he$delta.c[,comparison] + he$n.comparators=length(comparison)+1 + he$n.comparisons=length(comparison) + he$interventions=he$interventions[sort(c(he$ref,he$comp))] + he$ICER=he$ICER[comparison] + he$ib=he$ib[,,comparison] + he$eib=he$eib[,comparison] + he$U=he$U[,,sort(c(he$ref,comparison+1))] + he$ceac=he$ceac[,comparison] + he$ref=rank(c(he$ref,he$comp))[1] + he$comp=rank(c(he$ref,he$comp))[-1] + he$mod <- TRUE # + return(ceplane.plot(he,wtp=wtp,pos=alt.legend,graph="base",size=size,...)) + } + +} diff --git a/R/ceplane_plot_ggplot.R b/R/ceplane_plot_ggplot.R new file mode 100644 index 00000000..0e9712e7 --- /dev/null +++ b/R/ceplane_plot_ggplot.R @@ -0,0 +1,237 @@ + +ceplane_plot_ggplot <- function() { + + if(!isTRUE(requireNamespace("ggplot2",quietly=TRUE) & requireNamespace("grid",quietly=TRUE))){ + message("Falling back to base graphics\n") + ceplane.plot(he,comparison=comparison,wtp=wtp,pos=alt.legend,graph="base"); return(invisible(NULL)) + } + # no visible binding note + delta.e <- delta.c <- lambda.e <- lambda.c <- NULL + if (is.null(size)) + size <- ggplot2::rel(3.5) + label.pos <- TRUE + opt.theme <- ggplot2::theme() + if (!plot_aes$exist$ICER$sizes) + plot_aes$ICER$sizes <- ifelse(he$n.comparisons == 1, 2, 0) + if (length(exArgs) >= 1) { + if (exists("label.pos", where = exArgs)) + if (is.logical(exArgs$label.pos)) + label.pos <- exArgs$label.pos + for (obj in exArgs) + if (ggplot2::is.theme(obj)) + opt.theme <- opt.theme + obj + } + if (he$n.comparisons == 1) { + kd <- data.frame(he$delta.e,he$delta.c) + names(kd) <- c("delta.e","delta.c") + # for scale_x_continuous(oob=) + do.nothing=function(x,limits) return(x) + # plot limits + range.e <- range(kd$delta.e) + range.c <- range(kd$delta.c) + range.e[1] <- ifelse(range.e[1]<0,range.e[1],-range.e[1]) + range.c[1] <- ifelse(range.c[1]<0,range.c[1],-range.c[1]) + # ce plane data + x1 <- range.e[1]-2*abs(diff(range.e)) + x2 <- range.e[2]+2*abs(diff(range.e)) + x3 <- x2 + x <- c(x1,x2,x3) + y <- x*wtp; y[3] <- x1*wtp + plane <- data.frame(x=x,y=y) + # build a trapezoidal plane instead of a triangle if the y value is less than the minimum difference on costs + if(y[1]>1.2*range.c[1]) { + plane <- rbind(plane, + c(x2,2*range.c[1]), #new bottom-right vertex + c(x1,2*range.c[1])) #new bottom-left vertex + } + # actual plot + ceplane <- ggplot2::ggplot(kd, ggplot2::aes(delta.e,delta.c)) + + ggplot2::theme_bw() + + ggplot2::scale_x_continuous(limits=range.e,oob=do.nothing) + + ggplot2::scale_y_continuous(limits=range.c,oob=do.nothing) + + ggplot2::scale_color_manual( + "",labels=paste0("ICER = ",format(he$ICER,digits=6,nsmall=2)," "), + values = ifelse(!plot_aes$exist$ICER$colors, "red", plot_aes$ICER$colors[1])) + + ggplot2::geom_line( + data = plane[1:2,], ggplot2::aes(x = x, y = y), + color = ifelse(!plot_aes$exist$area$line_color, "black", plot_aes$area$line_color), + linetype = 1) + + ggplot2::geom_polygon( + data = plane,ggplot2::aes(x = x, y = y), + fill = ifelse(is.null(plot_aes$area$color), "light gray", plot_aes$area$color), + alpha = .3) + + ggplot2::geom_hline(ggplot2::aes(yintercept=0),colour="grey") + + ggplot2::geom_vline(ggplot2::aes(xintercept=0),colour="grey") + + ggplot2::geom_point( + size = ifelse(!plot_aes$exist$point$sizes, 1, plot_aes$point$sizes[1]), + colour = plot_aes$point$colors[1]) + + ggplot2::geom_point( + ggplot2::aes( + mean(delta.e),mean(delta.c), + color = as.factor(1)), + size = plot_aes$ICER$sizes[1]) + if(!label.pos) { + # moves the wtp label depending on whether the line crosses the y-axis + ceplane <- ceplane + + ggplot2::annotate( + geom = "text", + x = ifelse(range.c[1] / wtp > range.e[1], range.c[1] / wtp, range.e[1]), + y = range.c[1], + label = paste0("k = ", format(wtp, digits = 6)), + hjust = -.15, + size = size) + } + else{ + m.e <- ifelse(range.e[1]<0,range.e[1],-range.e[1]) + m.c <- ifelse(range.c[1]<0,range.c[1],-range.c[1]) + x.pt <- .95*m.e + y.pt <- ifelse(x.pt*wtp 1 & is.null(comparison)) { + # create dataframe for plotting + kd <- with(he,data.frame("delta.e" = c(delta.e), "delta.c" = c(delta.c))) + kd$comparison <- as.factor(sort(rep(1:he$n.comparisons,dim(he$delta.e)[1]))) + # dataset for ICERs + means <- matrix(NA_real_,nrow=he$n.comparisons,ncol=2) + for (i in 1:he$n.comparisons) + means[i,] <- colMeans(kd[kd$comparison == i, -3]) + means <- data.frame(means) + means$comparison <- factor(1:he$n.comparisons) + names(means) <- c("lambda.e","lambda.c","comparison") + # labels for legend + comparisons.label <- with(he,paste0(interventions[ref]," vs ",interventions[comp])) + # polygon + do.nothing = function(x,limits) return(x) + # plot limits + range.e <- range(kd$delta.e) + range.c <- range(kd$delta.c) + range.e[1] <- ifelse(range.e[1]<0,range.e[1],-range.e[1]) + range.c[1] <- ifelse(range.c[1]<0,range.c[1],-range.c[1]) + # ce plane data + x1 <- range.e[1]-2*abs(diff(range.e)) + x2 <- range.e[2]+2*abs(diff(range.e)) + x3 <- x2 + x <- c(x1,x2,x3) + y <- x*wtp; y[3] <- x1*wtp + plane <- data.frame(x=x,y=y,comparison=factor(rep(he$n.comparisons+1,3))) + # build a trapezoidal plane instead of a triangle if the y value is less than the minimum difference on costs + if(y[1]>min(kd$delta.c)) { + plane <- rbind(plane, + c(x2,2*min(kd$delta.c),he$n.comparisons+1), #new bottom-right vertex + c(x1,2*min(kd$delta.c),he$n.comparisons+1)) #new bottom-left vertex + } + ceplane <- + ggplot2::ggplot(kd,ggplot2::aes(x=delta.e,y=delta.c,col=comparison)) + + ggplot2::theme_bw() + + ggplot2::scale_color_manual( + labels = comparisons.label, + values = plot_aes$point$colors, + na.value = "black") + + ggplot2::scale_size_manual( + labels = comparisons.label, + values = if(!plot_aes$exist$point$sizes) + rep_len(1, length(comparisons.label)) else + rep_len(plot_aes$point$sizes, length(comparisons.label)), + na.value = 1) + + ggplot2::scale_x_continuous(limits=range.e,oob=do.nothing) + + ggplot2::scale_y_continuous(limits=range.c,oob=do.nothing) + + ggplot2::annotate( + "line", + x = plane[1:2,1], y = plane[1:2,2], + color = ifelse(!plot_aes$exist$area$line_color, "black", plot_aes$area$line_color)) + + ggplot2::annotate( + "polygon", + plane$x, plane$y, + fill = ifelse(is.null(plot_aes$area$color), "light gray", plot_aes$area$color), + alpha = .3) + + ggplot2::geom_hline(ggplot2::aes(yintercept=0),colour="grey") + ggplot2::geom_vline(ggplot2::aes(xintercept=0),colour="grey") + + ggplot2::geom_point( + ggplot2::aes(size = comparison)) + if (!all(plot_aes$ICER$sizes <= 0)) { + ceplane <- ceplane + + ggplot2::geom_point( + data = means, + ggplot2::aes(x = lambda.e, y = lambda.c), + colour = plot_aes$ICER$colors, + size = plot_aes$ICER$sizes) + } + # wtp label + if (!label.pos) { + ceplane <- ceplane + + ggplot2::annotate(geom="text", + x=ifelse(range.c[1]/wtp>range.e[1],range.c[1]/wtp,range.e[1]), + y=range.c[1], + label=paste0("k = ",format(wtp,digits=6)," "),hjust=.15,size=size + ) + } else { + m.e <- ifelse(range.e[1]<0,range.e[1],-range.e[1]) + m.c <- ifelse(range.c[1]<0,range.c[1],-range.c[1]) + x.pt <- .95*m.e + y.pt <- ifelse(x.pt*wtp 1 & is.null(comparison) == FALSE) { + # adjusts bcea object for the correct number of dimensions and comparators + he$comp <- he$comp[comparison] + he$delta.e <- he$delta.e[, comparison] + he$delta.c <- he$delta.c[, comparison] + he$n.comparators <- length(comparison) + 1 + he$n.comparisons <- length(comparison) + he$interventions <- he$interventions[sort(c(he$ref, he$comp))] + he$ICER <- he$ICER[comparison] + he$ib <- he$ib[, , comparison] + he$eib <- he$eib[, comparison] + he$U <- he$U[, , sort(c(he$ref, comparison + 1))] + he$ceac <- he$ceac[, comparison] + he$ref <- rank(c(he$ref, he$comp))[1] + he$comp <- rank(c(he$ref, he$comp))[-1] + he$mod <- TRUE # + return(ceplane.plot(he,wtp=wtp,pos=alt.legend,graph="ggplot2",size=size,...)) + } + ceplane <- ceplane + + ggplot2::labs( + title = plot_annotations$title, + x = plot_annotations$xlab, + y = plot_annotations$ylab) + jus <- NULL + if (isTRUE(alt.legend)) { + alt.legend="bottom" + ceplane <- ceplane + ggplot2::theme(legend.direction="vertical") + } else { + if (is.character(alt.legend)) { + choices <- c("left", "right", "bottom", "top") + alt.legend <- choices[pmatch(alt.legend,choices)] + jus="center" + if (is.na(alt.legend)) + alt.legend = FALSE + } + if (length(alt.legend) > 1) + jus <- alt.legend + if (length(alt.legend) == 1 & !is.character(alt.legend)) { + alt.legend <- c(1,1) + jus <- alt.legend + } + } + ceplane <- ceplane + + ggplot2::theme(legend.position=alt.legend,legend.justification=jus,legend.title=ggplot2::element_blank(),legend.background=ggplot2::element_blank()) + + ggplot2::theme(text=ggplot2::element_text(size=11),legend.key.size=grid::unit(.66,"lines"),legend.spacing=grid::unit(-1.25,"line"),panel.grid=ggplot2::element_blank(),legend.key=ggplot2::element_blank(),legend.text.align=0) + + ggplot2::theme(plot.title = ggplot2::element_text(lineheight=1.05, face="bold",size=14.3,hjust=0.5)) + if (he$n.comparisons == 1) + ceplane <- ceplane + ggplot2::theme(legend.key.size=grid::unit(.1,"lines")) + ceplane + opt.theme +} diff --git a/R/ceplane_plot_plotly.R b/R/ceplane_plot_plotly.R new file mode 100644 index 00000000..f023d105 --- /dev/null +++ b/R/ceplane_plot_plotly.R @@ -0,0 +1,173 @@ + +ceplane_plot_plotly <- function() { + + if (he$n.comparisons > 1 & !is.null(comparison)) { + # adjusts bcea object for the correct number of dimensions and comparators + he$comp <- he$comp[comparison] + he$delta.e <- he$delta.e[, comparison] + he$delta.c <- he$delta.c[, comparison] + he$n.comparators <- length(comparison) + 1 + he$n.comparisons <- length(comparison) + he$interventions <- he$interventions[sort(c(he$ref, he$comp))] + he$ICER <- he$ICER[comparison] + he$ib <- he$ib[, , comparison] + he$eib <- he$eib[, comparison] + he$U <- he$U[, , sort(c(he$ref, comparison + 1))] + he$ceac <- he$ceac[, comparison] + he$ref <- rank(c(he$ref, he$comp))[1] + he$comp <- rank(c(he$ref, he$comp))[-1] + he$mod <- TRUE # + return(ceplane.plot(he, wtp = wtp, pos = alt.legend, graph = "plotly", ...)) + } + if (exists("ICER.size", where = exArgs)) { + ICER.size <- exArgs$ICER.size + } else { + ICER.size <- ifelse(he$n.comparisons == 1, 8, 0) + } + # plot labels + comparisons.label <- with(he,paste0(interventions[ref]," vs ",interventions[comp])) + kd <- data.frame( + "delta.e" = c(he$delta.e), "delta.c" = c(he$delta.c), + "comparison" = as.factor(c( + sapply(1:he$n.comparisons, function(x) rep(x, nrow(as.matrix(he$delta.e)))) + )), + "label" = as.factor(c( + sapply(comparisons.label, function(x) rep(x, nrow(as.matrix(he$delta.e)))) + ))) + if (length(plot_aes$point$colors) != length(comparisons.label)) + plot_aes$point$colors <- rep_len(plot_aes$point$colors, length(comparisons.label)) + if (length(plot_aes$point$sizes) != length(comparisons.label)) + plot_aes$point$sizes <- rep_len(plot_aes$point$sizes, length(comparisons.label)) + if (length(plot_aes$ICER$colors) != length(comparisons.label)) + plot_aes$ICER$colors <- rep_len(plot_aes$ICER$colors, length(comparisons.label)) + if (length(plot_aes$ICER$sizes) != length(comparisons.label)) + plot_aes$ICER$sizes <- rep_len(plot_aes$ICER$sizes, length(comparisons.label)) + # plot limits + range.e <- range(kd$delta.e) + range.c <- range(kd$delta.c) + range.e[1] <- ifelse(range.e[1] < 0, range.e[1], -range.e[1]) + range.c[1] <- ifelse(range.c[1] < 0, range.c[1], -range.c[1]) + # ce plane data + x1 <- range.e[1] - 2*abs(diff(range.e)) + x2 <- range.e[2] + 2*abs(diff(range.e)) + x = c(x1, x2, x2) + y = c(x1*wtp, x2*wtp, x1*wtp) + plane <- data.frame(x = x, y = y) + # build a trapezoidal plane instead of a triangle if + # the y value is less than the minimum difference on costs + if (y[1] > 1.2*range.c[1]) + plane <- rbind(plane, + c(x2,2*range.c[1]), #new bottom-right vertex + c(x1,2*range.c[1])) #new bottom-left vertex + xrng = c(ifelse(prod(range.e) < 0, + range.e[1]*1.1, + ifelse(range.e[1] < 0, + range.e[1]*1.1, + -(range.e[2] - range.e[1])*0.1)), + ifelse(prod(range.e) < 0, range.e[2]*1.1, + ifelse(range.e[2] > 0, + range.e[2]*1.1, + (range.e[2] - range.e[1])*0.1))) + yrng = c(ifelse(prod(range.c) < 0, + range.c[1]*1.1, + ifelse(range.c[1] < 0, + range.c[1]*1.1, + -(range.c[2] - range.c[1])*0.1)), + ifelse(prod(range.c) < 0, + range.c[2]*1.1, + ifelse(range.c[2] > 0, + range.c[2]*1.1, + (range.c[2] - range.c[1])*0.1))) + # Calculates dataset for ICERs from bcea object + # @param he A BCEA object + # @param comparisons.label Optional vector of strings with comparison labels + # @return A data.frame object including mean outcomes, comparison identifier, + # comparison label and associated ICER + tabulate_means = function(he, comparisons.label = NULL) { + if (is.null(comparisons.label)) + comparisons.label <- 1:he$n.comparisons + data.frame( + "lambda.e" = sapply(1:he$n.comparisons, function(x) mean(as.matrix(he$delta.e)[,x])), + "lambda.c" = sapply(1:he$n.comparisons, function(x) mean(as.matrix(he$delta.c)[,x])), + "comparison" = as.factor(1:he$n.comparisons), + "label" = comparisons.label, + "ICER" = he$ICER + ) + } + # actual plot + ceplane <- plotly::plot_ly() + # CEA area + if (plot_aes$area$include) + ceplane <- plotly::add_trace( + ceplane, + type = "scatter", mode = "lines", + data = plane, + x = ~x, y = ~y, + fill = "tonext", + fillcolor = ifelse( + grepl(pattern = "^rgba\\(", x = plot_aes$area$color), + plot_aes$area$color, + plotly::toRGB(plot_aes$area$color, 0.5)), + line = list(color = ifelse( + grepl(pattern = "^rgba\\(", x = plot_aes$area$line_color), + plot_aes$area$line_color, + plotly::toRGB(plot_aes$area$line_color, 1))), + name = "CEA area") + # cloud + for (comp in 1:he$n.comparisons) { + ceplane <- plotly::add_trace( + ceplane, + type = "scatter", mode = "markers", + data = kd[kd$comparison == levels(kd$comparison)[comp],], + y = ~delta.c, + x = ~delta.e, + marker = list( + color = ifelse( + grepl(pattern = "^rgba\\(", x = plot_aes$point$colors[comp]), + plot_aes$point$colors[comp], + plotly::toRGB(plot_aes$point$colors[comp])), + size = plot_aes$point$sizes[comp] + ), + hoverinfo = "name+x+y", + name = ~label) + } + # ICER + if (!all(plot_aes$ICER$sizes <= 0)) { + means_table = tabulate_means(he, comparisons.label) + for (comp in 1:he$n.comparisons) { + ceplane <- plotly::add_trace( + ceplane, + type = "scatter", mode = "markers", + data = means_table[comp,], + x = ~lambda.e, + y = ~lambda.c, + marker = list( + color = plot_aes$ICER$colors[comp], + size = plot_aes$ICER$sizes[comp] + ), + name = ~paste( + ifelse(he$n.comparisons > 1, as.character(label), ""), + "ICER:", + prettyNum(round(ICER,2), big.mark = ",")) + ) + } + } + # layout + legend_list = list(orientation = "h", xanchor = "center", x = 0.5) + ceplane <- plotly::layout( + ceplane, + title = plot_annotations$title, + xaxis = list( + hoverformat = ".2f", range = xrng, + title = plot_annotations$xlab + ), + yaxis = list( + hoverformat = ".2f", range = yrng, + title = plot_annotations$ylab + ), + showlegend = TRUE, + legend = legend_list + ) + + plotly::config(ceplane, displayModeBar = FALSE) +} diff --git a/R/compute_IB.R b/R/compute_IB.R new file mode 100644 index 00000000..d6591f62 --- /dev/null +++ b/R/compute_IB.R @@ -0,0 +1,38 @@ + +#' Compute Incremental Benefit +#' +#' @param df_ce Dataframe of cost and effectiveness deltas +#' @param k Vector of willingness to pay values +#' +#' @import dplyr +#' +#' @return +#' @export +#' +#' @examples +#' +compute_IB <- function(df_ce, k) { + + df_ce <- + df_ce %>% + filter(ints != ref) %>% + rename(comps = ints) + + sims <- unique(df_ce$sim) + comps <- unique(df_ce$comps) + + ib_df <- + expand.grid(sim = sims, + k = k, + comps = comps) %>% + merge(df_ce) %>% + mutate(ib = k*delta_e - delta_c) %>% + arrange(comps, sim, k) + + array(ib_df$ib, + dim = c(length(k), + length(sims), + length(comps))) +} + + diff --git a/R/compute_ICER.R b/R/compute_ICER.R new file mode 100644 index 00000000..5f94dc2b --- /dev/null +++ b/R/compute_ICER.R @@ -0,0 +1,15 @@ + +# +compute_ICER <- function(df_ce) { + + df_ce %>% + filter(ints != ref) %>% + group_by(ints) %>% + summarise(ICER = mean(delta_c)/mean(delta_e)) %>% + ungroup() %>% + select(ICER) %>% # required to match current format + unlist() %>% + setNames(NULL) +} + + diff --git a/R/compute_xxx.R b/R/compute_xxx.R new file mode 100644 index 00000000..f87968d4 --- /dev/null +++ b/R/compute_xxx.R @@ -0,0 +1,139 @@ + +#' Compute kstar +#' +#' Find k when optimal decision changes. +#' +#' @param k +#' @param best +#' @param ref +#' +#' @return kstar +#' +compute_kstar <- function(k, best, ref) { + + if (all(best == ref)) { + return(NA) + } + + min(k[best != ref]) +} + + +# Compute Cost-Effectiveness Acceptability Curve +# +compute_CEAC <- function(ib) { + + apply(ib > 0, c(1,3), mean) +} + + +# Compute Expected Incremental Benefit +# +compute_EIB <- function(ib) { + + eib <- apply(ib, 3, function(x) apply(x, 1, mean)) + # eib <- apply(ib, 3, function(x) rowMeans(x)) ##TODO: test +} + + +#' Compute Ustar statistic +#' +#' @param n_sim +#' @param K +#' @param U +#' +#' @return Ustar +#' +compute_Ustar <- function(n_sim, K, U) { + + Ustar <- matrix(NA, n_sim, K) + + for (i in seq_len(K)) { + Ustar[, i] <- rowMax(U[, i, ]) + } + + Ustar +} + + +#' Compute Value of Information +#' +#' @param n_sim +#' @param K +#' @param Ustar +#' @param U +#' +#' @return vi +#' +compute_vi <- function(n_sim, + K, + Ustar, + U) { + + vi <- matrix(NA, n_sim, K) + + for (i in seq_len(K)) { + vi[, i] <- Ustar[, i] - max(apply(U[, i,], 2, mean)) + } + + vi +} + + +#' Compute ol +#' +#' @param n_sim +#' @param K +#' @param Ustar +#' @param U +#' @param best +#' +#' @return ol +#' +compute_ol <- function(n_sim, + K, + Ustar, + U, + best) { + + ol <- matrix(NA, n_sim, K) + + ##TODO: is there a clearer way of doing this? + for (i in seq_len(K)) { + cmd <- paste("ol[, i] <- Ustar[, i] - U[, i,", best[i], "]", sep = "") + eval(parse(text = cmd)) + } + + ol +} + + +# +rowMax <- function(dat) apply(dat, 1, max) + + +#' Compute U statistic +#' +#' @param df_ce +#' @param k Willingness to pay vector +#' +#' @return U +#' +compute_U <- function(df_ce, k) { + + sims <- sort(unique(df_ce$sim)) + ints <- sort(unique(df_ce$ints)) + + U_df <- + expand.grid(sim = sims, + k = k, + ints = ints) %>% + merge(df_ce) %>% + mutate(U = k*eff1 - cost1) %>% + arrange(ints, k, sim) + + array(U_df$U, + dim = c(length(sims), + length(k), + length(ints))) +} diff --git a/R/contour.bcea.R b/R/contour.bcea.R index 50b7f38f..5abd9a15 100644 --- a/R/contour.bcea.R +++ b/R/contour.bcea.R @@ -1,13 +1,11 @@ -## Contour plots for the cost-effectiveness plane - -#' Contour method for objects in the class \code{bcea} +#' Contour plots for the cost-effectiveness plane #' +#' Contour method for objects in the class \code{bcea}. #' Produces a scatterplot of the cost-effectiveness plane, with a contour-plot #' of the bivariate density of the differentials of cost (y-axis) and #' effectiveness (x-axis) #' -#' #' @param x A \code{bcea} object containing the results of the Bayesian #' modelling and the economic evaluation #' @param comparison In case of more than 2 interventions being analysed, @@ -55,20 +53,50 @@ #' Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, #' London #' @keywords Health economic evaluation Bayesian model -#' @export contour.bcea -contour.bcea <- function(x,comparison=1,scale=0.5,nlevels=4,levels=NULL,pos=c(1,0), - xlim=NULL,ylim=NULL,graph=c("base","ggplot2"),...) { - requireNamespace("MASS") - options(scipen=10) +#' @import MASS +#' +#' @export +#' +contour.bcea <- + function(x, + comparison = 1, + scale = 0.5, + nlevels = 4, + levels = NULL, + pos = c(1, 0), + xlim = NULL, + ylim = NULL, + graph = c("base", "ggplot2"), + ...) { + # comparison selects which plot should be made # by default it is the first possible # Additional/optional arguments - exArgs <- list(...) - if(!exists("xlab",where=exArgs)){xlab <- "Effectiveness differential"} else {xlab <- exArgs$xlab} - if(!exists("ylab",where=exArgs)){ylab <- "Cost differential"} else {ylab <- exArgs$ylab} - if(!exists("title",where=exArgs)){title <- paste("Cost effectiveness plane contour plot\n",x$interventions[x$ref]," vs ",x$interventions[x$comp],sep="")} - else {title <- exArgs$title} + exArgs <- list(...) + if (!exists("xlab", where = exArgs)) { + xlab <- "Effectiveness differential" + } else { + xlab <- exArgs$xlab + } + if (!exists("ylab", where = exArgs)) { + ylab <- "Cost differential" + } else { + ylab <- exArgs$ylab + } + if (!exists("title", where = exArgs)) { + title <- + paste( + "Cost effectiveness plane contour plot\n", + x$interventions[x$ref], + " vs ", + x$interventions[x$comp], + sep = "" + ) + } + else { + title <- exArgs$title + } alt.legend <- pos base.graphics <- ifelse(isTRUE(pmatch(graph,c("base","ggplot2"))==2),FALSE,TRUE) @@ -76,7 +104,8 @@ contour.bcea <- function(x,comparison=1,scale=0.5,nlevels=4,levels=NULL,pos=c(1, if(base.graphics){ if(is.null(comparison) | length(comparison) > 1){ - message("The first available comparison will be selected. To plot multiple comparisons together please use the ggplot2 version. Please see ?contour.bcea for additional details.") + message("The first available comparison will be selected. To plot multiple comparisons together please use the ggplot2 version. + Please see ?contour.bcea for additional details.") comparison <- 1 } diff --git a/R/contour2.R b/R/contour2.R index 03d161f9..dda35fc8 100644 --- a/R/contour2.R +++ b/R/contour2.R @@ -1,5 +1,3 @@ -##### - #' Specialised contour plot for objects in the class "bcea" #' @@ -55,20 +53,41 @@ #' contour2(m,wtp=200,ICER.size=2,graph="ggplot2") #' } #' -#' @export contour2 -contour2 <- function(he,wtp=25000,xlim=NULL,ylim=NULL,comparison=NULL,graph=c("base","ggplot2"),...) { - # Forces R to avoid scientific format for graphs labels - options(scipen=10) - +#' @export +#' +contour2 <- + function(he, + wtp = 25000, + xlim = NULL, + ylim = NULL, + comparison = NULL, + graph = c("base", "ggplot2"), + ...) { + # Additional/optional arguments - exArgs <- list(...) - if(!exists("xlab",where=exArgs)){xlab <- "Effectiveness differential"} else {xlab <- exArgs$xlab} - if(!exists("ylab",where=exArgs)){ylab <- "Cost differential"} else {ylab <- exArgs$ylab} - if(!exists("title",where=exArgs)){ - title <- paste("Cost effectiveness plane \n",he$interventions[he$ref]," vs ",he$interventions[he$comp],sep="")} - else {title <- exArgs$title - } - + exArgs <- list(...) + if (!exists("xlab", where = exArgs)) { + xlab <- "Effectiveness differential" + } else { + xlab <- exArgs$xlab + } + if (!exists("ylab", where = exArgs)) { + ylab <- "Cost differential" + } else { + ylab <- exArgs$ylab + } + if (!exists("title", where = exArgs)) { + title <- + paste("Cost effectiveness plane \n", + he$interventions[he$ref], + " vs ", + he$interventions[he$comp], + sep = "") + } + else { + title <- exArgs$title + } + base.graphics <- ifelse(isTRUE(pmatch(graph,c("base","ggplot2"))==2),FALSE,TRUE) if(base.graphics) { @@ -78,7 +97,8 @@ contour2 <- function(he,wtp=25000,xlim=NULL,ylim=NULL,comparison=NULL,graph=c("b # Selects the first comparison by default if not selected if(is.null(comparison)){ - message("The first available comparison will be selected. To plot multiple comparisons together please use the ggplot2 version. Please see ?contour2 for additional details.") + message("The first available comparison will be selected. + To plot multiple comparisons together please use the ggplot2 version. Please see ?contour2 for additional details.") comparison <- 1 } diff --git a/R/data.R b/R/data.R new file mode 100644 index 00000000..6a13ccd5 --- /dev/null +++ b/R/data.R @@ -0,0 +1,132 @@ + +#' Data set for the Bayesian model for the cost-effectiveness of smoking +#' cessation interventions +#' +#' This data set contains the results of the Bayesian analysis used to model +#' the clinical output and the costs associated with the health economic +#' evaluation of four different smoking cessation interventions. +#' +#' @name Smoking +#' @docType data +#' +#' @aliases Smoking data life.years pi smoking smoking_output +#' @format A data list including the variables needed for the smoking cessation +#' cost-effectiveness analysis. The variables are as follows: \describe{ +#' \item{list("c")}{a matrix of 500 simulations from the posterior distribution +#' of the overall costs associated with the four strategies} +#' \item{list("data")}{a dataset containing the characteristics of the smokers +#' in the UK population} \item{list("e")}{a matrix of 500 simulations from the +#' posterior distribution of the clinical benefits associated with the four +#' strategies} \item{list("life.years")}{a matrix of 500 simulations from the +#' posterior distribution of the life years gained with each strategy} +#' \item{list("pi")}{a matrix of 500 simulations from the posterior +#' distribution of the event of smoking cessation with each strategy} +#' \item{list("smoking")}{a data frame containing the inputs needed for the +#' network meta-analysis model. The \code{data.frame} object contains: +#' \code{nobs}: the record ID number, \code{s}: the study ID number, \code{i}: +#' the intervention ID number, \code{r_i}: the number of patients who quit +#' smoking, \code{n_i}: the total number of patients for the row-specific arm +#' and \code{b_i}: the reference intervention for each study} +#' \item{list("smoking_output")}{a \code{rjags} object obtained by running the +#' network meta-analysis model based on the data contained in the +#' \code{smoking} object} \item{list("smoking_mat")}{a matrix obtained by +#' running the network meta-analysis model based on the data contained in the +#' \code{smoking} object} \item{list("treats")}{a vector of labels associated +#' with the four strategies} } +#' @references Baio G. (2012). Bayesian Methods in Health Economics. +#' CRC/Chapman Hall, London +#' @source Effectiveness data adapted from Hasselblad V. (1998). Meta-analysis +#' of Multitreatment Studies. Medical Decision Making 1998;18:37-43. +#' +#' Cost and population characteristics data adapted from various sources: +#' \itemize{ \item Taylor, D.H. Jr, et al. (2002). Benefits of smoking +#' cessation on longevity. American Journal of Public Health 2002;92(6) \item +#' ASH: Action on Smoking and Health (2013). ASH fact sheet on smoking +#' statistics, \cr \code{http://ash.org.uk/files/documents/ASH_106.pdf} \item +#' Flack, S., et al. (2007). Cost-effectiveness of interventions for smoking +#' cessation. York Health Economics Consortium, January 2007 \item McGhan, +#' W.F.D., and Smith, M. (1996). Pharmacoeconomic analysis of smoking-cessation +#' interventions. American Journal of Health-System Pharmacy 1996;53:45-52 } +#' @keywords datasets +#' @examples +#' +#' data(Smoking) +#' +#' \donttest{ +#' m=bcea(e,c,ref=4,interventions=treats,Kmax=500) +#' } +#' +NULL + + + +#' Data set for the Bayesian model for the cost-effectiveness of influenza +#' vaccination +#' +#' This data set contains the results of the Bayesian analysis used to model +#' the clinical output and the costs associated with an influenza vaccination. +#' +#' @name Vaccine +#' @docType data +#' +#' @aliases Vaccine c cost.GP cost.hosp cost.otc cost.time.off cost.time.vac +#' cost.travel cost.trt1 cost.trt2 cost.vac e N N.outcomes N.resources +#' QALYs.adv QALYs.death QALYs.hosp QALYs.inf QALYs.pne treats vaccine +#' @format A data list including the variables needed for the influenza +#' vaccination. The variables are as follows: +#' +#' \describe{ \item{list("c")}{a matrix of simulations from the posterior +#' distribution of the overall costs associated with the two treatments} +#' \item{list("cost.GP")}{a matrix of simulations from the posterior +#' distribution of the costs for GP visits associated with the two treatments} +#' \item{list("cost.hosp")}{a matrix of simulations from the posterior +#' distribution of the costs for hospitalisations associated with the two +#' treatments} \item{list("cost.otc")}{a matrix of simulations from the +#' posterior distribution of the costs for over-the-counter medications +#' associated with the two treatments} \item{list("cost.time.off")}{a matrix of +#' simulations from the posterior distribution of the costs for time off work +#' associated with the two treatments} \item{list("cost.time.vac")}{a matrix of +#' simulations from the posterior distribution of the costs for time needed to +#' get the vaccination associated with the two treatments} +#' \item{list("cost.travel")}{a matrix of simulations from the posterior +#' distribution of the costs for travel to get vaccination associated with the +#' two treatments} \item{list("cost.trt1")}{a matrix of simulations from the +#' posterior distribution of the overall costs for first line of treatment +#' associated with the two interventions} \item{list("cost.trt2")}{a matrix of +#' simulations from the posterior distribution of the overall costs for second +#' line of treatment associated with the two interventions} +#' \item{list("cost.vac")}{a matrix of simulations from the posterior +#' distribution of the costs for vaccination} \item{list("e")}{a matrix of +#' simulations from the posterior distribution of the clinical benefits +#' associated with the two treatments} \item{list("N")}{the number of subjects +#' in the reference population} \item{list("N.outcomes")}{the number of +#' clinical outcomes analysed} \item{list("N.resources")}{the number of +#' health-care resources under study} \item{list("QALYs.adv")}{a vector from +#' the posterior distribution of the QALYs associated with advert events} +#' \item{list("QALYs.death")}{a vector from the posterior distribution of the +#' QALYs associated with death} \item{list("QALYs.hosp")}{a vector from the +#' posterior distribution of the QALYs associated with hospitalisation} +#' \item{list("QALYs.inf")}{a vector from the posterior distribution of the +#' QALYs associated with influenza infection} \item{list("QALYs.pne")}{a vector +#' from the posterior distribution of the QALYs associated with penumonia} +#' \item{list("treats")}{a vector of labels associated with the two treatments} +#' \item{list("vaccine")}{a \code{rjags} object containing the simulations for +#' the parameters used in the original model} \item{list("vaccine_mat")}{a +#' matrix containing the simulations for the parameters used in the original +#' model} } +#' @references Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity +#' Analysis in Health Economics. Statistical Methods in Medical Research +#' doi:10.1177/0962280211419832. +#' @source Adapted from Turner D, Wailoo A, Cooper N, Sutton A, Abrams K, +#' Nicholson K. The cost-effectiveness of influenza vaccination of healthy +#' adults 50-64 years of age. Vaccine. 2006;24:1035-1043. +#' @keywords datasets +#' @examples +#' +#' data(Vaccine) +#' +#' \donttest{ +#' m=bcea(e,c,ref=1,interventions=treats) +#' } +#' +NULL diff --git a/R/diag.evppi.R b/R/diag.evppi.R index 19b77fe4..9b59e449 100644 --- a/R/diag.evppi.R +++ b/R/diag.evppi.R @@ -1,31 +1,19 @@ -######diag.evppi################################################################################################ - -#' diag.evppi -#' -#' Performs diagnostic plots for the results of the EVPPI +#' Diagnostic plots for the results of the EVPPI #' -#' -#' @param x A \code{evppi} object obtained by running the function \code{evppi} -#' on a \code{bcea} model. -#' @param y A \code{bcea} object containing the results of the Bayesian -#' modelling and the economic evaluation. -#' @param diag The type of diagnostics to be performed. It can be the 'residual -#' plot' or the 'qqplot plot'. -#' @param int Specifies the interventions for which diagnostic tests should be -#' performed (if there are many options being compared) -#' @return The function produces either a residual plot comparing the fitted -#' values from the INLA-SPDE Gaussian Process regression to the residuals. This -#' is a scatter plot of residuals on the y axis and fitted values (estimated +#' The function produces either a residual plot comparing the fitted +#' values from the INLA-SPDE Gaussian Process regression to the residuals. +#' This is a scatter plot of residuals on the y axis and fitted values (estimated #' responses) on the x axis. The plot is used to detect non-linearity, unequal #' error variances, and outliers. A well-behaved residual plot supporting the #' appropriateness of the simple linear regression model has the following -#' characteristics: 1) The residuals bounce randomly around the 0 line. This -#' suggests that the assumption that the relationship is linear is reasonable. +#' characteristics: +#' 1) The residuals bounce randomly around the 0 line. This suggests that +#' the assumption that the relationship is linear is reasonable. #' 2) The residuals roughly form a horizontal band around the 0 line. This -#' suggests that the variances of the error terms are equal. 3) None of the -#' residual stands out from the basic random pattern of residuals. This -#' suggests that there are no outliers. +#' suggests that the variances of the error terms are equal. +#' 3) None of the residual stands out from the basic random pattern of residuals. +#' This suggests that there are no outliers. #' #' The second possible diagnostic is the qqplot for the fitted value. This is a #' graphical method for comparing the fitted values distributions with the @@ -34,7 +22,18 @@ #' (x,y) on the plot corresponds to one of the quantiles of the second #' distribution (y-coordinate) plotted against the same quantile of the first #' distribution (x-coordinate). If the two distributions being compared are -#' identical, the Q-Q plot follows the 45 degrees line. +#' identical, the Q-Q plot follows the 45 degrees line. +#' +#' @param evppi A \code{evppi} object obtained by running the function \code{evppi} +#' on a \code{bcea} model. +#' @param he A \code{bcea} object containing the results of the Bayesian +#' modelling and the economic evaluation. +#' @param plot_type The type of diagnostics to be performed. It can be the 'residual +#' plot' or the 'qqplot plot'. +#' @param interv Specifies the interventions for which diagnostic tests should be +#' performed (if there are many options being compared) +#' @return plot +#' #' @author Gianluca Baio, Anna Heath #' @seealso \code{\link{bcea}}, \code{\link{evppi}} #' @references Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity @@ -44,31 +43,77 @@ #' Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, #' London #' @keywords Health economic evaluation, Value of Information -#' @export diag.evppi -diag.evppi <- function(x,y,diag=c("residuals","qqplot"),int=1){ - # x = an evppi object - # y = a bcea object - # diag = the type of diagnostics required - # int = the comparison to be assessed (default determined by the BCEA object) - if (int>1 & dim(x$fitted.costs)[2]==1) {stop("There is only one comparison possible, so 'int' should be set to 1 (default)")} - res <- ifelse(isTRUE(pmatch(diag,c("residuals","qqplot"))==2),FALSE,TRUE) - if(res){ - op <- par(mfrow=c(1,2)) - n <- dim(x$fitted.costs)[1] - fitted <- x$fitted.costs[,int] - residual <- as.matrix(y$delta.c)[x$select,int]-fitted - plot(fitted,residual,xlab="Fitted values", - ylab="Residuals",main="Residual plot for costs",cex=.8);abline(h=0) - fitted <- x$fitted.effects[,int] - residual <- as.matrix(y$delta.e)[x$select,int]-fitted - plot(fitted,residual,xlab="Fitted values", - ylab="Residuals",main="Residual plot for effects",cex=.8);abline(h=0) - par(op) - }else{ - op <- par(mfrow=c(1,2)) - qqnorm(x$fitted.costs[,int],main="Normal Q-Q plot \n(costs)"); qqline(x$fitted.costs[,int]) - qqnorm(x$fitted.effects[,int],main="Normal Q-Q plot \n(effects)"); qqline(x$fitted.effects[,int]) - par(op) +#' +#' @export +#' +#' @examples +#' +diag.evppi <- function(evppi, + he, + plot_type = c("residuals", "qqplot"), + interv = 1) { + + if (interv > 1 && dim(evppi$fitted.costs)[2] == 1) { + stop("There is only one comparison possible, so 'interv' set to 1 (default)", call. = FALSE)} + + plot_type <- match.arg(plot_type) + is_residual <- pmatch(plot_type, c("residuals", "qqplot")) != 2 + + if (is_residual) { + evppi_residual_plot(evppi, he, interv) + } else { + evppi_qq_plot(evppi, he, interv) } +} + +# +evppi_residual_plot <- function(evppi, + he, + interv) { + + op <- par(mfrow = c(1, 2)) + + fitted <- list(cost = evppi$fitted.costs[, interv], + eff = evppi$fitted.effects[, interv]) + + residual <- list(cost = as.matrix(he$delta.c)[evppi$select, interv] - fitted$cost, + eff = as.matrix(he$delta.e)[evppi$select, interv] - fitted$eff) + cex <- 0.8 + + plot(fitted$cost, + residual$cost, + xlab = "Fitted values", + ylab = "Residuals", + main = "Residual plot for costs", + cex = cex) + abline(h = 0) + + plot(fitted$eff, + residual$eff, + xlab = "Fitted values", + ylab = "Residuals", + main = "Residual plot for effects", + cex = cex) + abline(h = 0) + + par(op) +} + +# +evppi_qq_plot <- function(evppi, + he, + interv) { + + op <- par(mfrow = c(1, 2)) + + fit_cost <- evppi$fitted.costs[, interv] + fit_eff <- evppi$fitted.effects[, interv] + + qqnorm(fit_cost, main = "Normal Q-Q plot \n(costs)") + qqline(fit_cost) + + qqnorm(fit_eff, main = "Normal Q-Q plot \n(effects)") + qqline(fit_eff) + par(op) } diff --git a/R/eib.plot.R b/R/eib.plot.R index 076e77bb..2f8d44ac 100644 --- a/R/eib.plot.R +++ b/R/eib.plot.R @@ -69,7 +69,6 @@ #' @export eib.plot eib.plot <- function(he,comparison=NULL,pos=c(1,0),size=NULL,plot.cri=NULL,graph=c("base","ggplot2","plotly"),...) { - options(scipen=10) alt.legend <- pos # choose graphical engine if (is.null(graph) || is.na(graph)) graph = "base" diff --git a/R/evi.plot.R b/R/evi.plot.R index 39745cff..fee35531 100644 --- a/R/evi.plot.R +++ b/R/evi.plot.R @@ -1,10 +1,8 @@ -# evi.plot ----- #' Expected Value of Information (EVI) plot #' #' Plots the Expected Value of Information (EVI) against the willingness to pay #' -#' #' @param he A \code{bcea} object containing the results of the Bayesian #' modelling and the economic evaluation. #' @param graph A string used to select the graphical engine to use for @@ -33,10 +31,11 @@ #' Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, #' London #' @keywords Health economic evaluation Expected value of information -#' @export evi.plot +#' @export +#' evi.plot <- function(he, graph = c("base","ggplot2","plotly"), ...) { - options(scipen = 10) - # choose graphical engine ----- + + # choose graphical engine ----- if (is.null(graph) || is.na(graph)) graph = "base" graph_choice <- pmatch(graph[1], c("base", "ggplot2", "plotly"), nomatch = 1) diff --git a/R/evppi.default.R b/R/evppi.default.R index a597b14a..f2d78ce0 100644 --- a/R/evppi.default.R +++ b/R/evppi.default.R @@ -1,361 +1,109 @@ -evppi.default<-function (parameter, input, he, N = NULL, plot = F, residuals = T,...) { +# +evppi.default <- function (parameter, + input, + he, + N = NULL, + plot = FALSE, + residuals = TRUE, ...) { + # This function has been completely changed and restructured to make it possible to change regression method. - # The method arguement can now be given as a list. The first element element in the list is a vector giving the + # The method argument can now be given as a list. The first element element in the list is a vector giving the # regression method for the effects. The second gives the regression method for the costs. The `method' argument # can also be given as before which then uses the same regression method for all curves. All other exArgs can be - # given as before. 'int.ord' can be updated using the list forumlation above to give the interactions for each - # different curve. The formula arguement for GAM can only be given once, either 'te()' or 's()+s()' as this is + # given as before. 'int.ord' can be updated using the list formulation above to give the interactions for each + # different curve. The formula argument for GAM can only be given once, either 'te()' or 's()+s()' as this is # for computational reasons rather than to aid fit. You can still plot the INLA mesh elements but not output the meshes. - + if (is.null(colnames(input))) { colnames(input) <- paste0("theta",1:dim(input)[2]) } if (class(parameter[1]) == "numeric" | class(parameter[1]) == "integer") { parameters = colnames(input)[parameter] - } - else { + } else { parameters = parameter for (i in 1:length(parameters)) { parameter[i] <- which(colnames(input) == parameters[i]) } - class(parameter)<-"numeric" + class(parameter) <- "numeric" } if (is.null(N)) { N <- he$n.sim } - + robust <- NULL exArgs <- list(...) - if (!exists("suppress.messages", where=exArgs)) { - suppress.messages=FALSE + + if (!exists("suppress.messages", where = exArgs)) { + suppress.messages = FALSE } else { - suppress.messages=exArgs$suppress.messages + suppress.messages = exArgs$suppress.messages } - + if (!exists("select", where=exArgs) & N == he$n.sim) { exArgs$select <- 1:he$n.sim } if (!exists("select", where=exArgs) & N < he$n.sim) { - exArgs$select <- sample(1:he$n.sim, size = N, replace = F) + exArgs$select <- sample(1:he$n.sim, size = N, replace = FALSE) } - inputs <- data.frame(input)[exArgs$select,] - - + inputs <- data.frame(input)[exArgs$select, ] + + # Sets default for method of calculation. If number of parameters <=4, then use GAM, if not defaults to INLA/SPDE if (length(parameter) <= 4 & !exists("method", where = exArgs)) { - exArgs$method <- list(rep("GAM",he$n.comparators-1),rep("GAM",he$n.comparators-1)) + + exArgs$method <- + list(rep("GAM", he$n.comparators - 1), + rep("GAM", he$n.comparators - 1)) } if (length(parameter) > 4 & !exists("method", where = exArgs)) { - exArgs$method <- list(rep("INLA",he$n.comparators-1),rep("INLA",he$n.comparators-1)) + + exArgs$method <- + list(rep("INLA", he$n.comparators - 1), + rep("INLA", he$n.comparators - 1)) } - if(class(exArgs$method)!="list"){ - if(exArgs$method=="sad"|exArgs$method=="so"){ + if (inherits(exArgs$method, "list")) { + if (exArgs$method == "sad" | exArgs$method == "so") { exArgs$method<-exArgs$method - } - else{ - if(length(exArgs$method)>1){ - exArgs$method <- list(exArgs$method,exArgs$method) + } else { + if (length(exArgs$method) > 1) { + exArgs$method <- list(exArgs$method, exArgs$method) } - if(length(exArgs$method)==1){ - exArgs$method <- list(rep(exArgs$method,he$n.comparators-1),rep(exArgs$method,he$n.comparators-1)) + if (length(exArgs$method) == 1) { + + exArgs$method <- + list(rep(exArgs$method, he$n.comparators - 1), + rep(exArgs$method, he$n.comparators - 1)) } } } - - if(class(exArgs$method)=="list"){ - if(length(exArgs$method[[1]])+length(exArgs$method[[2]])!=2*(he$n.comparators-1)){ - stop(paste("The argument 'method' must be a list of length 2 with",he$n.comparators-1,"elements each.")) + + if (class(exArgs$method) == "list") { + if (length(exArgs$method[[1]]) + length(exArgs$method[[2]]) != 2*(he$n.comparators - 1)) { + stop(paste("The argument 'method' must be a list of length 2 with", he$n.comparators - 1, "elements each.")) } } - - if(!exists("int.ord",where=exArgs)){ - exArgs$int.ord <- list(rep(1,he$n.comparators-1),rep(1,he$n.comparators-1)) - } - if(class(exArgs$int.ord)!="list"){ - exArgs$int.ord <- list(rep(exArgs$int.ord[1],he$n.comparators-1),rep(exArgs$int.ord[2],he$n.comparators-1)) - } - - prep.x<-function(he,select,k,l){ - if(k==1){ - x<-as.matrix(he$delta.e)[select,l] - } - if(k==2){ - x<-as.matrix(he$delta.c)[select,l] - } - return(x) + + if (!exists("int.ord", where = exArgs)) { + exArgs$int.ord <- + list(rep(1, he$n.comparators - 1), rep(1, he$n.comparators - 1)) } - - ###GAM Fitting - fit.gam <- function(parameter, inputs, x, form) { - tic <- proc.time() - N<-nrow(inputs) - p<-length(parameter) - model <- mgcv::gam(update(formula(x ~ .), - formula(paste(".~", form))), data = data.frame(inputs)) - hat <- model$fitted - formula <- form - fitted <- matrix(hat, nrow = N, ncol = p) - fit <- model - toc <- proc.time() - tic - time <- toc[3] - names(time) = "Time to fit GAM regression (seconds)" - list(fitted=hat,formula = formula, fit = model,time = time) + if (class(exArgs$int.ord) != "list") { + + exArgs$int.ord <- + list( + rep(exArgs$int.ord[1], he$n.comparators - 1), + rep(exArgs$int.ord[2], he$n.comparators - 1) + ) } - - ###GP Fitting - post.density <- function(hyperparams, parameter, x, input.matrix) { - dinvgamma <- function(x, alpha, beta) { - (beta^alpha)/gamma(alpha) * x^(-alpha - 1) * - exp(-beta/x) - } - N <- length(x) - p <- length(parameter) - H <- cbind(1, input.matrix) - q <- ncol(H) - a.sigma <- 0.001 - b.sigma <- 0.001 - a.nu <- 0.001 - b.nu <- 1 - delta <- exp(hyperparams)[1:p] - nu <- exp(hyperparams)[p + 1] - A <- exp(-(as.matrix(dist(t(t(input.matrix)/delta), - upper = TRUE, diag = TRUE))^2)) - Astar <- A + nu * diag(N) - T <- chol(Astar) - y <- backsolve(t(T),(x), upper.tri = FALSE) - x. <- backsolve(t(T), H, upper.tri = FALSE) - tHAstarinvH <- t(x.) %*% (x.) - betahat <- solve(tHAstarinvH) %*% t(x.) %*% y - residSS <- y %*% y - t(y) %*% x. %*% betahat - t(betahat) %*% - t(x.) %*% y + t(betahat) %*% tHAstarinvH %*% betahat - prior <- prod(dnorm(log(delta), 0, sqrt(1e+05))) * - dinvgamma(nu, a.nu, b.nu) - l <- -sum(log(diag(T))) - 1/2 * log(det(tHAstarinvH)) - - (N - q + 2 * a.sigma)/2 * log(residSS/2 + b.sigma) + - log(prior) - names(l) <- NULL - return(l) - } - estimate.hyperparameters <- function(x, input.matrix, parameter,n.sim) { - p <- length(parameter) - initial.values <- rep(0, p + 1) - repeat { - log.hyperparameters <- optim(initial.values, - fn = post.density,parameter=parameter, x = x[1:n.sim], - input.matrix = input.matrix[1:n.sim, ], - method = "Nelder-Mead", control = list(fnscale = -1, - maxit = 10000, trace = 0))$par - if (sum(abs(initial.values - log.hyperparameters)) < - 0.01) { - hyperparameters <- exp(log.hyperparameters) - break - } - initial.values <- log.hyperparameters - } - return(hyperparameters) - } - fit.gp <- function(parameter, inputs, x, n.sim) { - tic <- proc.time() - p <- length(parameter) - input.matrix <- as.matrix(inputs[, parameter, drop = FALSE]) - colmin <- apply(input.matrix, 2, min) - colmax <- apply(input.matrix, 2, max) - colrange <- colmax - colmin - input.matrix <- sweep(input.matrix, 2, colmin, "-") - input.matrix <- sweep(input.matrix, 2, colrange, - "/") - N <- nrow(input.matrix) - H <- cbind(1, input.matrix) - q <- ncol(H) - hyperparameters <- estimate.hyperparameters(x = x,input = input.matrix, parameter = parameter, n.sim = n.sim) - delta.hat <- hyperparameters[1:p] - nu.hat <- hyperparameters[p + 1] - A <- exp(-(as.matrix(dist(t(t(input.matrix)/delta.hat), - upper = TRUE, diag = TRUE))^2)) - Astar <- A + nu.hat * diag(N) - Astarinv <- chol2inv(chol(Astar)) - rm(Astar) - gc() - AstarinvY <- Astarinv %*% x - tHAstarinv <- t(H) %*% Astarinv - tHAHinv <- solve(tHAstarinv %*% H) - betahat <- tHAHinv %*% (tHAstarinv %*% x) - Hbetahat <- H %*% betahat - resid <- x - Hbetahat - fitted<- Hbetahat + A %*% (Astarinv %*% - resid) - AAstarinvH <- A %*% t(tHAstarinv) - sigmasqhat <- as.numeric(t(resid) %*% Astarinv %*% - resid)/(N - q - 2) - rm(A, Astarinv, AstarinvY, tHAstarinv, tHAHinv, - Hbetahat, resid, sigmasqhat) - gc() - toc <- proc.time() - tic - time <- toc[3] - names(time) = "Time to fit GP regression (seconds)" - list(fitted = fitted,time = time, fit=NULL,formula = NULL) - } - - ###INLA Fitting - make.proj <- function(parameter,inputs, x,k,l) { - tic <- proc.time() - scale<-8/(range(x)[2]-range(x)[1]) - scale.x <- scale*x -mean(scale*x) - bx<-ldr::bf(scale.x,case="poly",2) - fit1<-ldr::pfc(scale(inputs[,parameter]),scale.x,bx,structure="iso") - fit2<-ldr::pfc(scale(inputs[,parameter]),scale.x,bx,structure="aniso") - fit3<-ldr::pfc(scale(inputs[,parameter]),scale.x,bx,structure="unstr") - struc<-c("iso","aniso","unstr")[which(c(fit1$aic,fit2$aic,fit3$aic)==min(fit1$aic,fit2$aic,fit3$aic))] - AIC.deg<-array() - for(i in 2:7){ - bx<-ldr::bf(scale.x,case="poly",i) - fit<-ldr::pfc(scale(inputs[,parameter]),scale.x,bx,structure=struc) - AIC.deg[i]<-fit$aic} - deg<-which(AIC.deg==min(AIC.deg,na.rm=T)) - d<-min(dim(inputs[,parameter])[2],deg) - by<-ldr::bf(scale.x,case="poly",deg) - comp.d<-ldr::ldr(scale(inputs[,parameter]),scale.x,bx,structure=struc,model="pfc",numdir=d,numdir.test=T) - dim.d<-which(comp.d$aic==min(comp.d$aic))-1 - comp<-ldr::ldr(scale(inputs[,parameter]),scale.x,bx,structure=struc,model="pfc",numdir=2) - toc <- proc.time() - tic - time <- toc[3] - if(dim.d>2){ - cur<-c("effects","costs") - warning(paste("The dimension of the sufficient reduction for the incremental",cur[k],", column",l,", is",dim.d,". - Dimensions greater than 2 imply that the EVPPI approximation using INLA may be inaccurate. - Full residual checking using diag.evppi is required."))} - names(time) = "Time to fit find projections (seconds)" - list(data = comp$R, time = time,dim=dim.d) - } - plot.mesh <- function(mesh, data, plot) { - if (plot == TRUE || plot == T) { - cat("\n") - choice <- select.list(c("yes", "no"), title = "Would you like to save the graph?", - graphics = F) - if (choice == "yes") { - exts <- c("jpeg", "pdf", "bmp", "png", "tiff") - ext <- select.list(exts, title = "Please select file extension", - graphics = F) - name <- paste0(getwd(), "/mesh.", ext) - txt <- paste0(ext, "('", name, "')") - eval(parse(text = txt)) - plot(mesh) - points(data, col = "blue", pch = 19, cex = 0.8) - dev.off() - txt <- paste0("Graph saved as: ", name) - cat(txt) - cat("\n") - } - cat("\n") - plot(mesh) - points(data, col = "blue", pch = 19, cex = 0.8) - } - } - make.mesh <- function(data, convex.inner, convex.outer, - cutoff,max.edge) { - tic <- proc.time() - inner <- suppressMessages({ - INLA::inla.nonconvex.hull(data, convex = convex.inner) - }) - outer <- INLA::inla.nonconvex.hull(data, convex = convex.outer) - mesh <- INLA::inla.mesh.2d( - loc=data, boundary=list(inner,outer), - max.edge=c(max.edge,max.edge),cutoff=c(cutoff)) - toc <- proc.time() - tic - time <- toc[3] - names(time) = "Time to fit determine the mesh (seconds)" - list(mesh = mesh, pts = data, time = time) - } - fit.inla <- function(parameter, inputs, x, mesh, - data.scale, int.ord, convex.inner, convex.outer, - cutoff, max.edge,h.value,family) { - tic <- proc.time() - inputs.scale <- scale(inputs, apply(inputs, 2, mean), apply(inputs, 2, sd)) - scale<-8/(range(x)[2]-range(x)[1]) - scale.x <- scale*x -mean(scale*x) - A <- INLA::inla.spde.make.A(mesh = mesh, loc = data.scale, silent = 2L) - spde <- INLA::inla.spde2.matern(mesh = mesh, alpha = 2) - stk.real <- INLA::inla.stack(tag = "est", data = list(y=scale.x), A = list(A, 1), - effects = list(s = 1:spde$n.spde, - data.frame(b0 = 1, x = cbind(data.scale, inputs.scale)))) - data <- INLA::inla.stack.data(stk.real) - ctr.pred <- INLA::inla.stack.A(stk.real) - inp <- names(stk.real$effects$data)[parameter + 4] - form <- paste(inp, "+", sep = "", collapse = "") - formula <- paste("y~0+(", form, "+0)+b0+f(s,model=spde)", - sep = "", collapse = "") - if (int.ord[1] > 1) { - formula <- paste("y~0+(", form, "+0)^", int.ord[1], - "+b0+f(s,model=spde)", sep = "", collapse = "") - } - Result <- suppressMessages({ - INLA::inla(as.formula(formula), data = data, - family = family, control.predictor = list(A = ctr.pred,link = 1), - control.inla = list(h = h.value), - control.compute = list(config = T)) - }) - fitted <- (Result$summary.linear.predictor[1:length(x),"mean"]+mean(scale*x))/scale - fit <- Result - toc <- proc.time() - tic - time <- toc[3] - names(time) = "Time to fit INLA/SPDE (seconds)" - list(fitted = fitted, model = fit, time = time, formula = formula, - mesh = list(mesh = mesh, pts = data.scale)) - } - - compute.evppi <- function(he,fit.full) { - EVPPI <- array() - tic <- proc.time() - for (i in 1:length(he$k)) { - NB.k <- -(he$k[i]*fit.full[[1]]-fit.full[[2]]) - EVPPI[i] <- (mean(apply(NB.k, 1, max, na.rm = T)) - - max(apply(NB.k, 2, mean, na.rm = T))) - } - toc <- proc.time() - tic - time <- toc[3] - names(time) = "Time to compute the EVPPI (in seconds)" - list(EVPPI = EVPPI, time = time) - } - - prepare.output <- function(parameters, inputs) { - if (length(parameter) == 1) { - if (class(parameter) == "numeric") { - name = colnames(inputs)[parameter] - } - else { - name = parameter - } - } - else { - if (class(parameter) == "numeric") { - n.param <- length(parameter) - end <- colnames(input)[parameter[n.param]] - name.mid <- paste(colnames(inputs)[parameter[1:n.param - - 1]], ", ", sep = "", collapse = " ") - name <- paste(name.mid, "and ", end, sep = "", - collapse = " ") - } - else { - n.param <- length(parameter) - end <- parameter[n.param] - name.mid <- paste(parameter[1:n.param - 1], - ", ", sep = "", collapse = " ") - name <- paste(name.mid, "and ", end, sep = "", - collapse = " ") - } - } - return(name) - } - - if(class(exArgs$method)!="list"){ - if (exArgs$method == "sal"||exArgs$method=="sad") { - method = "Sadatsafavi et al" - n.blocks = NULL + + if (class(exArgs$method) != "list") { + if (exArgs$method == "sal" || exArgs$method == "sad") { + method <- "Sadatsafavi et al" + n.blocks <- NULL if (!exists("n.seps", where = exArgs)) { n.seps <- 1 - } - else { + } else { n.seps <- exArgs$n.seps } if (length(parameters) == 1) { @@ -557,7 +305,7 @@ evppi.default<-function (parameter, input, he, N = NULL, plot = F, residuals = T } names(res) <- parameters } - + res <- list(evppi = res, index = parameters, parameters = parameters, k = he$k, evi = he$evi, method = method) } @@ -589,7 +337,7 @@ evppi.default<-function (parameter, input, he, N = NULL, plot = F, residuals = T mean.k <- apply(U.array, c(2, 3), mean) partial.info <- mean(apply(mean.k, 1, max)) res[i] <- partial.info - max(apply(he$U[, i, - ], 2, mean)) + ], 2, mean)) } } if (length(parameter) > 1) { @@ -612,23 +360,37 @@ evppi.default<-function (parameter, input, he, N = NULL, plot = F, residuals = T } names(res) <- parameters } - + res <- list(evppi = res, index = parameters, parameters = parameters, k = he$k, evi = he$evi, method = method) } } - if(class(exArgs$method)=="list"){ - time<-list() - time[[1]]<-list() - time[[2]]<-list() - - fit.full<-list() - fit.full[[1]]<-matrix(data=0,nrow=length(exArgs$select),ncol=he$n.comparators) - fit.full[[2]]<-matrix(data=0,nrow=length(exArgs$select),ncol=he$n.comparators) - for(k in 1:2){ - for(l in 1:he$n.comparisons){ - x<-prep.x(he=he,select=exArgs$select,k=k,l=l) - method<-exArgs$method[[k]][l] + + if (class(exArgs$method) == "list") { + time <- list() + time[[1]] <- list() + time[[2]] <- list() + + fit.full <- vector("list") + fit.full[[1]] <- matrix( + data = 0, + nrow = length(exArgs$select), + ncol = he$n.comparators + ) + fit.full[[2]] <- matrix( + data = 0, + nrow = length(exArgs$select), + ncol = he$n.comparators + ) + for (k in 1:2) { + for (l in 1:he$n.comparisons) { + x <- prep.x( + he = he, + select = exArgs$select, + k = k, + l = l + ) + method <- exArgs$method[[k]][l] if (method == "GAM" || method == "gam" || method == "G" || method == "g") { method <- "GAM" @@ -637,30 +399,31 @@ evppi.default<-function (parameter, input, he, N = NULL, plot = F, residuals = T stop("You need to install the package 'mgcv'. Please run in your R terminal:\n install.packages('mgcv')") } if (isTRUE(requireNamespace("mgcv", quietly = TRUE))) { - if(suppress.messages==FALSE) { - cat("\n") - cat("Calculating fitted values for the GAM regression \n") + if (suppress.messages == FALSE) { + cat("\n") + cat("Calculating fitted values for the GAM regression \n") } - + inp <- names(inputs)[parameter] if (exists("formula", where = exArgs)) { form <- exArgs$formula - } - else { + } else { form <- paste("te(", paste(inp, ",", sep = "", collapse = ""), "bs='cr')") } - fit <- fit.gam(parameter = parameter, inputs = inputs, - x = x, form = form) + fit <- fit.gam(parameter = parameter, + inputs = inputs, + x = x, + form = form) } } if (method == "gp" || method == "GP") { method <- "GP" mesh <- robust <- NULL - if(suppress.messages==FALSE) { - cat("\n") - cat("Calculating fitted values for the GP regression \n") - # If the number of simulations to be used to estimate the hyperparameters is set then use that, else use N/2 + if(suppress.messages == FALSE) { + cat("\n") + cat("Calculating fitted values for the GP regression \n") + # If the number of simulations to be used to estimate the hyperparameters is set then use that, else use N/2 } if (!exists("n.sim", where = exArgs)) { n.sim = N/2 @@ -668,7 +431,10 @@ evppi.default<-function (parameter, input, he, N = NULL, plot = F, residuals = T else { n.sim = exArgs$n.sim } - fit <- fit.gp(parameter = parameter, inputs = inputs, x = x, n.sim = n.sim) + fit <- fit.gp(parameter = parameter, + inputs = inputs, + x = x, + n.sim = n.sim) } if (method == "INLA") { method <- "INLA" @@ -679,37 +445,37 @@ evppi.default<-function (parameter, input, he, N = NULL, plot = F, residuals = T stop("You need to install the package 'ldr'. Please run in your R terminal:\n install.packages('ldr')") } if (isTRUE(requireNamespace("ldr", quietly = TRUE))) { - + if (isTRUE(requireNamespace("INLA", quietly = TRUE))) { if (!is.element("INLA", (.packages()))) { attachNamespace("INLA") } - if(length(parameter)<2){ + if (length(parameter) < 2) { stop("The INLA method can only be used with 2 or more parameters") } - if(suppress.messages==FALSE) { - cat("\n") - cat("Finding projections \n") + if (!suppress.messages) { + cat("\n") + cat("Finding projections \n") } projections <- make.proj(parameter=parameter,inputs = inputs,x=x,k=k,l=l) data <- projections$data - if(suppress.messages==FALSE) { - cat("Determining Mesh \n") + if (!suppress.messages) { + cat("Determining Mesh \n") } if (!exists("cutoff", where = exArgs)) { - cutoff = 0.3 + cutoff <- 0.3 } else { cutoff = exArgs$cutoff } if (!exists("convex.inner", where = exArgs)) { - convex.inner = -0.4 + convex.inner <- -0.4 } else { - convex.inner = exArgs$convex.inner + convex.inner <- exArgs$convex.inner } if (!exists("convex.outer", where = exArgs)) { - convex.outer = -0.7 + convex.outer <- -0.7 } else { convex.outer = exArgs$convex.outer @@ -718,49 +484,65 @@ evppi.default<-function (parameter, input, he, N = NULL, plot = F, residuals = T max.edge = 0.7 } else { - max.edge = exArgs$max.edge + max.edge <- exArgs$max.edge } - mesh <- make.mesh(data = data, convex.inner = convex.inner, - convex.outer = convex.outer, cutoff = cutoff,max.edge=max.edge) - plot.mesh(mesh = mesh$mesh, data = data, + mesh <- + make.mesh( + data = data, + convex.inner = convex.inner, + convex.outer = convex.outer, + cutoff = cutoff, + max.edge = max.edge + ) + plot.mesh(mesh = mesh$mesh, + data = data, plot = plot) - if(suppress.messages==FALSE) { - cat("Calculating fitted values for the GP regression using INLA/SPDE \n") + if(!suppress.messages) { + cat("Calculating fitted values for the GP regression using INLA/SPDE \n") } if (exists("h.value", where = exArgs)) { - h.value = exArgs$h.value + h.value <- exArgs$h.value } else { - h.value = 5e-05 + h.value <- 5e-05 } if (exists("robust", where = exArgs)) { if (exArgs$robust == TRUE) { - family = "T" - robust = TRUE + family <- "T" + robust <- TRUE } else { - family = "gaussian" - robust = FALSE + family <- "gaussian" + robust <- FALSE } - } - else { - family = "gaussian" - robust = FALSE + } else { + family <- "gaussian" + robust <- FALSE } if (exists("int.ord", where = exArgs)) { - int.ord = exArgs$int.ord[[k]][l] + int.ord <- exArgs$int.ord[[k]][l] } else { - int.ord = 1 + int.ord <- 1 } - fit <- fit.inla(parameter = parameter, inputs = inputs, - x = x, mesh = mesh$mesh, data.scale = data, int.ord = int.ord, - convex.inner = convex.inner, convex.outer = convex.outer, - cutoff = cutoff, max.edge = max.edge, h.value = h.value,family=family) + fit <- fit.inla( + parameter = parameter, + inputs = inputs, + x = x, + mesh = mesh$mesh, + data.scale = data, + int.ord = int.ord, + convex.inner = convex.inner, + convex.outer = convex.outer, + cutoff = cutoff, + max.edge = max.edge, + h.value = h.value, + family = family + ) } } } - fit.full[[k]][,l]<-fit$fitted + fit.full[[k]][,l] <- fit$fitted ###Calculating Time Taken if (method == "INLA") { time. <- c(projections$time, mesh$time, fit$time) @@ -773,26 +555,41 @@ evppi.default<-function (parameter, input, he, N = NULL, plot = F, residuals = T } } } - if(suppress.messages==FALSE) {cat("Calculating EVPPI \n")} + if (!suppress.messages) {cat("Calculating EVPPI \n")} + comp <- compute.evppi(he = he, fit.full = fit.full) - name <- prepare.output(parameter=parameters, inputs=inputs) - time[[3]]<-comp$time - names(time)<-c("Fitting for Effects","Fitting for Costs","Calculating EVPPI") - names(exArgs$method)<-c("Methods for Effects","Methods for Costs") - - if (residuals == TRUE || residuals == T) { - res <- list(evppi = comp$EVPPI, index = parameters, - k = he$k, evi = he$evi, parameters = name, time = time, - method = exArgs$method, fitted.costs = fit.full[[2]], - fitted.effects = fit.full[[1]],select=exArgs$select) + name <- prepare.output(parameter = parameters, inputs = inputs) + time[[3]] <- comp$time + names(time) <- c("Fitting for Effects", + "Fitting for Costs", + "Calculating EVPPI") + names(exArgs$method) <- c("Methods for Effects", "Methods for Costs") + + if (residuals) { + res <- list( + evppi = comp$EVPPI, + index = parameters, + k = he$k, + evi = he$evi, + parameters = name, + time = time, + method = exArgs$method, + fitted.costs = fit.full[[2]], + fitted.effects = fit.full[[1]], + select = exArgs$select + ) + } else { + res <- list( + evppi = comp$EVPPI, + index = parameters, + k = he$k, + evi = he$evi, + parameters = name, + time = time, + method = exArgs$method + ) } - else { - res <- list(evppi = comp$EVPPI, index = parameters, - k = he$k, evi = he$evi, parameters = name, time = time, method = exArgs$method) - } - - } - - class(res) <- "evppi" - return(res) } + + structure(res, class = "evppi") +} diff --git a/R/evppi_helpers.R b/R/evppi_helpers.R new file mode 100644 index 00000000..cfe23a17 --- /dev/null +++ b/R/evppi_helpers.R @@ -0,0 +1,276 @@ + +# evppi() helper functions +# + + +prep.x <- function(he,select,k,l){ + if (k == 1) { + x <- as.matrix(he$delta.e)[select, l] + } + if (k == 2) { + x <- as.matrix(he$delta.c)[select, l] + } + return(x) +} + +###GAM Fitting +fit.gam <- function(parameter, inputs, x, form) { + tic <- proc.time() + N<-nrow(inputs) + p<-length(parameter) + model <- mgcv::gam(update(formula(x ~ .), + formula(paste(".~", form))), data = data.frame(inputs)) + hat <- model$fitted + formula <- form + fitted <- matrix(hat, nrow = N, ncol = p) + fit <- model + toc <- proc.time() - tic + time <- toc[3] + names(time) = "Time to fit GAM regression (seconds)" + list(fitted=hat,formula = formula, fit = model,time = time) +} + +###GP Fitting +post.density <- function(hyperparams, parameter, x, input.matrix) { + dinvgamma <- function(x, alpha, beta) { + (beta^alpha)/gamma(alpha) * x^(-alpha - 1) * + exp(-beta/x) + } + N <- length(x) + p <- length(parameter) + H <- cbind(1, input.matrix) + q <- ncol(H) + a.sigma <- 0.001 + b.sigma <- 0.001 + a.nu <- 0.001 + b.nu <- 1 + delta <- exp(hyperparams)[1:p] + nu <- exp(hyperparams)[p + 1] + A <- exp(-(as.matrix(dist(t(t(input.matrix)/delta), + upper = TRUE, diag = TRUE))^2)) + Astar <- A + nu * diag(N) + T <- chol(Astar) + y <- backsolve(t(T),(x), upper.tri = FALSE) + x. <- backsolve(t(T), H, upper.tri = FALSE) + tHAstarinvH <- t(x.) %*% (x.) + betahat <- solve(tHAstarinvH) %*% t(x.) %*% y + residSS <- y %*% y - t(y) %*% x. %*% betahat - t(betahat) %*% + t(x.) %*% y + t(betahat) %*% tHAstarinvH %*% betahat + prior <- prod(dnorm(log(delta), 0, sqrt(1e+05))) * + dinvgamma(nu, a.nu, b.nu) + l <- -sum(log(diag(T))) - 1/2 * log(det(tHAstarinvH)) - + (N - q + 2 * a.sigma)/2 * log(residSS/2 + b.sigma) + + log(prior) + names(l) <- NULL + return(l) +} +estimate.hyperparameters <- function(x, input.matrix, parameter,n.sim) { + p <- length(parameter) + initial.values <- rep(0, p + 1) + repeat { + log.hyperparameters <- optim(initial.values, + fn = post.density,parameter=parameter, x = x[1:n.sim], + input.matrix = input.matrix[1:n.sim, ], + method = "Nelder-Mead", control = list(fnscale = -1, + maxit = 10000, trace = 0))$par + if (sum(abs(initial.values - log.hyperparameters)) < + 0.01) { + hyperparameters <- exp(log.hyperparameters) + break + } + initial.values <- log.hyperparameters + } + return(hyperparameters) +} +fit.gp <- function(parameter, inputs, x, n.sim) { + tic <- proc.time() + p <- length(parameter) + input.matrix <- as.matrix(inputs[, parameter, drop = FALSE]) + colmin <- apply(input.matrix, 2, min) + colmax <- apply(input.matrix, 2, max) + colrange <- colmax - colmin + input.matrix <- sweep(input.matrix, 2, colmin, "-") + input.matrix <- sweep(input.matrix, 2, colrange, + "/") + N <- nrow(input.matrix) + H <- cbind(1, input.matrix) + q <- ncol(H) + hyperparameters <- estimate.hyperparameters(x = x,input = input.matrix, parameter = parameter, n.sim = n.sim) + delta.hat <- hyperparameters[1:p] + nu.hat <- hyperparameters[p + 1] + A <- exp(-(as.matrix(dist(t(t(input.matrix)/delta.hat), + upper = TRUE, diag = TRUE))^2)) + Astar <- A + nu.hat * diag(N) + Astarinv <- chol2inv(chol(Astar)) + rm(Astar) + gc() + AstarinvY <- Astarinv %*% x + tHAstarinv <- t(H) %*% Astarinv + tHAHinv <- solve(tHAstarinv %*% H) + betahat <- tHAHinv %*% (tHAstarinv %*% x) + Hbetahat <- H %*% betahat + resid <- x - Hbetahat + fitted<- Hbetahat + A %*% (Astarinv %*% + resid) + AAstarinvH <- A %*% t(tHAstarinv) + sigmasqhat <- as.numeric(t(resid) %*% Astarinv %*% + resid)/(N - q - 2) + rm(A, Astarinv, AstarinvY, tHAstarinv, tHAHinv, + Hbetahat, resid, sigmasqhat) + gc() + toc <- proc.time() - tic + time <- toc[3] + names(time) = "Time to fit GP regression (seconds)" + list(fitted = fitted,time = time, fit=NULL,formula = NULL) +} + +###INLA Fitting +make.proj <- function(parameter,inputs, x,k,l) { + tic <- proc.time() + scale<-8/(range(x)[2]-range(x)[1]) + scale.x <- scale*x -mean(scale*x) + bx<-ldr::bf(scale.x,case="poly",2) + fit1<-ldr::pfc(scale(inputs[,parameter]),scale.x,bx,structure="iso") + fit2<-ldr::pfc(scale(inputs[,parameter]),scale.x,bx,structure="aniso") + fit3<-ldr::pfc(scale(inputs[,parameter]),scale.x,bx,structure="unstr") + struc<-c("iso","aniso","unstr")[which(c(fit1$aic,fit2$aic,fit3$aic)==min(fit1$aic,fit2$aic,fit3$aic))] + AIC.deg<-array() + for(i in 2:7){ + bx<-ldr::bf(scale.x,case="poly",i) + fit<-ldr::pfc(scale(inputs[,parameter]),scale.x,bx,structure=struc) + AIC.deg[i]<-fit$aic} + deg<-which(AIC.deg==min(AIC.deg,na.rm=T)) + d<-min(dim(inputs[,parameter])[2],deg) + by<-ldr::bf(scale.x,case="poly",deg) + comp.d<-ldr::ldr(scale(inputs[,parameter]),scale.x,bx,structure=struc,model="pfc",numdir=d,numdir.test=T) + dim.d<-which(comp.d$aic==min(comp.d$aic))-1 + comp<-ldr::ldr(scale(inputs[,parameter]),scale.x,bx,structure=struc,model="pfc",numdir=2) + toc <- proc.time() - tic + time <- toc[3] + if(dim.d>2){ + cur<-c("effects","costs") + warning(paste("The dimension of the sufficient reduction for the incremental",cur[k],", column",l,", is",dim.d,". + Dimensions greater than 2 imply that the EVPPI approximation using INLA may be inaccurate. + Full residual checking using diag.evppi is required."))} + names(time) = "Time to fit find projections (seconds)" + list(data = comp$R, time = time,dim=dim.d) +} +plot.mesh <- function(mesh, data, plot) { + if (plot == TRUE || plot == T) { + cat("\n") + choice <- select.list(c("yes", "no"), title = "Would you like to save the graph?", + graphics = F) + if (choice == "yes") { + exts <- c("jpeg", "pdf", "bmp", "png", "tiff") + ext <- select.list(exts, title = "Please select file extension", + graphics = F) + name <- paste0(getwd(), "/mesh.", ext) + txt <- paste0(ext, "('", name, "')") + eval(parse(text = txt)) + plot(mesh) + points(data, col = "blue", pch = 19, cex = 0.8) + dev.off() + txt <- paste0("Graph saved as: ", name) + cat(txt) + cat("\n") + } + cat("\n") + plot(mesh) + points(data, col = "blue", pch = 19, cex = 0.8) + } +} +make.mesh <- function(data, convex.inner, convex.outer, + cutoff,max.edge) { + tic <- proc.time() + inner <- suppressMessages({ + INLA::inla.nonconvex.hull(data, convex = convex.inner) + }) + outer <- INLA::inla.nonconvex.hull(data, convex = convex.outer) + mesh <- INLA::inla.mesh.2d( + loc=data, boundary=list(inner,outer), + max.edge=c(max.edge,max.edge),cutoff=c(cutoff)) + toc <- proc.time() - tic + time <- toc[3] + names(time) = "Time to fit determine the mesh (seconds)" + list(mesh = mesh, pts = data, time = time) +} +fit.inla <- function(parameter, inputs, x, mesh, + data.scale, int.ord, convex.inner, convex.outer, + cutoff, max.edge,h.value,family) { + tic <- proc.time() + inputs.scale <- scale(inputs, apply(inputs, 2, mean), apply(inputs, 2, sd)) + scale<-8/(range(x)[2]-range(x)[1]) + scale.x <- scale*x -mean(scale*x) + A <- INLA::inla.spde.make.A(mesh = mesh, loc = data.scale, silent = 2L) + spde <- INLA::inla.spde2.matern(mesh = mesh, alpha = 2) + stk.real <- INLA::inla.stack(tag = "est", data = list(y=scale.x), A = list(A, 1), + effects = list(s = 1:spde$n.spde, + data.frame(b0 = 1, x = cbind(data.scale, inputs.scale)))) + data <- INLA::inla.stack.data(stk.real) + ctr.pred <- INLA::inla.stack.A(stk.real) + inp <- names(stk.real$effects$data)[parameter + 4] + form <- paste(inp, "+", sep = "", collapse = "") + formula <- paste("y~0+(", form, "+0)+b0+f(s,model=spde)", + sep = "", collapse = "") + if (int.ord[1] > 1) { + formula <- paste("y~0+(", form, "+0)^", int.ord[1], + "+b0+f(s,model=spde)", sep = "", collapse = "") + } + Result <- suppressMessages({ + INLA::inla(as.formula(formula), data = data, + family = family, control.predictor = list(A = ctr.pred,link = 1), + control.inla = list(h = h.value), + control.compute = list(config = T)) + }) + fitted <- (Result$summary.linear.predictor[1:length(x),"mean"]+mean(scale*x))/scale + fit <- Result + toc <- proc.time() - tic + time <- toc[3] + names(time) = "Time to fit INLA/SPDE (seconds)" + list(fitted = fitted, model = fit, time = time, formula = formula, + mesh = list(mesh = mesh, pts = data.scale)) +} + +compute.evppi <- function(he,fit.full) { + EVPPI <- array() + tic <- proc.time() + for (i in 1:length(he$k)) { + NB.k <- -(he$k[i]*fit.full[[1]]-fit.full[[2]]) + EVPPI[i] <- (mean(apply(NB.k, 1, max, na.rm = T)) - + max(apply(NB.k, 2, mean, na.rm = T))) + } + toc <- proc.time() - tic + time <- toc[3] + names(time) = "Time to compute the EVPPI (in seconds)" + list(EVPPI = EVPPI, time = time) +} + +prepare.output <- function(parameters, inputs) { + if (length(parameter) == 1) { + if (class(parameter) == "numeric") { + name = colnames(inputs)[parameter] + } + else { + name = parameter + } + } + else { + if (class(parameter) == "numeric") { + n.param <- length(parameter) + end <- colnames(input)[parameter[n.param]] + name.mid <- paste(colnames(inputs)[parameter[1:n.param - + 1]], ", ", sep = "", collapse = " ") + name <- paste(name.mid, "and ", end, sep = "", + collapse = " ") + } + else { + n.param <- length(parameter) + end <- parameter[n.param] + name.mid <- paste(parameter[1:n.param - 1], + ", ", sep = "", collapse = " ") + name <- paste(name.mid, "and ", end, sep = "", + collapse = " ") + } + } + return(name) +} diff --git a/R/filter_by.R b/R/filter_by.R new file mode 100644 index 00000000..a7b0f17b --- /dev/null +++ b/R/filter_by.R @@ -0,0 +1,23 @@ + +# helper functions so don't have to remember +# which dimension for which statistic + +Ustar_filter_by <- function(he, wtp) { + he$Ustar[, he$k == wtp] +} + +U_filter_by <- function(he, wtp) { + he$U[, he$k == wtp, ] +} + +ib_filter_by <- function(he, wtp) { + he$ib[he$k == wtp, , ] +} + +ol_filter_by <- function(he, wtp) { + he$ol[, he$k == wtp] +} + +vi_filter_by <- function(he, wtp) { + he$vi[, he$k == wtp] +} \ No newline at end of file diff --git a/R/helper_base_params.R b/R/helper_base_params.R new file mode 100644 index 00000000..d639b94c --- /dev/null +++ b/R/helper_base_params.R @@ -0,0 +1,59 @@ + +#' @keywords dplot +helper_base_params <- function(he, + graph_params) { + + n_lines <- + if (inherits(he, "pairwise")) { + he$n_comparators + } else { + he$n_comparisons} + + if (n_lines == 1) { + + default_params <- list(plot = + list(lwd = 1, + line = + list(types = 1))) + + graph_params <- modifyList(default_params, graph_params) + } + + if (n_lines > 1) { + + default_params <- + list(plot = + list(lwd = ifelse(n_lines <= 6, 1, 1.5), + line = + list(types = rep_len(1:6, n_lines), + colors = colors()[floor(seq(262, 340, + length.out = n_lines))]) + )) + + graph_params <- modifyList(default_params, graph_params) + + types <- graph_params$plot$line$types + cols <- graph_params$plot$line$colors + + is_enough_types <- length(types) >= n_lines + is_enough_colours <- length(cols) >= n_lines + + if (!is_enough_types) { + graph_params$plot$line$types <- rep_len(types, n_lines) + message("Wrong number of line types provided. Falling back to default\n")} + + if (!is_enough_colours) { + graph_params$plot$line$colors <- rep_len(cols, n_lines) + message("Wrong number of colours provided. Falling back to default\n")} + } + + list(type = "l", + main = graph_params$annot$title, + xlab = graph_params$annot$x, + ylab = graph_params$annot$y, + ylim = c(0, 1), + lty = graph_params$plot$line$types, + col = graph_params$plot$line$colors, + lwd = graph_params$plot$lwd) +} + diff --git a/R/helper_ggplot_params.R b/R/helper_ggplot_params.R new file mode 100644 index 00000000..457b6334 --- /dev/null +++ b/R/helper_ggplot_params.R @@ -0,0 +1,48 @@ + +#' @noRd +#' +#' @keywords dplot +#' +helper_ggplot_params <- function(he, + graph_params) { + + n_lines <- + if (inherits(he, "pairwise")) { + he$n_comparators + } else { + he$n_comparisons} + + if (n_lines == 1) { + + default_params <- list(plot = + list(labels = NULL, + line = + list(types = 1))) + graph_params <- modifyList(default_params, graph_params) + } + + if (n_lines > 1) { + + default_params <- + list(plot = + list(labels = line_labels(he), + line = + list(types = rep_len(1:6, n_lines)))) + + graph_params <- modifyList(default_params, graph_params) + + types <- graph_params$plot$line$types + cols <- graph_params$plot$line$colors + + is_enough_types <- length(types) >= n_lines + is_enough_colours <- length(cols) >= n_lines + + if (!is_enough_types) { + graph_params$plot$line$types <- rep_len(types, n_lines)} + + if (!is_enough_colours) { + graph_params$plot$line$colors <- rep_len(cols, n_lines)} + } + + graph_params +} diff --git a/R/ib.plot.R b/R/ib.plot.R index a960b371..6c2aac11 100644 --- a/R/ib.plot.R +++ b/R/ib.plot.R @@ -1,13 +1,9 @@ -###ib.plot#################################################################################################### -## Plots the IB - #' Incremental Benefit (IB) distribution plot #' #' Plots the distribution of the Incremental Benefit (IB) for a given value of #' the willingness to pay threshold #' -#' #' @param he A \code{bcea} object containing the results of the Bayesian #' modelling and the economic evaluation. #' @param comparison In the case of multiple interventions, specifies the one @@ -39,12 +35,21 @@ #' Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, #' London #' @keywords Health economic evaluation -#' @export ib.plot -ib.plot <- function(he,comparison=NULL,wtp=25000,bw=nbw,n=512,xlim=NULL,graph=c("base","ggplot2")){ - base.graphics <- ifelse(isTRUE(pmatch(graph,c("base","ggplot2"))==2),FALSE,TRUE) - # comparison controls which comparator is used when more than 2 interventions are present - # bw and n control the level of smoothness of the kernel density estimation - options(scipen=10) +#' @export +#' +ib.plot <- + function(he, + comparison = NULL, + wtp = 25000, + bw = nbw, + n = 512, + xlim = NULL, + graph = c("base", "ggplot2")) { + + base.graphics <- + ifelse(isTRUE(pmatch(graph, c("base", "ggplot2")) == 2), FALSE, TRUE) + # comparison controls which comparator is used when more than 2 interventions are present + # bw and n control the level of smoothness of the kernel density estimation if(!is.null(comparison)) stopifnot(comparison<=he$n.comparison) diff --git a/R/line_labels.R b/R/line_labels.R new file mode 100644 index 00000000..34fd1f36 --- /dev/null +++ b/R/line_labels.R @@ -0,0 +1,11 @@ + +line_labels <- function(he, ...) UseMethod("line_labels", he) + +line_labels.default <- function(he) { + paste(he$interventions[he$ref], "vs", + he$interventions[he$comp]) +} + +line_labels.pairwise <- function(he) { + he$interventions +} \ No newline at end of file diff --git a/R/make_legend_base.R b/R/make_legend_base.R new file mode 100644 index 00000000..9e6db0ea --- /dev/null +++ b/R/make_legend_base.R @@ -0,0 +1,33 @@ + +#' @keywords dplot +make_legend_base <- function(he, + pos_legend, + base_params) { + + # empty legend + if (!inherits(he, "pairwise") & he$n_comparisons == 1) { + return(list(x = -1, legend = ""))} + + if (is.numeric(pos_legend) & length(pos_legend) == 2) { + + ns <- ifelse(pos_legend[2] == 1, "top", "bottom") + ew <- ifelse(pos_legend[1] == 1, "right", "left") + pos_legend <- paste0(ns, ew) + } + + if (is.logical(pos_legend)) { + if (!pos_legend) + pos_legend <- "bottomright" + else + pos_legend <- "bottomleft" + } + + text <- line_labels(he) + + list(x = pos_legend, + legend = text, + cex = 0.7, + bty = "n", + lty = base_params$lty, + col = base_params$col) +} diff --git a/R/make_legend_ggplot.R b/R/make_legend_ggplot.R new file mode 100644 index 00000000..94f9c55f --- /dev/null +++ b/R/make_legend_ggplot.R @@ -0,0 +1,55 @@ + +#' @noRd +#' +#' @keywords dplot +#' +#' c(0,0) corresponds to the “bottom left” +#' c(1,1) corresponds to the “top right” +#' inside the plotting area +#' +make_legend_ggplot <- function(he, legend_pos) { + + legend_just <- NULL # sets the corner that the legend_pos position refers to + legend_dir <- "horizontal" + + n_lines <- + if (inherits(he, "pairwise")) { + he$n_comparators + } else { + he$n_comparisons} + + if (n_lines == 1) { + + legend_pos <- "none" + + } else if (any(is.na(legend_pos))) { + + legend_pos <- "none" + + } else if (is.logical(legend_pos)) { + + if (legend_pos) { + legend_pos <- "bottom" + legend_dir <- "vertical" + } else { + legend_pos <- c(1, 0) + legend_just <- legend_pos + } + } else if (is.character(legend_pos)) { + + pos_choices <- c("left", "right", "bottom", "top") + legend_pos <- choices[pmatch(legend_pos, pos_choices)] + legend_just <- "center" + } else if (is.numeric(legend_pos) & length(legend_pos) == 2) { + + legend_just <- legend_pos + } else { + # default + legend_pos <- c(1, 0) + legend_just <- legend_pos + } + + list(legend.direction = legend_dir, + legend.justification = legend_just, + legend.position = legend_pos) +} \ No newline at end of file diff --git a/R/mce.plot.R b/R/mce.plot.R deleted file mode 100644 index 1863c9a2..00000000 --- a/R/mce.plot.R +++ /dev/null @@ -1,186 +0,0 @@ -############mce.plot################################### - - -#' Plots the probability that each intervention is the most cost-effective -#' -#' Plots the probability that each of the n_int interventions being analysed is -#' the most cost-effective. -#' -#' -#' @param mce The output of the call to the function \code{\link{multi.ce}}. -#' @param pos Parameter to set the position of the legend. Can be given in form -#' of a string \code{(bottom|top)(right|left)} for base graphics and -#' \code{bottom|top|left|right} for ggplot2. It can be a two-elements vector, -#' which specifies the relative position on the x and y axis respectively, or -#' alternatively it can be in form of a logical variable, with \code{TRUE} -#' indicating to use the first standard and \code{FALSE} to use the second one. -#' Default value is \code{c(1,0.5)}, that is on the right inside the plot area. -#' @param graph A string used to select the graphical engine to use for -#' plotting. Should (partial-)match the two options \code{"base"} or -#' \code{"ggplot2"}. Default value is \code{"base"}. -#' @param ... Optional arguments. For example, it is possible to specify the -#' colours to be used in the plot. This is done in a vector -#' \code{color=c(...)}. The length of the vector colors needs to be the same as -#' the number of comparators included in the analysis, otherwise \code{BCEA} -#' will fall back to the default values (all black, or shades of grey) -#' @return \item{mceplot}{ A ggplot object containing the plot. Returned only -#' if \code{graph="ggplot2"}. } -#' @author Gianluca Baio, Andrea Berardi -#' @seealso \code{\link{bcea}} -#' @references Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity -#' Analysis in Health Economics. Statistical Methods in Medical Research -#' doi:10.1177/0962280211419832. -#' -#' Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, -#' London -#' @keywords Health economic evaluation Multiple comparison -#' @examples -#' -#' # See Baio G., Dawid A.P. (2011) for a detailed description of the -#' # Bayesian model and economic problem -#' # -#' # Load the processed results of the MCMC simulation model -#' data(Vaccine) -#' # -#' # Runs the health economic evaluation using BCEA -#' m <- bcea(e=e,c=c, # defines the variables of -#' # effectiveness and cost -#' ref=2, # selects the 2nd row of (e,c) -#' # as containing the reference intervention -#' interventions=treats, # defines the labels to be associated -#' # with each intervention -#' Kmax=50000, # maximum value possible for the willingness -#' # to pay threshold; implies that k is chosen -#' # in a grid from the interval (0,Kmax) -#' plot=FALSE # inhibits graphical output -#' ) -#' # -#' mce <- multi.ce(m) # uses the results of the economic analysis -#' # -#' mce.plot(mce, # plots the probability of being most cost-effective -#' graph="base") # using base graphics -#' # -#' if(require(ggplot2)){ -#' mce.plot(mce, # the same plot -#' graph="ggplot2") # using ggplot2 instead -#' } -#' -#' @export mce.plot -mce.plot <- function(mce,pos=c(1,0.5),graph=c("base","ggplot2"),...){ - alt.legend <- pos - base.graphics <- ifelse(isTRUE(pmatch(graph,c("base","ggplot2"))==2),FALSE,TRUE) - - exArgs <- list(...) - # Allows to specify colours for the plots - # If the user doesn't specify anything, use defaults - if(!exists("color",exArgs)) { - color <- rep(1,(mce$n.comparators+1)); lwd <- 1 - if (mce$n.comparators>7) { - cl <- colors() - color <- cl[floor(seq(262,340,length.out=mce$n.comparators))] # gray scale - lwd <- 1.5 - } - } - # If the user specify colours, then use but check they are the right number - if(exists("color",exArgs)) { - color <- exArgs$color; lwd <- 1 - if(mce$n.comparators>7) {lwd=1.5} - if (length(color)!=(mce$n.comparators)) { - message(paste0("You need to specify ",(mce$n.comparators)," colours. Falling back to default\n")) - } - } - - if(base.graphics) { - - if(is.numeric(alt.legend)&length(alt.legend)==2){ - temp <- "" - if(alt.legend[2]==0) - temp <- paste0(temp,"bottom") - else if(alt.legend[2]!=0.5) - temp <- paste0(temp,"top") - if(alt.legend[1]==1) - temp <- paste0(temp,"right") - else - temp <- paste0(temp,"left") - alt.legend <- temp - if(length(grep("^((bottom|top)(left|right)|right)$",temp))==0) - alt.legend <- FALSE - } - if(is.logical(alt.legend)){ - if(!alt.legend) - alt.legend="topright" - else - alt.legend="right" - } - -# color <- rep(1,(mce$n.comparators+1)); lwd <- 1 -# if (mce$n.comparators>7) { -# cl <- colors() -# color <- cl[floor(seq(262,340,length.out=mce$n.comparators))] # gray scale -# lwd <- 1.5 -# } - - plot(mce$k,mce$m.ce[,1],t="l",col=color[1],lwd=lwd,lty=1,xlab="Willingness to pay", - ylab="Probability of most cost effectiveness",ylim=c(0,1), - main="Cost-effectiveness acceptability curve \nfor multiple comparisons") - for (i in 2:mce$n.comparators) { - points(mce$k,mce$m.ce[,i],t="l",col=color[i],lwd=lwd,lty=i) - } - legend(alt.legend,mce$interventions,col=color,cex=.7,bty="n",lty=1:mce$n.comparators) - } # base graphics - else{ - if(!isTRUE(requireNamespace("ggplot2",quietly=TRUE)&requireNamespace("grid",quietly=TRUE))) { - message("Falling back to base graphics\n") - mce.plot(mce,pos=pos,graph="base") - return(invisible(NULL)) - } - - if(isTRUE(requireNamespace("ggplot2",quietly=TRUE)&requireNamespace("grid",quietly=TRUE))) { - # no visible bindings note - ceplane <- k <- ce <- comp <- NA_real_ - - alt.legend <- pos - lty <- rep(1:6,ceiling(mce$n.comparators/6))[1:mce$n.comparators] - label <- paste0(mce$interventions) - - df <- cbind("k"=rep(mce$k,mce$n.comparators),"ce"=c(mce$m.ce)) - df <- data.frame(df,"comp"=as.factor(sort(rep(1:mce$n.comparators,length(mce$k))))) - names(df) <- c("k","ce","comp") - - mceplot <- ggplot2::ggplot(df,ggplot2::aes(x=k,y=ce)) + ggplot2::theme_bw() + - ggplot2::geom_line(ggplot2::aes(linetype=comp)) + - ggplot2::scale_linetype_manual("",labels=label,values=lty) + - ggplot2::labs(title="Cost-effectiveness acceptability curve\nfor multiple comparisons",x="Willingness to pay",y="Probability of most cost effectiveness") + - ggplot2::theme(text=ggplot2::element_text(size=11),legend.key.size=grid::unit(.66,"lines"), - legend.spacing=grid::unit(-1.25,"line"),panel.grid=ggplot2::element_blank(), - legend.key=ggplot2::element_blank()) - - jus <- NULL - if(isTRUE(alt.legend)) { - alt.legend="bottom" - mceplot <- mceplot + ggplot2::theme(legend.direction="vertical") - } - else{ - if(is.character(alt.legend)) { - choices <- c("left", "right", "bottom", "top") - alt.legend <- choices[pmatch(alt.legend,choices)] - jus="center" - if(is.na(alt.legend)) - alt.legend=FALSE - } - if(length(alt.legend)>1) - jus <- alt.legend - if(length(alt.legend)==1 & !is.character(alt.legend)) { - alt.legend <- c(1,0.5) - jus <- alt.legend - } - } - - mceplot <- mceplot + ggplot2::coord_cartesian(ylim=c(-0.05,1.05)) + - ggplot2::theme(legend.position=alt.legend,legend.justification=jus,legend.title=ggplot2::element_blank(), - legend.background=ggplot2::element_blank(), - legend.text.align=0,plot.title = ggplot2::element_text(lineheight=1.05, face="bold",size=14.3,hjust=0.5)) - return(mceplot) - } - } -} diff --git a/R/multi.ce.R b/R/multi.ce.R index 2ed3aeda..59b98661 100644 --- a/R/multi.ce.R +++ b/R/multi.ce.R @@ -1,31 +1,33 @@ -#####multi.ce################################################################################################## - #' Cost-effectiveness analysis with multiple comparison #' #' Computes and plots the probability that each of the n_int interventions #' being analysed is the most cost-effective and the cost-effectiveness -#' acceptability frontier -#' +#' acceptability frontier. #' #' @param he A \code{bcea} object containing the results of the Bayesian #' modelling and the economic evaluation. -#' @return \item{m.ce}{A matrix including the probability that each -#' intervention is the most cost-effective for all values of the willingness to -#' pay parameter} \item{ceaf}{A vector containing the cost-effectiveness -#' acceptability frontier} +#' +#' @return Original bcea object (list) of class "pairwise" with additional: +#' \item{p_best_interv}{A matrix including the probability that each +#' intervention is the most cost-effective for all values of the willingness to +#' pay parameter} +#' \item{ceaf}{A vector containing the cost-effectiveness acceptability frontier} +#' #' @author Gianluca Baio #' @seealso \code{\link{bcea}}, \code{\link{mce.plot}}, \code{\link{ceaf.plot}} #' @keywords Health economic evaluation Multiple comparison +#' #' @examples #' #' # See Baio G., Dawid A.P. (2011) for a detailed description of the #' # Bayesian model and economic problem -#' # +#' #' # Load the processed results of the MCMC simulation model #' data(Vaccine) -#' # +#' #' # Runs the health economic evaluation using BCEA +#' #' m <- bcea(e=e,c=c, # defines the variables of #' # effectiveness and cost #' ref=2, # selects the 2nd row of (e,c) @@ -37,32 +39,38 @@ #' # in a grid from the interval (0,Kmax) #' plot=FALSE # inhibits graphical output #' ) -#' # -#' mce <- multi.ce(m # uses the results of the economic analysis -#' ) #' -#' @export multi.ce -multi.ce <- function(he){ - # Cost-effectiveness analysis for multiple comparison - # Identifies the probability that each comparator is the most cost-effective as well as the - # cost-effectiveness acceptability frontier - cl <- colors() - # choose colors on gray scale - color <- cl[floor(seq(262,340,length.out=he$n.comparators))] +#' mce <- multi.ce(m) # uses the results of the economic analysis +#' +#' @export +#' +multi.ce <- function(he) { + + # grey scale + color <- colors()[floor(seq(262, 340, length.out = he$n_comparators))] + + p_best_interv <- array(NA, c(length(he$k), he$n_comparators)) - rank <- most.ce <- array(NA,c(he$n.sim,length(he$k),he$n.comparators)) - for (t in 1:he$n.comparators) { - for (j in 1:length(he$k)) { - rank[,j,t] <- apply(he$U[,j,]<=he$U[,j,t],1,sum) - most.ce[,j,t] <- rank[,j,t]==he$n.comparators + for (i in seq_len(he$n_comparators)) { + for (k in seq_along(he$k)) { + + is_interv_best <- he$U[, k, ] <= he$U[, k, i] + + rank <- apply(!is_interv_best, 1, sum) + + p_best_interv[k, i] <- mean(rank == 0) } } - m.ce <- apply(most.ce,c(2,3),mean) # Probability most cost-effective - ceaf <- m.ce[cbind(1:nrow(m.ce),he$best)] - ###ceaf <- apply(m.ce,1,max) # Cost-effectiveness acceptability frontier - # Output of the function - list( - m.ce=m.ce,ceaf=ceaf,n.comparators=he$n.comparators,k=he$k,interventions=he$interventions - ) + # cost-effectiveness acceptability frontier + + ##TODO: fixed ref value. do we really want this? [NG] + ceaf <- p_best_interv[cbind(1:nrow(p_best_interv), he$best)] + #ceaf <- apply(p_best_interv, 1, max) + + he <- c(he, + list(p_best_interv = p_best_interv, + ceaf = ceaf)) + + structure(he, class = c("pairwise", class(he))) } diff --git a/R/new_bcea.R b/R/new_bcea.R new file mode 100644 index 00000000..24297fdf --- /dev/null +++ b/R/new_bcea.R @@ -0,0 +1,77 @@ + +#' Constructor for bcea +#' +#' @param df_ce dataframe of all simulation eff and cost +#' @param k vector of willingness to pay values +#' +#' @import reshape2, dplyr +#' +#' @return +#' @export +#' +new_bcea <- function(df_ce, k) { + + K <- length(k) + n_sim <- length(unique(df_ce$sim)) + ref <- unique(df_ce$ref) + comp <- (1:max(df_ce$ints))[-ref] + df_ce_comp <- df_ce %>% filter(ints != ref) + + ICER <- compute_ICER(df_ce) + + ib <- compute_IB(df_ce, k) + + ceac <- compute_CEAC(ib) + + eib <- compute_EIB(ib) + + best <- best_interv_given_k(eib, ref, comp) + + kstar <- compute_kstar(k, best, ref) + + U <- compute_U(df_ce, k) + + Ustar <- compute_Ustar(n_sim, K, U) + + vi <- compute_vi(n_sim, K, Ustar, U) + + ol <- compute_ol(n_sim, K, Ustar, U, best) + + evi <- colMeans(ol) + + he <- + list(n_sim = length(unique(df_ce$sim)), + n_comparators = length(comp) + 1, + n_comparisons = length(comp), + delta_e = dcast(sim ~ interv_names, + value.var = "delta_e", + data = df_ce_comp)[, -1], + delta_c = dcast(sim ~ interv_names, + value.var = "delta_c", + data = df_ce_comp)[, -1], + ICER = ICER, + Kmax = max(k), + k = k, + ceac = ceac, + ib = ib, + eib = eib, + kstar = kstar, + best = best, + U = U, + vi = vi, + Ustar = Ustar, + ol = ol, + evi = evi, + interventions = sort(unique(df_ce$interv_names)), + ref = ref, + comp = comp, + step = k[2] - k[1], + e = dcast(sim ~ interv_names, + value.var = "eff1", + data = df_ce)[, -1], + c = dcast(sim ~ interv_names, + value.var = "cost1", + data = df_ce)[, -1]) + + structure(he, class = c("bcea", class(he))) +} diff --git a/R/plot.CEriskav.R b/R/plot.CEriskav.R index 420fa1c0..72c8254b 100644 --- a/R/plot.CEriskav.R +++ b/R/plot.CEriskav.R @@ -89,9 +89,12 @@ #' ) #' } #' -#' @export plot.CEriskav -plot.CEriskav <- function(x,pos=c(0,1),graph=c("base","ggplot2"),...) { - options(scipen=10) +#' @export +#' +plot.CEriskav <- function(x, + pos = c(0, 1), + graph = c("base", "ggplot2"), + ...) { alt.legend <- pos base.graphics <- ifelse(isTRUE(pmatch(graph,c("base","ggplot2"))==2),FALSE,TRUE) diff --git a/R/plot.bcea.R b/R/plot.bcea.R index fbe8113f..b7c39bdb 100644 --- a/R/plot.bcea.R +++ b/R/plot.bcea.R @@ -1,6 +1,3 @@ -###plot.bcea################################################################################################## -## Plots the main health economics outcomes in just one graph - #' Summary plot of the health economic analysis #' @@ -12,10 +9,8 @@ #' overriding its default for \code{pos=FALSE}, since multiple ggplot2 plots #' are rendered in a slightly different way than single plots. #' -#' For more information see the documentation of each individual plot function. +#' @template args-he #' -#' @param x A \code{bcea} object containing the results of the Bayesian -#' modelling and the economic evaluation. #' @param comparison Selects the comparator, in case of more than two #' interventions being analysed. The value is passed to #' \code{\link{ceplane.plot}}, \code{\link{eib.plot}} and @@ -37,124 +32,193 @@ #' can be supplied to the functions in this way. In addition if #' \code{graph="ggplot2"} and the arguments are named theme objects they will #' be added to each plot. +#' #' @return The function produces a plot with four graphical summaries of the #' health economic evaluation. +#' #' @author Gianluca Baio, Andrea Berardi -#' @seealso \code{\link{bcea}}, \code{\link{ceplane.plot}}, -#' \code{\link{eib.plot}}, \code{\link{ceac.plot}}, \code{\link{evi.plot}} +#' +#' @seealso \code{\link{bcea}}, +#' \code{\link{ceplane.plot}}, +#' \code{\link{eib.plot}}, +#' \code{\link{ceac.plot}}, +#' \code{\link{evi.plot}} #' @references Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity #' Analysis in Health Economics. Statistical Methods in Medical Research #' doi:10.1177/0962280211419832. #' -#' Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, -#' London +#' Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, London +#' #' @keywords Health economic evaluation +#' #' @examples #' #' # See Baio G., Dawid A.P. (2011) for a detailed description of the #' # Bayesian model and economic problem -#' # +#' #' # Load the processed results of the MCMC simulation model #' data(Vaccine) -#' # +#' #' # Runs the health economic evaluation using BCEA -#' m <- bcea(e=e,c=c, # defines the variables of -#' # effectiveness and cost -#' ref=2, # selects the 2nd row of (e,c) -#' # as containing the reference intervention -#' interventions=treats, # defines the labels to be associated -#' # with each intervention -#' Kmax=50000, # maximum value possible for the willingness -#' # to pay threshold; implies that k is chosen -#' # in a grid from the interval (0,Kmax) -#' plot=FALSE # does not produce graphical outputs -#' ) -#' # +#' he <- bcea( +#' e=e, c=c, # defines the variables of +#' # effectiveness and cost +#' ref=2, # selects the 2nd row of (e,c) +#' # as containing the reference intervention +#' interventions=treats, # defines the labels to be associated +#' # with each intervention +#' Kmax=50000, # maximum value possible for the willingness +#' # to pay threshold; implies that k is chosen +#' # in a grid from the interval (0,Kmax) +#' plot=FALSE # does not produce graphical outputs +#' ) +#' #' # Plots the summary plots for the "bcea" object m using base graphics -#' plot(m,graph="base") +#' plot(he, graph="base") #' #' # Plots the same summary plots using ggplot2 #' if(require(ggplot2)){ -#' plot(m,graph="ggplot2") +#' plot(he, graph="ggplot2") #' #' ##### Example of a customized plot.bcea with ggplot2 -#' plot(m, -#' graph="ggplot2", # use ggplot2 -#' theme=theme(plot.title=element_text(size=rel(1.25))), # theme elements must have a name -#' ICER.size=1.5, # hidden option in ceplane.plot -#' size=rel(2.5) # modifies the size of k= labels -#' ) # in ceplane.plot and eib.plot +#' plot(he, +#' graph = "ggplot2", # use ggplot2 +#' theme = theme(plot.title=element_text(size=rel(1.25))), # theme elements must have a name +#' ICER.size = 1.5, # hidden option in ceplane.plot +#' size = rel(2.5) # modifies the size of k = labels +#' ) # in ceplane.plot and eib.plot #' } #' -#' @export plot.bcea -plot.bcea <- function(x,comparison=NULL,wtp=25000,pos=FALSE,graph=c("base","ggplot2"),...) { - options(scipen=10) - base.graphics <- ifelse(isTRUE(pmatch(graph,c("base","ggplot2"))==2),FALSE,TRUE) +#' @import ggplot2 +#' @export +#' +plot.bcea <- function(he, + comparison = NULL, + wtp = 25000, + pos = FALSE, + graph = c("base", "ggplot2"), + ...) { + + named_args <- c(as.list(environment()), list(...)) + graph <- match.arg(graph) + use_base_graphics <- pmatch(graph, c("base","ggplot2")) != 2 + extra_args <- list(...) - if(base.graphics) { - op <- par(mfrow=c(2,2)) - ceplane.plot(x,comparison=comparison,wtp=wtp,pos=pos,graph="base",...) - eib.plot(x,comparison=comparison,pos=pos,graph="base",...) - ceac.plot(x,comparison=comparison,pos=pos,graph="base") - evi.plot(x,graph="base") + if (use_base_graphics) { + op <- par(mfrow = c(2,2)) + + ceplane.plot(he, + comparison = comparison, + wtp = wtp, + pos = pos, + graph = "base",...) + + eib.plot(he, + comparison = comparison, + pos = pos, + graph = "base",...) + + ceac.plot(he, + pos = pos, + graph = "base") + + evi.plot(he, + graph = "base") par(op) - } - else{ + } else { + + is_req_pkgs <- map_lgl(c("ggplot2","grid"), requireNamespace, quietly = TRUE) - if(!requireNamespace("ggplot2",quietly=TRUE) & !requireNamespace("grid",quietly=TRUE)){ + if (!all(is_req_pkgs)) { message("falling back to base graphics\n") - plot.bcea(x,comparison=comparison,wtp=wtp,pos=pos,graph="base",...) + plot.bcea( + he, + comparison = comparison, + wtp = wtp, + pos = pos, + graph = "base", ...) return(invisible(NULL)) } ####### multiplot ###### # source: R graphics cookbook - if(requireNamespace("ggplot2",quietly=TRUE) & requireNamespace("grid",quietly=TRUE)){ - multiplot <- function(..., plotlist=NULL, file, cols=1, layout=NULL) { - plots <- c(list(...),plotlist) - numPlots = length(plots) - if(is.null(layout)) { - layout <- matrix(seq(1,cols*ceiling(numPlots/cols)), - ncol=cols, nrow=ceiling(numPlots/cols)) + if (all(is_req_pkgs)) { + + multiplot <- function(plotlist = NULL, + file, + cols = 1, + layout = NULL, ...) { + + plots <- c(extra_args, plotlist) + n_plots <- length(plots) + if (is.null(layout)) { + layout <- matrix(seq(1, cols*ceiling(n_plots/cols)), + ncol = cols, + nrow = ceiling(n_plots/cols)) } - if(numPlots==1) { + if (n_plots == 1) { print(plots[[1]]) } else { grid::grid.newpage() - grid::pushViewport(grid::viewport(layout=grid::grid.layout(nrow(layout),ncol(layout)))) + grid::pushViewport( + grid::viewport(layout = grid::grid.layout(nrow(layout), ncol(layout)))) - for(i in 1:numPlots) { - matchidx <- as.data.frame(which(layout==i,arr.ind=TRUE)) - print(plots[[i]],vp=grid::viewport(layout.pos.row=matchidx$row, - layout.pos.col=matchidx$col)) + for (i in seq_len(n_plots)) { + matchidx <- as.data.frame(which(layout == i, arr.ind = TRUE)) + print(plots[[i]], vp = grid::viewport(layout.pos.row = matchidx$row, + layout.pos.col = matchidx$col)) } } - } #### multiplot end #### + } - theme.multiplot <- - ggplot2::theme(text=ggplot2::element_text(size=9),legend.key.size=grid::unit(.5,"lines"), - legend.spacing=grid::unit(-1.25,"line"),panel.grid=ggplot2::element_blank(), - legend.key=ggplot2::element_blank(),plot.title=ggplot2::element_text(lineheight=1,face="bold",size=11.5,hjust=0.5)) + theme_params <- + list(text = element_text(size = 9), + legend.key.size = grid::unit(0.5, "lines"), + legend.spacing = grid::unit(-1.25, "line"), + panel.grid = element_blank(), + legend.key = element_blank(), + plot.title = element_text( + lineheight = 1, + face = "bold", + size = 11.5, + hjust = 0.5)) - exArgs <- list(...) - for(obj in exArgs) - if(ggplot2::is.theme(obj)) - theme.multiplot <- theme.multiplot + obj + ##TODO: modifylist with above? + theme_add <- purrr::keep(extra_args, is.theme) - ceplane.pos <- pos - if(isTRUE(pos==FALSE)){ - ceplane.pos <- c(1,1.025) - } - ceplane <- ceplane.plot(x,wtp=wtp,pos=ceplane.pos,comparison=comparison,graph="ggplot2",...) + - theme.multiplot - eib <- eib.plot(x,pos=pos,comparison=comparison,graph="ggplot2",...) + - theme.multiplot - ceac <- ceac.plot(x,pos=pos,comparison=comparison,graph="ggplot2") + - theme.multiplot - evi <- evi.plot(x,graph="ggplot2") + - theme.multiplot - # then call multiplot - multiplot(ceplane,ceac,eib,evi,cols=2) - } # !base.graphics + ceplane.pos <- ifelse(pos, pos, c(1, 1.025)) + + ceplane <- + ceplane.plot(he, + wtp = wtp, + pos = ceplane.pos, + comparison = comparison, + graph = "ggplot2", ...) + + do.call(theme, theme_params) + + theme_add + + eib <- + eib.plot(he, + pos = pos, + comparison = comparison, + graph = "ggplot2", ...) + + do.call(theme, theme_params) + + theme_add + + ceac <- + ceac.plot(he, + pos = pos, + comparison = comparison, + graph = "ggplot2") + + do.call(theme, theme_params) + + theme_add + + evi <- + evi.plot(he, graph = "ggplot2") + + do.call(theme, theme_params) + + theme_add + + multiplot(ceplane, ceac, eib, evi, cols = 2) + } } } diff --git a/R/plot.evppi.R b/R/plot.evppi.R index eb89740d..e3dedce6 100644 --- a/R/plot.evppi.R +++ b/R/plot.evppi.R @@ -1,12 +1,7 @@ -######plot.evppi################################################################################################ - -#' plot.evppi -#' -#' Plots a graph of the Expected Value of Partial Information with respect to a +#' Plot a graph of the Expected Value of Partial Information with respect to a #' set of parameters #' -#' #' @param x An object in the class \code{evppi}, obtained by the call to the #' function \code{\link{evppi}}. #' @param pos Parameter to set the position of the legend. Can be given in form @@ -28,15 +23,20 @@ #' @references Baio G. (2012). Bayesian Methods in Health Economics. #' CRC/Chapman Hall, London #' @keywords Health economic evaluation Expected value of information -#' @export plot.evppi -plot.evppi<-function (x, pos = c(0, 0.8), graph = c("base", "ggplot2"), col = NULL, - ...) -{ - options(scipen = 10) +#' +#' @export +#' +plot.evppi <- function (x, + pos = c(0, 0.8), + graph = c("base", "ggplot2"), + col = NULL, + ...) { + alt.legend <- pos - base.graphics <- ifelse(isTRUE(pmatch(graph, c("base", "ggplot2")) == - 2), FALSE, TRUE) - stopifnot(isTRUE(class(x) == "evppi")) + base.graphics <- pmatch(graph, c("base", "ggplot2")) != 2 + + stopifnot(inherits(x, "evppi")) + if (base.graphics) { if (is.numeric(alt.legend) & length(alt.legend) == 2) { temp <- "" diff --git a/R/plot.mixedAn.R b/R/plot.mixedAn.R index 566da87e..1818d5ba 100644 --- a/R/plot.mixedAn.R +++ b/R/plot.mixedAn.R @@ -1,5 +1,3 @@ -###plot.mixedAn############################################################################################### - #' Summary plot of the health economic analysis when the mixed analysis is #' considered @@ -30,6 +28,7 @@ #' difference between the ''optimal'' version of the EVPI (when only the most #' cost-effective intervention is included in the market) and the mixed #' strategy one (when more than one intervention is considered in the market). +#' #' @author Gianluca Baio, Andrea Berardi #' @seealso \code{\link{bcea}}, \code{\link{mixedAn}} #' @references Baio, G. and Russo, P. (2009).A decision-theoretic framework for @@ -43,6 +42,7 @@ #' Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, #' London #' @keywords Health economic evaluation Mixed analysis +#' #' @examples #' #' # See Baio G., Dawid A.P. (2011) for a detailed description of the @@ -50,7 +50,7 @@ #' # #' # Load the processed results of the MCMC simulation model #' data(Vaccine) -#' # +#' #' # Runs the health economic evaluation using BCEA #' m <- bcea(e=e,c=c, # defines the variables of #' # effectiveness and cost @@ -63,29 +63,32 @@ #' # in a grid from the interval (0,Kmax) #' plot=FALSE # inhibits graphical output #' ) -#' # +#' #' ma <- mixedAn(m, # uses the results of the mixed strategy #' # analysis (a "mixedAn" object) #' mkt.shares=NULL # the vector of market shares can be defined #' # externally. If NULL, then each of the T #' # interventions will have 1/T market share #' ) -#' # +#' #' # Can also plot the summary graph #' plot(ma,graph="base") -#' # +#' #' # Or with ggplot2 #' if(require(ggplot2)){ #' plot(ma,graph="ggplot2") #' } #' -#' @export plot.mixedAn -plot.mixedAn <- function(x,y.limits=NULL,pos=c(0,1),graph=c("base","ggplot2"),...) { - ## Plot the EVPI and the mixed strategy - options(scipen=10) +#' @export +#' +plot.mixedAn <- function(x, + y.limits = NULL, + pos = c(0, 1), + graph = c("base", "ggplot2"), + ...) { alt.legend <- pos - base.graphics <- ifelse(isTRUE(pmatch(graph,c("base","ggplot2"))==2),FALSE,TRUE) + base.graphics <- pmatch(graph, c("base", "ggplot2")) != 2 if(is.null(y.limits)){ y.limits=range(x$evi,x$evi.star) @@ -93,7 +96,7 @@ plot.mixedAn <- function(x,y.limits=NULL,pos=c(0,1),graph=c("base","ggplot2"),.. if(base.graphics) { - if(is.numeric(alt.legend)&length(alt.legend)==2){ + if(is.numeric(alt.legend)&length(alt.legend) == 2){ temp <- "" if(alt.legend[2]==0) temp <- paste0(temp,"bottom") @@ -104,7 +107,7 @@ plot.mixedAn <- function(x,y.limits=NULL,pos=c(0,1),graph=c("base","ggplot2"),.. else temp <- paste0(temp,"left") alt.legend <- temp - if(length(grep("^(bottom|top)(left|right)$",temp))==0) + if(length(grep("^(bottom|top)(left|right)$",temp)) == 0) alt.legend <- FALSE } if(is.logical(alt.legend)){ diff --git a/R/prepare_graph_params.R b/R/prepare_graph_params.R new file mode 100644 index 00000000..2d921cb0 --- /dev/null +++ b/R/prepare_graph_params.R @@ -0,0 +1,25 @@ + +#' @keywords dplot +prepare_graph_params <- function(...) { + + extra_params <- list(...) + + # defaults + + plot_params <- list(area = list(include = TRUE, + color = NULL), + line = list(colors = "black")) + + annot_params <- list(title = "Cost Effectiveness Acceptability Curve", + x = "Willingness to pay", + y = "Probability of cost effectiveness") + + plot_extra_params <- extra_params[c("area", "line")] + annot_extra_params <- extra_params[c("title", "xlab", "ylab")] + + annot_params <- modifyList(annot_params, annot_extra_params) + plot_params <- modifyList(plot_params, plot_extra_params) + + list(annot = annot_params, + plot = plot_params) +} diff --git a/R/prepare_graph_params_ceplane.R b/R/prepare_graph_params_ceplane.R new file mode 100644 index 00000000..44fd1965 --- /dev/null +++ b/R/prepare_graph_params_ceplane.R @@ -0,0 +1,94 @@ + +##TODO: +# +prepare_graph_params_ceplane <- function() { + + # evaluate additional arguments ----- + plot_annotations <- list("exist" = list("title" = FALSE, "xlab" = FALSE, "ylab" = FALSE)) + plot_aes <- list("area" = list("include" = TRUE, "color" = "light gray", "line_color" = "black"), + "point" = list("colors" = "black", "sizes" = 4), + "ICER" = list("colors" = "red", "sizes" = 8), + "exist" = list("area" = list("include" = FALSE, "color" = FALSE, "line_color" = FALSE), + "point" = list("colors" = FALSE, "sizes" = FALSE), + "ICER" = list("colors" = FALSE, "sizes" = FALSE))) + plot_aes_args = c("area_include", "area_color", "area_line_color", + "point_colors", "point_sizes", + "ICER_colors", "ICER_sizes") + if (length(exArgs) >= 1) { + # if existing, read and store title, xlab and ylab + for (annotation in names(plot_annotations$exist)) { + if (exists(annotation, where = exArgs)) { + plot_annotations$exist[[annotation]] <- TRUE + plot_annotations[[annotation]] <- exArgs[[annotation]] + } + } + # if existing, read and store graphical options + for (aes_arg in plot_aes_args) { + if (exists(aes_arg, where = exArgs)) { + aes_cat <- strsplit(aes_arg, "_")[[1]][1] + aes_name <- paste0(strsplit(aes_arg, "_")[[1]][-1], collapse = "_") + plot_aes[[aes_cat]][[aes_name]] <- exArgs[[aes_arg]] + plot_aes$exist[[aes_cat]][[aes_name]] <- TRUE + } + } + } + # Args compatibility + if (exists("ICER.size", where = exArgs)) { + if (plot_aes$exist$ICER$sizes) { + warning("Both ICER.size and ICER_sizes arguments specified. ICER_sizes will be used.") + } else { + warning("ICER.size is softly deprecated. Please use ICER_sizes instead.") + plot_aes$exist$ICER$sizes <- TRUE + plot_aes$ICER$sizes <- exArgs$ICER.size + } + } + if (exists("ICER.col", where = exArgs)) { + if (plot_aes$exist$ICER$colors) { + warning("Both ICER.col and ICER_col arguments specified. ICER_col will be used.") + } else { + warning("ICER.col is softly deprecated. Please use ICER_col instead.") + plot_aes$exist$ICER$colors <- TRUE + plot_aes$ICER$colors <- exArgs$ICER.col + } + } + if (exists("col", where = exArgs)) { + if (plot_aes$exist$point$colors) { + warning("Both col and point_colors arguments specified. point_colors will be used.") + } else { + warning("col argument is softly deprecated. Please use point_colors instead.") + plot_aes$exist$point$colors <- TRUE + plot_aes$point$colors <- exArgs$col + } + } + # set default colour scheme + if (!plot_aes$exist$point$colors) { + if (he$n.comparisons > 1 & (is.null(comparison) || length(comparison) > 1)) { + plot_aes$point$colors <- colors()[floor(seq(262, 340, length.out = he$n.comparisons))] + } else { + plot_aes$point$colors <- "grey55" + } + } + # default plot annotations ----- + if (!plot_annotations$exist$title) + plot_annotations$title <- with(he, paste0( + "Cost-Effectiveness Plane", + ifelse( + n.comparisons == 1 | (n.comparisons > 1 & (!is.null(comparison) && length(comparison) == 1)), + paste0("\n", interventions[ref], " vs ", interventions[-ref]), + paste0(ifelse( + isTRUE(he$mod), + paste0( + "\n", + interventions[ref], + " vs ", + paste0(interventions[comp], collapse = ", ") + ), + "" + )) + ) + )) + if (!plot_annotations$exist$xlab) + plot_annotations$xlab = "Effectiveness differential" + if (!plot_annotations$exist$ylab) + plot_annotations$ylab = "Cost differential" +} diff --git a/R/prepare_graph_params_multi.R b/R/prepare_graph_params_multi.R new file mode 100644 index 00000000..85c144ea --- /dev/null +++ b/R/prepare_graph_params_multi.R @@ -0,0 +1,33 @@ + +# +prepare_graph_params_multi <- function(...) { + + alt.legend <- pos + lty <- rep(1:6, ceiling(he$n_comparators/6))[1:he$n_comparators] + label <- paste0(he$interventions) + + jus <- NULL + + if (alt.legend) { + alt.legend <- "bottom" + heplot <- heplot + theme(legend.direction = "vertical") + } else { + if (is.character(alt.legend)) { + choices <- c("left", "right", "bottom", "top") + alt.legend <- choices[pmatch(alt.legend,choices)] + jus <- "center" + + if (is.na(alt.legend)) + alt.legend <- FALSE + } + + if (length(alt.legend) > 1) + jus <- alt.legend + + if (length(alt.legend) == 1 & !is.character(alt.legend)) { + alt.legend <- c(1, 0.5) + jus <- alt.legend + } + } + +} \ No newline at end of file diff --git a/R/select_plot_type.R b/R/select_plot_type.R new file mode 100644 index 00000000..2ae11496 --- /dev/null +++ b/R/select_plot_type.R @@ -0,0 +1,26 @@ + +#' choose graphical engine +#' +#' @keywords dplot +#' +select_plot_type <- function(graph) { + + if (is.null(graph) || is.na(graph)) graph <- "base" + + graph_type <- pmatch(graph[1], c("base", "ggplot2", "plotly"), nomatch = 1) + + is_req_pkgs <- map_lgl(c("ggplot2","grid"), requireNamespace, quietly = TRUE) + + # check feasibility + if (graph_type == 2 && !all(is_req_pkgs)) { + warning( + "Packages ggplot2 and grid not found; plot will be rendered using base graphics.", call. = FALSE) + graph_type <- 1} + + if (graph_type == 3 && !requireNamespace("plotly", quietly = TRUE)) { + warning( + "Package plotly not found; plot will be rendered using base graphics.", call. = FALSE) + graph_type <- 1} + + graph_type +} \ No newline at end of file diff --git a/R/sim.table.R b/R/sim.table.R index a79576a3..8a769475 100644 --- a/R/sim.table.R +++ b/R/sim.table.R @@ -1,107 +1,106 @@ -###sim.table################################################################################################## -# Produce a summary table with the results of simulations for the health economic variables of interest - -#' Table of simulations for the health economic model +#' Table of Simulations for the Health Economic Model #' #' Using the input in the form of MCMC simulations and after having run the #' health economic model, produces a summary table of the simulations from the -#' cost-effectiveness analysis +#' cost-effectiveness analysis. #' #' #' @param he A \code{bcea} object containing the results of the Bayesian -#' modelling and the economic evaluation. +#' modelling and the economic evaluation. #' @param wtp The value of the willingness to pay threshold to be used in the -#' summary table. -#' @return Produces the following elements: \item{Table}{A table with the +#' summary table. +#' +#' @return Produces the following elements: \item{table}{A table with the #' simulations from the economic model} \item{names.cols}{A vector of labels to #' be associated with each column of the table} \item{wtp}{The selected value -#' of the willingness to pay} \item{ind.table}{The index associated with the +#' of the willingness to pay} \item{idx_wtp}{The index associated with the #' selected value of the willingness to pay threshold in the grid used to run #' the analysis} +#' #' @author Gianluca Baio #' @seealso \code{\link{bcea}} #' @references Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity -#' Analysis in Health Economics. Statistical Methods in Medical Research +#' Analysis in Health Economics. Statistical Methods in Medical Research #' doi:10.1177/0962280211419832. #' -#' Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, -#' London +#' Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, London +#' #' @keywords Health economic evaluation +#' @importFrom dplyr +#' #' @examples #' #' # See Baio G., Dawid A.P. (2011) for a detailed description of the #' # Bayesian model and economic problem -#' # +#' #' # Load the processed results of the MCMC simulation model #' data(Vaccine) -#' # +#' #' # Runs the health economic evaluation using BCEA -#' m <- bcea(e=e,c=c, # defines the variables of -#' # effectiveness and cost -#' ref=2, # selects the 2nd row of (e,c) -#' # as containing the reference intervention -#' interventions=treats, # defines the labels to be associated -#' # with each intervention -#' Kmax=50000 # maximum value possible for the willingness -#' # to pay threshold; implies that k is chosen -#' # in a grid from the interval (0,Kmax) -#' ) -#' # +#' m <- bcea(e=e, # defines the variables of +#' c=c, # effectiveness and cost +#' ref=2, # selects the 2nd row of (e,c) +#' # as containing the reference intervention +#' interventions=treats, # defines the labels to be associated +#' # with each intervention +#' Kmax=50000 # maximum value possible for the willingness +#' # to pay threshold; implies that k is chosen +#' # in a grid from the interval (0,Kmax) +#' ) +#' #' # Now can save the simulation exercise in an object using sim.table() -#' st <- sim.table(m, # uses the results of the economic evalaution -#' # (a "bcea" object) -#' wtp=25000 # selects the particular value for k -#' ) -#' # +#' st <- sim.table(m, # uses the results of the economic evaluation +#' # (a 'bcea' object) +#' wtp=25000 # selects the particular value for k +#' ) +#' #' # The table can be explored. For example, checking the -#' # element 'Table' of the object 'st' +#' # element 'Table' of the object 'st' #' -#' @export sim.table -sim.table <- function(he,wtp=25000) { +#' @export +#' +sim.table <- function(he, + wtp = 25000) { - if(wtp>he$Kmax){wtp=he$Kmax} + wtp <- min(wtp, he$Kmax) - if (!is.element(wtp,he$k)) { - if (!is.na(he$step)) {# The user has selected a non-acceptable value for wtp, but has not specified wtp in the call to bcea - stop(paste("The willingness to pay parameter is defined in the interval [0-",he$Kmax, - "], with increments of ",he$step,"\n",sep="")) + if (!is.element(wtp, he$k)) { + if (!is.na(he$step)) { + # The user has selected a non-acceptable value for wtp, but has not specified wtp in the call to bcea + stop( + sprintf("The willingness to pay parameter is defined in the interval [0- %f], with increments of %f \n", he$Kmax, he$step), call. = FALSE) } else { # The user has actually specified wtp as input in the call to bcea - tmp <- paste(he$k,collapse=" ") - stop(paste0("The willingness to pay parameter is defined as:\n[",tmp,"]\nPlease select a suitable value",collapse=" ")) + he_k <- paste(he$k, collapse = " ") + stop( + paste0("The willingness to pay parameter is defined as:\n[", he_k, "]\nPlease select a suitable value", collapse = " "), call. = FALSE) } } - ind.table <- which(he$k==wtp) - cols.u <- 1:he$n.comparators - cols.ustar <- max(cols.u)+1 - cols.ib <- (cols.ustar+1):(cols.ustar+he$n.comparisons) - cols.ol <- max(cols.ib)+1 - cols.vi <- cols.ol+1 - n.cols <- cols.vi + table <- + cbind.data.frame( + U_filter_by(he, wtp), + Ustar_filter_by(he, wtp), + ib_filter_by(he, wtp), + ol_filter_by(he, wtp), + vi_filter_by(he, wtp)) - Table <- matrix(NA,(he$n.sim+1),n.cols) - Table[1:he$n.sim,cols.u] <- he$U[,ind.table,] - Table[1:he$n.sim,cols.ustar] <- he$Ustar[,ind.table] - if(length(dim(he$ib))==2){Table[1:he$n.sim,cols.ib] <- he$ib[ind.table,]} - if(length(dim(he$ib))>2){Table[1:he$n.sim,cols.ib] <- he$ib[ind.table,,]} - Table[1:he$n.sim,cols.ol] <- he$ol[,ind.table] - Table[1:he$n.sim,cols.vi] <- he$vi[,ind.table] - if(length(dim(he$ib))==2){ - Table[(he$n.sim+1),] <- c(apply(he$U[,ind.table,],2,mean),mean(he$Ustar[,ind.table]), - mean(he$ib[ind.table,]),mean(he$ol[,ind.table]),mean(he$vi[,ind.table])) - } - if(length(dim(he$ib))>2){ - Table[(he$n.sim+1),] <- c(apply(he$U[,ind.table,],2,mean),mean(he$Ustar[,ind.table]), - apply(he$ib[ind.table,,],2,mean),mean(he$ol[,ind.table]),mean(he$vi[,ind.table])) - } + table <- + bind_rows(table, + summarise_all(table, mean)) - names.cols <- c(paste("U",seq(1:he$n.comparators),sep=""),"U*",paste("IB",he$ref,"_",he$comp,sep=""),"OL","VI") - colnames(Table) <- names.cols - rownames(Table) <- c(1:he$n.sim,"Average") + names.cols <- + c(paste0("U", 1:he$n_comparators), + "U*", + paste0("IB", he$ref, "_", he$comp), + "OL", + "VI") + colnames(table) <- names.cols + rownames(table) <- c(1:he$n_sim, "Average") - ## Outputs of the function - list(Table=Table,names.cols=names.cols,wtp=wtp,ind.table=ind.table) + list( + Table = table, + names.cols = names.cols, + wtp = wtp, + ind.table = which(he$k == wtp)) } - - diff --git a/R/summary.bcea.R b/R/summary.bcea.R index 58514fac..8b08d04a 100644 --- a/R/summary.bcea.R +++ b/R/summary.bcea.R @@ -25,7 +25,8 @@ #' London #' @keywords Health economic evaluation #' @export summary.bcea -summary.bcea <- function(object,wtp=25000,...) { +summary.bcea <- function(object, + wtp = 25000,...) { if(max(object$k) -Given the results of a Bayesian model (possibly based on MCMC) in the form of simulations from the posterior distributions of suitable variables of costs and clinical benefits for two or more interventions, produces a health economic evaluation. Compares one of the interventions (the "reference") to the others ("comparators"). Produces many summary and plots to analyse the results +[![Build status](https://img.shields.io/travis/giabaio/BCEA/master.svg?maxAge=0)](https://travis-ci.org/giabaio/BCEA) [![AppVeyor Build Status](https://img.shields.io/appveyor/ci/giabaio/BCEA/master.svg)](https://ci.appveyor.com/project/giabaio/BCEA) [![CRAN_Status_Badge](http://www.r-pkg.org/badges/version/BCEA)](https://cran.r-project.org/package=BCEA) [![CRAN_Download_Badge](http://cranlogs.r-pkg.org/badges/BCEA)](https://cran.r-project.org/package=BCEA) [![CRAN_Download_Badge](http://cranlogs.r-pkg.org/badges/grand-total/BCEA?color=orange)]( ) + + +## Contents + +- [Overview](#introduction) +- [Features](#features) +- [Installation](#installation) +- [Further details](#further-details) + +## Overview + +Perform Bayesian Cost-Effectiveness Analysis in R. +Given the results of a Bayesian model (possibly based on MCMC) in the form of simulations from the posterior distributions of suitable variables of costs and clinical benefits for two or more interventions, produces a health economic evaluation. Compares one of the interventions (the "reference") to the others ("comparators"). + +## Features + +Main features of `BCEA` include: + +* Summary statistics and tables +* Cost-effectiveness analysis plots, such as CE planes and CEAC +* EVPPI calculations and plots ## Installation There are two ways of installing `BCEA`. A "stable" version (currently 2.2.6) is packaged and available from [CRAN](https://cran.r-project.org/index.html). So you can simply type on your R terminal -```R + +```r install.packages("BCEA") ``` The second way involves using the "development" version of `BCEA` - this will usually be updated more frequently and may be continuously tested. On Windows machines, you need to install a few dependencies, including [Rtools](https://cran.r-project.org/bin/windows/Rtools/) first, e.g. by running + ```R pkgs <- c("MASS","Rtools","devtools") repos <- c("https://cran.rstudio.com", "https://inla.r-inla-download.org/R/stable") install.packages(pkgs,repos=repos,dependencies = "Depends") ``` before installing the package using `devtools`: -```R + +```r devtools::install_github("giabaio/BCEA") ``` Under Linux or MacOS, it is sufficient to install the package via `devtools`: -```R + +```r install.packages("devtools") devtools:install_github("giabaio/BCEA") ``` +## Further details More details on `BCEA` are available in our book [_Bayesian Cost-Effectiveness Analysis with the R Package BCEA_](http://www.statistica.it/gianluca/book/bcea/) (published in the UseR! Springer series). Also, details about the package, including some references and links to a pdf presentation and some posts on my own blog) are given [here](http://www.statistica.it/gianluca/software/bcea/). + +## Licence + +MIT © [G Baio](https://github.com/giabaio). diff --git a/inst/Report/chunks/InfoRank.Rmd b/inst/Report/chunks/InfoRank.Rmd index 894d8fea..61d474a6 100644 --- a/inst/Report/chunks/InfoRank.Rmd +++ b/inst/Report/chunks/InfoRank.Rmd @@ -17,10 +17,10 @@ Another way in which the analysis of the value of information (specifically base For each parameter and value of the willingness-to-pay threshold $k$, a barchart is plotted to describe the ratio of EVPPI (specific to that parameter) to EVPI. This represents the relative 'importance' of each parameter in terms of the expected value of information. ```{r, echo=echo,fig.width=6.6, fig.height=6.6,fig.align=align,warning=FALSE,message=FALSE,comment=NA} -# Uses the BCEA function 'CreateInputs' to pre-process +# Uses the BCEA function `createInputs` to pre-process # the PSA runs and obtain a suitable format -mat=CreateInputs(psa_sims,print.lincom=FALSE) -IR=info.rank(1:ncol(mat$mat),mat$mat,he=m,wtp=wtp) +mat <- createInputs(psa_sims,print.lincom=FALSE) +IR <- info.rank(1:ncol(mat$mat),mat$mat,he=m,wtp=wtp) if(show.tab){IR$rank} ``` diff --git a/inst/Report/report.Rmd b/inst/Report/report.Rmd index 38ed5466..d9ec3600 100644 --- a/inst/Report/report.Rmd +++ b/inst/Report/report.Rmd @@ -18,7 +18,8 @@ if(ext=="pdf") { } else { align="default" } -options("scipen"=999) + +options(scipen = 999) # Check whether Info-rank should also be computed & shown if(!is.null(psa_sims)){iIR=TRUE} else {iIR=FALSE} diff --git a/man-roxygen/args-comparison.R b/man-roxygen/args-comparison.R new file mode 100644 index 00000000..8c70c35e --- /dev/null +++ b/man-roxygen/args-comparison.R @@ -0,0 +1,5 @@ +#' @param comparison Selects the comparator, in case of more than two +#' interventions being analysed. Default as NULL plots all the comparisons +#' together. Any subset of the possible comparisons can be selected (e.g., +#' \code{comparison=c(1,3)} or \code{comparison=2}). + diff --git a/man-roxygen/args-he.R b/man-roxygen/args-he.R new file mode 100644 index 00000000..42d3e9bc --- /dev/null +++ b/man-roxygen/args-he.R @@ -0,0 +1,4 @@ +#' @param he A \code{bcea} object containing the results of the Bayesian +#' modelling and the economic evaluation. + + \ No newline at end of file diff --git a/man/BCEA-package.Rd b/man/BCEA-package.Rd index 57d19c3d..23820351 100644 --- a/man/BCEA-package.Rd +++ b/man/BCEA-package.Rd @@ -11,7 +11,7 @@ and produce standardised output for the analysis of the results } \details{ \tabular{ll}{ Package: \tab BCEA\cr Type: \tab Package\cr Version: \tab -2.3-2\cr Date: \tab 2020-01-30\cr License: \tab GPL2 \cr LazyLoad: \tab +2.3-00\cr Date: \tab 2019-03-27\cr License: \tab GPL2 \cr LazyLoad: \tab yes\cr } Given the results of a Bayesian model (possibly based on MCMC) in the form of simulations from the posterior distributions of suitable variables of costs and clinical benefits for two or more interventions, diff --git a/man/CEriskav.Rd b/man/CEriskav.Rd index bdef347b..d039e86f 100644 --- a/man/CEriskav.Rd +++ b/man/CEriskav.Rd @@ -1,74 +1,52 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/CEriskav.R \name{CEriskav} \alias{CEriskav} \alias{CEriskav.default} -%- Also NEED an '\alias' for EACH other topic documented here. -\title{ -Cost-effectiveness analysis including a parameter of risk aversion -} -\description{ -Extends the standard cost-effectiveness analysis to modify the utility function so -that risk aversion of the decision maker is explicitly accounted for -} +\title{Cost-effectiveness analysis including a parameter of risk aversion} \usage{ CEriskav(he, r = NULL, comparison = 1) - -\method{CEriskav}{default}(he, r = NULL, comparison = 1) } -%- maybe also 'usage' for other objects documented here. \arguments{ - \item{he}{ -A \code{bcea} object containing the results of the Bayesian modelling and the -economic evaluation. -} - \item{r}{ -A vector of values for the risk aversion parameter. If \code{NULL}, default values -are assigned by R. The first (smallest) value (\code{r} -> 0) produces the standard -analysis with no risk aversion. -} - \item{comparison}{ -In case of more than 2 interventions being analysed, selects which plot should be made. -By default the first possible choice is selected as the comparator. -} -} -\value{ -An object of the class \code{CEriskav} containing the following elements: - \item{Ur}{An array containing the simulated values for all the ''known-distribution'' -utilities for all interventions, all the values of the willingness to pay parameter and -for all the possible values of \code{r}} -\item{Urstar}{ -An array containing the simulated values for the maximum ''known-distribution'' expected -utility for all the values of the willingness to pay parameter and for all the possible -values of \code{r}} -\item{IBr}{ -An array containing the simulated values for the distribution of the Incremental Benefit -for all the values of the willingness to pay and for all the possible values of \code{r}} -\item{eibr}{ -An array containing the Expected Incremental Benefit for each value of the willingness -to pay parameter and for all the possible values of \code{r}} -\item{vir}{ -An array containing all the simulations for the Value of Information for each value -of the willingness to pay parameter and for all the possible values of \code{r}} -\item{evir}{ -An array containing the Expected Value of Information for each value of the willingness -to pay parameter and for all the possible values of \code{r}} -\item{R}{ -The number of possible values for the parameter of risk aversion \code{r}} -\item{r}{ -The vector containing all the possible values for the parameter of risk aversion \code{r}} -} -\references{ -Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity Analysis in Health Economics. -Statistical Methods in Medical Research doi:10.1177/0962280211419832. +\item{he}{A \code{bcea} object containing the results of the Bayesian +modelling and the economic evaluation.} -Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, London +\item{r}{A vector of values for the risk aversion parameter. If \code{NULL}, +default values are assigned by R. The first (smallest) value (\code{r} -> 0) +produces the standard analysis with no risk aversion.} + +\item{comparison}{In case of more than 2 interventions being analysed, +selects which plot should be made. By default the first possible choice is +selected as the comparator.} } -\author{ -Gianluca Baio +\value{ +An object of the class \code{CEriskav} containing the following +elements: \item{Ur}{An array containing the simulated values for all the +''known-distribution'' utilities for all interventions, all the values of +the willingness to pay parameter and for all the possible values of +\code{r}} \item{Urstar}{ An array containing the simulated values for the +maximum ''known-distribution'' expected utility for all the values of the +willingness to pay parameter and for all the possible values of \code{r}} +\item{IBr}{ An array containing the simulated values for the distribution of +the Incremental Benefit for all the values of the willingness to pay and for +all the possible values of \code{r}} \item{eibr}{ An array containing the +Expected Incremental Benefit for each value of the willingness to pay +parameter and for all the possible values of \code{r}} \item{vir}{ An array +containing all the simulations for the Value of Information for each value +of the willingness to pay parameter and for all the possible values of +\code{r}} \item{evir}{ An array containing the Expected Value of Information +for each value of the willingness to pay parameter and for all the possible +values of \code{r}} \item{R}{ The number of possible values for the +parameter of risk aversion \code{r}} \item{r}{ The vector containing all the +possible values for the parameter of risk aversion \code{r}} } -\seealso{ -\code{\link{bcea}} +\description{ +Extends the standard cost-effectiveness analysis to modify the utility +function so that risk aversion of the decision maker is explicitly accounted +for. } \examples{ + # See Baio G., Dawid A.P. (2011) for a detailed description of the # Bayesian model and economic problem # @@ -100,9 +78,24 @@ cr <- CEriskav(m, # uses the results of the economic evalaution # pairwise comparison ) } + } +\references{ +Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity +Analysis in Health Economics. Statistical Methods in Medical Research +doi:10.1177/0962280211419832. -% Add one or more standard keywords, see file 'KEYWORDS' in the -% R documentation directory. -\keyword{Health economic evaluation} -\keyword{Risk aversion}% __ONLY ONE__ keyword per line +Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, +London +} +\seealso{ +\code{\link{bcea}} +} +\author{ +Gianluca Baio +} +\keyword{Health} +\keyword{Risk} +\keyword{aversion} +\keyword{economic} +\keyword{evaluation} diff --git a/man/Smoking.Rd b/man/Smoking.Rd index 9e5526b1..75b36e16 100644 --- a/man/Smoking.Rd +++ b/man/Smoking.Rd @@ -1,3 +1,6 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/BCEA-package.R +\docType{data} \name{Smoking} \alias{Smoking} \alias{data} @@ -5,70 +8,63 @@ \alias{pi} \alias{smoking} \alias{smoking_output} -\docType{data} -\title{ -Data set for the Bayesian model for the cost-effectiveness of smoking cessation -interventions -} -\description{ -This data set contains the results of the Bayesian analysis used to model the clinical -output and the costs associated with the health economic evaluation of four different -smoking cessation interventions. -} -\usage{data(Smoking)} +\title{Data set for the Bayesian model for the cost-effectiveness of smoking +cessation interventions} \format{ -A data list including the variables needed for the smoking cessation cost-effectiveness -analysis. The variables are as follows: - \describe{ - \item{\code{c}}{a matrix of 500 simulations from the posterior distribution of the -overall costs associated with the four strategies} - \item{\code{data}}{a dataset containing the characteristics of the smokers in the -UK population} - \item{\code{e}}{a matrix of 500 simulations from the posterior distribution of the -clinical benefits associated with the four strategies} - \item{\code{life.years}}{a matrix of 500 simulations from the posterior distribution -of the life years gained with each strategy} - \item{\code{pi}}{a matrix of 500 simulations from the posterior distribution of -the event of smoking cessation with each strategy} - \item{\code{smoking}}{a data frame containing the inputs needed for the network -meta-analysis model. The \code{data.frame} object contains: \code{nobs}: the record -ID number, \code{s}: the study ID number, \code{i}: the intervention ID number, -\code{r_i}: the number of patients who quit smoking, \code{n_i}: the total number of -patients for the row-specific arm and \code{b_i}: the reference intervention for -each study} - \item{\code{smoking_output}}{a \code{rjags} object obtained by running the -network meta-analysis model based on the data contained in the \code{smoking} object} - \item{\code{smoking_mat}}{a matrix obtained by running the -network meta-analysis model based on the data contained in the \code{smoking} object} - \item{\code{treats}}{a vector of labels associated with the four strategies} - } +A data list including the variables needed for the smoking cessation +cost-effectiveness analysis. The variables are as follows: \describe{ +\item{list("c")}{a matrix of 500 simulations from the posterior distribution +of the overall costs associated with the four strategies} +\item{list("data")}{a dataset containing the characteristics of the smokers +in the UK population} \item{list("e")}{a matrix of 500 simulations from the +posterior distribution of the clinical benefits associated with the four +strategies} \item{list("life.years")}{a matrix of 500 simulations from the +posterior distribution of the life years gained with each strategy} +\item{list("pi")}{a matrix of 500 simulations from the posterior +distribution of the event of smoking cessation with each strategy} +\item{list("smoking")}{a data frame containing the inputs needed for the +network meta-analysis model. The \code{data.frame} object contains: +\code{nobs}: the record ID number, \code{s}: the study ID number, \code{i}: +the intervention ID number, \code{r_i}: the number of patients who quit +smoking, \code{n_i}: the total number of patients for the row-specific arm +and \code{b_i}: the reference intervention for each study} +\item{list("smoking_output")}{a \code{rjags} object obtained by running the +network meta-analysis model based on the data contained in the +\code{smoking} object} \item{list("smoking_mat")}{a matrix obtained by +running the network meta-analysis model based on the data contained in the +\code{smoking} object} \item{list("treats")}{a vector of labels associated +with the four strategies} } } - \source{ -Effectiveness data adapted from Hasselblad V. (1998). Meta-analysis of -Multitreatment Studies. Medical Decision Making 1998;18:37-43. +Effectiveness data adapted from Hasselblad V. (1998). Meta-analysis +of Multitreatment Studies. Medical Decision Making 1998;18:37-43. Cost and population characteristics data adapted from various sources: - \itemize{ - \item Taylor, D.H. Jr, et al. (2002). Benefits of smoking cessation on -longevity. American Journal of Public Health 2002;92(6) - \item ASH: Action on Smoking and Health (2013). ASH fact sheet on -smoking statistics, \cr \code{http://ash.org.uk/files/documents/ASH_106.pdf} - \item Flack, S., et al. (2007). Cost-effectiveness of interventions for -smoking cessation. York Health Economics Consortium, January 2007 - \item McGhan, W.F.D., and Smith, M. (1996). Pharmacoeconomic analysis -of smoking-cessation interventions. American Journal of Health-System Pharmacy -1996;53:45-52 - } +\itemize{ \item Taylor, D.H. Jr, et al. (2002). Benefits of smoking +cessation on longevity. American Journal of Public Health 2002;92(6) \item +ASH: Action on Smoking and Health (2013). ASH fact sheet on smoking +statistics, \cr \code{http://ash.org.uk/files/documents/ASH_106.pdf} \item +Flack, S., et al. (2007). Cost-effectiveness of interventions for smoking +cessation. York Health Economics Consortium, January 2007 \item McGhan, +W.F.D., and Smith, M. (1996). Pharmacoeconomic analysis of smoking-cessation +interventions. American Journal of Health-System Pharmacy 1996;53:45-52 } } -\references{ -Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, London +\description{ +This data set contains the results of the Bayesian analysis used to model +the clinical output and the costs associated with the health economic +evaluation of four different smoking cessation interventions. } \examples{ + data(Smoking) \donttest{ m=bcea(e,c,ref=4,interventions=treats,Kmax=500) } + +} +\references{ +Baio G. (2012). Bayesian Methods in Health Economics. +CRC/Chapman Hall, London } \keyword{datasets} diff --git a/man/Vaccine.Rd b/man/Vaccine.Rd index 847ed2e3..9bef64cc 100644 --- a/man/Vaccine.Rd +++ b/man/Vaccine.Rd @@ -1,3 +1,6 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/BCEA-package.R +\docType{data} \name{Vaccine} \alias{Vaccine} \alias{c} @@ -11,9 +14,6 @@ \alias{cost.trt2} \alias{cost.vac} \alias{e} -\alias{e.pts} -\alias{c.pts} -\alias{vaccine_mat} \alias{N} \alias{N.outcomes} \alias{N.resources} @@ -24,88 +24,73 @@ \alias{QALYs.pne} \alias{treats} \alias{vaccine} -\docType{data} -\title{ -Data set for the Bayesian model for the cost-effectiveness of influenza -vaccination -} -\description{ -This data set contains the results of the Bayesian analysis used to model the -clinical output and the costs associated with an influenza vaccination. -} -\usage{ -data(Vaccine) -} - +\title{Data set for the Bayesian model for the cost-effectiveness of influenza +vaccination} \format{ -A data list including the variables needed for the influenza vaccination. -The variables are as follows: - - \describe{ - \item{\code{c}}{a matrix of simulations from the posterior distribution -of the overall costs associated with the two treatments} - \item{\code{cost.GP}}{a matrix of simulations from the posterior distribution -of the costs for GP visits associated with the two treatments} - \item{\code{cost.hosp}}{a matrix of simulations from the posterior distribution -of the costs for hospitalisations associated with the two treatments} - \item{\code{cost.otc}}{a matrix of simulations from the posterior distribution -of the costs for over-the-counter medications associated with the two treatments} - \item{\code{cost.time.off}}{a matrix of simulations from the posterior distribution -of the costs for time off work associated with the two treatments} - \item{\code{cost.time.vac}}{a matrix of simulations from the posterior distribution -of the costs for time needed to get the vaccination associated with the two treatments} - \item{\code{cost.travel}}{a matrix of simulations from the posterior distribution -of the costs for travel to get vaccination associated with the two treatments} - \item{\code{cost.trt1}}{a matrix of simulations from the posterior distribution -of the overall costs for first line of treatment associated with the two interventions} - \item{\code{cost.trt2}}{a matrix of simulations from the posterior distribution -of the overall costs for second line of treatment associated with the two interventions} - \item{\code{cost.vac}}{a matrix of simulations from the posterior distribution -of the costs for vaccination} - \item{\code{c.pts}}{a matrix of simulations from the posterior distribution of -the clinical benefits associated with the two treatments} - \item{\code{e}}{a matrix of simulations from the posterior distribution of -the clinical benefits associated with the two treatments} - \item{\code{e.pts}}{a matrix of simulations from the posterior distribution of -the clinical benefits associated with the two treatments} - \item{\code{N}}{the number of subjects in the reference population} - \item{\code{N.outcomes}}{the number of clinical outcomes analysed} - \item{\code{N.resources}}{the number of health-care resources under study} - \item{\code{QALYs.adv}}{a vector from the posterior distribution of the QALYs -associated with advert events} - \item{\code{QALYs.death}}{a vector from the posterior distribution of the QALYs -associated with death} - \item{\code{QALYs.hosp}}{a vector from the posterior distribution of the QALYs -associated with hospitalisation} - \item{\code{QALYs.inf}}{a vector from the posterior distribution of the QALYs -associated with influenza infection} - \item{\code{QALYs.pne}}{a vector from the posterior distribution of the QALYs -associated with penumonia} - \item{\code{treats}}{a vector of labels associated with the two treatments} - \item{\code{vaccine}}{a \code{rjags} object containing the simulations for the parameters -used in the original model} - \item{\code{vaccine_mat}}{a matrix containing the simulations for the parameters -used in the original model} - } -} +A data list including the variables needed for the influenza +vaccination. The variables are as follows: +\describe{ \item{list("c")}{a matrix of simulations from the posterior +distribution of the overall costs associated with the two treatments} +\item{list("cost.GP")}{a matrix of simulations from the posterior +distribution of the costs for GP visits associated with the two treatments} +\item{list("cost.hosp")}{a matrix of simulations from the posterior +distribution of the costs for hospitalisations associated with the two +treatments} \item{list("cost.otc")}{a matrix of simulations from the +posterior distribution of the costs for over-the-counter medications +associated with the two treatments} \item{list("cost.time.off")}{a matrix of +simulations from the posterior distribution of the costs for time off work +associated with the two treatments} \item{list("cost.time.vac")}{a matrix of +simulations from the posterior distribution of the costs for time needed to +get the vaccination associated with the two treatments} +\item{list("cost.travel")}{a matrix of simulations from the posterior +distribution of the costs for travel to get vaccination associated with the +two treatments} \item{list("cost.trt1")}{a matrix of simulations from the +posterior distribution of the overall costs for first line of treatment +associated with the two interventions} \item{list("cost.trt2")}{a matrix of +simulations from the posterior distribution of the overall costs for second +line of treatment associated with the two interventions} +\item{list("cost.vac")}{a matrix of simulations from the posterior +distribution of the costs for vaccination} \item{list("e")}{a matrix of +simulations from the posterior distribution of the clinical benefits +associated with the two treatments} \item{list("N")}{the number of subjects +in the reference population} \item{list("N.outcomes")}{the number of +clinical outcomes analysed} \item{list("N.resources")}{the number of +health-care resources under study} \item{list("QALYs.adv")}{a vector from +the posterior distribution of the QALYs associated with advert events} +\item{list("QALYs.death")}{a vector from the posterior distribution of the +QALYs associated with death} \item{list("QALYs.hosp")}{a vector from the +posterior distribution of the QALYs associated with hospitalisation} +\item{list("QALYs.inf")}{a vector from the posterior distribution of the +QALYs associated with influenza infection} \item{list("QALYs.pne")}{a vector +from the posterior distribution of the QALYs associated with penumonia} +\item{list("treats")}{a vector of labels associated with the two treatments} +\item{list("vaccine")}{a \code{rjags} object containing the simulations for +the parameters used in the original model} \item{list("vaccine_mat")}{a +matrix containing the simulations for the parameters used in the original +model} } +} \source{ -Adapted from Turner D, Wailoo A, Cooper N, Sutton A, Abrams K, Nicholson K. -The cost-effectiveness of influenza vaccination of healthy adults 50-64 years of age. -Vaccine. 2006;24:1035-1043. +Adapted from Turner D, Wailoo A, Cooper N, Sutton A, Abrams K, +Nicholson K. The cost-effectiveness of influenza vaccination of healthy +adults 50-64 years of age. Vaccine. 2006;24:1035-1043. } - -\references{ -Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity Analysis in Health Economics. -Statistical Methods in Medical Research doi:10.1177/0962280211419832. +\description{ +This data set contains the results of the Bayesian analysis used to model +the clinical output and the costs associated with an influenza vaccination. } - \examples{ + data(Vaccine) \donttest{ m=bcea(e,c,ref=1,interventions=treats) } -} +} +\references{ +Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity +Analysis in Health Economics. Statistical Methods in Medical Research +doi:10.1177/0962280211419832. +} \keyword{datasets} diff --git a/man/bcea.Rd b/man/bcea.Rd index 2d17c920..95545ee1 100644 --- a/man/bcea.Rd +++ b/man/bcea.Rd @@ -1,115 +1,107 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bcea.R \name{bcea} \alias{bcea} \alias{bcea.default} \alias{CEanalysis} -%- Also NEED an '\alias' for EACH other topic documented here. -\title{ -Bayesian Cost-Effectiveness Analysis -} -\description{ -Cost-effectiveness analysis based on the results of a simulation model for a variable -of clinical benefits (e) and of costs (c). Produces results to be post-processed to -give the health economic analysis. The output is stored in an object of the class "bcea" -} +\title{Bayesian Cost-Effectiveness Analysis} \usage{ -bcea(e, c, ref = 1, interventions = NULL, Kmax = 50000, - wtp = NULL, plot = FALSE) - -\method{bcea}{default}(e, c, ref = 1, interventions = NULL, Kmax = 50000, - wtp = NULL, plot = FALSE) +bcea( + e, + c, + ref = 1, + interventions = NULL, + Kmax = 50000, + wtp = NULL, + plot = FALSE +) } -%- maybe also 'usage' for other objects documented here. \arguments{ - \item{e}{ -An object containing \code{nsim} simulations for the variable of clinical effectiveness -for each intervention being considered. In general it is a matrix with \code{nsim} rows -and \code{nint} columns. -} - \item{c}{ -An object containing \code{nsim} simulations for the variable of cost for each -intervention being considered. In general it is a matrix with \code{nsim} rows and -\code{nint} columns. -} - \item{ref}{ -Defines which intervention (columns of \code{e} or \code{c}) is considered to be -the reference strategy. The default value \code{ref=1} means that the intervention -associated with the first column of \code{e} or \code{c} is the reference and the one(s) -associated with the other column(s) is(are) the comparators. -} - \item{interventions}{ -Defines the labels to be associated with each intervention. By default and if -\code{NULL}, assigns labels in the form "Intervention1", ... , "Intervention T". -} - \item{Kmax}{ -Maximum value of the willingness to pay to be considered. Default value is -\code{k=50000}. The willingness to pay is then approximated on a discrete grid in the -interval \code{[0,Kmax]}. The grid is equal to \code{wtp} if the parameter is given, or -composed of \code{501} elements if \code{wtp=NULL} (the default). -} - \item{wtp}{ -A(n optional) vector wtp including the values of the willingness to pay grid. If not -specified then BCEA will construct a grid of 501 values from 0 to Kmax. This option is -useful when performing intensive computations (eg for the EVPPI). -} - \item{plot}{ -A logical value indicating whether the function should produce the summary plot or not. - } +\item{e}{An object containing \code{nsim} simulations for the variable of +clinical effectiveness for each intervention being considered. In general it +is a matrix with \code{nsim} rows and \code{nint} columns.} + +\item{c}{An object containing \code{nsim} simulations for the variable of +cost for each intervention being considered. In general it is a matrix with +\code{nsim} rows and \code{nint} columns.} + +\item{ref}{Defines which intervention (columns of \code{e} or \code{c}) is +considered to be the reference strategy. The default value \code{ref=1} +means that the intervention associated with the first column of \code{e} or +\code{c} is the reference and the one(s) associated with the other column(s) +is(are) the comparators.} + +\item{interventions}{Defines the labels to be associated with each +intervention. By default and if \code{NULL}, assigns labels in the form +"Intervention1", ... , "Intervention T".} + +\item{Kmax}{Maximum value of the willingness to pay to be considered. +Default value is \code{k=50000}. The willingness to pay is then approximated +on a discrete grid in the interval \code{[0,Kmax]}. The grid is equal to +\code{wtp} if the parameter is given, or composed of \code{501} elements if +\code{wtp=NULL} (the default).} + +\item{wtp}{A(n optional) vector wtp including the values of the willingness +to pay grid. If not specified then BCEA will construct a grid of 501 values +from 0 to Kmax. This option is useful when performing intensive computations +(e.g. for the EVPPI).} + +\item{plot}{A logical value indicating whether the function should produce +the summary plot or not.} } \value{ An object of the class "bcea" containing the following elements - \item{n.sim}{Number of simulations produced by the Bayesian model} - \item{n.comparators}{Number of interventions being analysed} - \item{n.comparisons}{Number of possible pairwise comparisons} - \item{delta.e}{For each possible comparison, the differential in the effectiveness -measure} - \item{delta.c}{For each possible comparison, the differential in the cost measure} - \item{ICER}{The value of the Incremental Cost-Effectiveness Ratio} - \item{Kmax}{The maximum value assumed for the willingness to pay threshold} - \item{k}{The vector of values for the grid approximation of the willingness to pay} - \item{ceac}{The value for the Cost-Effectiveness Acceptability Curve, as a function of -the willingness to pay} - \item{ib}{The distribution of the Incremental Benefit, for a given willingness to pay} - \item{eib}{The value for the Expected Incremental Benefit, as a function of the -willingness to pay} - \item{kstar}{The grid approximation of the break even point(s)} - \item{best}{A vector containing the numeric label of the intervention that is the most -cost-effective for each value of the willingness to pay in the selected grid approximation} - \item{U}{An array including the value of the expected utility for each simulation from -the Bayesian model, for each value of the grid approximation of the willingness to pay and -for each intervention being considered} -\item{vi}{An array including the value of information for each simulation from the -Bayesian model and for each value of the grid approximation of the willingness to pay} -\item{Ustar}{An array including the maximum "known-distribution" utility for each -simulation from the Bayesian model and for each value of the grid approximation of -the willingness to pay} - \item{ol}{An array including the opportunity loss for each simulation from the Bayesian -model and for each value of the grid approximation of the willingness to pay} - \item{evi}{The vector of values for the Expected Value of Information, as a function -of the willingness to pay} - \item{interventions}{A vector of labels for all the interventions considered} - \item{ref}{The numeric index associated with the intervention used as reference in the analysis} - \item{comp}{The numeric index(es) associated with the intervention(s) used as comparator(s) -in the analysis} - \item{step}{The step used to form the grid approximation to the willingness to pay} - \item{e}{The \code{e} matrix used to generate the object (see Arguments)} - \item{c}{The \code{c} matrix used to generate the object (see Arguments)} +\item{n.sim}{Number of simulations produced by the Bayesian model} +\item{n.comparators}{Number of interventions being analysed} +\item{n.comparisons}{Number of possible pairwise comparisons} +\item{delta.e}{For each possible comparison, the differential in the +effectiveness measure} \item{delta.c}{For each possible comparison, the +differential in the cost measure} \item{ICER}{The value of the Incremental +Cost-Effectiveness Ratio} \item{Kmax}{The maximum value assumed for the +willingness to pay threshold} \item{k}{The vector of values for the grid +approximation of the willingness to pay} \item{ceac}{The value for the +Cost-Effectiveness Acceptability Curve, as a function of the willingness to +pay} \item{ib}{The distribution of the Incremental Benefit, for a given +willingness to pay} \item{eib}{The value for the Expected Incremental +Benefit, as a function of the willingness to pay} \item{kstar}{The grid +approximation of the break even point(s)} \item{best}{A vector containing +the numeric label of the intervention that is the most cost-effective for +each value of the willingness to pay in the selected grid approximation} +\item{U}{An array including the value of the expected utility for each +simulation from the Bayesian model, for each value of the grid approximation +of the willingness to pay and for each intervention being considered} +\item{vi}{An array including the value of information for each simulation +from the Bayesian model and for each value of the grid approximation of the +willingness to pay} \item{Ustar}{An array including the maximum +"known-distribution" utility for each simulation from the Bayesian model and +for each value of the grid approximation of the willingness to pay} +\item{ol}{An array including the opportunity loss for each simulation from +the Bayesian model and for each value of the grid approximation of the +willingness to pay} \item{evi}{The vector of values for the Expected Value +of Information, as a function of the willingness to pay} +\item{interventions}{A vector of labels for all the interventions +considered} \item{ref}{The numeric index associated with the intervention +used as reference in the analysis} \item{comp}{The numeric index(es) +associated with the intervention(s) used as comparator(s) in the analysis} +\item{step}{The step used to form the grid approximation to the willingness +to pay} \item{e}{The \code{e} matrix used to generate the object (see +Arguments)} \item{c}{The \code{c} matrix used to generate the object (see +Arguments)} } -\references{ -Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity Analysis in Health Economics. -Statistical Methods in Medical Research doi:10.1177/0962280211419832. - -Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, London -} -\author{ -Gianluca Baio, Andrea Berardi +\description{ +Cost-effectiveness analysis based on the results of a simulation model for a +variable of clinical benefits (e) and of costs (c). Produces results to be +post-processed to give the health economic analysis. The output is stored in +an object of the class "bcea" } \examples{ + # See Baio G., Dawid A.P. (2011) for a detailed description of the # Bayesian model and economic problem # # Load the processed results of the MCMC simulation model data(Vaccine) -# + # Runs the health economic evaluation using BCEA m <- bcea(e=e,c=c, # defines the variables of # effectiveness and cost @@ -122,9 +114,9 @@ m <- bcea(e=e,c=c, # defines the variables of # in a grid from the interval (0,Kmax) plot=TRUE # plots the results ) -# + # Creates a summary table -summary(m, # uses the results of the economic evalaution +summary(m, # uses the results of the economic evaluation # (a "bcea" object) wtp=25000 # selects the particular value for k ) @@ -218,8 +210,20 @@ ceac.plot(m) evi.plot(m) # } + } +\references{ +Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity +Analysis in Health Economics. Statistical Methods in Medical Research +doi:10.1177/0962280211419832. -% Add one or more standard keywords, see file 'KEYWORDS' in the -% R documentation directory. -\keyword{Health economic evaluation} +Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, +London +} +\author{ +Gianluca Baio, Andrea Berardi +} +\keyword{Health} +\keyword{economic} +\keyword{evaluation} +\keyword{manip} diff --git a/man/bcea.default.Rd b/man/bcea.default.Rd new file mode 100644 index 00000000..1f2741ef --- /dev/null +++ b/man/bcea.default.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bcea.default.R +\name{bcea.default} +\alias{bcea.default} +\title{Default function} +\usage{ +\method{bcea}{default}( + eff, + cost, + ref = 1, + interventions = NULL, + Kmax = 50000, + wtp = NULL, + plot = FALSE +) +} +\value{ +List of computed values for CE Plane, ICER, EIB, CEAC, EVPI +} +\description{ +Compute a Bayesian cost-effectiveness analysis of two or more interv_names +} +\details{ +INPUTS: +1. Two objects (`e`,`c`). These can be directly computed in a simulation object `sim` from JAGS/BUGS, + or derived by postprocessing of `sim` in R. The objects (`e`,`c`) have dimension (`n_sim` x number of + interv_names) and contain n_sim simulated values for the measures of effectiveness and costs + for each intervention being compared. +2. The reference intervention as a numeric value. Each intervention is a column in the matrices `e` + and `c` so if `ref` = 1 the first column is assumed to be associated with the reference intervention. + Intervention 1 is assumed the default reference. All others are considered comparators. +3. A string vector "interv_names" including the names of the interv_names. If none is provided + then labels each as "intervention1",...,"interventionN". +4. The value `Kmax` which represents the maximum value for the willingness to pay parameter. If none + is provided, then it is assumed `Kmax` = 50000. +5. A(n optional) vector wtp including the values of the willingness to pay grid. If not specified + then `bcea` will construct a grid of 501 values from 0 to `Kmax`. This option is useful when + performing intensive computations (e.g. for the EVPPI) +} diff --git a/man/best_interv_given_k.Rd b/man/best_interv_given_k.Rd new file mode 100644 index 00000000..dbde54f3 --- /dev/null +++ b/man/best_interv_given_k.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/best_interv_given_k.R +\name{best_interv_given_k} +\alias{best_interv_given_k} +\title{Select best option for each value of willingness to pay} +\usage{ +best_interv_given_k(eib, ref, comp) +} +\arguments{ +\item{eib}{Expected incremental benefit} +} +\value{ + +} +\description{ +Select best option for each value of willingness to pay +} +\examples{ + +} diff --git a/man/ceaf.plot.Rd b/man/ceaf.plot.Rd index 190d4ced..1bc2981e 100644 --- a/man/ceaf.plot.Rd +++ b/man/ceaf.plot.Rd @@ -1,47 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ceaf.plot.R \name{ceaf.plot} \alias{ceaf.plot} -%- Also NEED an '\alias' for EACH other topic documented here. -\title{ -Cost-Effectiveness Acceptability Frontier (CEAF) plot -} -\description{ -Produces a plot the Cost-Effectiveness Acceptability Frontier (CEAF) against the -willingness to pay threshold -} +\title{Cost-Effectiveness Acceptability Frontier (CEAF) plot} \usage{ -ceaf.plot(mce, graph=c("base","ggplot2")) +ceaf.plot(mce, graph = c("base", "ggplot2")) } -%- maybe also 'usage' for other objects documented here. \arguments{ - \item{mce}{ -The output of the call to the function \code{\link{multi.ce}}} - \item{graph}{ -A string used to select the graphical engine to use for plotting. Should -(partial-)match the two options \code{"base"} or \code{"ggplot2"}. Default value -is \code{"base"}. - } -} -\value{ -\item{ceaf}{ - A ggplot object containing the plot. Returned only if \code{graph="ggplot2"}. -} -} -\references{ -Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity Analysis in Health Economics. -Statistical Methods in Medical Research doi:10.1177/0962280211419832. +\item{mce}{The output of the call to the function \code{\link{multi.ce}}} -Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, London +\item{graph}{A string used to select the graphical engine to use for +plotting. Should (partial-)match the two options \code{"base"} or +\code{"ggplot2"}. Default value is \code{"base"}.} } -\author{ -Gianluca Baio, Andrea Berardi +\value{ +\item{ceaf}{ A ggplot object containing the plot. Returned only if +\code{graph="ggplot2"}. } } - -%% ~Make other sections like Warning with \section{Warning }{....} ~ - -\seealso{ -\code{\link{bcea}}, \code{\link{multi.ce}} +\description{ +Produces a plot the Cost-Effectiveness Acceptability Frontier (CEAF) against +the willingness to pay threshold } \examples{ + # See Baio G., Dawid A.P. (2011) for a detailed description of the # Bayesian model and economic problem # @@ -80,8 +61,24 @@ m <- bcea(e,c,ref=4,intervention=treats,Kmax=500,plot=FALSE) mce <- multi.ce(m) ceaf.plot(mce) } + +} +\references{ +Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity +Analysis in Health Economics. Statistical Methods in Medical Research +doi:10.1177/0962280211419832. + +Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, +London +} +\seealso{ +\code{\link{bcea}}, \code{\link{multi.ce}} +} +\author{ +Gianluca Baio, Andrea Berardi } -% Add one or more standard keywords, see file 'KEYWORDS' in the -% R documentation directory. -\keyword{Health economic evaluation} -\keyword{Multiple comparison} +\keyword{Health} +\keyword{Multiple} +\keyword{comparison} +\keyword{economic} +\keyword{evaluation} diff --git a/man/ceef.plot.Rd b/man/ceef.plot.Rd index fce19c17..ed81bf20 100644 --- a/man/ceef.plot.Rd +++ b/man/ceef.plot.Rd @@ -1,121 +1,115 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ceef.plot.R \name{ceef.plot} \alias{ceef.plot} -%- Also NEED an '\alias' for EACH other topic documented here. -\title{ -Cost-Effectiveness Efficiency Frontier (CEAF) plot -} -\description{ -Produces a plot of the Cost-Effectiveness Efficiency Frontier (CEEF) -} +\title{Cost-Effectiveness Efficiency Frontier (CEAF) plot} \usage{ -ceef.plot(he, comparators = NULL, pos = c(1, 1), -start.from.origins = TRUE, threshold = NULL, flip = FALSE, -dominance = TRUE, relative = FALSE, print.summary = TRUE, -graph = c("base", "ggplot2"), ...) +ceef.plot( + he, + comparators = NULL, + pos = c(1, 1), + start.from.origins = TRUE, + threshold = NULL, + flip = FALSE, + dominance = TRUE, + relative = FALSE, + print.summary = TRUE, + graph = c("base", "ggplot2"), + ... +) } -%- maybe also 'usage' for other objects documented here. \arguments{ - \item{he}{ -A \code{bcea} object containing the results of the Bayesian modelling and the -economic evaluation. The list needs to include the \code{e} and \code{c} matrices -used to generate the object; see Details. -} - \item{comparators}{ -Vector specifying the comparators to be included in the frontier analysis. Must be -of length > 1. Default as \code{NULL} includes all the available comparators. -} - \item{pos}{ -Parameter to set the position of the legend. Can be given in form of a string -\code{(bottom|top)(right|left)} for base graphics and \code{bottom}, \code{top}, -\code{left} or \code{right} for ggplot2. It can be a two-elements vector, which -specifies the relative position on the x and y axis respectively, or alternatively -it can be in form of a logical variable, with \code{FALSE} indicating to use the -default position and \code{TRUE} to place it on the bottom of the plot. Default -value is \code{c(1,1)}, that is the topright corner inside the plot area.} - \item{start.from.origins}{ -Logical. Should the frontier start from the origins of the axes? The argument is -reset to \code{FALSE} if the average effectiveness and/or costs of at least one -comparator are negative. -} - \item{threshold}{ -Specifies if the efficiency should be defined based on a willingness-to-pay threshold -value. If set to \code{NULL} (the default), no conditions are included on the slope -increase. If a positive value is passed as argument, to be efficient an intervention -also requires to have an ICER for the comparison versus the last efficient strategy -not greater than the specified threshold value. A negative value will be ignored with -a warning. -} - \item{flip}{ -Logical. Should the axes of the plane be inverted? -} - \item{dominance}{ -Logical. Should the dominance regions be included in the plot? -} - \item{relative}{ -Logical. Should the plot display the absolute measures (the default as \code{FALSE}) -or the differential outcomes versus the reference comparator? - } - \item{print.summary}{ -Logical. Should the efficiency frontier summary be printed along with the graph? -See Details for additional information. - } - \item{graph}{ -A string used to select the graphical engine to use for plotting. Should (partial-)match -the two options \code{"base"} or \code{"ggplot2"}. Default value is \code{"base"}. -} - \item{\dots}{ -If \code{graph="ggplot2"} and a named theme object is supplied, it will be added to -the ggplot object. Ignored if \code{graph="base"}. Setting the optional argument -\code{include.ICER} to \code{TRUE} will print the ICERs in the summary tables, -if produced.} -} -\details{ -The \code{bcea} objects did not include the generating \code{e} and \code{c} matrices -in BCEA versions <2.1-0. This function is not compatible with objects created with -previous versions. The matrices can be appended to \code{bcea} objects obtained using -previous versions, making sure that the class of the object remains unaltered. +\item{he}{A \code{bcea} object containing the results of the Bayesian +modelling and the economic evaluation. The list needs to include the +\code{e} and \code{c} matrices used to generate the object; see Details.} + +\item{comparators}{Vector specifying the comparators to be included in the +frontier analysis. Must be of length > 1. Default as \code{NULL} includes +all the available comparators.} + +\item{pos}{Parameter to set the position of the legend. Can be given in form +of a string \code{(bottom|top)(right|left)} for base graphics and +\code{bottom}, \code{top}, \code{left} or \code{right} for ggplot2. It can +be a two-elements vector, which specifies the relative position on the x and +y axis respectively, or alternatively it can be in form of a logical +variable, with \code{FALSE} indicating to use the default position and +\code{TRUE} to place it on the bottom of the plot. Default value is +\code{c(1,1)}, that is the topright corner inside the plot area.} + +\item{start.from.origins}{Logical. Should the frontier start from the +origins of the axes? The argument is reset to \code{FALSE} if the average +effectiveness and/or costs of at least one comparator are negative.} + +\item{threshold}{Specifies if the efficiency should be defined based on a +willingness-to-pay threshold value. If set to \code{NULL} (the default), no +conditions are included on the slope increase. If a positive value is passed +as argument, to be efficient an intervention also requires to have an ICER +for the comparison versus the last efficient strategy not greater than the +specified threshold value. A negative value will be ignored with a warning.} -The argument \code{print.summary} allows for printing a brief summary of the efficiency -frontier, with default to \code{TRUE}. Two tables are plotted, one for the interventions -included in the frontier and one for the dominated interventions. The average costs and -clinical benefits are included for each intervention. The frontier table includes the -slope for the increase in the frontier and the non-frontier table displays the dominance -type of each dominated intervention. Please note that the slopes are defined as the -increment in the costs for a unit increment in the benefits even if \code{flip = TRUE} -for consistency with the ICER definition. The angle of increase is in radians and depends -on the definition of the axes, i.e. on the value given to the \code{flip} argument. +\item{flip}{Logical. Should the axes of the plane be inverted?} -If the argument \code{relative} is set to \code{TRUE}, the graph will not display the -absolute measures of costs and benefits. Instead the axes will represent differential -costs and benefits compared to the reference intervention (indexed by \code{ref} in -the \code{\link{bcea}} function). +\item{dominance}{Logical. Should the dominance regions be included in the +plot?} + +\item{relative}{Logical. Should the plot display the absolute measures (the +default as \code{FALSE}) or the differential outcomes versus the reference +comparator?} + +\item{print.summary}{Logical. Should the efficiency frontier summary be +printed along with the graph? See Details for additional information.} + +\item{graph}{A string used to select the graphical engine to use for +plotting. Should (partial-)match the two options \code{"base"} or +\code{"ggplot2"}. Default value is \code{"base"}.} + +\item{\dots}{If \code{graph="ggplot2"} and a named theme object is supplied, +it will be added to the ggplot object. Ignored if \code{graph="base"}. +Setting the optional argument \code{include.ICER} to \code{TRUE} will print +the ICERs in the summary tables, if produced.} } \value{ -\item{ceplane}{ -A ggplot object containing the plot. Returned only if \code{graph="ggplot2"}. +\item{ceplane}{ A ggplot object containing the plot. Returned only +if \code{graph="ggplot2"}. } The function produces a plot of the +cost-effectiveness efficiency frontier. The dots show the simulated values +for the intervention-specific distributions of the effectiveness and costs. +The circles indicate the average of each bivariate distribution, with the +numbers referring to each included intervention. The numbers inside the +circles are black if the intervention is included in the frontier and grey +otherwise. If the option \code{dominance} is set to \code{TRUE}, the +dominance regions are plotted, indicating the areas of dominance. +Interventions in the areas between the dominance region and the frontier are +in a situation of extended dominance. } -The function produces a plot of the cost-effectiveness efficiency frontier. The dots -show the simulated values for the intervention-specific distributions of the -effectiveness and costs. The circles indicate the average of each bivariate -distribution, with the numbers referring to each included intervention. The numbers -inside the circles are black if the intervention is included in the frontier and grey -otherwise. If the option \code{dominance} is set to \code{TRUE}, the dominance regions -are plotted, indicating the areas of dominance. Interventions in the areas between -the dominance region and the frontier are in a situation of extended dominance. +\description{ +Produces a plot of the Cost-Effectiveness Efficiency Frontier (CEEF) } -\references{ -Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, London. +\details{ +The \code{bcea} objects did not include the generating \code{e} and \code{c} +matrices in BCEA versions <2.1-0. This function is not compatible with +objects created with previous versions. The matrices can be appended to +\code{bcea} objects obtained using previous versions, making sure that the +class of the object remains unaltered. -IQWIG (2009). General methods for the Assessment of the Relation of Benefits to Cost, -Version 1.0. IQWIG, November 2009. -} -\author{ -Andrea Berardi, Gianluca Baio -} -\seealso{ -\code{\link{bcea}} +The argument \code{print.summary} allows for printing a brief summary of the +efficiency frontier, with default to \code{TRUE}. Two tables are plotted, +one for the interventions included in the frontier and one for the dominated +interventions. The average costs and clinical benefits are included for each +intervention. The frontier table includes the slope for the increase in the +frontier and the non-frontier table displays the dominance type of each +dominated intervention. Please note that the slopes are defined as the +increment in the costs for a unit increment in the benefits even if +\code{flip = TRUE} for consistency with the ICER definition. The angle of +increase is in radians and depends on the definition of the axes, i.e. on +the value given to the \code{flip} argument. + +If the argument \code{relative} is set to \code{TRUE}, the graph will not +display the absolute measures of costs and benefits. Instead the axes will +represent differential costs and benefits compared to the reference +intervention (indexed by \code{ref} in the \code{\link{bcea}} function). } \examples{ + ### create the bcea object m for the smoking cessation example data(Smoking) m <- bcea(e,c,ref=4,Kmax=500,interventions=treats) @@ -131,8 +125,23 @@ ceef.plot(m,dominance=TRUE,start.from.origins=FALSE,pos=TRUE, print.summary=FALSE,graph="ggplot2") } } + +} +\references{ +Baio G. (2012). Bayesian Methods in Health Economics. +CRC/Chapman Hall, London. + +IQWIG (2009). General methods for the Assessment of the Relation of Benefits +to Cost, Version 1.0. IQWIG, November 2009. +} +\seealso{ +\code{\link{bcea}} +} +\author{ +Andrea Berardi, Gianluca Baio } -% Add one or more standard keywords, see file 'KEYWORDS' in the -% R documentation directory. -\keyword{Health economic evaluation} -\keyword{Multiple comparisons} +\keyword{Health} +\keyword{Multiple} +\keyword{comparisons} +\keyword{economic} +\keyword{evaluation} diff --git a/man/ceplane.plot.Rd b/man/ceplane.plot.Rd index 03b83145..80b3dd64 100644 --- a/man/ceplane.plot.Rd +++ b/man/ceplane.plot.Rd @@ -4,9 +4,17 @@ \alias{ceplane.plot} \title{Cost-effectiveness plane plot} \usage{ -ceplane.plot(he, comparison = NULL, wtp = 25000, pos = c(1, 1), - size = NULL, graph = c("base", "ggplot2"), xlim = NULL, - ylim = NULL, ...) +ceplane.plot( + he, + comparison = NULL, + wtp = 25000, + pos = c(1, 1), + size = NULL, + graph = c("base", "ggplot2"), + xlim = NULL, + ylim = NULL, + ... +) } \arguments{ \item{he}{A \code{bcea} object containing the results of the Bayesian diff --git a/man/compute_IB.Rd b/man/compute_IB.Rd new file mode 100644 index 00000000..1e76f72e --- /dev/null +++ b/man/compute_IB.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/compute_IB.R +\name{compute_IB} +\alias{compute_IB} +\title{Compute Incremental Benefit} +\usage{ +compute_IB(df_ce, k) +} +\arguments{ +\item{df_ce}{Dataframe of cost and effectiveness deltas} + +\item{k}{Vector of willingness to pay values} +} +\value{ + +} +\description{ +Compute Incremental Benefit +} +\examples{ + +} diff --git a/man/compute_U.Rd b/man/compute_U.Rd new file mode 100644 index 00000000..06aa528c --- /dev/null +++ b/man/compute_U.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/compute_xxx.R +\name{compute_U} +\alias{compute_U} +\title{Compute U statistic} +\usage{ +compute_U(df_ce, k) +} +\arguments{ +\item{df_ce}{} + +\item{k}{Willingness to pay vector} +} +\value{ +U +} +\description{ +Compute U statistic +} diff --git a/man/compute_Ustar.Rd b/man/compute_Ustar.Rd new file mode 100644 index 00000000..91fcd753 --- /dev/null +++ b/man/compute_Ustar.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/compute_xxx.R +\name{compute_Ustar} +\alias{compute_Ustar} +\title{Compute Ustar statistic} +\usage{ +compute_Ustar(n_sim, K, U) +} +\arguments{ +\item{n_sim}{} + +\item{K}{} + +\item{U}{} +} +\value{ +Ustar +} +\description{ +Compute Ustar statistic +} diff --git a/man/compute_kstar.Rd b/man/compute_kstar.Rd new file mode 100644 index 00000000..875641c2 --- /dev/null +++ b/man/compute_kstar.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/compute_xxx.R +\name{compute_kstar} +\alias{compute_kstar} +\title{Compute kstar} +\usage{ +compute_kstar(k, best, ref) +} +\arguments{ +\item{k}{} + +\item{best}{} + +\item{ref}{} +} +\value{ +kstar +} +\description{ +Find k when optimal decision changes. +} diff --git a/man/compute_ol.Rd b/man/compute_ol.Rd new file mode 100644 index 00000000..59dad534 --- /dev/null +++ b/man/compute_ol.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/compute_xxx.R +\name{compute_ol} +\alias{compute_ol} +\title{Compute ol} +\usage{ +compute_ol(n_sim, K, Ustar, U, best) +} +\arguments{ +\item{n_sim}{} + +\item{K}{} + +\item{Ustar}{} + +\item{U}{} + +\item{best}{} +} +\value{ +ol +} +\description{ +Compute ol +} diff --git a/man/compute_vi.Rd b/man/compute_vi.Rd new file mode 100644 index 00000000..68bfc038 --- /dev/null +++ b/man/compute_vi.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/compute_xxx.R +\name{compute_vi} +\alias{compute_vi} +\title{Compute Value of Information} +\usage{ +compute_vi(n_sim, K, Ustar, U) +} +\arguments{ +\item{n_sim}{} + +\item{K}{} + +\item{Ustar}{} + +\item{U}{} +} +\value{ +vi +} +\description{ +Compute Value of Information +} diff --git a/man/contour.bcea.Rd b/man/contour.bcea.Rd index e606acb6..efc680ad 100644 --- a/man/contour.bcea.Rd +++ b/man/contour.bcea.Rd @@ -1,85 +1,94 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/contour.bcea.R \name{contour.bcea} \alias{contour.bcea} -%- Also NEED an '\alias' for EACH other topic documented here. -\title{ -Contour method for objects in the class \code{bcea} -} -\description{ -Produces a scatterplot of the cost-effectiveness plane, with a contour-plot of the -bivariate density of the differentials of cost (y-axis) and effectiveness (x-axis) -} +\title{Contour method for objects in the class \code{bcea}} \usage{ -\method{contour}{bcea}(x, comparison = 1, scale = 0.5, nlevels = 4, levels = NULL, - pos = c(1,0), xlim=NULL, ylim=NULL, graph=c("base","ggplot2"), ...) +\method{contour}{bcea}( + x, + comparison = 1, + scale = 0.5, + nlevels = 4, + levels = NULL, + pos = c(1, 0), + xlim = NULL, + ylim = NULL, + graph = c("base", "ggplot2"), + ... +) } - \arguments{ - \item{x}{ -A \code{bcea} object containing the results of the Bayesian modelling and the economic -evaluation -} - \item{comparison}{ -In case of more than 2 interventions being analysed, selects which plot should be made. -By default the first comparison among the possible ones will be plotted. If -\code{graph="ggplot2"} any subset of the possible comparisons can be selected, and -\code{comparison=NULL} will yield a plot of all the possible comparisons together. -} - \item{scale}{ -Scales the plot as a function of the observed standard deviation. -} - \item{levels}{ -Numeric vector of levels at which to draw contour lines. Will be ignored using -\code{graph="ggplot2"}. -} - \item{nlevels}{ -Number of levels to be plotted in the contour. -} - \item{pos}{ -Parameter to set the position of the legend. Can be given in form of a string -\code{(bottom|top)(right|left)} for base graphics and \code{bottom}, \code{top}, -\code{left} or \code{right} for ggplot2. It can be a two-elements vector, which -specifies the relative position on the x and y axis respectively, or alternatively it - can be in form of a logical variable, with \code{FALSE} indicating to use the default -position and \code{TRUE} to place the legend on the bottom of the plot. Default value is -\code{c(1,0)}, that is the bottomright corner inside the plot area. - } - \item{graph}{ - A string used to select the graphical engine to use for plotting. Should (partial-)match -the two options \code{"base"} or \code{"ggplot2"}. Default value is \code{"base"}. - } - \item{xlim}{The range of the plot along the x-axis. If NULL (default) it is determined -by the range of the simulated values for \code{delta.e}} - \item{ylim}{The range of the plot along the y-axis. If NULL (default) it is determined -by the range of the simulated values for \code{delta.c}} -\item{...}{ -Additional arguments to 'plot.window', 'title', 'Axis' and 'box', typically graphical -parameters such as 'cex.axis'. Will be ignored if \code{graph="ggplot2"}. -} +\item{x}{A \code{bcea} object containing the results of the Bayesian +modelling and the economic evaluation} + +\item{comparison}{In case of more than 2 interventions being analysed, +selects which plot should be made. By default the first comparison among +the possible ones will be plotted. If \code{graph="ggplot2"} any subset of +the possible comparisons can be selected, and \code{comparison=NULL} will +yield a plot of all the possible comparisons together.} + +\item{scale}{Scales the plot as a function of the observed standard +deviation.} + +\item{nlevels}{Number of levels to be plotted in the contour.} + +\item{levels}{Numeric vector of levels at which to draw contour lines. Will +be ignored using \code{graph="ggplot2"}.} + +\item{pos}{Parameter to set the position of the legend. Can be given in form +of a string \code{(bottom|top)(right|left)} for base graphics and +\code{bottom}, \code{top}, \code{left} or \code{right} for ggplot2. It can +be a two-elements vector, which specifies the relative position on the x and +y axis respectively, or alternatively it can be in form of a logical +variable, with \code{FALSE} indicating to use the default position and +\code{TRUE} to place the legend on the bottom of the plot. Default value is +\code{c(1,0)}, that is the bottomright corner inside the plot area.} + +\item{xlim}{The range of the plot along the x-axis. If NULL (default) it is +determined by the range of the simulated values for \code{delta.e}} + +\item{ylim}{The range of the plot along the y-axis. If NULL (default) it is +determined by the range of the simulated values for \code{delta.c}} + +\item{graph}{A string used to select the graphical engine to use for +plotting. Should (partial-)match the two options \code{"base"} or +\code{"ggplot2"}. Default value is \code{"base"}.} + +\item{...}{Additional arguments to 'plot.window', 'title', 'Axis' and +'box', typically graphical parameters such as 'cex.axis'. Will be ignored if +\code{graph="ggplot2"}.} } \value{ -\item{ceplane}{ -A ggplot object containing the plot. Returned only if \code{graph="ggplot2"}. +\item{ceplane}{ A ggplot object containing the plot. Returned only +if \code{graph="ggplot2"}. } Plots the cost-effectiveness plane with a +scatterplot of all the simulated values from the (posterior) bivariate +distribution of (Delta_e,Delta_c), the differentials of effectiveness and +costs; superimposes a contour of the distribution and prints the estimated +value of the probability of each quadrant (combination of positive/negative +values for both Delta_e and Delta_c) } -Plots the cost-effectiveness plane with a scatterplot of all the simulated values from -the (posterior) bivariate distribution of (Delta_e,Delta_c), the differentials of -effectiveness and costs; superimposes a contour of the distribution and prints the -estimated value of the probability of each quadrant (combination of positive/negative -values for both Delta_e and Delta_c) +\description{ +Produces a scatterplot of the cost-effectiveness plane, with a contour-plot +of the bivariate density of the differentials of cost (y-axis) and +effectiveness (x-axis) } \references{ -Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity Analysis in Health Economics. -Statistical Methods in Medical Research doi:10.1177/0962280211419832. +Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity +Analysis in Health Economics. Statistical Methods in Medical Research +doi:10.1177/0962280211419832. -Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, London +Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, +London } -\author{ -Gianluca Baio, Andrea Berardi -} - \seealso{ -\code{\link{bcea}}, -\code{\link{ceplane.plot}}, +\code{\link{bcea}}, \code{\link{ceplane.plot}}, \code{\link{contour2}} } -\keyword{Health economic evaluation} -\keyword{Bayesian model} +\author{ +Gianluca Baio, Andrea Berardi +} +\keyword{Bayesian} +\keyword{Health} +\keyword{economic} +\keyword{evaluation} +\keyword{model} diff --git a/man/contour2.Rd b/man/contour2.Rd index d7d448e8..b2ceb7d3 100644 --- a/man/contour2.Rd +++ b/man/contour2.Rd @@ -1,74 +1,61 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/contour2.R \name{contour2} \alias{contour2} -%- Also NEED an '\alias' for EACH other topic documented here. -\title{ -Specialised contour plot for objects in the class "bcea" -} -\description{ -Produces a scatterplot of the cost-effectiveness plane, with a contour-plot of the -bivariate density of the differentials of cost (y-axis) and effectiveness (x-axis). -Also adds the sustainability area (i.e. below the selected value of the -willingness-to-pay threshold). -} +\title{Specialised contour plot for objects in the class "bcea"} \usage{ -contour2(he, wtp=25000, xlim=NULL, ylim=NULL, comparison=NULL, - graph=c("base","ggplot2"),...) +contour2( + he, + wtp = 25000, + xlim = NULL, + ylim = NULL, + comparison = NULL, + graph = c("base", "ggplot2"), + ... +) } -%- maybe also 'usage' for other objects documented here. \arguments{ - \item{he}{ -A "bcea" object containing the results of the Bayesian modelling and the economic -evaluation -} - \item{wtp}{ -The selected value of the willingness-to-pay. Default is \code{25000}. -} - \item{xlim}{ -Limits on the x-axis (default=\code{NULL}, so that R will select appropriate limits). -} - \item{ylim}{ -Limits on the y-axis (default=\code{NULL}, so that R will select appropriate limits). -} - \item{comparison}{ -The comparison being plotted. Default to \code{NULL} chooses the first comparison if -\code{graph="base"}. If \code{graph="ggplot2"} the default value will choose all the -possible comparisons. Any subset of the possible comparisons can be selected (e.g., -\code{comparison=c(1,3)}). -} - \item{graph}{ -A string used to select the graphical engine to use for plotting. Should (partial-)match -the two options \code{"base"} or \code{"ggplot2"}. Default value is \code{"base"}. - } - \item{...}{ -Arguments to be passed to \code{\link{ceplane.plot}}. See the relative manual page for -more details. - } -} -\value{ -\item{contour}{ -A ggplot item containing the requested plot. Returned only if \code{graph="ggplot2"}. -} -Plots the cost-effectiveness plane with a scatterplot of all the simulated values from -the (posterior) bivariate distribution of (Delta_e,Delta_c), the differentials of -effectiveness and costs; superimposes a contour of the distribution and prints the value -of the ICER, together with the sustainability area. -} -\references{ -Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity Analysis in Health Economics. -Statistical Methods in Medical Research doi:10.1177/0962280211419832. +\item{he}{A "bcea" object containing the results of the Bayesian modelling +and the economic evaluation} + +\item{wtp}{The selected value of the willingness-to-pay. Default is +\code{25000}.} + +\item{xlim}{Limits on the x-axis (default=\code{NULL}, so that R will select +appropriate limits).} + +\item{ylim}{Limits on the y-axis (default=\code{NULL}, so that R will select +appropriate limits).} + +\item{comparison}{The comparison being plotted. Default to \code{NULL} +chooses the first comparison if \code{graph="base"}. If +\code{graph="ggplot2"} the default value will choose all the possible +comparisons. Any subset of the possible comparisons can be selected (e.g., +\code{comparison=c(1,3)}).} + +\item{graph}{A string used to select the graphical engine to use for +plotting. Should (partial-)match the two options \code{"base"} or +\code{"ggplot2"}. Default value is \code{"base"}.} -Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, London +\item{...}{Arguments to be passed to \code{\link{ceplane.plot}}. See the +relative manual page for more details.} } -\author{ -Gianluca Baio, Andrea Berardi +\value{ +\item{contour}{ A ggplot item containing the requested plot. +Returned only if \code{graph="ggplot2"}. } Plots the cost-effectiveness +plane with a scatterplot of all the simulated values from the (posterior) +bivariate distribution of (Delta_e,Delta_c), the differentials of +effectiveness and costs; superimposes a contour of the distribution and +prints the value of the ICER, together with the sustainability area. } - -\seealso{ -\code{\link{bcea}}, -\code{\link{ceplane.plot}}, -\code{\link{contour.bcea}} +\description{ +Produces a scatterplot of the cost-effectiveness plane, with a contour-plot +of the bivariate density of the differentials of cost (y-axis) and +effectiveness (x-axis). Also adds the sustainability area (i.e. below the +selected value of the willingness-to-pay threshold). } \examples{ + ### create the bcea object m for the smoking cessation example data(Smoking) m=bcea(e,c,ref=4,interventions=treats,Kmax=500) @@ -78,6 +65,25 @@ contour2(m,wtp=200,graph="base") ### or use ggplot2 to plot multiple comparisons contour2(m,wtp=200,ICER.size=2,graph="ggplot2") } + +} +\references{ +Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity +Analysis in Health Economics. Statistical Methods in Medical Research +doi:10.1177/0962280211419832. + +Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, +London +} +\seealso{ +\code{\link{bcea}}, \code{\link{ceplane.plot}}, +\code{\link{contour.bcea}} +} +\author{ +Gianluca Baio, Andrea Berardi } -\keyword{Health economic evaluation} -\keyword{Bayesian model} +\keyword{Bayesian} +\keyword{Health} +\keyword{economic} +\keyword{evaluation} +\keyword{model} diff --git a/man/CreateInputs.Rd b/man/create_inputs_evpi.Rd similarity index 77% rename from man/CreateInputs.Rd rename to man/create_inputs_evpi.Rd index 2ea30928..96385411 100644 --- a/man/CreateInputs.Rd +++ b/man/create_inputs_evpi.Rd @@ -1,18 +1,18 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/CreateInputs.R -\name{CreateInputs} -\alias{CreateInputs} -\title{CreateInputs} +% Please edit documentation in R/createInputs.R +\name{create_inputs_evpi} +\alias{create_inputs_evpi} +\title{create_inputs_evpi} \usage{ -CreateInputs(x, print.lincom = TRUE) +create_inputs_evpi(inputs, print_is_linear_comb = TRUE) } \arguments{ -\item{x}{A \code{rjags}, \code{bugs} or \code{stanfit} object, containing +\item{inputs}{A \code{rjags}, \code{bugs} or \code{stanfit} object, containing the results of a call to either \code{jags}, (under \code{R2jags}), bugs (under \code{R2WinBUGS} or \code{R2OpenBUGS}), or \code{stan} (under \code{rstan}).} -\item{print.lincom}{A TRUE/FALSE indicator. If set to \code{TRUE} (default) +\item{print_is_linear_comb}{A TRUE/FALSE indicator. If set to \code{TRUE} (default) then prints the output of the procedure trying to assess whether there are some parameters that are a linear combination of others (in which case they are removed).} @@ -31,7 +31,10 @@ linear dependency among columns of the PSA samples or columns having constant values and removes them to only leave the fundamental parameters (to run VoI analysis). This also deals with simulations stored in a \code{.csv} or \code{.txt} file (eg as obtained using bootstrapping from a -non-Bayesian model) +non-Bayesian model). +} +\examples{ + } \seealso{ \code{\link{bcea}}, \code{\link{evppi}} diff --git a/man/diag.evppi.Rd b/man/diag.evppi.Rd index 748b8ede..b6a126df 100644 --- a/man/diag.evppi.Rd +++ b/man/diag.evppi.Rd @@ -1,69 +1,72 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/diag.evppi.R \name{diag.evppi} \alias{diag.evppi} -%- Also NEED an '\alias' for EACH other topic documented here. -\title{ -diag.evppi -} -\description{ -Performs diagnostic plots for the results of the EVPPI -} +\title{Diagnostic plots for the results of the EVPPI} \usage{ -diag.evppi(x,y,diag=c("residuals","qqplot"),int=1) +diag.evppi(evppi, he, plot_type = c("residuals", "qqplot"), interv = 1) } \arguments{ -\item{x}{ -A \code{evppi} object obtained by running the function \code{evppi} on a \code{bcea} -model. -} -\item{y}{ -A \code{bcea} object containing the results of the Bayesian modelling and the economic -evaluation. +\item{evppi}{A \code{evppi} object obtained by running the function \code{evppi} +on a \code{bcea} model.} + +\item{he}{A \code{bcea} object containing the results of the Bayesian +modelling and the economic evaluation.} + +\item{plot_type}{The type of diagnostics to be performed. It can be the 'residual +plot' or the 'qqplot plot'.} + +\item{interv}{Specifies the interventions for which diagnostic tests should be +performed (if there are many options being compared)} } -\item{diag}{ -The type of diagnostics to be performed. It can be the 'residual plot' or the 'qqplot -plot'. +\value{ +plot } -\item{int}{ -Specifies the interventions for which diagnostic tests should be performed (if there are many -options being compared) +\description{ +The function produces either a residual plot comparing the fitted +values from the INLA-SPDE Gaussian Process regression to the residuals. +This is a scatter plot of residuals on the y axis and fitted values (estimated +responses) on the x axis. The plot is used to detect non-linearity, unequal +error variances, and outliers. A well-behaved residual plot supporting the +appropriateness of the simple linear regression model has the following +characteristics: +1) The residuals bounce randomly around the 0 line. This suggests that +the assumption that the relationship is linear is reasonable. +2) The residuals roughly form a horizontal band around the 0 line. This +suggests that the variances of the error terms are equal. +3) None of the residual stands out from the basic random pattern of residuals. +This suggests that there are no outliers. } +\details{ +The second possible diagnostic is the qqplot for the fitted value. This is a +graphical method for comparing the fitted values distributions with the +assumed underlying normal distribution by plotting their quantiles against +each other. First, the set of intervals for the quantiles is chosen. A point +(x,y) on the plot corresponds to one of the quantiles of the second +distribution (y-coordinate) plotted against the same quantile of the first +distribution (x-coordinate). If the two distributions being compared are +identical, the Q-Q plot follows the 45 degrees line. } -\value{ -The function produces either a residual plot comparing the fitted values from the -INLA-SPDE Gaussian Process regression to the residuals. This is a scatter plot of -residuals on the y axis and fitted values (estimated responses) on the x axis. The plot -is used to detect non-linearity, unequal error variances, and outliers. A well-behaved -residual plot supporting the appropriateness of the simple linear regression model has -the following characteristics: -1) The residuals bounce randomly around the 0 line. This suggests that the assumption -that the -relationship is linear is reasonable. -2) The residuals roughly form a horizontal band around the 0 line. This suggests that -the variances -of the error terms are equal. -3) None of the residual stands out from the basic random pattern of residuals. This -suggests that there are no outliers. - -The second possible diagnostic is the qqplot for the fitted value. This is a graphical -method for comparing the fitted values distributions with the assumed underlying -normal distribution by plotting their quantiles against each other. First, the set of -intervals for the quantiles is chosen. A point (x,y) on the plot corresponds to one of -the quantiles of the second distribution (y-coordinate) plotted against the same quantile -of the first distribution (x-coordinate). If the two distributions being compared are -identical, the Q-Q plot follows the 45 degrees line. +\examples{ + } \references{ -Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity Analysis in Health Economics. -Statistical Methods in Medical Research doi:10.1177/0962280211419832. +Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity +Analysis in Health Economics. Statistical Methods in Medical Research +doi:10.1177/0962280211419832. -Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, London +Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, +London +} +\seealso{ +\code{\link{bcea}}, \code{\link{evppi}} } \author{ Gianluca Baio, Anna Heath } -\seealso{ -\code{\link{bcea}}, -\code{\link{evppi}} -} -\concept{Health economic evaluation} -\concept{Value of Information} +\keyword{Health} +\keyword{Information} +\keyword{Value} +\keyword{economic} +\keyword{evaluation,} +\keyword{of} diff --git a/man/eib.plot.Rd b/man/eib.plot.Rd index 3c7933ae..1dcf1a8e 100644 --- a/man/eib.plot.Rd +++ b/man/eib.plot.Rd @@ -4,8 +4,15 @@ \alias{eib.plot} \title{Expected Incremental Benefit (EIB) plot} \usage{ -eib.plot(he, comparison = NULL, pos = c(1, 0), size = NULL, - plot.cri = NULL, graph = c("base", "ggplot2", "plotly"), ...) +eib.plot( + he, + comparison = NULL, + pos = c(1, 0), + size = NULL, + plot.cri = NULL, + graph = c("base", "ggplot2", "plotly"), + ... +) } \arguments{ \item{he}{A \code{bcea} object containing the results of the Bayesian diff --git a/man/ib.plot.Rd b/man/ib.plot.Rd index ceebe905..389654fc 100644 --- a/man/ib.plot.Rd +++ b/man/ib.plot.Rd @@ -1,65 +1,69 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ib.plot.R \name{ib.plot} \alias{ib.plot} -%- Also NEED an '\alias' for EACH other topic documented here. -\title{ -Incremental Benefit (IB) distribution plot -} -\description{ -Plots the distribution of the Incremental Benefit (IB) for a given value of the -willingness to pay threshold -} +\title{Incremental Benefit (IB) distribution plot} \usage{ -ib.plot(he, comparison = NULL, wtp = 25000, bw = nbw, n = 512, - xlim = NULL, graph=c("base","ggplot2")) +ib.plot( + he, + comparison = NULL, + wtp = 25000, + bw = nbw, + n = 512, + xlim = NULL, + graph = c("base", "ggplot2") +) } \arguments{ - \item{he}{ -A \code{bcea} object containing the results of the Bayesian modelling and the economic -evaluation. -} - \item{comparison}{ -In the case of multiple interventions, specifies the one to be used in comparison with -the reference. Default value of \code{NULL} forces R to consider the first non-reference -intervention as the comparator. -} - \item{wtp}{ -The value of the willingness to pay threshold. Default value at \code{25000}. -} - \item{bw}{ -Identifies the smoothing bandwith used to construct the kernel estimation of the IB -density. -} - \item{n}{ -The number of equally spaced points at which the density is to be estimated. -} - \item{xlim}{ -The limits of the plot on the x-axis. -} - \item{graph}{ -A string used to select the graphical engine to use for plotting. Should (partial-)match -the two options \code{"base"} or \code{"ggplot2"}. Default value is \code{"base"}. -} +\item{he}{A \code{bcea} object containing the results of the Bayesian +modelling and the economic evaluation.} + +\item{comparison}{In the case of multiple interventions, specifies the one +to be used in comparison with the reference. Default value of \code{NULL} +forces R to consider the first non-reference intervention as the comparator.} + +\item{wtp}{The value of the willingness to pay threshold. Default value at +\code{25000}.} + +\item{bw}{Identifies the smoothing bandwith used to construct the kernel +estimation of the IB density.} + +\item{n}{The number of equally spaced points at which the density is to be +estimated.} + +\item{xlim}{The limits of the plot on the x-axis.} + +\item{graph}{A string used to select the graphical engine to use for +plotting. Should (partial-)match the two options \code{"base"} or +\code{"ggplot2"}. Default value is \code{"base"}.} } \value{ -\item{ib}{ -A ggplot object containing the requested plot. Returned only if \code{graph="ggplot2"}. +\item{ib}{ A ggplot object containing the requested plot. Returned +only if \code{graph="ggplot2"}. } The function produces a plot of the +distribution of the Incremental Benefit for a given value of the willingness +to pay parameter. The dashed area indicates the positive part of the +distribution (ie when the reference is more cost-effective than the +comparator). } -The function produces a plot of the distribution of the Incremental Benefit for a given -value of the willingness to pay parameter. The dashed area indicates the positive part -of the distribution (ie when the reference is more cost-effective than the comparator). +\description{ +Plots the distribution of the Incremental Benefit (IB) for a given value of +the willingness to pay threshold } \references{ -Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity Analysis in Health Economics. -Statistical Methods in Medical Research doi:10.1177/0962280211419832. +Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity +Analysis in Health Economics. Statistical Methods in Medical Research +doi:10.1177/0962280211419832. -Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, London -} -\author{ -Gianluca Baio, Andrea Berardi +Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, +London } \seealso{ -\code{\link{bcea}}, -\code{\link{ib.plot}}, +\code{\link{bcea}}, \code{\link{ib.plot}}, \code{\link{ceplane.plot}} } -\keyword{Health economic evaluation} +\author{ +Gianluca Baio, Andrea Berardi +} +\keyword{Health} +\keyword{economic} +\keyword{evaluation} diff --git a/man/info.rank.Rd b/man/info.rank.Rd index 34bbb6ba..4abfb1e7 100644 --- a/man/info.rank.Rd +++ b/man/info.rank.Rd @@ -4,8 +4,15 @@ \alias{info.rank} \title{Info-rank plot} \usage{ -info.rank(parameter, input, he, wtp = he$k[min(which(he$k >= he$ICER))], - howManyPars = NULL, graph = c("base", "plotly"), ...) +info.rank( + parameter, + input, + he, + wtp = he$k[min(which(he$k >= he$ICER))], + howManyPars = NULL, + graph = c("base", "plotly"), + ... +) } \arguments{ \item{parameter}{A vector of parameters for which the individual EVPPI diff --git a/man/mce.plot.Rd b/man/mce.plot.Rd deleted file mode 100644 index d092445f..00000000 --- a/man/mce.plot.Rd +++ /dev/null @@ -1,92 +0,0 @@ -\name{mce.plot} -\alias{mce.plot} -\title{ -Plots the probability that each intervention is the most cost-effective -} -\description{ -Plots the probability that each of the n_int interventions being analysed is the most -cost-effective. -} -\usage{ -mce.plot(mce,pos=c(1,0.5),graph=c("base","ggplot2"),...) -} -\arguments{ - \item{mce}{ -The output of the call to the function \code{\link{multi.ce}}. -} - \item{pos}{ -Parameter to set the position of the legend. Can be given in form of a string -\code{(bottom|top)(right|left)} for base graphics and \code{bottom|top|left|right} -for ggplot2. It can be a two-elements vector, which specifies the relative position on -the x and y axis respectively, or alternatively it can be in form of a logical variable, -with \code{TRUE} indicating to use the first standard and \code{FALSE} to use the second -one. Default value is \code{c(1,0.5)}, that is on the right inside the plot area. - } - \item{graph}{ -A string used to select the graphical engine to use for plotting. Should -(partial-)match the two options \code{"base"} or \code{"ggplot2"}. Default value is -\code{"base"}. - } - \item{...}{ -Optional arguments. For example, it is possible to specify the colours to be used -in the plot. This is done in a vector \code{color=c(...)}. The length of the -vector colors needs to be the same as the number of comparators included in the -analysis, otherwise \code{BCEA} will fall back to the default values (all black, -or shades of grey) -} -} -\value{ -\item{mceplot}{ -A ggplot object containing the plot. Returned only if \code{graph="ggplot2"}. -} -} -\author{ -Gianluca Baio, Andrea Berardi -} -\references{ -Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity Analysis in Health Economics. -Statistical Methods in Medical Research doi:10.1177/0962280211419832. - -Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, London -} - -%% ~Make other sections like Warning with \section{Warning }{....} ~ - -\seealso{ -\code{\link{bcea}} -} -\examples{ -# See Baio G., Dawid A.P. (2011) for a detailed description of the -# Bayesian model and economic problem -# -# Load the processed results of the MCMC simulation model -data(Vaccine) -# -# Runs the health economic evaluation using BCEA -m <- bcea(e=e,c=c, # defines the variables of - # effectiveness and cost - ref=2, # selects the 2nd row of (e,c) - # as containing the reference intervention - interventions=treats, # defines the labels to be associated - # with each intervention - Kmax=50000, # maximum value possible for the willingness - # to pay threshold; implies that k is chosen - # in a grid from the interval (0,Kmax) - plot=FALSE # inhibits graphical output -) -# -mce <- multi.ce(m) # uses the results of the economic analysis -# -mce.plot(mce, # plots the probability of being most cost-effective - graph="base") # using base graphics -# -if(require(ggplot2)){ -mce.plot(mce, # the same plot - graph="ggplot2") # using ggplot2 instead -} -} - -% Add one or more standard keywords, see file 'KEYWORDS' in the -% R documentation directory. -\keyword{Health economic evaluation} -\keyword{Multiple comparison} diff --git a/man/mixedAn.Rd b/man/mixedAn.Rd index 796ad756..dffdea8a 100644 --- a/man/mixedAn.Rd +++ b/man/mixedAn.Rd @@ -1,82 +1,58 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mixedAn.R \name{mixedAn} \alias{mixedAn} \alias{mixedAn.default} -\title{ -Cost-effectiveness analysis when multiple (possibly non cost-effective) interventions -are present on the market -} -\description{ -Runs the cost-effectiveness analysis, but accounts for the fact that more than one -intervention is present on the market -} +\title{Cost-effectiveness analysis when multiple (possibly non cost-effective) +interventions are present on the market} \usage{ mixedAn(he, mkt.shares = NULL, plot = FALSE) - -\method{mixedAn}{default}(he, mkt.shares = NULL, plot = FALSE) } -%- maybe also 'usage' for other objects documented here. \arguments{ - \item{he}{ -A \code{bcea} object containing the results of the Bayesian modelling and the economic -evaluation. -} - \item{mkt.shares}{ -A vector of market shares associated with the interventions. Its size is the same as -the number of possible comparators. By default, assumes uniform distribution for -each intervention. -} - \item{plot}{ -Logical value indicating whether the function should produce graphical output, via -\code{\link{plot.mixedAn}}, or not. Default is set to \code{FALSE}. - } -} -\value{ -Creates an object in the class \code{mixedAn} which contains the results of the health -economic evaluation in the mixed analysis case -\item{Ubar}{An array with the simulations of the ''known-distribution'' mixed utilities, -for each value of the discrete grid approximation of the willingness to pay parameter} -\item{OL.star}{An array with the simulations of the distribution of the Opportunity Loss -for the mixed strategy, for each value of the discrete grid approximation of the willingness -to pay parameter} -\item{evi.star}{The Expected Value of Information for the mixed strategy, for each value -of the discrete grid approximation of the willingness to pay parameter} -\item{k}{The discrete grid approximation of the willingness to pay parameter used for -the mixed strategy analysis} -\item{Kmax}{The maximum value of the discrete grid approximation for the willingness -to pay parameter} -\item{step}{The step used to form the grid approximation to the willingness to pay} -\item{ref}{The numeric index associated with the intervention used as reference in -the analysis} -\item{comp}{The numeric index(es) associated with the intervention(s) used as -comparator(s) in the analysis} -\item{mkt.shares}{The vector of market shares associated with each available intervention} -\item{n.comparisons}{The total number of pairwise comparisons available} -\item{interventions}{A vector of labels for all the interventions considered} -\item{evi}{The vector of values for the ''optimal'' Expected Value of Information, as a -function of the willingness to pay} -The function can also produce a graph showing the difference between the ''optimal'' -version of the EVPI (when only the most cost-effective intervention is included in the -market) and the mixed strategy one (when more than one intervention is considered in -the market) -} -\references{ -Baio, G. and Russo, P. (2009).A decision-theoretic framework for the application of cost-effectiveness analysis in regulatory processes. Pharmacoeconomics 27(8), -645-655 doi:10.2165/11310250 +\item{he}{A \code{bcea} object containing the results of the Bayesian +modelling and the economic evaluation.} -Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity Analysis in Health Economics. -Statistical Methods in Medical Research doi:10.1177/0962280211419832. +\item{mkt.shares}{A vector of market shares associated with the +interventions. Its size is the same as the number of possible comparators. +By default, assumes uniform distribution for each intervention.} -Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, London +\item{plot}{Logical value indicating whether the function should produce +graphical output, via \code{\link{plot.mixedAn}}, or not. Default is set to +\code{FALSE}.} } - -\author{ -Gianluca Baio +\value{ +Creates an object in the class \code{mixedAn} which contains the +results of the health economic evaluation in the mixed analysis case +\item{Ubar}{An array with the simulations of the ''known-distribution'' +mixed utilities, for each value of the discrete grid approximation of the +willingness to pay parameter} \item{OL.star}{An array with the simulations +of the distribution of the Opportunity Loss for the mixed strategy, for each +value of the discrete grid approximation of the willingness to pay +parameter} \item{evi.star}{The Expected Value of Information for the mixed +strategy, for each value of the discrete grid approximation of the +willingness to pay parameter} \item{k}{The discrete grid approximation of +the willingness to pay parameter used for the mixed strategy analysis} +\item{Kmax}{The maximum value of the discrete grid approximation for the +willingness to pay parameter} \item{step}{The step used to form the grid +approximation to the willingness to pay} \item{ref}{The numeric index +associated with the intervention used as reference in the analysis} +\item{comp}{The numeric index(es) associated with the intervention(s) used +as comparator(s) in the analysis} \item{mkt.shares}{The vector of market +shares associated with each available intervention} \item{n.comparisons}{The +total number of pairwise comparisons available} \item{interventions}{A +vector of labels for all the interventions considered} \item{evi}{The vector +of values for the ''optimal'' Expected Value of Information, as a function +of the willingness to pay} The function can also produce a graph showing the +difference between the ''optimal'' version of the EVPI (when only the most +cost-effective intervention is included in the market) and the mixed +strategy one (when more than one intervention is considered in the market) } - -\seealso{ -\code{\link{bcea}} +\description{ +Runs the cost-effectiveness analysis, but accounts for the fact that more +than one intervention is present on the market } \examples{ + # See Baio G., Dawid A.P. (2011) for a detailed description of the # Bayesian model and economic problem # @@ -103,7 +79,28 @@ ma <- mixedAn(m, # uses the results of the mixed strategy # interventions will have 1/T market share plot=TRUE # produces the plots ) + } +\references{ +Baio, G. and Russo, P. (2009).A decision-theoretic framework for +the application of cost-effectiveness analysis in regulatory processes. +Pharmacoeconomics 27(8), 645-655 doi:10.2165/11310250 + +Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity Analysis in Health +Economics. Statistical Methods in Medical Research +doi:10.1177/0962280211419832. -\keyword{Health economic evaluation} -\keyword{Mixed analysis} +Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, +London +} +\seealso{ +\code{\link{bcea}} +} +\author{ +Gianluca Baio +} +\keyword{Health} +\keyword{Mixed} +\keyword{analysis} +\keyword{economic} +\keyword{evaluation} diff --git a/man/multi.ce.Rd b/man/multi.ce.Rd index ea603489..d7adbd1a 100644 --- a/man/multi.ce.Rd +++ b/man/multi.ce.Rd @@ -1,43 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/multi.ce.R \name{multi.ce} \alias{multi.ce} -\title{ -Cost-effectiveness analysis with multiple comparison -} -\description{ -Computes and plots the probability that each of the n_int interventions being analysed -is the most cost-effective and the cost-effectiveness acceptability frontier -} +\title{Cost-effectiveness analysis with multiple comparison} \usage{ multi.ce(he) } \arguments{ - \item{he}{ -A \code{bcea} object containing the results of the Bayesian modelling and the economic -evaluation. -} +\item{he}{A \code{bcea} object containing the results of the Bayesian +modelling and the economic evaluation.} } \value{ -\item{m.ce}{A matrix including the probability that each intervention is the most -cost-effective for all values of the willingness to pay parameter} -\item{ceaf}{A vector containing the cost-effectiveness acceptability frontier} +Original bcea object (list) of class "pairwise" with additional: + \item{p_best_interv}{A matrix including the probability that each + intervention is the most cost-effective for all values of the willingness to + pay parameter} + \item{ceaf}{A vector containing the cost-effectiveness acceptability frontier} } -\author{ -Gianluca Baio -} - -\seealso{ -\code{\link{bcea}}, -\code{\link{mce.plot}}, -\code{\link{ceaf.plot}} +\description{ +Computes and plots the probability that each of the n_int interventions +being analysed is the most cost-effective and the cost-effectiveness +acceptability frontier. } \examples{ + # See Baio G., Dawid A.P. (2011) for a detailed description of the # Bayesian model and economic problem -# + # Load the processed results of the MCMC simulation model data(Vaccine) -# + # Runs the health economic evaluation using BCEA + m <- bcea(e=e,c=c, # defines the variables of # effectiveness and cost ref=2, # selects the 2nd row of (e,c) @@ -49,10 +43,18 @@ m <- bcea(e=e,c=c, # defines the variables of # in a grid from the interval (0,Kmax) plot=FALSE # inhibits graphical output ) -# -mce <- multi.ce(m # uses the results of the economic analysis -) -} -\keyword{Health economic evaluation} -\keyword{Multiple comparison} +mce <- multi.ce(m) # uses the results of the economic analysis + +} +\seealso{ +\code{\link{bcea}}, \code{\link{mce.plot}}, \code{\link{ceaf.plot}} +} +\author{ +Gianluca Baio +} +\keyword{Health} +\keyword{Multiple} +\keyword{comparison} +\keyword{economic} +\keyword{evaluation} diff --git a/man/new_bcea.Rd b/man/new_bcea.Rd new file mode 100644 index 00000000..ac59c910 --- /dev/null +++ b/man/new_bcea.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/new_bcea.R +\name{new_bcea} +\alias{new_bcea} +\title{Constructor for bcea} +\usage{ +new_bcea(df_ce, k) +} +\arguments{ +\item{df_ce}{dataframe of all simulation eff and cost} + +\item{k}{vector of willingness to pay values} +} +\value{ + +} +\description{ +Constructor for bcea +} diff --git a/man/ceac.plot.Rd b/man/plot-bcea.Rd similarity index 68% rename from man/ceac.plot.Rd rename to man/plot-bcea.Rd index 7e75efd1..a78f8f3a 100644 --- a/man/ceac.plot.Rd +++ b/man/plot-bcea.Rd @@ -4,27 +4,21 @@ \alias{ceac.plot} \title{Cost-Effectiveness Acceptability Curve (CEAC) plot} \usage{ -ceac.plot(he, comparison = NULL, pos = c(1, 0), graph = c("base", - "ggplot2", "plotly"), ...) +ceac.plot(he, pos = c(1, 0), graph = c("base", "ggplot2", "plotly"), ...) } \arguments{ \item{he}{A \code{bcea} object containing the results of the Bayesian modelling and the economic evaluation.} -\item{comparison}{Selects the comparator, in case of more than two -interventions being analysed. Default as NULL plots all the comparisons -together. Any subset of the possible comparisons can be selected (e.g., -\code{comparison=c(1,3)} or \code{comparison=2}).} - \item{pos}{Parameter to set the position of the legend (only relevant for multiple interventions, ie more than 2 interventions being compared). Can be given in form of a string \code{(bottom|top)(right|left)} for base graphics -and \code{bottom}, \code{top}, \code{left} or \code{right} for ggplot2. It -can be a two-elements vector, which specifies the relative position on the x -and y axis respectively, or alternatively it can be in form of a logical +and \code{bottom}, \code{top}, \code{left} or \code{right} for *ggplot2*. +It can be a two-elements vector, which specifies the relative position on the x +and y axis respectively, or alternatively in form of a logical variable, with \code{FALSE} indicating to use the default position and \code{TRUE} to place it on the bottom of the plot. Default value is -\code{c(1,0)}, that is the bottomright corner inside the plot area.} +\code{c(1,0)}, that is the bottom right corner inside the plot area.} \item{graph}{A string used to select the graphical engine to use for plotting. Should (partial-)match the three options \code{"base"}, @@ -37,9 +31,14 @@ plotting. Should (partial-)match the three options \code{"base"}, \item \code{line_types}: specifies the line type(s) as lty numeric values - all graph types. \item \code{area_include}: logical, include area under the CEAC curves - plotly only. \item \code{area_color}: specifies the AUC colour - plotly only.}} + +\item{comparison}{Selects the comparator, in case of more than two +interventions being analysed. Default as NULL plots all the comparisons +together. Any subset of the possible comparisons can be selected (e.g., +\code{comparison=c(1,3)} or \code{comparison=2}).} } \value{ -\item{ceac}{ If \code{graph="ggplot2"} a ggplot object, or if \code{graph="plotly"} +\item{ceac} {If \code{graph="ggplot2"} a ggplot object, or if \code{graph="plotly"} a plotly object containing the requested plot. Nothing is returned when \code{graph="base"}, the default.} The function produces a plot of the cost-effectiveness acceptability curve against the discrete grid of possible @@ -50,15 +49,32 @@ plotting. Should (partial-)match the three options \code{"base"}, } \description{ Produces a plot of the Cost-Effectiveness Acceptability Curve (CEAC) against -the willingness to pay threshold +the willingness to pay threshold. +} +\examples{ + +data("Vaccine") +he <- BCEA::bcea(e, c) +ceac.plot(he) + +ceac.plot(he, graph = "base") +ceac.plot(he, graph = "ggplot2") +ceac.plot(he, graph = "plotly") + +ceac.plot(he, graph = "ggplot2", title = "my title", line = list(colors = "green"), theme = theme_dark()) +he2 <- BCEA::bcea(cbind(e,e - 0.0002), cbind(c,c + 5)) +mypalette <- RColorBrewer::brewer.pal(3, "Accent") +ceac.plot(he2, graph = "ggplot2", title = "my title", theme = theme_dark(), pos = TRUE, line = mypalette) +ceac.plot(he, graph = "base", title = "my title", line = list(colors = "green")) +ceac.plot(he2, graph = "base") + } \references{ Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity - Analysis in Health Economics. Statistical Methods in Medical Research + Analysis in Health Economics. Statistical Methods in Medical Research doi:10.1177/0962280211419832. - Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, - London + Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, London. } \seealso{ \code{\link{bcea}} @@ -66,10 +82,4 @@ Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity \author{ Gianluca Baio, Andrea Berardi } -\keyword{Acceptability} -\keyword{Cost} -\keyword{Curve} -\keyword{Effectiveness} -\keyword{Health} -\keyword{economic} -\keyword{evaluation} +\keyword{hplot} diff --git a/man/plot.CEriskav.Rd b/man/plot.CEriskav.Rd index f2aa93f1..d6ba16cc 100644 --- a/man/plot.CEriskav.Rd +++ b/man/plot.CEriskav.Rd @@ -1,66 +1,46 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot.CEriskav.R \name{plot.CEriskav} \alias{plot.CEriskav} -%- Also NEED an '\alias' for EACH other topic documented here. -\title{ -Summary plot of the health economic analysis when risk aversion is included -} -\description{ -Plots the EIB and the EVPI when risk aversion is included in the utility function -} +\title{Summary plot of the health economic analysis when risk aversion is included} \usage{ -\method{plot}{CEriskav}(x, pos=c(0,1), graph=c("base","ggplot2"), ...) -%%%plot.CEriskav(x, y, ...) +\method{plot}{CEriskav}(x, pos = c(0, 1), graph = c("base", "ggplot2"), ...) } \arguments{ - \item{x}{ -An object of the class \code{CEriskav}, containing the results of the economic -analysis performed accounting for a risk aversion parameter (obtained as output of -the function \code{\link{CEriskav}}). -} - \item{pos}{ -Parameter to set the position of the legend. Can be given in form of a string -\code{(bottom|top)(right|left)} for base graphics and \code{bottom|top|left|right} -for ggplot2. It can be a two-elements vector, which specifies the relative position -on the x and y axis respectively, or alternatively it can be in form of a logical -variable, with \code{FALSE} indicating to use the default position and \code{TRUE} -to place it on the bottom of the plot. Default value is \code{c(0,1)}, that is in -the topleft corner inside the plot area. - } - \item{graph}{ -A string used to select the graphical engine to use for plotting. Should -(partial-)match the two options \code{"base"} or \code{"ggplot2"}. Default value -is \code{"base"}. - } -\item{...}{ -Arguments to be passed to methods, such as graphical parameters (see -\code{\link{par}}). -} -} +\item{x}{An object of the class \code{CEriskav}, containing the results of +the economic analysis performed accounting for a risk aversion parameter +(obtained as output of the function \code{\link{CEriskav}}).} -\value{ -\item{list(eib,evi)}{A two-elements named list of the ggplot objects containing -the requested plots. Returned only if \code{graph="ggplot2"}.} -The function produces two plots for the risk aversion analysis. The first one is -the EIB as a function of the discrete grid approximation of the willingness parameter -for each of the possible values of the risk aversion parameter, r. The second one is -a similar plot for the EVPI. -} -\references{ -Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity Analysis in Health Economics. -Statistical Methods in Medical Research doi:10.1177/0962280211419832. +\item{pos}{Parameter to set the position of the legend. Can be given in form +of a string \code{(bottom|top)(right|left)} for base graphics and +\code{bottom|top|left|right} for ggplot2. It can be a two-elements vector, +which specifies the relative position on the x and y axis respectively, or +alternatively it can be in form of a logical variable, with \code{FALSE} +indicating to use the default position and \code{TRUE} to place it on the +bottom of the plot. Default value is \code{c(0,1)}, that is in the topleft +corner inside the plot area.} + +\item{graph}{A string used to select the graphical engine to use for +plotting. Should (partial-)match the two options \code{"base"} or +\code{"ggplot2"}. Default value is \code{"base"}.} -Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, London +\item{...}{Arguments to be passed to methods, such as graphical parameters +(see \code{\link{par}}).} } -\author{ -Gianluca Baio, Andrea Berardi +\value{ +\item{list(eib,evi)}{A two-elements named list of the ggplot objects +containing the requested plots. Returned only if \code{graph="ggplot2"}.} +The function produces two plots for the risk aversion analysis. The first +one is the EIB as a function of the discrete grid approximation of the +willingness parameter for each of the possible values of the risk aversion +parameter, r. The second one is a similar plot for the EVPI. } - - -\seealso{ -\code{\link{bcea}}, -\code{\link{CEriskav}} +\description{ +Plots the EIB and the EVPI when risk aversion is included in the utility +function } \examples{ + # See Baio G., Dawid A.P. (2011) for a detailed description of the # Bayesian model and economic problem # @@ -108,9 +88,24 @@ plot(cr, # "dev.new" (default), "x11" or "ask" ) } + } +\references{ +Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity +Analysis in Health Economics. Statistical Methods in Medical Research +doi:10.1177/0962280211419832. -% Add one or more standard keywords, see file 'KEYWORDS' in the -% R documentation directory. -\keyword{Health economic evaluation}% __ONLY ONE__ keyword per line -\keyword{Risk aversion} +Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, +London +} +\seealso{ +\code{\link{bcea}}, \code{\link{CEriskav}} +} +\author{ +Gianluca Baio, Andrea Berardi +} +\keyword{Health} +\keyword{Risk} +\keyword{aversion} +\keyword{economic} +\keyword{evaluation} diff --git a/man/plot.bcea.Rd b/man/plot.bcea.Rd index 11081267..6d61fe49 100644 --- a/man/plot.bcea.Rd +++ b/man/plot.bcea.Rd @@ -1,113 +1,118 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot.bcea.R \name{plot.bcea} \alias{plot.bcea} -%- Also NEED an '\alias' for EACH other topic documented here. -\title{ -Summary plot of the health economic analysis -} -\description{ -Plots in a single graph the Cost-Effectiveness plane, the Expected Incremental Benefit, -the CEAC and the EVPI -} +\title{Summary plot of the health economic analysis} \usage{ -\method{plot}{bcea}(x, comparison=NULL, wtp=25000, pos=FALSE, -graph=c("base","ggplot2"), ...) +\method{plot}{bcea}( + he, + comparison = NULL, + wtp = 25000, + pos = FALSE, + graph = c("base", "ggplot2"), + ... +) } \arguments{ -\item{x}{ -A \code{bcea} object containing the results of the Bayesian modelling and the economic -evaluation. -} -\item{comparison}{ -Selects the comparator, in case of more than two interventions being analysed. The value -is passed to \code{\link{ceplane.plot}}, \code{\link{eib.plot}} and \code{\link{ceac.plot}}. -} -\item{wtp}{ -The value of the willingness to pay parameter. It is passed to \code{\link{ceplane.plot}}. -} -\item{pos}{ -Parameter to set the position of the legend. Can be given in form of a string, a single -logical value, or a two-element vector with the respective relative positions on the x -and y axis. Default as \code{FALSE} sets the legend position to the default one for each -plot (see the details section), while \code{TRUE} puts it on the bottom of each plot. -Changes will affect all the individual plots. -} -\item{graph}{ -A string used to select the graphical engine to use for plotting. Should -(partial-)match the two options \code{"base"} or \code{"ggplot2"}. Default value -is \code{"base"}. -} -\item{...}{ -Arguments to be passed to the methods \code{\link{ceplane.plot}} and -\code{\link{eib.plot}}. Please see the manual pages for the individual functions. -Arguments like \code{size}, \code{ICER.size} and \code{plot.cri} can be supplied to -the functions in this way. In addition if \code{graph="ggplot2"} and the arguments -are named theme objects they will be added to each plot. -} -} +\item{he}{A \code{bcea} object containing the results of the Bayesian +modelling and the economic evaluation.} -\value{ -The function produces a plot with four graphical summaries of the health economic -evaluation. -} -\details{ -The default position of the legend for the cost-effectiveness plane (produced by -\code{\link{ceplane.plot}}) is set to \code{c(1,1.025)} overriding its default for -\code{pos=FALSE}, since multiple ggplot2 plots are rendered in a slightly different -way than single plots. +\item{comparison}{Selects the comparator, in case of more than two +interventions being analysed. The value is passed to +\code{\link{ceplane.plot}}, \code{\link{eib.plot}} and +\code{\link{ceac.plot}}.} -For more information see the documentation of each individual plot function. -} -\references{ -Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity Analysis in Health Economics. -Statistical Methods in Medical Research doi:10.1177/0962280211419832. +\item{wtp}{The value of the willingness to pay parameter. It is passed to +\code{\link{ceplane.plot}}.} -Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, London +\item{pos}{Parameter to set the position of the legend. Can be given in form +of a string, a single logical value, or a two-element vector with the +respective relative positions on the x and y axis. Default as \code{FALSE} +sets the legend position to the default one for each plot (see the details +section), while \code{TRUE} puts it on the bottom of each plot. Changes +will affect all the individual plots.} + +\item{graph}{A string used to select the graphical engine to use for +plotting. Should (partial-)match the two options \code{"base"} or +\code{"ggplot2"}. Default value is \code{"base"}.} + +\item{...}{Arguments to be passed to the methods \code{\link{ceplane.plot}} +and \code{\link{eib.plot}}. Please see the manual pages for the individual +functions. Arguments like \code{size}, \code{ICER.size} and \code{plot.cri} +can be supplied to the functions in this way. In addition if +\code{graph="ggplot2"} and the arguments are named theme objects they will +be added to each plot.} } -\author{ -Gianluca Baio, Andrea Berardi +\value{ +The function produces a plot with four graphical summaries of the +health economic evaluation. } - -\seealso{ -\code{\link{bcea}}, -\code{\link{ceplane.plot}}, -\code{\link{eib.plot}}, -\code{\link{ceac.plot}}, -\code{\link{evi.plot}} +\description{ +Plots in a single graph the Cost-Effectiveness plane, the Expected +Incremental Benefit, the CEAC and the EVPI +} +\details{ +The default position of the legend for the cost-effectiveness plane +(produced by \code{\link{ceplane.plot}}) is set to \code{c(1,1.025)} +overriding its default for \code{pos=FALSE}, since multiple ggplot2 plots +are rendered in a slightly different way than single plots. } \examples{ + # See Baio G., Dawid A.P. (2011) for a detailed description of the # Bayesian model and economic problem -# + # Load the processed results of the MCMC simulation model data(Vaccine) -# + # Runs the health economic evaluation using BCEA -m <- bcea(e=e,c=c, # defines the variables of - # effectiveness and cost - ref=2, # selects the 2nd row of (e,c) - # as containing the reference intervention - interventions=treats, # defines the labels to be associated - # with each intervention - Kmax=50000, # maximum value possible for the willingness - # to pay threshold; implies that k is chosen - # in a grid from the interval (0,Kmax) - plot=FALSE # does not produce graphical outputs -) -# +he <- bcea( + e=e, c=c, # defines the variables of + # effectiveness and cost + ref=2, # selects the 2nd row of (e,c) + # as containing the reference intervention + interventions=treats, # defines the labels to be associated + # with each intervention + Kmax=50000, # maximum value possible for the willingness + # to pay threshold; implies that k is chosen + # in a grid from the interval (0,Kmax) + plot=FALSE # does not produce graphical outputs + ) + # Plots the summary plots for the "bcea" object m using base graphics -plot(m,graph="base") +plot(he, graph="base") # Plots the same summary plots using ggplot2 if(require(ggplot2)){ -plot(m,graph="ggplot2") +plot(he, graph="ggplot2") ##### Example of a customized plot.bcea with ggplot2 -plot(m, - graph="ggplot2", # use ggplot2 - theme=theme(plot.title=element_text(size=rel(1.25))), # theme elements must have a name - ICER.size=1.5, # hidden option in ceplane.plot - size=rel(2.5) # modifies the size of k= labels -) # in ceplane.plot and eib.plot +plot(he, + graph = "ggplot2", # use ggplot2 + theme = theme(plot.title=element_text(size=rel(1.25))), # theme elements must have a name + ICER.size = 1.5, # hidden option in ceplane.plot + size = rel(2.5) # modifies the size of k = labels + ) # in ceplane.plot and eib.plot } + +} +\references{ +Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity +Analysis in Health Economics. Statistical Methods in Medical Research +doi:10.1177/0962280211419832. + +Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, London +} +\seealso{ +\code{\link{bcea}}, + \code{\link{ceplane.plot}}, + \code{\link{eib.plot}}, + \code{\link{ceac.plot}}, + \code{\link{evi.plot}} +} +\author{ +Gianluca Baio, Andrea Berardi } -\keyword{Health economic evaluation} +\keyword{Health} +\keyword{economic} +\keyword{evaluation} diff --git a/man/plot.evppi.Rd b/man/plot.evppi.Rd index 1f9d0f62..a4615808 100644 --- a/man/plot.evppi.Rd +++ b/man/plot.evppi.Rd @@ -1,55 +1,51 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot.evppi.R \name{plot.evppi} \alias{plot.evppi} -%- Also NEED an '\alias' for EACH other topic documented here. -\title{ -plot.evppi} -\description{ -Plots a graph of the Expected Value of Partial Information with respect -to a set of parameters -} +\title{plot.evppi} \usage{ -\method{plot}{evppi}(x, pos = c(0, 0.8), graph = c("base", "ggplot2"), -col = NULL,...) +\method{plot}{evppi}(x, pos = c(0, 0.8), graph = c("base", "ggplot2"), col = NULL, ...) } -%- maybe also 'usage' for other objects documented here. \arguments{ - \item{x}{ -An object in the class \code{evppi}, obtained by the call to the function -\code{\link{evppi}}. -} - \item{pos}{ -Parameter to set the position of the legend. Can be given in form of a string -\code{(bottom|top)(right|left)} for base graphics and \code{bottom|top|left|right} -for ggplot2. It can be a two-elements vector, which specifies the relative position on -the x and y axis respectively, or alternatively it can be in form of a logical variable, -with \code{FALSE} indicating to use the default position and \code{TRUE} to place it on -the bottom of the plot. Default value is \code{c(0,1)}, that is in the topleft corner -inside the plot area. -} - \item{graph}{ -A string used to select the graphical engine to use for plotting. Should -(partial-)match the two options \code{"base"} or \code{"ggplot2"}. Default value is -\code{"base"}. -} - \item{col}{ -Sets the color for the lines depicted in the graph. -} -\item{...}{ -Arguments to be passed to methods, such as graphical parameters (see -\code{\link{par}}). +\item{x}{An object in the class \code{evppi}, obtained by the call to the +function \code{\link{evppi}}.} + +\item{pos}{Parameter to set the position of the legend. Can be given in form +of a string \code{(bottom|top)(right|left)} for base graphics and +\code{bottom|top|left|right} for ggplot2. It can be a two-elements vector, +which specifies the relative position on the x and y axis respectively, or +alternatively it can be in form of a logical variable, with \code{FALSE} +indicating to use the default position and \code{TRUE} to place it on the +bottom of the plot. Default value is \code{c(0,1)}, that is in the topleft +corner inside the plot area.} + +\item{graph}{A string used to select the graphical engine to use for +plotting. Should (partial-)match the two options \code{"base"} or +\code{"ggplot2"}. Default value is \code{"base"}.} + +\item{col}{Sets the color for the lines depicted in the graph.} + +\item{...}{Arguments to be passed to methods, such as graphical parameters +(see \code{\link{par}}).} } +\description{ +Plots a graph of the Expected Value of Partial Information with respect to a +set of parameters } \references{ -Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, London +Baio G. (2012). Bayesian Methods in Health Economics. +CRC/Chapman Hall, London } -\author{ -Gianluca Baio, Andrea Berardi} \seealso{ -\code{\link{bcea}}, -\code{\link{evppi}} +\code{\link{bcea}}, \code{\link{evppi}} } -% Add one or more standard keywords, see file 'KEYWORDS' in the -% R documentation directory. -\keyword{Health economic evaluation} -\keyword{Expected value of information} - +\author{ +Gianluca Baio, Andrea Berardi +} +\keyword{Expected} +\keyword{Health} +\keyword{economic} +\keyword{evaluation} +\keyword{information} +\keyword{of} +\keyword{value} diff --git a/man/plot.mixedAn.Rd b/man/plot.mixedAn.Rd index 69f12e77..f6dd8016 100644 --- a/man/plot.mixedAn.Rd +++ b/man/plot.mixedAn.Rd @@ -1,80 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot.mixedAn.R \name{plot.mixedAn} \alias{plot.mixedAn} -%- Also NEED an '\alias' for EACH other topic documented here. -\title{ -Summary plot of the health economic analysis when the mixed analysis is considered -} -\description{ -Compares the optimal scenario to the mixed case in terms of the EVPI -} +\title{Summary plot of the health economic analysis when the mixed analysis is +considered} \usage{ -\method{plot}{mixedAn}(x, y.limits = NULL, pos=c(0,1), graph=c("base","ggplot2"), ...) +\method{plot}{mixedAn}(x, y.limits = NULL, pos = c(0, 1), graph = c("base", "ggplot2"), ...) } -%- maybe also 'usage' for other objects documented here. \arguments{ -\item{x}{ -An object of class \code{mixedAn}, given as output of the call to the function -\code{\link{mixedAn}}. -} -\item{y.limits}{ -Range of the y-axis for the graph. The default value is \code{NULL}, in which case the -maximum range between the optimal and the mixed analysis scenarios is considered. -} - \item{pos}{ -Parameter to set the position of the legend. Can be given in form of a string -\code{(bottom|top)(right|left)} for base graphics and \code{bottom|top|left|right} -for ggplot2. It can be a two-elements vector, which specifies the relative position on -the x and y axis respectively, or alternatively it can be in form of a logical -variable, with \code{FALSE} indicating to use the default position and \code{TRUE} to -place it on the bottom of the plot. Default value is \code{c(0,1)}, that is in the -topleft corner inside the plot area. - } - \item{graph}{ -A string used to select the graphical engine to use for plotting. Should -(partial-)match the two options \code{"base"} or \code{"ggplot2"}. Default value is -\code{"base"}. - } -\item{...}{ -Arguments to be passed to methods, such as graphical parameters (see \code{\link{par}}). -} -} +\item{x}{An object of class \code{mixedAn}, given as output of the call to +the function \code{\link{mixedAn}}.} -\value{ -\item{evi}{ -A ggplot object containing the plot. Returned only if \code{graph="ggplot2"}. -} -The function produces a graph showing the difference between the ''optimal'' version of -the EVPI (when only the most cost-effective intervention is included in the market) and -the mixed strategy one (when more than one intervention is considered in the market). -} -\references{ -Baio, G. and Russo, P. (2009).A decision-theoretic framework for the application of cost-effectiveness analysis in regulatory processes. Pharmacoeconomics 27(8), 645-655 -doi:10.2165/11310250 +\item{y.limits}{Range of the y-axis for the graph. The default value is +\code{NULL}, in which case the maximum range between the optimal and the +mixed analysis scenarios is considered.} -Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity Analysis in Health Economics. -Statistical Methods in Medical Research doi:10.1177/0962280211419832. +\item{pos}{Parameter to set the position of the legend. Can be given in form +of a string \code{(bottom|top)(right|left)} for base graphics and +\code{bottom|top|left|right} for ggplot2. It can be a two-elements vector, +which specifies the relative position on the x and y axis respectively, or +alternatively it can be in form of a logical variable, with \code{FALSE} +indicating to use the default position and \code{TRUE} to place it on the +bottom of the plot. Default value is \code{c(0,1)}, that is in the topleft +corner inside the plot area.} -Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, London -} +\item{graph}{A string used to select the graphical engine to use for +plotting. Should (partial-)match the two options \code{"base"} or +\code{"ggplot2"}. Default value is \code{"base"}.} -\author{ -Gianluca Baio, Andrea Berardi +\item{...}{Arguments to be passed to methods, such as graphical parameters +(see \code{\link{par}}).} } - - -%% ~Make other sections like Warning with \section{Warning }{....} ~ - -\seealso{ -\code{\link{bcea}}, -\code{\link{mixedAn}} +\value{ +\item{evi}{ A ggplot object containing the plot. Returned only if +\code{graph="ggplot2"}. } The function produces a graph showing the +difference between the ''optimal'' version of the EVPI (when only the most +cost-effective intervention is included in the market) and the mixed +strategy one (when more than one intervention is considered in the market). +} +\description{ +Compares the optimal scenario to the mixed case in terms of the EVPI } \examples{ + # See Baio G., Dawid A.P. (2011) for a detailed description of the # Bayesian model and economic problem # # Load the processed results of the MCMC simulation model data(Vaccine) -# + # Runs the health economic evaluation using BCEA m <- bcea(e=e,c=c, # defines the variables of # effectiveness and cost @@ -87,24 +61,43 @@ m <- bcea(e=e,c=c, # defines the variables of # in a grid from the interval (0,Kmax) plot=FALSE # inhibits graphical output ) -# + ma <- mixedAn(m, # uses the results of the mixed strategy # analysis (a "mixedAn" object) mkt.shares=NULL # the vector of market shares can be defined # externally. If NULL, then each of the T # interventions will have 1/T market share ) -# + # Can also plot the summary graph plot(ma,graph="base") -# + # Or with ggplot2 if(require(ggplot2)){ plot(ma,graph="ggplot2") } + } +\references{ +Baio, G. and Russo, P. (2009).A decision-theoretic framework for +the application of cost-effectiveness analysis in regulatory processes. +Pharmacoeconomics 27(8), 645-655 doi:10.2165/11310250 -% Add one or more standard keywords, see file 'KEYWORDS' in the -% R documentation directory. -\keyword{Health economic evaluation} -\keyword{Mixed analysis} +Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity Analysis in Health +Economics. Statistical Methods in Medical Research +doi:10.1177/0962280211419832. + +Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, +London +} +\seealso{ +\code{\link{bcea}}, \code{\link{mixedAn}} +} +\author{ +Gianluca Baio, Andrea Berardi +} +\keyword{Health} +\keyword{Mixed} +\keyword{analysis} +\keyword{economic} +\keyword{evaluation} diff --git a/man/select_plot_type.Rd b/man/select_plot_type.Rd new file mode 100644 index 00000000..38172d68 --- /dev/null +++ b/man/select_plot_type.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/select_plot_type.R +\name{select_plot_type} +\alias{select_plot_type} +\title{choose graphical engine} +\usage{ +select_plot_type(graph) +} +\description{ +choose graphical engine +} +\keyword{dplot} diff --git a/man/sim.table.Rd b/man/sim.table.Rd index 25bb6659..658ec06d 100644 --- a/man/sim.table.Rd +++ b/man/sim.table.Rd @@ -1,80 +1,74 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sim.table.R \name{sim.table} \alias{sim.table} -%- Also NEED an '\alias' for EACH other topic documented here. -\title{ -Table of simulations for the health economic model -} -\description{ -Using the input in the form of MCMC simulations and after having run the health -economic model, produces a summary table of the simulations from the cost-effectiveness -analysis -} +\title{Table of Simulations for the Health Economic Model} \usage{ sim.table(he, wtp = 25000) } -%- maybe also 'usage' for other objects documented here. \arguments{ - \item{he}{ -A \code{bcea} object containing the results of the Bayesian modelling and the economic -evaluation. -} - \item{wtp}{ -The value of the willingness to pay threshold to be used in the summary table. -} -} +\item{he}{A \code{bcea} object containing the results of the Bayesian +modelling and the economic evaluation.} -\value{ -Produces the following elements: -\item{Table}{A table with the simulations from the economic model} -\item{names.cols}{A vector of labels to be associated with each column of the table} -\item{wtp}{The selected value of the willingness to pay} -\item{ind.table}{The index associated with the selected value of the willingness to pay -threshold in the grid used to run the analysis} +\item{wtp}{The value of the willingness to pay threshold to be used in the +summary table.} } -\references{ -Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity Analysis in Health Economics. -Statistical Methods in Medical Research doi:10.1177/0962280211419832. - -Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, London -} -\author{ -Gianluca Baio +\value{ +Produces the following elements: \item{table}{A table with the +simulations from the economic model} \item{names.cols}{A vector of labels to +be associated with each column of the table} \item{wtp}{The selected value +of the willingness to pay} \item{idx_wtp}{The index associated with the +selected value of the willingness to pay threshold in the grid used to run +the analysis} } - -%% ~Make other sections like Warning with \section{Warning }{....} ~ - -\seealso{ -\code{\link{bcea}} +\description{ +Using the input in the form of MCMC simulations and after having run the +health economic model, produces a summary table of the simulations from the +cost-effectiveness analysis. } \examples{ + # See Baio G., Dawid A.P. (2011) for a detailed description of the # Bayesian model and economic problem -# + # Load the processed results of the MCMC simulation model data(Vaccine) -# + # Runs the health economic evaluation using BCEA -m <- bcea(e=e,c=c, # defines the variables of - # effectiveness and cost - ref=2, # selects the 2nd row of (e,c) - # as containing the reference intervention - interventions=treats, # defines the labels to be associated - # with each intervention - Kmax=50000 # maximum value possible for the willingness - # to pay threshold; implies that k is chosen - # in a grid from the interval (0,Kmax) -) -# +m <- bcea(e=e, # defines the variables of + c=c, # effectiveness and cost + ref=2, # selects the 2nd row of (e,c) + # as containing the reference intervention + interventions=treats, # defines the labels to be associated + # with each intervention + Kmax=50000 # maximum value possible for the willingness + # to pay threshold; implies that k is chosen + # in a grid from the interval (0,Kmax) + ) + # Now can save the simulation exercise in an object using sim.table() -st <- sim.table(m, # uses the results of the economic evalaution - # (a "bcea" object) - wtp=25000 # selects the particular value for k -) -# +st <- sim.table(m, # uses the results of the economic evaluation + # (a 'bcea' object) + wtp=25000 # selects the particular value for k + ) + # The table can be explored. For example, checking the -# element 'Table' of the object 'st' +# element 'Table' of the object 'st' + } +\references{ +Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity +Analysis in Health Economics. Statistical Methods in Medical Research +doi:10.1177/0962280211419832. -% Add one or more standard keywords, see file 'KEYWORDS' in the -% R documentation directory. -\keyword{Health economic evaluation} % __ONLY ONE__ keyword per line +Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, London +} +\seealso{ +\code{\link{bcea}} +} +\author{ +Gianluca Baio +} +\keyword{Health} +\keyword{economic} +\keyword{evaluation} diff --git a/man/struct.psa.Rd b/man/struct.psa.Rd index a8a58e45..b7b14d92 100644 --- a/man/struct.psa.Rd +++ b/man/struct.psa.Rd @@ -1,57 +1,59 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/struct.psa.R \name{struct.psa} \alias{struct.psa} - -\title{ -Structural PSA -} -\description{ -Computes the weights to be associated with a set of competing models in order -to perform structural PSA -} +\title{Structural PSA} \usage{ -struct.psa(models, effect, cost, ref = 1, interventions = NULL, - Kmax = 50000, plot = F) +struct.psa( + models, + effect, + cost, + ref = 1, + interventions = NULL, + Kmax = 50000, + plot = F +) } - \arguments{ - \item{models}{ -A list containing the output from either R2jags or R2OpenBUGS/R2WinBUGS for all -the models that need to be combined in the model average -} - \item{effect}{ -A list containing the measure of effectiveness computed from the various models -(one matrix with n.sim x n.ints simulations for each model) -} - \item{cost}{ -A list containing the measure of costs computed from the various models -(one matrix with n.sim x n.ints simulations for each model) -} - \item{ref}{ -Defines which intervention is considered to be the reference strategy. The default -value \code{ref=1} means that the intervention appearing first is the reference and -the other(s) is(are) the comparator(s) -} - \item{interventions}{ -Defines the labels to be associated with each intervention. By default and -if \code{NULL}, assigns labels in the form "Intervention1", ... , "Intervention T" -} - \item{Kmax}{ -Maximum value of the willingness to pay to be considered. Default value is -\code{k=50000}. The willingness to pay is then approximated on a discrete grid in -the interval \code{[0,Kmax]}. The grid is equal to \code{wtp} if the parameter is -given, or composed of \code{501} elements if \code{wtp=NULL} (the default) -} - \item{plot}{ -A logical value indicating whether the function should produce the summary -plot or not +\item{models}{A list containing the output from either R2jags or +R2OpenBUGS/R2WinBUGS for all the models that need to be combined in the +model average} + +\item{effect}{A list containing the measure of effectiveness computed from +the various models (one matrix with n.sim x n.ints simulations for each +model)} + +\item{cost}{A list containing the measure of costs computed from the various +models (one matrix with n.sim x n.ints simulations for each model)} + +\item{ref}{Defines which intervention is considered to be the reference +strategy. The default value \code{ref=1} means that the intervention +appearing first is the reference and the other(s) is(are) the comparator(s)} + +\item{interventions}{Defines the labels to be associated with each +intervention. By default and if \code{NULL}, assigns labels in the form +"Intervention1", ... , "Intervention T"} + +\item{Kmax}{Maximum value of the willingness to pay to be considered. +Default value is \code{k=50000}. The willingness to pay is then approximated +on a discrete grid in the interval \code{[0,Kmax]}. The grid is equal to +\code{wtp} if the parameter is given, or composed of \code{501} elements if +\code{wtp=NULL} (the default)} + +\item{plot}{A logical value indicating whether the function should produce +the summary plot or not} } +\description{ +Computes the weights to be associated with a set of competing models in +order to perform structural PSA } \references{ -Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, London -} -\author{ -Gianluca Baio +Baio G. (2012). Bayesian Methods in Health Economics. +CRC/Chapman Hall, London } \seealso{ \code{\link{bcea}} } +\author{ +Gianluca Baio +} diff --git a/man/summary.bcea.Rd b/man/summary.bcea.Rd index bbdedfde..f639350b 100644 --- a/man/summary.bcea.Rd +++ b/man/summary.bcea.Rd @@ -1,50 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/summary.bcea.R \name{summary.bcea} \alias{summary.bcea} -%- Also NEED an '\alias' for EACH other topic documented here. -\title{ -Summary method for objects in the class \code{bcea} -} -\description{ -Produces a table printout with some summary results of the health economic -evaluation -} +\title{Summary method for objects in the class \code{bcea}} \usage{ \method{summary}{bcea}(object, wtp = 25000, ...) -%%summary(object, wtp = 25000, ...) } -%- maybe also 'usage' for other objects documented here. \arguments{ - \item{object}{ -A \code{bcea} object containing the results of the Bayesian modelling and the -economic evaluation. -} - \item{wtp}{ -The value of the willingness to pay threshold to be used in the summary table. -} -\item{...}{ -Additional arguments affecting the summary produced. -} -} +\item{object}{A \code{bcea} object containing the results of the Bayesian +modelling and the economic evaluation.} + +\item{wtp}{The value of the willingness to pay threshold to be used in the +summary table.} +\item{...}{Additional arguments affecting the summary produced.} +} \value{ -Prints a summary table with some information on the health economic output and -synthetic information on the economic measures (EIB, CEAC, EVPI). +Prints a summary table with some information on the health economic +output and synthetic information on the economic measures (EIB, CEAC, EVPI). +} +\description{ +Produces a table printout with some summary results of the health economic +evaluation } \references{ -Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity Analysis in Health Economics. -Statistical Methods in Medical Research doi:10.1177/0962280211419832. +Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity +Analysis in Health Economics. Statistical Methods in Medical Research +doi:10.1177/0962280211419832. -Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, London -} -\author{ -Gianluca Baio +Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, +London } - -%% ~Make other sections like Warning with \section{Warning }{....} ~ - \seealso{ \code{\link{bcea}} } -% Add one or more standard keywords, see file 'KEYWORDS' in the -% R documentation directory. -\keyword{Health economic evaluation}% __ONLY ONE__ keyword per line +\author{ +Gianluca Baio +} +\keyword{Health} +\keyword{economic} +\keyword{evaluation} diff --git a/man/summary.mixedAn.Rd b/man/summary.mixedAn.Rd index 45e980c7..cab06a9e 100644 --- a/man/summary.mixedAn.Rd +++ b/man/summary.mixedAn.Rd @@ -1,65 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/summary.mixedAn.R \name{summary.mixedAn} \alias{summary.mixedAn} -%- Also NEED an '\alias' for EACH other topic documented here. -\title{ -Summary methods for objects in the class \code{mixedAn} (mixed analysis) -} -\description{ -Prints a summary table for the results of the mixed analysis for the economic -evaluation of a given model -} +\title{Summary methods for objects in the class \code{mixedAn} (mixed analysis)} \usage{ -\method{summary}{mixedAn}(object, wtp = 25000,...) -%%summary(object, wtp = 25000) +\method{summary}{mixedAn}(object, wtp = 25000, ...) } -%- maybe also 'usage' for other objects documented here. \arguments{ - \item{object}{ -An object of the class \code{mixedAn}, which is the results of the function -\code{\link{mixedAn}}, generating the economic evaluation of a set of interventions, -considering given market shares for each option. -} - \item{wtp}{ -The value of the willingness to pay choosen to present the analysis. -} -\item{...}{ -Additional arguments affecting the summary produced. -} -} - -\value{ -Produces a table with summary information on the loss in expected value of information -generated by the inclusion of non cost-effective interventions in the market. -} -\references{ -Baio, G. and Russo, P. (2009).A decision-theoretic framework for the application of -cost-effectiveness analysis in regulatory processes. Pharmacoeconomics 27(8), 645-655 -doi:10.2165/11310250 +\item{object}{An object of the class \code{mixedAn}, which is the results of +the function \code{\link{mixedAn}}, generating the economic evaluation of a +set of interventions, considering given market shares for each option.} -Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity Analysis in Health Economics. -Statistical Methods in Medical Research doi:10.1177/0962280211419832. +\item{wtp}{The value of the willingness to pay choosen to present the +analysis.} -Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, London +\item{...}{Additional arguments affecting the summary produced.} } - -\author{ -Gianluca Baio +\value{ +Produces a table with summary information on the loss in expected +value of information generated by the inclusion of non cost-effective +interventions in the market. } - - -%% ~Make other sections like Warning with \section{Warning }{....} ~ - -\seealso{ -\code{\link{bcea}}, -\code{\link{mixedAn}} +\description{ +Prints a summary table for the results of the mixed analysis for the +economic evaluation of a given model } \examples{ + # See Baio G., Dawid A.P. (2011) for a detailed description of the # Bayesian model and economic problem # # Load the processed results of the MCMC simulation model data(Vaccine) -# + # Runs the health economic evaluation using BCEA m <- bcea(e=e,c=c, # defines the variables of # effectiveness and cost @@ -71,23 +44,42 @@ m <- bcea(e=e,c=c, # defines the variables of # to pay threshold; implies that k is chosen # in a grid from the interval (0,Kmax) ) -# + ma <- mixedAn(m, # uses the results of the mixed strategy # analysis (a "mixedAn" object) mkt.shares=NULL # the vector of market shares can be defined # externally. If NULL, then each of the T # interventions will have 1/T market share ) -# + # Prints a summary of the results summary(ma, # uses the results of the mixed strategy analysis # (a "mixedAn" object) wtp=25000 # selects the relevant willingness to pay # (default: 25,000) ) + } +\references{ +Baio, G. and Russo, P. (2009).A decision-theoretic framework for +the application of cost-effectiveness analysis in regulatory processes. +Pharmacoeconomics 27(8), 645-655 doi:10.2165/11310250 + +Baio, G., Dawid, A. P. (2011). Probabilistic Sensitivity Analysis in Health +Economics. Statistical Methods in Medical Research +doi:10.1177/0962280211419832. -% Add one or more standard keywords, see file 'KEYWORDS' in the -% R documentation directory. -\keyword{Health economic evaluation} -\keyword{Mixed analysis} +Baio G. (2012). Bayesian Methods in Health Economics. CRC/Chapman Hall, +London +} +\seealso{ +\code{\link{bcea}}, \code{\link{mixedAn}} +} +\author{ +Gianluca Baio +} +\keyword{Health} +\keyword{Mixed} +\keyword{analysis} +\keyword{economic} +\keyword{evaluation} diff --git a/tests/figs/ceac-plot/ceac-plot-ggplot.svg b/tests/figs/ceac-plot/ceac-plot-ggplot.svg new file mode 100644 index 00000000..0fa6c278 --- /dev/null +++ b/tests/figs/ceac-plot/ceac-plot-ggplot.svg @@ -0,0 +1,54 @@ + + + + + + + + + + + + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 + + + + + + + + + + + +0 +10000 +20000 +30000 +40000 +50000 +Willingness to pay +Probability of cost effectiveness +my title + diff --git a/tests/figs/deps.txt b/tests/figs/deps.txt new file mode 100644 index 00000000..fa7c5968 --- /dev/null +++ b/tests/figs/deps.txt @@ -0,0 +1,3 @@ +- vdiffr-svg-engine: 1.0 +- vdiffr: 0.3.2 +- freetypeharfbuzz: 0.2.5 diff --git a/tests/testthat/ce.RData b/tests/testthat/ce.RData new file mode 100644 index 00000000..42bb6ed3 Binary files /dev/null and b/tests/testthat/ce.RData differ diff --git a/tests/testthat/test-bcea.R b/tests/testthat/test-bcea.R index 616a462f..8f9c96d9 100644 --- a/tests/testthat/test-bcea.R +++ b/tests/testthat/test-bcea.R @@ -1,3 +1,180 @@ -test_that("multiplication works", { - }) +# library(BCEA) +library(dplyr) +library(reshape2) + + +load("ce.RData") + + +test_that("input errors", { + + expect_error( + bcea(eff, cost[c(1,2,1), ], + plot = FALSE), + regexp = "eff and cost are not the same dimensions.") + + expect_error( + bcea( + eff, cost[, c(1,2,1)], + plot = FALSE), + regexp = "eff and cost are not the same dimensions.") + + expect_error( + bcea(eff[c(1,2,1), ], cost, + plot = FALSE), + regexp = "eff and cost are not the same dimensions.") + + expect_error( + bcea(eff[, c(1,2,1)], cost, + plot = FALSE), + regexp = "eff and cost are not the same dimensions.") + + expect_error( + bcea(eff, cost, + interventions = c("aaa"), + plot = FALSE), + regexp = "interventions names wrong length.") + + expect_error( + bcea(eff, cost, + ref = 0, + plot = FALSE), + regexp = "reference is not in available interventions.") + + expect_error( + bcea(eff, cost, + ref = 3, + plot = FALSE), + regexp = "reference is not in available interventions.") + + # expect_error(bcea(e, c, ref = 1.1, plot = FALSE), + # regexp = "reference is not in available interventions.") + + expect_error( + bcea(c(0,0), c(1,2), + plot = FALSE), + regexp = "eff and cost must be matrices.") + + expect_error( + bcea(matrix(c(0,0)), matrix(c(1,2)), + plot = FALSE), + regexp = "Require at least 2 comparators.") +}) + + +# realistic input data + +test_that("basic return", { + + res <- + bcea(e = eff, + c = cost) + + expect_s3_class(res, "bcea") + expect_type(res, "list") + + expect_length(res, 24) + expect_named(res, + c("n_sim","n_comparators","n_comparisons","delta_e","delta_c", + "ICER","Kmax","k","ceac","ib","eib","kstar","best","U","vi", + "Ustar","ol","evi","interventions","ref","comp","step","e","c")) + + expect_equal(res$n_sim, nrow(cost)) + + expect_length(res$delta_c, nrow(cost)) + expect_length(res$delta_e, nrow(eff)) + + expect_equal(nrow(res$U), nrow(eff)) + expect_equal(nrow(res$vi), nrow(eff)) + expect_equal(nrow(res$Ustar), nrow(eff)) + expect_equal(nrow(res$e), nrow(eff)) + expect_equal(nrow(res$c), nrow(cost)) + + num_k <- length(res$k) + + expect_length(res$ce, num_k) + expect_length(res$eib, num_k) + expect_length(res$evi, num_k) + + expect_length(res$best, num_k) + + expect_equal(nrow(res$ib), num_k) ##TODO: should we swap rows and columns to match other variables? + + expect_equal(ncol(res$vi), num_k) + expect_equal(ncol(res$Ustar), num_k) + expect_equal(ncol(res$ol), num_k) + +}) + + +test_that("ib", { + + # single wtp + + c_tmp <- matrix(c(0, 0, 100, 10), nrow = 2) + e_tmp <- matrix(c(0, 0, 1, -2), nrow = 2) + + res <- + bcea(e = e_tmp, + c = c_tmp, wtp = 5) + + k <- 5 + n_comparisons <- 1 + delta_e <- c(-1, 2) + delta_c <- c(-100, -10) # this actually a saving for intervention + n_sim <- 2 + + ib_1 <- k*delta_e[1] - delta_c[1] # 5*(-1) - (-100) = 95 + ib_2 <- k*delta_e[2] - delta_c[2] # 5*2 - (-10) = 20 + + expect_equivalent(c(ib_1, ib_2), res$ib) + + + # multiple wtp + + k <- c(5, 10) + K <- 2 + + res <- + bcea(e = e_tmp, + c = c_tmp, wtp = k) + + ib_1 <- k*delta_e[1] - delta_c[1] # 95, 10*(-1) - (-100) = 90 + ib_2 <- k*delta_e[2] - delta_c[2] # 20, 10*2 - (-10) = 30 + + expect_equivalent(cbind(ib_1, ib_2), drop(res$ib)) + + + # multiple comparisons + + c_tmp <- matrix(c(0, 0, 100, 10, 0, 1), nrow = 2) + e_tmp <- matrix(c(0, 0, 1, -2, -3, -4), nrow = 2) + n_comparisons <- 2 + + res <- + bcea(e = e_tmp, + c = c_tmp, wtp = k) + + # sim x comprison + delta_e <- matrix(c(-1,3, + 2,4), nrow = 2, byrow = TRUE) + delta_c <- matrix(c(-100, 0, + -10, -1), nrow = 2, byrow = TRUE) + + ib_11 <- k*delta_e[1,1] - delta_c[1,1] # 15 30 + ib_12 <- k*delta_e[1,2] - delta_c[1,2] # 15 30 + ib_21 <- k*delta_e[2,1] - delta_c[2,1] # 15 30 + ib_22 <- k*delta_e[2,2] - delta_c[2,2] # 21 41 + + expect_equivalent(cbind(ib_11, ib_21), res$ib[,,1 ]) + expect_equivalent(cbind(ib_12, ib_22), res$ib[,,2 ]) +}) + + +###################### + +# n_comparisons > 1, realistic data +res <- + bcea(e = cbind(eff, eff[, 2]), + c = cbind(cost, cost[, 2])) diff --git a/tests/testthat/test-ceac_plot_ggplot.R b/tests/testthat/test-ceac_plot_ggplot.R new file mode 100644 index 00000000..b5464414 --- /dev/null +++ b/tests/testthat/test-ceac_plot_ggplot.R @@ -0,0 +1,18 @@ +context("ceac_plot") + +# vdiffr::manage_cases(filter = "ceac") + +library(ggplot2) +library(dplyr) +library(reshape2) +library(purrr) +library(vdiffr) + +load("ce.RData") +he <- BCEA::bcea(eff, cost) + +test_that("ceac.plot_ggplot draws correctly", { + + ceac_plot <- ceac.plot(he, graph = "ggplot2", title = "my title") + vdiffr::expect_doppelganger(title = "ceac plot ggplot", fig = ceac_plot) +}) diff --git a/vignettes/.gitignore b/vignettes/.gitignore new file mode 100644 index 00000000..097b2416 --- /dev/null +++ b/vignettes/.gitignore @@ -0,0 +1,2 @@ +*.html +*.R diff --git a/vignettes/ceac.Rmd b/vignettes/ceac.Rmd new file mode 100644 index 00000000..98a99f0f --- /dev/null +++ b/vignettes/ceac.Rmd @@ -0,0 +1,165 @@ +--- +title: "Cost-effectiveness acceptability curve plots" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{ceac} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( +collapse = TRUE, +comment = "#>", +fig.width = 6 +) +``` + +```{r setup, results='hide', message=FALSE, warning=FALSE} +library(BCEA) +library(dplyr) +library(reshape2) +library(ggplot2) +library(purrr) +``` + +The intention of this vignette is to show how to plot different styles of cost-effectiveness acceptability curves using the BCEA package. + +## Two interventions only + +This is the simplest case, usually status-quo versus an alternative intervention. + +```{r} +data("Vaccine") + +he <- bcea(e, c) +# str(he) + +ceac.plot(he) +``` + +The plot defaults to base R plotting. Type of plot can be set explicitly using the `graph` argument. + +```{r} +ceac.plot(he, graph = "base") +ceac.plot(he, graph = "ggplot2") +# ceac.plot(he, graph = "plotly") +``` + +Other plotting arguments can be specified such as title, line colours and theme. + +```{r} +ceac.plot(he, + graph = "ggplot2", + title = "my title", + line = list(colors = "green"), + theme = theme_dark()) +``` + + +## Multiple interventions + +This situation is when there are more than two interventions to consider. +Incremental values can be obtained either alway against a fixed reference intervention, such as status-quo, or for all pair-wise comparisons. + +### Against a fixed reference intervention + +```{r} +data("Smoking") + +he <- bcea(e, c, ref = 4) +# str(he) +``` + +```{r} +ceac.plot(he) + +ceac.plot(he, + graph = "base", + title = "my title", + line = list(colors = "green")) +``` + +```{r} +ceac.plot(he, + graph = "ggplot2", + title = "my title", + line = list(colors = "green")) +``` + +Reposition legend. + +```{r} +ceac.plot(he, pos = FALSE) # bottom right +ceac.plot(he, pos = c(0, 0)) +ceac.plot(he, pos = c(0, 1)) +ceac.plot(he, pos = c(1, 0)) +ceac.plot(he, pos = c(1, 1)) +``` + +```{r} +ceac.plot(he, graph = "ggplot2", pos = c(0, 0)) +ceac.plot(he, graph = "ggplot2", pos = c(0, 1)) +ceac.plot(he, graph = "ggplot2", pos = c(1, 0)) +ceac.plot(he, graph = "ggplot2", pos = c(1, 1)) +``` + +Define colour palette. + +```{r} +mypalette <- RColorBrewer::brewer.pal(3, "Accent") + +ceac.plot(he, + graph = "base", + title = "my title", + line = list(colors = mypalette), + pos = FALSE) + +ceac.plot(he, + graph = "ggplot2", + title = "my title", + line = list(colors = mypalette), + pos = FALSE) +``` + +### Pair-wise comparisons + +First we must determine all combinations of paired interventions using the `multi.ce()` function. + +```{r} +he <- multi.ce(he) +``` + +We can use the same plotting calls as before i.e. `ceac.plot()` and BCEA will deal with the pairwise situation appropriately. +Note that in this case the probabilities at a given willingness to pay sum to 1. + +```{r} +ceac.plot(he, graph = "base") + +ceac.plot(he, + graph = "base", + title = "my title", + line = list(colors = "green"), + pos = FALSE) + +mypalette <- RColorBrewer::brewer.pal(4, "Dark2") + +ceac.plot(he, + graph = "base", + title = "my title", + line = list(colors = mypalette), + pos = c(0,1)) +``` + +```{r} +ceac.plot(he, + graph = "ggplot2", + title = "my title", + line = list(colors = mypalette), + pos = c(0,1)) +``` + +```{r echo=FALSE} +# create pdf +# rmarkdown::render(input = "vignettes/ceac.Rmd", output_format = "pdf_document", output_dir = "vignettes") +``` diff --git a/vignettes/ceac.pdf b/vignettes/ceac.pdf new file mode 100644 index 00000000..9539c190 Binary files /dev/null and b/vignettes/ceac.pdf differ