From 58f67181d6bfa8107ee8d1c5d15293addb503bd7 Mon Sep 17 00:00:00 2001 From: JaroSant <74154059+JaroSant@users.noreply.github.com> Date: Wed, 5 Oct 2022 17:01:55 +0100 Subject: [PATCH] Initial commit --- .gitattributes | 2 + LICENCE | 684 +++ Makefile | 18 + Polynomial.cpp | 1578 ++++++ Polynomial.h | 196 + PolynomialRootFinder.cpp | 1362 ++++++ PolynomialRootFinder.h | 136 + PolynomialTest.cpp | 450 ++ R-plotter.r | 19 + README.md | 34 + WrightFisher.cpp | 9819 ++++++++++++++++++++++++++++++++++++++ WrightFisher.h | 280 ++ config.cfg | 42 + configBridge.cfg | 48 + configDiffusion.cfg | 36 + configHorseCoat.cfg | 63 + main.cpp | 1011 ++++ myHelpers.cpp | 12 + myHelpers.h | 94 + run.sh | 7 + 20 files changed, 15891 insertions(+) create mode 100644 .gitattributes create mode 100644 LICENCE create mode 100644 Makefile create mode 100644 Polynomial.cpp create mode 100644 Polynomial.h create mode 100644 PolynomialRootFinder.cpp create mode 100644 PolynomialRootFinder.h create mode 100644 PolynomialTest.cpp create mode 100644 R-plotter.r create mode 100644 README.md create mode 100644 WrightFisher.cpp create mode 100644 WrightFisher.h create mode 100644 config.cfg create mode 100644 configBridge.cfg create mode 100644 configDiffusion.cfg create mode 100644 configHorseCoat.cfg create mode 100644 main.cpp create mode 100644 myHelpers.cpp create mode 100644 myHelpers.h create mode 100644 run.sh diff --git a/.gitattributes b/.gitattributes new file mode 100644 index 0000000..dfe0770 --- /dev/null +++ b/.gitattributes @@ -0,0 +1,2 @@ +# Auto detect text files and perform LF normalization +* text=auto diff --git a/LICENCE b/LICENCE new file mode 100644 index 0000000..a3fdb96 --- /dev/null +++ b/LICENCE @@ -0,0 +1,684 @@ +GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 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. + +{ + one line to give the + program's name and a brief idea of what it does.} Copyright(C){ + year} {name of author} + + This program is free software : you can redistribute it and / + or modify it under the terms of the GNU General Public License + as published by the Free Software Foundation, + either version 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: + + {project} Copyright (C) {year} {fullname} + 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/Makefile b/Makefile new file mode 100644 index 0000000..857688a --- /dev/null +++ b/Makefile @@ -0,0 +1,18 @@ +CC := g++ +CFLAGS := -Wall -Wextra -std=c++11 -O3 # -g +LDFLAGS := -I/home/ubuntu/Desktop/boost_1_78_0 -I/home/ubuntu/Desktop/EWF /usr/local/lib/libconfig++.a + +#Make sure LDFLAGS points towards the locations where: + +# 1. your boost library resides(e.g.'/home/ubuntu/Desktop/boost_1_78_0') +# 2. the source files for the program reside(e.g.'/home/ubuntu/Desktop/EWF') +# 3. the library libconfig ++.a resides(e.g.'/usr/local/lib/libconfig++.a') + +PROGRAMS := main + +all: $(PROGRAMS) + +main: main.cpp WrightFisher.cpp myHelpers.cpp Polynomial.cpp PolynomialRootFinder.cpp + $(CC) $(CFLAGS) -o $@ $^ $(LDFLAGS) + +clean: rm -f *.o $(PROGRAMS) diff --git a/Polynomial.cpp b/Polynomial.cpp new file mode 100644 index 0000000..4de2623 --- /dev/null +++ b/Polynomial.cpp @@ -0,0 +1,1578 @@ +//======================================================================= +// Copyright (C) 2003-2013 William Hallahan +// +// Permission is hereby granted, free of charge, to any person +// obtaining a copy of this software and associated documentation +// files (the "Software"), to deal in the Software without restriction, +// including without limitation the rights to use, copy, modify, merge, +// publish, distribute, sublicense, and/or sell copies of the Software, +// and to permit persons to whom the Software is furnished to do so, +// subject to the following conditions: +// +// The above copyright notice and this permission notice shall be +// included in all copies or substantial portions of the Software. +// +// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +// EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES +// OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +// NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +// HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +// WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +// FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +// OTHER DEALINGS IN THE SOFTWARE. +//======================================================================= + +//********************************************************************** +// File: Polynomial.cpp +// Author: Bill Hallahan +// Date: January 30, 2003 +// +// Abstract: +// +// This file contains the implementation for class Polynomial. +// +//********************************************************************** + +#include "Polynomial.h" +#include "PolynomialRootFinder.h" +#include +#include +#include +#include +#include + +//====================================================================== +// Constructor: Polynomial::Polynomial +//====================================================================== + +Polynomial::Polynomial() : m_degree(-1), m_coefficient_vector_ptr(NULL) { + SetToScalar(0.0); +} + +//====================================================================== +// Constructor: Polynomial::Polynomial +// +// Input: +// +// scalar A scalar value. +// +//====================================================================== + +Polynomial::Polynomial(double scalar) + : m_degree(-1), m_coefficient_vector_ptr(NULL) { + SetToScalar(scalar); +} + +//====================================================================== +// Constructor: Polynomial::Polynomial +// +// Input: +// +// x_coefficient The coefficient for x term of the +// polynomial. +// +// scalar The scalar value of the polynomial. +// +// Where the resulting polynomial will be in the form of: +// +// x_coefficient * x + scalar = 0 +// +// degree The degree of the polynomial. +// +//====================================================================== + +Polynomial::Polynomial(double x_coefficient, double scalar) + : m_degree(-1), m_coefficient_vector_ptr(NULL) { + SetToFirstOrderPolynomial(x_coefficient, scalar); +} + +//====================================================================== +// Constructor: Polynomial::Polynomial +// +// Input: +// +// x_squared_coefficient The coefficient for x * x term of +// the quadratic polynomial. +// +// x_coefficient The coefficient for x term of the +// quadratic polynomial. +// +// scalar The scalar value of the quadratic +// polynomial. +// +// Where the resulting polynomial will be in the form of: +// +// x_squared_coefficient * x^2 + x_coefficient * x + scalar = 0 +// +// degree The degree of the polynomial. +// +//====================================================================== + +Polynomial::Polynomial(double x_squared_coefficient, double x_coefficient, + double scalar) + : m_degree(-1), m_coefficient_vector_ptr(NULL) { + SetToQuadraticPolynomial(x_squared_coefficient, x_coefficient, scalar); +} + +//====================================================================== +// Constructor: Polynomial::Polynomial +// +// Input: +// +// coefficient_vector_ptr The vector of coefficients in order +// of increasing powers. +// +// degree The degree of the polynomial. +// +//====================================================================== + +Polynomial::Polynomial(double *coefficient_vector_ptr, int degree) + : m_degree(-1), m_coefficient_vector_ptr(NULL) { + SetCoefficients(coefficient_vector_ptr, degree); +} + +//====================================================================== +// Copy Constructor: Polynomial::Polynomial +//====================================================================== + +Polynomial::Polynomial(const Polynomial &polynomial) + : m_degree(-1), m_coefficient_vector_ptr(NULL) { + Copy(polynomial); +} + +//====================================================================== +// Destructor: Polynomial::~Polynomial +//====================================================================== + +Polynomial::~Polynomial() {} + +//====================================================================== +// Member Function: Polynomial::SetCoefficients +// +// Abstract: +// +// This method sets the polynomial coefficients. +// +// +// Input: +// +// coefficient_vector_ptr The vector of coefficients in order +// of increasing powers. +// +// degree The degree of the polynomial. +// +// +// Return Value: +// +// The function has no return value. +// +//====================================================================== + +void Polynomial::SetCoefficients(double *coefficient_vector_ptr, int degree) { + assert(degree >= 0); + + m_degree = degree; + + SetLength(m_degree + 1, false); + + int ii = 0; + + for (ii = 0; ii <= m_degree; ++ii) { + m_coefficient_vector_ptr[ii] = coefficient_vector_ptr[ii]; + } + + AdjustPolynomialDegree(); +} + +//====================================================================== +// Member Function: Polynomial::SetToScalar +// +// Abstract: +// +// This method sets the polynomial to be a scalar. +// The polynomial degree is set to 0 in this method. +// +// +// Input: +// +// scalar A scalar value +// +// Return Value: +// +// The function has no return value. +// +//====================================================================== + +void Polynomial::SetToScalar(double scalar) { SetCoefficients(&scalar, 0); } + +//====================================================================== +// Member Function: Polynomial::SetToFirstOrderPolynomial +// +// Input: +// +// x_coefficient The coefficient for x term of the +// polynomial. +// +// scalar The scalar value of the polynomial. +// +// Where the resulting polynomial will be in the form of: +// +// x_coefficient * x + scalar = 0 +// +// degree The degree of the polynomial. +// +//====================================================================== + +void Polynomial::SetToFirstOrderPolynomial(double x_coefficient, + double scalar) { + double coefficient_array[2]; + coefficient_array[0] = scalar; + coefficient_array[1] = x_coefficient; + SetCoefficients(&coefficient_array[0], 1); +} + +//====================================================================== +// Member Function: Polynomial::SetToQuadraticPolynomial +// +// Input: +// +// x_squared_coefficient The coefficient for x * x term of +// the quadratic polynomial. +// +// x_coefficient The coefficient for x term of the +// quadratic polynomial. +// +// scalar The scalar value of the quadratic +// polynomial. +// +// Where the resulting polynomial will be in the form of: +// +// x_squared_coefficient * x^2 + x_coefficient * x + scalar = 0 +// +// degree The degree of the polynomial. +// +//====================================================================== + +void Polynomial::SetToQuadraticPolynomial(double x_squared_coefficient, + double x_coefficient, double scalar) { + double coefficient_array[3]; + coefficient_array[0] = scalar; + coefficient_array[1] = x_coefficient; + coefficient_array[2] = x_squared_coefficient; + SetCoefficients(&coefficient_array[0], 2); +} + +//====================================================================== +// Member Function: Polynomial::EvaluateReal +// +// Abstract: +// +// This method evaluates the polynomial using the passed real +// value x. The algorithm used is Horner's method. +// +// +// Input: +// +// xr A real value. +// +// +// Return Value: +// +// This function returns a value of type 'double' that is equal +// to the polynomial evaluated at the passed value x. +// +//====================================================================== + +double Polynomial::EvaluateReal(double xr) const { + assert(m_degree >= 0); + + double pr = m_coefficient_vector_ptr[m_degree]; + int i = 0; + + for (i = m_degree - 1; i >= 0; --i) { + pr = pr * xr + m_coefficient_vector_ptr[i]; + } + + return pr; +} + +//====================================================================== +// Member Function: Polynomial::EvaluateReal +// +// Abstract: +// +// This method evaluates the polynomial using the passed real +// value x. The algorithm used is Horner's method. +// +// +// Input: +// +// xr A real value. +// +// dr A reference to a double which contains the real term +// that the polynomial derivative evaluates to. +// +// Return Value: +// +// This function returns a value of type 'double' that is equal +// to the polynomial evaluated at the passed value x. +// +//====================================================================== + +double Polynomial::EvaluateReal(double xr, double &dr) const { + assert(m_degree >= 0); + + double pr = m_coefficient_vector_ptr[m_degree]; + dr = pr; + + int i = 0; + + for (i = m_degree - 1; i > 0; --i) { + pr = pr * xr + m_coefficient_vector_ptr[i]; + dr = dr * xr + pr; + } + + pr = pr * xr + m_coefficient_vector_ptr[0]; + + return pr; +} + +//====================================================================== +// Member Function: Polynomial::EvaluateImaginary +// +// Abstract: +// +// This function evaluates the value of a polynomial for a +// specified pure imaginary value xi. The polynomial value +// is evaluated by Horner's method. +// +// +// Input: +// +// xi A double which equals the imaginary term used to +// evaluate the polynomial. +// +// Outputs: +// +// pr A reference to a double which contains the real term +// that the polynomial evaluates to. +// +// pi A reference to a double which contains the imaginary +// term that the polynomial evaluates to. +// +// Return Value: +// +// This function has no return value. +// +//====================================================================== + +void Polynomial::EvaluateImaginary(double xi, double &pr, double &pi) const { + assert(m_degree >= 0); + + pr = m_coefficient_vector_ptr[m_degree]; + pi = 0; + + int i = 0; + + for (i = m_degree - 1; i >= 0; --i) { + double temp = -pi * xi + m_coefficient_vector_ptr[i]; + pi = pr * xi; + pr = temp; + } + + return; +} + +//====================================================================== +// Member Function: Polynomial::EvaluateComplex +// +// Abstract: +// +// This function evaluates the value of a polynomial for a +// specified complex value xr + i xi. The polynomial value +// is evaluated by Horner's method. +// +// +// Input: +// +// xr A double which equals the real term used to evaluate +// the polynomial. +// +// xi A double which equals the imaginary term used to +// evaluate the polynomial. +// +// Outputs: +// +// pr A reference to a double which contains the real term +// that the polynomial evaluates to. +// +// pi A reference to a double which contains the imaginary +// term that the polynomial evaluates to. +// +// Return Value: +// +// This function has no return value. +// +//====================================================================== + +void Polynomial::EvaluateComplex(double xr, double xi, double &pr, + double &pi) const { + assert(m_degree >= 0); + + pr = m_coefficient_vector_ptr[m_degree]; + pi = 0; + + int i = 0; + + for (i = m_degree - 1; i >= 0; --i) { + double temp = pr * xr - pi * xi + m_coefficient_vector_ptr[i]; + pi = pr * xi + pi * xr; + pr = temp; + } + + return; +} + +//====================================================================== +// Member Function: Polynomial::EvaluateComplex +// +// Abstract: +// +// This function evaluates the value of a polynomial and the +// value of the polynomials derivative for a specified complex +// value xr + i xi. The polynomial value is evaluated by +// Horner's method. The combination of the polynomial evaluation +// and the derivative evaluation is known as the Birge-Vieta method. +// +// +// Input: +// +// xr A double which equals the real term used to evaluate +// the polynomial. +// +// xi A double which equals the imaginary term used to +// evaluate the polynomial. +// +// Outputs: +// +// pr A reference to a double which contains the real term +// that the polynomial evaluates to. +// +// pi A reference to a double which contains the imaginary +// term that the polynomial evaluates to. +// +// dr A reference to a double which contains the real term +// that the polynomial derivative evaluates to. +// +// di A reference to a double which contains the imaginary +// term that the polynomial derivative evaluates to. +// +// Return Value: +// +// This function has no return value. +// +//====================================================================== + +void Polynomial::EvaluateComplex(double xr, double xi, double &pr, double &pi, + double &dr, double &di) const { + assert(m_degree >= 0); + + pr = m_coefficient_vector_ptr[m_degree]; + pi = 0; + dr = pr; + di = 0; + + double temp = 0.0; + int i = 0; + + for (i = m_degree - 1; i > 0; --i) { + temp = pr * xr - pi * xi + m_coefficient_vector_ptr[i]; + pi = pr * xi + pi * xr; + pr = temp; + + temp = dr * xr - di * xi + pr; + di = dr * xi + di * xr + pi; + dr = temp; + } + + temp = pr * xr - pi * xi + m_coefficient_vector_ptr[0]; + pi = pr * xi + pi * xr; + pr = temp; + + return; +} + +//====================================================================== +// Member Function: Polynomial::Derivative +// +// Abstract: +// +// This method calculates the derivative polynomial. +// +// +// Input: +// +// None +// +// Return Value: +// +// This function returns a polynomial that is the derivative +// of this polynomial. +// +//====================================================================== + +Polynomial Polynomial::Derivative() const { + Polynomial derivative_polynomial; + + //------------------------------------------------------------------ + // If this polynomial is just a scalar, i.e. it is of degree + // zero then the derivative is zero. + //------------------------------------------------------------------ + + assert(m_degree >= 0); + + if (m_degree > 0) { + //-------------------------------------------------------------- + // Set the size of the buffer for the derivative polynomial. + //-------------------------------------------------------------- + + derivative_polynomial.SetLength(m_degree); + + //-------------------------------------------------------------- + // Set the degree of the derivative polynomial. + //-------------------------------------------------------------- + + derivative_polynomial.m_degree = m_degree - 1; + + //-------------------------------------------------------------- + // Calculate the derivative polynomial. + //-------------------------------------------------------------- + + double *temp_ptr = derivative_polynomial.m_coefficient_vector_ptr; + + for (int i = m_degree; i > 0; --i) { + temp_ptr[i - 1] = (double)(i)*m_coefficient_vector_ptr[i]; + } + } else { + derivative_polynomial = 0.0; + } + + return derivative_polynomial; +} + +//====================================================================== +// Member Function: Polynomial::Integral +// +// Abstract: +// +// This method calculates the integral polynomial. +// +// +// Input: +// +// None +// +// Return Value: +// +// This function returns a polynomial that is the integral +// of this polynomial. +// +//====================================================================== + +Polynomial Polynomial::Integral() const { + Polynomial integral_polynomial; + + //------------------------------------------------------------------ + // Set the size of the buffer for the integral polynomial. + //------------------------------------------------------------------ + + assert(m_degree >= 0); + + integral_polynomial.SetLength(m_degree + 2); + + //------------------------------------------------------------------ + // Set the degree of the integral polynomial. + //------------------------------------------------------------------ + + integral_polynomial.m_degree = m_degree + 1; + + //------------------------------------------------------------------ + // Calculate the integral polynomial. + //------------------------------------------------------------------ + + double *temp_ptr = integral_polynomial.m_coefficient_vector_ptr; + int i = 0; + + for (i = m_degree; i > 0; --i) { + temp_ptr[i + 1] = m_coefficient_vector_ptr[i] / (double)(i + 1); + } + + return integral_polynomial; +} + +//====================================================================== +// Member Function: Polynomial::Degree +// +// Abstract: +// +// This method gets the polynomial degree. +// +// +// Input: +// +// None. +// +// +// Return Value: +// +// This function returns a value of type 'int' that is the +// degree of the polynomial. +// +//====================================================================== + +int Polynomial::Degree() const { return m_degree; } + +//====================================================================== +// Member Function: Polynomial::FindRoots +// +// Abstract: +// +// This method determines the roots of a polynomial which has +// real coefficients. +// +// +// Input: +// +// +// real_zero_vector_ptr A double precision vector that will +// contain the real parts of the roots +// of the polynomial when this method +// returns. +// +// imaginary_zero_vector_ptr A double precision vector that will +// contain the real parts of the roots +// of the polynomial when this method +// returns. +// +// roots_found_ptr A pointer to an integer that will +// equal the number of roots found when +// this method returns. If the method +// returns SUCCESS then this value will +// always equal the degree of the +// polynomial. +// +// Return Value: +// +// This function returns an enum value of type +// 'PolynomialRootFinder::RootStatus_T'. +// +//====================================================================== + +PolynomialRootFinder::RootStatus_T +Polynomial::FindRoots(double *real_zero_vector_ptr, + double *imaginary_zero_vector_ptr, + int *roots_found_ptr) const { + assert(m_degree >= 0); + + PolynomialRootFinder *polynomial_root_finder_ptr = new PolynomialRootFinder; + + if (polynomial_root_finder_ptr == NULL) { + throw std::bad_alloc(); + } + + std::unique_ptr root_finder_ptr( + polynomial_root_finder_ptr); + + PolynomialRootFinder::RootStatus_T status = root_finder_ptr->FindRoots( + m_coefficient_vector_ptr, m_degree, real_zero_vector_ptr, + imaginary_zero_vector_ptr, roots_found_ptr); + return status; +} + +//====================================================================== +// Member Function: Polynomial::IncludeRealRoot +// +// Abstract: +// +// This method multiplies this polynomial by a first order term +// that incorporates the real root. +// +// +// Input: +// +// real_value A real root value. +// +// +// Return Value: +// +// The function has no return value. +// +//====================================================================== + +void Polynomial::IncludeRealRoot(double real_value) { + if ((m_degree == 0) && (m_coefficient_vector_ptr[0] == 0.0)) { + SetToScalar(1.0); + } + + double coefficient_array[2]; + coefficient_array[0] = -real_value; + coefficient_array[1] = 1.0; + Polynomial temp_polynomial(coefficient_array, 1); + operator*=(temp_polynomial); + return; +} + +//====================================================================== +// Member Function: Polynomial::IncludeComplexConjugateRootPair +// +// Abstract: +// +// This method multiplies this polynomial by a second order +// polynomial that incorporates a complex root pair. +// +// +// Input: +// +// real_value A real root value. +// +// imag_value An imaginary root value. +// +// +// Return Value: +// +// The function has no return value. +// +//====================================================================== + +void Polynomial::IncludeComplexConjugateRootPair(double real_value, + double imag_value) { + if ((m_degree == 0) && (m_coefficient_vector_ptr[0] == 0.0)) { + SetToScalar(1.0); + } + + double coefficient_array[3]; + coefficient_array[0] = real_value * real_value + imag_value * imag_value; + coefficient_array[1] = -(real_value + real_value); + coefficient_array[2] = 1.0; + Polynomial temp_polynomial(coefficient_array, 2); + operator*=(temp_polynomial); +} + +//====================================================================== +// Member Function: Polynomial::Divide +// +// Abstract: +// +// This method divides this polynomial by a passed divisor +// polynomial. The remainder polynomial is stored in the passed +// instance remainder_polynomial. +// +// +// Input: +// +// divisor_polynomial The divisor polynomial +// +// quotient_polynomial A reference to an instance of class +// Polynomial that will contain the quotient +// polynomial when this method returns. +// +// remainder_polynomial A reference to an instance of class +// Polynomial that will contain the remainder +// polynomial when this method returns. +// +// Return Value: +// +// This function returns a value of type 'bool' that false if this +// method fails. This can only occur if the divisor polynomial is +// equal to the scalar value zero. Otherwise the return value is +// true. +// +//====================================================================== + +bool Polynomial::Divide(const Polynomial &divisor_polynomial, + Polynomial "ient_polynomial, + Polynomial &remainder_polynomial) const { + //------------------------------------------------------------------ + // If the divisor is zero then fail. + //------------------------------------------------------------------ + + int divisor_degree = divisor_polynomial.Degree(); + + bool non_zero_divisor_flag = + ((divisor_polynomial.Degree() != 0) || (divisor_polynomial[0] != 0.0)); + + if (non_zero_divisor_flag) { + //-------------------------------------------------------------- + // If this dividend polynomial's degree is not greater than + // or equal to the divisor polynomial's degree then do the division. + //-------------------------------------------------------------- + + remainder_polynomial = *this; + int dividend_degree = Degree(); + quotient_polynomial = 0.0; + int quotient_maximum_degree = dividend_degree - divisor_degree + 1; + quotient_polynomial.SetLength(quotient_maximum_degree); + quotient_polynomial.m_degree = -1; + double *quotient_coefficient_ptr = + quotient_polynomial.m_coefficient_vector_ptr; + double *dividend_coefficient_ptr = + remainder_polynomial.m_coefficient_vector_ptr; + double leading_divisor_coefficient = divisor_polynomial[divisor_degree]; + + //-------------------------------------------------------------- + // Loop and subtract each scaled divisor polynomial + // to perform the division. + //-------------------------------------------------------------- + + int dividend_index = dividend_degree; + + for (dividend_index = dividend_degree; dividend_index >= divisor_degree; + --dividend_index) { + //---------------------------------------------------------- + // Subtract the scaled divisor from the dividend. + //---------------------------------------------------------- + + double scale_value = + remainder_polynomial[dividend_index] / leading_divisor_coefficient; + + //---------------------------------------------------------- + // Increase the order of the quotient polynomial. + //---------------------------------------------------------- + + quotient_polynomial.m_degree += 1; + int j = 0; + + for (j = quotient_polynomial.m_degree; j >= 1; --j) { + quotient_coefficient_ptr[j] = quotient_coefficient_ptr[j - 1]; + } + + quotient_coefficient_ptr[0] = scale_value; + + //---------------------------------------------------------- + // Subtract the scaled divisor from the dividend. + //---------------------------------------------------------- + + int dividend_degree_index = dividend_index; + + for (j = divisor_degree; j >= 0; --j) { + dividend_coefficient_ptr[dividend_degree_index] -= + divisor_polynomial[j] * scale_value; + --dividend_degree_index; + } + } + + //-------------------------------------------------------------- + // Adjust the order of the current dividend polynomial. + // This is the remainder polynomial. + //-------------------------------------------------------------- + + remainder_polynomial.AdjustPolynomialDegree(); + quotient_polynomial.AdjustPolynomialDegree(); + } else { + quotient_polynomial = DBL_MAX; + remainder_polynomial = 0.0; + } + + return non_zero_divisor_flag; +} + +//====================================================================== +// Member Function: Polynomial::operator [] +// +// Abstract: +// +// This method returns the specified polynomial coefficient. +// +// +// Input: +// +// power_index The coefficient index. +// +// +// Return Value: +// +// This function returns a value of type 'double' that is the +// coefficient value corresponding to the specified power. +// +//====================================================================== + +double Polynomial::operator[](int power_index) const { + //------------------------------------------------------------------ + // Ensure that the index is within range. + //------------------------------------------------------------------ + + assert(m_degree >= 0); + + if ((power_index < 0) || (power_index > m_degree)) { + throw std::exception(); + } + + return m_coefficient_vector_ptr[power_index]; +} + +//====================================================================== +// Member Function: Polynomial::operator [] +// +// Abstract: +// +// This method returns the specified polynomial coefficient. +// +// +// Input: +// +// power_index The coefficient index. +// +// +// Return Value: +// +// This function returns a value of type 'double' that is the +// coefficient value corresponding to the specified power. +// +//====================================================================== + +double &Polynomial::operator[](int power_index) { + //------------------------------------------------------------------ + // Ensure that the index is within range. + //------------------------------------------------------------------ + + assert(m_degree >= 0); + + if ((power_index < 0) || (power_index > m_degree)) { + throw std::exception(); + } + + return m_coefficient_vector_ptr[power_index]; +} + +//====================================================================== +// Member Function: Polynomial::operator += +// +// Abstract: +// +// This method adds a polynomial to this polynomial. +// +// +// Input: +// +// polynomial An instance of class Polynomial +// +// +// Return Value: +// +// This function returns this polynomial. +// +//====================================================================== + +Polynomial Polynomial::operator+=(const Polynomial &polynomial) { + assert(m_degree >= 0); + + int i = 0; + + if (m_degree >= polynomial.m_degree) { + for (i = 0; i <= polynomial.m_degree; ++i) { + m_coefficient_vector_ptr[i] += polynomial.m_coefficient_vector_ptr[i]; + } + } else { + SetLength(polynomial.m_degree + 1, true); + + for (i = 0; i <= m_degree; ++i) { + m_coefficient_vector_ptr[i] += polynomial.m_coefficient_vector_ptr[i]; + } + + for (i = m_degree + 1; i <= polynomial.m_degree; ++i) { + m_coefficient_vector_ptr[i] = polynomial.m_coefficient_vector_ptr[i]; + } + + m_degree = polynomial.m_degree; + } + + //------------------------------------------------------------------ + // If the leading coefficient(s) are zero, then decrease the + // polynomial degree. + //------------------------------------------------------------------ + + AdjustPolynomialDegree(); + + return *this; +} + +//====================================================================== +// Member Function: Polynomial::operator += +// +// Abstract: +// +// This method adds a scalar to this polynomial. +// +// +// Input: +// +// scalar A scalar value. +// +// +// Return Value: +// +// This function returns this polynomial. +// +//====================================================================== + +Polynomial Polynomial::operator+=(double scalar) { + assert(m_degree >= 0); + + m_coefficient_vector_ptr[0] += scalar; + + return *this; +} + +//====================================================================== +// Member Function: Polynomial::operator -= +// +// Abstract: +// +// This method subtracts a polynomial from this polynomial. +// +// +// Input: +// +// polynomial An instance of class Polynomial +// +// +// Return Value: +// +// This function returns this polynomial. +// +//====================================================================== + +Polynomial Polynomial::operator-=(const Polynomial &polynomial) { + assert(m_degree >= 0); + + int i = 0; + + if (m_degree >= polynomial.m_degree) { + for (i = 0; i <= polynomial.m_degree; ++i) { + m_coefficient_vector_ptr[i] -= polynomial.m_coefficient_vector_ptr[i]; + } + } else { + SetLength(polynomial.m_degree + 1, true); + + for (i = 0; i <= m_degree; ++i) { + m_coefficient_vector_ptr[i] -= polynomial.m_coefficient_vector_ptr[i]; + } + + for (i = m_degree + 1; i <= polynomial.m_degree; ++i) { + m_coefficient_vector_ptr[i] = -polynomial.m_coefficient_vector_ptr[i]; + } + + m_degree = polynomial.m_degree; + } + + //------------------------------------------------------------------ + // If the leading coefficient(s) are zero, then decrease the + // polynomial degree. + //------------------------------------------------------------------ + + AdjustPolynomialDegree(); + + return *this; +} + +//====================================================================== +// Member Function: Polynomial::operator -= +// +// Abstract: +// +// This method subtracts a scalar from this polynomial. +// +// +// Input: +// +// scalar A scalar value. +// +// +// Return Value: +// +// This function returns this polynomial. +// +//====================================================================== + +Polynomial Polynomial::operator-=(double scalar) { + assert(m_degree >= 0); + + m_coefficient_vector_ptr[0] -= scalar; + + return *this; +} + +//====================================================================== +// Member Function: Polynomial::operator *= +// +// Abstract: +// +// This method multiplies a polynomial times this polynomial. +// +// +// Input: +// +// polynomial An instance of class Polynomial +// +// +// Return Value: +// +// This function returns this polynomial. +// +//====================================================================== + +Polynomial Polynomial::operator*=(const Polynomial &polynomial) { + //------------------------------------------------------------------ + // Create a temporary buffer to hold the product of the two + // polynomials. + //------------------------------------------------------------------ + + assert(m_degree >= 0); + + int convolution_length = m_degree + polynomial.m_degree + 1; + + std::vector temp_vector; + temp_vector.resize(convolution_length + 1); + double *temp_vector_ptr = &temp_vector[0]; + + //------------------------------------------------------------------ + // Zero the temporary buffer. + //------------------------------------------------------------------ + + int i = 0; + + for (i = 0; i < convolution_length; ++i) { + temp_vector_ptr[i] = 0.0; + } + + //------------------------------------------------------------------ + // Calculate the convolution in the temporary buffer. + //------------------------------------------------------------------ + + for (i = 0; i <= m_degree; ++i) { + for (int j = 0; j <= polynomial.m_degree; ++j) { + temp_vector_ptr[i + j] += + m_coefficient_vector_ptr[i] * polynomial.m_coefficient_vector_ptr[j]; + } + } + + //------------------------------------------------------------------ + // Make sure this buffer is large enough for the product. + //------------------------------------------------------------------ + + SetLength((unsigned int)(convolution_length), false); + + //------------------------------------------------------------------ + // Store the result in this instance. + //------------------------------------------------------------------ + + m_degree = convolution_length - 1; + + for (i = 0; i <= m_degree; ++i) { + m_coefficient_vector_ptr[i] = temp_vector_ptr[i]; + } + + //------------------------------------------------------------------ + // If the leading coefficient(s) are zero, then decrease the + // polynomial degree. + //------------------------------------------------------------------ + + AdjustPolynomialDegree(); + + return *this; +} + +//====================================================================== +// Member Function: Polynomial::operator *= +// +// Abstract: +// +// This method multiplies a scalar time this polynomial. +// +// +// Input: +// +// scalar A scalar value. +// +// +// Return Value: +// +// This function returns this polynomial. +// +//====================================================================== + +Polynomial Polynomial::operator*=(double scalar) { + assert(m_degree >= 0); + + int i = 0; + + for (i = 0; i <= m_degree; ++i) { + m_coefficient_vector_ptr[i] *= scalar; + } + + //------------------------------------------------------------------ + // If the leading coefficient(s) are zero, then decrease the + // polynomial degree. + //------------------------------------------------------------------ + + AdjustPolynomialDegree(); + + return *this; +} + +//====================================================================== +// Member Function: Polynomial::operator /= +// +// Abstract: +// +// This method divides this polynomial by a scalar. +// +// +// Input: +// +// scalar A scalar value. +// +// +// Return Value: +// +// This function returns this polynomial. +// +//====================================================================== + +Polynomial Polynomial::operator/=(double scalar) { + assert(m_degree >= 0); + + int i = 0; + + for (i = 0; i <= m_degree; ++i) { + m_coefficient_vector_ptr[i] /= scalar; + } + + return *this; +} + +//====================================================================== +// Member Function: Polynomial::operator + +// +// Abstract: +// +// This method implements unary operator +() +// +// +// Input: +// +// None. +// +// +// Return Value: +// +// This function returns a polynomial which is equal to this instance. +// +//====================================================================== + +Polynomial Polynomial::operator+() { + assert(m_degree >= 0); + return *this; +} + +//====================================================================== +// Member Function: Polynomial::operator - +// +// Abstract: +// +// This method implements unary operator -(). +// This polynomials coefficients became the negative of +// their present value and then this polynomial is returned. +// +// +// Input: +// +// None. +// +// +// Return Value: +// +// This function returns a polynomial which is the negative of +// this instance. +// +//====================================================================== + +Polynomial Polynomial::operator-() { + assert(m_degree >= 0); + + for (int i = 0; i <= m_degree; ++i) { + m_coefficient_vector_ptr[i] = -m_coefficient_vector_ptr[i]; + } + + return *this; +} + +//====================================================================== +// Member Function: Polynomial::operator = +// +// Abstract: +// +// This method sets this polynomial to a scalar value. +// +// +// Input: +// +// scalar A scalar value. +// +// +// Return Value: +// +// This function returns this polynomial. +// +//====================================================================== + +Polynomial Polynomial::operator=(double scalar) { + SetCoefficients(&scalar, 0); + return *this; +} + +//====================================================================== +// Member Function: Polynomial::operator = +// +// Abstract: +// +// This method copies this polynomial. +// +// +// Input: +// +// polynomial An instance of class Polynomial +// +// +// Return Value: +// +// This function returns this polynomial. +// +//====================================================================== + +Polynomial Polynomial::operator=(const Polynomial &polynomial) { + if (this != &polynomial) { + Copy(polynomial); + } + + return *this; +} + +//====================================================================== +// Member Function: Polynomial::AdjustPolynomialDegree +// +// Abstract: +// +// This method will decrease the polynomial degree until leading +// coefficient is non-zero or until the polynomial degree is zero. +// +// +// Input: +// +// None. +// +// +// Return Value: +// +// This method has no return value. +// +//====================================================================== + +void Polynomial::AdjustPolynomialDegree() { + //------------------------------------------------------------------ + // Any leading coefficient with a magnitude less than DBL_EPSILON + // is treated as if it was zero. + //------------------------------------------------------------------ + + while ((m_degree > 0) && + (fabs(m_coefficient_vector_ptr[m_degree]) < DBL_EPSILON)) { + m_coefficient_vector_ptr[m_degree] = 0.0; + m_degree--; + } + + return; +} + +//====================================================================== +// Member Function: Polynomial::Copy +// +// Abstract: +// +// This method copies a passed polynomial into this instance. +// +// +// Input: +// +// polynomial An instance of class Polynomial. +// +// +// Return Value: +// +// This function returns this polynomial. +// +//====================================================================== + +void Polynomial::Copy(const Polynomial &polynomial) { + SetLength(polynomial.m_degree + 1); + + m_degree = polynomial.m_degree; + + for (int i = 0; i <= m_degree; ++i) { + m_coefficient_vector_ptr[i] = polynomial.m_coefficient_vector_ptr[i]; + } + + return; +} + +//====================================================================== +// Member Function: Polynomial::SetLength +// +// Abstract: +// +// This function is called to set the buffer lengths for the +// coefficient vector. If the new buffer length is less than +// or equal to the current buffer lengths then then the buffer +// is not modified and the data length is set to the new buffer +// length. If the new data length is greater than the current +// buffer lengths then the buffer is reallocated to the new +// buffer size. In this case, if argument copy_data_flag +// is set to the value true then the data in the old buffer +// is copied to the new buffer. +// +// +// Input: +// +// udata_length The new length of the data. +// +// copy_data_flag If this is true then existing data +// is copied to any newly allocated buffer. +// This parameter defaults to the value +// 'true'. +// +// Output: +// +// This function has no return value. +// +//====================================================================== + +void Polynomial::SetLength(unsigned int number_of_coefficients, + bool copy_data_flag) { + + // If m_degree is equal to -1, then this is a new polynomial and the + // caller will set m_degree. + if ((!copy_data_flag) || (m_degree == -1)) { + // Clear and resize the coefficient vector. + m_coefficient_vector.clear(); + m_coefficient_vector.resize(number_of_coefficients); + m_coefficient_vector_ptr = &m_coefficient_vector[0]; + } else { + // Save the polynomial values in a temporary vector. + std::vector temp_vector; + temp_vector.resize(m_degree + 1); + + int i = 0; + + for (i = 0; i <= m_degree; ++i) { + temp_vector[i] = m_coefficient_vector_ptr[i]; + } + + // Clear and resize the coefficient vector. + m_coefficient_vector.clear(); + m_coefficient_vector.resize(number_of_coefficients); + m_coefficient_vector_ptr = &m_coefficient_vector[0]; + + // Restore the coefficients for the new vector size. + // Was the polynomial size increased? + if (number_of_coefficients > (unsigned int)(m_degree + 1)) { + // The polynomial size was increased. + for (i = 0; i <= m_degree; ++i) { + m_coefficient_vector_ptr[i] = temp_vector[i]; + } + + for (i = m_degree + 1; i < (int)(number_of_coefficients); ++i) { + m_coefficient_vector_ptr[i] = 0.0; + } + } else { + for (int i = 0; i < (int)(number_of_coefficients); ++i) { + m_coefficient_vector_ptr[i] = temp_vector[i]; + } + } + } + + return; +} + +//====================================================================== +// Global operators +//====================================================================== + +//====================================================================== +// Addition of two instances of this class. +//====================================================================== + +Polynomial operator+(const Polynomial &polynomial_0, + const Polynomial &polynomial_1) { + return Polynomial(polynomial_0) += polynomial_1; +} + +//====================================================================== +// Addition of an instance of the Polynomial class and a scalar. +//====================================================================== + +Polynomial operator+(const Polynomial &polynomial, double scalar) { + return Polynomial(polynomial) += scalar; +} + +Polynomial operator+(double scalar, const Polynomial &polynomial) { + return Polynomial(polynomial) += scalar; +} + +//====================================================================== +// Subtraction of two instances of this class. +//====================================================================== + +Polynomial operator-(const Polynomial &minuend_polynomial, + const Polynomial &subtrahend_polynomial) { + return Polynomial(minuend_polynomial) -= subtrahend_polynomial; +} + +//====================================================================== +// Subtraction with an instance of the Polynomial class and a scalar. +//====================================================================== + +Polynomial operator-(const Polynomial &minuend_polynomial, double scalar) { + return Polynomial(minuend_polynomial) -= scalar; +} + +Polynomial operator-(double scalar, const Polynomial &polynomial) { + return (-Polynomial(polynomial)) + scalar; +} + +//====================================================================== +// Multiplication of two instances of this class. +//====================================================================== + +Polynomial operator*(const Polynomial &polynomial_0, + const Polynomial &polynomial_1) { + return Polynomial(polynomial_0) *= polynomial_1; +} + +//====================================================================== +// Multiplication of an instance of the Polynomial class and a scalar. +//====================================================================== + +Polynomial operator*(const Polynomial &polynomial, double scalar) { + return Polynomial(polynomial) *= scalar; +} + +Polynomial operator*(double scalar, const Polynomial &polynomial) { + return Polynomial(polynomial) *= scalar; +} + +//====================================================================== +// Division with an instance of the Polynomial class and a scalar. +//====================================================================== + +Polynomial operator/(const Polynomial &polynomial, double scalar) { + return Polynomial(polynomial) /= scalar; +} diff --git a/Polynomial.h b/Polynomial.h new file mode 100644 index 0000000..94200c6 --- /dev/null +++ b/Polynomial.h @@ -0,0 +1,196 @@ +//======================================================================= +// Copyright (C) 2003-2013 William Hallahan +// +// Permission is hereby granted, free of charge, to any person +// obtaining a copy of this software and associated documentation +// files (the "Software"), to deal in the Software without restriction, +// including without limitation the rights to use, copy, modify, merge, +// publish, distribute, sublicense, and/or sell copies of the Software, +// and to permit persons to whom the Software is furnished to do so, +// subject to the following conditions: +// +// The above copyright notice and this permission notice shall be +// included in all copies or substantial portions of the Software. +// +// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +// EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES +// OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +// NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +// HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +// WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +// FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +// OTHER DEALINGS IN THE SOFTWARE. +//======================================================================= + +//********************************************************************** +// File: Polynomial.h +// Author: Bill Hallahan +// Date: January 30, 2003 +// +// Abstract: +// +// This file contains the definition for class Polynomial. +// +//********************************************************************** + +#ifndef POLYNOMIAL_H +#define POLYNOMIAL_H + +#include "PolynomialRootFinder.h" +#include + +//====================================================================== +// Class definition. +//====================================================================== + +class Polynomial { +protected: + std::vector m_coefficient_vector; + int m_degree; + double *m_coefficient_vector_ptr; + +public: + Polynomial(); + + Polynomial(double scalar); + + Polynomial(double x_coefficient, double scalar); + + Polynomial(double x_squared_coefficient, double x_coefficient, double scalar); + + Polynomial(double *coefficient_vector, int degree); + + Polynomial(const Polynomial &polynomial); + + virtual ~Polynomial(); + + void SetCoefficients(double *coefficient_vector_ptr, int degree); + + void SetToScalar(double scalar); + + void SetToFirstOrderPolynomial(double x_coefficient, double scalar); + + void SetToQuadraticPolynomial(double x_squared_coefficient, + double x_coefficient, double scalar); + + double EvaluateReal(double xr) const; + + double EvaluateReal(double xr, double &dr) const; + + void EvaluateImaginary(double xi, double &pr, double &pi) const; + + void EvaluateComplex(double xr, double xi, double &pr, double &pi) const; + + void EvaluateComplex(double xr, double xi, double &pr, double &pi, double &dr, + double &di) const; + + Polynomial Derivative() const; + + Polynomial Integral() const; + + int Degree() const; + + PolynomialRootFinder::RootStatus_T + FindRoots(double *real_zero_vector_ptr, double *imaginary_zero_vector_ptr, + int *roots_found_ptr = 0) const; + + void IncludeRealRoot(double real_value); + + void IncludeComplexConjugateRootPair(double real_value, double imag_value); + + bool Divide(const Polynomial &divisor_polynomial, + Polynomial "ient_polynomial, + Polynomial &remainder_polynomial) const; + + double operator[](int power_index) const; + + double &operator[](int power_index); + + Polynomial operator+=(const Polynomial &polynomial); + + Polynomial operator+=(double scalar); + + Polynomial operator-=(const Polynomial &polynomial); + + Polynomial operator-=(double scalar); + + Polynomial operator*=(const Polynomial &polynomial); + + Polynomial operator*=(double scalar); + + Polynomial operator/=(double scalar); + + Polynomial operator+(); + + Polynomial operator-(); + + Polynomial operator=(double scalar); + + Polynomial operator=(const Polynomial &polynomial); + + void Copy(const Polynomial &polynomial); + +private: + void AdjustPolynomialDegree(); + + // void Copy(const Polynomial & polynomial); + + void SetLength(unsigned int number_of_coefficients, + bool copy_data_flag = true); +}; + +//====================================================================== +// Global operators. +//====================================================================== + +//====================================================================== +// Addition of two instances of this class. +//====================================================================== + +Polynomial operator+(const Polynomial &polynomial_0, + const Polynomial &polynomial_1); + +//====================================================================== +// Addition of an instance of the Polynomial class and a scalar. +//====================================================================== + +Polynomial operator+(const Polynomial &polynomial, double scalar); + +Polynomial operator+(double scalar, const Polynomial &polynomial); + +//====================================================================== +// Subtraction of two instances of this class. +//====================================================================== + +Polynomial operator-(const Polynomial &minuend_polynomial, + const Polynomial &subtrahend_polynomial); + +//====================================================================== +// Subtraction with an instance of the Polynomial class and a scalar. +//====================================================================== + +Polynomial operator-(const Polynomial &minuend_polynomial, double scalar); + +Polynomial operator-(double scalar, const Polynomial &polynomial); + +//====================================================================== +// Multiplication of two instances of this class. +//====================================================================== + +Polynomial operator*(const Polynomial &polynomial_0, + const Polynomial &polynomial_1); + +//====================================================================== +// Multiplication of an instance of the Polynomial class and a scalar. +//====================================================================== + +Polynomial operator*(const Polynomial &polynomial, double scalar); + +Polynomial operator*(double scalar, const Polynomial &polynomial); + +//====================================================================== +// Division with an instance of the Polynomial class and a scalar. +//====================================================================== + +Polynomial operator/(const Polynomial &polynomial, double scalar); +#endif diff --git a/PolynomialRootFinder.cpp b/PolynomialRootFinder.cpp new file mode 100644 index 0000000..28fabb0 --- /dev/null +++ b/PolynomialRootFinder.cpp @@ -0,0 +1,1362 @@ +//======================================================================= +// Copyright (C) 2003-2013 William Hallahan +// +// Permission is hereby granted, free of charge, to any person +// obtaining a copy of this software and associated documentation +// files (the "Software"), to deal in the Software without restriction, +// including without limitation the rights to use, copy, modify, merge, +// publish, distribute, sublicense, and/or sell copies of the Software, +// and to permit persons to whom the Software is furnished to do so, +// subject to the following conditions: +// +// The above copyright notice and this permission notice shall be +// included in all copies or substantial portions of the Software. +// +// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +// EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES +// OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +// NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +// HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +// WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +// FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +// OTHER DEALINGS IN THE SOFTWARE. +//======================================================================= + +//********************************************************************** +// File: PolynomialRootFinder.cpp +// Author: Bill Hallahan +// Date: January 30, 2003 +// +// Abstract: +// +// This file contains the implementation for class +// PolynomialRootFinder. +// +//********************************************************************** + +#include "PolynomialRootFinder.h" +#include +#include + +//====================================================================== +// Local constants. +//====================================================================== + +namespace { +//------------------------------------------------------------------ +// The following machine constants are used in this method. +// +// f_BASE The base of the floating point number system used. +// +// f_ETA The maximum relative representation error which +// can be described as the smallest positive floating +// point number such that 1.0 + f_ETA is greater than 1.0. +// +// f_MAXIMUM_FLOAT The largest floating point number. +// +// f_MINIMUM_FLOAT The smallest positive floating point number. +// +//------------------------------------------------------------------ + +const float f_BASE = 2.0; +const float f_ETA = FLT_EPSILON; +const float f_ETA_N = (float)(10.0) * f_ETA; +const float f_ETA_N_SQUARED = (float)(100.0) * f_ETA; +const float f_MAXIMUM_FLOAT = FLT_MAX; +const float f_MINIMUM_FLOAT = FLT_MIN; +const float f_XX_INITIAL_VALUE = (float)(0.70710678); +const float f_COSR_INITIAL_VALUE = (float)(-0.069756474); +const float f_SINR_INITIAL_VALUE = (float)(0.99756405); +}; // namespace + +//====================================================================== +// Constructor: PolynomialRootFinder::PolynomialRootFinder +//====================================================================== + +PolynomialRootFinder::PolynomialRootFinder() {} + +//====================================================================== +// Destructor: PolynomialRootFinder::~PolynomialRootFinder +//====================================================================== + +PolynomialRootFinder::~PolynomialRootFinder() {} + +//====================================================================== +// Member Function: PolynomialRootFinder::FindRoots +// +// Abstract: +// +// This method determines the roots of a polynomial which +// has real coefficients. This code is based on FORTRAN +// code published in reference [1]. The method is based on +// an algorithm the three-stage algorithm described in +// Jenkins and Traub [2]. +// +// 1. "Collected Algorithms from ACM, Volume III", Algorithms 493-545 +// 1983. (The root finding algorithms is number 493) +// +// 2. Jenkins, M. A. and Traub, J. F., "A three-stage algorithm for +// real polynomials using quadratic iteration", SIAM Journal of +// Numerical Analysis, 7 (1970), 545-566 +// +// 3. Jenkins, M. A. and Traub, J. F., "Principles for testing +// polynomial zerofinding programs", ACM TOMS 1, +// 1 (March 1975), 26-34 +// +// +// Input: +// +// All vectors below must be at least a length equal to degree + 1. +// +// coefficicent_ptr A double precision vector that contains +// the polynomial coefficients in order +// of increasing power. +// +// degree The degree of the polynomial. +// +// real_zero_vector_ptr A double precision vector that will +// contain the real parts of the roots +// of the polynomial when this method +// returns. +// +// imaginary_zero_vector_ptr A double precision vector that will +// contain the real parts of the roots +// of the polynomial when this method +// returns. +// +// number_of_roots_found_ptr A pointer to an integer that will +// equal the number of roots found when +// this method returns. If the method +// returns SUCCESS then this value will +// always equal the degree of the +// polynomial. +// +// Return Value: +// +// The function returns an enum value of type +// 'PolynomialRootFinder::RootStatus_T'. +// +//====================================================================== + +PolynomialRootFinder::RootStatus_T PolynomialRootFinder::FindRoots( + double *coefficient_vector_ptr, int degree, double *real_zero_vector_ptr, + double *imaginary_zero_vector_ptr, int *number_of_roots_found_ptr) { + //-------------------------------------------------------------- + // The algorithm fails if the polynomial is not at least + // degree on or the leading coefficient is zero. + //-------------------------------------------------------------- + + PolynomialRootFinder::RootStatus_T status; + + if (degree == 0) { + status = PolynomialRootFinder::SCALAR_VALUE_HAS_NO_ROOTS; + } else if (coefficient_vector_ptr[degree] == 0.0) { + status = PolynomialRootFinder::LEADING_COEFFICIENT_IS_ZERO; + } else { + //-------------------------------------------------------------- + // Allocate temporary vectors used to find the roots. + //-------------------------------------------------------------- + + m_degree = degree; + + std::vector temp_vector; + std::vector pt_vector; + + m_p_vector.resize(m_degree + 1); + m_qp_vector.resize(m_degree + 1); + m_k_vector.resize(m_degree + 1); + m_qk_vector.resize(m_degree + 1); + m_svk_vector.resize(m_degree + 1); + temp_vector.resize(m_degree + 1); + pt_vector.resize(m_degree + 1); + + m_p_vector_ptr = &m_p_vector[0]; + m_qp_vector_ptr = &m_qp_vector[0]; + m_k_vector_ptr = &m_k_vector[0]; + m_qk_vector_ptr = &m_qk_vector[0]; + m_svk_vector_ptr = &m_svk_vector[0]; + double *temp_vector_ptr = &temp_vector[0]; + PRF_Float_T *pt_vector_ptr = &pt_vector[0]; + + //-------------------------------------------------------------- + // m_are and m_mre refer to the unit error in + and * + // respectively. they are assumed to be the same as + // f_ETA. + //-------------------------------------------------------------- + + m_are = f_ETA; + m_mre = f_ETA; + PRF_Float_T lo = f_MINIMUM_FLOAT / f_ETA; + + //-------------------------------------------------------------- + // Initialization of constants for shift rotation. + //-------------------------------------------------------------- + + PRF_Float_T xx = f_XX_INITIAL_VALUE; + PRF_Float_T yy = -xx; + PRF_Float_T cosr = f_COSR_INITIAL_VALUE; + PRF_Float_T sinr = f_SINR_INITIAL_VALUE; + m_n = m_degree; + m_n_plus_one = m_n + 1; + + //-------------------------------------------------------------- + // Make a copy of the coefficients in reverse order. + //-------------------------------------------------------------- + + int ii = 0; + + for (ii = 0; ii < m_n_plus_one; ++ii) { + m_p_vector_ptr[m_n - ii] = coefficient_vector_ptr[ii]; + } + + //-------------------------------------------------------------- + // Assume failure. The status is set to SUCCESS if all + // the roots are found. + //-------------------------------------------------------------- + + status = PolynomialRootFinder::FAILED_TO_CONVERGE; + + //-------------------------------------------------------------- + // If there are any zeros at the origin, remove them. + //-------------------------------------------------------------- + + int jvar = 0; + + while (m_p_vector_ptr[m_n] == 0.0) { + jvar = m_degree - m_n; + real_zero_vector_ptr[jvar] = 0.0; + imaginary_zero_vector_ptr[jvar] = 0.0; + m_n_plus_one = m_n_plus_one - 1; + m_n = m_n - 1; + } + + //-------------------------------------------------------------- + // Loop and find polynomial zeros. In the original algorithm + // this loop was an infinite loop. Testing revealed that the + // number of main loop iterations to solve a polynomial of a + // particular degree is usually about half the degree. + // We loop twice that to make sure the solution is found. + // (This should be revisited as it might preclude solving + // some large polynomials.) + //-------------------------------------------------------------- + + int count = 0; + + for (count = 0; count < m_degree; ++count) { + //---------------------------------------------------------- + // Check for less than 2 zeros to finish the solution. + //---------------------------------------------------------- + + if (m_n <= 2) { + if (m_n > 0) { + //-------------------------------------------------- + // Calculate the final zero or pair of zeros. + //-------------------------------------------------- + + if (m_n == 1) { + real_zero_vector_ptr[m_degree - 1] = + -m_p_vector_ptr[1] / m_p_vector_ptr[0]; + + imaginary_zero_vector_ptr[m_degree - 1] = 0.0; + } else { + SolveQuadraticEquation(m_p_vector_ptr[0], m_p_vector_ptr[1], + m_p_vector_ptr[2], + real_zero_vector_ptr[m_degree - 2], + imaginary_zero_vector_ptr[m_degree - 2], + real_zero_vector_ptr[m_degree - 1], + imaginary_zero_vector_ptr[m_degree - 1]); + } + } + + m_n = 0; + status = PolynomialRootFinder::SUCCESS; + break; + } else { + //------------------------------------------------------ + // Find largest and smallest moduli of coefficients. + //------------------------------------------------------ + + PRF_Float_T max = 0.0; + PRF_Float_T min = f_MAXIMUM_FLOAT; + PRF_Float_T xvar; + + for (ii = 0; ii < m_n_plus_one; ++ii) { + xvar = (PRF_Float_T)(::fabs((PRF_Float_T)(m_p_vector_ptr[ii]))); + + if (xvar > max) { + max = xvar; + } + + if ((xvar != 0.0) && (xvar < min)) { + min = xvar; + } + } + + //------------------------------------------------------ + // Scale if there are large or very small coefficients. + // Computes a scale factor to multiply the coefficients + // of the polynomial. The scaling is done to avoid + // overflow and to avoid undetected underflow from + // interfering with the convergence criterion. + // The factor is a power of the base. + //------------------------------------------------------ + + bool do_scaling_flag = false; + PRF_Float_T sc = lo / min; + + if (sc <= 1.0) { + do_scaling_flag = f_MAXIMUM_FLOAT / sc < max; + } else { + do_scaling_flag = max < 10.0; + + if (!do_scaling_flag) { + if (sc == 0.0) { + sc = f_MINIMUM_FLOAT; + } + } + } + + //------------------------------------------------------ + // Conditionally scale the data. + //------------------------------------------------------ + + if (do_scaling_flag) { + int lvar = (int)(::log(sc) / ::log(f_BASE) + 0.5); + double factor = ::pow((double)(f_BASE * 1.0), double(lvar)); + + if (factor != 1.0) { + for (ii = 0; ii < m_n_plus_one; ++ii) { + m_p_vector_ptr[ii] = factor * m_p_vector_ptr[ii]; + } + } + } + + //------------------------------------------------------ + // Compute lower bound on moduli of zeros. + //------------------------------------------------------ + + for (ii = 0; ii < m_n_plus_one; ++ii) { + pt_vector_ptr[ii] = + (PRF_Float_T)(::fabs((PRF_Float_T)(m_p_vector_ptr[ii]))); + } + + pt_vector_ptr[m_n] = -pt_vector_ptr[m_n]; + + //------------------------------------------------------ + // Compute upper estimate of bound. + //------------------------------------------------------ + + xvar = (PRF_Float_T)( + ::exp((::log(-pt_vector_ptr[m_n]) - ::log(pt_vector_ptr[0])) / + (PRF_Float_T)(m_n))); + + //------------------------------------------------------ + // If newton step at the origin is better, use it. + //------------------------------------------------------ + + PRF_Float_T xm; + + if (pt_vector_ptr[m_n - 1] != 0.0) { + xm = -pt_vector_ptr[m_n] / pt_vector_ptr[m_n - 1]; + + if (xm < xvar) { + xvar = xm; + } + } + + //------------------------------------------------------ + // Chop the interval (0, xvar) until ff <= 0 + //------------------------------------------------------ + + PRF_Float_T ff; + + while (true) { + xm = (PRF_Float_T)(xvar * 0.1); + ff = pt_vector_ptr[0]; + + for (ii = 1; ii < m_n_plus_one; ++ii) { + ff = ff * xm + pt_vector_ptr[ii]; + } + + if (ff <= 0.0) { + break; + } + + xvar = xm; + } + + PRF_Float_T dx = xvar; + + //------------------------------------------------------ + // Do newton iteration until xvar converges to two + // decimal places. + //------------------------------------------------------ + + while (true) { + if ((PRF_Float_T)(::fabs(dx / xvar)) <= 0.005) { + break; + } + + ff = pt_vector_ptr[0]; + PRF_Float_T df = ff; + + for (ii = 1; ii < m_n; ++ii) { + ff = ff * xvar + pt_vector_ptr[ii]; + df = df * xvar + ff; + } + + ff = ff * xvar + pt_vector_ptr[m_n]; + dx = ff / df; + xvar = xvar - dx; + } + + PRF_Float_T bnd = xvar; + + //------------------------------------------------------ + // Compute the derivative as the intial m_k_vector_ptr + // polynomial and do 5 steps with no shift. + //------------------------------------------------------ + + int n_minus_one = m_n - 1; + + for (ii = 1; ii < m_n; ++ii) { + m_k_vector_ptr[ii] = + (PRF_Float_T)(m_n - ii) * m_p_vector_ptr[ii] / (PRF_Float_T)(m_n); + } + + m_k_vector_ptr[0] = m_p_vector_ptr[0]; + double aa = m_p_vector_ptr[m_n]; + double bb = m_p_vector_ptr[m_n - 1]; + bool zerok_flag = m_k_vector_ptr[m_n - 1] == 0.0; + + int jj = 0; + + for (jj = 1; jj <= 5; ++jj) { + double cc = m_k_vector_ptr[m_n - 1]; + + if (zerok_flag) { + //---------------------------------------------- + // Use unscaled form of recurrence. + //---------------------------------------------- + + for (jvar = n_minus_one; jvar > 0; --jvar) { + m_k_vector_ptr[jvar] = m_k_vector_ptr[jvar - 1]; + } + + m_k_vector_ptr[0] = 0.0; + zerok_flag = m_k_vector_ptr[m_n - 1] == 0.0; + } else { + //---------------------------------------------- + // Use scaled form of recurrence if value + // of m_k_vector_ptr at 0 is nonzero. + //---------------------------------------------- + + double tvar = -aa / cc; + + for (jvar = n_minus_one; jvar > 0; --jvar) { + m_k_vector_ptr[jvar] = + tvar * m_k_vector_ptr[jvar - 1] + m_p_vector_ptr[jvar]; + } + + m_k_vector_ptr[0] = m_p_vector_ptr[0]; + zerok_flag = + ::fabs(m_k_vector_ptr[m_n - 1]) <= ::fabs(bb) * f_ETA_N; + } + } + + //------------------------------------------------------ + // Save m_k_vector_ptr for restarts with new shifts. + //------------------------------------------------------ + + for (ii = 0; ii < m_n; ++ii) { + temp_vector_ptr[ii] = m_k_vector_ptr[ii]; + } + + //------------------------------------------------------ + // Loop to select the quadratic corresponding to + // each new shift. + //------------------------------------------------------ + + int cnt = 0; + + for (cnt = 1; cnt <= 20; ++cnt) { + //-------------------------------------------------- + // Quadratic corresponds to a double shift to a + // non-real point and its complex conjugate. The + // point has modulus 'bnd' and amplitude rotated + // by 94 degrees from the previous shift. + //-------------------------------------------------- + + PRF_Float_T xxx = cosr * xx - sinr * yy; + yy = sinr * xx + cosr * yy; + xx = xxx; + m_real_s = bnd * xx; + m_imag_s = bnd * yy; + m_u = -2.0 * m_real_s; + m_v = bnd; + + //-------------------------------------------------- + // Second stage calculation, fixed quadratic. + // Variable nz will contain the number of + // zeros found when function Fxshfr() returns. + //-------------------------------------------------- + + int nz = Fxshfr(20 * cnt); + + if (nz != 0) { + //---------------------------------------------- + // The second stage jumps directly to one of + // the third stage iterations and returns here + // if successful. Deflate the polynomial, + // store the zero or zeros and return to the + // main algorithm. + //---------------------------------------------- + + jvar = m_degree - m_n; + real_zero_vector_ptr[jvar] = m_real_sz; + imaginary_zero_vector_ptr[jvar] = m_imag_sz; + m_n_plus_one = m_n_plus_one - nz; + m_n = m_n_plus_one - 1; + + for (ii = 0; ii < m_n_plus_one; ++ii) { + m_p_vector_ptr[ii] = m_qp_vector_ptr[ii]; + } + + if (nz != 1) { + real_zero_vector_ptr[jvar + 1] = m_real_lz; + imaginary_zero_vector_ptr[jvar + 1] = m_imag_lz; + } + + break; + + //---------------------------------------------- + // If the iteration is unsuccessful another + // quadratic is chosen after restoring + // m_k_vector_ptr. + //---------------------------------------------- + } + + for (ii = 0; ii < m_n; ++ii) { + m_k_vector_ptr[ii] = temp_vector_ptr[ii]; + } + } + } + } + + //-------------------------------------------------------------- + // If no convergence with 20 shifts then adjust the degree + // for the number of roots found. + //-------------------------------------------------------------- + + if (number_of_roots_found_ptr != 0) { + *number_of_roots_found_ptr = m_degree - m_n; + } + } + + return status; +} + +//====================================================================== +// Computes up to l2var fixed shift m_k_vector_ptr polynomials, +// testing for convergence in the linear or quadratic +// case. initiates one of the variable shift +// iterations and returns with the number of zeros +// found. +// +// l2var An integer that is the limit of fixed shift steps. +// +// Return Value: +// nz An integer that is the number of zeros found. +//====================================================================== + +int PolynomialRootFinder::Fxshfr(int l2var) { + //------------------------------------------------------------------ + // Evaluate polynomial by synthetic division. + //------------------------------------------------------------------ + + QuadraticSyntheticDivision(m_n_plus_one, m_u, m_v, m_p_vector_ptr, + m_qp_vector_ptr, m_a, m_b); + + int itype = CalcSc(); + + int nz = 0; + float betav = 0.25; + float betas = 0.25; + float oss = (float)(m_real_s); + float ovv = (float)(m_v); + float ots; + float otv; + double ui; + double vi; + double svar; + + int jvar = 0; + + for (jvar = 1; jvar <= l2var; ++jvar) { + //-------------------------------------------------------------- + // Calculate next m_k_vector_ptr polynomial and estimate m_v. + //-------------------------------------------------------------- + + NextK(itype); + itype = CalcSc(); + Newest(itype, ui, vi); + float vv = (float)(vi); + + //-------------------------------------------------------------- + // Estimate svar + //-------------------------------------------------------------- + + float ss = 0.0; + + if (m_k_vector_ptr[m_n - 1] != 0.0) { + ss = (float)(-m_p_vector_ptr[m_n] / m_k_vector_ptr[m_n - 1]); + } + + float tv = 1.0; + float ts = 1.0; + + if ((jvar != 1) && (itype != 3)) { + //---------------------------------------------------------- + // Compute relative measures of convergence of + // svar and m_v sequences. + //---------------------------------------------------------- + + if (vv != 0.0) { + tv = (float)(::fabs((vv - ovv) / vv)); + } + + if (ss != 0.0) { + ts = (float)(::fabs((ss - oss) / ss)); + } + + //---------------------------------------------------------- + // If decreasing, multiply two most recent convergence + // measures. + //---------------------------------------------------------- + + float tvv = 1.0; + + if (tv < otv) { + tvv = tv * otv; + } + + float tss = 1.0; + + if (ts < ots) { + tss = ts * ots; + } + + //---------------------------------------------------------- + // Compare with convergence criteria. + //---------------------------------------------------------- + + bool vpass_flag = tvv < betav; + bool spass_flag = tss < betas; + + if (spass_flag || vpass_flag) { + //------------------------------------------------------ + // At least one sequence has passed the convergence + // test. Store variables before iterating. + //------------------------------------------------------ + + double svu = m_u; + double svv = m_v; + int ii = 0; + + for (ii = 0; ii < m_n; ++ii) { + m_svk_vector_ptr[ii] = m_k_vector_ptr[ii]; + } + + svar = ss; + + //------------------------------------------------------ + // Choose iteration according to the fastest + // converging sequence. + //------------------------------------------------------ + + bool vtry_flag = false; + bool stry_flag = false; + bool exit_outer_loop_flag = false; + + bool start_with_real_iteration_flag = + (spass_flag && ((!vpass_flag) || (tss < tvv))); + + do { + if (!start_with_real_iteration_flag) { + nz = QuadraticIteration(ui, vi); + + if (nz > 0) { + exit_outer_loop_flag = true; + break; + } + + //---------------------------------------------- + // Quadratic iteration has failed. flag + // that it has been tried and decrease + // the convergence criterion. + //---------------------------------------------- + + vtry_flag = true; + betav = (float)(betav * 0.25); + } + + //-------------------------------------------------- + // Try linear iteration if it has not been + // tried and the svar sequence is converging. + //-------------------------------------------------- + + if (((!stry_flag) && spass_flag) || start_with_real_iteration_flag) { + if (!start_with_real_iteration_flag) { + for (ii = 0; ii < m_n; ++ii) { + m_k_vector_ptr[ii] = m_svk_vector_ptr[ii]; + } + } else { + start_with_real_iteration_flag = false; + } + + int iflag = 0; + + nz = RealIteration(svar, iflag); + + if (nz > 0) { + exit_outer_loop_flag = true; + break; + } + + //---------------------------------------------- + // Linear iteration has failed. Flag that + // it has been tried and decrease the + // convergence criterion. + //---------------------------------------------- + + stry_flag = true; + betas = (float)(betas * 0.25); + + if (iflag != 0) { + //------------------------------------------ + // If linear iteration signals an almost + // double real zero attempt quadratic + // iteration. + //------------------------------------------ + + ui = -(svar + svar); + vi = svar * svar; + + continue; + } + } + + //-------------------------------------------------- + // Restore variables + //-------------------------------------------------- + + m_u = svu; + m_v = svv; + + for (ii = 0; ii < m_n; ++ii) { + m_k_vector_ptr[ii] = m_svk_vector_ptr[ii]; + } + + //---------------------------------------------- + // Try quadratic iteration if it has not been + // tried and the m_v sequence is converging. + //---------------------------------------------- + } while (vpass_flag && (!vtry_flag)); + + if (exit_outer_loop_flag) { + break; + } + + //------------------------------------------------------ + // Recompute m_qp_vector_ptr and scalar values to + // continue the second stage. + //------------------------------------------------------ + + QuadraticSyntheticDivision(m_n_plus_one, m_u, m_v, m_p_vector_ptr, + m_qp_vector_ptr, m_a, m_b); + + itype = CalcSc(); + } + } + + ovv = vv; + oss = ss; + otv = tv; + ots = ts; + } + + return nz; +} + +//====================================================================== +// Variable-shift m_k_vector_ptr-polynomial iteration for +// a quadratic factor converges only if the zeros are +// equimodular or nearly so. +// +// uu Coefficients of starting quadratic +// vv Coefficients of starting quadratic +// +// Return value: +// nz The number of zeros found. +//====================================================================== + +int PolynomialRootFinder::QuadraticIteration(double uu, double vv) { + //------------------------------------------------------------------ + // Main loop + //------------------------------------------------------------------ + + double ui = 0.0; + double vi = 0.0; + float omp = 0.0F; + float relstp = 0.0F; + int itype = 0; + bool tried_flag = false; + int jvar = 0; + int nz = 0; + m_u = uu; + m_v = vv; + + while (true) { + SolveQuadraticEquation(1.0, m_u, m_v, m_real_sz, m_imag_sz, m_real_lz, + m_imag_lz); + + //-------------------------------------------------------------- + // Return if roots of the quadratic are real and not close + // to multiple or nearly equal and of opposite sign. + //-------------------------------------------------------------- + + if (::fabs(::fabs(m_real_sz) - ::fabs(m_real_lz)) > + 0.01 * ::fabs(m_real_lz)) { + break; + } + + //-------------------------------------------------------------- + // Evaluate polynomial by quadratic synthetic division. + //------------------------------------------------------------------ + + QuadraticSyntheticDivision(m_n_plus_one, m_u, m_v, m_p_vector_ptr, + m_qp_vector_ptr, m_a, m_b); + + float mp = (float)(::fabs(m_a - m_real_sz * m_b) + ::fabs(m_imag_sz * m_b)); + + //-------------------------------------------------------------- + // Compute a rigorous bound on the rounding error in + // evaluting m_p_vector_ptr. + //-------------------------------------------------------------- + + float zm = (float)(::sqrt((float)(::fabs((float)(m_v))))); + float ee = (float)(2.0 * (float)(::fabs((float)(m_qp_vector_ptr[0])))); + float tvar = (float)(-m_real_sz * m_b); + int ii = 0; + + for (ii = 1; ii < m_n; ++ii) { + ee = ee * zm + (float)(::fabs((float)(m_qp_vector_ptr[ii]))); + } + + ee = ee * zm + (float)(::fabs((float)(m_a) + tvar)); + ee = (float)((5.0 * m_mre + 4.0 * m_are) * ee - + (5.0 * m_mre + 2.0 * m_are) * + ((float)(::fabs((float)(m_a) + tvar)) + + (float)(::fabs((float)(m_b))) * zm) + + 2.0 * m_are * (float)(::fabs(tvar))); + + //-------------------------------------------------------------- + // Iteration has converged sufficiently if the polynomial + // value is less than 20 times this bound. + //-------------------------------------------------------------- + + if (mp <= 20.0 * ee) { + nz = 2; + break; + } + + jvar = jvar + 1; + + //-------------------------------------------------------------- + // Stop iteration after 20 steps. + //-------------------------------------------------------------- + + if (jvar > 20) { + break; + } + + if ((jvar >= 2) && ((relstp <= 0.01) && (mp >= omp) && (!tried_flag))) { + //---------------------------------------------------------- + // A cluster appears to be stalling the convergence. + // Five fixed shift steps are taken with a m_u, m_v + // close to the cluster. + //---------------------------------------------------------- + + if (relstp < f_ETA) { + relstp = f_ETA; + } + + relstp = (float)(::sqrt(relstp)); + m_u = m_u - m_u * relstp; + m_v = m_v + m_v * relstp; + + QuadraticSyntheticDivision(m_n_plus_one, m_u, m_v, m_p_vector_ptr, + m_qp_vector_ptr, m_a, m_b); + + for (ii = 0; ii < 5; ++ii) { + itype = CalcSc(); + NextK(itype); + } + + tried_flag = true; + jvar = 0; + } + + omp = mp; + + //-------------------------------------------------------------- + // Calculate next m_k_vector_ptr polynomial and + // new m_u and m_v. + //-------------------------------------------------------------- + + itype = CalcSc(); + NextK(itype); + itype = CalcSc(); + Newest(itype, ui, vi); + + //-------------------------------------------------------------- + // If vi is zero the iteration is not converging. + //-------------------------------------------------------------- + + if (vi == 0.0) { + break; + } + + relstp = (float)(::fabs((vi - m_v) / vi)); + m_u = ui; + m_v = vi; + } + + return nz; +} + +//====================================================================== +// Variable-shift h polynomial iteration for a real zero. +// +// sss Starting iterate +// flag Flag to indicate a pair of zeros near real axis. +// +// Return Value: +// Number of zero found. +//====================================================================== + +int PolynomialRootFinder::RealIteration(double &sss, int &flag) { + //------------------------------------------------------------------ + // Main loop + //------------------------------------------------------------------ + + double tvar = 0.0; + float omp = 0.0F; + int nz = 0; + flag = 0; + int jvar = 0; + double svar = sss; + + while (true) { + double pv = m_p_vector_ptr[0]; + + //-------------------------------------------------------------- + // Evaluate m_p_vector_ptr at svar + //-------------------------------------------------------------- + + m_qp_vector_ptr[0] = pv; + int ii = 0; + + for (ii = 1; ii < m_n_plus_one; ++ii) { + pv = pv * svar + m_p_vector_ptr[ii]; + m_qp_vector_ptr[ii] = pv; + } + + float mp = (float)(::fabs(pv)); + + //-------------------------------------------------------------- + // Compute a rigorous bound on the error in evaluating p + //-------------------------------------------------------------- + + PRF_Float_T ms = (PRF_Float_T)(::fabs(svar)); + PRF_Float_T ee = (m_mre / (m_are + m_mre)) * + (PRF_Float_T)(::fabs((PRF_Float_T)(m_qp_vector_ptr[0]))); + + for (ii = 1; ii < m_n_plus_one; ++ii) { + ee = ee * ms + (float)(::fabs((PRF_Float_T)(m_qp_vector_ptr[ii]))); + } + + //-------------------------------------------------------------- + // Iteration has converged sufficiently if the + // polynomial value is less than 20 times this bound. + //-------------------------------------------------------------- + + if (mp <= 20.0 * ((m_are + m_mre) * ee - m_mre * mp)) { + nz = 1; + m_real_sz = svar; + m_imag_sz = 0.0; + break; + } + + jvar = jvar + 1; + + //-------------------------------------------------------------- + // Stop iteration after 10 steps. + //-------------------------------------------------------------- + + if (jvar > 10) { + break; + } + + if ((jvar >= 2) && + ((::fabs(tvar) <= 0.001 * ::fabs(svar - tvar)) && (mp > omp))) { + //---------------------------------------------------------- + // A cluster of zeros near the real axis has been + // encountered. Return with flag set to initiate + // a quadratic iteration. + //---------------------------------------------------------- + + flag = 1; + sss = svar; + break; + } + + //-------------------------------------------------------------- + // Return if the polynomial value has increased significantly. + //-------------------------------------------------------------- + + omp = mp; + + //-------------------------------------------------------------- + // Compute t, the next polynomial, and the new iterate. + //-------------------------------------------------------------- + + double kv = m_k_vector_ptr[0]; + m_qk_vector_ptr[0] = kv; + + for (ii = 1; ii < m_n; ++ii) { + kv = kv * svar + m_k_vector_ptr[ii]; + m_qk_vector_ptr[ii] = kv; + } + + if (::fabs(kv) <= ::fabs(m_k_vector_ptr[m_n - 1]) * f_ETA_N) { + m_k_vector_ptr[0] = 0.0; + + for (ii = 1; ii < m_n; ++ii) { + m_k_vector_ptr[ii] = m_qk_vector_ptr[ii - 1]; + } + } else { + //---------------------------------------------------------- + // Use the scaled form of the recurrence if the + // value of m_k_vector_ptr at svar is non-zero. + //---------------------------------------------------------- + + tvar = -pv / kv; + m_k_vector_ptr[0] = m_qp_vector_ptr[0]; + + for (ii = 1; ii < m_n; ++ii) { + m_k_vector_ptr[ii] = + tvar * m_qk_vector_ptr[ii - 1] + m_qp_vector_ptr[ii]; + } + } + + //-------------------------------------------------------------- + // Use unscaled form. + //-------------------------------------------------------------- + + kv = m_k_vector_ptr[0]; + + for (ii = 1; ii < m_n; ++ii) { + kv = kv * svar + m_k_vector_ptr[ii]; + } + + tvar = 0.0; + + if (::fabs(kv) > ::fabs(m_k_vector_ptr[m_n - 1]) * f_ETA_N) { + tvar = -pv / kv; + } + + svar = svar + tvar; + } + + return nz; +} + +//====================================================================== +// This routine calculates scalar quantities used to compute +// the next m_k_vector_ptr polynomial and new estimates of the +// quadratic coefficients. +// +// Return Value: +// type Integer variable set here indicating how the +// calculations are normalized to avoid overflow. +//====================================================================== + +int PolynomialRootFinder::CalcSc() { + //------------------------------------------------------------------ + // Synthetic division of m_k_vector_ptr by the quadratic 1, m_u, m_v. + //------------------------------------------------------------------ + + QuadraticSyntheticDivision(m_n, m_u, m_v, m_k_vector_ptr, m_qk_vector_ptr, + m_c, m_d); + + int itype = 0; + + if ((::fabs(m_c) <= ::fabs(m_k_vector_ptr[m_n - 1]) * f_ETA_N_SQUARED) && + (::fabs(m_d) <= ::fabs(m_k_vector_ptr[m_n - 2]) * f_ETA_N_SQUARED)) { + //-------------------------------------------------------------- + // itype == 3 Indicates the quadratic is almost a + // factor of m_k_vector_ptr. + //-------------------------------------------------------------- + + itype = 3; + } else if (::fabs(m_d) >= ::fabs(m_c)) { + //-------------------------------------------------------------- + // itype == 2 Indicates that all formulas are divided by m_d. + //-------------------------------------------------------------- + + itype = 2; + m_e = m_a / m_d; + m_f = m_c / m_d; + m_g = m_u * m_b; + m_h = m_v * m_b; + m_a3 = (m_a + m_g) * m_e + m_h * (m_b / m_d); + m_a1 = m_b * m_f - m_a; + m_a7 = (m_f + m_u) * m_a + m_h; + } else { + //-------------------------------------------------------------- + // itype == 1 Indicates that all formulas are divided by m_c. + //-------------------------------------------------------------- + + itype = 1; + m_e = m_a / m_c; + m_f = m_d / m_c; + m_g = m_u * m_e; + m_h = m_v * m_b; + m_a3 = m_a * m_e + (m_h / m_c + m_g) * m_b; + m_a1 = m_b - m_a * (m_d / m_c); + m_a7 = m_a + m_g * m_d + m_h * m_f; + } + + return itype; +} + +//====================================================================== +// Computes the next k polynomials using scalars computed in CalcSc. +//====================================================================== + +void PolynomialRootFinder::NextK(int itype) { + int ii = 0; + + if (itype == 3) { + //-------------------------------------------------------------- + // Use unscaled form of the recurrence if type is 3. + //-------------------------------------------------------------- + + m_k_vector_ptr[0] = 0.0; + m_k_vector_ptr[1] = 0.0; + + for (ii = 2; ii < m_n; ++ii) { + m_k_vector_ptr[ii] = m_qk_vector_ptr[ii - 2]; + } + } else { + double temp = m_a; + + if (itype == 1) { + temp = m_b; + } + + if (::fabs(m_a1) <= ::fabs(temp) * f_ETA_N) { + //---------------------------------------------------------- + // If m_a1 is nearly zero then use a special form of + // the recurrence. + //---------------------------------------------------------- + + m_k_vector_ptr[0] = 0.0; + m_k_vector_ptr[1] = -m_a7 * m_qp_vector_ptr[0]; + + for (ii = 2; ii < m_n; ++ii) { + m_k_vector_ptr[ii] = + m_a3 * m_qk_vector_ptr[ii - 2] - m_a7 * m_qp_vector_ptr[ii - 1]; + } + } else { + //---------------------------------------------------------- + // Use scaled form of the recurrence. + //---------------------------------------------------------- + + m_a7 = m_a7 / m_a1; + m_a3 = m_a3 / m_a1; + m_k_vector_ptr[0] = m_qp_vector_ptr[0]; + m_k_vector_ptr[1] = m_qp_vector_ptr[1] - m_a7 * m_qp_vector_ptr[0]; + + for (ii = 2; ii < m_n; ++ii) { + m_k_vector_ptr[ii] = m_a3 * m_qk_vector_ptr[ii - 2] - + m_a7 * m_qp_vector_ptr[ii - 1] + + m_qp_vector_ptr[ii]; + } + } + } + + return; +} + +//====================================================================== +// Compute new estimates of the quadratic coefficients using the +// scalars computed in CalcSc. +//====================================================================== + +void PolynomialRootFinder::Newest(int itype, double &uu, double &vv) { + //------------------------------------------------------------------ + // Use formulas appropriate to setting of itype. + //------------------------------------------------------------------ + + if (itype == 3) { + //-------------------------------------------------------------- + // If itype == 3 the quadratic is zeroed. + //-------------------------------------------------------------- + + uu = 0.0; + vv = 0.0; + } else { + double a4; + double a5; + + if (itype == 2) { + a4 = (m_a + m_g) * m_f + m_h; + a5 = (m_f + m_u) * m_c + m_v * m_d; + } else { + a4 = m_a + m_u * m_b + m_h * m_f; + a5 = m_c + (m_u + m_v * m_f) * m_d; + } + + //-------------------------------------------------------------- + // Evaluate new quadratic coefficients. + //-------------------------------------------------------------- + + double b1 = -m_k_vector_ptr[m_n - 1] / m_p_vector_ptr[m_n]; + double b2 = -(m_k_vector_ptr[m_n - 2] + b1 * m_p_vector_ptr[m_n - 1]) / + m_p_vector_ptr[m_n]; + double c1 = m_v * b2 * m_a1; + double c2 = b1 * m_a7; + double c3 = b1 * b1 * m_a3; + double c4 = c1 - c2 - c3; + double temp = a5 + b1 * a4 - c4; + + if (temp != 0.0) { + uu = m_u - (m_u * (c3 + c2) + m_v * (b1 * m_a1 + b2 * m_a7)) / temp; + vv = m_v * (1.0 + c4 / temp); + } + } + + return; +} + +//====================================================================== +// Divides p by the quadratic 1, u, v placing the quotient in q +// and the remainder in a,b +//====================================================================== + +void PolynomialRootFinder::QuadraticSyntheticDivision(int n_plus_one, double u, + double v, double *p_ptr, + double *q_ptr, double &a, + double &b) { + b = p_ptr[0]; + q_ptr[0] = b; + a = p_ptr[1] - u * b; + q_ptr[1] = a; + + int ii = 0; + + for (ii = 2; ii < n_plus_one; ++ii) { + double c = p_ptr[ii] - u * a - v * b; + q_ptr[ii] = c; + b = a; + a = c; + } + + return; +} + +//====================================================================== +// 2 +// Calculate the zeros of the quadratic a x + b x + c. +// the quadratic formula, modified to avoid overflow, is used to find +// the larger zero if the zeros are real and both zeros are complex. +// the smaller real zero is found directly from the product of the +// zeros c / a. +//====================================================================== + +void PolynomialRootFinder::SolveQuadraticEquation(double a, double b, double c, + double &sr, double &si, + double &lr, double &li) { + if (a == 0.0) { + if (b != 0.0) { + sr = -c / b; + } else { + sr = 0.0; + } + + lr = 0.0; + si = 0.0; + li = 0.0; + } else if (c == 0.0) { + sr = 0.0; + lr = -b / a; + si = 0.0; + li = 0.0; + } else { + //-------------------------------------------------------------- + // Compute discriminant avoiding overflow. + //-------------------------------------------------------------- + + double d; + double e; + double bvar = b / 2.0; + + if (::fabs(bvar) < ::fabs(c)) { + if (c < 0.0) { + e = -a; + } else { + e = a; + } + + e = bvar * (bvar / ::fabs(c)) - e; + + d = ::sqrt(::fabs(e)) * ::sqrt(::fabs(c)); + } else { + e = 1.0 - (a / bvar) * (c / bvar); + d = ::sqrt(::fabs(e)) * ::fabs(bvar); + } + + if (e >= 0.0) { + //---------------------------------------------------------- + // Real zeros + //---------------------------------------------------------- + + if (bvar >= 0.0) { + d = -d; + } + + lr = (-bvar + d) / a; + sr = 0.0; + + if (lr != 0.0) { + sr = (c / lr) / a; + } + + si = 0.0; + li = 0.0; + } else { + //---------------------------------------------------------- + // Complex conjugate zeros + //---------------------------------------------------------- + + sr = -bvar / a; + lr = sr; + si = ::fabs(d / a); + li = -si; + } + } + + return; +} diff --git a/PolynomialRootFinder.h b/PolynomialRootFinder.h new file mode 100644 index 0000000..ab80649 --- /dev/null +++ b/PolynomialRootFinder.h @@ -0,0 +1,136 @@ +//======================================================================= +// Copyright (C) 2003-2013 William Hallahan +// +// Permission is hereby granted, free of charge, to any person +// obtaining a copy of this software and associated documentation +// files (the "Software"), to deal in the Software without restriction, +// including without limitation the rights to use, copy, modify, merge, +// publish, distribute, sublicense, and/or sell copies of the Software, +// and to permit persons to whom the Software is furnished to do so, +// subject to the following conditions: +// +// The above copyright notice and this permission notice shall be +// included in all copies or substantial portions of the Software. +// +// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +// EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES +// OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +// NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +// HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +// WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +// FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +// OTHER DEALINGS IN THE SOFTWARE. +//======================================================================= + +//********************************************************************** +// File: PolynomialRootFinder.h +// Author: Bill Hallahan +// Date: January 30, 2003 +// +// Abstract: +// +// This file contains the definition for class PolynomialRootFinder. +// +//********************************************************************** + +#ifndef POLYNOMIALROOTFINDER_H +#define POLYNOMIALROOTFINDER_H + +#include + +//====================================================================== +// Class definition. +//====================================================================== + +class PolynomialRootFinder { +protected: + typedef double PRF_Float_T; + + std::vector m_p_vector; + std::vector m_qp_vector; + std::vector m_k_vector; + std::vector m_qk_vector; + std::vector m_svk_vector; + + double *m_p_vector_ptr; + double *m_qp_vector_ptr; + double *m_k_vector_ptr; + double *m_qk_vector_ptr; + double *m_svk_vector_ptr; + + int m_degree; + int m_n; + int m_n_plus_one; + double m_real_s; + double m_imag_s; + double m_u; + double m_v; + double m_a; + double m_b; + double m_c; + double m_d; + double m_a1; + double m_a2; + double m_a3; + double m_a6; + double m_a7; + double m_e; + double m_f; + double m_g; + double m_h; + double m_real_sz; + double m_imag_sz; + double m_real_lz; + double m_imag_lz; + PRF_Float_T m_are; + PRF_Float_T m_mre; + +public: + enum RootStatus_T { + SUCCESS, + LEADING_COEFFICIENT_IS_ZERO, + SCALAR_VALUE_HAS_NO_ROOTS, + FAILED_TO_CONVERGE + }; + + PolynomialRootFinder(); + + virtual ~PolynomialRootFinder(); + + PolynomialRootFinder::RootStatus_T + FindRoots(double *coefficient_ptr, int degree, double *real_zero_vector_ptr, + double *imaginary_zero_vector_ptr, + int *number_of_roots_found_ptr = 0); + +private: + int Fxshfr(int l2var); + + int QuadraticIteration(double uu, double vv); + + int RealIteration(double &sss, int &flag); + + int CalcSc(); + + void NextK(int itype); + + void Newest(int itype, double &uu, double &vv); + + void QuadraticSyntheticDivision(int n_plus_one, double u, double v, + double *p_ptr, double *q_ptr, double &a, + double &b); + + void SolveQuadraticEquation(double a, double b, double c, double &sr, + double &si, double &lr, double &li); + + //================================================================== + // Declare the copy constructor and operator equals to be private + // and do not implement them to prevent copying instances of this + // class. + //================================================================== + + PolynomialRootFinder(const PolynomialRootFinder &that); + + PolynomialRootFinder operator=(const PolynomialRootFinder &that); +}; + +#endif diff --git a/PolynomialTest.cpp b/PolynomialTest.cpp new file mode 100644 index 0000000..5ac2041 --- /dev/null +++ b/PolynomialTest.cpp @@ -0,0 +1,450 @@ +//======================================================================= +// Copyright (C) 2003-2013 William Hallahan +// +// Permission is hereby granted, free of charge, to any person +// obtaining a copy of this software and associated documentation +// files (the "Software"), to deal in the Software without restriction, +// including without limitation the rights to use, copy, modify, merge, +// publish, distribute, sublicense, and/or sell copies of the Software, +// and to permit persons to whom the Software is furnished to do so, +// subject to the following conditions: +// +// The above copyright notice and this permission notice shall be +// included in all copies or substantial portions of the Software. +// +// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +// EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES +// OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +// NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +// HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +// WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +// FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +// OTHER DEALINGS IN THE SOFTWARE. +//======================================================================= + +// PolynomialTest.cpp : Defines the entry point for the console application. +// + +#include "Polynomial.h" +#include +#include + +void DisplayPolynomial(const Polynomial &polynomial); +void GetPolynomial(Polynomial &polynomial, int polynomial_type); + +//====================================================================== +// Start of main program. +//====================================================================== + +int main(int argc, char *argv[]) { + //------------------------------------------------------------------ + // Get the type of test. + //------------------------------------------------------------------ + + std::cout << std::endl; + std::cout << "1. Find roots of the polynomial." << std::endl; + std::cout << "2. Evaluate the polynomial at a real value" << std::endl; + std::cout << "3. Evaluate the polynomial and its derivative at a real value" + << std::endl; + std::cout << "4. Evaluate the polynomial at a complex value" << std::endl; + std::cout + << "5. Evaluate the polynomial and its derivative at a complex value" + << std::endl; + std::cout << "6. Test polynomial arithmetic." << std::endl; + std::cout << "7. Test polynomial division." << std::endl; + std::cout << std::endl; + std::cout << "Enter the type of test > "; + int test_type; + std::cin >> test_type; + + //------------------------------------------------------------------ + // Get the type of polynomial. + //------------------------------------------------------------------ + + std::cout << "1. Arbitrary polynomial" << std::endl; + std::cout + << "2. Polynomial with maximum power and scalar value 1.0, the rest 0.0." + << std::endl; + std::cout << "3. Polynomial with all coefficient equal to 1.0." << std::endl; + std::cout << std::endl; + std::cout << "Enter the type of polynomial > "; + int polynomial_type; + std::cin >> polynomial_type; + std::cout << std::endl; + + //------------------------------------------------------------------ + // Get a polynomial. + //------------------------------------------------------------------ + + Polynomial polynomial; + + GetPolynomial(polynomial, polynomial_type); + + //------------------------------------------------------------------ + // Perform different processing for the different tests. + //------------------------------------------------------------------ + + switch (test_type) { + case 1: { + //---------------------------------------------------------- + // Find the roots of the polynomial. + //---------------------------------------------------------- + + std::vector real_vector; + std::vector imag_vector; + + int degree = polynomial.Degree(); + + real_vector.resize(degree); + imag_vector.resize(degree); + + double *real_vector_ptr = &real_vector[0]; + double *imag_vector_ptr = &imag_vector[0]; + + int root_count = 0; + + if (polynomial.FindRoots(real_vector_ptr, imag_vector_ptr, &root_count) == + PolynomialRootFinder::SUCCESS) { + int i = 0; + + for (i = 0; i < root_count; ++i) { + std::cout << "Root " << i << " = " << real_vector_ptr[i] << " + i " + << imag_vector_ptr[i] << std::endl; + } + } else { + std::cout << "Failed to find all roots." << std::endl; + } + } + + break; + + case 2: { + //---------------------------------------------------------- + // Evaluate the polynomial at a real value. + //---------------------------------------------------------- + + while (true) { + std::cout << "Enter value > "; + double xr; + std::cin >> xr; + std::cout << "P(" << xr << ") = " << polynomial.EvaluateReal(xr) + << std::endl; + std::cout << std::endl; + } + } + + break; + + case 3: { + //---------------------------------------------------------- + // Evaluate the polynomial and its derivative at a + // real value. + //---------------------------------------------------------- + + while (true) { + std::cout << "Enter value > "; + double xr; + std::cin >> xr; + + double dr; + double pr = polynomial.EvaluateReal(xr, dr); + + std::cout << "P(" << xr << ") = " << pr << std::endl; + std::cout << "D(" << xr << ") = " << dr << std::endl; + std::cout << std::endl; + } + } + + break; + + case 4: { + //---------------------------------------------------------- + // Evaluate the polynomial at a complex value. + //---------------------------------------------------------- + + while (true) { + std::cout << "Enter real value > "; + double xr; + std::cin >> xr; + + std::cout << "Enter imaginary value > "; + double xi; + std::cin >> xi; + + double pr; + double pi; + + polynomial.EvaluateComplex(xr, xi, pr, pi); + + std::cout << "P(" << xr << " + i " << xi << ") = " << pr << " + i " << pi + << std::endl; + std::cout << std::endl; + } + } + + break; + + case 5: { + //---------------------------------------------------------- + // Evaluate the polynomial and its derivative at a + // complex value. + //---------------------------------------------------------- + + while (true) { + std::cout << "Enter real value > "; + double xr; + std::cin >> xr; + + std::cout << "Enter imaginary value > "; + double xi; + std::cin >> xi; + + double pr; + double pi; + double dr; + double di; + + polynomial.EvaluateComplex(xr, xi, pr, pi, dr, di); + + std::cout << "P(" << xr << " + i " << xi << ") = " << pr << " + i " << pi + << std::endl; + std::cout << "D(" << xr << " + i " << xi << ") = " << dr << " + i " << di + << std::endl; + std::cout << std::endl; + } + } + + break; + + case 6: { + //---------------------------------------------------------- + // Test polynomial arithmetic. + // Test polynomial copy constructor and equals operator. + //---------------------------------------------------------- + + Polynomial p_0 = polynomial; + Polynomial p_1; + p_1 = p_0; + + //---------------------------------------------------------- + // Test polynomial addition. + //---------------------------------------------------------- + + Polynomial p_sum = p_0 + p_1; + + std::cout << "The sum polynomial is:" << std::endl; + std::cout << std::endl; + DisplayPolynomial(p_sum); + std::cout << std::endl; + + //---------------------------------------------------------- + // Test polynomial subtraction. + //---------------------------------------------------------- + + std::cout << "The difference polynomial is:" << std::endl; + Polynomial p_diff = p_0 - p_1; + std::cout << std::endl; + DisplayPolynomial(p_diff); + std::cout << std::endl; + + //---------------------------------------------------------- + // Test polynomial multiplication. + //---------------------------------------------------------- + + std::cout << "The product polynomial is:" << std::endl; + Polynomial p_product = p_0 * p_1; + std::cout << std::endl; + DisplayPolynomial(p_product); + std::cout << std::endl; + } + + break; + + case 7: { + //---------------------------------------------------------- + // Get another polynomial that will be the divisor. + //---------------------------------------------------------- + + std::cout << "Enter the divisor polynomial." << std::endl; + + Polynomial divisor_polynomial; + GetPolynomial(divisor_polynomial, 1); + + Polynomial quotient_polynomial; + Polynomial remainder_polynomial; + + polynomial.Divide(divisor_polynomial, quotient_polynomial, + remainder_polynomial); + + //---------------------------------------------------------- + // Display the quotient polynomial. + //---------------------------------------------------------- + + std::cout << "The quotient polynomial is:" << std::endl; + std::cout << std::endl; + DisplayPolynomial(quotient_polynomial); + std::cout << std::endl; + + //---------------------------------------------------------- + // Display the remainder polynomial. + //---------------------------------------------------------- + + std::cout << "The remainder polynomial is:" << std::endl; + std::cout << std::endl; + DisplayPolynomial(remainder_polynomial); + std::cout << std::endl; + } + + break; + + default: + + std::cout << "Invalid test type" << std::endl; + return -1; + break; + } + + return 0; +} + +//====================================================================== +// Function to display a polynomial. +//====================================================================== + +void DisplayPolynomial(const Polynomial &polynomial) { + int power = 0; + + for (power = polynomial.Degree(); power > 0; --power) { + //-------------------------------------------------------------- + // Display the coefficient if it is not equal to one. + //-------------------------------------------------------------- + + if (polynomial[power] != 1.0) { + std::cout << polynomial[power]; + } + + //-------------------------------------------------------------- + // If this is not the scalar value, then display the variable + // X. + //-------------------------------------------------------------- + + if (power > 0) { + std::cout << " X"; + } + + //-------------------------------------------------------------- + // If this is higher than the first power, then display the + // exponent. + //-------------------------------------------------------------- + + if (power > 1) { + std::cout << "^" << power; + } + + //-------------------------------------------------------------- + // Add each term together. + //-------------------------------------------------------------- + + std::cout << " + "; + } + + //------------------------------------------------------------------ + // Display the polynomial's scalar value. + //------------------------------------------------------------------ + + std::cout << polynomial[power] << std::endl; + + return; +} + +//====================================================================== +// Function: GetPolynomial +//====================================================================== + +void GetPolynomial(Polynomial &polynomial, int polynomial_type) { + //------------------------------------------------------------------ + // Get the polynomial degree. + //------------------------------------------------------------------ + + std::cout << "Enter the polynomial degree > "; + int degree = 0; + std::cin >> degree; + std::cout << std::endl; + + //------------------------------------------------------------------ + // Create a buffer to contain the polynomial coefficients. + //------------------------------------------------------------------ + + std::vector coefficient_vector; + + coefficient_vector.resize(degree + 1); + + double *coefficient_vector_ptr = &coefficient_vector[0]; + + //------------------------------------------------------------------ + // Create the specified type of polynomial. + //------------------------------------------------------------------ + + int i = 0; + + switch (polynomial_type) { + case 1: + + //-------------------------------------------------------------- + // Create an arbitrary polynomial. + //-------------------------------------------------------------- + + for (i = 0; i <= degree; ++i) { + std::cout << "coefficient[" << i << "] = "; + double temp; + ; + std::cin >> temp; + coefficient_vector_ptr[i] = temp; + } + + std::cout << std::endl; + break; + + case 2: + + //-------------------------------------------------------------- + // Create a polynomial with the maximum degree and the scalar + // value coefficients equal to 1.0 and all other coefficients + // equal to zero. + //-------------------------------------------------------------- + + for (i = 1; i < degree; ++i) { + coefficient_vector_ptr[i] = 0; + } + + coefficient_vector_ptr[0] = 1.0; + coefficient_vector_ptr[degree] = 1.0; + + break; + + case 3: + + //-------------------------------------------------------------- + // Create a polynomial with all coefficients equal to 1.0. + //-------------------------------------------------------------- + + for (i = 0; i <= degree; ++i) { + coefficient_vector_ptr[i] = 1.0; + } + + break; + + default: + + std::cout << "Invalid polynomial type" << std::endl; + exit(-1); + } + + //------------------------------------------------------------------ + // Create an instance of class Polynomial. + //------------------------------------------------------------------ + + polynomial.SetCoefficients(coefficient_vector_ptr, degree); + + return; +} diff --git a/R-plotter.r b/R-plotter.r new file mode 100644 index 0000000..ed8c037 --- /dev/null +++ b/R-plotter.r @@ -0,0 +1,19 @@ +rm(list = ls()) +library(ggplot2) #Needs ggplot2 - run install.packages(ggplot2) if not already installed !! + +cols <- hcl.colors(30, "Spectral") + +Ne = 10000 #Quantities needed to recale time back into years before present +g = 5 + +ImpT <- t(read.table("D:/MCMC4WF-ThetaZero/ImpT.txt", quote = "\"", comment.char = "")) #Input location of file ImpT.txt here! +ImpT <-(((ImpT * 2 * Ne * g) - 20000)) #Converting from diffusion time to years before present +ImpHT <-(t(read.table("D:/MCMC4WF-ThetaZero/HorseTrajectories.txt", quote = "\"", comment.char = ""))) #Input location of file ImpHT.txt here! +OGT <-t(read.table("D:/MCMC4WF-ThetaZero/OGT.txt", quote = "\"", comment.char = "")) #Input location of file OGT.txt here! +OGT <-(((OGT * 2 * Ne * g) - 20000)) #Converting from diffusion time to years before present +OGHT <-(t(read.table("D:/MCMC4WF-ThetaZero/OGHT.txt", quote = "\"", comment.char = ""))) #Input location of file OGHT.txt here + +setEPS() +postscript(file = "horseTrajectories.eps") #Selection of figure format +matplot(ImpT, ImpHT, type = "l", col = cols, lwd = 1, lty = 1, xlab = "Time in years before present", ylab = "Frequency", ylim = c(0, 0.85)) #Plots all the generated paths +points(OGT, OGHT, pch = 4, bg = "black", col = "black", lwd = 4, cex = 1.5) #Superimposes the original observations dev.off() diff --git a/README.md b/README.md new file mode 100644 index 0000000..fa091b7 --- /dev/null +++ b/README.md @@ -0,0 +1,34 @@ +#EWF + +An efficient simulator for exact Wright-Fisher diffusion and diffusion bridge paths, accounting for a wide class of selective regimes (genic, diploid and arbitrary polynomial selection), and the presence/absence of mutation. + +*Dependencies* + +EWF has been tested out on Ubuntu 20.04, and requires the following: + +- g++ compiler (tested on version 9.4.0) +- libconfig library (tested on version 1.7.3), available from http://hyperrealm.github.io/libconfig +- boost library (tested on version 1.78.0), available from https://boost.org +- R (tested on version 4.2.1 using RStudio version 2022.07.1+554), available from https://www.r-project.org/ + +*Compilation* + +Please ensure that the compiler and linker flags in 'Makefile' point towards where the 'libconfig' and 'boost' libraries are on your platform! + +*Configuration files* + +The underlying Wright-Fisher diffusion/diffusion bridge can be configured via the 'config.cfg' file, where the mutation and selection parameters can be suitably altered. + +The configuration setup for simulating draws from the law of a _diffusion_ are found in 'configDiffusion.cfg' which allows for the start points, start times and sample times to be modified (as well as number of samples to generate and mesh size if the truncated transition density is desired). If multiple simulation setups are desired, the corresponding setup inputs need to be entered as an array. Precise instructions on input syntax can be found in the file itself. + +The configuration setup for simulating draws from the law of a _diffusion bridge_ are found in 'configBridge.cfg' which allows for the start/end points and times, sampling times, number of bridges to simulate, etc. to be modified. Please see the details within the configuration file for exact instructions with regards to input syntax. The number of simulations and mesh sizes (for the truncated transition density) can also be modified. + +*Running the program* + +When in the root directory run 'run.sh'. This first compiles the program by invoking the makefile, and subsequently calls the program using './main horses' where the second argument invokes the demo described below. The program can be run as a diffusion or diffusion bridge simulator by changing the program invocation to simply './main', whence the program asks whether the user desires to simulate draws from a diffusion law or from a diffusion bridge law, whether they wish to condition on non-absorption and further offers the option of computing a truncation to the transition density. + +*Output files* + +Output for the diffusion simulator is saved using the format 'YYYY-MM-DD-HH-mmAbsDiffusionSamplesX%T%S%.txt' for the samples generated (where 'Abs' is either 'Conditioned' (if absorption is not allowed at the boundaries) or 'Unconditioned' (if absorption at the boundaries is allowed), 'T' denotes the start time and 'S' the sampling time), and 'YYYY-MM-DD-HH-mmAbsDiffusionDensityX%T%S%.txt' for the truncated transition density. + +A similar system is in place for the diffusion bridge simulator, where the output is saved as 'YYYY-MM-DD-HH-mmAbsBridgeSamplesX%Z%T1%T2%S%.txt' with 'X' denoting the start point, 'Z' the end point, 'T1' the start time, 'T2' the end time and 'S' the sampling time. A similar setup is in place for the truncated transition density. diff --git a/WrightFisher.cpp b/WrightFisher.cpp new file mode 100644 index 0000000..75953e4 --- /dev/null +++ b/WrightFisher.cpp @@ -0,0 +1,9819 @@ +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "Polynomial.h" +#include "WrightFisher.h" + +/// HELPER FUNCTIONS + +void WrightFisher::ThetaSetter() /// Set theta depending on what thetaP is + /// entered +{ + if (!thetaP.empty()) /// When thetaP is not empty, set theta to be the L1 norm + /// of thetaP + { + theta = accumulate(thetaP.begin(), thetaP.end(), 0.0); + } else { + theta = 0.0; /// Otherwise thetaP is empty and we set theta to be 0.0 + } +} + +void WrightFisher:: + ThetaResetter() /// For conditioned bridge ONLY - set thetaP empty to (2,2), + /// or thetaP = (0,theta)/(theta,0) to (2,theta)/(theta,2) +{ + if (thetaP.empty()) /// If no mutation present, we need to set both thetaP + /// entries to 2 + { + thetaP.push_back(2.0); + thetaP.push_back(2.0); + + theta = 4.0; + } else if (!(thetaP[0] > 0.0) || + !(thetaP[1] > 0.0)) /// If one sided mutation, we need to set + /// corresponding parameter to 2 + { + if (!(thetaP[0] > 0.0)) { + thetaP[0] = 2.0; + } + if (!(thetaP[1] > 0.0)) { + thetaP[1] = 2.0; + } + + theta = accumulate(thetaP.begin(), thetaP.end(), 0.0); + } +} + +void WrightFisher::SelectionSetter() /// Setting up selection mechanisms +{ + if (non_neutral) /// If false, we don't need to run anything + { + Polynomial GenicSelection(-1.0, 1.0, + 0.0); /// Set up genic selection (which will + /// always be present) as Polynomial class + double100 AlphaC1 = (thetaP.empty() ? 0.0 : 0.5 * thetaP[0]), + AlphaC2 = (thetaP.empty() ? 0.0 : -0.5 * theta); + Polynomial Alpha(AlphaC2, AlphaC1); + + if (SelectionSetup == 0) /// Genic Selection - sigma*x*(1-x) + { + SelPolyDeg = 2; + SelectionFunction.Copy(0.5 * sigma * GenicSelection); + Polynomial temp_Phi = 0.5 * (2.0 * 0.5 * sigma * Alpha + + pow(0.5 * sigma, 2.0) * GenicSelection); + Polynomial temp_A(0.5 * sigma, 0.0); //= sigma*; + PhiFunction.Copy(temp_Phi); + AtildeFunction.Copy(temp_A); + } else if (SelectionSetup == + 1) /// Diploid Selection - sigma*x*(1-x)*(h+x*(1-2*h)) + { + SelPolyDeg = 4; + Polynomial Eta(1.0 - 2.0 * dominanceParameter, dominanceParameter); + SelectionFunction.Copy(0.5 * sigma * GenicSelection * Eta); + Polynomial temp_Phi = + 0.5 * (2.0 * 0.5 * sigma * Alpha * Eta + + pow(0.5 * sigma, 2.0) * GenicSelection * Eta * Eta + + 0.5 * sigma * GenicSelection * Eta.Derivative()); + Polynomial temp_A(0.25 * sigma * (1.0 - 2.0 * dominanceParameter), + 0.5 * sigma * dominanceParameter, 0.0); + PhiFunction.Copy(temp_Phi); + AtildeFunction.Copy(temp_A); + } else if (SelectionSetup == + 2) /// General polynomial selection - sigma*x*(1-x)*eta(x) + { + SelPolyDeg = 2 * selectionCoeffs.size(); + double *coeff_ptr = &selectionCoeffs[0]; + Polynomial Eta(coeff_ptr, SelPolyDeg); + Polynomial temp_Phi = + 0.5 * (2.0 * 0.5 * sigma * Alpha * Eta + + pow(0.5 * sigma, 2.0) * GenicSelection * Eta * Eta + + 0.5 * sigma * GenicSelection * Eta.Derivative()); + cout << temp_Phi.EvaluateReal(0.5) << endl; + vector ACoeffs(SelPolyDeg + 1); + for (int i = 0; i <= SelPolyDeg; i++) { + ACoeffs[i] = + (0.5 * sigma * selectionCoeffs[i]) / + (static_cast( + i + 1)); /// Scaling polynomials coefficients appropriately + } + coeff_ptr = &ACoeffs[0]; + Polynomial temp_A(coeff_ptr, SelPolyDeg); + SelectionFunction.Copy(0.5 * sigma * GenicSelection * Eta); + PhiFunction.Copy(temp_Phi); + AtildeFunction.Copy(temp_A); + } else { + cout << "Please enter a valid selection setup!" + << endl; /// If values not within {0,1,2} complain! + } + } + + PhiSetter(); /// Run function to set phi values +} + +void WrightFisher::PhiSetter() /// Compute max and min of Phi & Atilde functions +{ + if (non_neutral) /// If false, we don't need to bother + { + if (SelectionSetup == 0) /// Genic selection case + { + vector GenicSelMinMax = PhitildeMinMaxRange(); + phiMin = GenicSelMinMax[0]; + phiMax = GenicSelMinMax[1]; + AtildeMax = 0.5 * sigma; + } else /// Otherwise we set Phi & Atilde fns, then use the + /// PolynomialRootFinder to compute their extrema + { + Polynomial temp1 = PhiFunction.Derivative(), + temp2 = AtildeFunction.Derivative(); + vector validRoots, Aroots; + + std::vector real_vector, imag_vector, r_Avec, i_Avec; + int degree = temp1.Degree(), Adegree = temp2.Degree(); + real_vector.resize(degree), imag_vector.resize(degree), + r_Avec.resize(Adegree), i_Avec.resize(Adegree); + + double *real_vector_ptr = &real_vector[0]; + double *imag_vector_ptr = &imag_vector[0]; + double *r_Avec_ptr = &r_Avec[0]; + double *i_Avec_ptr = &i_Avec[0]; + int root_count = 0, root_Acount = 0; + + if (temp1.FindRoots(real_vector_ptr, imag_vector_ptr, &root_count) == + PolynomialRootFinder::SUCCESS) { + int i = 0; + + for (i = 0; i < root_count; ++i) { + if (!(imag_vector_ptr[i] > 0.0 && imag_vector_ptr[i] < 0.0) && + real_vector_ptr[i] >= 0.0 && real_vector_ptr[i] <= 1.0) { + validRoots.push_back(real_vector_ptr[i]); + } + } + } + + if (temp2.FindRoots(r_Avec_ptr, i_Avec_ptr, &root_Acount) == + PolynomialRootFinder::SUCCESS) { + int i = 0; + + for (i = 0; i < root_Acount; ++i) { + if (!(i_Avec_ptr[i] > 0.0 && i_Avec_ptr[i] < 0.0) && + r_Avec_ptr[i] >= 0.0 && r_Avec_ptr[i] <= 1.0) { + Aroots.push_back(r_Avec_ptr[i]); + } + } + } + + double potMax = max(PhiFunction.EvaluateReal(0.0), + PhiFunction.EvaluateReal(1.0)), + potMin = min(PhiFunction.EvaluateReal(0.0), + PhiFunction.EvaluateReal(1.0)); + double AMax = max(AtildeFunction.EvaluateReal(0.0), + AtildeFunction.EvaluateReal(1.0)); + + for (vector::iterator vRit = validRoots.begin(); + vRit != validRoots.end(); vRit++) { + potMax = max(potMax, PhiFunction.EvaluateReal(*vRit)); + potMin = min(potMin, PhiFunction.EvaluateReal(*vRit)); + } + + phiMax = potMax; + phiMin = potMin; + + for (vector::iterator vRit = Aroots.begin(); vRit != Aroots.end(); + vRit++) { + AMax = max(AMax, AtildeFunction.EvaluateReal(*vRit)); + } + + AtildeMax = AMax; + } + } +} + +double100 WrightFisher::Phitilde( + double100 y) /// Returns value of the quadratic function phitilde(y) +{ + assert((y >= 0.0) && (y <= 1.0)); + if (SelectionSetup == 0) /// For genic selection + { + if (sigma == 0.0) { + return 0.0; + } else { + return ((0.25) * sigma * + (-(0.5) * sigma * y * y + ((0.5 * sigma) - theta) * y + + (thetaP.empty() ? 0.0 : thetaP[0]))); + } + } else /// Otherwise use Polynomial class to evaluate + { + return PhiFunction.EvaluateReal(y); + } +} + +vector +WrightFisher::PhitildeMinMaxRange() /// Returns the minimum, maximum and range + /// of phitilde respectively for genic + /// selection case +{ + double100 phiargmin, + phiargmax = max(min(0.5 - (theta / sigma), 1.0), + 0.0); /// Find out max value of phitilde by plugging in + /// derivative(phitilde)=0 + + if (!(phiargmax > 0.0)) /// Figure out if max is at either boundary and set + /// min to be other + { + phiargmin = 1.0; + } else if (!(phiargmax < 1.0)) { + phiargmin = 0.0; + } else /// Otherwise we need to choose the smaller value at each endpoints as + /// the min + { + double100 phizero = Phitilde(0.0), phione = Phitilde(1.0); + + if (min(phizero, phione) == phizero) { + phiargmin = 0.0; + } else { + phiargmin = 1.0; + } + } + + vector MinMaxRange; + + MinMaxRange.push_back(Phitilde(phiargmin)); + MinMaxRange.push_back(Phitilde(phiargmax)); + MinMaxRange.push_back(MinMaxRange[1] - MinMaxRange[0]); + + return MinMaxRange; +} + +double100 WrightFisher::Atilde(double100 x) /// Returns the value of Atilde(x) +{ + assert((x >= 0.0) && (x <= 1.0)); + if (SelectionSetup == 0) /// Genic selection case + { + return 0.5 * (sigma * x); + } else /// Otherwise use Polynomial class + { + return AtildeFunction.EvaluateReal(x); + } +} + +double100 WrightFisher::Atildeplus() /// Returns the max of Atilde +{ + return AtildeMax; +} + +pair WrightFisher::GriffithsParas( + double100 t) /// Compute parameters for Griffiths approximation +{ + assert(t > 0.0); + double beta = (theta - 1.0) * static_cast(t) / 2.0; + double eta = (abs(beta) <= 2.5e-5 ? 1.0 : beta / (exp(beta) - 1.0)); + double mu = 2 * (eta / static_cast(t)); + double sigma = + (abs(beta) <= 2.5e-5 + ? 2.0 / (3.0 * static_cast(t)) + : 2.0 * eta / static_cast(t) * pow(eta + beta, 2.0) * + (1.0 + eta / (eta + beta) - 2.0 * eta) / pow(beta, 2.0)); + assert(sigma > 0.0); + return make_pair(mu, sigma); +} + +int WrightFisher::radiate_from_mode(int index, const double100 t) + const /// Moving from mode as opposed to starting from m = 0 and working + /// upwards +{ + double beta = (theta - 1.0) * static_cast(t) / 2.0; + double eta = (abs(beta) <= 2.5e-5 ? 1.0 : beta / (exp(beta) - 1.0)); + int mmode = static_cast(round(2 * eta / static_cast(t))), + threshold = (thetaP.empty() ? 1 : 0), adjindex = index + threshold; + if (adjindex > 2 * (mmode)-threshold) { + return adjindex; + } else { + return mmode + (index % 2 == 0 ? 1 : -1) * ((index + 1) / 2); + } +} + +void WrightFisher::increment_on_mk(vector &mk, const double100 s, + const double100 t) + const /// Incrementing (m,k) in bridge sampler using bijective fn +{ + int &m_index = mk[2], &k_index = mk[3]; + --m_index; + ++k_index; + if (m_index < 0) { + m_index = m_index + k_index + 1; + k_index = 0; + } + mk[0] = radiate_from_mode(m_index, s); + mk[1] = radiate_from_mode(k_index, t - s); +} + +double100 WrightFisher::Getd( + vector &d, int i, double100 x, double100 z, + double100 t) /// Compute contributions to denom for DrawBridgePMF cases +{ + if (i > static_cast(d.size()) - 1) + d.resize(i + 1, -1.0); + if (d[i] < 0.0) { + d[i] = 0.0; + int m = i / 2, offset = i % 2; + + for (int j = 0; j <= m; ++j) { + int c1 = m + j + offset, c2 = m - j; + boost::math::binomial_distribution B(c2, x); + double100 Expected_Dirichlet = 0.0; + for (int l = 0; l <= c2; ++l) { + double para1 = (thetaP.empty() ? static_cast(l) + : static_cast(thetaP[0] + l)), + para2 = + (thetaP.empty() ? static_cast(c2 - l) + : static_cast(thetaP[1] + c2 - l)); + + boost::math::beta_distribution D(para1, para2); + Expected_Dirichlet += pdf(B, l) * pdf(D, z); + } + + d[i] += exp(Getlogakm(c1, c2) + + static_cast(-c1 * (c1 + theta - 1) * t / 2.0)) * + Expected_Dirichlet; + assert(exp(Getlogakm(c1, c2)) > 0.0); + } + } + assert(d[i] >= 0.0); + return d[i]; +} + +double100 +WrightFisher::Getd2(vector &d, int i, double100 x, + double100 t) /// Compute contributions to denom for + /// AncestralProcessConditional function +{ + if (i > static_cast(d.size()) - 1) + d.resize(i + 1, -1.0); + if (d[i] < 0.0) { + d[i] = 0.0; + int m = i / 2, offset = i % 2; + int bumper = (thetaP.empty()) ? 2 : 1; + + for (int j = 0; j <= m; ++j) { + int c1 = m + bumper + j + offset, c2 = m + bumper - j; + double100 binomialremainder = + (bumper == 2) ? (1.0 - pow(1.0 - x, static_cast(c2)) - + pow(x, static_cast(c2))) + : (1.0 - pow(1.0 - x, static_cast(c2))); + boost::math::binomial_distribution B( + c2, x); // Could make these distributions static for the duration of + // this x and z + d[i] += exp(Getlogakm(c1, c2) + + static_cast(-c1 * (c1 + theta - 1) * t / 2.0)) * + binomialremainder; + assert(exp(Getlogakm(c1, c2)) > 0.0); + } + } + assert(d[i] >= 0.0); + return d[i]; +} + +double100 +WrightFisher::GetdBridgeSame(vector &d, int i, double100 x, + double100 t) /// Compute contributions to denom for + /// DrawBridgePMFSame function +{ + if (i > static_cast(d.size()) - 1) + d.resize(i + 1, -1.0); + if (d[i] < 0.0) { + d[i] = 0.0; + int m = i / 2, offset = i % 2; + + for (int j = 0; j <= m; ++j) { + int c1 = m + j + offset, c2 = m - j; + double100 addon = + (thetaP[0] > 0.0 && thetaP[1] > 0.0 + ? (!(x > 0.0) ? (log(boost::math::tgamma_ratio( + static_cast(theta + c2), + static_cast(thetaP[1] + c2))) - + log(boost::math::tgamma(thetaP[0]))) + : (log(boost::math::tgamma_ratio( + static_cast(theta + c2), + static_cast(thetaP[0] + c2))) - + log(boost::math::tgamma(thetaP[1])))) + : (log(boost::math::tgamma_ratio( + static_cast(theta + c2), + static_cast(c2))) - + log(boost::math::tgamma(theta)))); + d[i] += + exp(Getlogakm(c1, c2) + + static_cast(-c1 * (c1 + theta - 1) * t / 2.0) + addon); + assert(exp(Getlogakm(c1, c2)) > 0.0); + } + } + assert(d[i] >= 0.0); + return d[i]; +} + +double100 WrightFisher::GetdBridgeInterior( + vector &d, int i, double100 x, double100 z, + double100 + t) /// Compute contributions to denom for DrawBridgePMFInterior function +{ + if (i > static_cast(d.size()) - 1) + d.resize(i + 1, -1.0); + if (d[i] < 0.0) { + d[i] = 0.0; + int m = i / 2, offset = i % 2; + + for (int j = 0; j <= m; ++j) { + int c1 = m + j + offset, c2 = m - j; + double100 para1, para2; + + if (!(x > 0.0)) { + para1 = thetaP[0]; + para2 = thetaP[1] + c2; + } else { + para1 = thetaP[0] + c2; + para2 = thetaP[1]; + } + + boost::math::beta_distribution BETA(para1, para2); + double100 zcontribution = log(pdf(BETA, z)); + d[i] += exp(Getlogakm(c1, c2) + + static_cast(-c1 * (c1 + theta - 1) * t / 2.0) + + zcontribution); + assert(exp(Getlogakm(c1, c2)) > 0.0); + } + } + assert(d[i] >= 0.0); + return d[i]; +} + +double100 WrightFisher::GetdBridgeUnconditional( + vector &d, int i, double100 x, double100 z, + double100 t) /// Compute contributions to denom for + /// DrawBridgePMFUnconditioned function +{ + int thetaDep = (thetaP.empty() ? 1 : 0); + if (i > static_cast(d.size()) - 1) + d.resize(i + 1, -1.0); + if (d[i] < 0.0) { + d[i] = 0.0; + int m = i / 2, offset = i % 2; + + for (int j = 0; j <= m; ++j) { + int c1 = m + j + offset + thetaDep, c2 = m - j + thetaDep; + double100 xcontribution = + (!(z > 0.0) ? static_cast(c2) * log(1.0 - x) + : static_cast(c2) * log(x)); + d[i] += exp(Getlogakm(c1, c2) + + static_cast(-c1 * (c1 + theta - 1) * t / 2.0) + + xcontribution); + assert(exp(Getlogakm(c1, c2)) > 0.0); + } + } + assert(d[i] >= 0.0); + return d[i]; +} + +double100 WrightFisher::computeA( + int m, int k, int l, int j, double100 x, + double100 z) /// Compute weights for bridge diffusion decomposition +{ + assert((m >= 0) && (k >= 0) && (l >= 0) && (j >= 0) && (m >= l) && (k >= j) && + (x >= 0.0) && (x <= 1.0) && (z >= 0.0) && (z <= 1.0)); + double theta1 = thetaP[0], theta2 = thetaP[1]; + boost::math::binomial_distribution BIN(m, x); + boost::math::beta_distribution BETA(theta1 + j, theta2 + k - j); + + double100 betaBinPdfs; + + if (!(x > 0.0) || !(x < 1.0)) { + betaBinPdfs = 1.0; /// If x = 0.0 or 1.0, then there is no contribution + } else { + betaBinPdfs = pdf(BIN, l); + } + + if (!(z > 0.0) || !(z < 1.0)) /// Same as above but for z + { + + } else { + betaBinPdfs *= pdf(BETA, z); + } + + return betaBinPdfs * boost::math::binomial_coefficient(k, j) * + (boost::math::beta(theta1 + l + j, theta2 + m - l + k - j) / + boost::math::beta(theta1 + l, theta2 + m - l)); +} + +double100 WrightFisher::computeAUnconditional( + int m, int k, int l, double100 x, + double100 + z) /// Compute weights for unconditioned bridge diffusion decomposition +{ + assert((m >= 0) && (k >= 0) && (l >= 0) && (m >= l) && (x > 0.0) && + (x < 1.0) && (!(z > 0.0) || !(z < 1.0))); + boost::math::binomial_distribution BIN(m, x); + + if ((l == 0) && (thetaP.empty() || !(thetaP[0] > 0.0))) { + return pdf(BIN, l); + } else if ((l == m) && (thetaP.empty() || !(thetaP[1] > 0.0))) { + return pdf(BIN, l); + } + + if (!(z > 0.0)) { + return pdf(BIN, l) * + exp(boost::math::lgamma(static_cast(theta + m - l + k)) + + boost::math::lgamma(static_cast(theta + m)) - + boost::math::lgamma(static_cast(theta + m + k)) - + boost::math::lgamma(static_cast(theta + m - l))); + } else if (!(z < 1.0)) { + return pdf(BIN, l) * + exp(boost::math::lgamma(static_cast(theta + l + k)) + + boost::math::lgamma(static_cast(theta + m)) - + boost::math::lgamma(static_cast(theta + l)) - + boost::math::lgamma(static_cast(theta + k + m))); + } else { + cerr << "z was not 0 or 1! Returning 0."; + return 0.0; + } +} + +int WrightFisher::computeC( + int m, pair, double100> &C) /// Compute the quantity C_m +{ + assert(m >= 0); + if (m > static_cast(C.first.size() - 1) || C.first[m] < 0) { + C.first.resize(m + 1, -1); + int i = 0; + double100 bimnext = + exp(Getlogakm(i + m + 1, m) - + (i + m + 1) * (i + m + 1 + theta - 1) * C.second / 2.0), + bim = exp(Getlogakm(i + m, m) - + (i + m) * (i + m + theta - 1) * C.second / 2.0); + while (bimnext > bim) { + ++i; + bim = bimnext; + bimnext = exp(Getlogakm(i + m + 1, m) - + (i + m + 1) * (i + m + 1 + theta - 1) * C.second / 2.0); + } + C.first[m] = i; + } + assert(C.first[m] >= 0); + return C.first[m]; +} + +int WrightFisher::computeE( + pair, double100> &C) /// Compute the quantity E +{ + int next_constraint = computeC(0, C), curr_row = 0; + int diag_index = next_constraint + (next_constraint % 2); + bool Efound = false; + while (!Efound) { + ++curr_row; + next_constraint = computeC(curr_row, C) + curr_row; + if (diag_index - curr_row < next_constraint) { + diag_index = next_constraint + curr_row; + diag_index += (diag_index % 2); + } + if (curr_row == diag_index / 2) + Efound = true; + } + return curr_row; +} + +double100 +WrightFisher::NormCDF(double100 x, double100 m, + double100 v) /// CDF for N(m,v) - v is the variance +{ + return 0.5 * erfc(-(x - m) / sqrt(2 * v)); +} + +double100 WrightFisher::DiscretisedNormCDF( + int m, + double100 + t) /// CDF for discretised normal, binning mass into nearest integer +{ + double100 returnval; + int threshold = + (thetaP.empty() ? 2 : (thetaP[0] == 0 || !(thetaP[1] > 0.0)) ? 1 : 0); + double beta = (theta - 1.0) * static_cast(t) / 2.0; + double eta = (abs(beta) <= 2.5e-5 ? 1.0 : beta / (exp(beta) - 1.0)); + double v = + (abs(beta) <= 2.5e-5 ? 2.0 / (3.0 * static_cast(t)) + : 2.0 * (eta / static_cast(t)) * + pow((eta + beta) / beta, 2.0) * + (1.0 + (eta / (eta + beta)) - 2.0 * eta)); + assert(v > 0.0); + + if (m == threshold) { + returnval = NormCDF(static_cast(threshold) + 0.5, + 2.0 * (eta / static_cast(t)), v); + } else { + returnval = NormCDF(static_cast(m) + 0.5, + 2.0 * eta / static_cast(t), v) - + NormCDF(static_cast(m) - 0.5, + 2.0 * eta / static_cast(t), v); + } + + return returnval; +} + +double100 WrightFisher::UnconditionedDiffusionDensity( + double100 x, double100 y, double100 t, + const Options &o) /// Compute truncation to diffusion transition density + /// where diffusion can be absorbed at any time +{ + assert((x > 0.0) && (x < 1.0) && (y >= 0.0) && (y <= 1.0) && (t > 0.0)); + + int thetaDependent = + (thetaP.empty() ? 1 : 0); /// Check what thetaP configuration we have + double100 density = 0.0, density_inc, threshold = 1.0e-12; + int mMode = static_cast(floor(GriffithsParas(t).first)), m = mMode, + mFlip = 1, mU = 0, mD = 0; + bool mSwitch = false, mUpSwitch = false, mDownSwitch = false; + + while (!mSwitch) { + if (thetaP.empty()) { + double100 addon = + (!(y > 0.0) ? pow(1.0 - x, static_cast(m)) + : (!(y < 1.0) ? pow(x, static_cast(m)) : 0.0)); + for (int l = 1; l <= m - 1; l++) { + boost::math::binomial_distribution<> BIN(m, x); + boost::math::beta_distribution<> BETA(static_cast(l), + static_cast(m - l)); + addon += pdf(BIN, l) * pdf(BETA, y); + } + density_inc = QmApprox(m, t, o) * addon; + } else if (!(thetaP[0] > 0.0)) { + double100 addon = + (!(y > 0.0) ? pow(1.0 - x, static_cast(m)) : 0.0); + for (int l = 1; l <= m; l++) { + boost::math::binomial_distribution<> BIN(m, x); + boost::math::beta_distribution<> BETA( + static_cast(l), static_cast(theta + m - l)); + addon += pdf(BIN, l) * pdf(BETA, y); + } + density_inc = QmApprox(m, t, o) * addon; + } else { + double100 addon = (!(y < 1.0) ? pow(x, static_cast(m)) : 0.0); + for (int l = 0; l <= m - 1; l++) { + boost::math::binomial_distribution<> BIN(m, x); + boost::math::beta_distribution<> BETA(static_cast(theta + l), + static_cast(m - l)); + addon += pdf(BIN, l) * pdf(BETA, y); + } + density_inc = QmApprox(m, t, o) * addon; + } + + density += density_inc; + + if (!(mDownSwitch)) /// Switching mechanism + { + if (sgn(m - mMode) <= 0) { + mDownSwitch = + ((density_inc < threshold) || (mMode - mD - 1 < thetaDependent)); + } + } + + if (!(mUpSwitch)) { + if (sgn(m - mMode) >= 0) { + mUpSwitch = (density_inc < threshold); + } + } + + mSwitch = (mDownSwitch && mUpSwitch); + + if (!mSwitch) { + if (mFlip == 1) { + mU++; + m = mMode + mU; + mFlip *= (mDownSwitch ? 1 : -1); + } else if ((mFlip == -1) && (mMode - mD - 1 >= thetaDependent)) { + mD++; + m = mMode - mD; + mFlip *= (mUpSwitch ? 1 : -1); + } + } + } + + return density; +} + +double100 WrightFisher::DiffusionDensityApproximationDenom( + double100 x, double100 t, + const Options + &o) /// Compute denominator for truncation to diffusion transition + /// density when diffusion conditioned on non-absorption +{ + assert((x >= 0.0) && (x <= 1.0) && (t > 0.0)); + int thetaDependent = + (thetaP.empty() ? 2 + : ((!(thetaP[0] > 0.0) || !(thetaP[1] > 0.0)) ? 1 : 0)); + double100 denom; + + if ((thetaDependent == 1) || + (thetaDependent == 2)) /// Check whether we have a zero mutation entry + { + double100 denom_inc = 1.0; + denom = 0.0; + int dMode = static_cast(ceil(GriffithsParas(t).first)), d = dMode, + Dflip = 1, Djm = 0, Djp = 0; + + while (denom_inc > + 0.0) /// As long as increments are positive, keep computing + { + if (!(x > 0.0) || !(x < 1.0)) { + denom_inc = QmApprox(d, t, o) * static_cast(d); + } else { + denom_inc = + QmApprox(d, t, o) * (1.0 - pow(x, static_cast(d)) - + pow(1.0 - x, static_cast(d))); + } + + denom += denom_inc; + + if (Dflip == -1 && + (dMode - Djm - 1 >= + thetaDependent)) /// Mechanism to explore either side around the mode + { + Djm++; + d = dMode - Djm; + } else { + Djp++; + d = dMode + Djp; + } + assert(d >= thetaDependent); + Dflip *= -1; + } + } else { + return 1.0; + } + + return denom; +} + +double100 WrightFisher::DiffusionDensityApproximation( + double100 x, double100 y, double100 t, + const Options &o) /// Compute truncation to diffusion transition density +{ + assert((x >= 0.0) && (x <= 1.0) && (y >= 0.0) && (y <= 1.0) && (t > 0.0)); + int thetaDependent = + (thetaP.empty() ? 2 + : ((thetaP[0] > 0.0 && thetaP[1] > 0.0) + ? 0 + : 1)); /// Check what thetaP configuration we have + double100 density = 0.0, density_inc, + denom = DiffusionDensityApproximationDenom(x, t, o), + threshold = max(1.0e-12 * denom, 1.0e-50); + int mMode = static_cast(floor(GriffithsParas(t).first)), m = mMode, + mFlip = 1, mU = 0, mD = 0; + bool mSwitch = false, mUpSwitch = false, mDownSwitch = false; + + while (!mSwitch) { + if (thetaP.empty()) { + if (!(x > 0.0)) { + density_inc = QmApprox(m, t, o) * static_cast(m * (m - 1)) * + pow(1.0 - y, static_cast(m - 2)); + } else if (!(x < 1.0)) { + density_inc = QmApprox(m, t, o) * static_cast(m * (m - 1)) * + pow(y, static_cast(m - 2)); + } else { + double100 addon = 0.0; + for (int l = 1; l != m; l++) { + boost::math::binomial_distribution<> BIN(m, x); + boost::math::beta_distribution BETA( + static_cast(l), static_cast(m - l)); + addon += pdf(BIN, l) * pdf(BETA, y); + } + density_inc = QmApprox(m, t, o) * addon; + } + } else if (!(thetaP[0] > 0.0)) //|| !( thetaP[1] > 0.0 ) ) + { + /*bool thetaSwitch = false; + if ( !( thetaP[1] > 0.0 ) ) + { + iter_swap(thetaP.begin(),thetaP.begin()+1); + thetaSwitch = true; + }*/ + + if (!(x > 0.0)) { + density_inc = QmApprox(m, t, o) * + static_cast(m * (theta + m - 1)) * + pow(1.0 - y, static_cast(theta + m - 2)); + } else { + double100 addon = 0.0; + for (int l = 1; l != m + 1; l++) { + boost::math::binomial_distribution<> BIN(m, x); + boost::math::beta_distribution BETA( + static_cast(l), static_cast(theta + m - l)); + addon += pdf(BIN, l) * pdf(BETA, y); + } + density_inc = QmApprox(m, t, o) * addon; + } + + /*if ( thetaSwitch ) + { + iter_swap(thetaP.begin(),thetaP.begin()+1); + }*/ + } else if (!(thetaP[1] > 0.0)) { + if (!(x < 1.0)) { + density_inc = QmApprox(m, t, o) * + static_cast(m * (theta + m - 1)) * + pow(y, static_cast(theta + m - 2)); + } else { + double100 addon = 0.0; + for (int l = 0; l != m; l++) { + boost::math::binomial_distribution<> BIN(m, x); + boost::math::beta_distribution BETA( + static_cast(theta + l), static_cast(m - l)); + addon += pdf(BIN, l) * pdf(BETA, y); + } + density_inc = QmApprox(m, t, o) * addon; + } + } else { + double100 addon = 0.0; + for (int l = 0; l != m + 1; l++) { + boost::math::binomial_distribution<> BIN(m, x); + boost::math::beta_distribution BETA( + static_cast(thetaP[0] + l), + static_cast(thetaP[1] + m - l)); + addon += pdf(BIN, l) * pdf(BETA, y); + } + density_inc = QmApprox(m, t, o) * addon; + } + + density += density_inc / denom; + + if (!(mDownSwitch)) /// Switching mechanism + { + if (sgn(m - mMode) <= 0) { + mDownSwitch = + ((density_inc < threshold) || (mMode - mD - 1 < thetaDependent)); + } + } + + if (!(mUpSwitch)) { + if (sgn(m - mMode) >= 0) { + mUpSwitch = (density_inc < threshold); + } + } + + mSwitch = (mDownSwitch && mUpSwitch); + + if (!mSwitch) { + if (mFlip == 1) { + mU++; + m = mMode + mU; + mFlip *= (mDownSwitch ? 1 : -1); + } else if ((mFlip == -1) && (mMode - mD - 1 >= thetaDependent)) { + mD++; + m = mMode - mD; + mFlip *= (mUpSwitch ? 1 : -1); + } + } + } + + return density; +} + +double100 +WrightFisher::QmApprox(int m, double100 t, + const Options &o) /// Compute an approximation to q_m(t) +{ + assert((m >= 0) && (t > 0.0)); + double100 qm = 0.0, qmold = -1.0; + + if (t <= o.g1984threshold) /// If time increment is too small, use discretised + /// Gaussian + { + qm = DiscretisedNormCDF(m, t); + } else { + int mkIndex = m; + while (abs(qm - qmold) > 1.0e-12 || qm < 0.0 || + qm > 1.0) /// If increments are big enough, keep going + { + qmold = qm; + qm += pow(-1.0, mkIndex - m) * + exp(Getlogakm(mkIndex, m) + + static_cast(-(mkIndex) * (mkIndex + theta - 1) * + (t) / 2.0)); + mkIndex++; + + if (!(qm > qmold) && !(qm < qmold) && + (qm < 0.0 || qm > 1.0)) /// We have lost precision, so use discretised + /// normal approximation + { + return DiscretisedNormCDF(m, t); + } + } + } + assert(qm >= 0.0); + + return qm; +} + +double100 WrightFisher::UnconditionedBridgeDensity( + double100 x, double100 z, double100 y, double100 s, double100 t, + const Options + &o) /// Compute an approximation to the transition density of the + /// diffusion bridge when absorption can happen at any time +{ + assert((x > 0.0) && (x < 1.0) && (y >= 0.0) && (y <= 1.0) && (s > 0.0) && + (s < t)); + + if (thetaP.empty() && + ((!(z > 0.0) && !(y < 1.0)) || (!(z < 1.0) && !(y > 0.0)))) { + return 0.0; + } + + double100 eC = 0.0, denom_inc = 1.0; + int dmode = static_cast(ceil(GriffithsParas(t).first)), d = dmode, + Dflip = 1, Djm = 0, Djp = 0, mkdLower = (thetaP.empty() ? 1 : 0); + + while (denom_inc > 0.0) /// As long as increments are positive, keep computing + { + if (!(z > 0.0)) /// z = 0 + { + denom_inc = QmApprox(d, t, o) * pow(1.0 - x, static_cast(d)); + } else /// z = 1 + { + denom_inc = QmApprox(d, t, o) * pow(x, static_cast(d)); + } + + eC += denom_inc; + + if (Dflip == -1 && + (dmode - Djm - 1 >= + mkdLower)) /// Mechanism to explore either side around the mode + { + Djm++; + d = dmode - Djm; + } else { + Djp++; + d = dmode + Djp; + } + assert(d >= 0); + Dflip *= -1; + } + + if ((!(y > 0.0) && ((thetaP.empty() || !(thetaP[0] > 0.0)))) || + (!(y < 1.0) && ((thetaP.empty() || !(thetaP[1] > 0.0))))) { + int mMode = GriffithsParas(s).first, + kMode = GriffithsParas(t - s).first; /// Use these together eC to get + /// estimate of suitable threshold + double100 constcontr = + ((!(y > 0.0) && ((thetaP.empty() || !(thetaP[0] > 0.0)))) + ? static_cast(mMode) * log(1.0 - x) + : static_cast(mMode) * log(x)); + double100 density = 0.0, + threshold = + max(exp(log(max(1.0e-300, QmApprox(mMode, s, o))) + + log(max(1.0e-300, QmApprox(kMode, t - s, o))) + + constcontr - log(eC)) * + 1.0e-20, + 1.0e-50); + + int m = mMode, mFlip = 1, mD = 0, mU = 0; + bool mSwitch = false, mDownSwitch = false, mUpSwitch = false; + + while (!mSwitch) { + int k = kMode, kFlip = 1, kD = 0, kU = 0; + bool kSwitch = false, kDownSwitch = false, kUpSwitch = false; + + while (!kSwitch) { + double100 num_inc; + if (!(y > 0.0) && ((thetaP.empty() || !(thetaP[0] > 0.0)))) { + num_inc = + exp(log(max(1.0e-300, QmApprox(m, s, o))) + + log(max(1.0e-300, QmApprox(k, t - s, o))) + + static_cast(m) * log(1.0 - x) - + log(eC)); /// Putting all the separate contributions together + } else { + num_inc = + exp(log(max(1.0e-300, QmApprox(m, s, o))) + + log(max(1.0e-300, QmApprox(k, t - s, o))) + + static_cast(m) * log(x) - + log(eC)); /// Putting all the separate contributions together + } + + density += num_inc; + + if (!(kDownSwitch)) /// Switching mechanism for k + { + if (sgn(k - kMode) <= 0) { + kDownSwitch = + ((num_inc < threshold) || (kMode - kD - 1 < mkdLower)); + } + } + + if (!(kUpSwitch)) { + if (sgn(k - kMode) >= 0) { + kUpSwitch = (num_inc < threshold); + } + } + + kSwitch = (kDownSwitch && kUpSwitch); + + if (!kSwitch) { + if (kFlip == 1) { + kU++; + k = kMode + kU; + kFlip *= (kDownSwitch ? 1 : -1); + } else if ((kFlip == -1) && (kMode - kD - 1 >= mkdLower)) { + kD++; + k = kMode - kD; + kFlip *= (kUpSwitch ? 1 : -1); + } + } + } + + if (!(mDownSwitch)) /// Switching mechanism for m + { + if (sgn(m - mMode) <= 0) { + mDownSwitch = + (((kU == 0) && (kD == 0)) || (mMode - mD - 1 < mkdLower)); + } + } + + if (!(mUpSwitch)) { + if (sgn(m - mMode) >= 0) { + mUpSwitch = ((kU == 0) && (kD == 0)); + } + } + + mSwitch = (mDownSwitch && mUpSwitch); + + if (!mSwitch) { + if (mFlip == 1) { + mU++; + m = mMode + mU; + mFlip *= (mDownSwitch ? 1 : -1); + } else if ((mFlip == -1) && (mMode - mD - 1 >= mkdLower)) { + mD++; + m = mMode - mD; + mFlip *= (mUpSwitch ? 1 : -1); + } + } + } + assert(density >= 0.0); + + return density; + } else if (thetaP.empty() || !(thetaP[0] > 0.0)) { + vector modeGuess = mklModeFinder( + x, z, s, t, o); /// Compute mode over (m,k,l) to use as start points + int mMode = modeGuess[0], kMode = modeGuess[1], + lMode = modeGuess[2]; /// Use these estimates together with eC as a + /// gauge for suitable threshold + double100 ycontr, xcontr; + if (((lMode == 0) && (!(z > 0.0))) || ((lMode == mMode) && (!(z < 1.0)))) { + xcontr = + static_cast(mMode) * (!(z > 0.0) ? log(1.0 - x) : log(x)); + ycontr = 0.0; + } else { + boost::math::binomial_distribution<> BIN(mMode, x); + xcontr = log(pdf(BIN, lMode)); + double100 p1 = static_cast(lMode); + double100 p2 = static_cast(theta + mMode - lMode); + boost::math::beta_distribution BETA(p1, p2); + ycontr = log(pdf(BETA, y)) + static_cast(kMode) * + (!(z > 0.0) ? log(1.0 - y) : log(y)); + } + double100 density = 0.0, + threshold = + max(exp(log(max(1.0e-300, QmApprox(mMode, s, o))) + + log(max(1.0e-300, QmApprox(kMode, t - s, o))) + + xcontr + ycontr - log(eC)) * + 1.0e-20, + 1.0e-50); + + int m = mMode, mFlip = 1, mD = 0, mU = 0; + bool mSwitch = false, mDownSwitch = false, mUpSwitch = false; + double100 mContr_D = boost::math::lgamma(static_cast(theta + m)), + mContr_U = mContr_D, mContr; + double100 constContr = -log(y) - log(1.0 - y); + /// Allows to avoid calling beta functions, and thus faster + while (!mSwitch) { + double100 qm = max(1.0e-300, QmApprox(m, s, o)); + if (m != mMode) /// Increment m contributions accordingly + { + if (mU > mD) { + mContr_U += log(static_cast(theta + (m - 1))); + mContr = log(qm) + mContr_U; + } else { + mContr_D -= log(static_cast(theta + (m + 1) - 1)); + mContr = log(qm) + mContr_D; + } + } else { + mContr = log(qm) + mContr_U; + } + + int k = kMode, kFlip = 1, kD = 0, kU = 0; + bool kSwitch = false, kDownSwitch = false, kUpSwitch = false; + double100 kContr_D = static_cast(k) * + (!(z > 0.0) ? log(1.0 - y) : log(y)), + kContr_U = kContr_D, kContr; /// Calculate k contributions + + while (!kSwitch) { + double100 qk = max(1.0e-300, QmApprox(k, t - s, o)); + if (k != kMode) { + if (kU > kD) { + kContr_U += (!(z > 0.0) ? log(1.0 - y) : log(y)); + kContr = log(qk) + kContr_U; + } else { + kContr_D -= (!(z > 0.0) ? log(1.0 - y) : log(y)); + kContr = log(qk) + kContr_D; + } + } else { + kContr = log(qk) + kContr_U; + } + + int lLower = + (thetaP.empty() ? 1 + : ((!(thetaP[0] > 0.0) && !(z > 0.0)) ? 1 : 0)), + lUpper = (thetaP.empty() + ? m - 1 + : ((!(thetaP[1] > 0.0) && !(z < 1.0)) ? m - 1 : m)); + int lFlip = 1, newlMode = min(lMode, lUpper), l = newlMode, lU = 0, + lD = 0; /// Need to ensure l <= m as m changes! + bool lSwitch = false, lDownSwitch = false, + lUpSwitch = false; /// Compute l contributions + boost::math::binomial_distribution BIN(m, x); + double100 lContr_D = + log(pdf(BIN, l)) + static_cast(l) * log(y) + + static_cast(m - l) * log(1.0 - y) - + boost::math::lgamma(static_cast(l)) - + boost::math::lgamma(static_cast(theta + m - l)); + double100 lContr_U = lContr_D, lContr; + + while (!lSwitch) { + if (l != newlMode) { + if (lU > lD) { + lContr_U += log(static_cast(m - (l - 1))) - + log(static_cast((l - 1) + 1)) + log(x) - + log(1.0 - x) + log(y) - log(1.0 - y) + + log(static_cast(theta + m - (l - 1) - 1)) - + log(static_cast((l - 1))); + lContr = lContr_U; + } else { + lContr_D += log(static_cast(l + 1)) - + log(static_cast(m - (l + 1) + 1)) + + log(1.0 - x) - log(x) + log(1.0 - y) - log(y) + + log(static_cast((l + 1) - 1)) - + log(static_cast(theta + m - (l + 1))); + lContr = lContr_D; + } + } else { + lContr = lContr_U; + } + double100 density_inc = + exp(constContr + mContr + kContr + lContr - + log(eC)); /// Putting all separate contributions together + density += density_inc; + + if (!(lDownSwitch)) /// Switching mechanism for l + { + if (sgn(l - newlMode) <= 0) { + lDownSwitch = + ((density_inc < threshold) || (newlMode - lD - 1) < lLower); + } + } + + if (!(lUpSwitch)) { + if (sgn(l - newlMode) >= 0) { + lUpSwitch = + ((density_inc < threshold) || (newlMode + lU + 1) > lUpper); + } + } + + lSwitch = (lDownSwitch && lUpSwitch); + + if (!lSwitch) { + if ((lFlip == 1 && (newlMode + lU + 1 <= lUpper)) || + (lDownSwitch && !(lUpSwitch))) { + lU++; + l = newlMode + lU; + lFlip *= (lDownSwitch ? 1 : -1); + } else if ((lFlip == -1 && (newlMode - lD - 1 >= lLower)) || + (lUpSwitch && !(lDownSwitch))) { + lD++; + l = newlMode - lD; + lFlip *= (lUpSwitch ? 1 : -1); + } + } + } + + if (!(kDownSwitch)) /// Switching mechanism for k + { + if (sgn(k - kMode) <= 0) { + kDownSwitch = + (((lU == 0) && (lD == 0)) || (kMode - kD - 1 < mkdLower)); + } + } + + if (!(kUpSwitch)) { + if (sgn(k - kMode) >= 0) { + kUpSwitch = ((lU == 0) && (lD == 0)); + } + } + + kSwitch = (kDownSwitch && kUpSwitch); + + if (!kSwitch) { + if (kFlip == 1) { + kU++; + k = kMode + kU; + kFlip *= (kDownSwitch ? 1 : -1); + } else if ((kFlip == -1) && (kMode - kD - 1 >= mkdLower)) { + kD++; + k = kMode - kD; + kFlip *= (kUpSwitch ? 1 : -1); + } + } + } + + if (!(mDownSwitch)) /// Switching mechanism for m + { + if (sgn(m - mMode) <= 0) { + mDownSwitch = + (((kU == 0) && (kD == 0)) || (mMode - mD - 1 < mkdLower)); + } + } + + if (!(mUpSwitch)) { + if (sgn(m - mMode) >= 0) { + mUpSwitch = ((kU == 0) && (kD == 0)); + } + } + + mSwitch = (mDownSwitch && mUpSwitch); + + if (!mSwitch) { + if (mFlip == 1) { + mU++; + m = mMode + mU; + mFlip *= (mDownSwitch ? 1 : -1); + } else if ((mFlip == -1) && (mMode - mD - 1 >= mkdLower)) { + mD++; + m = mMode - mD; + mFlip *= (mUpSwitch ? 1 : -1); + } + } + } + assert(density >= 0.0); + + return density; + } else { + vector modeGuess = mklModeFinder( + x, z, s, t, o); /// Compute mode over (m,k,l) to use as start points + int mMode = modeGuess[0], kMode = modeGuess[1], + lMode = modeGuess[2]; /// Use these estimates together with eC as a + /// gauge for suitable threshold + double100 xcontr, ycontr; + if (lMode == 0) { + xcontr = static_cast(mMode) * log(x); + ycontr = 0.0; + } else { + boost::math::binomial_distribution<> BIN(mMode, x); + xcontr = log(pdf(BIN, lMode)); + double100 p1 = static_cast(theta + lMode), + p2 = static_cast(mMode - lMode); + boost::math::beta_distribution B1(p1, p2); + ycontr = log(pdf(B1, y)) + static_cast(kMode) * log(y); + } + double100 density = 0.0, + threshold = + max(exp(log(max(1.0e-300, QmApprox(mMode, s, o))) + + log(max(1.0e-300, QmApprox(kMode, t - s, o))) + + xcontr + ycontr - log(eC)) * + 1.0e-20, + 1.0e-50); + + int m = mMode, mFlip = 1, mD = 0, mU = 0; + bool mSwitch = false, mDownSwitch = false, mUpSwitch = false; + double100 mContr_D = boost::math::lgamma(static_cast(theta + m)), + mContr_U = mContr_D, mContr; + double100 constContr = -log(y) - log(1.0 - y); + /// Allows to avoid calling beta functions, and thus faster + while (!mSwitch) { + double100 qm = max(1.0e-300, QmApprox(m, s, o)); + if (m != mMode) /// Increment m contributions accordingly + { + if (mU > mD) { + mContr_U += log(static_cast(theta + (m - 1))); + mContr = log(qm) + mContr_U; + } else { + mContr_D -= log(static_cast(theta + (m + 1) - 1)); + mContr = log(qm) + mContr_D; + } + } else { + mContr = log(qm) + mContr_U; + } + + int k = kMode, kFlip = 1, kD = 0, kU = 0; + bool kSwitch = false, kDownSwitch = false, kUpSwitch = false; + double100 kContr_D = static_cast(k) * log(y), + kContr_U = kContr_D, kContr; /// Calculate k contributions + + while (!kSwitch) { + double100 qk = max(1.0e-300, QmApprox(k, t - s, o)); + if (k != kMode) { + if (kU > kD) { + kContr_U += log(y); + kContr = log(qk) + kContr_U; + } else { + kContr_D -= log(y); + kContr = log(qk) + kContr_D; + } + } else { + kContr = log(qk) + kContr_U; + } + + int lFlip = 1, newlMode = min(lMode, m), l = newlMode, lU = 0, + lD = 0; /// Need to ensure l <= m as m changes! + int lLower = + (thetaP.empty() ? 1 + : ((!(thetaP[0] > 0.0) && !(z > 0.0)) ? 1 : 0)), + lUpper = (thetaP.empty() + ? m - 1 + : ((!(thetaP[1] > 0.0) && !(z < 1.0)) ? m - 1 : m)); + bool lSwitch = false, lDownSwitch = false, + lUpSwitch = false; /// Compute l contributions + boost::math::binomial_distribution BIN(m, x); + double100 lContr_D = + log(pdf(BIN, l)) + static_cast(l) * log(y) + + static_cast(m - l) * log(1.0 - y) - + boost::math::lgamma(static_cast(theta + l)) - + boost::math::lgamma(static_cast(m - l)); + double100 lContr_U = lContr_D, lContr; + + while (!lSwitch) { + if (l != newlMode) { + if (lU > lD) { + lContr_U += log(static_cast(m - (l - 1))) - + log(static_cast((l - 1) + 1)) + log(x) - + log(1.0 - x) + log(y) - log(1.0 - y) + + log(static_cast(m - (l - 1) - 1)) - + log(static_cast(theta + (l - 1))); + lContr = lContr_U; + } else { + lContr_D += log(static_cast(l + 1)) - + log(static_cast(m - (l + 1) + 1)) + + log(1.0 - x) - log(x) + log(1.0 - y) - log(y) + + log(static_cast(theta + (l + 1) - 1)) - + log(static_cast(m - (l + 1))); + lContr = lContr_D; + } + } else { + lContr = lContr_U; + } + double100 density_inc = + exp(constContr + mContr + kContr + lContr - + log(eC)); /// Putting all separate contributions together + density += density_inc; + + if (!(lDownSwitch)) /// Switching mechanism for l + { + if (sgn(l - newlMode) <= 0) { + lDownSwitch = + ((density_inc < threshold) || (newlMode - lD - 1) < lLower); + } + } + + if (!(lUpSwitch)) { + if (sgn(l - newlMode) >= 0) { + lUpSwitch = + ((density_inc < threshold) || (newlMode + lU + 1) > lUpper); + } + } + + lSwitch = (lDownSwitch && lUpSwitch); + + if (!lSwitch) { + if ((lFlip == 1 && (newlMode + lU + 1 <= lUpper)) || + (lDownSwitch && !(lUpSwitch))) { + lU++; + l = newlMode + lU; + lFlip *= (lDownSwitch ? 1 : -1); + } else if ((lFlip == -1 && (newlMode - lD - 1 >= lLower)) || + (lUpSwitch && !(lDownSwitch))) { + lD++; + l = newlMode - lD; + lFlip *= (lUpSwitch ? 1 : -1); + } + } + } + + if (!(kDownSwitch)) /// Switching mechanism for k + { + if (sgn(k - kMode) <= 0) { + kDownSwitch = + (((lU == 0) && (lD == 0)) || (kMode - kD - 1 < mkdLower)); + } + } + + if (!(kUpSwitch)) { + if (sgn(k - kMode) >= 0) { + kUpSwitch = ((lU == 0) && (lD == 0)); + } + } + + kSwitch = (kDownSwitch && kUpSwitch); + + if (!kSwitch) { + if (kFlip == 1) { + kU++; + k = kMode + kU; + kFlip *= (kDownSwitch ? 1 : -1); + } else if ((kFlip == -1) && (kMode - kD - 1 >= mkdLower)) { + kD++; + k = kMode - kD; + kFlip *= (kUpSwitch ? 1 : -1); + } + } + } + + if (!(mDownSwitch)) /// Switching mechanism for m + { + if (sgn(m - mMode) <= 0) { + mDownSwitch = + (((kU == 0) && (kD == 0)) || (mMode - mD - 1 < mkdLower)); + } + } + + if (!(mUpSwitch)) { + if (sgn(m - mMode) >= 0) { + mUpSwitch = ((kU == 0) && (kD == 0)); + } + } + + mSwitch = (mDownSwitch && mUpSwitch); + + if (!mSwitch) { + if (mFlip == 1) { + mU++; + m = mMode + mU; + mFlip *= (mDownSwitch ? 1 : -1); + } else if ((mFlip == -1) && (mMode - mD - 1 >= mkdLower)) { + mD++; + m = mMode - mD; + mFlip *= (mUpSwitch ? 1 : -1); + } + } + } + assert(density >= 0.0); + + return density; + } +} + +double100 WrightFisher::BridgeDenom( + double100 x, double100 z, double100 y, double100 s, double100 t, + const Options &o) /// Compute an approximation to the denominator for the + /// transition density of the diffusion bridge +{ + assert((x >= 0.0) && (x <= 1.0) && (y >= 0.0) && (y <= 1.0) && (z >= 0.0) && + (z <= 1.0) && (t > 0.0) && (s > 0.0) && (s < t)); + double100 denom = 0.0; + double100 inc = 1.0; + int dmode = static_cast(ceil(GriffithsParas(t).first)), d = dmode, + Dflip = 1, Djm = 0, Djp = 0; + + while (inc > 0.0) /// As long as increments are positive, keep computing + { + if ((x > 0.0) && (x < 1.0) && (z > 0.0) && (z < 1.0)) /// x,z in (0,1) + { + double100 betabin = 0.0; + for (int f = 0; f != d + 1; f++) { + boost::math::binomial_distribution BIN(d, x); + double100 para1 = static_cast(thetaP[0] + f), + para2 = static_cast(thetaP[1] + d - f); + boost::math::beta_distribution BETA(para1, para2); + + betabin += pdf(BIN, f) * pdf(BETA, z); + } + + inc = QmApprox(d, t, o) * betabin; + } else if ((z > 0.0) && (z < 1.0) && + (!(x > 0.0) || !(x < 1.0))) /// x in {0,1}, z in (0,1) + { + double100 para1 = (!(x > 0.0) ? thetaP[0] + : static_cast(thetaP[0] + d)), + para2 = (!(x > 0.0) ? static_cast(thetaP[1] + d) + : thetaP[1]); + boost::math::beta_distribution BETAZ(para1, para2); + inc = QmApprox(d, t, o) * pdf(BETAZ, z); + } else if ((x > 0.0) && (x < 1.0) && + (!(z > 0.0) || !(z < 1.0))) /// x in (0,1), z in {0,1} + { + double100 para1 = (!(z > 0.0) ? thetaP[0] + : static_cast(thetaP[0] + d)), + para2 = (!(z > 0.0) ? static_cast(thetaP[1] + d) + : thetaP[1]); + double100 xcon = (!(z > 0.0) ? pow(1.0 - x, static_cast(d)) + : pow(x, static_cast(d))); + inc = QmApprox(d, t, o) * xcon * + (1.0 / boost::math::beta(para1, para2)); + } else if (!(x < z) && !(x > z)) /// x,z in {0,1} and x=z + { + double100 para1 = (!(x > 0.0) ? thetaP[0] + : static_cast(thetaP[0] + d)), + para2 = (!(x > 0.0) ? static_cast(thetaP[1] + d) + : thetaP[1]); + inc = QmApprox(d, t, o) / boost::math::beta(para1, para2); + } else /// x,z in {0,1} and x!=z + { + return QmApprox(0, t, o) / + boost::math::beta(thetaP[0], thetaP[1]); + } + + denom += inc; + + if (Dflip == -1 && + (dmode - Djm > 0)) /// Mechanism to explore either side around the mode + { + Djm++; + d = dmode - Djm; + } else { + Djp++; + d = dmode + Djp; + } + assert(d >= 0); + Dflip *= -1; + } + + return denom; +} + +double100 WrightFisher::ComputeDensity1( + double100 x, double100 z, double100 y, double100 s, double100 t, + const Options &o) /// Compute bridge density when x,z in (0,1) (any theta!) +{ + assert((x >= 0.0) && (x <= 1.0) && (y >= 0.0) && (y <= 1.0) && (z >= 0.0) && + (z <= 1.0) && (t > 0.0) && (s > 0.0) && (s < t)); + if (!(y > 0.0) || !(y < 1.0)) { + return 0.0; + } + + vector modeGuess = mkljModeFinder( + x, z, s, t, o); /// Compute mode over (m,k,l,j) to use as start points + int mMode = modeGuess[0], kMode = modeGuess[1], lMode = modeGuess[2], + jMode = modeGuess[3]; /// Use these estimates together with eC as a gauge + /// for suitable threshold + double100 qmmode = max(1.0e-300, QmApprox(mMode, s, o)), + qkmode = max(1.0e-300, QmApprox(kMode, t - s, o)); + boost::math::binomial_distribution<> BINx(mMode, x), BINy(kMode, y); + boost::math::beta_distribution BETAz( + static_cast(thetaP[0] + jMode), + static_cast(thetaP[1] + kMode - jMode)), + BETAy(static_cast(thetaP[0] + lMode), + static_cast(thetaP[1] + mMode - lMode)); + double100 density = 0.0, eC = BridgeDenom(x, z, y, s, t, o), + threshold = + max(exp(log(qmmode) + log(qkmode) + log(pdf(BINx, lMode)) + + log(pdf(BINy, jMode)) + log(pdf(BETAz, z)) + + log(pdf(BETAy, y)) - log(eC)) * + 1.0e-6, + 1.0e-50); + + int m = mMode, mFlip = 1, mD = 0, mU = 0; + bool mSwitch = false, mDownSwitch = false, mUpSwitch = false; + double100 mContr_D = boost::math::lgamma( + static_cast(thetaP[0] + thetaP[1] + m)), + mContr_U = mContr_D, + mContr; /// Compute contributions depending only on m + /// Allows to avoid calling beta functions, and thus faster + while (!mSwitch) { + double100 qm = QmApprox(m, s, o); + if (m != mMode) /// Increment m contributions accordingly + { + if (mU > mD) { + mContr_U += + log(static_cast(thetaP[0] + thetaP[1] + (m - 1))); + mContr = log(qm) + mContr_U; + } else { + mContr_D -= + log(static_cast(thetaP[0] + thetaP[1] + (m + 1) - 1)); + mContr = log(qm) + mContr_D; + } + } else { + mContr = log(qm) + mContr_U; + } + + int k = kMode, kFlip = 1, kD = 0, kU = 0; + bool kSwitch = false, kDownSwitch = false, kUpSwitch = false; + double100 kContr_D = boost::math::lgamma( + static_cast(thetaP[0] + thetaP[1] + k)), + kContr_U = kContr_D, kContr; /// Calculate k contributions + + while (!kSwitch) { + double100 qk = QmApprox(k, t - s, o); + if (k != kMode) { + if (kU > kD) { + kContr_U += + log(static_cast(thetaP[0] + thetaP[1] + (k - 1))); + kContr = log(qk) + kContr_U; + } else { + kContr_D -= + log(static_cast(thetaP[0] + thetaP[1] + (k + 1) - 1)); + kContr = log(qk) + kContr_D; + } + } else { + kContr = log(qk) + kContr_U; + } + + int lFlip = 1, lU = 0, lD = 0, newlMode = min(lMode, m), + l = newlMode; /// Need to ensure l <= m since m changes! + bool lSwitch = false, lDownSwitch = false, lUpSwitch = false; + boost::math::binomial_distribution BINL( + m, x); /// Contributions from l + double100 lContr_D = + (log(pdf(BINL, l)) - + boost::math::lgamma(static_cast(thetaP[0] + l)) - + boost::math::lgamma(static_cast(thetaP[1] + m - l)) + + static_cast(l) * log(y) + + static_cast(m - l) * log(1.0 - y)); + double100 lContr_U = lContr_D, lContr; + + while (!lSwitch) { + assert((l >= 0) && (l <= m)); + if (l != newlMode) { + if (lU > lD) { + lContr_U += + log(static_cast(m - (l - 1))) - + log(static_cast((l - 1) + 1)) + log(x) - + log(1.0 - x) + + log(static_cast(thetaP[1] + m - (l - 1) - 1)) - + log(static_cast(thetaP[0] + (l - 1))) + log(y) - + log(1.0 - y); + lContr = lContr_U; + } else { + lContr_D += log(static_cast(l + 1)) - + log(static_cast(m - (l + 1) + 1)) + + log(1.0 - x) - log(x) + + log(static_cast(thetaP[0] + (l + 1) - 1)) - + log(static_cast(thetaP[1] + m - (l + 1))) + + log(1.0 - y) - log(y); + lContr = lContr_D; + } + } else { + lContr = lContr_U; + } + + int jFlip = 1, jU = 0, jD = 0, newjMode = min(jMode, k), + j = newjMode; /// Need to ensure j <= k as k changes! + bool jSwitch = false, jDownSwitch = false, + jUpSwitch = false; /// Compute j contributions + double100 jContr_D = + log(boost::math::binomial_coefficient(k, j)) - + boost::math::lgamma(static_cast(thetaP[0] + j)) - + boost::math::lgamma(static_cast(thetaP[1] + k - j)) + + static_cast(thetaP[0] + j - 1) * log(z) + + static_cast(thetaP[1] + k - j - 1) * log(1.0 - z) + + static_cast(thetaP[0] + j - 1) * log(y) + + static_cast(thetaP[1] + k - j - 1) * log(1.0 - y); + double100 jContr_U = jContr_D, jContr; + + while (!jSwitch) { + if (j != newjMode) { + if (jU > jD) { + jContr_U += + log(static_cast(k - (j - 1))) - + log(static_cast((j - 1) + 1)) + log(z) - + log(1.0 - z) + + log(static_cast(thetaP[1] + k - (j - 1) - 1)) - + log(static_cast(thetaP[0] + (j - 1))) + log(y) - + log(1.0 - y); + jContr = jContr_U; + } else { + jContr_D += log(static_cast(j + 1)) - + log(static_cast(k - (j + 1) + 1)) + + log(1.0 - z) - log(z) + + log(static_cast(thetaP[0] + (j + 1) - 1)) - + log(static_cast(thetaP[1] + k - (j + 1))) + + log(1.0 - y) - log(y); + jContr = jContr_D; + } + } else { + jContr = jContr_U; + } + + double100 density_inc = + exp(mContr + kContr + lContr + jContr - + log(eC)); /// Put all separate contributions together + density += density_inc; + + if (!(jDownSwitch)) /// Check whether we can still move downwards + { + if (sgn(j - newjMode) <= 0) { + jDownSwitch = + ((density_inc < threshold) || (newjMode - jD - 1) < 0); + } + } + + if (!(jUpSwitch)) /// Check whether we can still move downwards + { + if (sgn(j - newjMode) >= 0) { + jUpSwitch = + ((density_inc < threshold) || (newjMode + jU + 1) > k); + } + } + + jSwitch = (jDownSwitch && + jUpSwitch); /// Decide if we can move out and change l + + if (!jSwitch) /// If we cannot, we need to move upwards or downwards + { + if ((jFlip == 1 && (newjMode + jU + 1 <= k)) || + (jDownSwitch && !(jUpSwitch))) { + jU++; + j = newjMode + jU; + jFlip *= (jDownSwitch ? 1 : -1); + } else if ((jFlip == -1 && (newjMode - jD - 1 >= 0)) || + (jUpSwitch && !(jDownSwitch))) { + jD++; + j = newjMode - jD; + jFlip *= (jUpSwitch ? 1 : -1); + } + } + } + + if (!(lDownSwitch)) /// Same procedure as for j contributions, but now + /// we don't need to worry about increments being + /// below threshold + { + if (sgn(l - newlMode) <= 0) { + lDownSwitch = (((jU == 0) && (jD == 0)) || (newlMode - lD - 1) < 0); + } + } + + if (!(lUpSwitch)) { + if (sgn(l - newlMode) >= 0) { + lUpSwitch = (((jU == 0) && (jD == 0)) || (newlMode + lU + 1) > m); + } + } + + lSwitch = (lDownSwitch && lUpSwitch); + + if (!lSwitch) { + if ((lFlip == 1 && (newlMode + lU + 1 <= m)) || + (lDownSwitch && !(lUpSwitch))) { + lU++; + l = newlMode + lU; + lFlip *= (lDownSwitch ? 1 : -1); + } else if ((lFlip == -1 && (newlMode - lD - 1 >= 0)) || + (lUpSwitch && !(lDownSwitch))) { + lD++; + l = newlMode - lD; + lFlip *= (lUpSwitch ? 1 : -1); + } + } + } + + if (!(kDownSwitch)) /// Same switching procedure as for l + { + if (sgn(k - kMode) <= 0) { + kDownSwitch = (((lU == 0) && (lD == 0)) || (kMode - kD - 1 < 0)); + } + } + + if (!(kUpSwitch)) { + if (sgn(k - kMode) >= 0) { + kUpSwitch = ((lU == 0) && (lD == 0)); + } + } + + kSwitch = (kDownSwitch && kUpSwitch); + + if (!kSwitch) { + if (kFlip == 1) { + kU++; + k = kMode + kU; + kFlip *= (kDownSwitch ? 1 : -1); + } else if ((kFlip == -1) && (kMode - kD - 1 >= 0)) { + kD++; + k = kMode - kD; + kFlip *= (kUpSwitch ? 1 : -1); + } + } + } + + if (!(mDownSwitch)) /// Same switching procedure as for k + { + if (sgn(m - mMode) <= 0) { + mDownSwitch = (((kU == 0) && (kD == 0)) || (mMode - mD - 1 < 0)); + } + } + + if (!(mUpSwitch)) { + if (sgn(m - mMode) >= 0) { + mUpSwitch = ((kU == 0) && (kD == 0)); + } + } + + mSwitch = (mDownSwitch && mUpSwitch); + + if (!mSwitch) { + if (mFlip == 1) { + mU++; + m = mMode + mU; + mFlip *= (mDownSwitch ? 1 : -1); + } else if ((mFlip == -1) && (mMode - mD - 1 >= 0)) { + mD++; + m = mMode - mD; + mFlip *= (mUpSwitch ? 1 : -1); + } + } + } + assert(density >= 0.0); + + return density; +} + +double100 WrightFisher::ComputeDensity2( + double100 x, double100 z, double100 y, double100 s, double100 t, + const Options + &o) /// Compute bridge density when x in {0,1},z in (0,1) (any theta!) +{ + assert((x >= 0.0) && (x <= 1.0) && (y >= 0.0) && (y <= 1.0) && (z >= 0.0) && + (z <= 1.0) && (t > 0.0) && (s > 0.0) && (s < t)); + if (!(y > 0.0) || !(y < 1.0)) { + return 0.0; + } + + vector modeGuess = mkjModeFinder( + x, z, s, t, o); /// Compute mode over (m,k,j) to use as start points + int mMode = modeGuess[0], kMode = modeGuess[1], + jMode = modeGuess[2]; /// Use these estimates together with eC as a gauge + /// for suitable threshold + double100 qmmode = max(1.0e-300, QmApprox(mMode, s, o)), + qkmode = max(1.0e-300, QmApprox(kMode, t - s, o)); + double100 p1 = static_cast(!(x > 0.0) ? thetaP[0] + : thetaP[0] + mMode), + p2 = static_cast(!(x < 1.0) ? thetaP[1] + mMode + : thetaP[1]); + boost::math::binomial_distribution<> BINy(kMode, y); + boost::math::beta_distribution BETAz( + static_cast(thetaP[0] + jMode), + static_cast(thetaP[1] + kMode - jMode)), + BETAy(p1, p2); + double100 density = 0.0, eC = BridgeDenom(x, z, y, s, t, o), + threshold = + max(exp(log(qmmode) + log(qkmode) + log(pdf(BINy, jMode)) + + log(pdf(BETAz, z)) + log(pdf(BETAy, y)) - log(eC)) * + 1.0e-6, + 1.0e-50); + + int m = mMode, mFlip = 1, mD = 0, mU = 0; + bool mSwitch = false, mDownSwitch = false, mUpSwitch = false; + double100 mContr_D = + boost::math::lgamma( + static_cast(thetaP[0] + thetaP[1] + m)) + + (!(x > 0.0) ? -boost::math::lgamma( + static_cast(thetaP[1] + m)) + + static_cast(m) * log(1.0 - y) + : -boost::math::lgamma( + static_cast(thetaP[0] + m)) + + static_cast(m) * log(y)), + mContr_U = mContr_D, mContr; + double100 constContr = + (static_cast(thetaP[0] - 1.0)) * log(z) + + (static_cast(thetaP[1] - 1.0)) * log(1.0 - z) + + (static_cast(thetaP[0] - 1.0)) * log(y) + + (static_cast(thetaP[1] - 1.0)) * log(1.0 - y) + + (!(x > 0.0) ? -boost::math::lgamma(static_cast(thetaP[0])) + : -boost::math::lgamma(static_cast(thetaP[1]))); + /// Allows to avoid calling beta functions, and thus faster + while (!mSwitch) { + double100 qm = QmApprox(m, s, o); + if (m != mMode) /// Increment m contributions accordingly + { + if (mU > mD) { + mContr_U += + log(static_cast(thetaP[0] + thetaP[1] + (m - 1))) + + (!(x > 0.0) + ? -log(static_cast(thetaP[1] + (m - 1))) + + log(1.0 - y) + : -log(static_cast(thetaP[0] + (m - 1))) + log(y)); + mContr = log(qm) + mContr_U; + } else { + mContr_D += + -log(static_cast(thetaP[0] + thetaP[1] + (m + 1) - 1)) + + (!(x > 0.0) ? log(static_cast(thetaP[1] + (m + 1) - 1)) - + log(1.0 - y) + : log(static_cast(thetaP[0] + (m + 1) - 1)) - + log(y)); + mContr = log(qm) + mContr_D; + } + } else { + mContr = log(qm) + mContr_U; + } + + int k = kMode, kFlip = 1, kD = 0, kU = 0; + bool kSwitch = false, kDownSwitch = false, kUpSwitch = false; + double100 kContr_D = boost::math::lgamma( + static_cast(thetaP[0] + thetaP[1] + k)), + kContr_U = kContr_D, kContr; /// Calculate k contributions + + while (!kSwitch) { + double100 qk = QmApprox(k, t - s, o); + if (k != kMode) { + if (kU > kD) { + kContr_U += + log(static_cast(thetaP[0] + thetaP[1] + (k - 1))); + kContr = log(qk) + kContr_U; + } else { + kContr_D -= + log(static_cast(thetaP[0] + thetaP[1] + (k + 1) - 1)); + kContr = log(qk) + kContr_D; + } + } else { + kContr = log(qk) + kContr_U; + } + + int jFlip = 1, newjMode = min(jMode, k), j = newjMode, jU = 0, + jD = 0; /// Need to ensure j <= k as k changes! + bool jSwitch = false, jDownSwitch = false, + jUpSwitch = false; /// Compute j contributions + double100 jContr_D = + log(boost::math::binomial_coefficient(k, j)) - + boost::math::lgamma(static_cast(thetaP[0] + j)) - + boost::math::lgamma(static_cast(thetaP[1] + k - j)) + + static_cast(thetaP[0] + j) * log(z) + + static_cast(thetaP[1] + k - j) * log(1.0 - z) + + static_cast(j) * log(y) + + static_cast(k - j) * log(1.0 - y); + double100 jContr_U = jContr_D, jContr; + + while (!jSwitch) { + if (j != newjMode) { + if (jU > jD) { + jContr_U += + log(static_cast(k - (j - 1))) - + log(static_cast((j - 1) + 1)) + log(z) - + log(1.0 - z) + + log(static_cast(thetaP[1] + k - (j - 1) - 1)) - + log(static_cast(thetaP[0] + (j - 1))) + log(y) - + log(1.0 - y); + jContr = jContr_U; + } else { + jContr_D += log(static_cast(j + 1)) - + log(static_cast(k - (j + 1) + 1)) + + log(1.0 - z) - log(z) + + log(static_cast(thetaP[0] + (j + 1) - 1)) - + log(static_cast(thetaP[1] + k - (j + 1))) + + log(1.0 - y) - log(y); + jContr = jContr_D; + } + } else { + jContr = jContr_U; + } + double100 density_inc = + exp(constContr + mContr + kContr + jContr - + log(eC)); /// Putting all separate contributions together + density += density_inc; + + if (!(jDownSwitch)) /// Switching mechnism for j, exactly as in + /// ComputeDensity1 function + { + if (sgn(j - newjMode) <= 0) { + jDownSwitch = + ((density_inc < threshold) || (newjMode - jD - 1) < 0); + } + } + + if (!(jUpSwitch)) { + if (sgn(j - newjMode) >= 0) { + jUpSwitch = ((density_inc < threshold) || (newjMode + jU + 1) > k); + } + } + + jSwitch = (jDownSwitch && jUpSwitch); + + if (!jSwitch) { + if ((jFlip == 1 && (newjMode + jU + 1 <= k)) || + (jDownSwitch && !(jUpSwitch))) { + jU++; + j = newjMode + jU; + jFlip *= (jDownSwitch ? 1 : -1); + } else if ((jFlip == -1 && (newjMode - jD - 1 >= 0)) || + (jUpSwitch && !(jDownSwitch))) { + jD++; + j = newjMode - jD; + jFlip *= (jUpSwitch ? 1 : -1); + } + } + } + + if (!(kDownSwitch)) /// Switching mechanism for k + { + if (sgn(k - kMode) <= 0) { + kDownSwitch = (((jU == 0) && (jD == 0)) || (kMode - kD - 1 < 0)); + } + } + + if (!(kUpSwitch)) { + if (sgn(k - kMode) >= 0) { + kUpSwitch = ((jU == 0) && (jD == 0)); + } + } + + kSwitch = (kDownSwitch && kUpSwitch); + + if (!kSwitch) { + if (kFlip == 1) { + kU++; + k = kMode + kU; + kFlip *= (kDownSwitch ? 1 : -1); + } else if ((kFlip == -1) && (kMode - kD - 1 >= 0)) { + kD++; + k = kMode - kD; + kFlip *= (kUpSwitch ? 1 : -1); + } + } + } + + if (!(mDownSwitch)) /// Switching mechanism for m + { + if (sgn(m - mMode) <= 0) { + mDownSwitch = (((kU == 0) && (kD == 0)) || (mMode - mD - 1 < 0)); + } + } + + if (!(mUpSwitch)) { + if (sgn(m - mMode) >= 0) { + mUpSwitch = ((kU == 0) && (kD == 0)); + } + } + + mSwitch = (mDownSwitch && mUpSwitch); + + if (!mSwitch) { + if (mFlip == 1) { + mU++; + m = mMode + mU; + mFlip *= (mDownSwitch ? 1 : -1); + } else if ((mFlip == -1) && (mMode - mD - 1 >= 0)) { + mD++; + m = mMode - mD; + mFlip *= (mUpSwitch ? 1 : -1); + } + } + } + assert(density >= 0.0); + + return density; +} + +double100 WrightFisher::ComputeDensity3( + double100 x, double100 z, double100 y, double100 s, double100 t, + const Options + &o) /// Compute bridge density when x,z in {0,1}, x=z (any theta!) +{ + assert((x >= 0.0) && (x <= 1.0) && (y >= 0.0) && (y <= 1.0) && (z >= 0.0) && + (z <= 1.0) && (t > 0.0) && (s > 0.0) && (s < t)); + if (!(y > 0.0) || !(y < 1.0)) { + return 0.0; + } + + vector modeGuess = mkModeFinder(x, z, s, t, o); /// Find mode over (m,k) + int mMode = modeGuess[0], + kMode = modeGuess[1]; /// Use these together eC to get estimate of + /// suitable threshold + double100 qmmode = max(1.0e-300, QmApprox(mMode, s, o)), + qkmode = max(1.0e-300, QmApprox(kMode, t - s, o)); + double100 th1 = static_cast(!(x > 0.0) ? thetaP[0] : thetaP[1]), + th2 = theta - th1; + double100 gammaratios = + -boost::math::lgamma(th1) + + boost::math::lgamma(static_cast(theta + mMode)) - + boost::math::lgamma(static_cast(th2 + mMode)) + + boost::math::lgamma(static_cast(theta + kMode)) - + boost::math::lgamma(static_cast(th2 + kMode)) + + boost::math::lgamma(static_cast(th2 + mMode + kMode)) - + boost::math::lgamma(static_cast(theta + mMode + kMode)); + boost::math::beta_distribution BETA( + static_cast( + !(x > 0.0 ? thetaP[0] : thetaP[0] + mMode + kMode)), + static_cast(!(x > 0.0) ? thetaP[1] + mMode + kMode + : thetaP[1])); + double100 density = 0.0, eC = BridgeDenom(x, z, y, s, t, o), + threshold = max(exp(log(qmmode) + log(qkmode) + gammaratios + + log(pdf(BETA, y)) - log(eC)) * + 1.0e-6, + 1.0e-50); + + int m = mMode, mFlip = 1, mD = 0, mU = 0; + bool mSwitch = false, mDownSwitch = false, mUpSwitch = false; + double100 constContr = + static_cast(thetaP[0] - 1.0) * log(y) + + static_cast(thetaP[1] - 1.0) * log(1.0 - y) + + (!(x > 0.0) + ? -2.0 * boost::math::lgamma(static_cast(thetaP[0])) + : -2.0 * boost::math::lgamma(static_cast(thetaP[1]))); + double100 mContr_D = + boost::math::lgamma(static_cast(thetaP[0] + thetaP[1] + m)) + + (!(x > 0.0) + ? -boost::math::lgamma(static_cast(thetaP[1] + m)) + + static_cast(m) * log(1.0 - y) + : -boost::math::lgamma(static_cast(thetaP[0] + m)) + + static_cast(m) * log(y)); + double100 mContr_U = mContr_D, mContr; /// Contributions from m + + while (!mSwitch) { + double100 qm = QmApprox(m, s, o); + if (m != mMode) { + if (mU > mD) { + mContr_U += + log(static_cast(thetaP[0] + thetaP[1] + (m - 1))) + + (!(x > 0.0) + ? -log(static_cast(thetaP[1] + (m - 1))) + + log(1.0 - y) + : -log(static_cast(thetaP[0] + (m - 1))) + log(y)); + mContr = log(qm) + mContr_U; + } else { + mContr_D += + (!(x > 0.0) ? log(static_cast(thetaP[1] + (m + 1) - 1)) - + log(1.0 - y) + : log(static_cast(thetaP[0] + (m + 1) - 1)) - + log(y)) - + log(static_cast(thetaP[0] + thetaP[1] + (m + 1) - 1)); + mContr = log(qm) + mContr_D; + } + } else { + mContr = log(qm) + mContr_U; + } + + int k = kMode, kFlip = 1, kD = 0, kU = 0; + bool kSwitch = false, kDownSwitch = false, kUpSwitch = false; + double100 kContr_D = + (boost::math::lgamma( + static_cast(thetaP[0] + thetaP[1] + k)) + + (!(x > 0.0) + ? -boost::math::lgamma(static_cast(thetaP[1] + k)) + + static_cast(k) * log(1.0 - y) + : -boost::math::lgamma(static_cast(thetaP[0] + k)) + + static_cast(k) * log(y))); + double100 kContr_U = kContr_D, kContr; /// Contributions from k + + while (!kSwitch) { + double100 qk = QmApprox(k, t - s, o); + if (k != kMode) { + if (kU > kD) { + kContr_U += + log(static_cast(thetaP[0] + thetaP[1] + (k - 1))) + + (!(x > 0.0) + ? log(1.0 - y) - + log(static_cast(thetaP[1] + (k - 1))) + : log(y) - log(static_cast(thetaP[0] + (k - 1)))); + kContr = log(qk) + kContr_U; + } else { + kContr_D += + -log( + static_cast(thetaP[0] + thetaP[1] + (k + 1) - 1)) + + (!(x > 0.0) + ? log(static_cast(thetaP[1] + (k + 1) - 1)) - + log(1.0 - y) + : log(static_cast(thetaP[0] + (k + 1) - 1)) - + log(y)); + kContr = log(qk) + kContr_D; + } + } else { + kContr = log(qk) + kContr_U; + } + + double100 density_inc = + exp(constContr + mContr + kContr - + log(eC)); /// Putting all the separate contributions together + density += density_inc; + + if (!(kDownSwitch)) /// Switching mechanism for k + { + if (sgn(k - kMode) <= 0) { + kDownSwitch = ((density_inc < threshold) || (kMode - kD - 1 < 0)); + } + } + + if (!(kUpSwitch)) { + if (sgn(k - kMode) >= 0) { + kUpSwitch = (density_inc < threshold); + } + } + + kSwitch = (kDownSwitch && kUpSwitch); + + if (!kSwitch) { + if (kFlip == 1) { + kU++; + k = kMode + kU; + kFlip *= (kDownSwitch ? 1 : -1); + } else if ((kFlip == -1) && (kMode - kD - 1 >= 0)) { + kD++; + k = kMode - kD; + kFlip *= (kUpSwitch ? 1 : -1); + } + } + } + + if (!(mDownSwitch)) /// Switching mechanism for m + { + if (sgn(m - mMode) <= 0) { + mDownSwitch = (((kU == 0) && (kD == 0)) || (mMode - mD - 1 < 0)); + } + } + + if (!(mUpSwitch)) { + if (sgn(m - mMode) >= 0) { + mUpSwitch = ((kU == 0) && (kD == 0)); + } + } + + mSwitch = (mDownSwitch && mUpSwitch); + + if (!mSwitch) { + if (mFlip == 1) { + mU++; + m = mMode + mU; + mFlip *= (mDownSwitch ? 1 : -1); + } else if ((mFlip == -1) && (mMode - mD - 1 >= 0)) { + mD++; + m = mMode - mD; + mFlip *= (mUpSwitch ? 1 : -1); + } + } + } + assert(density >= 0.0); + + return density; +} + +double100 WrightFisher::ComputeDensity4( + double100 x, double100 z, double100 y, double100 s, double100 t, + const Options + &o) /// Compute bridge density when x,z in {0,1}, x!=z (any theta!) +{ + assert((x >= 0.0) && (x <= 1.0) && (y >= 0.0) && (y <= 1.0) && (z >= 0.0) && + (z <= 1.0) && (t > 0.0) && (s > 0.0) && (s < t)); + if (!(y > 0.0) || !(y < 1.0)) { + return 0.0; + } + + vector modeGuess = mkModeFinder(x, z, s, t, o); /// Find mode over (m,k) + int mMode = modeGuess[0], + kMode = modeGuess[1]; /// Use together with eC to get suitable threshold + double100 qmmode = max(1.0e-300, QmApprox(mMode, s, o)), + qkmode = max(1.0e-300, QmApprox(kMode, t - s, o)); + double100 gammaratios = + -boost::math::lgamma(static_cast(thetaP[0])) - + boost::math::lgamma(static_cast(thetaP[1])) + + boost::math::lgamma(static_cast(theta + mMode)) + + boost::math::lgamma(static_cast(theta + kMode)) - + boost::math::lgamma(static_cast(theta + mMode + kMode)); + boost::math::beta_distribution BETA( + static_cast( + !(x > 0.0 ? thetaP[0] + kMode : thetaP[0] + mMode)), + static_cast(!(x > 0.0) ? thetaP[1] + mMode + : thetaP[1] + mMode)); + double100 density = 0.0, eC = BridgeDenom(x, z, y, s, t, o), + threshold = max(exp(log(qmmode) + log(qkmode) + gammaratios + + log(pdf(BETA, y)) - log(eC)) * + 1.0e-6, + 1.0e-50); + + int m = mMode, mFlip = 1, mD = 0, mU = 0; + bool mSwitch = false, mDownSwitch = false, mUpSwitch = false; + double100 constContr = + static_cast(thetaP[0] - 1.0) * log(y) + + static_cast(thetaP[1] - 1.0) * log(1.0 - y) - + (boost::math::lgamma(static_cast(thetaP[0])) + + boost::math::lgamma(static_cast(thetaP[1]))); + double100 mContr_D = + boost::math::lgamma(static_cast(theta + m)) + + (!(x > 0.0) + ? -boost::math::lgamma(static_cast(thetaP[1] + m)) + + static_cast(m) * log(1.0 - y) + : -boost::math::lgamma(static_cast(thetaP[0] + m)) + + static_cast(m) * log(y)); + double100 mContr_U = mContr_D, mContr; /// Contributions from m + + while (!mSwitch) { + double100 qm = QmApprox(m, s, o); + if (m != mMode) { + if (mU > mD) { + mContr_U += + log(static_cast(theta + (m - 1))) + + (!(x > 0.0) + ? -log(static_cast(thetaP[1] + (m - 1))) + + log(1.0 - y) + : -log(static_cast(thetaP[0] + (m - 1))) + log(y)); + mContr = log(qm) + mContr_U; + } else { + mContr_D += + (!(x > 0.0) ? log(static_cast(thetaP[1] + (m + 1) - 1)) - + log(1.0 - y) + : log(static_cast(thetaP[0] + (m + 1) - 1)) - + log(y)) - + log(static_cast(theta + (m + 1) - 1)); + mContr = log(qm) + mContr_D; + } + } else { + mContr = log(qm) + mContr_U; + } + + int k = kMode, kFlip = 1, kD = 0, kU = 0; + bool kSwitch = false, kDownSwitch = false, kUpSwitch = false; + double100 kContr_D = + (boost::math::lgamma(static_cast(theta + k)) + + (!(x > 0.0) + ? -boost::math::lgamma(static_cast(thetaP[0] + k)) + + static_cast(k) * log(y) + : -boost::math::lgamma(static_cast(thetaP[1] + k)) + + static_cast(k) * log(1.0 - y))); + double100 kContr_U = kContr_D, kContr; /// Contributions from k + + while (!kSwitch) { + double100 qk = QmApprox(k, t - s, o); + if (k != kMode) { + if (kU > kD) { + kContr_U += + log(static_cast(theta + (k - 1))) + + (!(x > 0.0) + ? log(y) - log(static_cast(thetaP[0] + (k - 1))) + : log(1.0 - y) - + log(static_cast(thetaP[1] + (k - 1)))); + kContr = log(qk) + kContr_U; + } else { + kContr_D += + -log(static_cast(theta + (k + 1) - 1)) + + (!(x > 0.0) + ? log(static_cast(thetaP[0] + (k + 1) - 1)) - + log(y) + : log(static_cast(thetaP[1] + (k + 1) - 1)) - + log(1.0 - y)); + kContr = log(qk) + kContr_D; + } + } else { + kContr = log(qk) + kContr_U; + } + + double100 density_inc = + exp(constContr + mContr + kContr - + log(eC)); /// Putting all separate contributions together + density += density_inc; + + if (!(kDownSwitch)) /// Switching mechanism for k + { + if (sgn(k - kMode) <= 0) { + kDownSwitch = ((density_inc < threshold) || (kMode - kD - 1 < 0)); + } + } + + if (!(kUpSwitch)) { + if (sgn(k - kMode) >= 0) { + kUpSwitch = (density_inc < threshold); + } + } + + kSwitch = (kDownSwitch && kUpSwitch); + + if (!kSwitch) { + if (kFlip == 1) { + kU++; + k = kMode + kU; + kFlip *= (kDownSwitch ? 1 : -1); + } else if ((kFlip == -1) && (kMode - kD - 1 >= 0)) { + kD++; + k = kMode - kD; + kFlip *= (kUpSwitch ? 1 : -1); + } + } + } + + if (!(mDownSwitch)) /// Switching mechanism for m + { + if (sgn(m - mMode) <= 0) { + mDownSwitch = (((kU == 0) && (kD == 0)) || (mMode - mD - 1 < 0)); + } + } + + if (!(mUpSwitch)) { + if (sgn(m - mMode) >= 0) { + mUpSwitch = ((kU == 0) && (kD == 0)); + } + } + + mSwitch = (mDownSwitch && mUpSwitch); + + if (!mSwitch) { + if (mFlip == 1) { + mU++; + m = mMode + mU; + mFlip *= (mDownSwitch ? 1 : -1); + } else if ((mFlip == -1) && (mMode - mD - 1 >= 0)) { + mD++; + m = mMode - mD; + mFlip *= (mUpSwitch ? 1 : -1); + } + } + } + assert(density >= 0.0); + + return density; +} + +double100 WrightFisher::BridgeDensity( + double100 x, double100 z, double100 y, double100 s, double100 t, + const Options &o) /// Function to determine which case from the above + /// computeDensity to invoke +{ + assert((x >= 0.0) && (x <= 1.0) && (y >= 0.0) && (y <= 1.0) && (z >= 0.0) && + (z <= 1.0) && (t > 0.0) && (s > 0.0) && (s < t)); + + if ((x > 0.0) && (x < 1.0) && (z > 0.0) && (z < 1.0)) /// x,z in (0,1) + { + return ComputeDensity1(x, z, y, s, t, o); + } else if ((x > 0.0) && (x < 1.0)) /// x in (0,1), z in {0,1} + { + return ComputeDensity2(z, x, y, t - s, t, + o); /// Equivalent to a reverse bridge going from z + /// to y in time t-s and ending at x at time t + } else if ((z > 0.0) && (z < 1.0)) /// x in {0,1}, z in (0,1) + { + return ComputeDensity2(x, z, y, s, t, o); + } else if (x == z) /// x,z in {0,1}, x=z + { + return ComputeDensity3(x, z, y, s, t, o); + } else /// x,z in {0,1}, x!=z + { + return ComputeDensity4(x, z, y, s, t, o); + } +} + +double100 WrightFisher::LogSumExp( + vector &vecProb, + double100 maxProb) /// Routine to perform log-sum-exp trick +{ + double100 sumexp = 0.0; + for (vector::iterator vPi = vecProb.begin(); vPi != vecProb.end(); + vPi++) { + sumexp += exp(*vPi - maxProb); + } + for (vector::iterator vPi = vecProb.begin(); vPi != vecProb.end(); + vPi++) { + *vPi -= maxProb + log(sumexp); + *vPi = exp(*vPi); + } + + return exp(maxProb + log(sumexp)); +} + +/// DIFFUSION SIMULATION - NEUTRAL PATHS + +pair WrightFisher::DrawAncestralProcess( + double100 t, const Options &o, + boost::random::mt19937 &gen) /// Draws from the law of the Ancestral Process + /// using upper and lower sums +{ + assert(t > 0.0); + /// Pre-computing all necessary quantities + int mup = -1, mdown = 0, mmode = GriffithsParas(t).first, m = -1; + bool m_found = false; + + /// Setting up all the necessary quantities + boost::random::uniform_01 U01; + double100 u = U01(gen), currsumU = 0.0, currsumL = 0.0; + map dL, dU; + map n_used; + + int threshold = ((thetaP.empty()) ? 1 : 0); + + while (!m_found) { + if (mup > mdown && + mmode - mdown > + threshold) /// Checking if down moves still possible - ensures we do + /// not get m smaller than it should be allowed! + { + ++mdown; + m = mmode - mdown; + } else /// Up moves can keep happening + { + ++mup; + m = mmode + mup; + } + assert(m >= 0); + + int n = m - 2; + bool coefficients_converging = false; + dU.insert(make_pair(m, 0.0)); + dL.insert(make_pair(m, 0.0)); + + while (n < 1 || !coefficients_converging || + ((dU[m]) > 1.0 && + dL[m] < 0.0)) /// Checking if upper and lower sums converging + { + n += 2; + double100 newcoefficientU = + (((n - m) % 2 != 0) ? -1.0 : 1.0) * + exp(Getlogakm(n, m) + + static_cast(-n * (n + theta - 1) * t / 2.0)); + double100 newcoefficientL = + (((n + 1 - m) % 2 != 0) ? -1.0 : 1.0) * + exp(Getlogakm(n + 1, m) + + static_cast(-(n + 1) * ((n + 1) + theta - 1) * t / + 2.0)); + + if (o.debug > 2) { + cerr << setprecision(0) << n << " newcoeffU " << setprecision(50) + << newcoefficientU << "\n" + << n + 1 << " newcoeffL " << newcoefficientL << endl; + } + + dU[m] = dL[m] + newcoefficientU; + dL[m] = dU[m] + newcoefficientL; + + coefficients_converging = (newcoefficientU + newcoefficientL >= 0.0); + + if (o.debug > 2) { + cerr << "\nk "; + for (int k = mmode - mdown; k <= mmode + mup; ++k) + cerr << k << " "; + cerr << "\ndL "; + for (int k = mmode - mdown; k <= mmode + mup; ++k) + cerr << dL[k] << " "; + cerr << "\ndU "; + for (int k = mmode - mdown; k <= mmode + mup; ++k) + cerr << dU[k] << " "; + cerr << endl; + } + } + + if (dL[m] > 1.0 || + dU[m] < 0.0) /// If we fall out of bounds, use Gaussian approximations + { + cerr << "Numerical error detected: dL[" << m << "] = " << dL[m] << ", dU[" + << m << "] = " << dU[m] + << ". Resorting to G1984 approximation (t = " << t << ") ..." + << endl; + return make_pair(DrawAncestralProcessG1984(t, gen), -1); + } + + currsumL += dL[m]; + currsumU += dU[m]; + + if (currsumL > currsumU) { + cerr << "Error: currsumL = " << currsumL << " > " << currsumU + << " = currsumU." << endl; + exit(1); + } + + n_used.insert(make_pair(m, n + 1)); + + bool decision_on_m_made = (currsumL > u || currsumU < u); + + while (!decision_on_m_made) /// We need to refine our upper and lower bounds + { + double100 currsumLold = currsumL, currsumUold = currsumU; + currsumL = 0.0; + currsumU = 0.0; + + for (int k = mmode - mdown; k <= mmode + mup; ++k) { + ++n_used[k]; + dU[k] = dL[k] + + (((n_used[k] - k) % 2 != 0) ? -1.0 : 1.0) * + exp(Getlogakm(n_used[k], k) + + static_cast( + -n_used[k] * (n_used[k] + theta - 1) * t / 2.0)); + + ++n_used[k]; + dL[k] = dU[k] + + (((n_used[k] - k) % 2 != 0) ? -1.0 : 1.0) * + exp(Getlogakm(n_used[k], k) + + static_cast( + -n_used[k] * (n_used[k] + theta - 1) * t / 2.0)); + + currsumL += dL[k]; + currsumU += dU[k]; + + if (currsumL > currsumU) { + cerr << "Error: currsumL = " << currsumL << " > " << currsumU + << " = currsumU." << endl; + exit(1); + } + } + + if (currsumLold > currsumL) { + cerr << "Error: currsumLold = " << currsumLold << " > " << currsumL + << " = currsumL." << endl; + exit(1); + } + if (currsumUold < currsumU) { + cerr << "Error: currsumUold = " << currsumUold << " < " << currsumU + << " = currsumU." << endl; + exit(1); + } + + decision_on_m_made = (currsumL > u || currsumU < u); + } + + m_found = (currsumL > u); + } + + int coeffcount = 0; + for (int k = mmode - mdown; k <= mmode + mup; ++k) + coeffcount += (n_used[k] - k + 1); + + if (o.debug > 2) { + cerr << "d_m(t): Returned m = " << m << "\n"; + cerr << "m =\t\t\t"; + for (int k = mmode - mdown; k <= mmode + mup; ++k) + cerr << k << "\t"; + cerr << "\nn_used =\t"; + for (int k = mmode - mdown; k <= mmode + mup; ++k) + cerr << n_used[k] << "\t"; + + cerr << "Coeffcount = " << coeffcount << endl; + } + return make_pair(m, coeffcount); +} + +pair WrightFisher::DrawAncestralProcessConditionalZero( + double100 t, const Options &o, + boost::random::mt19937 + &gen) /// Draws from the law of the Ancestral Process when conditioning + /// the diffusion on non-absorption but started from boundary +{ + assert(t > 0.0); + /// Pre-computing all necessary quantities + int mup = -1, mdown = 0, + mmode = static_cast(round(GriffithsParas(t).first)), m = -1, + eCindex_computed = 0, q1index = 0; + bool m_found = false; + + /// Setting up the necessary quantities + boost::random::uniform_01 U01; + double100 u = U01(gen), currsumU = 0.0, currsumL = 0.0, eCL = 0.0, eCU, + q1L = 0.0, q1U = 0.0; + double100 eCnew = (thetaP.empty() + ? 1.0 + : static_cast((theta + 1.0)) * + exp(-t * static_cast(theta) * 0.5)), + consForD = (thetaP.empty()) ? 3.0 : 5.0; + map eAL, eAU, dL, dU; + map n_used, v_used; + + int threshold = ((thetaP.empty()) ? 2 : 1); + + while (!m_found) { + if (mup > mdown && + mmode - mdown > + threshold) /// Checking whether down moves still allow - makes sure + /// m does not go below allowed values + { + ++mdown; + m = mmode - mdown; + } else /// Otherwise move upwards, which is always allowed + { + ++mup; + m = max(mmode + mup, threshold); + } + assert(m >= threshold); + + int n = m - 2, v = 0, n1 = -1; + bool coefficients_converging = false; + dU.insert(make_pair(m, 0.0)); + dL.insert(make_pair(m, 0.0)); + eAU.insert(make_pair(m, 0.0)); + eAL.insert(make_pair(m, 0.0)); + /// Computing quantities beyond which upper and lower bounds converge + /// theoretically + pair, double100> Ct; + Ct.second = t; + int F1 = computeC(m, Ct), + F2 = static_cast( + ceil(max(0.0, 1.0 / static_cast(t) - (theta + 1.0) / 2.0))), + F3 = static_cast(ceil((log(consForD) / t) - (theta / 2.0))); + while ((theta + static_cast(2 * F2 + 1)) * + exp(-(static_cast(2 * F2) + theta) * + static_cast(t) / 2.0) >= + 1 - o.eps) + ++F2; + int F = max(F1, F2) + 1; + + while (n < F || v < F3 || !coefficients_converging || + ((dU[m]) > 1.0 && + dL[m] < 0.0)) /// Checking if upper and lower sums converging + { + n += 2; + n1 += 2; + v++; + double100 newcoefficientU = + (((n - m) % 2 != 0) ? -1.0 : 1.0) * + exp(Getlogakm(n, m) + + static_cast(-n * (n + theta - 1) * t / 2.0)); + double100 newcoefficientL = + (((n + 1 - m) % 2 != 0) ? -1.0 : 1.0) * + exp(Getlogakm(n + 1, m) + + static_cast(-(n + 1) * ((n + 1) + theta - 1) * t / + 2.0)); + + if ((thetaP.empty()) && + (2 * (n1 + 1) > + q1index)) /// If mutation vector is empty, we need to subtract q_1 + /// from normalising constant (because m can only be >= 2) + { + double100 newcoefficientUq1 = + (((n1 - 1) % 2 != 0) ? -1.0 : 1.0) * + exp(Getlogakm(n1, 1) + + static_cast(-n1 * (n1 + theta - 1) * t / + 2.0)), + newcoefficientLq1 = + ((n1 % 2 != 0) ? -1.0 : 1.0) * + exp(Getlogakm(n1 + 1, 1) + + static_cast( + -(n1 + 1) * ((n1 + 1) + theta - 1) * t / 2.0)); + q1U = q1L + newcoefficientUq1; + q1L = q1U + newcoefficientLq1; + q1index += 2; + } + + if ((v + 1) > + eCindex_computed) /// Computing the denominator by using explicit + /// expression for falling factorial moments of + /// ancestral process and subtracting q_1 + { + eCL += eCnew; + eCnew = exp(static_cast(-(v + 1) * (v + theta) * t / 2.0) + + log(static_cast(2 * (v + 1) + theta - 1))); + eCU = eCL + (eCnew / (1.0 - consForD * exp(-static_cast( + v + 1 + (theta / 2.0)) * + t))); + eCindex_computed += 1; + } + + if (o.debug > 2) { + cerr << setprecision(0) << n << " newcoeffU " << setprecision(50) + << newcoefficientU << "\n" + << n + 1 << " newcoeffL " << newcoefficientL << endl; + } + + eAU[m] = eAL[m] + newcoefficientU; + eAL[m] = eAU[m] + newcoefficientL; + + coefficients_converging = (newcoefficientU + newcoefficientL >= 0.0); + + if (o.debug > 2) { + cerr << "\nk "; + for (int k = mmode - mdown; k <= mmode + mup; ++k) + cerr << k << " "; + cerr << "\ndL "; + for (int k = mmode - mdown; k <= mmode + mup; ++k) + cerr << dL[k] << " "; + cerr << "\ndU "; + for (int k = mmode - mdown; k <= mmode + mup; ++k) + cerr << dU[k] << " "; + cerr << endl; + } + } + + if (eAL[m] < 0.0 || + eCL < 0.0) /// If we fall out of bounds, use Gaussian approximations + { + cerr << "Numerical error detected: eAL[" << m << "] = " << eAL[m] + << ", eAU[" << m << "] = " << eAU[m] << ", eCL = " << eCL + << ", eCU = " << eCU + << ". Resorting to G1984 approximation (t = " << t << ") ..." + << endl; + return make_pair(DrawAncestralProcessG1984(t, gen), -1); + } + + dU[m] = + ((!(eAU[m] > 0.0) || eCL < 0.0 || eCL < q1U) + ? static_cast(nan("")) + : exp(log(static_cast(m)) + log(eAU[m])) / (eCL - q1U)); + dL[m] = + ((!(eAL[m] > 0.0) || eCU < q1L) + ? static_cast(0.0) + : exp(log(static_cast(m)) + log(eAL[m])) / (eCU - q1L)); + + currsumL += dL[m]; + currsumU += dU[m]; + + if (currsumL > currsumU) { + cerr << "Error: currsumL = " << currsumL << " > " << currsumU + << " = currsumU." << endl; + exit(1); + } + + n_used.insert(make_pair(m, n + 1)); + v_used.insert(make_pair(m, v)); + + bool decision_on_m_made = (currsumL > u || currsumU < u); + + while (!decision_on_m_made) /// Refine upper and lower bounds + { + double100 currsumLold = currsumL, currsumUold = currsumU; + currsumL = 0.0; + currsumU = 0.0; + + for (int k = max(mmode, threshold) - mdown; + k <= max(mmode, threshold) + mup; ++k) { + ++n_used[k]; + ++v_used[k]; /// Adding on more contributions to sharpen bounds + + if (thetaP.empty() && ((n_used[k] + 1) > q1index)) { + double100 newcoefficientUq1 = + (((n_used[k] - 1) % 2 != 0) ? -1.0 : 1.0) * + exp(Getlogakm(n_used[k], 1) + + static_cast(-n_used[k] * + (n_used[k] + theta - 1) * t / + 2.0)), + newcoefficientLq1 = + (((n_used[k]) % 2 != 0) ? -1.0 : 1.0) * + exp(Getlogakm(n_used[k] + 1, 1) + + static_cast( + -(n_used[k] + 1) * + ((n_used[k] + 1) + theta - 1) * t / 2.0)); + q1U = q1L + newcoefficientUq1; + q1L = q1U + newcoefficientLq1; + } + + if ((v_used[k] + 1) > eCindex_computed) { + eCL += eCnew; + eCnew = + exp(static_cast(-(v_used[k] + 2) * + (v_used[k] + theta + 1) * t / 2.0) + + log(static_cast(2 * (v_used[k] + 2) + theta - 1))); + eCU = eCL + (eCnew / + (1.0 - consForD * exp(-static_cast( + v_used[k] + 2 + theta / 2.0) * + t))); + eCindex_computed += 1; + } + + eAU[k] += (((n_used[k] - k) % 2 != 0) ? -1.0 : 1.0) * + exp(Getlogakm(n_used[k], k) + + static_cast( + -n_used[k] * (n_used[k] + theta - 1) * t / 2.0)); + ++n_used[k]; + eAL[k] += (((n_used[k] - k) % 2 != 0) ? -1.0 : 1.0) * + exp(Getlogakm(n_used[k], k) + + static_cast( + -n_used[k] * (n_used[k] + theta - 1) * t / 2.0)); + + dU[k] = ((eCL < 0.0 || !(eAU[k] > 0.0) || eCL < q1U) + ? static_cast(nan("")) + : exp(log(static_cast(k)) + log(eAU[k])) / + (eCL - q1U)); + dL[k] = ((eAL[k] < 0.0 || eCU < q1L) + ? static_cast(0.0) + : exp(log(static_cast(k)) + log(eAL[k])) / + (eCU - q1L)); + + currsumL += dL[k]; + currsumU += dU[k]; + + if (currsumL > currsumU) { + cerr << "Error: currsumL = " << currsumL << " > " << currsumU + << " = currsumU." << endl; + exit(1); + } + } + + if (currsumLold > currsumL) { + cerr << "Error: currsumLold = " << currsumLold << " > " << currsumL + << " = currsumL." << endl; + exit(1); + } + if (currsumUold < currsumU) { + cerr << "Error: currsumUold = " << currsumUold << " < " << currsumU + << " = currsumU." << endl; + exit(1); + } + + decision_on_m_made = (currsumL > u || currsumU < u); + } + + m_found = (currsumL > u); + } + + int coeffcount = 0; + for (int k = max(mmode, threshold) - mdown; k <= max(mmode, threshold) + mup; + ++k) + coeffcount += (n_used[k] - k + 1); + + if (o.debug > 2) { + cerr << "d_m(t): Returned m = " << m << "\n"; + cerr << "m =\t\t\t"; + for (int k = max(mmode, threshold) - mdown; + k <= max(mmode, threshold) + mup; ++k) + cerr << k << "\t"; + cerr << "\nn_used =\t"; + for (int k = max(mmode, threshold) - mdown; + k <= max(mmode, threshold) + mup; ++k) + cerr << n_used[k] << "\t"; + + cerr << "Coeffcount = " << coeffcount << endl; + } + return make_pair(m, coeffcount); +} + +pair, int> WrightFisher::DrawAncestralProcessConditionalInterior( + double100 t, double100 x, const Options &o, + boost::random::mt19937 + &gen) /// Draws from the law of the Ancestral Process when conditioning + /// the diffusion on non-absorption but started from inside (0,1) +{ + assert((x > 0.0) && (x <= 1.0) && (t > 0.0)); + /// Pre-computing all necessary quantities + int mup = -1, mdown = 0, + mmode = static_cast(round(GriffithsParas(t).first)), m = -1, + eCindex_computed = 0, lstore; + bool ml_found = false; + + /// Setting up all the necessary quantities + boost::random::uniform_01 U01; + double100 u = U01(gen); + vector eCvec; + double100 currsumU = 0.0, currsumL = 0.0, eCL = 0.0, + eCU = Getd2(eCvec, 0, x, t); + map eAL, eAU, dL, dU; + + map n_used, v_used; + + int threshold = ((thetaP.empty()) ? 2 : 1); + + while (!ml_found) { + if (mup > mdown && + mmode - mdown > + threshold) /// Checking whether down moves are still possible + { + ++mdown; + m = mmode - mdown; + } else /// If not, upward moves are always allowed + { + ++mup; + m = max(mmode + mup, threshold); + } + + int n = m - 2; + bool coefficients_converging = false; + int v = -1; + dU.insert(make_pair(m, 0.0)); + dL.insert(make_pair(m, 0.0)); + eAU.insert(make_pair(m, 0.0)); + eAL.insert(make_pair(m, 0.0)); + /// Compute F ensuring that theoretically upper and lower bounds converge + pair, double100> Ct; + Ct.second = t; + int F1 = computeC(m, Ct), + F2 = static_cast( + ceil(max(0.0, 1.0 / static_cast(t) - (theta + 1.0) / 2.0))), + F3 = static_cast(ceil((log(3.0) / t) - (theta / 2.0))); + while ((theta + static_cast(2 * F2 + 1)) * + exp(-(static_cast(2 * F2) + theta) * + static_cast(t) / 2.0) >= + 1 - o.eps) + ++F2; + int F = max(F1, max(F2, F3)) + 1; + + while (2 * v < F || n < F || !coefficients_converging || + ((dU[m]) > 1.0 && + dL[m] < 0.0)) /// Checking if upper and lower sums converging + { + n += 2; + v++; /// Adding on new contributions for numerator + double100 newcoefficientU = + (((n - m) % 2 != 0) ? -1.0 : 1.0) * + exp(Getlogakm(n, m) + + static_cast(-n * (n + theta - 1) * t / 2.0)), + newcoefficientL = + (((n + 1 - m) % 2 != 0) ? -1.0 : 1.0) * + exp(Getlogakm(n + 1, m) + + static_cast( + -(n + 1) * ((n + 1) + theta - 1) * t / 2.0)); + + if (2 * (v + 1) > eCindex_computed) /// Computing denominator + { + assert(2 * v == eCindex_computed); + eCL = eCU - Getd2(eCvec, 2 * v + 1, x, t); + eCU = eCL + Getd2(eCvec, 2 * v + 2, x, t); + eCindex_computed += 2; + } + + if (o.debug > 2) { + cerr << setprecision(0) << n << " newcoeffU " << setprecision(50) + << newcoefficientU << "\n" + << n + 1 << " newcoeffL " << newcoefficientL << endl; + } + + eAU[m] = eAL[m] + newcoefficientU; + eAL[m] = eAU[m] + newcoefficientL; + + coefficients_converging = (newcoefficientU + newcoefficientL >= 0.0); + + if (o.debug > 2) { + cerr << "\nk "; + for (int k = max(mmode, threshold) - mdown; + k <= max(mmode, threshold) + mup; ++k) + cerr << k << " "; + cerr << "\ndL "; + for (int k = max(mmode, threshold) - mdown; + k <= max(mmode, threshold) + mup; ++k) + cerr << dL[k] << " "; + cerr << "\ndU "; + for (int k = max(mmode, threshold) - mdown; + k <= max(mmode, threshold) + mup; ++k) + cerr << dU[k] << " "; + cerr << endl; + } + } + + if (eAL[m] < 0.0 || + eCL < 0.0) /// If we fall out of bounds, use Gaussian approximations + { + cerr << "Numerical error detected: eAL[" << m << "] = " << eAL[m] + << ", eAU[" << m << "] = " << eAU[m] << ", eCL = " << eCL + << ", eCU = " << eCU + << ". Resorting to G1984 approximation (t = " << t << ") ..." + << endl; + m = DrawAncestralProcessG1984(t, gen); + vector binomialBins; + boost::math::binomial_distribution BINOMIAL(m, x); + int mlimit = (threshold == 2) ? m - 1 : m; + for (int k = 1; k <= mlimit; ++k) { + binomialBins.push_back(pdf(BINOMIAL, k)); + } + boost::random::discrete_distribution<> CATEGORICAL(binomialBins.begin(), + binomialBins.end()); + int l = CATEGORICAL(gen) + 1; + + return make_pair(make_pair(m, l), -1); + } + + dU[m] = (eCL < 0.0 ? static_cast(nan("")) : eAU[m] / eCL); + dL[m] = (eAL[m] < 0.0 ? static_cast(0.0) : eAL[m] / eCU); + + int llimit = (threshold == 2) ? m - 1 : m; + boost::math::binomial_distribution BIN(m, x); + for (int l = 1; l <= llimit && !ml_found; + ++l) /// Adding on the corresponding binomial terms (minus the edge + /// cases i.e. l=0 and potentially l=m (depending on theta)) + { + double100 currsummaddon = + pdf(BIN, l); //( ( !(x < 1.0) || !(x > 0.0) ) ? 1.0 : pdf(BIN,l) ); + currsumL += currsummaddon * dL[m]; + currsumU += currsummaddon * dU[m]; + + bool decision_on_ml_made = (currsumL > u || currsumU < u); + + if (currsumL > currsumU) { + cerr << "Error: currsumL = " << currsumL << " > " << currsumU + << " = currsumU (n,m,l) = (" << n << "," << m << "," << l << ")." + << endl; + exit(1); + } + + while (!decision_on_ml_made) /// Refine upper and lower bounds + { + double100 currsumLold = currsumL, currsumUold = currsumU; + currsumL = 0.0; + currsumU = 0.0; + + const map dUold(dU), dLold(dL); + for (int k = max(mmode, threshold) - mdown; + k <= max(mmode, threshold) + mup; ++k) { + ++v_used[k]; + ++n_used[k]; /// Adding on new contributions to sharpen bounds + double100 newcoefficientU = + exp(Getlogakm(k + 2 * n_used[k], k) + + static_cast( + -(k + 2 * v_used[k]) * + (k + 2 * n_used[k] + theta - 1) * t / 2.0)), + newcoefficientL = + exp(Getlogakm(k + 2 * n_used[k] + 1, k) + + static_cast( + -(k + 2 * n_used[k] + 1) * + (k + 2 * n_used[k] + 1 + theta - 1) * t / 2.0)); + + eAU[k] = eAL[k] + newcoefficientU; + eAL[k] = eAU[k] - newcoefficientL; + + if (2 * v_used[k] + 2 > eCindex_computed) { + assert(2 * v_used[k] == eCindex_computed); + eCL = eCU - Getd2(eCvec, 2 * v_used[k] + 1, x, t); + eCU = eCL + Getd2(eCvec, 2 * v_used[k] + 2, x, t); + eCindex_computed += 2; + } + + dU[k] = (eCL < 0.0 ? static_cast(nan("")) : eAU[k] / eCL); + dL[k] = (eAL[k] < 0.0 ? static_cast(0.0) : eAL[k] / eCU); + + int l1limit = (threshold == 2) ? k - 1 : k; + boost::math::binomial_distribution BIN2(k, x); + for (int l1 = 1; l1 <= l1limit; ++l1) { + double100 addon = + ((!(x < 1.0) || !(x > 0.0)) ? 1.0 : pdf(BIN2, l1)); + currsumL += addon * dL[k]; + currsumU += addon * dU[k]; + } + + if (currsumL > currsumU) { + cerr << "Error: currsumL = " << currsumL << " > " << currsumU + << " = currsumU (n,m,l) = (" << n << "," << m << "," << l + << ")." << endl; + exit(1); + } + } + + if (currsumLold > currsumL) { + cerr << "Error: currsumLold = " << currsumLold << " > " << currsumL + << " = currsumL (n,m,l) = (" << n << "," << m << "," << l << ")." + << endl; + exit(1); + } + if (currsumUold < currsumU) { + cerr << "Error: currsumUold = " << currsumUold << " < " << currsumU + << " = currsumU (n,m,l) = (" << n << "," << m << "," << l << ")." + << endl; + exit(1); + } + + decision_on_ml_made = (currsumL > u || currsumU < u); + } + + ml_found = (currsumL > u); + { lstore = l; } + } + } + + int coeffcount = 0; + for (int k = max(mmode, threshold) - mdown; k <= max(mmode, threshold) + mup; + ++k) + coeffcount += (n_used[k] - k + 1); + + if (o.debug > 2) { + cerr << "d_m(t): Returned m = " << m << "\n"; + cerr << "m =\t\t\t"; + for (int k = max(mmode, threshold) - mdown; + k <= max(mmode, threshold) + mup; ++k) + cerr << k << "\t"; + cerr << "\nn_used =\t"; + for (int k = max(mmode, threshold) - mdown; + k <= max(mmode, threshold) + mup; ++k) + cerr << n_used[k] << "\t"; + + cerr << "Coeffcount = " << coeffcount << endl; + } + return make_pair(make_pair(m, lstore), coeffcount); +} + +int WrightFisher::DrawAncestralProcessG1984( + double100 t, + boost::random::mt19937 &gen) /// Draws from the law of the Ancestral Process + /// when time increment falls below threshold +{ + assert(t > 0.0); + int threshold = + (thetaP.empty() ? 2 : (!(thetaP[0] > 0.0) || !(thetaP[1] > 0.0)) ? 1 : 0); + /// Pre-compute all necessary quantities + double mean = GriffithsParas(t).first, v = GriffithsParas(t).second; + assert(v > 0.0); + boost::random::normal_distribution NORMAL(mean, sqrt(v)); + return max(static_cast(round(NORMAL(gen))), + threshold); // Return discretised Gaussian approximation +} + +int WrightFisher::DrawSizebiasedAncestralProcess( + int d, double100 t, + boost::random::mt19937 + &gen) /// Draws from the size-biased distribution of the Ancestral + /// process when the time increment falls below threshold +{ + assert((d > 0) && (t > 0.0)); + /// Pre-compute all necessary quantities + double mean = GriffithsParas(t).first, v = GriffithsParas(t).second; + assert(v > 0.0); + /// Normalisation obtained from integral_{0}^{inf} of x*Gaussian pdf(x) dx + double normalisation = + 0.5 * sqrt(v) * + (exp(-pow(mean, 2.0) * 0.5 * (1.0 / v)) * + sqrt(2.0 / boost::math::constants::pi()) + + (mean / sqrt(v)) * (1.0 + boost::math::erf(mean / (sqrt(2.0))))); + + bool decision = false; + int flip = 1, mlimit = thetaP.empty() ? 2 : 1, + mode = static_cast(round(mean)), m = mode, jp = 0, + jm = 0; /// Starting m from mode to speed up routine + double mlim = static_cast(mlimit) + 0.5, summqm = 0.0; + + boost::random::uniform_01 U01; + double100 u = U01(gen); + + while (!decision) { + if (m == mlimit) /// Computing correct border (i.e. m = 1 or 2) contribution + { + summqm += exp(static_cast(d) * log(static_cast(mlim))) * + 0.5 * + erfc(-(static_cast(mlim) - mean) / (sqrt(2.0 * v))); + } else /// Add on discretised Gaussian contributions + { + summqm += + exp(static_cast(d) * log(static_cast(m))) * 0.5 * + (erfc(-(static_cast(m) + 0.5 - mean) / (sqrt(2.0 * v))) - + erfc(-(static_cast(m) - 0.5 - mean) / (sqrt(2.0 * v)))); + } + if (summqm / normalisation > u) /// Return last m + { + decision = true; + } else { + if (flip == -1 && + (mode - jm > 2)) /// Mechanism to explore either side around mode + { + jm++; + m = mode - jm; + } else { + jp++; + m = mode + jp; + } + flip *= -1; + } + } + assert(m >= mlimit); + + return m; +} + +pair WrightFisher::DrawEndpoint( + double100 x, double100 t1, double100 t2, const Options &o, + boost::random::mt19937 &gen) /// Draws from the law of a Wright-Fisher + /// diffusion conditioned on non-absorption +{ + assert((x >= 0.0) && (x <= 1.0) && (t1 >= 0.0) && (t2 > 0.0) && (t1 < t2)); + double100 y; + int m, coeffcount; + pair m_and_coeffcount; + + if (thetaP.empty()) /// No mutation - condition on avoiding either boundary + { + if (!(x > + 0.0)) /// Diffusion conditioned on non-absorption but started from 0 + { + if (t2 - t1 <= + o.g1984threshold) /// Time increment smaller than threshold, use + /// Gaussian approximations + { + m = DrawSizebiasedAncestralProcess(1, t2 - t1, gen); + coeffcount = -1; + } else /// Otherwise use alternating series technique + { + m_and_coeffcount = DrawAncestralProcessConditionalZero(t2 - t1, o, gen); + m = m_and_coeffcount.first; + coeffcount = m_and_coeffcount.second; + } + + boost::random::gamma_distribution<> GAMMA1(1.0, 1.0), + GAMMA2(static_cast(m) - 1.0, 1.0); + + y = -1.0; + while (!(0.0 < y && y < 1.0)) /// Occasionally get y == 0.0 or y == 1.0 + { + double100 G1 = GAMMA1(gen), G2 = GAMMA2(gen); + y = G1 / (G1 + G2); + } + } else if (!(x < 1.0)) /// Diffusion conditioned on non-absorption but + /// started from 1 + { + if (t2 - t1 <= + o.g1984threshold) /// Time increment smaller than threshold, use + /// Gaussian approximations + { + m = DrawSizebiasedAncestralProcess(1, t2 - t1, gen); + coeffcount = -1; + } else /// Otherwise use alternating series technique + { + m_and_coeffcount = DrawAncestralProcessConditionalZero(t2 - t1, o, gen); + m = m_and_coeffcount.first; + coeffcount = m_and_coeffcount.second; + } + + boost::random::gamma_distribution<> GAMMA1(static_cast(m) - 1.0, + 1.0), + GAMMA2(1.0, 1.0); + + y = -1.0; + while (!(0.0 < y && y < 1.0)) /// Occasionally get y == 0.0 or y == 1.0 + { + double100 G1 = GAMMA1(gen), G2 = GAMMA2(gen); + y = G1 / (G1 + G2); + } + } else /// Diffusion conditioned on non-absorption but started from the + /// interior (0,1) + { + int l; + + if (t2 - t1 <= + o.g1984threshold) /// Time increment smaller than threshold, use + /// Gaussian approximations + { + m = DrawAncestralProcessG1984(t2 - t1, gen); + coeffcount = -1; + vector binomialBins; + boost::math::binomial_distribution BINOMIAL( + m, static_cast(x)); + for (int k = 1; k <= m - 1; ++k) { + binomialBins.push_back(pdf(BINOMIAL, k)); + } + boost::random::discrete_distribution<> CATEGORICAL(binomialBins.begin(), + binomialBins.end()); + l = CATEGORICAL(gen) + 1; + } else /// Otherwise use alternating series technique + { + pair, int> storer = + DrawAncestralProcessConditionalInterior(t2 - t1, x, o, gen); + m = (storer.first).first; + l = (storer.first).second; + coeffcount = storer.second; + } + + boost::random::gamma_distribution<> GAMMA1(static_cast(l), 1.0), + GAMMA2(static_cast(m - l), 1.0); + + y = -1.0; + while (!(0.0 < y && y < 1.0)) /// Occasionally get y == 0.0 or y == 1.0 + { + double100 G1 = GAMMA1(gen), G2 = GAMMA2(gen); + y = G1 / (G1 + G2); + } + } + } else if ((!(thetaP[0] > 0.0)) || + (!(thetaP[1] > 0.0))) /// One sided mutation - condition on + /// avoiding one boundary only + { + if ((!(thetaP[0] > 0.0)) && + (!(x > 0.0))) /// Diffusion conditioned on avoiding 0 but started from 0 + { + if (t2 - t1 <= + o.g1984threshold) /// Time increment smaller than threshold, use + /// Gaussian approximations + { + m = DrawSizebiasedAncestralProcess(1, t2 - t1, gen); + coeffcount = -1; + } else /// Otherwise use alternating series technique + { + m_and_coeffcount = DrawAncestralProcessConditionalZero(t2 - t1, o, gen); + m = m_and_coeffcount.first; + coeffcount = m_and_coeffcount.second; + } + + boost::random::gamma_distribution<> GAMMA1(1.0, 1.0), + GAMMA2(thetaP[1] + static_cast(m) - 1.0, 1.0); + + y = -1.0; + while (!(0.0 < y && y < 1.0)) /// Occasionally get y == 0.0 or y == 1.0 + { + double100 G1 = GAMMA1(gen), G2 = GAMMA2(gen); + y = G1 / (G1 + G2); + } + } else if ((!(thetaP[1] > 0.0)) && + (!(x < 1.0))) /// Diffusion conditioned on avoiding 1 but started + /// from 1 - can translate to diffusion with + /// mutation entries swapped avoiding 0 started + /// from 0 by symmetry + { + iter_swap(thetaP.begin(), thetaP.begin() + 1); /// Swap mutation entries + + if (t2 - t1 <= + o.g1984threshold) /// Time increment smaller than threshold, use + /// Gaussian approximations + { + m = DrawSizebiasedAncestralProcess(1, t2 - t1, gen); + coeffcount = -1; + } else /// Otherwise use alternating series technique + { + m_and_coeffcount = DrawAncestralProcessConditionalZero(t2 - t1, o, gen); + m = m_and_coeffcount.first; + coeffcount = m_and_coeffcount.second; + } + + boost::random::gamma_distribution<> GAMMA1(1.0, 1.0), + GAMMA2(thetaP[1] + static_cast(m) - 1.0, 1.0); + + double100 y1 = -1.0; + while (!(0.0 < y1 && y1 < 1.0)) /// Occasionally get y == 0.0 or y == 1.0 + { + double100 G1 = GAMMA1(gen), G2 = GAMMA2(gen); + y1 = G1 / (G1 + G2); + } + + y = 1.0 - y1; + + iter_swap(thetaP.begin(), + thetaP.begin() + 1); /// Swap back mutation entries + } else if (!(thetaP[1] > + 0.0)) /// Diffusion conditioned on avoiding 1 but started from + /// x in [0,1) - can translate to diffusion with mutation + /// entries swapped avoiding 0 started from 1-x in + /// interior (0,1] by symmetry + { + iter_swap(thetaP.begin(), thetaP.begin() + 1); /// Swap mutation entries + + int l; + + if (t2 - t1 <= + o.g1984threshold) /// Time increment smaller than threshold, use + /// Gaussian approximations + { + m = DrawAncestralProcessG1984(t2 - t1, gen); + coeffcount = -1; + vector binomialBins; + boost::math::binomial_distribution BINOMIAL(m, 1.0 - x); + for (int k = 1; k <= m; ++k) { + binomialBins.push_back(pdf(BINOMIAL, k)); + } + boost::random::discrete_distribution<> CATEGORICAL(binomialBins.begin(), + binomialBins.end()); + l = CATEGORICAL(gen) + 1; + } else /// Otherwise use alternating series technique + { + pair, int> storer = + DrawAncestralProcessConditionalInterior(t2 - t1, 1.0 - x, o, gen); + m = (storer.first).first; + l = (storer.first).second; + coeffcount = storer.second; + } + + boost::random::gamma_distribution<> GAMMA1( + thetaP[0] + static_cast(l), 1.0), + GAMMA2(thetaP[1] + static_cast(m - l), 1.0); + + double100 y1 = -1.0; + while (!(0.0 < y1 && y1 < 1.0)) /// Occasionally get y == 0.0 or y == 1.0 + { + double100 G1 = GAMMA1(gen), G2 = GAMMA2(gen); + y1 = G1 / (G1 + G2); + } + y = 1.0 - y1; + + iter_swap(thetaP.begin(), + thetaP.begin() + 1); /// Swap mutation entries back + } else /// Diffusion conditioned on avoiding 0 but started from x in (0,1] + { + int l; + + if (t2 - t1 <= + o.g1984threshold) /// Time increment smaller than threshold, use + /// Gaussian approximations + { + m = DrawAncestralProcessG1984(t2 - t1, gen); + coeffcount = -1; + vector binomialBins; + boost::math::binomial_distribution<> BINOMIAL(m, x); + for (int j = 1; j <= m; j++) { + binomialBins.push_back(pdf(BINOMIAL, j)); + } + boost::random::discrete_distribution<> CAT(binomialBins.begin(), + binomialBins.end()); + l = CAT(gen) + 1; + } else /// Otherwise use alternating series technique + { + pair, int> storer = + DrawAncestralProcessConditionalInterior(t2 - t1, x, o, gen); + m = (storer.first).first; + l = (storer.first).second; + coeffcount = storer.second; + } + + boost::random::gamma_distribution<> GAMMA1( + thetaP[0] + static_cast(l), 1.0), + GAMMA2(thetaP[1] + static_cast(m - l), 1.0); + + y = -1.0; + while (!(0.0 < y && y < 1.0)) /// Occasionally get y == 0.0 or y == 1.0 + { + double100 G1 = GAMMA1(gen), G2 = GAMMA2(gen); + y = G1 / (G1 + G2); + } + } + } else /// Strictly positive entries in mutation vector, so unconditioned + /// diffusion + { + + if (t2 - t1 <= o.g1984threshold) /// Time increment smaller than threshold, + /// use Gaussian approximations + { + m = DrawAncestralProcessG1984(t2 - t1, gen); + coeffcount = -1; + } else /// Otherwise use alternating series technique + { + m_and_coeffcount = DrawAncestralProcess(t2 - t1, o, gen); + m = m_and_coeffcount.first; + coeffcount = m_and_coeffcount.second; + } + + boost::random::binomial_distribution BINOMIAL(m, + static_cast(x)); + int l = BINOMIAL(gen); + + boost::random::gamma_distribution<> GAMMA1( + thetaP[0] + static_cast(l), 1.0), + GAMMA2(thetaP[1] + static_cast(m - l), 1.0); + + y = -1.0; + while (!(0.0 < y && y < 1.0)) /// Occasionally get y == 0.0 or y == 1.0 + { + double100 G1 = GAMMA1(gen), G2 = GAMMA2(gen); + y = G1 / (G1 + G2); + } + } + + return make_pair(y, coeffcount); +} + +pair WrightFisher::DrawUnconditionedDiffusion( + double100 x, double100 t, const Options &o, + boost::random::mt19937 + &gen) /// Draws from the law of an unconditioned Wright-Fisher diffusion +{ + assert((x >= 0.0) && (x <= 1.0) && (t > 0.0)); + + if (!(x > 0.0) && (thetaP.empty() || + (!(thetaP[0] > 0.0)))) /// If we start at 0 and there is no + /// mutation, diffusion stays there + { + return make_pair(0.0, -1); + } else if (!(x < 1.0) && + (thetaP.empty() || + (!(thetaP[1] > + 0.0)))) /// Similarly if started from 1 with no mutation + { + return make_pair(1.0, -1); + } else /// Otherwise we first draw M ~ {q_m} + { + int m, coefcount; + if (t <= o.g1984threshold) { + m = DrawAncestralProcessG1984(t, gen); + coefcount = -1; + } else { + pair temp = DrawAncestralProcess(t, o, gen); + m = temp.first; + coefcount = temp.second; + } + + double100 para1, para2; + boost::random::binomial_distribution<> BIN(m, x); /// Draw L ~ Bin(m,x) + int l = BIN(gen); + + if (thetaP.empty()) /// Sort out cases based on what mutation parameters is + { + if (l == 0) { + return make_pair(0.0, coefcount); + } else if (l == m) { + return make_pair(1.0, coefcount); + } else { + para1 = static_cast(l); + para2 = static_cast(m - l); + } + } else if (!(thetaP[0] > 0.0)) { + if (l == 0) { + return make_pair(0.0, coefcount); + } else { + para1 = static_cast(l); + para2 = static_cast(thetaP[1] + m - l); + } + } else if (!(thetaP[1] > 0.0)) { + if (l == m) { + return make_pair(1.0, coefcount); + } else { + para1 = static_cast(thetaP[0] + l); + para2 = static_cast(m - l); + } + } else { + para1 = static_cast(thetaP[0] + l); + para2 = static_cast(thetaP[0] + m - l); + } + + boost::random::gamma_distribution GAMMA1(para1, 1.0), + GAMMA2(para2, 1.0); + double100 y = -1.0; + while (!(0.0 < y && y < 1.0)) /// Occasionally get y == 0.0 or y == 1.0 + { + double100 G1 = GAMMA1(gen), G2 = GAMMA2(gen); + y = G1 / (G1 + G2); + } + + return make_pair(y, coefcount); + } +} + +/// DIFFUSION SIMULATION - NON-NEUTRAL PATHS + +vector> WrightFisher::NonNeutralDraw( + double100 x, double100 t1, double100 t2, bool Absorption, const Options &o, + boost::random::mt19937 &gen) /// Draws of paths from non-neutral WF + /// diffusion started from x at time t1 +{ + assert((x >= 0.0) && (x <= 1.0) && (t1 >= 0.0) && (t2 > 0.0) && (t1 < t2)); + bool accept = false; + vector paras{phiMin, phiMax, phiMax - phiMin}; + vector> ptr; + double100 kapmean = paras[2] * (t2 - t1); /// Rate of Poisson point process + + boost::random::poisson_distribution kap(static_cast(kapmean)); + + boost::random::uniform_01 unift, unifm, + unifU; /// Set up uniform generators for points over [t1,t2] * + /// [0,phiMax-phiMin] * [0,1] + int rcount = 0; + while (!accept) /// Until all skeleton points get accepted, keep going + { + int kappa = kap(gen); /// Generate kappa ~ Pois + double100 u = unifU(gen); + + vector path, times(kappa), marks(kappa), rejcount; + auto gent = [&t1, &t2, &unift, &gen]() /// time stamps ~ Unif [t1,t2] + { return (t1 + ((t2 - t1) * unift(gen))); }; + auto genm = [¶s, &unifm, &gen]() /// marks ~ Unif [0,phiMax-phiMin] + { return (paras[2] * unifm(gen)); }; + generate(begin(times), end(times), gent); + generate(begin(marks), end(marks), genm); + sortVectorsAscending(times, times, + marks); /// Sort vectors according to timestamps + + times.push_back(t2); + marks.push_back( + u); /// Add on end point - to be checked differently to skeleton points + + for (vector::iterator itt = times.begin(), itm = marks.begin(); + itt != times.end(); itt++, itm++) { + if (kappa == 0) /// No skeleton points -> check end point directly + { + if (Absorption) { + path.push_back(DrawUnconditionedDiffusion(x, t2 - t1, o, gen) + .first); /// Generate endpoint + } else { + path.push_back( + DrawEndpoint(x, t1, t2, o, gen).first); /// Generate endpoint + } + + if (exp(Atilde(path.back()) - Atildeplus()) < + *itm) /// Test if generated point is good; if not generate new + /// Poisson point process + { + rcount++; + break; + } + + rejcount.push_back(rcount); + ptr.push_back(path); + ptr.push_back(times); + ptr.push_back(rejcount); + accept = true; + } else /// kappa > 0 - generate skeleton points and endpoint + { + if (itt == times.begin()) { + if (Absorption) { + path.push_back( + DrawUnconditionedDiffusion(x, (*itt) - t1, o, gen) + .first); /// Generate skeleton points sequentially + } else { + path.push_back( + DrawEndpoint(x, t1, *itt, o, gen) + .first); /// Generate skeleton points sequentially + } + + if (Phitilde(path.back()) - paras[0] > + *itm) /// Test generated point is OK, otherwise can stop and + /// generate a new Poisson point process + { + rcount++; + break; + } + + } else if (*itt != t2) /// Separate first time stamp and rest to ensure + /// correct sequential sampling + { + if (Absorption) { + path.push_back(DrawUnconditionedDiffusion( + path.back(), (*itt) - *(itt - 1), o, gen) + .first); + } else { + path.push_back( + DrawEndpoint(path.back(), *(itt - 1), *itt, o, gen).first); + } + + if (Phitilde(path.back()) - paras[0] > *itm) { + rcount++; + break; + } + + } else /// Endpoint draw + { + if (Absorption) { + path.push_back(DrawUnconditionedDiffusion( + path.back(), (*itt) - *(itt - 1), o, gen) + .first); + } else { + path.push_back( + DrawEndpoint(path.back(), *(itt - 1), *itt, o, gen).first); + } + + if (exp(Atilde(path.back()) - Atildeplus()) < + *itm) /// Check corresponding endpoint condition + { + rcount++; + break; + } + + rejcount.push_back(rcount); + ptr.push_back(path); + ptr.push_back(times); + ptr.push_back(rejcount); + accept = true; + } + } + } + } + + return ptr; +} + +pair WrightFisher::NonNeutralDrawEndpoint( + double100 x, double100 t1, double100 t2, bool Absorption, const Options &o, + boost::random::mt19937 + &gen) /// Invoke NonNeutralDraw to generate a whole path, but retains + /// only the endpoint at time t2 +{ + vector> ptr = NonNeutralDraw(x, t1, t2, Absorption, o, gen); + return make_pair(ptr[0].back(), -1); +} + +/// BRIDGE SIMULATION - NEUTRAL PATHS + +vector WrightFisher::DrawBridgePMFUnconditional( + double100 x, double100 z, double100 s, double100 t, const Options &o, + boost::random::mt19937 + &gen) /// Draws from the law of a bridge starting within (0,1), ending + /// at some boundary point (absorption can happen at any time) + /// with time increments being large enough +{ + assert((x > 0.0) && (x < 1.0) && (!(z > 0.0) || !(z < 1.0)) && (s > 0.0) && + (t > 0.0)); + vector> curr_mk; + vector first_mk(4, 0); + first_mk[2] = 1; + first_mk[3] = -1; + curr_mk.push_back(first_mk); + bool mkl_found = false; + + /// Setting up necessary quantities + boost::random::uniform_01 U01; + double100 u = U01(gen); + vector eCvec, eAL, eAU, eBL, eBU, dL, dU; + double100 currsumU = 0.0, currsumL = 0.0, eCL = 0.0, + eCU(GetdBridgeUnconditional(eCvec, 0, x, z, t)); + vector v_used; + double100 Amkl; + int n = -1, Fmkl = 0, eCindex_computed = 0; + + /// Compute F ensuring theoretical convergence of upper and lower bounds + pair, double100> Cs, Cts, Ct; + Cs.second = s; + Cts.second = t - s; + Ct.second = t; + int F3 = computeE(Ct), + F4 = static_cast( + ceil(max(0.0, 1.0 / static_cast(t) - (theta + 1.0) / 2.0))), + F5 = static_cast(ceil(2.0 / o.eps) + 1); + while ((theta + 2 * F4 + 1) * exp(-(2 * F4 + theta) * t / 2.0) >= 1 - o.eps) + ++F4; + int F6 = 2 * max(max(F3, F4), F5); + + while (!mkl_found) { + ++n; + if (n > 0) + curr_mk.push_back(curr_mk.back()); + increment_on_mk(curr_mk.back(), s, t); + int &m = curr_mk[n][0]; + int &k = curr_mk[n][1]; + if (o.debug > 2) + cerr << "New n = " << n << ", (m,k) = (" << m << ", " << k << ")" << endl; + + /// Add the new n to the mix + eAL.push_back(0.0); + eAU.push_back(0.0); + eBL.push_back(0.0); + eBU.push_back(0.0); + dL.push_back(0.0); + dU.push_back(0.0); + int F1 = computeC(m, Cs), F2 = computeC(k, Cts); + if (o.debug > 2) + cerr << "(F1,F2,F3,F4,F5) = (" << F1 << "," << F2 << "," << F3 << "," + << F4 << "," << F5 << ")" << endl; + Fmkl = max(max(F1, F2), F6); + + int v = -1; + if (o.debug > 2) { + cerr << "F(" << setprecision(0) << m << "," << k << "," << setprecision(4) + << x << "," << z << "," << s << "," << t << ") = " << Fmkl << endl; + } + + while (2 * v < Fmkl || eAU[n] > 1.0 || eBU[n] > 1.0) { + ++v; + double100 newcoefficientU = + exp(Getlogakm(m + 2 * v, m) + + static_cast(-(m + 2 * v) * (m + 2 * v + theta - 1) * + s / 2.0)); + double100 newcoefficientL = + exp(Getlogakm(m + 2 * v + 1, m) + + static_cast(-(m + 2 * v + 1) * + (m + 2 * v + 1 + theta - 1) * s / 2.0)); + + eAU[n] = eAL[n] + newcoefficientU; + eAL[n] = eAU[n] - newcoefficientL; + + newcoefficientU = + exp(Getlogakm(k + 2 * v, k) + + static_cast(-(k + 2 * v) * (k + 2 * v + theta - 1) * + (t - s) / 2.0)); + newcoefficientL = exp(Getlogakm(k + 2 * v + 1, k) + + static_cast(-(k + 2 * v + 1) * + (k + 2 * v + 1 + theta - 1) * + (t - s) / 2.0)); + + eBU[n] = eBL[n] + newcoefficientU; + eBL[n] = eBU[n] - newcoefficientL; + + if (2 * v + 2 > eCindex_computed) { + assert(2 * v == eCindex_computed); + eCL = eCU - GetdBridgeUnconditional(eCvec, 2 * v + 1, x, z, t); + eCU = eCL + GetdBridgeUnconditional(eCvec, 2 * v + 2, x, z, t); + eCindex_computed += 2; + } + + if (eAU[n] == eAL[n] && eBU[n] == eBL[n] && + eCL == eCU) /// ...then we have lost precision before reaching Fmkj. + { + if (o.debug > 2) { + cerr << "Abandoning loop for n = " << n << ", Fmkj = " << Fmkl + << " at v = " << v << endl; + cerr << "Leftovers: " << setprecision(50) << eAU[n] - eAL[n] << ", " + << eBU[n] - eBL[n] << ", " << eCU - eCL << endl; + } + + if (eAL[n] < 0.0 || eCL < 0.0) { + cerr << "Numerical error detected: (m,k) = " << m << "," << k + << ", eAU[" << n << "] = " << eAU[n] << ", eAL[" << n + << "] = " << eAL[n] << ", eCU[" << n << "] = " << eCU + << ", eCL = " << eCL + << ". Resorting to G1984-style approximation (s,t) = (" << s + << "," << t << ") ..." << endl; + return DrawBridgePMFUnconditionalApprox(x, z, s, t, o, gen); + } + + break; + } + } + + dU[n] = (eCL < 0.0 ? static_cast(nan("")) + : exp(log(eAU[n]) + log(eBU[n]) - log(eCL))); + dL[n] = (eAL[n] < 0.0 || eBL[n] < 0.0 + ? static_cast(0.0) + : exp(log(eAL[n]) + log(eBL[n]) - log(eCU))); + v_used.push_back(v); + + if (o.debug > 2) { + cerr << "\nn "; + for (int k = 0; k <= n; ++k) + cerr << k << " "; + cerr << "\ndL "; + for (int k = 0; k <= n; ++k) + cerr << dL[k] << " "; + cerr << "\ndU "; + for (int k = 0; k <= n; ++k) + cerr << dU[k] << " "; + cerr << endl; + } + + /// Add on l contributions + int llower = + (((thetaP.empty() || !(thetaP[0] > 0.0)) && !(z > 0.0)) ? 0 : 1), + lupper = + (((thetaP.empty() || !(thetaP[1] > 0.0)) && !(z < 1.0)) ? m + : m - 1); + for (int l = llower; l <= lupper && !mkl_found; ++l) { + Amkl = computeAUnconditional(m, k, l, x, z); + if (o.debug > 2) + cerr << "Adding to currsums with A(n,m,k,l) = A(" << n << "," << m + << "," << k << "," << l << ") = " << Amkl << endl; + + if (Amkl * dL[n] > 1.0 || Amkl * dU[n] < 0.0 || eAU[n] < 0.0 || + eBU[n] < 0.0 || eAL[n] > 1.0 || eBL[n] > 1.0 || eCU < 0.0) { + cerr << "Numerical error detected: (m,k,l) = " << m << "," << k << "," + << l << "), Amkj = " << Amkl << ", dL[" << n << "] = " << dL[n] + << ", dU[" << n << "] = " << dU[n] << ", eAU[" << n + << "] = " << eAU[n] << ", eAL[" << n << "] = " << eAL[n] + << ", eBU[" << n << "] = " << eBU[n] << ", eBL[" << n + << "] = " << eBL[n] << ", eCU = " << eCU << ", eCL = " << eCL + << ". Resorting to G1984-style approximation (x,z,s,t) = (" << x + << "," << z << "," << s << "," << t << ") ..." << endl; + return DrawBridgePMFUnconditionalApprox(x, z, s, t, o, gen); + } + + currsumL += Amkl * dL[n]; + currsumU += Amkl * dU[n]; + bool decision_on_mkl_made = (currsumL > u || currsumU < u); + + if (currsumL > currsumU) { + cerr << "Error: currsumL = " << currsumL << " > " << currsumU + << " = currsumU (n,m,k,l) = (" << n << "," << m << "," << k << "," + << l << ")." << endl; + exit(1); + } + + while (!decision_on_mkl_made) /// Refine upper and lower bounds + { + double100 currsumLold = currsumL, currsumUold = currsumU; + currsumL = 0.0; + currsumU = 0.0; + + const vector dUold(dU), dLold(dL); + for (int i = 0; i <= n; ++i) { + int &mi = curr_mk[i][0], &ki = curr_mk[i][1]; + ++v_used[i]; + double100 newcoefficientU = + exp(Getlogakm(mi + 2 * v_used[i], mi) + + static_cast(-(mi + 2 * v_used[i]) * + (mi + 2 * v_used[i] + theta - 1) * s / + 2.0)); + double100 newcoefficientL = + exp(Getlogakm(mi + 2 * v_used[i] + 1, mi) + + static_cast(-(mi + 2 * v_used[i] + 1) * + (mi + 2 * v_used[i] + 1 + theta - 1) * + s / 2.0)); + + eAU[i] = eAL[i] + newcoefficientU; + eAL[i] = eAU[i] - newcoefficientL; + + newcoefficientU = + exp(Getlogakm(ki + 2 * v_used[i], ki) + + static_cast(-(ki + 2 * v_used[i]) * + (ki + 2 * v_used[i] + theta - 1) * + (t - s) / 2.0)); + newcoefficientL = + exp(Getlogakm(ki + 2 * v_used[i] + 1, ki) + + static_cast(-(ki + 2 * v_used[i] + 1) * + (ki + 2 * v_used[i] + 1 + theta - 1) * + (t - s) / 2.0)); + + eBU[i] = eBL[i] + newcoefficientU; + eBL[i] = eBU[i] - newcoefficientL; + + if (2 * v_used[i] + 2 > eCindex_computed) { + assert(2 * v_used[i] == eCindex_computed); + eCL = eCU - + GetdBridgeUnconditional(eCvec, 2 * v_used[i] + 1, x, z, t); + eCU = eCL + + GetdBridgeUnconditional(eCvec, 2 * v_used[i] + 2, x, z, t); + eCindex_computed += 2; + } + + dU[i] = (eCL < 0.0 ? static_cast(nan("")) + : exp(log(eAU[i]) + log(eBU[i]) - log(eCL))); + dL[i] = ((eAL[i] < 0.0 || eBL[i] < 0.0) + ? static_cast(0.0) + : exp(log(eAL[i]) + log(eBL[i]) - log(eCU))); + + if (dLold[i] > dL[i] || dUold[i] < dU[i] || dL[i] > dU[i] || + static_cast(eAU[i]) < 0.0 || + static_cast(eBU[i]) < 0.0 || + static_cast(eAL[i]) > 1.0 || + static_cast(eBL[i]) > 1.0 || + static_cast(eCU) < 0.0) { + cerr << "Numerical error detected: (m,k,l) = " << mi << "," << ki + << ", *, *), dL[" << i << "] = " << dL[i] << ", dU[" << i + << "] = " << dU[i] << ", eAU[" << i << "] = " << eAU[i] + << ", eAL[" << i << "] = " << eAL[i] << ", eBU[" << i + << "] = " << eBU[i] << ", eBL[" << i << "] = " << eBL[i] + << ", eCU = " << eCU << ", eCL = " << eCL + << ". Resorting to G1984-style approximation (x,z,s,t) = (" + << x << "," << z << "," << s << "," << t << ") ..." << endl; + return DrawBridgePMFUnconditionalApprox(x, z, s, t, o, gen); + } + + int lilower = + (((thetaP.empty() || !(thetaP[0] > 0.0)) && !(z > 0.0)) ? 0 + : 1), + liupper = (((thetaP.empty() || !(thetaP[1] > 0.0)) && !(z < 1.0)) + ? mi + : mi - 1); + for (int l2 = lilower; l2 <= liupper; ++l2) { + Amkl = computeAUnconditional(mi, ki, l2, x, z); + currsumL += Amkl * dL[i]; + currsumU += Amkl * dU[i]; + if (o.debug > 3) + cerr << "Recomputing currsums with A(n,m,k,l) = A(" << i << "," + << mi << "," << ki << "," << l2 << ") = " << Amkl << endl; + } + } + + if (currsumL > currsumU) { + cerr << "Error: currsumL = " << currsumL << " > " << currsumU + << " = currsumU (n,m,k,l) = (" << n << "," << m << "," << k + << "," << l << ")." << endl; + exit(1); + } + + if (o.debug > 2) { + cerr << "\ndL "; + printVec(dL, cerr); + cerr << "\ndU "; + printVec(dU, cerr); + } + + if (currsumLold > currsumL) { + cerr << "Error: currsumLold = " << currsumLold << " > " << currsumL + << " = currsumL (n,m,k,l) = (" << n << "," << m << "," << k + << "," << l << ")." << endl; + exit(1); + } + if (currsumUold < currsumU) { + cerr << "Error: currsumUold = " << currsumUold << " < " << currsumU + << " = currsumU (n,m,k,l) = (" << n << "," << m << "," << k + << "," << l << ")." << endl; + exit(1); + } + + decision_on_mkl_made = (currsumL > u || currsumU < u); + } + + mkl_found = (currsumL > u); + + if (mkl_found) { + if (!(z > 0.0)) { + curr_mk[n][2] = l; /// Sets j = 0 + curr_mk[n][3] = 0; + } else { + curr_mk[n][2] = l; /// Sets j = k + curr_mk[n][3] = k; + } + } + } + } + + int coeffcount = 0; + for (int i = 0; i <= n; ++i) + coeffcount += (v_used[i] + 1); + curr_mk[n].push_back(coeffcount); + curr_mk[n].push_back(0); + + if (o.debug > 2) { + cerr << "p_m,k,j: Returned (m,k,j) = (" << curr_mk[n][0] << "," + << curr_mk[n][1] << "," << curr_mk[n][3] << ")\n"; + cerr << "n =\t\t\t"; + for (int i = 0; i <= n; ++i) + cerr << i << "\t"; + cerr << "\nv_used =\t"; + for (int i = 0; i <= n; ++i) + cerr << v_used[i] << "\t"; + cerr << "Coeffcount = " << coeffcount << endl; + } + + return curr_mk[n]; +} + +vector WrightFisher::DrawBridgePMFUnconditionalOneQApprox( + double100 x, double100 z, double100 s, double100 t, const Options &o, + boost::random::mt19937 + &gen) /// Draws from the law of a bridge starting within (0,1), ending + /// at some boundary point (absorption can happen at any time) + /// with one time increment falling below the threshold +{ + assert((x > 0.0) && (x < 1.0) && (!(z > 0.0) || !(z < 1.0)) && (t > s) && + (s > 0.0)); + bool ind1 = + (s > o.g1984threshold); /// Figure out whether to approximate q_m or q_k + double100 sorts = (ind1 ? s : t - s), sortsapprox = (sorts == s ? t - s : s); + + vector> curr_mk; + vector first_mk(4, 0), mkljStore; + first_mk[2] = 1; + first_mk[3] = -1; + curr_mk.push_back(first_mk); + bool mkl_found = false; + + /// Setting up the necessary quantities + boost::random::uniform_01 U01; + double100 u = U01(gen); + vector eCvec, eAL, eAU, dL, dU, currsumStore; + double100 currsumU = 0.0, currsumL = 0.0, eCL = 0.0, + eCU(GetdBridgeUnconditional(eCvec, 0, x, z, t)), qApprox = 0.0, + runningMax = 1.0e-300; + vector v_used; + double100 Amkl; + int n = -1, Fmkl = 0, eCindex_computed = 0; + /// Mechanism to check whether we have run out of precision due to Gaussian + /// approximations used for one side of the bridge interval - very rare to be + /// needed + double mmode = GriffithsParas(s).first, vm = GriffithsParas(s).second, + kmode = GriffithsParas(t - s).first, vk = GriffithsParas(t - s).second; + int mlimU = static_cast(ceil(mmode + 5.0 * sqrt(vm))), + klimU = static_cast(ceil(kmode + 5.0 * sqrt(vk))), + mlimL = max(0, static_cast(floor(mmode - 5.0 * sqrt(vm)))), + klimL = max(0, static_cast(floor(kmode - 5.0 * sqrt(vk)))); + int totalpts = (mlimU - mlimL) * (klimU - klimL), counter = 0; + + /// Compute F ensuring theoretical convergence of upper and lower bounds + pair, double100> Csorts, Ct; + Csorts.second = sorts; + Ct.second = t; + int F3 = computeE(Ct), + F4 = static_cast( + ceil(max(0.0, 1.0 / static_cast(t) - (theta + 1.0) / 2.0))), + F5 = static_cast(ceil(2.0 / o.eps) + 1); + while ((theta + 2 * F4 + 1) * exp(-(2 * F4 + theta) * t / 2.0) >= 1 - o.eps) + ++F4; + int F6 = 2 * max(max(F3, F4), F5); + + while (!mkl_found) { + ++n; + if (n > 0) + curr_mk.push_back(curr_mk.back()); + increment_on_mk(curr_mk.back(), s, t); + int &m = curr_mk[n][0]; + int &k = curr_mk[n][1]; + int mork = (ind1 ? m : k), morkapprox = (mork == m ? k : m); + if (m <= mlimU && m >= mlimL && k <= klimU && k >= klimL) + counter++; + if (o.debug > 2) + cerr << "New n = " << n << ", (m,k) = (" << m << ", " << k << ")" << endl; + + /// Add the new n to the mix + eAL.push_back(0.0); + eAU.push_back(0.0); + dL.push_back(0.0); + dU.push_back(0.0); + int F1 = computeC(mork, Csorts); + if (o.debug > 2) + cerr << "(F1,F3,F4,F5) = (" << F1 << "," << F3 << "," << F4 << "," << F5 + << ")" << endl; + Fmkl = max(F1, F6); + + int v = -1; + if (o.debug > 2) { + cerr << "F(" << setprecision(0) << m << "," << k << "," << setprecision(4) + << x << "," << z << "," << s << "," << t << ") = " << Fmkl << endl; + } + + while (2 * v < Fmkl) { + ++v; + double100 newcoefficientU = + exp(Getlogakm(mork + 2 * v, mork) + + static_cast(-(mork + 2 * v) * + (mork + 2 * v + theta - 1) * sorts / 2.0)); + double100 newcoefficientL = exp( + Getlogakm(mork + 2 * v + 1, mork) + + static_cast(-(mork + 2 * v + 1) * + (mork + 2 * v + 1 + theta - 1) * sorts / 2.0)); + + eAU[n] = eAL[n] + newcoefficientU; + eAL[n] = eAU[n] - newcoefficientL; + + qApprox = DiscretisedNormCDF(morkapprox, sortsapprox); + + if (2 * v + 2 > eCindex_computed) { + assert(2 * v == eCindex_computed); + eCL = eCU - GetdBridgeUnconditional(eCvec, 2 * v + 1, x, z, t); + eCU = eCL + GetdBridgeUnconditional(eCvec, 2 * v + 2, x, z, t); + eCindex_computed += 2; + } + + if (eAU[n] == eAL[n] && + eCL == eCU) /// ...then we have lost precision before reaching Fmkj. + { + if (o.debug > 2) { + cerr << "Abandoning loop for n = " << n << ", Fmkj = " << Fmkl + << " at v = " << v << endl; + cerr << "Leftovers: " << setprecision(50) << eAU[n] - eAL[n] << ", " + << eCU - eCL << endl; + } + + if (eAL[n] < 0.0 || eCL < 0.0) { + cerr << "Numerical error detected: (m,k) = " << m << "," << k + << ", eAU[" << n << "] = " << eAU[n] << ", eAL[" << n + << "] = " << eAL[n] << ", eCU[" << n << "] = " << eCU + << ", eCL = " << eCL + << ". Resorting to G1984-style approximation (s,t) = (" << s + << "," << t << ") ..." << endl; + return DrawBridgePMFUnconditionalApprox(x, z, s, t, o, gen); + } + + break; + } + } + + dU[n] = (eCL < 0.0 ? static_cast(nan("")) + : exp(log(eAU[n]) + log(qApprox) - log(eCL))); + dL[n] = (eAL[n] < 0.0 ? static_cast(0.0) + : exp(log(eAL[n]) + log(qApprox) - log(eCU))); + v_used.push_back(v); + + if (o.debug > 2) { + cerr << "\nn "; + for (int k = 0; k <= n; ++k) + cerr << k << " "; + cerr << "\ndL "; + for (int k = 0; k <= n; ++k) + cerr << dL[k] << " "; + cerr << "\ndU "; + for (int k = 0; k <= n; ++k) + cerr << dU[k] << " "; + cerr << endl; + } + + /// Add on l contributions + int llower = + (((thetaP.empty() || !(thetaP[0] > 0.0)) && !(z > 0.0)) ? 0 : 1), + lupper = + (((thetaP.empty() || !(thetaP[1] > 0.0)) && !(z < 1.0)) ? m + : m - 1); + for (int l = llower; l <= lupper && !mkl_found; ++l) { + Amkl = computeAUnconditional(m, k, l, x, z); + if (o.debug > 2) + cerr << "Adding to currsums with A(n,m,k,l) = A(" << n << "," << m + << "," << k << "," << l << ") = " << Amkl << endl; + + if (Amkl * dL[n] > 1.0 || Amkl * dU[n] < 0.0 || eAU[n] < 0.0 || + eAL[n] > 1.0 || eCU < 0.0) { + cerr << "Numerical error detected: (m,k,l) = " << m << "," << k << "," + << l << "), Amkl = " << Amkl << ", dL[" << n << "] = " << dL[n] + << ", dU[" << n << "] = " << dU[n] << ", eAU[" << n + << "] = " << eAU[n] << ", eAL[" << n << "] = " << eAL[n] + << ", eCU = " << eCU << ", eCL = " << eCL + << ". Resorting to G1984-style approximation (x,z,s,t) = (" << x + << "," << z << "," << s << "," << t << ") ..." << endl; + return DrawBridgePMFUnconditionalApprox(x, z, s, t, o, gen); + } + + currsumL += Amkl * dL[n]; + currsumU += Amkl * dU[n]; + + currsumStore.push_back(log(Amkl) + log(dL[n])); + runningMax = max(runningMax, currsumStore.back()); + mkljStore.resize(mkljStore.size() + 4, -1); + mkljStore[0 + (4 * (currsumStore.size() - 1))] = m; + mkljStore[1 + (4 * (currsumStore.size() - 1))] = k; + mkljStore[2 + (4 * (currsumStore.size() - 1))] = l; + mkljStore[3 + (4 * (currsumStore.size() - 1))] = (!(z > 0.0) ? 0 : k); + + bool decision_on_mkl_made = (currsumL > u || currsumU < u); + + if (currsumL > currsumU) { + cerr << "Error: currsumL = " << currsumL << " > " << currsumU + << " = currsumU (n,m,k,l) = (" << n << "," << m << "," << k << "," + << l << ")." << endl; + exit(1); + } + + while (!decision_on_mkl_made) /// Refine upper and lower bounds + { + double100 currsumLold = currsumL, currsumUold = currsumU; + currsumL = 0.0; + currsumU = 0.0; + + const vector dUold(dU), dLold(dL); + for (int i = 0; i <= n; ++i) { + int &mi = curr_mk[i][0], &ki = curr_mk[i][1], + morki = (ind1 ? mi : ki), morkapproxi = (morki == mi ? ki : mi); + ++v_used[i]; + double100 newcoefficientU = + exp(Getlogakm(morki + 2 * v_used[i], morki) + + static_cast(-(morki + 2 * v_used[i]) * + (morki + 2 * v_used[i] + theta - 1) * + sorts / 2.0)); + double100 newcoefficientL = + exp(Getlogakm(morki + 2 * v_used[i] + 1, morki) + + static_cast( + -(morki + 2 * v_used[i] + 1) * + (morki + 2 * v_used[i] + 1 + theta - 1) * sorts / 2.0)); + + eAU[i] = eAL[i] + newcoefficientU; + eAL[i] = eAU[i] - newcoefficientL; + + qApprox = DiscretisedNormCDF(morkapproxi, sortsapprox); + + if (2 * v_used[i] + 2 > eCindex_computed) { + assert(2 * v_used[i] == eCindex_computed); + eCL = eCU - + GetdBridgeUnconditional(eCvec, 2 * v_used[i] + 1, x, z, t); + eCU = eCL + + GetdBridgeUnconditional(eCvec, 2 * v_used[i] + 2, x, z, t); + eCindex_computed += 2; + } + + dU[i] = (eCL < 0.0 ? static_cast(nan("")) + : exp(log(eAU[i]) + log(qApprox) - log(eCL))); + dL[i] = (eAL[i] < 0.0 ? static_cast(0.0) + : exp(log(eAL[i]) + log(qApprox) - log(eCU))); + + if (dLold[i] > dL[i] || dUold[i] < dU[i] || dL[i] > dU[i] || + static_cast(eAU[i]) < 0.0 || + static_cast(eAL[i]) > 1.0 || + static_cast(eCU) < 0.0) { + cerr << "Numerical error detected: (m,k,l,j) = " << mi << "," << ki + << ", *, *), dL[" << i << "] = " << dL[i] << ", dU[" << i + << "] = " << dU[i] << ", eAU[" << i << "] = " << eAU[i] + << ", eAL[" << i << "] = " << eAL[i] << ", eCU = " << eCU + << ", eCL = " << eCL + << ". Resorting to G1984-style approximation (x,z,s,t) = (" + << x << "," << z << "," << s << "," << t << ") ..." << endl; + return DrawBridgePMFUnconditionalApprox(x, z, s, t, o, gen); + } + + int lilower = + (((thetaP.empty() || !(thetaP[0] > 0.0)) && !(z > 0.0)) ? 0 + : 1), + liupper = (((thetaP.empty() || !(thetaP[1] > 0.0)) && !(z < 1.0)) + ? mi + : mi - 1); + for (int l2 = lilower; l2 <= liupper; ++l2) { + Amkl = computeAUnconditional(mi, ki, l2, x, z); + currsumL += Amkl * dL[i]; + currsumU += Amkl * dU[i]; + + currsumStore[i] = log(Amkl) + log(dL[i]); + runningMax = max(runningMax, currsumStore[i]); + + if (o.debug > 3) + cerr << "Recomputing currsums with A(n,m,k,l) = A(" << i << "," + << mi << "," << ki << "," << l2 << ") = " << Amkl << endl; + } + } + + if (currsumL > currsumU) { + cerr << "Error: currsumL = " << currsumL << " > " << currsumU + << " = currsumU (n,m,k,l) = (" << n << "," << m << "," << k + << "," << l << ")." << endl; + exit(1); + } + + if (o.debug > 2) { + cerr << "\ndL "; + printVec(dL, cerr); + cerr << "\ndU "; + printVec(dU, cerr); + } + + if (currsumLold > currsumL) { + cerr << "Error: currsumLold = " << currsumLold << " > " << currsumL + << " = currsumL (n,m,k,l) = (" << n << "," << m << "," << k + << "," << l << ")." << endl; + exit(1); + } + if (currsumUold < currsumU) { + cerr << "Error: currsumUold = " << currsumUold << " < " << currsumU + << " = currsumU (n,m,k,l) = (" << n << "," << m << "," << k + << "," << l << ")." << endl; + exit(1); + } + + decision_on_mkl_made = (currsumL > u || currsumU < u); + } + + mkl_found = (currsumL > u); + + if (mkl_found) { + if (!(z > 0.0)) { + curr_mk[n][2] = l; /// Sets j = 0 + curr_mk[n][3] = 0; + } else { + curr_mk[n][2] = l; /// Sets j = k + curr_mk[n][3] = k; + } + } + } + + if (counter == + totalpts) /// Gaussian approximation leads to currsum summing to < 1.0, + /// so we renormalise and sample from the computed quantities + { + LogSumExp(currsumStore, runningMax); + double100 sum = 0.0; + int ind = 0; + + bool found = false; + + while (!found) { + sum += currsumStore[ind]; + if (sum > u) { + found = true; + } + if (ind == static_cast(currsumStore.size() - 1)) { + found = true; + } + ind++; + } + + vector returnvec; + + returnvec.push_back(mkljStore[0 + (4 * ind)]); + returnvec.push_back(mkljStore[1 + (4 * ind)]); + returnvec.push_back(mkljStore[2 + (4 * ind)]); + returnvec.push_back(mkljStore[3 + (4 * ind)]); + + return returnvec; + } + } + + int coeffcount = 0; + for (int i = 0; i <= n; ++i) + coeffcount += (v_used[i] + 1); + curr_mk[n].push_back(coeffcount); + curr_mk[n].push_back(0); + if (o.debug > 2) { + cerr << "p_m,k,j: Returned (m,k,j) = (" << curr_mk[n][0] << "," + << curr_mk[n][1] << "," << curr_mk[n][3] << ")\n"; + cerr << "n =\t\t\t"; + for (int i = 0; i <= n; ++i) + cerr << i << "\t"; + cerr << "\nv_used =\t"; + for (int i = 0; i <= n; ++i) + cerr << v_used[i] << "\t"; + cerr << "Coeffcount = " << coeffcount << endl; + } + + return curr_mk[n]; +} + +vector WrightFisher::DrawBridgePMFUnconditionalApprox( + double100 x, double100 z, double100 s, double100 t, const Options &o, + boost::random::mt19937 + &gen) /// Draws from the law of a bridge starting within (0,1), ending + /// at some boundary point (absorption can happen at any time) + /// with both time increments falling below the threshold +{ + assert((x > 0.0) && (x < 1.0) && (!(z > 0.0) || !(z < 1.0)) && (t > s) && + (s > 0.0)); + vector returnvec; + vector currsumStore; + vector mkljStore; + + /// Compute denominator + double100 eC = 0.0, eCInc = 1.0, eCOldInc = 1.0; + int Dflip = 1, Djm = 0, Djp = 0, mkLower = (thetaP.empty() ? 1 : 0); + int dmode = static_cast(ceil(GriffithsParas(t).first)), d = dmode; + + while (max(eCOldInc, eCInc) > 0.0) { + eCOldInc = eCInc; + double100 xcont = (!(z > 0.0) ? static_cast(d) * log(1.0 - x) + : static_cast(d) * log(x)); + + eCInc = exp(log(QmApprox(d, t, o)) + xcont); + eC += eCInc; + + if (Dflip == -1 && + (dmode - Djm - 1 > 0)) /// Mechanism to explore either side around mode + { + Djm++; + d = dmode - Djm; + } else { + Djp++; + d = dmode + Djp; + } + Dflip *= -1; + } + + vector modeGuess = mklModeFinder( + x, z, s, t, o); /// Get a guess to location of mode over (m,k,l) + int mMode = modeGuess[0], kMode = modeGuess[1], lMode = modeGuess[2]; + + boost::random::uniform_01 + U01; /// Use these guesses & eC to set a suitable threshold for subsequent + /// computations + double100 currsum = 0.0, u = U01(gen), + threshold = exp(mklModeFinder_Evaluator(mMode, kMode, lMode, x, z, + s, t, o) - + log(eC)) * + 1.0e-4; + + int m = mMode, mFlip = 1, mD = 0, mU = 0, kFlip = 1, kD = 0, kU = 0; + bool mSwitch = false, mDownSwitch = false, mUpSwitch = false; + double100 mContr_D = boost::math::lgamma(static_cast(theta + m)); + double100 mContr_U = mContr_D, mContr, + runningMax = -1.0e100; /// Computing m contributions + + while (!mSwitch) { + double100 qm = QmApprox(m, s, o); + if (!(qm > 0.0)) /// This should not trigger, but if it does, sets to very + /// small value (taking logs later so cannot be 0!) + { + qm = 1.0e-300; + } + if (m != mMode) { + if (mU > mD) { + mContr_U += log(static_cast(theta + m - 1)); + mContr = log(qm) + mContr_U; + } else { + mContr_D -= log(static_cast(theta + m + 1)); + mContr = log(qm) + mContr_D; + } + } else { + mContr = log(qm) + mContr_U; + } + + int k = kMode, j = (!(z > 0.0) ? 0 : k); + kFlip = 1, kD = 0, kU = 0; + bool kSwitch = false, kDownSwitch = false, + kUpSwitch = false; /// Computing k contributions + double100 kContr_D = + -boost::math::lgamma(static_cast(theta + m + k)), + kContr_U = kContr_D, kContr; + + while (!kSwitch) { + double100 qk = QmApprox(k, t - s, o); + if (!(qk > 0.0)) /// This should not trigger, but if it does, sets to very + /// small value (taking logs later so cannot be 0!) + { + qk = 1.0e-300; + } + if (k != kMode) { + if (kU > kD) { + kContr_U -= log(static_cast(theta + m + k - 1)); + kContr = log(qk) + kContr_U; + } else { + kContr_D += log(static_cast(theta + m + k + 1)); + kContr = log(qk) + kContr_D; + } + } else { + kContr = log(qk) + kContr_U; + } + + int lFlip = 1, newlMode = min(m, lMode), l = newlMode, lU = 0, + lD = 0; /// Need to redefine lMode as m might be too small! + int lLower = ((thetaP.empty() && !(z < 1.0)) ? 1 : 0), + lUpper = ((thetaP.empty() && !(z > 0.0)) ? m : m - 1); + bool lSwitch = false, lDownSwitch = false, lUpSwitch = false; + + boost::math::binomial_distribution<> BIN(m, x); + double100 lContr_D = + log(pdf(BIN, l)) + + (!(z > 0.0) + ? boost::math::lgamma( + static_cast(theta + m - l + k)) - + boost::math::lgamma(static_cast(theta + m - l)) + : boost::math::lgamma(static_cast(theta + l + k)) - + boost::math::lgamma(static_cast(theta + l))); + double100 lContr_U = lContr_D, lContr; + + while (!lSwitch) { + if (l != newlMode) { + if (lU > lD) { + lContr_U += + log(static_cast(m - (l - 1))) - + log(static_cast((l - 1) + 1)) + log(x) - + log(1.0 - x) + + (!(z > 0.0) + ? log(static_cast(theta + m - (l - 1) - 1)) - + log(static_cast(theta + m - (l - 1) + k - + 1)) + : log(static_cast(theta + (l - 1) + k)) - + log(static_cast(theta + (l - 1)))); + lContr = lContr_U; + } else { + lContr_D += + log(static_cast(l + 1)) - + log(static_cast(m - (l + 1) + 1)) + log(1.0 - x) - + log(x) + + (!(z > 0.0) + ? log(static_cast(theta + m - (l + 1) + k)) - + log(static_cast(theta + m - (l + 1))) + : log(static_cast(theta + (l + 1) - 1)) - + log(static_cast(theta + (l + 1) + k - + 1))); + lContr = lContr_D; + } + } else { + lContr = lContr_U; + } + double100 currsum_inc = mContr + kContr + lContr - log(eC); + runningMax = + max(currsum_inc, runningMax); /// Running max of log probabilities + /// for use in log-sum-exp trick + currsum += exp(currsum_inc); + currsumStore.push_back(currsum_inc); + + mkljStore.resize(mkljStore.size() + 4, -1); + mkljStore[0 + (4 * (currsumStore.size() - 1))] = m; + mkljStore[1 + (4 * (currsumStore.size() - 1))] = k; + mkljStore[2 + (4 * (currsumStore.size() - 1))] = l; + mkljStore[3 + (4 * (currsumStore.size() - 1))] = j; + + if (!(lDownSwitch)) /// Switching mechanism for l + { + if (sgn(l - newlMode) <= 0) { + lDownSwitch = ((exp(currsum_inc) < threshold) || + (newlMode - lD - 1) < lLower); + } + } + + if (!(lUpSwitch)) { + if (sgn(l - newlMode) >= 0) { + lUpSwitch = ((exp(currsum_inc) < threshold) || + (newlMode + lU + 1) > lUpper); + } + } + + lSwitch = (lDownSwitch && lUpSwitch); + + if (!lSwitch) { + if ((lFlip == 1 && (newlMode + lU + 1 <= lUpper)) || + (lDownSwitch && !(lUpSwitch))) { + lU++; + l = newlMode + lU; + lFlip *= (lDownSwitch ? 1 : -1); + } else if ((lFlip == -1 && (newlMode - lD - 1 >= lLower)) || + (lUpSwitch && !(lDownSwitch))) { + lD++; + l = newlMode - lD; + lFlip *= (lUpSwitch ? 1 : -1); + } + } + } + + if (!(kDownSwitch)) /// Switching mechanism for k + { + if (sgn(k - kMode) <= 0) { + kDownSwitch = + (((lU == 0) && (lD == 0)) || (kMode - kD - 1 < mkLower)); + } + } + + if (!(kUpSwitch)) { + if (sgn(k - kMode) >= 0) { + kUpSwitch = ((lU == 0) && (lD == 0)); + } + } + + kSwitch = (kDownSwitch && kUpSwitch); + + if (!kSwitch) { + if (kFlip == 1) { + kU++; + k = kMode + kU; + kFlip *= (kDownSwitch ? 1 : -1); + } else if ((kFlip == -1) && (kMode - kD - 1 >= mkLower)) { + kD++; + k = kMode - kD; + kFlip *= (kUpSwitch ? 1 : -1); + } + } + } + + if (!(mDownSwitch)) /// Switching mechanism for m + { + if (sgn(m - mMode) <= 0) { + mDownSwitch = (((kU == 0) && (kD == 0)) || (mMode - mD - 1 < mkLower)); + } + } + + if (!(mUpSwitch)) { + if (sgn(m - mMode) >= 0) { + mUpSwitch = ((kU == 0) && (kD == 0)); + } + } + + mSwitch = (mDownSwitch && mUpSwitch); + + if (!mSwitch) { + if (mFlip == 1) { + mU++; + m = mMode + mU; + mFlip *= (mDownSwitch ? 1 : -1); + } else if ((mFlip == -1) && (mMode - mD - 1 >= mkLower)) { + mD++; + m = mMode - mD; + mFlip *= (mUpSwitch ? 1 : -1); + } + } + } + + LogSumExp(currsumStore, runningMax); + double100 sum = 0.0; + int index, ind = 0; + + vector indexing(currsumStore.size(), 0); + for (int i = 0; i != static_cast(indexing.size()); i++) { + indexing[i] = i; + } + sort(indexing.begin(), indexing.end(), [&](const int &a, const int &b) { + return (currsumStore[a] > currsumStore[b]); + }); + + bool found = false; + + while (!found) { + sum += currsumStore[indexing[ind]]; + if (sum > u) { + index = indexing[ind]; + found = true; + } + if (ind == static_cast(currsumStore.size() - 1)) { + index = indexing[ind]; + found = true; + } + ind++; + } + + returnvec.push_back(mkljStore[0 + (4 * index)]); + returnvec.push_back(mkljStore[1 + (4 * index)]); + returnvec.push_back(mkljStore[2 + (4 * index)]); + returnvec.push_back(mkljStore[3 + (4 * index)]); + + return returnvec; +} + +vector WrightFisher::DrawBridgePMFSameMutation( + double100 x, double100 s, double100 t, const Options &o, + boost::random::mt19937 + &gen) /// Draws from the law of a bridge starting and ending at the same + /// boundary point and time increments are large enough +{ + assert((!(x > 0.0) || !(x < 1.0)) && (t > s) && (s > 0.0)); + vector> curr_mk; + vector first_mk(4, 0); + first_mk[2] = 1; + first_mk[3] = -1; + curr_mk.push_back(first_mk); + bool mk_found = false; + + /// Set up the necessary quantities + boost::random::uniform_01 U01; + vector eCvec, eAL, eAU, eBL, eBU, dL, dU; + double100 u = U01(gen), currsumU = 0.0, currsumL = 0.0, eCL = 0.0, + eCU(GetdBridgeSame(eCvec, 0, x, t)); + vector v_used; + map, double100> Amkj; + int n = -1, Fmkj = 0, eCindex_computed = 0; + + /// Compute F ensuring theoretical convergence of lower and upper sums - F1 + /// and F2 depend on m and k but F3-5 do not. None depend on j. + pair, double100> Cs, Cts, Ct; + Cs.second = s; + Cts.second = t - s; + Ct.second = t; + int F3 = computeE(Ct), + F4 = static_cast( + ceil(max(0.0, 1.0 / static_cast(t) - (theta + 1.0) / 2.0))), + F5 = static_cast(ceil(2.0 / o.eps) + 1); + while ((theta + 2 * F4 + 1) * exp(-(2 * F4 + theta) * t / 2.0) >= 1 - o.eps) + ++F4; + int F6 = max(max(F3, F4), F5); + + while (!mk_found) { + ++n; + if (n > 0) + curr_mk.push_back(curr_mk.back()); + increment_on_mk(curr_mk.back(), s, t); + int &m = curr_mk[n][0]; + int &k = curr_mk[n][1]; + if (o.debug > 2) + cerr << "New n = " << n << ", (m,k) = (" << m << ", " << k << ")" << endl; + + /// Add the new n to the mix + eAL.push_back(0.0); + eAU.push_back(0.0); + eBL.push_back(0.0); + eBU.push_back(0.0); + dL.push_back(0.0); + dU.push_back(0.0); + int F1 = computeC(m, Cs), F2 = computeC(k, Cts); + if (o.debug > 2) + cerr << "(F1,F2,F3,F4,F5) = (" << F1 << "," << F2 << "," << F3 << "," + << F4 << "," << F5 << ")" << endl; + Fmkj = max(max(F1, F2), F6); + + int v = -1; + if (o.debug > 2) { + cerr << "F(" << setprecision(0) << m << "," << k << "," << setprecision(4) + << x << "," << s << "," << t << ") = " << Fmkj << endl; + } + + while (2 * v < Fmkj || eAU[n] > 1.0 || eBU[n] > 1.0) { + ++v; + double100 newcoefficientU = + exp(Getlogakm(m + 2 * v, m) + + static_cast(-(m + 2 * v) * (m + 2 * v + theta - 1) * + s / 2.0)); + double100 newcoefficientL = + exp(Getlogakm(m + 2 * v + 1, m) + + static_cast(-(m + 2 * v + 1) * + (m + 2 * v + 1 + theta - 1) * s / 2.0)); + + eAU[n] = eAL[n] + newcoefficientU; + eAL[n] = eAU[n] - newcoefficientL; + + newcoefficientU = + exp(Getlogakm(k + 2 * v, k) + + static_cast(-(k + 2 * v) * (k + 2 * v + theta - 1) * + (t - s) / 2.0)); + newcoefficientL = exp(Getlogakm(k + 2 * v + 1, k) + + static_cast(-(k + 2 * v + 1) * + (k + 2 * v + 1 + theta - 1) * + (t - s) / 2.0)); + + eBU[n] = eBL[n] + newcoefficientU; + eBL[n] = eBU[n] - newcoefficientL; + + if (2 * v + 2 > eCindex_computed) { + assert(2 * v == eCindex_computed); + eCL = eCU - GetdBridgeSame(eCvec, 2 * v + 1, x, t); + eCU = eCL + GetdBridgeSame(eCvec, 2 * v + 2, x, t); + eCindex_computed += 2; + } + + if (eAU[n] == eAL[n] && eBU[n] == eBL[n] && + eCL == eCU) /// ...then we have lost precision before reaching Fmkj. + { + if (o.debug > 2) { + cerr << "Abandoning loop for n = " << n << ", Fmkj = " << Fmkj + << " at v = " << v << endl; + cerr << "Leftovers: " << setprecision(50) << eAU[n] - eAL[n] << ", " + << eBU[n] - eBL[n] << ", " << eCU - eCL << endl; + } + + if (eAL[n] < 0.0 || eCL < 0.0) { + cerr << "Numerical error detected: (m,k) = " << m << "," << k + << ", eAU[" << n << "] = " << eAU[n] << ", eAL[" << n + << "] = " << eAL[n] << ", eCU[" << n << "] = " << eCU + << ", eCL = " << eCL + << ". Resorting to G1984-style approximation (s,t) = (" << s + << "," << t << ") ..." << endl; + return DrawBridgePMFSameMutationApprox(x, s, t, gen); + } + + break; + } + } + + double100 addon; /// Compute the appropriate additional terms + + if ((thetaP[0] > 0.0 && thetaP[1] > 0.0) && !(x > 0.0)) { + addon = log(boost::math::beta(thetaP[0], thetaP[1] + m + k)) - + log(boost::math::beta(thetaP[0], thetaP[1] + m)) - + log(boost::math::beta(thetaP[0], thetaP[1] + k)); + } else if (thetaP[0] > 0.0 && thetaP[1] > 0.0) { + addon = log(boost::math::beta(thetaP[0] + m + k, thetaP[1])) - + log(boost::math::beta(thetaP[0] + m, thetaP[1])) - + log(boost::math::beta(thetaP[0] + k, thetaP[1])); + } else { + addon = log(boost::math::beta(m + k, theta)) - + log(boost::math::beta(m, theta)) - + log(boost::math::beta(k, theta)); + } + + dU[n] = (eCL < 0.0 ? static_cast(nan("")) + : exp(log(eAU[n]) + log(eBU[n]) + addon - log(eCL))); + dL[n] = (eAL[n] < 0.0 || eBL[n] < 0.0 + ? static_cast(0.0) + : exp(log(eAL[n]) + log(eBL[n]) + addon - log(eCU))); + v_used.push_back(v); + + if (o.debug > 2) { + cerr << "\nn "; + for (int k = 0; k <= n; ++k) + cerr << k << " "; + cerr << "\ndL "; + for (int k = 0; k <= n; ++k) + cerr << dL[k] << " "; + cerr << "\ndU "; + for (int k = 0; k <= n; ++k) + cerr << dU[k] << " "; + cerr << endl; + } + + currsumL += dL[n]; + currsumU += dU[n]; + + bool decision_on_mk_made = (currsumL > u || currsumU < u); + + if (currsumL > currsumU) { + cerr << "Error: currsumL = " << currsumL << " > " << currsumU + << " = currsumU (n,m,k) = (" << n << "," << m << "," << k << ")." + << endl; + exit(1); + } + + while (!decision_on_mk_made) /// Need to refine upper and lower bounds + { + double100 currsumLold = currsumL, currsumUold = currsumU; + currsumL = 0.0; + currsumU = 0.0; + + const vector dUold(dU), dLold(dL); + for (int i = 0; i <= n; ++i) { + int &mi = curr_mk[i][0], &ki = curr_mk[i][1]; + ++v_used[i]; + double100 newcoefficientU = + exp(Getlogakm(mi + 2 * v_used[i], mi) + + static_cast( + -(mi + 2 * v_used[i]) * + (mi + 2 * v_used[i] + theta - 1) * s / 2.0)), + newcoefficientL = + exp(Getlogakm(mi + 2 * v_used[i] + 1, mi) + + static_cast( + -(mi + 2 * v_used[i] + 1) * + (mi + 2 * v_used[i] + 1 + theta - 1) * s / 2.0)); + + eAU[i] = eAL[i] + newcoefficientU; + eAL[i] = eAU[i] - newcoefficientL; + + newcoefficientU = + exp(Getlogakm(ki + 2 * v_used[i], ki) + + static_cast(-(ki + 2 * v_used[i]) * + (ki + 2 * v_used[i] + theta - 1) * + (t - s) / 2.0)); + newcoefficientL = + exp(Getlogakm(ki + 2 * v_used[i] + 1, ki) + + static_cast(-(ki + 2 * v_used[i] + 1) * + (ki + 2 * v_used[i] + 1 + theta - 1) * + (t - s) / 2.0)); + + eBU[i] = eBL[i] + newcoefficientU; + eBL[i] = eBU[i] - newcoefficientL; + + if (2 * (v_used[i] + 1) > eCindex_computed) { + assert(2 * v_used[i] == eCindex_computed); + eCL = eCU - GetdBridgeSame(eCvec, 2 * v_used[i] + 1, x, t); + eCU = eCL + GetdBridgeSame(eCvec, 2 * v_used[i] + 2, x, t); + eCindex_computed += 2; + } + + if ((thetaP[0] > 0.0 && thetaP[1] > 0.0) && !(x > 0.0)) { + addon = log(boost::math::beta(thetaP[0], + thetaP[1] + mi + ki)) - + log(boost::math::beta(thetaP[0], thetaP[1] + mi)) - + log(boost::math::beta(thetaP[0], thetaP[1] + ki)); + } else if (thetaP[0] > 0.0 && thetaP[1] > 0.0) { + addon = log(boost::math::beta(thetaP[0] + mi + ki, + thetaP[1])) - + log(boost::math::beta(thetaP[0] + mi, thetaP[1])) - + log(boost::math::beta(thetaP[0] + ki, thetaP[1])); + } else { + addon = log(boost::math::beta(mi + ki, theta)) - + log(boost::math::beta(mi, theta)) - + log(boost::math::beta(ki, theta)); + } + + dU[i] = (eCL < 0.0 ? static_cast(nan("")) + : exp(log(eAU[i]) + log(eBU[i]) + addon - log(eCL))); + dL[i] = ((eAL[i] < 0.0 || eBL[i] < 0.0) + ? static_cast(0.0) + : exp(log(eAL[i]) + log(eBL[i]) + addon - log(eCU))); + + if (dLold[i] > dL[i] || dUold[i] < dU[i] || dL[i] > dU[i] || + static_cast(eAU[i]) < 0.0 || + static_cast(eBU[i]) < 0.0 || + static_cast(eAL[i]) > 1.0 || + static_cast(eBL[i]) > 1.0 || + static_cast(eCU) < 0.0) { + cerr << "Numerical error detected: (m,k) = " << mi << "," << ki + << "), dL[" << i << "] = " << dL[i] << ", dU[" << i + << "] = " << dU[i] << ", eAU[" << i << "] = " << eAU[i] + << ", eAL[" << i << "] = " << eAL[i] << ", eBU[" << i + << "] = " << eBU[i] << ", eBL[" << i << "] = " << eBL[i] + << ", eCU = " << eCU << ", eCL = " << eCL + << ". Resorting to G1984-style approximation (s,t) = (" << s + << "," << t << ") ..." << endl; + return DrawBridgePMFSameMutationApprox(x, s, t, gen); + } + + currsumL += dL[i]; + currsumU += dU[i]; + + if (currsumL > currsumU) { + cerr << "Error: currsumL = " << currsumL << " > " << currsumU + << " = currsumU (n,m,k) = (" << n << "," << m << "," << k << ")." + << endl; + exit(1); + } + } + + if (o.debug > 2) { + cerr << "\ndL "; + printVec(dL, cerr); + cerr << "\ndU "; + printVec(dU, cerr); + } + + if (currsumLold > currsumL) { + cerr << "Error: currsumLold = " << currsumLold << " > " << currsumL + << " = currsumL (n,m,k) = (" << n << "," << m << "," << k << ")." + << endl; + exit(1); + } + if (currsumUold < currsumU) { + cerr << "Error: currsumUold = " << currsumUold << " < " << currsumU + << " = currsumU (n,m,k) = (" << n << "," << m << "," << k << ")." + << endl; + exit(1); + } + + decision_on_mk_made = (currsumL > u || currsumU < u); + } + + mk_found = (currsumL > u); + } + + if (!(x > 0.0)) { + curr_mk[n][2] = 0; /// Setting l & j to be 0 + curr_mk[n][3] = 0; + } else { + curr_mk[n][2] = curr_mk[n][0]; /// Setting l & j to be m & k respectively + curr_mk[n][3] = curr_mk[n][1]; + } + + int coeffcount = 0; + + for (int i = 0; i <= n; ++i) + coeffcount += (v_used[i] + 1); + curr_mk[n].push_back(coeffcount); + curr_mk[n].push_back(0); + + if (o.debug > 2) { + cerr << "p_m,k,l,j: Returned (m,k) = (" << curr_mk[n][0] << "," + << curr_mk[n][1] << ")\n"; + cerr << "n =\t\t\t"; + for (int i = 0; i <= n; ++i) + cerr << i << "\t"; + cerr << "\nv_used =\t"; + for (int i = 0; i <= n; ++i) + cerr << v_used[i] << "\t"; + cerr << "Coeffcount = " << coeffcount << endl; + } + + return curr_mk[n]; +} + +vector WrightFisher::DrawBridgePMFSameMutationOneQApprox( + double100 x, double100 s, double100 t, const Options &o, + boost::random::mt19937 + &gen) /// Draws from the law of a bridge starting and ending at the same + /// boundary point, but one of the time increments falls below + /// threshold +{ + assert((!(x > 0.0) || !(x < 1.0)) && (t > s) && (s > 0.0)); + bool ind1 = + (s > o.g1984threshold); /// Figure out whether to approximate q_m or q_k + double100 sorts = (ind1 ? s : t - s), sortsapprox = (sorts == s ? t - s : s); + + vector> curr_mk; + vector first_mk(4, 0), mkljStore; + first_mk[2] = 1; + first_mk[3] = -1; + curr_mk.push_back(first_mk); + bool mk_found = false; + + /// Set up the necessary quantities + boost::random::uniform_01 U01; + double100 u = U01(gen); + vector eCvec, eAL, eAU, dL, dU, currsumStore; + double100 currsumU = 0.0, currsumL = 0.0, eCL = 0.0, + eCU(GetdBridgeSame(eCvec, 0, x, t)), qApprox = 0.0, + runningMax = 1.0e-300; + vector v_used; + map, double100> Amkj; + int n = -1, Fmkj = 0, eCindex_computed = 0, + threshold = (thetaP.empty() + ? 2 + : ((!(thetaP[0] > 0.0) || !(thetaP[1] > 0.0)) ? 1 : 0)); + + /// Mechanism to check whether we have run out of precision due to Gaussian + /// approximations used for one side of the bridge interval - very rare to be + /// needed + double mmode = GriffithsParas(s).first, vm = GriffithsParas(s).second; + double kmode = GriffithsParas(t - s).first, vk = GriffithsParas(t - s).second; + int mlimU = static_cast(ceil(mmode + 5.0 * sqrt(vm))), + klimU = static_cast(ceil(kmode + 5.0 * sqrt(vk))), + mlimL = max(threshold, static_cast(floor(mmode - 5.0 * sqrt(vm)))), + klimL = max(threshold, static_cast(floor(kmode - 5.0 * sqrt(vk)))); + int totalpts = (mlimU - mlimL) * (klimU - klimL), counter = 0; + + /// Compute F ensuring theoretical convergence of upper and lower bounds + pair, double100> Csorts, Ct; + Csorts.second = sorts; + Ct.second = t; + int F3 = computeE(Ct), + F4 = static_cast( + ceil(max(0.0, 1.0 / static_cast(t) - (theta + 1.0) / 2.0))), + F5 = static_cast(ceil(2.0 / o.eps) + 1); + while ((theta + 2 * F4 + 1) * exp(-(2 * F4 + theta) * t / 2.0) >= 1 - o.eps) + ++F4; + int F6 = max(max(F3, F4), F5); + + while (!mk_found) { + ++n; + if (n > 0) + curr_mk.push_back(curr_mk.back()); + increment_on_mk(curr_mk.back(), s, t); + int &m = curr_mk[n][0]; + int &k = curr_mk[n][1]; + int mork = (ind1 ? m : k), morkapprox = (mork == m ? k : m); + if (m <= mlimU && m >= mlimL && k <= klimU && k >= klimL) + counter++; /// Keep track of the points we have visited inside the + /// specified (m,k)-square + if (o.debug > 2) + cerr << "New n = " << n << ", (m,k) = (" << m << ", " << k << ")" << endl; + + /// Add the new n to the mix + eAL.push_back(0.0); + eAU.push_back(0.0); + dL.push_back(0.0); + dU.push_back(0.0); + int F1 = computeC(mork, Csorts); + if (o.debug > 2) + cerr << "(F1,F3,F4,F5) = (" << F1 << "," << F3 << "," << F4 << "," << F5 + << ")" << endl; + Fmkj = max(F1, F6); + + int v = -1; + if (o.debug > 2) { + cerr << "F(" << setprecision(0) << m << "," << k << "," << setprecision(4) + << x << "," << s << "," << t << ") = " << Fmkj << endl; + } + + while (2 * v < Fmkj) { + ++v; + double100 newcoefficientU = + exp(Getlogakm(mork + 2 * v, mork) + + static_cast(-(mork + 2 * v) * + (mork + 2 * v + theta - 1) * sorts / 2.0)); + double100 newcoefficientL = exp( + Getlogakm(mork + 2 * v + 1, mork) + + static_cast(-(mork + 2 * v + 1) * + (mork + 2 * v + 1 + theta - 1) * sorts / 2.0)); + + eAU[n] = eAL[n] + newcoefficientU; + eAL[n] = eAU[n] - newcoefficientL; + + qApprox = DiscretisedNormCDF(morkapprox, sortsapprox); + + if (2 * v + 2 > eCindex_computed) { + assert(2 * v == eCindex_computed); + eCL = eCU - GetdBridgeSame(eCvec, 2 * v + 1, x, t); + eCU = eCL + GetdBridgeSame(eCvec, 2 * v + 2, x, t); + eCindex_computed += 2; + } + + if (eAU[n] == eAL[n] && + eCL == eCU) /// ...then we have lost precision before reaching Fmkj. + { + if (o.debug > 2) { + cerr << "Abandoning loop for n = " << n << ", Fmkj = " << Fmkj + << " at v = " << v << endl; + cerr << "Leftovers: " << setprecision(50) << eAU[n] - eAL[n] << ", " + << eCU - eCL << endl; + } + + if (eAL[n] < 0.0 || eCL < 0.0) { + cerr << "Numerical error detected: (m,k) = " << m << "," << k + << ", eAU[" << n << "] = " << eAU[n] << ", eAL[" << n + << "] = " << eAL[n] << ", eCU[" << n << "] = " << eCU + << ", eCL = " << eCL + << ". Resorting to G1984-style approximation (s,t) = (" << s + << "," << t << ") ..." << endl; + return DrawBridgePMFSameMutationApprox(x, s, t, gen); + } + + break; + } + } + + double100 addon; /// Computing the appropriate additional contributions + + if ((thetaP[0] > 0.0 && thetaP[1] > 0.0) && !(x > 0.0)) { + addon = log(boost::math::beta(thetaP[0], thetaP[1] + m + k)) - + log(boost::math::beta(thetaP[0], thetaP[1] + m)) - + log(boost::math::beta(thetaP[0], thetaP[1] + k)); + } else if (thetaP[0] > 0.0 && thetaP[1] > 0.0) { + addon = log(boost::math::beta(thetaP[0] + m + k, thetaP[1])) - + log(boost::math::beta(thetaP[0] + m, thetaP[1])) - + log(boost::math::beta(thetaP[0] + k, thetaP[1])); + } else { + addon = log(boost::math::beta(m + k, theta)) - + log(boost::math::beta(m, theta)) - + log(boost::math::beta(k, theta)); + } + + dU[n] = (eCL < 0.0 ? static_cast(nan("")) + : exp(log(eAU[n]) + log(qApprox) + addon - log(eCL))); + dL[n] = (eAL[n] < 0.0 ? static_cast(0.0) + : exp(log(eAL[n]) + log(qApprox) + addon - log(eCU))); + v_used.push_back(v); + + if (o.debug > 2) { + cerr << "\nn "; + for (int k = 0; k <= n; ++k) + cerr << k << " "; + cerr << "\ndL "; + for (int k = 0; k <= n; ++k) + cerr << dL[k] << " "; + cerr << "\ndU "; + for (int k = 0; k <= n; ++k) + cerr << dU[k] << " "; + cerr << endl; + } + + currsumL += dL[n]; + currsumU += dU[n]; + + currsumStore.push_back(log(dL[n])); + runningMax = max(runningMax, currsumStore.back()); + mkljStore.resize(mkljStore.size() + 4, -1); + mkljStore[0 + (4 * (currsumStore.size() - 1))] = m; + mkljStore[1 + (4 * (currsumStore.size() - 1))] = k; + mkljStore[2 + (4 * (currsumStore.size() - 1))] = (!(x > 0.0) ? 0 : m); + mkljStore[3 + (4 * (currsumStore.size() - 1))] = (!(x > 0.0) ? 0 : k); + + if (counter == totalpts) /// Gaussian approximation leads to currsum summing + /// to < 1.0, so we renormalise and sample + { + LogSumExp(currsumStore, runningMax); + double100 sum = 0.0; + int ind = 0; + + bool found = false; + + while (!found) { + sum += currsumStore[ind]; + if (sum > u) { + found = true; + } + if (ind == static_cast(currsumStore.size() - 1)) { + found = true; + } + ind++; + } + + vector returnvec; + + returnvec.push_back(mkljStore[0 + (4 * ind)]); + returnvec.push_back(mkljStore[1 + (4 * ind)]); + returnvec.push_back(mkljStore[2 + (4 * ind)]); + returnvec.push_back(mkljStore[3 + (4 * ind)]); + + return returnvec; + } + + bool decision_on_mk_made = (currsumL > u || currsumU < u); + + if (currsumL > currsumU) { + cerr << "Error: currsumL = " << currsumL << " > " << currsumU + << " = currsumU (n,m,k) = (" << n << "," << m << "," << k << ")." + << endl; + exit(1); + } + + while (!decision_on_mk_made) /// Need to refine the upper and lower bounds + { + double100 currsumLold = currsumL, currsumUold = currsumU; + currsumL = 0.0; + currsumU = 0.0; + + const vector dUold(dU), dLold(dL); + for (int i = 0; i <= n; ++i) { + int &mi = curr_mk[i][0], &ki = curr_mk[i][1]; + int morki = (ind1 ? mi : ki), morkapproxi = (morki == mi ? ki : mi); + ++v_used[i]; + double100 newcoefficientU = + exp(Getlogakm(morki + 2 * v_used[i], morki) + + static_cast(-(morki + 2 * v_used[i]) * + (morki + 2 * v_used[i] + theta - 1) * + sorts / 2.0)); + double100 newcoefficientL = + exp(Getlogakm(morki + 2 * v_used[i] + 1, morki) + + static_cast(-(morki + 2 * v_used[i] + 1) * + (morki + 2 * v_used[i] + 1 + theta - 1) * + sorts / 2.0)); + + eAU[i] = eAL[i] + newcoefficientU; + eAL[i] = eAU[i] - newcoefficientL; + + qApprox = DiscretisedNormCDF(morkapproxi, sortsapprox); + + if (2 * (v_used[i] + 1) > eCindex_computed) { + assert(2 * v_used[i] == eCindex_computed); + eCL = eCU - GetdBridgeSame(eCvec, 2 * v_used[i] + 1, x, t); + eCU = eCL + GetdBridgeSame(eCvec, 2 * v_used[i] + 2, x, t); + eCindex_computed += 2; + } + + if ((thetaP[0] > 0.0 && thetaP[1] > 0.0) && !(x > 0.0)) { + addon = log(boost::math::beta(thetaP[0], + thetaP[1] + mi + ki)) - + log(boost::math::beta(thetaP[0], thetaP[1] + mi)) - + log(boost::math::beta(thetaP[0], thetaP[1] + ki)); + } else if (thetaP[0] > 0.0 && thetaP[1] > 0.0) { + addon = log(boost::math::beta(thetaP[0] + mi + ki, + thetaP[1])) - + log(boost::math::beta(thetaP[0] + mi, thetaP[1])) - + log(boost::math::beta(thetaP[0] + ki, thetaP[1])); + } else { + addon = log(boost::math::beta(mi + ki, theta)) - + log(boost::math::beta(mi, theta)) - + log(boost::math::beta(ki, theta)); + } + + dU[i] = + (eCL < 0.0 ? static_cast(nan("")) + : exp(log(eAU[i]) + log(qApprox) + addon - log(eCL))); + dL[i] = + (eAL[i] < 0.0 ? static_cast(0.0) + : exp(log(eAL[i]) + log(qApprox) + addon - log(eCU))); + + if (dLold[i] > dL[i] || dUold[i] < dU[i] || dL[i] > dU[i] || + static_cast(eAU[i]) < 0.0 || + static_cast(eAL[i]) > 1.0 || + static_cast(eCU) < 0.0) { + cerr << "Numerical error detected: (m,k) = " << mi << "," << ki + << "), dL[" << i << "] = " << dL[i] << ", dU[" << i + << "] = " << dU[i] << ", eAU[" << i << "] = " << eAU[i] + << ", eAL[" << i << "] = " << eAL[i] << ", eCU = " << eCU + << ", eCL = " << eCL + << ". Resorting to G1984-style approximation (s,t) = (" << s + << "," << t << ") ..." << endl; + return DrawBridgePMFSameMutationApprox(x, s, t, gen); + } + + currsumL += dL[i]; + currsumU += dU[i]; + + currsumStore[i] = log(dL[i]); + runningMax = max(runningMax, currsumStore[i]); + + if (currsumL > currsumU) { + cerr << "Error: currsumL = " << currsumL << " > " << currsumU + << " = currsumU (n,m,k) = (" << n << "," << m << "," << k << ")." + << endl; + exit(1); + } + } + + if (o.debug > 2) { + cerr << "\ndL "; + printVec(dL, cerr); + cerr << "\ndU "; + printVec(dU, cerr); + } + + if (currsumLold > currsumL) { + cerr << "Error: currsumLold = " << currsumLold << " > " << currsumL + << " = currsumL (n,m,k) = (" << n << "," << m << "," << k << ")." + << endl; + exit(1); + } + if (currsumUold < currsumU) { + cerr << "Error: currsumUold = " << currsumUold << " < " << currsumU + << " = currsumU (n,m,k) = (" << n << "," << m << "," << k << ")." + << endl; + exit(1); + } + + decision_on_mk_made = (currsumL > u || currsumU < u); + } + + mk_found = (currsumL > u); + } + + if (!(x > 0.0)) { + curr_mk[n][2] = 0; /// Setting l & j to be 0 + curr_mk[n][3] = 0; + } else { + curr_mk[n][2] = curr_mk[n][0]; /// Setting l & j to be m & k respectively + curr_mk[n][3] = curr_mk[n][1]; + } + + int coeffcount = 0; + + for (int i = 0; i <= n; ++i) + coeffcount += (v_used[i] + 1); + curr_mk[n].push_back(coeffcount); + curr_mk[n].push_back(0); + + if (o.debug > 2) { + cerr << "p_m,k,l,j: Returned (m,k) = (" << curr_mk[n][0] << "," + << curr_mk[n][1] << ")\n"; + cerr << "n =\t\t\t"; + for (int i = 0; i <= n; ++i) + cerr << i << "\t"; + cerr << "\nv_used =\t"; + for (int i = 0; i <= n; ++i) + cerr << v_used[i] << "\t"; + cerr << "Coeffcount = " << coeffcount << endl; + } + + return curr_mk[n]; +} + +vector WrightFisher::DrawBridgePMFSameMutationApprox( + double100 x, double100 s, double100 t, + boost::random::mt19937 + &gen) /// Draws from the law of a bridge starting and ending at the same + /// boundary point, but both time increments fall below threshold +{ + assert((!(x > 0.0) || !(x < 1.0)) && (t > s) && (s > 0.0)); + vector returnvec; + bool accept = false; + int m, k; + + /// Return (m,k) by running a rejection sampler + double mean = GriffithsParas(t).first, v = GriffithsParas(t).second; + int l = max(static_cast(round(mean - 4.0 * sqrt(v))), 1); + /// Precompute an upper bound for the rejection sampler + double norm = + boost::math::lgamma(static_cast(thetaP[1] + (2 * l))) + + boost::math::lgamma(static_cast(thetaP[0] + thetaP[1] + l)) + + boost::math::lgamma(static_cast(thetaP[0] + thetaP[1] + l)) - + boost::math::lgamma( + static_cast(thetaP[0] + thetaP[1] + (2 * l))) - + boost::math::lgamma(static_cast(thetaP[1] + l)) - + boost::math::lgamma(static_cast(thetaP[1] + l)); + + while (!accept) { + m = DrawSizebiasedAncestralProcess(2, s, gen), + k = DrawSizebiasedAncestralProcess( + 2, t - s, gen); /// Draw (m,k) from a size-biased Ancestral Process + boost::random::uniform_01<> + U01; /// Compute alpha and run an accept/reject step + double u = U01(gen), + alpha = + boost::math::lgamma(static_cast(thetaP[1] + m + k)) + + boost::math::lgamma( + static_cast(thetaP[0] + thetaP[1] + m)) + + boost::math::lgamma( + static_cast(thetaP[0] + thetaP[1] + k)) - + boost::math::lgamma( + static_cast(thetaP[0] + thetaP[1] + m + k)) - + boost::math::lgamma(static_cast(thetaP[1] + m)) - + boost::math::lgamma(static_cast(thetaP[1] + k)); + + if (exp(alpha - norm) > u) { + accept = true; + } + } + + returnvec.push_back(m); + returnvec.push_back(k); + + if (!(x > 0.0)) { + returnvec.push_back(0); /// Setting l & j to be m & k respectively + returnvec.push_back(0); + } else { + returnvec.push_back(m); /// Setting l & j to be m & k respectively + returnvec.push_back(k); + } + + return returnvec; +} + +vector WrightFisher::DrawBridgePMFDifferentMutation( + double100 s, double100 t, double100 x, const Options &o, + boost::random::mt19937 + &gen) /// Draws from the law of a bridge starting and ending at + /// different boundary points and time increments are large enough +{ + assert((!(x > 0.0) || !(x < 1.0)) && (t > s) && (s > 0.0)); + vector> curr_mk; + vector first_mk(4, 0); + first_mk[2] = 1; + first_mk[3] = -1; + curr_mk.push_back(first_mk); + bool mk_found = false; + + /// Set up the necessary quantities + boost::random::uniform_01 U01; + double100 u = U01(gen); + vector eAL, eAU, eBL, eBU, eCU, eCL, dL, dU; + double100 currsumU = 0.0, currsumL = 0.0; + vector v_used; + int n = -1, Fmk = 0, + denomqindex = ((thetaP[0] > 0.0 && thetaP[1] > 0.0) ? 0 : 1); + + /// Compute F ensuring theoretical convergence of upper and lower bounds + pair, double100> Cs, Cts, Ct; + Cs.second = s; + Cts.second = t - s; + Ct.second = t; + int F4 = static_cast( + ceil(max(0.0, 1.0 / static_cast(t) - (theta + 1.0) / 2.0))); + while ((theta + 2 * F4 + 1) * exp(-(2 * F4 + theta) * t / 2.0) >= 1 - o.eps) + ++F4; + + while (!mk_found) { + ++n; + if (n > 0) + curr_mk.push_back(curr_mk.back()); + increment_on_mk(curr_mk.back(), s, t); + int &m = curr_mk[n][0]; + int &k = curr_mk[n][1]; + if (o.debug > 2) + cerr << "New n = " << n << ", (m,k) = (" << m << ", " << k << ")" << endl; + + /// Add the new n to the mix + eAL.push_back(0.0); + eAU.push_back(0.0); + eBL.push_back(0.0); + eBU.push_back(0.0); + eCL.push_back(0.0); + eCU.push_back(0.0); + dL.push_back(0.0); + dU.push_back(0.0); + int F1 = computeC(m, Cs), F2 = computeC(k, Cts), + F3 = computeC(denomqindex, Ct); + if (o.debug > 2) + cerr << "(F1,F2,F3) = (" << F1 << "," << F2 << "," << F3 << ")" << endl; + Fmk = max(max(max(F1, F2), F3), F4); + + int v = -1; + if (o.debug > 2) { + cerr << "F(" << setprecision(0) << m << "," << k << "," << setprecision(4) + << s << "," << t << ") = " << Fmk << endl; + } + + while (2 * v < Fmk || eAU[n] > 1.0 || eBU[n] > 1.0 || eCU[n] > 1.0 || + eAL[n] < 0.0 || eBL[n] < 0.0 || eCL[n] < 0.0) { + ++v; + double100 newcoefficientU = + exp(Getlogakm(m + 2 * v, m) + + static_cast(-(m + 2 * v) * (m + 2 * v + theta - 1) * + s / 2.0)); + double100 newcoefficientL = + exp(Getlogakm(m + 2 * v + 1, m) + + static_cast(-(m + 2 * v + 1) * + (m + 2 * v + 1 + theta - 1) * s / 2.0)); + + eAU[n] = eAL[n] + newcoefficientU; + eAL[n] = eAU[n] - newcoefficientL; + + newcoefficientU = + exp(Getlogakm(k + 2 * v, k) + + static_cast(-(k + 2 * v) * (k + 2 * v + theta - 1) * + (t - s) / 2.0)); + newcoefficientL = exp(Getlogakm(k + 2 * v + 1, k) + + static_cast(-(k + 2 * v + 1) * + (k + 2 * v + 1 + theta - 1) * + (t - s) / 2.0)); + + eBU[n] = eBL[n] + newcoefficientU; + eBL[n] = eBU[n] - newcoefficientL; + + newcoefficientU = + exp(Getlogakm(denomqindex + 2 * v, denomqindex) + + static_cast(-(denomqindex + 2 * v) * + (denomqindex + 2 * v + theta - 1) * (t) / + 2.0)); // Computing q_2 + newcoefficientL = + exp(Getlogakm(denomqindex + 2 * v + 1, denomqindex) + + static_cast(-(denomqindex + 2 * v + 1) * + (denomqindex + 2 * v + 1 + theta - 1) * + (t) / 2.0)); + + eCU[n] = eCL[n] + newcoefficientU; + eCL[n] = eCU[n] - newcoefficientL; + + if (eAU[n] == eAL[n] && eBU[n] == eBL[n] && + eCL[n] == + eCU[n]) /// ...then we have lost precision before reaching Fmk. + { + if (o.debug > 2) { + cerr << "Abandoning loop for n = " << n << ", Fmk = " << Fmk + << " at v = " << v << endl; + cerr << "Leftovers: " << setprecision(50) << eAU[n] - eAL[n] << ", " + << eBU[n] - eBL[n] << ", " << eCU[n] - eCL[n] << endl; + } + + if (eAL[n] < 0.0 || eCL[n] < 0.0) { + cerr << "Numerical error detected: (m,k) = " << m << "," << k + << ", eAU[" << n << "] = " << eAU[n] << ", eAL[" << n + << "] = " << eAL[n] << ", eCU[" << n << "] = " << eCU[n] + << ", eCL = " << eCL[n] + << ". Resorting to G1984-style approximation (s,t) = (" << s + << "," << t << ") ..." << endl; + return DrawBridgePMFDifferentMutationApprox(s, t, x, o, gen); + } + + break; + } + } + + /// Compute the corresponding additional contributions + double100 addon = + boost::math::lgamma(static_cast(theta + k)) + + boost::math::lgamma(static_cast(theta + m)) - + boost::math::lgamma(static_cast(theta + m + k)) - + boost::math::lgamma(static_cast(thetaP[0])) - + boost::math::lgamma(static_cast(thetaP[1])); + + dU[n] = (eCL[n] < 0.0 + ? static_cast(nan("")) + : exp(log(eAU[n]) + log(eBU[n]) + addon - + log(eCL[n] / boost::math::beta( + static_cast(thetaP[0]), + static_cast(thetaP[1]))))); + dL[n] = (eAL[n] < 0.0 || eBL[n] < 0.0 + ? static_cast(0.0) + : exp(log(eAL[n]) + log(eBL[n]) + addon - + log(eCU[n] / boost::math::beta( + static_cast(thetaP[0]), + static_cast(thetaP[1]))))); + v_used.push_back(v); + + if (o.debug > 2) { + cerr << "\nn "; + for (int k = 0; k <= n; ++k) + cerr << k << " "; + cerr << "\ndL "; + for (int k = 0; k <= n; ++k) + cerr << dL[k] << " "; + cerr << "\ndU "; + for (int k = 0; k <= n; ++k) + cerr << dU[k] << " "; + cerr << endl; + } + + currsumL += dL[n]; + currsumU += dU[n]; + + bool decision_on_mk_made = (currsumL > u || currsumU < u); + + if (currsumL > currsumU) { + cerr << "Error: currsumL = " << currsumL << " > " << currsumU + << " = currsumU (n,m,k) = (" << n << "," << m << "," << k << ")." + << endl; + exit(1); + } + + while (!decision_on_mk_made) /// Refine upper and lower bounds + { + double100 currsumLold = currsumL, currsumUold = currsumU; + currsumL = 0.0; + currsumU = 0.0; + + const vector dUold(dU), dLold(dL); + for (int i = 0; i <= n; ++i) { + int &mi = curr_mk[i][0], &ki = curr_mk[i][1]; + ++v_used[i]; + double100 newcoefficientU = + exp(Getlogakm(mi + 2 * v_used[i], mi) + + static_cast( + -(mi + 2 * v_used[i]) * + (mi + 2 * v_used[i] + theta - 1) * s / 2.0)), + newcoefficientL = + exp(Getlogakm(mi + 2 * v_used[i] + 1, mi) + + static_cast( + -(mi + 2 * v_used[i] + 1) * + (mi + 2 * v_used[i] + 1 + theta - 1) * s / 2.0)); + + eAU[i] = eAL[i] + newcoefficientU; + eAL[i] = eAU[i] - newcoefficientL; + + newcoefficientU = + exp(Getlogakm(ki + 2 * v_used[i], ki) + + static_cast(-(ki + 2 * v_used[i]) * + (ki + 2 * v_used[i] + theta - 1) * + (t - s) / 2.0)); + newcoefficientL = + exp(Getlogakm(ki + 2 * v_used[i] + 1, ki) + + static_cast(-(ki + 2 * v_used[i] + 1) * + (ki + 2 * v_used[i] + 1 + theta - 1) * + (t - s) / 2.0)); + + eBU[i] = eBL[i] + newcoefficientU; + eBL[i] = eBU[i] - newcoefficientL; + + newcoefficientU = + exp(Getlogakm(denomqindex + 2 * v_used[i], denomqindex) + + static_cast( + -(denomqindex + 2 * v_used[i]) * + (denomqindex + 2 * v_used[i] + theta - 1) * (t) / 2.0)); + newcoefficientL = exp( + Getlogakm(denomqindex + 2 * v_used[i] + 1, denomqindex) + + static_cast( + -(denomqindex + 2 * v_used[i] + 1) * + (denomqindex + 2 * v_used[i] + 1 + theta - 1) * (t) / 2.0)); + + eCU[i] = eCL[i] + newcoefficientU; + eCL[i] = eCU[i] - newcoefficientL; + + addon = boost::math::lgamma(static_cast(theta + ki)) + + boost::math::lgamma(static_cast(theta + mi)) - + boost::math::lgamma(static_cast(theta + mi + ki)) - + boost::math::lgamma(static_cast(thetaP[0])) - + boost::math::lgamma(static_cast(thetaP[1])); + + dU[i] = + (eCL[i] < 0.0 + ? static_cast(nan("")) + : exp(log(eAU[i]) + log(eBU[i]) + addon - + log(eCL[i] / boost::math::beta( + static_cast(thetaP[0]), + static_cast(thetaP[1]))))); + dL[i] = + ((eAL[i] < 0.0 || eBL[i] < 0.0) + ? static_cast(0.0) + : exp(log(eAL[i]) + log(eBL[i]) + addon - + log(eCU[i] / boost::math::beta( + static_cast(thetaP[0]), + static_cast(thetaP[1]))))); + + if (dLold[i] > dL[i] || dUold[i] < dU[i] || dL[i] > dU[i] || + static_cast(eAU[i]) < 0.0 || + static_cast(eBU[i]) < 0.0 || + static_cast(eAL[i]) > 1.0 || + static_cast(eBL[i]) > 1.0 || + static_cast(eCU[i]) < 0.0) { + cerr << "Numerical error detected: (m,k) = " << mi << "," << ki + << "), dL[" << i << "] = " << dL[i] << ", dU[" << i + << "] = " << dU[i] << ", eAU[" << i << "] = " << eAU[i] + << ", eAL[" << i << "] = " << eAL[i] << ", eBU[" << i + << "] = " << eBU[i] << ", eBL[" << i << "] = " << eBL[i] + << ", eCU = " << eCU[i] << ", eCL = " << eCL[i] + << ". Resorting to G1984-style approximation (s,t) = (" << s + << "," << t << ") ..." << endl; + return DrawBridgePMFDifferentMutationApprox(s, t, x, o, gen); + } + + currsumL += dL[i]; + currsumU += dU[i]; + + if (currsumL > currsumU) { + cerr << "Error: currsumL = " << currsumL << " > " << currsumU + << " = currsumU (n,m,k) = (" << n << "," << m << "," << k << ")." + << endl; + exit(1); + } + } + + if (o.debug > 2) { + cerr << "\ndL "; + printVec(dL, cerr); + cerr << "\ndU "; + printVec(dU, cerr); + } + + if (currsumLold > currsumL) { + cerr << "Error: currsumLold = " << currsumLold << " > " << currsumL + << " = currsumL (n,m,k) = (" << n << "," << m << "," << k << ")." + << endl; + exit(1); + } + if (currsumUold < currsumU) { + cerr << "Error: currsumUold = " << currsumUold << " < " << currsumU + << " = currsumU (n,m,k) = (" << n << "," << m << "," << k << ")." + << endl; + exit(1); + } + + decision_on_mk_made = (currsumL > u || currsumU < u); + } + + mk_found = (currsumL > u); + } + + if (!(x > 0.0)) { + curr_mk[n][2] = 0; /// Setting l & j to be 0 & k respectively + curr_mk[n][3] = curr_mk[n][1]; + } else { + curr_mk[n][2] = curr_mk[n][0]; /// Setting l & j to be m & 0 respectively + curr_mk[n][3] = 0; + } + + int coeffcount = 0; + + for (int i = 0; i <= n; ++i) + coeffcount += (v_used[i] + 1); + curr_mk[n].push_back(coeffcount); + curr_mk[n].push_back(0); + + if (o.debug > 2) { + cerr << "p_m,k,l,j: Returned (m,k) = (" << curr_mk[n][0] << "," + << curr_mk[n][1] << ")\n"; + cerr << "n =\t\t\t"; + for (int i = 0; i <= n; ++i) + cerr << i << "\t"; + cerr << "\nv_used =\t"; + for (int i = 0; i <= n; ++i) + cerr << v_used[i] << "\t"; + cerr << "Coeffcount = " << coeffcount << endl; + } + + return curr_mk[n]; +} + +vector WrightFisher::DrawBridgePMFDifferentMutationOneQApprox( + double100 s, double100 t, double100 x, const Options &o, + boost::random::mt19937 + &gen) /// Draws from the law of a bridge starting and ending at + /// different boundary points, but one of the time increments + /// falls below threshold +{ + assert((!(x > 0.0) || !(x < 1.0)) && (t > s) && (s > 0.0)); + bool ind1 = + (s > o.g1984threshold); /// Figure out whether to approximate q_m or q_k + double100 sorts = (ind1 ? s : t - s), sortsapprox = (sorts == s ? t - s : s); + + vector> curr_mk; + vector first_mk(4, 0), mkljStore; + first_mk[2] = 1; + first_mk[3] = -1; + curr_mk.push_back(first_mk); + bool mk_found = false; + + /// Setting up the necessary quantities + boost::random::uniform_01 U01; + double100 u = U01(gen); + vector eAL, eAU, eCU, eCL, dL, dU, currsumStore; + double100 currsumU = 0.0, currsumL = 0.0, qApprox = 0.0, + runningMax = 1.0e-300; + vector v_used; + int n = -1, Fmk = 0, + denomqindex = ((thetaP[0] > 0.0 && thetaP[1] > 0.0) ? 0 : 1); + /// Mechanism to check whether we have run out of precision due to Gaussian + /// approximations used for one side of the bridge interval - very rare to be + /// needed + double mmode = GriffithsParas(s).first, vm = GriffithsParas(s).second, + kmode = GriffithsParas(t - s).first, vk = GriffithsParas(t - s).second; + int mlimU = static_cast(ceil(mmode + 5.0 * sqrt(vm))), + klimU = static_cast(ceil(kmode + 5.0 * sqrt(vk))), + mlimL = max(0, static_cast(floor(mmode - 5.0 * sqrt(vm)))), + klimL = max(0, static_cast(floor(kmode - 5.0 * sqrt(vk)))); + int totalpts = (mlimU - mlimL) * (klimU - klimL), counter = 0; + + /// Compute F ensuring theoretical convergence of upper and lower bounds + pair, double100> Csorts, Ct; + Csorts.second = sorts; + Ct.second = t; + int F4 = static_cast( + ceil(max(0.0, 1.0 / static_cast(t) - (theta + 1.0) / 2.0))); + while ((theta + 2 * F4 + 1) * exp(-(2 * F4 + theta) * t / 2.0) >= 1 - o.eps) + ++F4; + + while (!mk_found) { + ++n; + if (n > 0) + curr_mk.push_back(curr_mk.back()); + increment_on_mk(curr_mk.back(), s, t); + int &m = curr_mk[n][0]; + int &k = curr_mk[n][1]; + int mork = (ind1 ? m : k), morkapprox = (mork == m ? k : m); + if (m <= mlimU && m >= mlimL && k <= klimU && k >= klimL) + counter++; + if (o.debug > 2) + cerr << "New n = " << n << ", (m,k) = (" << m << ", " << k << ")" << endl; + + /// Add the new n to the mix + eAL.push_back(0.0); + eAU.push_back(0.0); + eCL.push_back(0.0); + eCU.push_back(0.0); + dL.push_back(0.0); + dU.push_back(0.0); + int F1 = computeC(mork, Csorts), F3 = computeC(denomqindex, Ct); + if (o.debug > 2) + cerr << "(F1,F3) = (" << F1 << "," << F3 << ")" << endl; + Fmk = max(max(F1, F3), F4); + + int v = -1; + if (o.debug > 2) { + cerr << "F(" << setprecision(0) << m << "," << k << "," << setprecision(4) + << s << "," << t << ") = " << Fmk << endl; + } + + while (2 * v < Fmk) { + ++v; + double100 newcoefficientU = + exp(Getlogakm(mork + 2 * v, mork) + + static_cast(-(mork + 2 * v) * + (mork + 2 * v + theta - 1) * sorts / 2.0)); + double100 newcoefficientL = exp( + Getlogakm(mork + 2 * v + 1, mork) + + static_cast(-(mork + 2 * v + 1) * + (mork + 2 * v + 1 + theta - 1) * sorts / 2.0)); + + eAU[n] = eAL[n] + newcoefficientU; + eAL[n] = eAU[n] - newcoefficientL; + + qApprox = DiscretisedNormCDF(morkapprox, sortsapprox); + + newcoefficientU = + exp(Getlogakm(denomqindex + 2 * v, denomqindex) + + static_cast(-(denomqindex + 2 * v) * + (denomqindex + 2 * v + theta - 1) * (t) / + 2.0)); // Computing q_2 + newcoefficientL = + exp(Getlogakm(denomqindex + 2 * v + 1, denomqindex) + + static_cast(-(denomqindex + 2 * v + 1) * + (denomqindex + 2 * v + 1 + theta - 1) * + (t) / 2.0)); + + eCU[n] = eCL[n] + newcoefficientU; + eCL[n] = eCU[n] - newcoefficientL; + + if (eAU[n] == eAL[n] && + eCL[n] == + eCU[n]) /// ...then we have lost precision before reaching Fmk. + { + if (o.debug > 2) { + cerr << "Abandoning loop for n = " << n << ", Fmk = " << Fmk + << " at v = " << v << endl; + cerr << "Leftovers: " << setprecision(50) << eAU[n] - eAL[n] << ", " + << eCU[n] - eCL[n] << endl; + } + + if (eAL[n] < 0.0 || eCL[n] < 0.0) { + cerr << "Numerical error detected: (m,k) = " << m << "," << k + << ", eAU[" << n << "] = " << eAU[n] << ", eAL[" << n + << "] = " << eAL[n] << ", eCU[" << n << "] = " << eCU[n] + << ", eCL = " << eCL[n] + << ". Resorting to G1984-style approximation (s,t) = (" << s + << "," << t << ") ..." << endl; + return DrawBridgePMFDifferentMutationApprox(s, t, x, o, gen); + } + + break; + } + } + + /// Compute the appropriate additional contributions + double100 addon = + boost::math::lgamma(static_cast(theta + k)) + + boost::math::lgamma(static_cast(theta + m)) - + boost::math::lgamma(static_cast(theta + m + k)) - + boost::math::lgamma(static_cast(thetaP[0])) - + boost::math::lgamma(static_cast(thetaP[1])); + + dU[n] = (eCL[n] < 0.0 + ? static_cast(nan("")) + : exp(log(eAU[n]) + log(qApprox) + addon - + log(eCL[n] / boost::math::beta( + static_cast(thetaP[0]), + static_cast(thetaP[1]))))); + dL[n] = (eAL[n] < 0.0 + ? static_cast(0.0) + : exp(log(eAL[n]) + log(qApprox) + addon - + log(eCU[n] / boost::math::beta( + static_cast(thetaP[0]), + static_cast(thetaP[1]))))); + v_used.push_back(v); + + if (o.debug > 2) { + cerr << "\nn "; + for (int k = 0; k <= n; ++k) + cerr << k << " "; + cerr << "\ndL "; + for (int k = 0; k <= n; ++k) + cerr << dL[k] << " "; + cerr << "\ndU "; + for (int k = 0; k <= n; ++k) + cerr << dU[k] << " "; + cerr << endl; + } + + currsumL += dL[n]; + currsumU += dU[n]; + + currsumStore.push_back(log(dL[n])); + runningMax = max(runningMax, currsumStore.back()); + mkljStore.resize(mkljStore.size() + 4, -1); + mkljStore[0 + (4 * (currsumStore.size() - 1))] = m; + mkljStore[1 + (4 * (currsumStore.size() - 1))] = k; + mkljStore[2 + (4 * (currsumStore.size() - 1))] = (!(x > 0.0) ? 0 : m); + mkljStore[3 + (4 * (currsumStore.size() - 1))] = (!(x > 0.0) ? k : 0); + + if (counter == totalpts) /// Gaussian approximation leads to currsum summing + /// to < 1.0, so we renormalise and sample + { + LogSumExp(currsumStore, runningMax); + double100 sum = 0.0; + int ind = 0; + + bool found = false; + + while (!found) { + sum += currsumStore[ind]; + if (sum > u) { + found = true; + } + if (ind == static_cast(currsumStore.size() - 1)) { + found = true; + } + ind++; + } + + vector returnvec; + + returnvec.push_back(mkljStore[0 + (4 * ind)]); + returnvec.push_back(mkljStore[1 + (4 * ind)]); + returnvec.push_back(mkljStore[2 + (4 * ind)]); + returnvec.push_back(mkljStore[3 + (4 * ind)]); + + return returnvec; + } + + bool decision_on_mk_made = (currsumL > u || currsumU < u); + + if (currsumL > currsumU) { + cerr << "Error: currsumL = " << currsumL << " > " << currsumU + << " = currsumU (n,m,k) = (" << n << "," << m << "," << k << ")." + << endl; + exit(1); + } + + while (!decision_on_mk_made) /// Refine upper and lower bounds + { + double100 currsumLold = currsumL, currsumUold = currsumU; + currsumL = 0.0; + currsumU = 0.0; + + const vector dUold(dU), dLold(dL); + for (int i = 0; i <= n; ++i) { + int &mi = curr_mk[i][0], &ki = curr_mk[i][1], morki = (ind1 ? mi : ki), + morkapproxi = (morki == mi ? ki : mi); + ++v_used[i]; + double100 newcoefficientU = exp( + Getlogakm(morki + 2 * v_used[i], morki) + + static_cast( + -(morki + 2 * v_used[i]) * + (morki + 2 * v_used[i] + theta - 1) * sorts / 2.0)), + newcoefficientL = exp( + Getlogakm(morki + 2 * v_used[i] + 1, morki) + + static_cast( + -(morki + 2 * v_used[i] + 1) * + (morki + 2 * v_used[i] + 1 + theta - 1) * sorts / + 2.0)); + + eAU[i] = eAL[i] + newcoefficientU; + eAL[i] = eAU[i] - newcoefficientL; + + qApprox = DiscretisedNormCDF(morkapproxi, sortsapprox); + + newcoefficientU = + exp(Getlogakm(denomqindex + 2 * v_used[i], denomqindex) + + static_cast( + -(denomqindex + 2 * v_used[i]) * + (denomqindex + 2 * v_used[i] + theta - 1) * (t) / 2.0)); + newcoefficientL = exp( + Getlogakm(denomqindex + 2 * v_used[i] + 1, denomqindex) + + static_cast( + -(denomqindex + 2 * v_used[i] + 1) * + (denomqindex + 2 * v_used[i] + 1 + theta - 1) * (t) / 2.0)); + + eCU[i] = eCL[i] + newcoefficientU; + eCL[i] = eCU[i] - newcoefficientL; + + addon = boost::math::lgamma(static_cast(theta + ki)) + + boost::math::lgamma(static_cast(theta + mi)) - + boost::math::lgamma(static_cast(theta + mi + ki)) - + boost::math::lgamma(static_cast(thetaP[0])) - + boost::math::lgamma(static_cast(thetaP[1])); + + dU[i] = + (eCL[i] < 0.0 + ? static_cast(nan("")) + : exp(log(eAU[i]) + log(qApprox) + addon - + log(eCL[i] / boost::math::beta( + static_cast(thetaP[0]), + static_cast(thetaP[1]))))); + dL[i] = + (eAL[i] < 0.0 + ? static_cast(0.0) + : exp(log(eAL[i]) + log(qApprox) + addon - + log(eCU[i] / boost::math::beta( + static_cast(thetaP[0]), + static_cast(thetaP[1]))))); + + if (dLold[i] > dL[i] || dUold[i] < dU[i] || dL[i] > dU[i] || + static_cast(eAU[i]) < 0.0 || + static_cast(eAL[i]) > 1.0 || + static_cast(eCU[i]) < 0.0) { + cerr << "Numerical error detected: (m,k) = " << mi << "," << ki + << "), dL[" << i << "] = " << dL[i] << ", dU[" << i + << "] = " << dU[i] << ", eAU[" << i << "] = " << eAU[i] + << ", eAL[" << i << "] = " << eAL[i] << ", eCU = " << eCU[i] + << ", eCL = " << eCL[i] + << ". Resorting to G1984-style approximation (s,t) = (" << s + << "," << t << ") ..." << endl; + return DrawBridgePMFDifferentMutationApprox(s, t, x, o, gen); + } + + currsumL += dL[i]; + currsumU += dU[i]; + + currsumStore[i] = log(dL[i]); + runningMax = max(runningMax, currsumStore[i]); + + if (currsumL > currsumU) { + cerr << "Error: currsumL = " << currsumL << " > " << currsumU + << " = currsumU (n,m,k) = (" << n << "," << m << "," << k << ")." + << endl; + exit(1); + } + } + + if (o.debug > 2) { + cerr << "\ndL "; + printVec(dL, cerr); + cerr << "\ndU "; + printVec(dU, cerr); + } + + if (currsumLold > currsumL) { + cerr << "Error: currsumLold = " << currsumLold << " > " << currsumL + << " = currsumL (n,m,k) = (" << n << "," << m << "," << k << ")." + << endl; + exit(1); + } + if (currsumUold < currsumU) { + cerr << "Error: currsumUold = " << currsumUold << " < " << currsumU + << " = currsumU (n,m,k) = (" << n << "," << m << "," << k << ")." + << endl; + exit(1); + } + + decision_on_mk_made = (currsumL > u || currsumU < u); + } + + mk_found = (currsumL > u); + } + + if (!(x > 0.0)) { + curr_mk[n][2] = 0; /// Setting l & j to be 0 & k respectively + curr_mk[n][3] = curr_mk[n][1]; + } else { + curr_mk[n][2] = curr_mk[n][0]; /// Setting l & j to be m & 0 respectively + curr_mk[n][3] = 0; + } + + int coeffcount = 0; + + for (int i = 0; i <= n; ++i) + coeffcount += (v_used[i] + 1); + curr_mk[n].push_back(coeffcount); + curr_mk[n].push_back(0); + + if (o.debug > 2) { + cerr << "p_m,k,l,j: Returned (m,k) = (" << curr_mk[n][0] << "," + << curr_mk[n][1] << ")\n"; + cerr << "n =\t\t\t"; + for (int i = 0; i <= n; ++i) + cerr << i << "\t"; + cerr << "\nv_used =\t"; + for (int i = 0; i <= n; ++i) + cerr << v_used[i] << "\t"; + cerr << "Coeffcount = " << coeffcount << endl; + } + + return curr_mk[n]; +} + +vector WrightFisher::DrawBridgePMFDifferentMutationApprox( + double100 s, double100 t, double100 x, const Options &o, + boost::random::mt19937 & + gen) /// Draws from the law of a bridge starting and ending at different + /// boundary points, but both time increments fall below threshold +{ + assert((!(x > 0.0) || !(x < 1.0)) && (t > s) && (s > 0.0)); + vector returnvec; + vector currsumStore; + vector mkStore; + + /// Compute denominator depending on value of time increment t + double100 eC = + (t <= o.g1984threshold ? DiscretisedNormCDF(0, t) : QmApprox(0, t, o)) / + boost::math::beta(static_cast(thetaP[0]), + static_cast(thetaP[1])); + + /// Compute a guess to the mode over (m,k) + vector modeGuess = mkModeFinder(x, 1.0 - x, s, t, o); + int mMode = modeGuess[0], + kMode = modeGuess[1]; /// Use this guess & eC to obtain a suitable + /// threshold for subsequent calculations + double100 constContr = -log(eC) - boost::math::lgamma(thetaP[0]) - + boost::math::lgamma(thetaP[1]); + double100 currsum = 0.0, + threshold = + exp(mkModeFinder_Evaluator(mMode, kMode, x, 1.0 - x, s, t, o) - + constContr) * + 1.0e-4, + runningMax = -1.0e100; + + int m = mMode, mFlip = 1, mD = 0, mU = 0; + bool mSwitch = false, mDownSwitch = false, mUpSwitch = false; + + while (!mSwitch) { + int kFlip = 1, k = kMode, kU = 0, kD = 0; + bool kSwitch = false, kDownSwitch = false, kUpSwitch = false; + + while (!kSwitch) { + double100 currsum_inc = + log(QmApprox(m, s, o)) + log(QmApprox(k, t - s, o)) + + boost::math::lgamma(static_cast(theta + k)) + + boost::math::lgamma(static_cast(theta + m)) - + boost::math::lgamma(static_cast(theta + m + k)) - + constContr; + + currsum += exp(currsum_inc); + runningMax = + max(currsum_inc, runningMax); /// Storing maximum of log probabilities + /// for log-sum-exp trick + currsumStore.push_back(currsum_inc); + + mkStore.resize(mkStore.size() + 2, -1); + mkStore[0 + (2 * (currsumStore.size() - 1))] = m; + mkStore[1 + (2 * (currsumStore.size() - 1))] = k; + + if (!(kDownSwitch)) /// Mechanism to explore k + { + if (sgn(k - kMode) <= 0) { + kDownSwitch = + ((exp(currsum_inc) < threshold) || (kMode - kD - 1) < 0); + } + } + + if (!(kUpSwitch)) { + if (sgn(k - kMode) >= 0) { + kUpSwitch = (exp(currsum_inc) < threshold); + } + } + + kSwitch = (kDownSwitch && kUpSwitch); + + if (!kSwitch) { + if (kFlip == 1 || (kDownSwitch && !(kUpSwitch))) { + kU++; + k = kMode + kU; + kFlip *= (kDownSwitch ? 1 : -1); + } else if ((kFlip == -1 && (kMode - kD - 1 >= 0)) || + (kUpSwitch && !(kDownSwitch))) { + kD++; + k = kMode - kD; + kFlip *= (kUpSwitch ? 1 : -1); + } + } + } + + if (!(mDownSwitch)) /// Mechanism to explore m + { + if (sgn(m - mMode) <= 0) { + mDownSwitch = (((kU == 0) && (kD == 0)) || (mMode - mD - 1 < 0)); + } + } + + if (!(mUpSwitch)) { + if (sgn(m - mMode) >= 0) { + mUpSwitch = ((kU == 0) && (kD == 0)); + } + } + + mSwitch = (mDownSwitch && mUpSwitch); + + if (!mSwitch) { + if (mFlip == 1) { + mU++; + m = mMode + mU; + mFlip *= (mDownSwitch ? 1 : -1); + } else if ((mFlip == -1) && (mMode - mD - 1 >= 0)) { + mD++; + m = mMode - mD; + mFlip *= (mUpSwitch ? 1 : -1); + } + } + } + + LogSumExp(currsumStore, runningMax); /// Log-sum-exp trick to normalise vector + /// of log probabilities + double100 sum = 0.0; + int index, ind = 0; + boost::random::uniform_01 U01; + double100 u = U01(gen); + + vector indexing(currsumStore.size(), 0); + for (int i = 0; i != static_cast(indexing.size()); i++) { + indexing[i] = i; + } + sort(indexing.begin(), indexing.end(), /// Sort vector + [&](const int &a, const int &b) { + return (currsumStore[a] > currsumStore[b]); + }); + + bool found = false; + + while (!found) { + sum += currsumStore[indexing[ind]]; + if (sum > u) { + index = + indexing[ind]; /// Figure out what the correct index for mkljStore is + found = true; + } + if (ind == static_cast(currsumStore.size())) /// Ending condition + { + index = indexing[ind]; + found = true; + } + ind++; + } + + if (!(x > 0.0)) /// Setting l = 0, j = k + { + returnvec.push_back(mkStore[0 + (2 * index)]); + returnvec.push_back(mkStore[1 + (2 * index)]); + returnvec.push_back(0); + returnvec.push_back(mkStore[1 + (2 * index)]); + } else /// Setting l = m, j = 0 + { + returnvec.push_back(mkStore[0 + (2 * index)]); + returnvec.push_back(mkStore[1 + (2 * index)]); + returnvec.push_back(mkStore[0 + (2 * index)]); + returnvec.push_back(0); + } + + return returnvec; +} + +vector WrightFisher::DrawBridgePMFInteriorMutation( + double100 x, double100 z, double100 s, double100 t, const Options &o, + boost::random::mt19937 + &gen) /// Draws from the law of a bridge starting at a boundary point + /// but ending in the interior of (0,1) with both time increments + /// large enough +{ + assert((!(x > 0.0) || !(x < 1.0)) && (z > 0.0) && (z < 1.0) && (t > s) && + (s > 0.0)); + vector> curr_mk; + vector first_mk(4, 0); + first_mk[2] = 1; + first_mk[3] = -1; + curr_mk.push_back(first_mk); + bool mkj_found = false; + + /// Setting up necessary quantities + boost::random::uniform_01 U01; + double100 u = U01(gen); + vector eCvec, eAL, eAU, eBL, eBU, dL, dU; + double100 currsumU = 0.0, currsumL = 0.0, eCL = 0.0, + eCU(GetdBridgeInterior(eCvec, 0, x, z, t)); + vector v_used; + double100 Amkj; + int n = -1, Fmkj = 0, eCindex_computed = 0; + + /// Compute F ensuring theoretical convergence of upper and lower bounds + pair, double100> Cs, Cts, Ct; + Cs.second = s; + Cts.second = t - s; + Ct.second = t; + int F3 = computeE(Ct), + F4 = static_cast( + ceil(max(0.0, 1.0 / static_cast(t) - (theta + 1.0) / 2.0))), + F5 = (!(x > 0.0) ? static_cast(floor( + (theta + 2.0) / (o.eps * (thetaP[1] + 1.0)) - 1)) + + 1 + : static_cast(floor( + (theta + 2.0) / (o.eps * (thetaP[0] + 1.0)) - 1)) + + 1); + while ((theta + 2 * F4 + 1) * exp(-(2 * F4 + theta) * t / 2.0) >= 1 - o.eps) + ++F4; + int F6 = 2 * max(max(F3, F4), F5); + + while (!mkj_found) { + ++n; + if (n > 0) + curr_mk.push_back(curr_mk.back()); + increment_on_mk(curr_mk.back(), s, t); + int &m = curr_mk[n][0]; + int &k = curr_mk[n][1]; + if (o.debug > 2) + cerr << "New n = " << n << ", (m,k) = (" << m << ", " << k << ")" << endl; + + /// Add the new n to the mix + eAL.push_back(0.0); + eAU.push_back(0.0); + eBL.push_back(0.0); + eBU.push_back(0.0); + dL.push_back(0.0); + dU.push_back(0.0); + int F1 = computeC(m, Cs), F2 = computeC(k, Cts); + if (o.debug > 2) + cerr << "(F1,F2,F3,F4,F5) = (" << F1 << "," << F2 << "," << F3 << "," + << F4 << "," << F5 << ")" << endl; + Fmkj = max(max(F1, F2), F6); + + int v = -1; + if (o.debug > 2) { + cerr << "F(" << setprecision(0) << m << "," << k << "," << setprecision(4) + << x << "," << z << "," << s << "," << t << ") = " << Fmkj << endl; + } + + while (2 * v < Fmkj || eAU[n] > 1.0 || eBU[n] > 1.0) { + ++v; + double100 newcoefficientU = + exp(Getlogakm(m + 2 * v, m) + + static_cast(-(m + 2 * v) * (m + 2 * v + theta - 1) * + s / 2.0)); + double100 newcoefficientL = + exp(Getlogakm(m + 2 * v + 1, m) + + static_cast(-(m + 2 * v + 1) * + (m + 2 * v + 1 + theta - 1) * s / 2.0)); + + eAU[n] = eAL[n] + newcoefficientU; + eAL[n] = eAU[n] - newcoefficientL; + + newcoefficientU = + exp(Getlogakm(k + 2 * v, k) + + static_cast(-(k + 2 * v) * (k + 2 * v + theta - 1) * + (t - s) / 2.0)); + newcoefficientL = exp(Getlogakm(k + 2 * v + 1, k) + + static_cast(-(k + 2 * v + 1) * + (k + 2 * v + 1 + theta - 1) * + (t - s) / 2.0)); + + eBU[n] = eBL[n] + newcoefficientU; + eBL[n] = eBU[n] - newcoefficientL; + + if (2 * v + 2 > eCindex_computed) { + assert(2 * v == eCindex_computed); + eCL = eCU - GetdBridgeInterior(eCvec, 2 * v + 1, x, z, t); + eCU = eCL + GetdBridgeInterior(eCvec, 2 * v + 2, x, z, t); + eCindex_computed += 2; + } + + if (eAU[n] == eAL[n] && eBU[n] == eBL[n] && + eCL == eCU) /// ...then we have lost precision before reaching Fmkj. + { + if (o.debug > 2) { + cerr << "Abandoning loop for n = " << n << ", Fmkj = " << Fmkj + << " at v = " << v << endl; + cerr << "Leftovers: " << setprecision(50) << eAU[n] - eAL[n] << ", " + << eBU[n] - eBL[n] << ", " << eCU - eCL << endl; + } + + if (eAL[n] < 0.0 || eCL < 0.0) { + cerr << "Numerical error detected: (m,k) = " << m << "," << k + << ", eAU[" << n << "] = " << eAU[n] << ", eAL[" << n + << "] = " << eAL[n] << ", eCU[" << n << "] = " << eCU + << ", eCL = " << eCL + << ". Resorting to G1984-style approximation (s,t) = (" << s + << "," << t << ") ..." << endl; + return DrawBridgePMFInteriorMutationApprox(x, z, s, t, o, gen); + } + + break; + } + } + + dU[n] = (eCL < 0.0 ? static_cast(nan("")) + : exp(log(eAU[n]) + log(eBU[n]) - log(eCL))); + dL[n] = (eAL[n] < 0.0 || eBL[n] < 0.0 + ? static_cast(0.0) + : exp(log(eAL[n]) + log(eBL[n]) - log(eCU))); + v_used.push_back(v); + + if (o.debug > 2) { + cerr << "\nn "; + for (int k = 0; k <= n; ++k) + cerr << k << " "; + cerr << "\ndL "; + for (int k = 0; k <= n; ++k) + cerr << dL[k] << " "; + cerr << "\ndU "; + for (int k = 0; k <= n; ++k) + cerr << dU[k] << " "; + cerr << endl; + } + + /// Add on j contributions + int lindex = (!(x < 1.0) ? m : 0); + for (int j = 0; j <= k && !mkj_found; ++j) { + Amkj = computeA(m, k, lindex, j, x, z); + if (o.debug > 2) + cerr << "Adding to currsums with A(n,m,k,j) = A(" << n << "," << m + << "," << k << "," << j << ") = " << Amkj << endl; + + if (Amkj * dL[n] > 1.0 || Amkj * dU[n] < 0.0 || eAU[n] < 0.0 || + eBU[n] < 0.0 || eAL[n] > 1.0 || eBL[n] > 1.0 || eCU < 0.0) { + cerr << "Numerical error detected: (m,k,j) = " << m << "," << k << "," + << j << "), Amkj = " << Amkj << ", dL[" << n << "] = " << dL[n] + << ", dU[" << n << "] = " << dU[n] << ", eAU[" << n + << "] = " << eAU[n] << ", eAL[" << n << "] = " << eAL[n] + << ", eBU[" << n << "] = " << eBU[n] << ", eBL[" << n + << "] = " << eBL[n] << ", eCU = " << eCU << ", eCL = " << eCL + << ". Resorting to G1984-style approximation (x,z,s,t) = (" << x + << "," << z << "," << s << "," << t << ") ..." << endl; + return DrawBridgePMFInteriorMutationApprox(x, z, s, t, o, gen); + } + + currsumL += Amkj * dL[n]; + currsumU += Amkj * dU[n]; + bool decision_on_mkj_made = (currsumL > u || currsumU < u); + + if (currsumL > currsumU) { + cerr << "Error: currsumL = " << currsumL << " > " << currsumU + << " = currsumU (n,m,k,j) = (" << n << "," << m << "," << k << "," + << j << ")." << endl; + exit(1); + } + + while (!decision_on_mkj_made) /// Refine upper and lower bounds + { + double100 currsumLold = currsumL, currsumUold = currsumU; + currsumL = 0.0; + currsumU = 0.0; + + const vector dUold(dU), dLold(dL); + for (int i = 0; i <= n; ++i) { + int &mi = curr_mk[i][0], &ki = curr_mk[i][1]; + ++v_used[i]; + double100 newcoefficientU = + exp(Getlogakm(mi + 2 * v_used[i], mi) + + static_cast(-(mi + 2 * v_used[i]) * + (mi + 2 * v_used[i] + theta - 1) * s / + 2.0)); + double100 newcoefficientL = + exp(Getlogakm(mi + 2 * v_used[i] + 1, mi) + + static_cast(-(mi + 2 * v_used[i] + 1) * + (mi + 2 * v_used[i] + 1 + theta - 1) * + s / 2.0)); + + eAU[i] = eAL[i] + newcoefficientU; + eAL[i] = eAU[i] - newcoefficientL; + + newcoefficientU = + exp(Getlogakm(ki + 2 * v_used[i], ki) + + static_cast(-(ki + 2 * v_used[i]) * + (ki + 2 * v_used[i] + theta - 1) * + (t - s) / 2.0)); + newcoefficientL = + exp(Getlogakm(ki + 2 * v_used[i] + 1, ki) + + static_cast(-(ki + 2 * v_used[i] + 1) * + (ki + 2 * v_used[i] + 1 + theta - 1) * + (t - s) / 2.0)); + + eBU[i] = eBL[i] + newcoefficientU; + eBL[i] = eBU[i] - newcoefficientL; + + if (2 * v_used[i] + 2 > eCindex_computed) { + assert(2 * v_used[i] == eCindex_computed); + eCL = eCU - GetdBridgeInterior(eCvec, 2 * v_used[i] + 1, x, z, t); + eCU = eCL + GetdBridgeInterior(eCvec, 2 * v_used[i] + 2, x, z, t); + eCindex_computed += 2; + } + + dU[i] = (eCL < 0.0 ? static_cast(nan("")) + : exp(log(eAU[i]) + log(eBU[i]) - log(eCL))); + dL[i] = ((eAL[i] < 0.0 || eBL[i] < 0.0) + ? static_cast(0.0) + : exp(log(eAL[i]) + log(eBL[i]) - log(eCU))); + + if (dLold[i] > dL[i] || dUold[i] < dU[i] || dL[i] > dU[i] || + static_cast(eAU[i]) < 0.0 || + static_cast(eBU[i]) < 0.0 || + static_cast(eAL[i]) > 1.0 || + static_cast(eBL[i]) > 1.0 || + static_cast(eCU) < 0.0) { + cerr << "Numerical error detected: (m,k,j) = " << mi << "," << ki + << ", *, *), dL[" << i << "] = " << dL[i] << ", dU[" << i + << "] = " << dU[i] << ", eAU[" << i << "] = " << eAU[i] + << ", eAL[" << i << "] = " << eAL[i] << ", eBU[" << i + << "] = " << eBU[i] << ", eBL[" << i << "] = " << eBL[i] + << ", eCU = " << eCU << ", eCL = " << eCL + << ". Resorting to G1984-style approximation (x,z,s,t) = (" + << x << "," << z << "," << s << "," << t << ") ..." << endl; + return DrawBridgePMFInteriorMutationApprox(x, z, s, t, o, gen); + } + + int liindex = (!(x < 1.0) ? mi : 0); + for (int j2 = 0; j2 <= ki; ++j2) { + Amkj = computeA(mi, ki, liindex, j2, x, z); + currsumL += Amkj * dL[i]; + currsumU += Amkj * dU[i]; + if (o.debug > 3) + cerr << "Recomputing currsums with A(n,m,k,j) = A(" << i << "," + << mi << "," << ki << "," << j2 << ") = " << Amkj << endl; + } + } + + if (currsumL > currsumU) { + cerr << "Error: currsumL = " << currsumL << " > " << currsumU + << " = currsumU (n,m,k,j) = (" << n << "," << m << "," << k + << "," << j << ")." << endl; + exit(1); + } + + if (o.debug > 2) { + cerr << "\ndL "; + printVec(dL, cerr); + cerr << "\ndU "; + printVec(dU, cerr); + } + + if (currsumLold > currsumL) { + cerr << "Error: currsumLold = " << currsumLold << " > " << currsumL + << " = currsumL (n,m,k,j) = (" << n << "," << m << "," << k + << "," << j << ")." << endl; + exit(1); + } + if (currsumUold < currsumU) { + cerr << "Error: currsumUold = " << currsumUold << " < " << currsumU + << " = currsumU (n,m,k,j) = (" << n << "," << m << "," << k + << "," << j << ")." << endl; + exit(1); + } + + decision_on_mkj_made = (currsumL > u || currsumU < u); + } + + mkj_found = (currsumL > u); + + if (mkj_found) { + if (!(x > 0.0)) { + curr_mk[n][2] = 0; /// Sets l = 0 + curr_mk[n][3] = j; + } else { + curr_mk[n][2] = m; /// Sets l = m + curr_mk[n][3] = j; + } + } + } + } + + int coeffcount = 0; + for (int i = 0; i <= n; ++i) + coeffcount += (v_used[i] + 1); + curr_mk[n].push_back(coeffcount); + curr_mk[n].push_back(0); + + if (o.debug > 2) { + cerr << "p_m,k,j: Returned (m,k,j) = (" << curr_mk[n][0] << "," + << curr_mk[n][1] << "," << curr_mk[n][3] << ")\n"; + cerr << "n =\t\t\t"; + for (int i = 0; i <= n; ++i) + cerr << i << "\t"; + cerr << "\nv_used =\t"; + for (int i = 0; i <= n; ++i) + cerr << v_used[i] << "\t"; + cerr << "Coeffcount = " << coeffcount << endl; + } + + return curr_mk[n]; +} + +vector WrightFisher::DrawBridgePMFInteriorMutationOneQApprox( + double100 x, double100 z, double100 s, double100 t, const Options &o, + boost::random::mt19937 + &gen) /// Draws from the law of a bridge starting at a boundary point + /// but ending in the interior of (0,1) but one time increment is + /// below the threshold +{ + assert((!(x > 0.0) || !(x < 1.0)) && (z > 0.0) && (z < 1.0) && (t > s) && + (s > 0.0)); + bool ind1 = + (s > o.g1984threshold); /// Figure out whether to approximate q_m or q_k + double100 sorts = (ind1 ? s : t - s), sortsapprox = (sorts == s ? t - s : s); + + vector> curr_mk; + vector first_mk(4, 0), mkljStore; + first_mk[2] = 1; + first_mk[3] = -1; + curr_mk.push_back(first_mk); + bool mkj_found = false; + + /// Setting up the necessary quantities + boost::random::uniform_01 U01; + double100 u = U01(gen); + vector eCvec, eAL, eAU, dL, dU, currsumStore; + double100 currsumU = 0.0, currsumL = 0.0, eCL = 0.0, + eCU(GetdBridgeInterior(eCvec, 0, x, z, t)), qApprox = 0.0; + vector v_used; + double100 Amkj, runningMax = 1.0e-300; + int n = -1, Fmkj = 0, eCindex_computed = 0; + /// Mechanism to check whether we have run out of precision due to Gaussian + /// approximations used for one side of the bridge interval - very rare to be + /// needed + double mmode = GriffithsParas(s).first, vm = GriffithsParas(s).second, + kmode = GriffithsParas(t - s).first, vk = GriffithsParas(t - s).second; + int mlimU = static_cast(ceil(mmode + 5.0 * sqrt(vm))), + klimU = static_cast(ceil(kmode + 5.0 * sqrt(vk))), + mlimL = max(0, static_cast(floor(mmode - 5.0 * sqrt(vm)))), + klimL = max(0, static_cast(floor(kmode - 5.0 * sqrt(vk)))); + int totalpts = (mlimU - mlimL) * (klimU - klimL), counter = 0; + + /// Compute F ensuring theoretical convergence of upper and lower bounds + pair, double100> Csorts, Ct; + Csorts.second = sorts; + Ct.second = t; + int F3 = computeE(Ct), + F4 = static_cast( + ceil(max(0.0, 1.0 / static_cast(t) - (theta + 1.0) / 2.0))), + F5 = static_cast(ceil(2.0 / o.eps) + 1); + while ((theta + 2 * F4 + 1) * exp(-(2 * F4 + theta) * t / 2.0) >= 1 - o.eps) + ++F4; + int F6 = 2 * max(max(F3, F4), F5); + + while (!mkj_found) { + ++n; + if (n > 0) + curr_mk.push_back(curr_mk.back()); + increment_on_mk(curr_mk.back(), s, t); + int &m = curr_mk[n][0]; + int &k = curr_mk[n][1]; + int mork = (ind1 ? m : k), morkapprox = (mork == m ? k : m); + if (m <= mlimU && m >= mlimL && k <= klimU && k >= klimL) + counter++; + if (o.debug > 2) + cerr << "New n = " << n << ", (m,k) = (" << m << ", " << k << ")" << endl; + + /// Add the new n to the mix + eAL.push_back(0.0); + eAU.push_back(0.0); + dL.push_back(0.0); + dU.push_back(0.0); + int F1 = computeC(mork, Csorts); + if (o.debug > 2) + cerr << "(F1,F3,F4,F5) = (" << F1 << "," << F3 << "," << F4 << "," << F5 + << ")" << endl; + Fmkj = max(F1, F6); + + int v = -1; + if (o.debug > 2) { + cerr << "F(" << setprecision(0) << m << "," << k << "," << setprecision(4) + << x << "," << z << "," << s << "," << t << ") = " << Fmkj << endl; + } + + while (2 * v < Fmkj) { + ++v; + double100 newcoefficientU = + exp(Getlogakm(mork + 2 * v, mork) + + static_cast(-(mork + 2 * v) * + (mork + 2 * v + theta - 1) * sorts / 2.0)); + double100 newcoefficientL = exp( + Getlogakm(mork + 2 * v + 1, mork) + + static_cast(-(mork + 2 * v + 1) * + (mork + 2 * v + 1 + theta - 1) * sorts / 2.0)); + + eAU[n] = eAL[n] + newcoefficientU; + eAL[n] = eAU[n] - newcoefficientL; + + qApprox = DiscretisedNormCDF(morkapprox, sortsapprox); + + if (2 * v + 2 > eCindex_computed) { + assert(2 * v == eCindex_computed); + eCL = eCU - GetdBridgeInterior(eCvec, 2 * v + 1, x, z, t); + eCU = eCL + GetdBridgeInterior(eCvec, 2 * v + 2, x, z, t); + eCindex_computed += 2; + } + + if (eAU[n] == eAL[n] && + eCL == eCU) /// ...then we have lost precision before reaching Fmkj. + { + if (o.debug > 2) { + cerr << "Abandoning loop for n = " << n << ", Fmkj = " << Fmkj + << " at v = " << v << endl; + cerr << "Leftovers: " << setprecision(50) << eAU[n] - eAL[n] << ", " + << eCU - eCL << endl; + } + + if (eAL[n] < 0.0 || eCL < 0.0) { + cerr << "Numerical error detected: (m,k) = " << m << "," << k + << ", eAU[" << n << "] = " << eAU[n] << ", eAL[" << n + << "] = " << eAL[n] << ", eCU[" << n << "] = " << eCU + << ", eCL = " << eCL + << ". Resorting to G1984-style approximation (s,t) = (" << s + << "," << t << ") ..." << endl; + return DrawBridgePMFInteriorMutationApprox(x, z, s, t, o, gen); + } + + break; + } + } + + dU[n] = (eCL < 0.0 ? static_cast(nan("")) + : exp(log(eAU[n]) + log(qApprox) - log(eCL))); + dL[n] = (eAL[n] < 0.0 ? static_cast(0.0) + : exp(log(eAL[n]) + log(qApprox) - log(eCU))); + v_used.push_back(v); + + if (o.debug > 2) { + cerr << "\nn "; + for (int k = 0; k <= n; ++k) + cerr << k << " "; + cerr << "\ndL "; + for (int k = 0; k <= n; ++k) + cerr << dL[k] << " "; + cerr << "\ndU "; + for (int k = 0; k <= n; ++k) + cerr << dU[k] << " "; + cerr << endl; + } + + /// Add on j contributions + int lindex = (!(x < 1.0) ? m : 0); + for (int j = 0; j <= k && !mkj_found; ++j) { + Amkj = computeA(m, k, lindex, j, x, z); + if (o.debug > 2) + cerr << "Adding to currsums with A(n,m,k,j) = A(" << n << "," << m + << "," << k << "," << j << ") = " << Amkj << endl; + + if (Amkj * dL[n] > 1.0 || Amkj * dU[n] < 0.0 || eAU[n] < 0.0 || + eAL[n] > 1.0 || eCU < 0.0) { + cerr << "Numerical error detected: (m,k,j) = " << m << "," << k << "," + << j << "), Amkj = " << Amkj << ", dL[" << n << "] = " << dL[n] + << ", dU[" << n << "] = " << dU[n] << ", eAU[" << n + << "] = " << eAU[n] << ", eAL[" << n << "] = " << eAL[n] + << ", eCU = " << eCU << ", eCL = " << eCL + << ". Resorting to G1984-style approximation (x,z,s,t) = (" << x + << "," << z << "," << s << "," << t << ") ..." << endl; + return DrawBridgePMFInteriorMutationApprox(x, z, s, t, o, gen); + } + + currsumL += Amkj * dL[n]; + currsumU += Amkj * dU[n]; + + currsumStore.push_back(log(Amkj) + log(dL[n])); + runningMax = max(runningMax, currsumStore.back()); + mkljStore.resize(mkljStore.size() + 4, -1); + mkljStore[0 + (4 * (currsumStore.size() - 1))] = m; + mkljStore[1 + (4 * (currsumStore.size() - 1))] = k; + mkljStore[2 + (4 * (currsumStore.size() - 1))] = lindex; + mkljStore[3 + (4 * (currsumStore.size() - 1))] = j; + + bool decision_on_mkj_made = (currsumL > u || currsumU < u); + + if (currsumL > currsumU) { + cerr << "Error: currsumL = " << currsumL << " > " << currsumU + << " = currsumU (n,m,k,j) = (" << n << "," << m << "," << k << "," + << j << ")." << endl; + exit(1); + } + + while (!decision_on_mkj_made) /// Refine upper and lower bounds + { + double100 currsumLold = currsumL, currsumUold = currsumU; + currsumL = 0.0; + currsumU = 0.0; + + const vector dUold(dU), dLold(dL); + for (int i = 0; i <= n; ++i) { + int &mi = curr_mk[i][0], &ki = curr_mk[i][1], + morki = (ind1 ? mi : ki), morkapproxi = (morki == mi ? ki : mi); + ++v_used[i]; + double100 newcoefficientU = + exp(Getlogakm(morki + 2 * v_used[i], morki) + + static_cast(-(morki + 2 * v_used[i]) * + (morki + 2 * v_used[i] + theta - 1) * + sorts / 2.0)); + double100 newcoefficientL = + exp(Getlogakm(morki + 2 * v_used[i] + 1, morki) + + static_cast( + -(morki + 2 * v_used[i] + 1) * + (morki + 2 * v_used[i] + 1 + theta - 1) * sorts / 2.0)); + + eAU[i] = eAL[i] + newcoefficientU; + eAL[i] = eAU[i] - newcoefficientL; + + qApprox = DiscretisedNormCDF(morkapproxi, sortsapprox); + + if (2 * v_used[i] + 2 > eCindex_computed) { + assert(2 * v_used[i] == eCindex_computed); + eCL = eCU - GetdBridgeInterior(eCvec, 2 * v_used[i] + 1, x, z, t); + eCU = eCL + GetdBridgeInterior(eCvec, 2 * v_used[i] + 2, x, z, t); + eCindex_computed += 2; + } + + dU[i] = (eCL < 0.0 ? static_cast(nan("")) + : exp(log(eAU[i]) + log(qApprox) - log(eCL))); + dL[i] = (eAL[i] < 0.0 ? static_cast(0.0) + : exp(log(eAL[i]) + log(qApprox) - log(eCU))); + + if (dLold[i] > dL[i] || dUold[i] < dU[i] || dL[i] > dU[i] || + static_cast(eAU[i]) < 0.0 || + static_cast(eAL[i]) > 1.0 || + static_cast(eCU) < 0.0) { + cerr << "Numerical error detected: (m,k,l,j) = " << mi << "," << ki + << ", *, *), dL[" << i << "] = " << dL[i] << ", dU[" << i + << "] = " << dU[i] << ", eAU[" << i << "] = " << eAU[i] + << ", eAL[" << i << "] = " << eAL[i] << ", eCU = " << eCU + << ", eCL = " << eCL + << ". Resorting to G1984-style approximation (x,z,s,t) = (" + << x << "," << z << "," << s << "," << t << ") ..." << endl; + return DrawBridgePMFInteriorMutationApprox(x, z, s, t, o, gen); + } + + int liindex = (!(x < 1.0) ? mi : 0); + for (int j2 = 0; j2 <= ki; ++j2) { + Amkj = computeA(mi, ki, liindex, j2, x, z); + currsumL += Amkj * dL[i]; + currsumU += Amkj * dU[i]; + currsumStore[i] = log(Amkj) + log(dL[i]); + runningMax = max(runningMax, currsumStore[i]); + if (o.debug > 3) + cerr << "Recomputing currsums with A(n,m,k,j) = A(" << i << "," + << mi << "," << ki << "," << j2 << ") = " << Amkj << endl; + } + } + + if (currsumL > currsumU) { + cerr << "Error: currsumL = " << currsumL << " > " << currsumU + << " = currsumU (n,m,k,j) = (" << n << "," << m << "," << k + << "," << j << ")." << endl; + exit(1); + } + + if (o.debug > 2) { + cerr << "\ndL "; + printVec(dL, cerr); + cerr << "\ndU "; + printVec(dU, cerr); + } + + if (currsumLold > currsumL) { + cerr << "Error: currsumLold = " << currsumLold << " > " << currsumL + << " = currsumL (n,m,k,l,j) = (" << n << "," << m << "," << k + << "," << j << ")." << endl; + exit(1); + } + if (currsumUold < currsumU) { + cerr << "Error: currsumUold = " << currsumUold << " < " << currsumU + << " = currsumU (n,m,k,l,j) = (" << n << "," << m << "," << k + << "," << j << ")." << endl; + exit(1); + } + + decision_on_mkj_made = (currsumL > u || currsumU < u); + } + + mkj_found = (currsumL > u); + + if (mkj_found) { + if (!(x > 0.0)) { + curr_mk[n][2] = 0; /// Sets l = 0 + curr_mk[n][3] = j; + } else { + curr_mk[n][2] = m; /// Sets l = m + curr_mk[n][3] = j; + } + } + } + + if (counter == totalpts) /// Gaussian approximation leads to currsum summing + /// to < 1.0, so we renormalise and sample + { + LogSumExp(currsumStore, runningMax); + double100 sum = 0.0; + int ind = 0; + + bool found = false; + + while (!found) { + sum += currsumStore[ind]; + if (sum > u) { + found = true; + } + if (ind == static_cast(currsumStore.size() - 1)) { + found = true; + } + ind++; + } + + vector returnvec; + + returnvec.push_back(mkljStore[0 + (4 * ind)]); + returnvec.push_back(mkljStore[1 + (4 * ind)]); + returnvec.push_back(mkljStore[2 + (4 * ind)]); + returnvec.push_back(mkljStore[3 + (4 * ind)]); + + return returnvec; + } + } + + int coeffcount = 0; + for (int i = 0; i <= n; ++i) + coeffcount += (v_used[i] + 1); + curr_mk[n].push_back(coeffcount); + curr_mk[n].push_back(0); + if (o.debug > 2) { + cerr << "p_m,k,j: Returned (m,k,j) = (" << curr_mk[n][0] << "," + << curr_mk[n][1] << "," << curr_mk[n][3] << ")\n"; + cerr << "n =\t\t\t"; + for (int i = 0; i <= n; ++i) + cerr << i << "\t"; + cerr << "\nv_used =\t"; + for (int i = 0; i <= n; ++i) + cerr << v_used[i] << "\t"; + cerr << "Coeffcount = " << coeffcount << endl; + } + + return curr_mk[n]; +} + +vector WrightFisher::DrawBridgePMFInteriorMutationApprox( + double100 x, double100 z, double100 s, double100 t, const Options &o, + boost::random::mt19937 + &gen) /// Draws from the law of a bridge starting at a boundary point + /// but ending in the interior of (0,1) with both time increments + /// below the threshold +{ + assert((!(x > 0.0) || !(x < 1.0)) && (z > 0.0) && (z < 1.0) && (t > s) && + (s > 0.0)); + vector returnvec; + vector currsumStore; + vector mkljStore; + + /// Compute denominator + double100 eC = 0.0, eCInc = 1.0, eCOldInc = 1.0; + int Dflip = 1, Djm = 0, Djp = 0; + int dmode = static_cast(ceil(GriffithsParas(t).first)), d = dmode; + + while (max(eCOldInc, eCInc) > 0.0) { + eCOldInc = eCInc; + double100 para1 = (!(x > 0.0) ? static_cast(thetaP[0]) + : static_cast(thetaP[0] + d)); + double100 para2 = (!(x > 0.0) ? static_cast(thetaP[1] + d) + : static_cast(thetaP[1])); + double100 zcont = (!(x > 0.0) ? static_cast(d) * log(1.0 - z) + : static_cast(d) * log(z)); + + eCInc = exp(log(QmApprox(d, t, o)) + zcont - + boost::math::lgamma(static_cast(para1)) - + boost::math::lgamma(static_cast(para2)) + + boost::math::lgamma(static_cast(para1 + para2))); + eC += eCInc; + + if (Dflip == -1 && + (dmode - Djm - 1 > 0)) /// Mechanism to explore either side around mode + { + Djm++; + d = dmode - Djm; + } else { + Djp++; + d = dmode + Djp; + } + Dflip *= -1; + } + + vector modeGuess = mkjModeFinder( + x, z, s, t, o); /// Get a guess to location of mode over (m,k,j) + int mMode = modeGuess[0], kMode = modeGuess[1], jMode = modeGuess[2]; + + boost::random::uniform_01 + U01; /// Use these guesses & eC to set a suitable threshold for subsequent + /// computations + double100 currsum = 0.0, u = U01(gen), + threshold = exp(mkjModeFinder_Evaluator(mMode, kMode, jMode, x, z, + s, t, o) - + log(eC)) * + 1.0e-4; + + int m = mMode, mFlip = 1, mD = 0, mU = 0, kFlip = 1, kD = 0, kU = 0, l; + bool mSwitch = false, mDownSwitch = false, mUpSwitch = false; + double100 constContr = + (static_cast(thetaP[0] - 1.0)) * log(z) + + (static_cast(thetaP[1] - 1.0)) * log(1.0 - z) + + (!(x > 0.0) ? -boost::math::lgamma(static_cast(thetaP[0])) + : -boost::math::lgamma(static_cast(thetaP[1]))); + double100 mContr_D = + boost::math::lgamma(static_cast(thetaP[0] + thetaP[1] + m)) + + (!(x > 0.0) + ? -boost::math::lgamma(static_cast(thetaP[1] + m)) + : -boost::math::lgamma(static_cast(thetaP[0] + m))); + double100 mContr_U = mContr_D, mContr, + runningMax = -1.0e100; /// Computing m contributions + + while (!mSwitch) { + double100 qm = QmApprox(m, s, o); + if (!(qm > 0.0)) /// This should not trigger, but if it does, sets to very + /// small value (taking logs later so cannot be 0!) + { + qm = 1.0e-300; + } + l = (!(x > 0.0) ? 0 : m); + if (m != mMode) { + if (mU > mD) { + mContr_U += + log(static_cast(thetaP[0] + thetaP[1] + (m - 1))) + + (!(x > 0.0) ? -log(static_cast(thetaP[1] + (m - 1))) + : -log(static_cast(thetaP[0] + (m - 1)))); + mContr = log(qm) + mContr_U; + } else { + mContr_D += + -log(static_cast(thetaP[0] + thetaP[1] + (m + 1) - 1)) + + (!(x > 0.0) ? log(static_cast(thetaP[1] + (m + 1) - 1)) + : log(static_cast(thetaP[0] + (m + 1) - 1))); + mContr = log(qm) + mContr_D; + } + } else { + mContr = log(qm) + mContr_U; + } + + int k = kMode; + kFlip = 1, kD = 0, kU = 0; + bool kSwitch = false, kDownSwitch = false, + kUpSwitch = false; /// Computing k contributions + double100 kContr_D = + (boost::math::lgamma( + static_cast(thetaP[0] + thetaP[1] + k)) - + boost::math::lgamma( + static_cast(thetaP[0] + thetaP[1] + m + k))) + + static_cast(k) * log(1.0 - z), + kContr_U = kContr_D, kContr; + + while (!kSwitch) { + double100 qk = QmApprox(k, t - s, o); + if (!(qk > 0.0)) /// This should not trigger, but if it does, sets to very + /// small value (taking logs later so cannot be 0!) + { + qk = 1.0e-300; + } + if (k != kMode) { + if (kU > kD) { + kContr_U += + log(static_cast(thetaP[0] + thetaP[1] + (k - 1))) - + log(static_cast(thetaP[0] + thetaP[1] + m + (k - 1))) + + log(1.0 - z); + kContr = log(qk) + kContr_U; + } else { + kContr_D += + log(static_cast(thetaP[0] + thetaP[1] + m + (k + 1) - + 1)) - + log(static_cast(thetaP[0] + thetaP[1] + (k + 1) - 1)) - + log(1.0 - z); + kContr = log(qk) + kContr_D; + } + } else { + kContr = log(qk) + kContr_U; + } + + int jFlip = 1, newjMode = min(k, jMode), j = newjMode, jU = 0, + jD = 0; /// Need to redefine jMode as k might be too small! + bool jSwitch = false, jDownSwitch = false, jUpSwitch = false; + + double100 jContr_D = + log(boost::math::binomial_coefficient(k, j)) + + (!(x > 0.0) ? boost::math::lgamma( + static_cast(thetaP[1] + m + k - j)) - + boost::math::lgamma( + static_cast(thetaP[1] + k - j)) + : boost::math::lgamma( + static_cast(thetaP[0] + m + j)) - + boost::math::lgamma( + static_cast(thetaP[0] + j))) + + static_cast(j) * log(z) + + static_cast(-j) * log(1.0 - z); + double100 jContr_U = jContr_D, jContr; + + while (!jSwitch) { + if (j != newjMode) { + if (jU > jD) { + jContr_U += + log(static_cast(k - (j - 1))) - + log(static_cast((j - 1) + 1)) + log(z) - + log(1.0 - z) + + (!(x > 0.0) + ? log(static_cast(thetaP[1] + k - (j - 1) - + 1)) - + log(static_cast(thetaP[1] + m + k - + (j - 1) - 1)) + : log(static_cast(thetaP[0] + m + (j - 1))) - + log(static_cast(thetaP[0] + (j - 1)))); + jContr = jContr_U; + } else { + jContr_D += + log(static_cast(j + 1)) - + log(static_cast(k - (j + 1) + 1)) + log(1.0 - z) - + log(z) + + (!(x > 0.0) + ? log(static_cast(thetaP[1] + m + k - + (j + 1))) - + log(static_cast(thetaP[1] + k - (j + 1))) + : log(static_cast(thetaP[0] + (j + 1) - 1)) - + log(static_cast(thetaP[0] + m + (j + 1) - + 1))); + jContr = jContr_D; + } + } else { + jContr = jContr_U; + } + double100 currsum_inc = constContr + mContr + kContr + jContr - log(eC); + runningMax = + max(currsum_inc, runningMax); /// Running max of log probabilities + /// for use in log-sum-exp trick + currsum += exp(currsum_inc); + currsumStore.push_back(currsum_inc); + + mkljStore.resize(mkljStore.size() + 4, -1); + mkljStore[0 + (4 * (currsumStore.size() - 1))] = m; + mkljStore[1 + (4 * (currsumStore.size() - 1))] = k; + mkljStore[2 + (4 * (currsumStore.size() - 1))] = l; + mkljStore[3 + (4 * (currsumStore.size() - 1))] = j; + + if (!(jDownSwitch)) /// Switching mechanism for j + { + if (sgn(j - newjMode) <= 0) { + jDownSwitch = + ((exp(currsum_inc) < threshold) || (newjMode - jD - 1) < 0); + } + } + + if (!(jUpSwitch)) { + if (sgn(j - newjMode) >= 0) { + jUpSwitch = + ((exp(currsum_inc) < threshold) || (newjMode + jU + 1) > k); + } + } + + jSwitch = (jDownSwitch && jUpSwitch); + + if (!jSwitch) { + if ((jFlip == 1 && (newjMode + jU + 1 <= k)) || + (jDownSwitch && !(jUpSwitch))) { + jU++; + j = newjMode + jU; + jFlip *= (jDownSwitch ? 1 : -1); + } else if ((jFlip == -1 && (newjMode - jD - 1 >= 0)) || + (jUpSwitch && !(jDownSwitch))) { + jD++; + j = newjMode - jD; + jFlip *= (jUpSwitch ? 1 : -1); + } + } + } + + if (!(kDownSwitch)) /// Switching mechanism for k + { + if (sgn(k - kMode) <= 0) { + kDownSwitch = (((jU == 0) && (jD == 0)) || (kMode - kD - 1 < 0)); + } + } + + if (!(kUpSwitch)) { + if (sgn(k - kMode) >= 0) { + kUpSwitch = ((jU == 0) && (jD == 0)); + } + } + + kSwitch = (kDownSwitch && kUpSwitch); + + if (!kSwitch) { + if (kFlip == 1) { + kU++; + k = kMode + kU; + kFlip *= (kDownSwitch ? 1 : -1); + } else if ((kFlip == -1) && (kMode - kD - 1 >= 0)) { + kD++; + k = kMode - kD; + kFlip *= (kUpSwitch ? 1 : -1); + } + } + } + + if (!(mDownSwitch)) /// Switching mechanism for m + { + if (sgn(m - mMode) <= 0) { + mDownSwitch = (((kU == 0) && (kD == 0)) || (mMode - mD - 1 < 0)); + } + } + + if (!(mUpSwitch)) { + if (sgn(m - mMode) >= 0) { + mUpSwitch = ((kU == 0) && (kD == 0)); + } + } + + mSwitch = (mDownSwitch && mUpSwitch); + + if (!mSwitch) { + if (mFlip == 1) { + mU++; + m = mMode + mU; + mFlip *= (mDownSwitch ? 1 : -1); + } else if ((mFlip == -1) && (mMode - mD - 1 >= 0)) { + mD++; + m = mMode - mD; + mFlip *= (mUpSwitch ? 1 : -1); + } + } + } + + LogSumExp(currsumStore, runningMax); + double100 sum = 0.0; + int index, ind = 0; + + vector indexing(currsumStore.size(), 0); + for (int i = 0; i != static_cast(indexing.size()); i++) { + indexing[i] = i; + } + sort(indexing.begin(), indexing.end(), [&](const int &a, const int &b) { + return (currsumStore[a] > currsumStore[b]); + }); + + bool found = false; + + while (!found) { + sum += currsumStore[indexing[ind]]; + if (sum > u) { + index = indexing[ind]; + found = true; + } + if (ind == static_cast(currsumStore.size() - 1)) { + index = indexing[ind]; + found = true; + } + ind++; + } + + returnvec.push_back(mkljStore[0 + (4 * index)]); + returnvec.push_back(mkljStore[1 + (4 * index)]); + returnvec.push_back(mkljStore[2 + (4 * index)]); + returnvec.push_back(mkljStore[3 + (4 * index)]); + + return returnvec; +} + +vector WrightFisher::DrawBridgePMF( + double100 x, double100 z, double100 s, double100 t, const Options &o, + boost::random::mt19937 + &gen) /// Draws from the law of a bridge starting and ending in the + /// interior of (0,1) with both time increments large enough +{ + assert((x > 0.0) && (x < 1.0) && (z > 0.0) && (z < 1.0) && (t > s) && + (s > 0.0)); + vector> curr_mk; + vector first_mk(4, 0); + first_mk[2] = 1; + first_mk[3] = -1; + curr_mk.push_back(first_mk); + bool mklj_found = false; + + /// Set up necessary quantities + boost::random::uniform_01 U01; + double100 u = U01(gen); + vector eCvec, eAL, eAU, eBL, eBU, dL, dU; + double100 currsumU = 0.0, currsumL = 0.0, eCL = 0.0, + eCU(Getd(eCvec, 0, x, z, t)); + vector v_used; + double100 Amklj; + int n = -1, Fmklj = 0, eCindex_computed = 0; + + /// Compute F ensuring convergence of upper and lower bounds + pair, double100> Cs, Cts, Ct; + Cs.second = s; + Cts.second = t - s; + Ct.second = t; + int F5; + if (thetaP.empty()) { + F5 = static_cast( + ceil(((1.0 - x) / (1.0 - z)) + (x / z) * (1.0 + z) * o.eps)); + } else { + F5 = static_cast(ceil( + 2.0 * + (max((theta / thetaP[1]) * (1.0 - static_cast(z)), + (1.0 + theta) / (1.0 - static_cast(z))) * + (1.0 - static_cast(x)) + + (1.0 + (1.0 / static_cast(z))) * + (max(((static_cast(z) * theta) + 1.0) / thetaP[0], 1.0)) * + static_cast(x)) / + o.eps)); + } + int F3 = computeE(Ct), + F4 = static_cast( + ceil(max(0.0, 1.0 / static_cast(t) - (theta + 1.0) / 2.0))); + while ((theta + 2 * F4 + 1) * exp(-(2 * F4 + theta) * t / 2.0) >= 1 - o.eps) + ++F4; + int F6 = max(max(F3, F4), F5); + + while (!mklj_found) { + ++n; + if (n > 0) + curr_mk.push_back(curr_mk.back()); + increment_on_mk(curr_mk.back(), s, t); + int &m = curr_mk[n][0]; + int &k = curr_mk[n][1]; + if (o.debug > 2) + cerr << "New n = " << n << ", (m,k) = (" << m << ", " << k << ")" << endl; + + /// Add the new n to the mix + eAL.push_back(0.0); + eAU.push_back(0.0); + eBL.push_back(0.0); + eBU.push_back(0.0); + dL.push_back(0.0); + dU.push_back(0.0); + int F1 = computeC(m, Cs), F2 = computeC(k, Cts); + if (o.debug > 2) + cerr << "(F1,F2,F3,F4,F5) = (" << F1 << "," << F2 << "," << F3 << "," + << F4 << "," << F5 << ")" << endl; + Fmklj = max(max(F1, F2), F6); + + int v = -1; + if (o.debug > 2) { + cerr << "F(" << setprecision(0) << m << "," << k << "," << setprecision(4) + << x << "," << z << "," << s << "," << t << ") = " << Fmklj << endl; + } + + while (2 * v < Fmklj || eAU[n] > 1.0 || eBU[n] > 1.0) { + ++v; + double100 newcoefficientU = + exp(Getlogakm(m + 2 * v, m) + + static_cast(-(m + 2 * v) * (m + 2 * v + theta - 1) * + s / 2.0)); + double100 newcoefficientL = + exp(Getlogakm(m + 2 * v + 1, m) + + static_cast(-(m + 2 * v + 1) * + (m + 2 * v + 1 + theta - 1) * s / 2.0)); + + eAU[n] = eAL[n] + newcoefficientU; + eAL[n] = eAU[n] - newcoefficientL; + + newcoefficientU = + exp(Getlogakm(k + 2 * v, k) + + static_cast(-(k + 2 * v) * (k + 2 * v + theta - 1) * + (t - s) / 2.0)); + newcoefficientL = exp(Getlogakm(k + 2 * v + 1, k) + + static_cast(-(k + 2 * v + 1) * + (k + 2 * v + 1 + theta - 1) * + (t - s) / 2.0)); + + eBU[n] = eBL[n] + newcoefficientU; + eBL[n] = eBU[n] - newcoefficientL; + + if (2 * v + 2 > eCindex_computed) { + assert(2 * v == eCindex_computed); + eCL = eCU - Getd(eCvec, 2 * v + 1, x, z, t); + eCU = eCL + Getd(eCvec, 2 * v + 2, x, z, t); + eCindex_computed += 2; + } + + if (eAU[n] == eAL[n] && eBU[n] == eBL[n] && + eCL == eCU) /// ...then we have lost precision before reaching Fmklj + { + if (o.debug > 2) { + cerr << "Abandoning loop for n = " << n << ", Fmklj = " << Fmklj + << " at v = " << v << endl; + cerr << "Leftovers: " << setprecision(50) << eAU[n] - eAL[n] << ", " + << eBU[n] - eBL[n] << ", " << eCU - eCL << endl; + } + + if (eAL[n] < 0.0 || eCL < 0.0) { + cerr << "Numerical error detected: (m,k) = " << m << "," << k + << ", eAU[" << n << "] = " << eAU[n] << ", eAL[" << n + << "] = " << eAL[n] << ", eCU[" << n << "] = " << eCU + << ", eCL = " << eCL + << ". Resorting to G1984-style approximation (s,t) = (" << s + << "," << t << ") ..." << endl; + return DrawBridgePMFG1984(x, z, s, t, o, gen); + } + + break; + } + } + + dU[n] = (eCL < 0.0 ? static_cast(nan("")) + : exp(log(eAU[n]) + log(eBU[n]) - log(eCL))); + dL[n] = (eAL[n] < 0.0 || eBL[n] < 0.0 + ? static_cast(0.0) + : exp(log(eAL[n]) + log(eBL[n]) - log(eCU))); + + v_used.push_back(v); + + if (o.debug > 2) { + cerr << "\nn "; + for (int k = 0; k <= n; ++k) + cerr << k << " "; + cerr << "\ndL "; + for (int k = 0; k <= n; ++k) + cerr << dL[k] << " "; + cerr << "\ndU "; + for (int k = 0; k <= n; ++k) + cerr << dU[k] << " "; + cerr << endl; + } + + for (int l = 0; l <= m && !mklj_found; ++l) { + for (int j = 0; j <= k && !mklj_found; ++j) { + Amklj = computeA(m, k, l, j, x, z); + if (o.debug > 2) + cerr << "Adding to currsums with A(n,m,k,l,j) = A(" << n << "," << m + << "," << k << "," << l << "," << j << ") = " << Amklj << endl; + + if (Amklj * dL[n] > 1.0 || Amklj * dU[n] < 0.0 || eAU[n] < 0.0 || + eBU[n] < 0.0 || eAL[n] > 1.0 || eBL[n] > 1.0 || eCU < 0.0) { + cerr << "Numerical error detected: (m,k,l,j) = " << m << "," << k + << "," << l << "," << j << "), Amklj = " << Amklj << ", dL[" << n + << "] = " << dL[n] << ", dU[" << n << "] = " << dU[n] << ", eAU[" + << n << "] = " << eAU[n] << ", eAL[" << n << "] = " << eAL[n] + << ", eBU[" << n << "] = " << eBU[n] << ", eBL[" << n + << "] = " << eBL[n] << ", eCU = " << eCU << ", eCL = " << eCL + << ". Resorting to G1984-style approximation (x,z,s,t) = (" << x + << "," << z << "," << s << "," << t << ") ..." << endl; + return DrawBridgePMFG1984(x, z, s, t, o, gen); + } + + currsumL += Amklj * dL[n]; + currsumU += Amklj * dU[n]; + bool decision_on_mklj_made = (currsumL > u || currsumU < u); + + if (currsumL > currsumU) { + cerr << "Error: currsumL = " << currsumL << " > " << currsumU + << " = currsumU (n,m,k,l,j) = (" << n << "," << m << "," << k + << "," << l << "," << j << ")." << endl; + exit(1); + } + + while (!decision_on_mklj_made) /// Refine upper and lower bounds + { + double100 currsumLold = currsumL, currsumUold = currsumU; + currsumL = 0.0; + currsumU = 0.0; + + const vector dUold(dU), dLold(dL); + for (int i = 0; i <= n; ++i) { + int &mi = curr_mk[i][0], &ki = curr_mk[i][1]; + ++v_used[i]; + double100 newcoefficientU = + exp(Getlogakm(mi + 2 * v_used[i], mi) + + static_cast( + -(mi + 2 * v_used[i]) * + (mi + 2 * v_used[i] + theta - 1) * s / 2.0)), + newcoefficientL = exp( + Getlogakm(mi + 2 * v_used[i] + 1, mi) + + static_cast( + -(mi + 2 * v_used[i] + 1) * + (mi + 2 * v_used[i] + 1 + theta - 1) * s / 2.0)); + + eAU[i] = eAL[i] + newcoefficientU; + eAL[i] = eAU[i] - newcoefficientL; + + newcoefficientU = + exp(Getlogakm(ki + 2 * v_used[i], ki) + + static_cast(-(ki + 2 * v_used[i]) * + (ki + 2 * v_used[i] + theta - 1) * + (t - s) / 2.0)); + newcoefficientL = + exp(Getlogakm(ki + 2 * v_used[i] + 1, ki) + + static_cast( + -(ki + 2 * v_used[i] + 1) * + (ki + 2 * v_used[i] + 1 + theta - 1) * (t - s) / 2.0)); + + eBU[i] = eBL[i] + newcoefficientU; + eBL[i] = eBU[i] - newcoefficientL; + + if (2 * v_used[i] + 2 > eCindex_computed) { + assert(2 * v_used[i] == eCindex_computed); + eCL = eCU - Getd(eCvec, 2 * v_used[i] + 1, x, z, t); + eCU = eCL + Getd(eCvec, 2 * v_used[i] + 2, x, z, t); + eCindex_computed += 2; + } + + dU[i] = (eCL < 0.0 ? static_cast(nan("")) + : exp(log(eAU[i]) + log(eBU[i]) - log(eCL))); + dL[i] = ((eAL[i] < 0.0 || eBL[i] < 0.0) + ? static_cast(0.0) + : exp(log(eAL[i]) + log(eBL[i]) - log(eCU))); + if (dLold[i] > dL[i] || dUold[i] < dU[i] || dL[i] > dU[i] || + static_cast(eAU[i]) < 0.0 || + static_cast(eBU[i]) < 0.0 || + static_cast(eAL[i]) > 1.0 || + static_cast(eBL[i]) > 1.0 || + static_cast(eCU) < 0.0) { + cerr << "Numerical error detected: (m,k,l,j) = " << mi << "," + << ki << ", *, *), dL[" << i << "] = " << dL[i] << ", dU[" + << i << "] = " << dU[i] << ", eAU[" << i << "] = " << eAU[i] + << ", eAL[" << i << "] = " << eAL[i] << ", eBU[" << i + << "] = " << eBU[i] << ", eBL[" << i << "] = " << eBL[i] + << ", eCU = " << eCU << ", eCL = " << eCL + << ". Resorting to G1984-style approximation (x,z,s,t) = (" + << x << "," << z << "," << s << "," << t << ") ..." << endl; + return DrawBridgePMFG1984(x, z, s, t, o, gen); + } + + int l_upper = (i == n ? l : mi); + for (int l2 = 0; l2 <= l_upper; ++l2) { + int j_upper = ((i == n && l2 == l_upper) ? j : ki); + for (int j2 = 0; j2 <= j_upper; ++j2) { + Amklj = computeA(mi, ki, l2, j2, x, z); + currsumL += Amklj * dL[i]; + currsumU += Amklj * dU[i]; + if (o.debug > 3) + cerr << "Recomputing currsums with A(n,m,k,l,j) = A(" << i + << "," << mi << "," << ki << "," << l2 << "," << j2 + << ") = " << Amklj << endl; + } + } + + if (currsumL > currsumU) { + cerr << "Error: currsumL = " << currsumL << " > " << currsumU + << " = currsumU (n,m,k,l,j) = (" << n << "," << m << "," << k + << "," << l << "," << j << ")." << endl; + exit(1); + } + } + + if (o.debug > 2) { + cerr << "\ndL "; + printVec(dL, cerr); + cerr << "\ndU "; + printVec(dU, cerr); + } + + if (currsumLold > currsumL) { + cerr << "Error: currsumLold = " << currsumLold << " > " << currsumL + << " = currsumL (n,m,k,l,j) = (" << n << "," << m << "," << k + << "," << l << "," << j << ")." << endl; + exit(1); + } + if (currsumUold < currsumU) { + cerr << "Error: currsumUold = " << currsumUold << " < " << currsumU + << " = currsumU (n,m,k,l,j) = (" << n << "," << m << "," << k + << "," << l << "," << j << ")." << endl; + exit(1); + } + + decision_on_mklj_made = (currsumL > u || currsumU < u); + } + + mklj_found = (currsumL > u); + if (mklj_found) { + curr_mk[n][2] = l; + curr_mk[n][3] = j; + } + } + } + } + + int coeffcount = 0; + for (int i = 0; i <= n; ++i) + coeffcount += (v_used[i] + 1); + curr_mk[n].push_back(coeffcount); + curr_mk[n].push_back(0); + + if (o.debug > 2) { + cerr << "p_m,k,l,j: Returned (m,k,l,j) = (" << curr_mk[n][0] << "," + << curr_mk[n][1] << "," << curr_mk[n][2] << "," << curr_mk[n][3] + << ")\n"; + cerr << "n =\t\t\t"; + for (int i = 0; i <= n; ++i) + cerr << i << "\t"; + cerr << "\nv_used =\t"; + for (int i = 0; i <= n; ++i) + cerr << v_used[i] << "\t"; + cerr << "Coeffcount = " << coeffcount << endl; + } + + return curr_mk[n]; +} + +vector WrightFisher::DrawBridgePMFOneQApprox( + double100 x, double100 z, double100 s, double100 t, const Options &o, + boost::random::mt19937 &gen) /// Draws from the law of a bridge starting and + /// ending in the interior of (0,1), but one + /// time increment is below the threshold +{ + assert((x > 0.0) && (x < 1.0) && (z > 0.0) && (z < 1.0) && (t > s) && + (s > 0.0)); + bool ind1 = + (s > o.g1984threshold); /// Figure out whether to approximate q_m or q_k + double100 sorts = (ind1 ? s : t - s), sortsapprox = (sorts == s ? t - s : s); + + vector> curr_mk; + vector first_mk(4, 0), mkljStore; + first_mk[2] = 1; + first_mk[3] = -1; + curr_mk.push_back(first_mk); + bool mklj_found = false; + + /// Set up the necessary quantities + boost::random::uniform_01 U01; + double100 u = U01(gen); + vector eCvec, eAL, eAU, dL, dU, currsumStore; + double100 currsumU = 0.0, currsumL = 0.0, eCL = 0.0, + eCU(Getd(eCvec, 0, x, z, t)), qApprox = 0.0, runningMax = 1.0e-300; + vector v_used; + double100 Amklj; + int n = -1, Fmklj = 0, eCindex_computed = 0; + /// Mechanism to check whether we have run out of precision due to Gaussian + /// approximations used for one side of the bridge interval - very rare to be + /// needed + double mmode = GriffithsParas(s).first, vm = GriffithsParas(s).second, + kmode = GriffithsParas(t - s).first, vk = GriffithsParas(t - s).second; + int mlimU = static_cast(ceil(mmode + 5.0 * sqrt(vm))), + klimU = static_cast(ceil(kmode + 5.0 * sqrt(vk))), + mlimL = max(0, static_cast(floor(mmode - 5.0 * sqrt(vm)))), + klimL = max(0, static_cast(floor(kmode - 5.0 * sqrt(vk)))); + int totalpts = (mlimU - mlimL) * (klimU - klimL), counter = 0; + + /// Compute F ensuring convergence of upper and lower bounds + pair, double100> Csorts, Ct; + Csorts.second = sorts; + Ct.second = t; + int F5; + if (thetaP.empty()) { + F5 = static_cast( + ceil(((1.0 - x) / (1.0 - z)) + (x / z) * (1.0 + z) * o.eps)); + } else { + F5 = static_cast(ceil( + 2.0 * + (max((theta / thetaP[1]) * (1.0 - static_cast(z)), + (1.0 + theta) / (1.0 - static_cast(z))) * + (1.0 - static_cast(x)) + + (1.0 + (1.0 / static_cast(z))) * + (max(((static_cast(z) * theta) + 1.0) / thetaP[0], 1.0)) * + static_cast(x)) / + o.eps)); + } + int F3 = computeE(Ct), + F4 = static_cast( + ceil(max(0.0, 1.0 / static_cast(t) - (theta + 1.0) / 2.0))); + while ((theta + 2 * F4 + 1) * exp(-(2 * F4 + theta) * t / 2.0) >= 1 - o.eps) + ++F4; + int F6 = max(max(F3, F4), F5); + + while (!mklj_found) { + ++n; + if (n > 0) + curr_mk.push_back(curr_mk.back()); + increment_on_mk(curr_mk.back(), s, t); + int &m = curr_mk[n][0]; + int &k = curr_mk[n][1]; + int mork = (ind1 ? m : k), morkapprox = (mork == m ? k : m); + if (m <= mlimU && m >= mlimL && k <= klimU && k >= klimL) + counter++; + if (o.debug > 2) + cerr << "New n = " << n << ", (m,k) = (" << m << ", " << k << ")" << endl; + + /// Add the new n to the mix + eAL.push_back(0.0); + eAU.push_back(0.0); + dL.push_back(0.0); + dU.push_back(0.0); + int F1 = computeC(mork, Csorts); + if (o.debug > 2) + cerr << "(F1,F3,F4,F5) = (" << F1 << "," << F3 << "," << F4 << "," << F5 + << ")" << endl; + Fmklj = max(F1, F6); + + int v = -1; + if (o.debug > 2) { + cerr << "F(" << setprecision(0) << m << "," << k << "," << setprecision(4) + << x << "," << z << "," << s << "," << t << ") = " << Fmklj << endl; + } + + while (2 * v < Fmklj) { + ++v; + double100 newcoefficientU = + exp(Getlogakm(mork + 2 * v, mork) + + static_cast(-(mork + 2 * v) * + (mork + 2 * v + theta - 1) * sorts / 2.0)); + double100 newcoefficientL = exp( + Getlogakm(mork + 2 * v + 1, mork) + + static_cast(-(mork + 2 * v + 1) * + (mork + 2 * v + 1 + theta - 1) * sorts / 2.0)); + + eAU[n] = eAL[n] + newcoefficientU; + eAL[n] = eAU[n] - newcoefficientL; + + qApprox = DiscretisedNormCDF(morkapprox, sortsapprox); + + if (2 * v + 2 > eCindex_computed) { + assert(2 * v == eCindex_computed); + eCL = eCU - Getd(eCvec, 2 * v + 1, x, z, t); + eCU = eCL + Getd(eCvec, 2 * v + 2, x, z, t); + eCindex_computed += 2; + } + + if (eAU[n] == eAL[n] && + eCL == eCU) /// ...then we have lost precision before reaching Fmklj + { + if (o.debug > 2) { + cerr << "Abandoning loop for n = " << n << ", Fmklj = " << Fmklj + << " at v = " << v << endl; + cerr << "Leftovers: " << setprecision(50) << eAU[n] - eAL[n] << ", " + << eCU - eCL << endl; + } + + if (eAL[n] < 0.0 || eCL < 0.0) { + cerr << "Numerical error detected: (m,k) = " << m << "," << k + << ", eAU[" << n << "] = " << eAU[n] << ", eAL[" << n + << "] = " << eAL[n] << ", eCU[" << n << "] = " << eCU + << ", eCL = " << eCL + << ". Resorting to G1984-style approximation (s,t) = (" << s + << "," << t << ") ..." << endl; + return DrawBridgePMFG1984(x, z, s, t, o, gen); + } + + break; + } + } + + dU[n] = (eCL < 0.0 ? static_cast(nan("")) + : exp(log(eAU[n]) + log(qApprox) - log(eCL))); + dL[n] = (eAL[n] < 0.0 ? static_cast(0.0) + : exp(log(eAL[n]) + log(qApprox) - log(eCU))); + + v_used.push_back(v); + + if (o.debug > 2) { + cerr << "\nn "; + for (int k = 0; k <= n; ++k) + cerr << k << " "; + cerr << "\ndL "; + for (int k = 0; k <= n; ++k) + cerr << dL[k] << " "; + cerr << "\ndU "; + for (int k = 0; k <= n; ++k) + cerr << dU[k] << " "; + cerr << endl; + } + + for (int l = 0; l <= m && !mklj_found; ++l) { + for (int j = 0; j <= k && !mklj_found; ++j) { + Amklj = computeA(m, k, l, j, x, z); + if (o.debug > 2) + cerr << "Adding to currsums with A(n,m,k,l,j) = A(" << n << "," << m + << "," << k << "," << l << "," << j + << ") = " << endl; // Amklj[Akey] << endl; + + if (Amklj * dL[n] > 1.0 || Amklj * dU[n] < 0.0 || eAU[n] < 0.0 || + eAL[n] > 1.0 || eCU < 0.0) { + cerr << "Numerical error detected: (m,k,l,j) = " << m << "," << k + << "," << l << "," << j << "), Amklj = " << Amklj << ", dL[" << n + << "] = " << dL[n] << ", dU[" << n << "] = " << dU[n] << ", eAU[" + << n << "] = " << eAU[n] << ", eAL[" << n << "] = " << eAL[n] + << ", eCU = " << eCU << ", eCL = " << eCL + << ". Resorting to G1984-style approximation (x,z,s,t) = (" << x + << "," << z << "," << s << "," << t << ") ..." << endl; + return DrawBridgePMFG1984(x, z, s, t, o, gen); + } + + currsumL += Amklj * dL[n]; + currsumU += Amklj * dU[n]; + + currsumStore.push_back(log(Amklj) + log(dL[n])); + runningMax = max(runningMax, currsumStore.back()); + mkljStore.resize(mkljStore.size() + 4, -1); + mkljStore[0 + (4 * (currsumStore.size() - 1))] = m; + mkljStore[1 + (4 * (currsumStore.size() - 1))] = k; + mkljStore[2 + (4 * (currsumStore.size() - 1))] = l; + mkljStore[3 + (4 * (currsumStore.size() - 1))] = j; + + bool decision_on_mklj_made = (currsumL > u || currsumU < u); + + if (currsumL > currsumU) { + cerr << "Error: currsumL = " << currsumL << " > " << currsumU + << " = currsumU (n,m,k,l,j) = (" << n << "," << m << "," << k + << "," << l << "," << j << ")." << endl; + exit(1); + } + + while (!decision_on_mklj_made) /// Refine upper and lower bounds + { + double100 currsumLold = currsumL, currsumUold = currsumU; + currsumL = 0.0; + currsumU = 0.0; + + const vector dUold(dU), dLold(dL); + for (int i = 0; i <= n; ++i) { + int &mi = curr_mk[i][0], &ki = curr_mk[i][1], + morki = (ind1 ? mi : ki), morkapproxi = (morki == mi ? ki : mi); + ; + ++v_used[i]; + double100 + newcoefficientU = + exp(Getlogakm(morki + 2 * v_used[i], morki) + + static_cast( + -(morki + 2 * v_used[i]) * + (morki + 2 * v_used[i] + theta - 1) * sorts / 2.0)), + newcoefficientL = exp( + Getlogakm(morki + 2 * v_used[i] + 1, morki) + + static_cast( + -(morki + 2 * v_used[i] + 1) * + (morki + 2 * v_used[i] + 1 + theta - 1) * sorts / 2.0)); + + eAU[i] = eAL[i] + newcoefficientU; + eAL[i] = eAU[i] - newcoefficientL; + + qApprox = DiscretisedNormCDF(morkapproxi, sortsapprox); + + if (2 * v_used[i] + 2 > eCindex_computed) { + assert(2 * v_used[i] == eCindex_computed); + eCL = eCU - Getd(eCvec, 2 * v_used[i] + 1, x, z, t); + eCU = eCL + Getd(eCvec, 2 * v_used[i] + 2, x, z, t); + eCindex_computed += 2; + } + + dU[i] = (eCL < 0.0 ? static_cast(nan("")) + : exp(log(eAU[i]) + log(qApprox) - log(eCL))); + dL[i] = (eAL[i] < 0.0 ? static_cast(0.0) + : exp(log(eAL[i]) + log(qApprox) - log(eCU))); + if (dLold[i] > dL[i] || dUold[i] < dU[i] || dL[i] > dU[i] || + static_cast(eAU[i]) < 0.0 || + static_cast(eAL[i]) > 1.0 || + static_cast(eCU) < 0.0) { + cerr << "Numerical error detected: (m,k,l,j) = " << mi << "," + << ki << ", *, *), dL[" << i << "] = " << dL[i] << ", dU[" + << i << "] = " << dU[i] << ", eAU[" << i << "] = " << eAU[i] + << ", eAL[" << i << "] = " << eAL[i] << ", eCU = " << eCU + << ", eCL = " << eCL + << ". Resorting to G1984-style approximation (x,z,s,t) = (" + << x << "," << z << "," << s << "," << t << ") ..." << endl; + return DrawBridgePMFG1984(x, z, s, t, o, gen); + } + + int l_upper = (i == n ? l : mi); + for (int l2 = 0; l2 <= l_upper; ++l2) { + int j_upper = ((i == n && l2 == l_upper) ? j : ki); + for (int j2 = 0; j2 <= j_upper; ++j2) { + Amklj = computeA(mi, ki, l2, j2, x, z); + currsumL += Amklj * dL[i]; + currsumU += Amklj * dU[i]; + currsumStore[i] = log(Amklj) + log(dL[i]); + runningMax = max(runningMax, currsumStore[i]); + if (o.debug > 3) + cerr << "Recomputing currsums with A(n,m,k,l,j) = A(" << i + << "," << mi << "," << ki << "," << l2 << "," << j2 + << ") = " << Amklj << endl; + } + } + + if (currsumL > currsumU) { + cerr << "Error: currsumL = " << currsumL << " > " << currsumU + << " = currsumU (n,m,k,l,j) = (" << n << "," << m << "," << k + << "," << l << "," << j << ")." << endl; + exit(1); + } + } + + if (o.debug > 2) { + cerr << "\ndL "; + printVec(dL, cerr); + cerr << "\ndU "; + printVec(dU, cerr); + } + + if (currsumLold > currsumL) { + cerr << "Error: currsumLold = " << currsumLold << " > " << currsumL + << " = currsumL (n,m,k,l,j) = (" << n << "," << m << "," << k + << "," << l << "," << j << ")." << endl; + exit(1); + } + if (currsumUold < currsumU) { + cerr << "Error: currsumUold = " << currsumUold << " < " << currsumU + << " = currsumU (n,m,k,l,j) = (" << n << "," << m << "," << k + << "," << l << "," << j << ")." << endl; + exit(1); + } + + decision_on_mklj_made = (currsumL > u || currsumU < u); + } + + mklj_found = (currsumL > u); + if (mklj_found) { + curr_mk[n][2] = l; + curr_mk[n][3] = j; + } + } + } + + if (counter == totalpts) /// Gaussian approximation leads to currsum summing + /// to < 1.0, so we renormalise and sample + { + LogSumExp(currsumStore, runningMax); + double100 sum = 0.0; + int ind = 0; + + bool found = false; + + while (!found) { + sum += currsumStore[ind]; + if (sum > u) { + found = true; + } + if (ind == static_cast(currsumStore.size() - 1)) { + found = true; + } + ind++; + } + + vector returnvec; + + returnvec.push_back(mkljStore[0 + (4 * ind)]); + returnvec.push_back(mkljStore[1 + (4 * ind)]); + returnvec.push_back(mkljStore[2 + (4 * ind)]); + returnvec.push_back(mkljStore[3 + (4 * ind)]); + + return returnvec; + } + } + + int coeffcount = 0; + for (int i = 0; i <= n; ++i) + coeffcount += (v_used[i] + 1); + curr_mk[n].push_back(coeffcount); + curr_mk[n].push_back(0); + + if (o.debug > 2) { + cerr << "p_m,k,l,j: Returned (m,k,l,j) = (" << curr_mk[n][0] << "," + << curr_mk[n][1] << "," << curr_mk[n][2] << "," << curr_mk[n][3] + << ")\n"; + cerr << "n =\t\t\t"; + for (int i = 0; i <= n; ++i) + cerr << i << "\t"; + cerr << "\nv_used =\t"; + for (int i = 0; i <= n; ++i) + cerr << v_used[i] << "\t"; + cerr << "Coeffcount = " << coeffcount << endl; + } + + return curr_mk[n]; +} + +vector WrightFisher::DrawBridgePMFG1984( + double100 x, double100 z, double100 s, double100 t, const Options &o, + boost::random::mt19937 &gen) /// Draws from the law of a bridge starting and + /// ending in the interior of (0,1), but both + /// time increments are below the threshold +{ + assert((x > 0.0) && (x < 1.0) && (z > 0.0) && (z < 1.0) && (t > s) && + (s > 0.0)); + vector returnvec; + vector currsumStore; + vector mkljStore; + bool mklj_found = false, + earlyStop = + (abs(x - z) <= 0.6); /// earlyStop gauges whether we can use currsum + /// as is, or whether we should compute all + /// probabilities and then sample + + /// Compute denominator + double100 eC = 0.0, eCInc = 1.0, eCOldInc = 1.0; + int Dflip = 1, Djm = 0, Djp = 0; + int dmode = static_cast(ceil(GriffithsParas(t).first)), d = dmode; + + while (max(eCOldInc, eCInc) > 0.0) { + eCOldInc = eCInc; + double100 addon = 0.0; + for (int f = 0; f != d; f++) { + double100 para1 = static_cast(thetaP[0] + f), + para2 = static_cast(thetaP[1] + d - f); + boost::math::binomial_distribution BIN(d, x); + boost::math::beta_distribution BETA(para1, para2); + + addon += pdf(BIN, f) * pdf(BETA, z); + } + eCInc = QmApprox(d, t, o) * addon; + eC += eCInc; + + if (Dflip == -1 && + (dmode - Djm - 1 > 0)) // Mechanism to explore either side around mode + { + Djm++; + d = dmode - Djm; + } else { + Djp++; + d = dmode + Djp; + } + Dflip *= -1; + } + + vector modeGuess = + mkljModeFinder(x, z, s, t, o); /// Get a guess on mode over (m,k,l,j) + int mMode = modeGuess[0], kMode = modeGuess[1], lMode = modeGuess[2], + jMode = modeGuess[3]; + + boost::random::uniform_01 + U01; /// Use this guess & eC to compute a suitable threshold for + /// subsequent computations + double100 currsum = 0.0, u = U01(gen), + threshold = exp(mkljModeFinder_Evaluator(mMode, kMode, lMode, jMode, + x, z, s, t, o) - + log(eC)) * + 1.0e-4; + + int m = mMode, mFlip = 1, mD = 0, mU = 0; + bool mSwitch = false, mDownSwitch = false, + mUpSwitch = false; /// Compute m contributions + double100 mContr_D = boost::math::lgamma( + static_cast(thetaP[0] + thetaP[1] + m)), + mContr_U = mContr_D, mContr, runningMax = -1.0e100; + + while (!mSwitch) { + double100 qm = QmApprox(m, s, o); + if (!(qm > 0.0)) /// This should not trigger, but if it does, sets to very + /// small value (taking logs later so cannot be 0!) + { + qm = 1.0e-300; + } + if (m != mMode) { + if (mU > mD) { + mContr_U += + log(static_cast(thetaP[0] + thetaP[1] + (m - 1))); + mContr = log(qm) + mContr_U; + } else { + mContr_D -= + log(static_cast(thetaP[0] + thetaP[1] + (m + 1) - 1)); + mContr = log(qm) + mContr_D; + } + } else { + mContr = log(qm) + mContr_U; + } + + int k = kMode, kFlip = 1, kD = 0, kU = 0; + bool kSwitch = false, kDownSwitch = false, + kUpSwitch = false; /// Compute k contributions + double100 kContr_D = + (boost::math::lgamma( + static_cast(thetaP[0] + thetaP[1] + k)) - + boost::math::lgamma( + static_cast(thetaP[0] + thetaP[1] + m + k))), + kContr_U = kContr_D, kContr; + + while (!kSwitch) { + double100 qk = QmApprox(k, t - s, o); + if (!(qk > 0.0)) /// This should not trigger, but if it does, sets to very + /// small value (taking logs later so cannot be 0!) + { + qk = 1.0e-300; + } + if (!(qk > 0.0)) { + break; + } + if (k != kMode) { + if (kU > kD) { + kContr_U += + log(static_cast(thetaP[0] + thetaP[1] + (k - 1))) - + log(static_cast(thetaP[0] + thetaP[1] + m + (k - 1))); + kContr = log(qk) + kContr_U; + } else { + kContr_D += + log(static_cast(thetaP[0] + thetaP[1] + m + (k + 1) - + 1)) - + log(static_cast(thetaP[0] + thetaP[1] + (k + 1) - 1)); + kContr = log(qk) + kContr_D; + } + } else { + kContr = log(qk) + kContr_U; + } + + int lFlip = 1, lU = 0, lD = 0, newlMode = min(lMode, m), + l = newlMode; /// Redefine lMode in case m is too small! + bool lSwitch = false, lDownSwitch = false, lUpSwitch = false; + boost::math::binomial_distribution BINL( + m, x); /// Compute l contributions + double100 lContr_D = (log(pdf(BINL, l)) - + boost::math::lgamma( + static_cast(thetaP[0] + l)) - + boost::math::lgamma( + static_cast(thetaP[1] + m - l))), + lContr_U = lContr_D, lContr; + + while (!lSwitch) { + assert((l >= 0) && (l <= m)); + if (l != newlMode) { + if (lU > lD) { + lContr_U += + log(static_cast(m - (l - 1))) - + log(static_cast((l - 1) + 1)) + log(x) - + log(1.0 - x) + + log(static_cast(thetaP[1] + m - (l - 1) - 1)) - + log(static_cast(thetaP[0] + (l - 1))); + lContr = lContr_U; + } else { + lContr_D += log(static_cast(l + 1)) - + log(static_cast(m - (l + 1) + 1)) + + log(1.0 - x) - log(x) + + log(static_cast(thetaP[0] + (l + 1) - 1)) - + log(static_cast(thetaP[1] + m - (l + 1))); + lContr = lContr_D; + } + } else { + lContr = lContr_U; + } + + int jFlip = 1, jU = 0, jD = 0, newjMode = min(jMode, k), + j = newjMode; /// Redefine jMode in case k is too small! + bool jSwitch = false, jDownSwitch = false, + jUpSwitch = false; /// Compute j contributions + double100 jContr_D = + log(boost::math::binomial_coefficient(k, j)) + + boost::math::lgamma(static_cast(thetaP[0] + l + j)) - + boost::math::lgamma(static_cast(thetaP[0] + j)) + + boost::math::lgamma( + static_cast(thetaP[1] + m - l + k - j)) - + boost::math::lgamma(static_cast(thetaP[1] + k - j)) + + static_cast(thetaP[0] + j - 1) * log(z) + + static_cast(thetaP[1] + k - j - 1) * log(1.0 - z); + double100 jContr_U = jContr_D, jContr; + + while (!jSwitch) { + if (j != newjMode) { + if (jU > jD) { + jContr_U += + log(static_cast(k - (j - 1))) - + log(static_cast((j - 1) + 1)) + log(z) - + log(1.0 - z) + + log(static_cast(thetaP[0] + l + (j - 1))) - + log(static_cast(thetaP[0] + (j - 1))) + + log(static_cast(thetaP[1] + k - (j - 1) - 1)) - + log(static_cast(thetaP[1] + m - l + k - (j - 1) - + 1)); + jContr = jContr_U; + } else { + jContr_D += + log(static_cast(j + 1)) - + log(static_cast(k - (j + 1) + 1)) + log(1.0 - z) - + log(z) + + log(static_cast(thetaP[0] + (j + 1) - 1)) - + log(static_cast(thetaP[0] + l + (j + 1) - 1)) + + log(static_cast(thetaP[1] + m - l + k - (j + 1))) - + log(static_cast(thetaP[1] + k - (j + 1))); + jContr = jContr_D; + } + } else { + jContr = jContr_U; + } + double100 currsum_inc = + exp(mContr + kContr + lContr + jContr - log(eC)); + runningMax = max( + currsum_inc, + runningMax); /// Running max needed for log-sum-exp trick later + currsum += currsum_inc; + currsumStore.push_back(currsum); + + mkljStore.resize(mkljStore.size() + 4, -1); + mkljStore[0 + (4 * (currsumStore.size() - 1))] = m; + mkljStore[1 + (4 * (currsumStore.size() - 1))] = k; + mkljStore[2 + (4 * (currsumStore.size() - 1))] = l; + mkljStore[3 + (4 * (currsumStore.size() - 1))] = j; + + if ((currsum > u) && earlyStop) /// if earlyStop is allowed, we can + /// stop once currsum exceeds u + { + returnvec.push_back(m); + returnvec.push_back(k); + returnvec.push_back(l); + returnvec.push_back(j); + + mklj_found = true; + goto End; + } + + if (!(jDownSwitch)) /// Switching mechanism for j + { + if (sgn(j - newjMode) <= 0) { + jDownSwitch = + ((currsum_inc < threshold) || (newjMode - jD - 1) < 0); + } + } + + if (!(jUpSwitch)) { + if (sgn(j - newjMode) >= 0) { + jUpSwitch = + ((currsum_inc < threshold) || (newjMode + jU + 1) > k); + } + } + + jSwitch = (jDownSwitch && jUpSwitch); + + if (!jSwitch) { + if ((jFlip == 1 && (newjMode + jU + 1 <= k)) || + (jDownSwitch && !(jUpSwitch))) { + jU++; + j = newjMode + jU; + jFlip *= (jDownSwitch ? 1 : -1); + } else if ((jFlip == -1 && (newjMode - jD - 1 >= 0)) || + (jUpSwitch && !(jDownSwitch))) { + jD++; + j = newjMode - jD; + jFlip *= (jUpSwitch ? 1 : -1); + } + } + } + + if (!(lDownSwitch)) /// Switching mechanism for l + { + if (sgn(l - newlMode) <= 0) { + lDownSwitch = (((jU == 0) && (jD == 0)) || (newlMode - lD - 1) < 0); + } + } + + if (!(lUpSwitch)) { + if (sgn(l - newlMode) >= 0) { + lUpSwitch = (((jU == 0) && (jD == 0)) || (newlMode + lU + 1) > m); + } + } + + lSwitch = (lDownSwitch && lUpSwitch); + + if (!lSwitch) { + if ((lFlip == 1 && (newlMode + lU + 1 <= m)) || + (lDownSwitch && !(lUpSwitch))) { + lU++; + l = newlMode + lU; + lFlip *= (lDownSwitch ? 1 : -1); + } else if ((lFlip == -1 && (newlMode - lD - 1 >= 0)) || + (lUpSwitch && !(lDownSwitch))) { + lD++; + l = newlMode - lD; + lFlip *= (lUpSwitch ? 1 : -1); + } + } + } + + if (!(kDownSwitch)) /// Switching mechanism for k + { + if (sgn(k - kMode) <= 0) { + kDownSwitch = (((lU == 0) && (lD == 0)) || (kMode - kD - 1 < 0)); + } + } + + if (!(kUpSwitch)) { + if (sgn(k - kMode) >= 0) { + kUpSwitch = ((lU == 0) && (lD == 0)); + } + } + + kSwitch = (kDownSwitch && kUpSwitch); + + if (!kSwitch) { + if (kFlip == 1) { + kU++; + k = kMode + kU; + kFlip *= (kDownSwitch ? 1 : -1); + } else if ((kFlip == -1) && (kMode - kD - 1 >= 0)) { + kD++; + k = kMode - kD; + kFlip *= (kUpSwitch ? 1 : -1); + } + } + } + + if (!(mDownSwitch)) /// Switching mechanism for m + { + if (sgn(m - mMode) <= 0) { + mDownSwitch = (((kU == 0) && (kD == 0)) || (mMode - mD - 1 < 0)); + } + } + + if (!(mUpSwitch)) { + if (sgn(m - mMode) >= 0) { + mUpSwitch = ((kU == 0) && (kD == 0)); + } + } + + mSwitch = (mDownSwitch && mUpSwitch); + + if (!mSwitch) { + if (mFlip == 1) { + mU++; + m = mMode + mU; + mFlip *= (mDownSwitch ? 1 : -1); + } else if ((mFlip == -1) && (mMode - mD - 1 >= 0)) { + mD++; + m = mMode - mD; + mFlip *= (mUpSwitch ? 1 : -1); + } + } + } + +End: + + if (!mklj_found) /// Either earlyStop disable or even with it we still did not + /// get currsum > u - guards against cases when earlyStop is + /// not a good enough indicator of currsum summing to < 1 + { + LogSumExp(currsumStore, + runningMax); /// log-sum-exp trick to normalise and transform + /// vector of log probabilities + double100 sum = 0.0; + int index, ind = 0; + + vector indexing(currsumStore.size(), 0); + for (int i = 0; i != static_cast(indexing.size()); i++) { + indexing[i] = i; + } + sort(indexing.begin(), indexing.end(), /// Sort probabilities + [&](const int &a, const int &b) { + return (currsumStore[a] > currsumStore[b]); + }); + + bool found = false; + + while (!found) { + sum += currsumStore[indexing[ind]]; + if (sum > u) { + index = indexing[ind]; /// Return correct index to sorted probabilities + found = true; + } + if (ind == static_cast(currsumStore.size() - 1)) /// Ending condition + { + index = indexing[ind]; + found = true; + } + ind++; + } + + returnvec.push_back(mkljStore[0 + (4 * index)]); + returnvec.push_back(mkljStore[1 + (4 * index)]); + returnvec.push_back(mkljStore[2 + (4 * index)]); + returnvec.push_back(mkljStore[3 + (4 * index)]); + } + + return returnvec; +} + +double100 WrightFisher::mkModeFinder_Evaluator( + int m, int k, double100 x, double100 z, double100 s, double100 t, + const Options &o) /// Evaluation function for finding mode over (m,k) +{ + assert((m >= 0) && (k >= 0) && (x >= 0.0) && (x <= 1.0) && (z >= 0.0) && + (z <= 1.0) && (s > 0.0) && (s < t)); + double100 qm = QmApprox(m, s, o), qk = QmApprox(k, t - s, o); + if (!(qm > 0.0)) /// Ensure qm and qk are not zero when taking logs! If they + /// are, set to a very small positive value + { + qm = 1.0e-300; + } + if (!(qk > 0.0)) { + qk = 1.0e-300; + } + + if (x != z) { + return log(qm) + log(qk) + boost::math::lgamma(theta + m) + + boost::math::lgamma(theta + k) - boost::math::lgamma(theta + m + k); + } else if (!(x > 0.0)) { + return log(qm) + log(qk) + boost::math::lgamma(thetaP[1] + m + k) + + boost::math::lgamma(theta + m) + boost::math::lgamma(theta + k) - + boost::math::lgamma(thetaP[1] + m) - + boost::math::lgamma(thetaP[1] + k) - + boost::math::lgamma(theta + m + k); + } else { + return log(qm) + log(qk) + boost::math::lgamma(thetaP[0] + m + k) + + boost::math::lgamma(theta + m) + boost::math::lgamma(theta + k) - + boost::math::lgamma(thetaP[0] + m) - + boost::math::lgamma(thetaP[0] + k) - + boost::math::lgamma(theta + m + k); + } +} + +double100 WrightFisher::mkjModeFinder_Evaluator( + int m, int k, int j, double100 x, double100 z, double100 s, double100 t, + const Options &o) /// Evaluation function for finding mode over (m,k,j) +{ + assert((m >= 0) && (k >= 0) && (j >= 0) && (j <= k) && (x >= 0.0) && + (x <= 1.0) && (z >= 0.0) && (z <= 1.0) && (s > 0.0) && (s < t)); + boost::math::binomial_distribution<> BIN(k, z); + double100 qm = QmApprox(m, s, o), qk = QmApprox(k, t - s, o); + if (!(qm > 0.0)) /// Ensure qm and qk are not zero when taking logs! If they + /// are, set to a very small positive value + { + qm = 1.0e-300; + } + if (!(qk > 0.0)) { + qk = 1.0e-300; + } + return log(qm) + log(qk) + log(pdf(BIN, j)) + + boost::math::lgamma(static_cast(theta + m)) + + boost::math::lgamma(static_cast(theta + k)) - + boost::math::lgamma(static_cast(theta + m + k)) + + (!(x > 0.0) + ? boost::math::lgamma( + static_cast(thetaP[1] + m + k - j)) - + boost::math::lgamma(static_cast(thetaP[1] + m)) - + boost::math::lgamma( + static_cast(thetaP[1] + k - j)) + : boost::math::lgamma(static_cast(thetaP[0] + m + j)) - + boost::math::lgamma(static_cast(thetaP[0] + m)) - + boost::math::lgamma(static_cast(thetaP[0] + j))); +} + +double100 WrightFisher::mkljModeFinder_Evaluator( + int m, int k, int l, int j, double100 x, double100 z, double100 s, + double100 t, + const Options &o) /// Evaluation function for finding mode over (m,k,l,j) +{ + assert((m >= 0) && (k >= 0) && (j >= 0) && (j <= k) && (l >= 0) && (l <= m) && + (x >= 0.0) && (x <= 1.0) && (z >= 0.0) && (z <= 1.0) && (s > 0.0) && + (s < t)); + boost::math::binomial_distribution<> BIN(m, x), BINZ(k, z); + double100 qm = QmApprox(m, s, o), qk = QmApprox(k, t - s, o); + if (!(qm > 0.0)) /// Ensure qm and qk are not zero when taking logs! If they + /// are, set to a very small positive value + { + qm = 1.0e-300; + } + if (!(qk > 0.0)) { + qk = 1.0e-300; + } + return log(qm) + log(qk) + log(pdf(BIN, l)) + log(pdf(BINZ, j)) + + boost::math::lgamma(static_cast(thetaP[0] + l + j)) + + boost::math::lgamma( + static_cast(thetaP[1] + m - l + k - j)) + + boost::math::lgamma(static_cast(theta + m)) - + boost::math::lgamma(static_cast(theta + m + k)) - + boost::math::lgamma(static_cast(thetaP[0] + l)) - + boost::math::lgamma(static_cast(thetaP[1] + m - l)); +} + +double100 WrightFisher::mklModeFinder_Evaluator( + int m, int k, int l, double100 x, double100 z, double100 s, double100 t, + const Options &o) /// Evaluation function for finding mode over (m,k,l) +{ + assert((m >= 0) && (k >= 0) && (l >= 0) && (l <= m) && (x > 0.0) && + (x < 1.0) && (!(z > 0.0) || !(z < 1.0)) && (s > 0.0) && (s < t)); + double100 qm = QmApprox(m, s, o), qk = QmApprox(k, t - s, o); + if (!(qm > 0.0)) /// Ensure qm and qk are not zero when taking logs! If they + /// are, set to a very small positive value + { + qm = 1.0e-300; + } + if (!(qk > 0.0)) { + qk = 1.0e-300; + } + boost::math::binomial_distribution<> BIN(m, x); + return log(qm) + log(qk) + log(pdf(BIN, l)) + + boost::math::lgamma(static_cast(theta + m)) - + boost::math::lgamma(theta + m + k) + + (!(z > 0.0) + ? boost::math::lgamma(static_cast(theta + m - l + k)) - + boost::math::lgamma(static_cast(theta + m - l)) + : boost::math::lgamma(static_cast(theta + l + k)) - + boost::math::lgamma(static_cast(theta + l))); +} + +vector WrightFisher::mkModeFinder( + double100 x, double100 z, double100 s, double100 t, + const Options &o) /// Routine for finding mode over (m,k) +{ + vector returnvec; + int m = static_cast(floor(GriffithsParas(s).first)), + k = static_cast(floor(GriffithsParas(t - s).first)); + + int m_ud, k_ud; /// Start at mode from qm and qk + double100 currMode_eval = mkModeFinder_Evaluator(m, k, x, z, s, t, o); + + bool stop = false; + + /// Iteratively increment m and k depending on whether function increases or + /// decreases with proposed move + while (!stop) { + if (currMode_eval < mkModeFinder_Evaluator(m + 1, k, x, z, s, t, o)) { + m_ud = 1; + } else if ((m - 1 >= 0) && currMode_eval < mkModeFinder_Evaluator( + m - 1, k, x, z, s, t, o)) { + m_ud = -1; + } else { + m_ud = 0; + } + + m += m_ud; + currMode_eval = mkModeFinder_Evaluator(m, k, x, z, s, t, o); + + if (currMode_eval < mkModeFinder_Evaluator(m, k + 1, x, z, s, t, o)) { + k_ud = 1; + } else if ((k - 1 >= 0) && currMode_eval < mkModeFinder_Evaluator( + m, k - 1, x, z, s, t, o)) { + k_ud = -1; + } else { + k_ud = 0; + } + + k += k_ud; + currMode_eval = mkModeFinder_Evaluator(m, k, x, z, s, t, o); + + if (!(m_ud > 0) && !(m_ud < 0) && !(k_ud > 0) && + !(k_ud < 0)) /// Keep iterating until both m & k told to not change + { + stop = true; + returnvec.push_back(m); + returnvec.push_back(k); + } + } + + return returnvec; +} + +vector WrightFisher::mkjModeFinder( + double100 x, double100 z, double100 s, double100 t, + const Options &o) /// Routine for finding mode over (m,k,j) +{ + vector returnvec; + int m = static_cast(floor(GriffithsParas(s).first)), + k = static_cast(floor(GriffithsParas(t - s).first)); + int j = static_cast(floor(static_cast(k) * z)); + + int m_ud, k_ud, j_ud; /// Starting from the modes of qm, qk and Bin(k,z) + double100 currMode_eval = mkjModeFinder_Evaluator(m, k, j, x, z, s, t, o); + + bool stop = false; + + /// Iteratively increment m and (k,j) depending on whether function increases + /// or decreases with proposed move - (k,j) updated jointly to make sure 0 <= + /// j <= k at all times + while (!stop) { + if (currMode_eval < mkjModeFinder_Evaluator(m + 1, k, j, x, z, s, t, o)) { + m_ud = 1; + } else if ((m - 1 >= 0) && + currMode_eval < + mkjModeFinder_Evaluator(m - 1, k, j, x, z, s, t, o)) { + m_ud = -1; + } else { + m_ud = 0; + } + + m += m_ud; + currMode_eval = mkjModeFinder_Evaluator(m, k, j, x, z, s, t, o); + + if (currMode_eval < mkjModeFinder_Evaluator(m, k + 1, j, x, z, s, t, o)) { + k_ud = 1; + if (currMode_eval < + mkjModeFinder_Evaluator(m, k + 1, j + 1, x, z, s, t, o)) { + j_ud = 1; + } else if ((j - 1 >= 0) && + (currMode_eval < + mkjModeFinder_Evaluator(m, k + 1, j - 1, x, z, s, t, o))) { + j_ud = -1; + } else { + j_ud = 0; + } + } else if ((k - 1 >= 0) && (j <= k - 1) && + currMode_eval < + mkjModeFinder_Evaluator(m, k - 1, j, x, z, s, t, o)) { + k_ud = -1; + if ((j + 1 <= k - 1) && + (currMode_eval < + mkjModeFinder_Evaluator(m, k - 1, j + 1, x, z, s, t, o))) { + j_ud = 1; + } else if ((j - 1 >= 0) && + (currMode_eval < + mkjModeFinder_Evaluator(m, k - 1, j - 1, x, z, s, t, o))) { + j_ud = -1; + } else { + j_ud = 0; + } + } else if ((k - 1 >= 0) && (j - 1 >= 0) && + (currMode_eval < + mkjModeFinder_Evaluator(m, k - 1, j - 1, x, z, s, t, o))) { + k_ud = -1; + j_ud = -1; + } else { + k_ud = 0; + if (k == 0) { + j_ud = 0; + } else { + if ((j + 1 <= k) && (currMode_eval < mkjModeFinder_Evaluator( + m, k, j + 1, x, z, s, t, o))) { + j_ud = 1; + } else if ((j - 1 >= 0) && + (currMode_eval < + mkjModeFinder_Evaluator(m, k, j - 1, x, z, s, t, o))) { + j_ud = -1; + } else { + j_ud = 0; + } + } + } + + k += k_ud; + j += j_ud; + currMode_eval = mkjModeFinder_Evaluator(m, k, j, x, z, s, t, o); + + /// Iterate until told to not update (m,k,j) anymore + if (!(m_ud > 0) && !(m_ud < 0) && !(k_ud > 0) && !(k_ud < 0) && + !(j_ud > 0) && !(j_ud < 0)) { + stop = true; + returnvec.push_back(m); + returnvec.push_back(k); + returnvec.push_back(j); + } + } + + return returnvec; +} + +vector WrightFisher::mkljModeFinder( + double100 x, double100 z, double100 s, double100 t, + const Options &o) /// Routine for finding mode over (m,k,l,j) +{ + vector returnvec; + int m = static_cast(floor(GriffithsParas(s).first)), + k = static_cast(floor(GriffithsParas(t - s).first)); + int l = static_cast(floor(static_cast(m) * x)), + j = static_cast(floor(static_cast(k) * z)); + + int m_ud, k_ud, l_ud, + j_ud; /// Initialise at modes from qm, qk, Bin(m,x), Bin(k,z) + double100 currMode_eval = mkljModeFinder_Evaluator(m, k, l, j, x, z, s, t, o); + + bool stop = false; + + /// Iteratively increment (m,l) and (k,j) depending on whether function + /// increases or decreases with proposed move - (m,l) & (k,j) updated jointly + /// to make sure 0 <= l <= m & 0 <= j <= k at all times + while (!stop) { + if (currMode_eval < + mkljModeFinder_Evaluator(m + 1, k, l, j, x, z, s, t, o)) { + m_ud = 1; + if (currMode_eval < + mkljModeFinder_Evaluator(m + 1, k, l + 1, j, x, z, s, t, o)) { + l_ud = 1; + } else if ((l - 1 >= 0) && + (currMode_eval < mkljModeFinder_Evaluator(m + 1, k, l - 1, j, + x, z, s, t, o))) { + l_ud = -1; + } else { + l_ud = 0; + } + } else if ((m - 1 >= 0) && (l <= m - 1) && + currMode_eval < + mkljModeFinder_Evaluator(m - 1, k, l, j, x, z, s, t, o)) { + m_ud = -1; + if ((l + 1 <= m - 1) && + (currMode_eval < + mkljModeFinder_Evaluator(m - 1, k, l + 1, j, x, z, s, t, o))) { + l_ud = 1; + } else if ((l - 1 >= 0) && + (currMode_eval < mkljModeFinder_Evaluator(m - 1, k, l - 1, j, + x, z, s, t, o))) { + l_ud = -1; + } else { + l_ud = 0; + } + } else if ((m - 1 >= 0) && (l - 1 >= 0) && + (currMode_eval < + mkljModeFinder_Evaluator(m - 1, k, l - 1, j, x, z, s, t, o))) { + m_ud = -1; + l_ud = -1; + } else { + m_ud = 0; + if (m == 0) { + l_ud = 0; + } else { + if ((l + 1 <= m) && + (currMode_eval < + mkljModeFinder_Evaluator(m, k, l + 1, j, x, z, s, t, o))) { + l_ud = 1; + } else if ((l - 1 >= 0) && + (currMode_eval < + mkljModeFinder_Evaluator(m, k, l - 1, j, x, z, s, t, o))) { + l_ud = -1; + } else { + l_ud = 0; + } + } + } + + m += m_ud; + l += l_ud; + currMode_eval = mkljModeFinder_Evaluator(m, k, l, j, x, z, s, t, o); + + if (currMode_eval < + mkljModeFinder_Evaluator(m, k + 1, l, j, x, z, s, t, o)) { + k_ud = 1; + if (currMode_eval < + mkljModeFinder_Evaluator(m, k + 1, l, j + 1, x, z, s, t, o)) { + j_ud = 1; + } else if ((j - 1 >= 0) && + (currMode_eval < mkljModeFinder_Evaluator(m, k + 1, l, j - 1, + x, z, s, t, o))) { + j_ud = -1; + } else { + j_ud = 0; + } + } else if ((k - 1 >= 0) && (j <= k - 1) && + currMode_eval < + mkljModeFinder_Evaluator(m, k - 1, l, j, x, z, s, t, o)) { + k_ud = -1; + if ((j + 1 <= k - 1) && + currMode_eval < + mkljModeFinder_Evaluator(m, k - 1, l, j + 1, x, z, s, t, o)) { + j_ud = 1; + } else if ((j - 1 >= 0) && + (currMode_eval < mkljModeFinder_Evaluator(m, k - 1, l, j - 1, + x, z, s, t, o))) { + j_ud = -1; + } else { + j_ud = 0; + } + } else if ((k - 1 >= 0) && (j - 1 >= 0) && + (currMode_eval < + mkljModeFinder_Evaluator(m, k - 1, l, j - 1, x, z, s, t, o))) { + k_ud = -1; + j_ud = -1; + } else { + k_ud = 0; + if (k == 0) { + j_ud = 0; + } else { + if ((j + 1 <= k) && + (currMode_eval < + mkljModeFinder_Evaluator(m, k, l, j + 1, x, z, s, t, o))) { + j_ud = 1; + } else if ((j - 1 >= 0) && + (currMode_eval < + mkljModeFinder_Evaluator(m, k, l, j - 1, x, z, s, t, o))) { + j_ud = -1; + } else { + j_ud = 0; + } + } + } + + k += k_ud; + j += j_ud; + currMode_eval = mkljModeFinder_Evaluator(m, k, l, j, x, z, s, t, o); + + /// Iterate until (m,k,l,j) told not to change any more + if (!(m_ud > 0) && !(m_ud < 0) && !(k_ud > 0) && !(k_ud < 0) && + !(j_ud > 0) && !(j_ud < 0)) { + stop = true; + returnvec.push_back(m); + returnvec.push_back(k); + returnvec.push_back(l); + returnvec.push_back(j); + } + } + + return returnvec; +} + +vector WrightFisher::mklModeFinder( + double100 x, double100 z, double100 s, double100 t, + const Options &o) /// Routine for finding mode over (m,k,l) +{ + vector returnvec; + int m = static_cast(floor(GriffithsParas(s).first)), + k = static_cast(floor(GriffithsParas(t - s).first)), + bumper = (thetaP.empty() ? 1 : 0); + int l = max(static_cast(floor(static_cast(m) * x)), bumper); + + int m_ud = -1, k_ud = -1, l_ud = -1, + mkLower = thetaP.empty() + ? 1 + : 0; /// Starting from the modes of qm, qk and Bin(m,x) + double100 currMode_eval = mklModeFinder_Evaluator(m, k, l, x, z, s, t, o); + + bool rerun = false; + + /// Iteratively increment k and (m,l) depending on whether function increases + /// or decreases with proposed move - (m,l) updated jointly to make sure 0 <= + /// l <= m at all times + while (!((m_ud == 0) && (k_ud == 0) && (l_ud == 0))) { + Rerun: + + if (currMode_eval < mklModeFinder_Evaluator(m, k + 1, l, x, z, s, t, o)) { + k_ud = 1; + } else if ((k - 1 >= mkLower) && + currMode_eval < + mklModeFinder_Evaluator(m, k - 1, l, x, z, s, t, o)) { + k_ud = -1; + } else { + k_ud = 0; + } + + k += k_ud; + currMode_eval = mklModeFinder_Evaluator(m, k, l, x, z, s, t, o); + int lLower = (thetaP.empty() || (!(thetaP[0] > 0.0) && !(z > 0.0)) ? 1 : 0), + lUpper = + (thetaP.empty() || (!(thetaP[1] > 0.0) && !(z < 1.0)) ? m - 1 : m); + + if (currMode_eval < mklModeFinder_Evaluator(m + 1, k, l, x, z, s, t, o)) { + m_ud = 1; + if (currMode_eval < + mklModeFinder_Evaluator(m + 1, k, l + 1, x, z, s, t, o)) { + l_ud = 1; + } else if ((l - 1 >= lLower) && + (currMode_eval < + mklModeFinder_Evaluator(m + 1, k, l - 1, x, z, s, t, o))) { + l_ud = -1; + } else { + l_ud = 0; + } + } else if ((m - 1 >= mkLower) && (l <= lUpper - 1) && + currMode_eval < + mklModeFinder_Evaluator(m - 1, k, l, x, z, s, t, o)) { + m_ud = -1; + if ((l + 1 <= lUpper - 1) && + (currMode_eval < + mklModeFinder_Evaluator(m - 1, k, l + 1, x, z, s, t, o))) { + l_ud = 1; + } else if ((l - 1 >= lLower) && + (currMode_eval < + mklModeFinder_Evaluator(m - 1, k, l - 1, x, z, s, t, o))) { + l_ud = -1; + } else { + l_ud = 0; + } + } else if ((m - 1 >= mkLower) && (l - 1 >= lLower) && + (currMode_eval < + mklModeFinder_Evaluator(m - 1, k, l - 1, x, z, s, t, o))) { + m_ud = -1; + l_ud = -1; + } else { + m_ud = 0; + if (m == mkLower) { + l_ud = 0; + } else { + if ((l + 1 <= lUpper) && + (currMode_eval < + mklModeFinder_Evaluator(m, k, l + 1, x, z, s, t, o))) { + l_ud = 1; + } else if ((l - 1 >= lLower) && + (currMode_eval < + mklModeFinder_Evaluator(m, k, l - 1, x, z, s, t, o))) { + l_ud = -1; + } else { + l_ud = 0; + } + } + } + + m += m_ud; + l += l_ud; + currMode_eval = mklModeFinder_Evaluator(m, k, l, x, z, s, t, o); + + if (rerun == true && !(k_ud == 0 && m_ud == 0 && l_ud == 0)) { + rerun = false; + } + + if (k_ud == 0 && m_ud == 0 && l_ud == 0 && rerun == false) { + rerun = true; + goto Rerun; + } + + /// Iterate until told to not update (m,k,l) anymore + } + + if ((thetaP.empty() || (!(thetaP[0] > 0.0) && (l == 0))) || + (thetaP.empty() || (!(thetaP[1] > 0.0) && (l == m)))) { + l = ((thetaP.empty() || (!(thetaP[0] > 0.0) && (l == 0))) + ? 1 + : m - 1); /// Sometimes l == 0/m but cannot be for cases when + /// thetaP.empty() + } + + returnvec.push_back(m); + returnvec.push_back(k); + returnvec.push_back(l); + + return returnvec; +} + +pair WrightFisher::DrawBridgepoint( + double100 x, double100 z, double100 t1, double100 t2, double100 s, + const Options &o, + boost::random::mt19937 + &gen) /// Routine to decide which bridge sampler to invoke for sampling + /// at time s from neutral bridge diffusion started at x at time + /// t1, ending at z in time t2, conditioned on non-absorption on + /// (t1,t2) +{ + assert((x >= 0.0) && (x <= 1.0) && (z >= 0.0) && (z <= 1.0) && (t1 >= 0.0) && + (s > t1) && (s < t2)); + double100 y, para1, para2; + int m, k, j, l, coeffcount = -1; + vector mklj; + + if ((s - t1 <= o.bridgethreshold || t2 - s <= o.bridgethreshold) || + (((theta - 1.0) / (exp(0.5 * theta * (s - t1)))) + + ((theta - 1.0) / (exp(0.5 * theta * (t2 - s)))) > + 260.0)) /// Use diffusion approximations + { /// Last condition checks that corresponding m and k terms are not too large + /// to create computational bottleneck + double100 y1 = + DrawEndpoint(x, t1, s, o, gen) + .first; /// Diffusion approximation for when times are too small and + /// bridge takes too long to compute + + y = abs((y1 - x) + ((t2 - s) / (t2 - t1)) * x + + ((s - t1) / (t2 - t1)) * z); /// Ensures y remains positive + + if (y > 1.0) /// Ensure y remains <= 1.0 + { + y = 1.0 - abs(1.0 - y); + } + } else /// Else use bridge simulator + { + if (!(x > 0.0)) /// x = 0 + { + if (!(z > 0.0)) /// x = 0 & z = 0 + { + if (s - t1 <= o.g1984threshold && + t2 - s <= o.g1984threshold) /// Time increments both below threshold + { + mklj = DrawBridgePMFSameMutationApprox(x, s - t1, t2 - t1, gen); + } /// One time increment both below threshold + else if ((s - t1 <= o.g1984threshold && t2 - s > o.g1984threshold) || + (s - t1 > o.g1984threshold && t2 - s <= o.g1984threshold)) { + mklj = + DrawBridgePMFSameMutationOneQApprox(x, s - t1, t2 - t1, o, gen); + } else /// Time increments are large enough for alternating series + /// method + { + mklj = DrawBridgePMFSameMutation(x, s - t1, t2 - t1, o, gen); + } + + m = mklj[0]; + k = mklj[1]; + l = 0; + j = 0; + } else if (!(z < 1.0)) /// x = 0 & z = 1 + { + if (s - t1 <= o.g1984threshold && + t2 - s <= o.g1984threshold) /// Time increments both below threshold + { + mklj = + DrawBridgePMFDifferentMutationApprox(s - t1, t2 - t1, x, o, gen); + } /// One time increment both below threshold + else if ((s - t1 <= o.g1984threshold && t2 - s > o.g1984threshold) || + (s - t1 > o.g1984threshold && t2 - s <= o.g1984threshold)) { + mklj = DrawBridgePMFDifferentMutationOneQApprox(s - t1, t2 - t1, x, o, + gen); + } else /// Time increments are large enough for alternating series + /// method + { + mklj = DrawBridgePMFDifferentMutation(s - t1, t2 - t1, x, o, gen); + } + + m = mklj[0]; + k = mklj[1]; + l = 0; + j = k; + } else /// x = 0 & z in (0,1) + { + if (s - t1 <= o.g1984threshold && + t2 - s <= o.g1984threshold) /// Time increments both below threshold + { + mklj = DrawBridgePMFInteriorMutationApprox(x, z, s - t1, t2 - t1, o, + gen); + } /// One time increment both below threshold + else if ((s - t1 <= o.g1984threshold && t2 - s > o.g1984threshold) || + (s - t1 > o.g1984threshold && t2 - s <= o.g1984threshold)) { + mklj = DrawBridgePMFInteriorMutationOneQApprox(x, z, s - t1, t2 - t1, + o, gen); + } else /// Time increments are large enough for alternating series + /// method + { + mklj = DrawBridgePMFInteriorMutation(x, z, s - t1, t2 - t1, o, gen); + } + + m = mklj[0]; + k = mklj[1]; + l = mklj[2]; + j = mklj[3]; + } + } else if (!(x < 1.0)) /// x = 1 + { + if (!(z > 0.0)) /// x = 1 & z = 0 + { + if (s - t1 <= o.g1984threshold && + t2 - s <= o.g1984threshold) /// Time increments both below threshold + { + mklj = + DrawBridgePMFDifferentMutationApprox(s - t1, t2 - t1, x, o, gen); + } /// One time increment both below threshold + else if ((s - t1 <= o.g1984threshold && t2 - s > o.g1984threshold) || + (s - t1 > o.g1984threshold && t2 - s <= o.g1984threshold)) { + mklj = DrawBridgePMFDifferentMutationOneQApprox(s - t1, t2 - t1, x, o, + gen); + } else /// Time increments are large enough for alternating series + /// method + { + mklj = DrawBridgePMFDifferentMutation(s - t1, t2 - t1, x, o, gen); + } + + m = mklj[0]; + k = mklj[1]; + l = m; + j = 0; + } else if (!(z < 1.0)) /// x = 1 & z = 1 + { + if (s - t1 <= o.g1984threshold && + t2 - s <= o.g1984threshold) /// Time increments both below threshold + { + mklj = DrawBridgePMFSameMutationApprox(x, s - t1, t2 - t1, gen); + } /// One time increment both below threshold + else if ((s - t1 <= o.g1984threshold && t2 - s > o.g1984threshold) || + (s - t1 > o.g1984threshold && t2 - s <= o.g1984threshold)) { + mklj = + DrawBridgePMFSameMutationOneQApprox(x, s - t1, t2 - t1, o, gen); + } else /// Time increments are large enough for alternating series + /// method + { + mklj = DrawBridgePMFSameMutation(x, s - t1, t2 - t1, o, gen); + } + + m = mklj[0]; + k = mklj[1]; + l = m; + j = k; + } else /// x = 1 & z in (0,1) + { + if (s - t1 <= o.g1984threshold && + t2 - s <= o.g1984threshold) /// Time increments both below threshold + { + mklj = DrawBridgePMFInteriorMutationApprox(x, z, s - t1, t2 - t1, o, + gen); + } /// One time increment both below threshold + else if ((s - t1 <= o.g1984threshold && t2 - s > o.g1984threshold) || + (s - t1 > o.g1984threshold && t2 - s <= o.g1984threshold)) { + mklj = DrawBridgePMFInteriorMutationOneQApprox(x, z, s - t1, t2 - t1, + o, gen); + } else /// Time increments are large enough for alternating series + /// method + { + mklj = DrawBridgePMFInteriorMutation(x, z, s - t1, t2 - t1, o, gen); + } + + m = mklj[0]; + k = mklj[1]; + l = mklj[2]; + j = mklj[3]; + } + } else /// x in (0,1) + { + if (!(z > 0.0)) /// x in (0,1) & z = 0 + { + double100 newt2 = t2 - t1, news = t2 - s; + + if (news <= o.g1984threshold && + newt2 - news <= + o.g1984threshold) /// Time increments both below threshold + { + mklj = DrawBridgePMFInteriorMutationApprox( + z, x, news, newt2, o, + gen); /// Time reversal! Flip x and z because reverse time bridge + } /// One time increment both below threshold + else if ((news <= o.g1984threshold && + newt2 - news > o.g1984threshold) || + (news > o.g1984threshold && + newt2 - news <= o.g1984threshold)) { + mklj = DrawBridgePMFInteriorMutationOneQApprox( + z, x, news, newt2, o, + gen); /// Time reversal! Flip x and z because reverse time bridge + } else /// Time increments are large enough for alternating series + /// method + { + mklj = DrawBridgePMFInteriorMutation( + z, x, news, newt2, o, + gen); /// Time reversal! Flip x and z because reverse time bridge + } + + m = mklj[0]; + k = mklj[1]; + l = mklj[2]; + j = mklj[3]; + } else if (!(z < 1.0)) /// x in (0,1) & z = 1 + { + double100 newt2 = t2 - t1, news = t2 - s; + + if (news <= o.g1984threshold && + newt2 - news <= + o.g1984threshold) /// Time increments both below threshold + { + mklj = DrawBridgePMFInteriorMutationApprox( + z, x, news, newt2, o, + gen); /// Time reversal! Flip x and z because reverse time bridge + } /// One time increment both below threshold + else if ((news <= o.g1984threshold && + newt2 - news > o.g1984threshold) || + (news > o.g1984threshold && + newt2 - news <= o.g1984threshold)) { + mklj = DrawBridgePMFInteriorMutationOneQApprox( + z, x, news, newt2, o, + gen); /// Time reversal! Flip x and z because reverse time bridge + } else /// Time increments are large enough for alternating series + /// method + { + mklj = DrawBridgePMFInteriorMutation( + z, x, news, newt2, o, + gen); /// Time reversal! Flip x and z because reverse time bridge + } + + m = mklj[0]; + k = mklj[1]; + l = mklj[2]; + j = mklj[3]; + } else /// x in (0,1) & z in (0,1) + { + if (s - t1 <= o.g1984threshold && + t2 - s < o.g1984threshold) /// Time increments both below threshold + { + mklj = DrawBridgePMFG1984(x, z, s - t1, t2 - t1, o, gen); + } /// One time increment both below threshold + else if ((s - t1 <= o.g1984threshold && t2 - s > o.g1984threshold) || + (s - t1 > o.g1984threshold && t2 - s <= o.g1984threshold)) { + mklj = DrawBridgePMFOneQApprox(x, z, s - t1, t2 - t1, o, gen); + } else /// Time increments are large enough for alternating series + /// method + { + mklj = DrawBridgePMF(x, z, s - t1, t2 - t1, o, gen); + } + + m = mklj[0]; + k = mklj[1]; + l = mklj[2]; + j = mklj[3]; + } + } + + para1 = static_cast(thetaP[0] + l + j), + para2 = static_cast(thetaP[1] + m - l + k - j); + + boost::random::gamma_distribution<> GAMMA1(para1, 1.0), GAMMA2(para2, 1.0); + + y = -1.0; + while (!(0.0 < y && y < 1.0)) { + double100 G1 = GAMMA1(gen), G2 = GAMMA2(gen); + y = G1 / (G1 + G2); + } + } + + return make_pair(y, coeffcount); +} + +pair WrightFisher::DrawUnconditionedBridge( + double100 x, double100 z, double100 t1, double100 t2, double100 s, + const Options &o, + boost::random::mt19937 + &gen) /// Routine to decide which bridge sampler to invoke for sampling + /// at time s from neutral bridge diffusion started at x at time + /// t1, ending at z in time t2, with potential absorption at any + /// time in between [t1,t2] +{ + assert((x >= 0.0) && (x <= 1.0) && (z >= 0.0) && (z <= 1.0) && (t1 >= 0.0) && + (s > t1) && (s < t2)); + double100 y, para1, para2; + int m = -1, k = -1, j = -1, l = -1, coeffcount = -1; + vector mklj; + + if ((s - t1 <= o.bridgethreshold || t2 - s <= o.bridgethreshold) || + (((theta - 1.0) / (exp(0.5 * theta * (s - t1)))) + + ((theta - 1.0) / (exp(0.5 * theta * (t2 - s)))) > + 260.0)) /// Use diffusion approximations + { /// Last condition checks that corresponding m and k terms are not too large + /// to create computational bottleneck + double100 y1 = + DrawEndpoint(x, t1, s, o, gen) + .first; /// Diffusion approximation for when times are too small and + /// bridge takes too long to compute + + y = abs((y1 - x) + ((t2 - s) / (t2 - t1)) * x + + ((s - t1) / (t2 - t1)) * z); /// Ensures y remains positive + + if (y > 1.0) /// Ensure y remains <= 1.0 + { + y = 1.0 - abs(1.0 - y); + } + } else { + if (thetaP.empty()) { + if (!(x > 0.0)) { + if (!(z > 0.0)) { + return make_pair(0.0, coeffcount); + } else { + cerr << "Right endpoint for bridge is impossible for the given " + "configuration! Returned value corresponds to the left " + "endpoint!"; + return make_pair(0.0, coeffcount); + } + } else if (!(x < 1.0)) { + if (!(z < 1.0)) { + return make_pair(1.0, coeffcount); + } else { + cerr << "Right endpoint for bridge is impossible for the given " + "configuration! Returned value corresponds to the left " + "endpoint!"; + return make_pair(1.0, coeffcount); + } + } else { + if (!(z > 0.0)) { + vector mklj; + + if (s - t1 <= o.g1984threshold && t2 - s <= o.g1984threshold) { + mklj = + DrawBridgePMFUnconditionalApprox(x, z, s - t1, t2 - t1, o, gen); + } else if ((s - t1 <= o.g1984threshold && + t2 - s > o.g1984threshold) || + (s - t1 > o.g1984threshold && + t2 - s <= o.g1984threshold)) { + mklj = DrawBridgePMFUnconditionalOneQApprox(x, z, s - t1, t2 - t1, + o, gen); + } else { + mklj = DrawBridgePMFUnconditional(x, z, s - t1, t2 - t1, o, gen); + } + + m = mklj[0]; + k = mklj[1]; + l = mklj[2]; + j = 0; + + if (l == 0) { + return make_pair(0.0, coeffcount); + } + } else if (!(z < 1.0)) { + vector mklj; + + if (s - t1 <= o.g1984threshold && t2 - s <= o.g1984threshold) { + mklj = + DrawBridgePMFUnconditionalApprox(x, z, s - t1, t2 - t1, o, gen); + } else if ((s - t1 <= o.g1984threshold && + t2 - s > o.g1984threshold) || + (s - t1 > o.g1984threshold && + t2 - s <= o.g1984threshold)) { + mklj = DrawBridgePMFUnconditionalOneQApprox(x, z, s - t1, t2 - t1, + o, gen); + } else { + mklj = DrawBridgePMFUnconditional(x, z, s - t1, t2 - t1, o, gen); + } + + m = mklj[0]; + k = mklj[1]; + l = mklj[2]; + j = k; + + if (l == m) { + return make_pair(1.0, coeffcount); + } + } else /// Otherwise the conditions imposed imply the diffusion cannot + /// be absorbed over [t1,t2], so we can use Drawbridgepoint + { + ThetaResetter(); + return DrawBridgepoint(x, z, t1, t2, s, o, gen); + } + } + } else if (!(thetaP[0] > 0.0) || !(thetaP[1] > 0.0)) { + if (!(thetaP[0] > 0.0)) { + if (!(x > 0.0)) { + if (!(z > 0.0)) { + return make_pair(0.0, coeffcount); + } else { + cerr << "Right endpoint for bridge is impossible for the given " + "configuration! Returned value corresponds to the left " + "endpoint!"; + return make_pair(0.0, coeffcount); + } + } else { + if (!(z > 0.0)) { + vector mklj; + + if (s - t1 <= o.g1984threshold && t2 - s <= o.g1984threshold) { + mklj = DrawBridgePMFUnconditionalApprox(x, z, s - t1, t2 - t1, o, + gen); + } else if ((s - t1 <= o.g1984threshold && + t2 - s > o.g1984threshold) || + (s - t1 > o.g1984threshold && + t2 - s <= o.g1984threshold)) { + mklj = DrawBridgePMFUnconditionalOneQApprox(x, z, s - t1, t2 - t1, + o, gen); + } else { + mklj = DrawBridgePMFUnconditional(x, z, s - t1, t2 - t1, o, gen); + } + + m = mklj[0]; + k = mklj[1]; + l = mklj[2]; + j = 0; + + if (l == 0) { + return make_pair(0.0, coeffcount); + } + } else { + ThetaResetter(); + return DrawBridgepoint(x, z, t1, t2, s, o, gen); + } + } + } else { + if (!(x < 1.0)) { + if (!(z < 1.0)) { + return make_pair(1.0, coeffcount); + } else { + cerr << "Right endpoint for bridge is impossible for the given " + "configuration! Returned value corresponds to the left " + "endpoint!"; + return make_pair(1.0, coeffcount); + } + } else { + if (!(z < 1.0)) { + vector mklj; + + if (s - t1 <= o.g1984threshold && t2 - s <= o.g1984threshold) { + mklj = DrawBridgePMFUnconditionalApprox(x, z, s - t1, t2 - t1, o, + gen); + } else if ((s - t1 <= o.g1984threshold && + t2 - s > o.g1984threshold) || + (s - t1 > o.g1984threshold && + t2 - s <= o.g1984threshold)) { + mklj = DrawBridgePMFUnconditionalOneQApprox(x, z, s - t1, t2 - t1, + o, gen); + } else { + mklj = DrawBridgePMFUnconditional(x, z, s - t1, t2 - t1, o, gen); + } + + m = mklj[0]; + k = mklj[1]; + l = mklj[2]; + j = 0; + + if (l == m) { + return make_pair(1.0, coeffcount); + } + } else { + ThetaResetter(); + return DrawBridgepoint(x, z, t1, t2, s, o, gen); + } + } + } + } else /// No absorption can happen, so we are in the same case as in + /// DrawBridgepoint + { + ThetaResetter(); + return DrawBridgepoint(x, z, t1, t2, s, o, gen); + } + } + + para1 = (thetaP.empty() ? static_cast(l + j) + : (!(thetaP[0] > 0.0) + ? static_cast(l + j) + : static_cast(thetaP[0] + l + j))); + para2 = (thetaP.empty() + ? static_cast(m - l + k - j) + : (!(thetaP[1] > 0.0) + ? static_cast(m - l + k - j) + : static_cast(thetaP[1] + m - l + k - j))); + + boost::random::gamma_distribution<> GAMMA1(para1, 1.0), GAMMA2(para2, 1.0); + + y = -1.0; + while (!(0.0 < y && y < 1.0)) { + double100 G1 = GAMMA1(gen), G2 = GAMMA2(gen); + y = G1 / (G1 + G2); + } + + return make_pair(y, coeffcount); +} + +/// BRIDGE SIMULATION - NON-NEUTRAL PATHS + +vector> WrightFisher::NonNeutralDrawBridge( + double100 x, double100 t1, double100 t2, double100 z, bool Absorption, + const Options &o, + boost::random::mt19937 + &gen) /// Draws of paths from non-neutral WF diffusion bridge started + /// from x at time t1 and ending at z at time t2 +{ + bool accept = false; + vector paras{phiMin, phiMax, phiMax - phiMin}; + double100 kapmean = paras[2] * (t2 - t1); /// Rate of Poisson point process + boost::random::poisson_distribution kap(static_cast(kapmean)); + + boost::random::uniform_01 unift, + unifm; /// Set up uniform generators for points over [t1,t2] * + /// [0,phiMax-phiMin] * [0,1] + vector> ptr; + int rcount = 0; + vector kappastore; + + while (!accept) /// Until all skeleton points get accepted, keep going + { + int kappa = kap(gen); /// Generate kappa ~ Pois + vector path, times(kappa), marks(kappa), rejcount; + auto gent = [&t1, &t2, &unift, &gen]() /// time stamps ~ Unif [t1,t2] + { return (t1 + ((t2 - t1) * unift(gen))); }; + auto genm = [¶s, &unifm, &gen]() /// marks ~ Unif [0,phiMax-phiMin] + { return (paras[2] * unifm(gen)); }; + generate(begin(times), end(times), gent); + generate(begin(marks), end(marks), genm); + sortVectorsAscending(times, times, + marks); /// Sort vectors according to timestamps + + if (kappa == 0) /// No skeleton points -> accept + { + rejcount.push_back(rcount); + kappastore.push_back(1.0 * kappa); + ptr.push_back(path); + ptr.push_back(times); + ptr.push_back(rejcount); + ptr.push_back(kappastore); + accept = true; + } else /// kappa > 0 - generate skeleton points and check them + { + for (vector::iterator itt = times.begin(), itm = marks.begin(); + itt != times.end(); itt++, itm++) { + if (itt == times.begin()) { + if (Absorption) { + path.push_back( + DrawUnconditionedBridge(x, z, t1, t2, *itt, o, gen).first); + } else { + path.push_back( + DrawBridgepoint(x, z, t1, t2, *itt, o, gen) + .first); /// Generate skeleton points sequentially + } + + if (Phitilde(path.back()) - paras[0] > + *itm) /// Test generated point is OK, otherwise can stop and + /// generate a new Poisson point process + { + rcount++; + break; + } + + if (kappa == 1) /// We only needed to generate one skeleton point, + /// which we accepted, so we can exit + { + rejcount.push_back(rcount); + kappastore.push_back(1.0 * kappa); + ptr.push_back(path); + ptr.push_back(times); + ptr.push_back(rejcount); + ptr.push_back(kappastore); + accept = true; + } + } else if (*itt != + times.back()) /// There are more than 2 skeleton points, and + /// we are not at the last one yet + { + if (Absorption) { + path.push_back(DrawUnconditionedBridge(path.back(), z, *(itt - 1), + t2, *itt, o, gen) + .first); + } else { + path.push_back( + DrawBridgepoint(path.back(), z, *(itt - 1), t2, *itt, o, gen) + .first); /// Generate skeleton points sequentially + } + + if (Phitilde(path.back()) - paras[0] > + *itm) /// Check the generated point is OK, otherwise can stop and + /// generate a new Poisson point process + { + rcount++; + break; + } + } else /// We are at the last skeleton point + { + if (Absorption) { + path.push_back(DrawUnconditionedBridge(path.back(), z, *(itt - 1), + t2, *itt, o, gen) + .first); /// Generate skeleton point sequentially + } else { + path.push_back( + DrawBridgepoint(path.back(), z, *(itt - 1), t2, *itt, o, gen) + .first); /// Generate skeleton point sequentially + } + + if (Phitilde(path.back()) - paras[0] > + *itm) /// Check the generated point is OK, otherwise can stop and + /// generate a new Poisson point process + { + rcount++; + break; + } + rejcount.push_back(rcount); /// We are at the end, so we can just exit + kappastore.push_back(1.0 * kappa); + ptr.push_back(path); + ptr.push_back(times); + ptr.push_back(rejcount); + ptr.push_back(kappastore); + accept = true; + } + } + } + } + + return ptr; +} + +pair WrightFisher::NonNeutralDrawBridgepoint( + double100 x, double100 t1, double100 t2, double100 z, double100 testT, + bool Absorption, const Options &o, + boost::random::mt19937 + &gen) /// Invoke NonNeutralDrawBridge to generate a whole bridge path, + /// conditionally on the generated path, generate a neutral draw + /// at time testT +{ + vector bridgeSection, bridgeTimes; + bridgeSection.push_back(x); + bridgeTimes.push_back(t1); + + vector> skeleton = NonNeutralDrawBridge( + x, t1, t2, z, Absorption, o, gen); /// Create skeleton points for bridge + bridgeSection.insert(bridgeSection.end(), skeleton[0].begin(), + skeleton[0].end()); + bridgeTimes.insert(bridgeTimes.end(), skeleton[1].begin(), skeleton[1].end()); + + bridgeSection.push_back(z); + bridgeTimes.push_back(t2); + + vector::iterator timeIt = bridgeTimes.begin(), + xIt = bridgeSection.begin(); + while (*timeIt < + testT) /// Cycle through skeleton points to find appropriate end points + { + timeIt++; + xIt++; + } + timeIt--; + xIt--; + if (Absorption) { + return DrawUnconditionedBridge(*xIt, *(xIt + 1), *timeIt, *(timeIt + 1), + testT, o, gen); + } else { + return DrawBridgepoint(*xIt, *(xIt + 1), *timeIt, *(timeIt + 1), testT, o, + gen); /// Return neutral draw using corresponding + /// endpoints and time increments + } +} + +/// SIMULATION RUNNER FUNCTIONS + +void WrightFisher::DiffusionRunner( + int nSim, double100 x, double100 startT, double100 endT, bool Absorption, + string &Filename, const Options &o, + boost::random::mt19937 + &gen) /// Function to generate specified number of diffusion draws +{ + ofstream saveFile; + saveFile.open(Filename); + + int nosamples = 1, loader = floor(0.1 * nSim), loader_count = 1; + while (nosamples < nSim + 1) { + if (non_neutral) { + saveFile + << NonNeutralDrawEndpoint(x, startT, endT, Absorption, o, gen).first + << "\n"; + } else { + if (Absorption) { + saveFile << DrawUnconditionedDiffusion(x, endT - startT, o, gen).first + << "\n"; + } else { + saveFile << DrawEndpoint(x, startT, endT, o, gen).first << "\n"; + } + } + + nosamples++; + if (nosamples % (loader * loader_count) == 0) { + cout << "Simulated " << nosamples << " samples." << endl; + loader_count++; + } + } + + cout << "Diffusion simulation complete." << endl; +} + +void WrightFisher::BridgeDiffusionRunner( + int nSim, double100 x, double100 z, double100 startT, double100 endT, + double100 sampleT, bool Absorption, string &Filename, const Options &o, + boost::random::mt19937 + &gen) /// Function to generate specified number of bridge draws +{ + ofstream saveFile; + saveFile.open(Filename); + + int nosamples = 1, loader = floor(0.1 * nSim), loader_count = 1; + while (nosamples < nSim + 1) { + if (non_neutral) { + saveFile << NonNeutralDrawBridgepoint(x, startT, endT, z, sampleT, + Absorption, o, gen) + .first + << "\n"; + } else { + if (Absorption) { + saveFile << DrawUnconditionedBridge(x, z, startT, endT, sampleT, o, gen) + .first + << "\n"; + } else { + ThetaResetter(); + saveFile << DrawBridgepoint(x, z, startT, endT, sampleT, o, gen).first + << "\n"; + } + } + + nosamples++; + if (nosamples % (loader * loader_count) == 0) { + cout << "Simulated " << nosamples << " samples." << endl; + loader_count++; + } + } + + cout << "Bridge simulation complete." << endl; +} + +void WrightFisher::DiffusionDensityCalculator( + int meshSize, double100 x, double100 startT, double100 endT, + bool Absorption, string &Filename, + const Options + &o) /// Function to compute truncated diffusion transition density +{ + ofstream saveFile; + saveFile.open(Filename); + + int counter = 0; + double100 timeInc = endT - startT, + yinc = 1.0 / static_cast(meshSize), y, ycount = 0.1; + while (counter <= meshSize) { + if (counter == 0) { + y = 0.0; + } else if (counter == meshSize) { + y = 1.0; + } else { + y += yinc; + } + if (non_neutral) { + cerr << "Truncated density cannot be computed for non-neutral case due " + "to presence of intractable quantities!"; + } else { + if (Absorption) { + if ((x > 0.0) && (x < 1.0)) { + saveFile << y << " " + << UnconditionedDiffusionDensity(x, y, timeInc, o) << "\n"; + } else { + if (!(x > y) && !(x < y)) { + saveFile << y << " " << 1.0 << "\n"; + } else { + saveFile << y << " " << 0.0 << "\n"; + } + } + } else { + saveFile << y << " " << DiffusionDensityApproximation(x, y, timeInc, o) + << "\n"; + } + } + + if (y >= ycount) { + cout << "Calculated density up to y = " << ycount << endl; + ycount += 0.1; + } + counter++; + } + + cout << "Density calculation complete." << endl; + + saveFile.close(); +} + +void WrightFisher::BridgeDiffusionDensityCalculator( + int meshSize, double100 x, double100 z, double100 startT, double100 endT, + double100 sampleT, bool Absorption, string &Filename, + const Options & + o) /// Function to compute truncated diffusion bridge transition density +{ + ofstream saveFile; + saveFile.open(Filename); + + int counter = 0; + double100 timeInc = endT - startT, sampleInc = sampleT - startT, + yinc = 1.0 / static_cast(meshSize), y, ycount = 0.1; + while (counter <= meshSize) { + if (counter == 0) { + y = 0.0; + } else if (counter == meshSize) { + y = 1.0; + } else { + y += yinc; + } + if (non_neutral) { + cerr << "Truncated density cannot be computed for non-neutral case due " + "to presence of intractable quantities!"; + } else { + if (Absorption) { + if ((x > 0.0) && (x < 1.0)) { + saveFile << y << " " + << UnconditionedBridgeDensity(x, z, y, sampleInc, timeInc, o) + << "\n"; + } else { + if (!(x > y) && !(x < y)) { + saveFile << y << " " << 1.0 << "\n"; + } else { + saveFile << y << " " << 0.0 << "\n"; + } + } + } else { + saveFile << y << " " << BridgeDensity(x, z, y, sampleInc, timeInc, o) + << "\n"; + } + } + + if (y >= ycount) { + cout << "Calculated density up to y = " << ycount << endl; + ycount += 0.1; + } + counter++; + } + + cout << "Density calculation complete." << endl; + + saveFile.close(); +} diff --git a/WrightFisher.h b/WrightFisher.h new file mode 100644 index 0000000..af9c92d --- /dev/null +++ b/WrightFisher.h @@ -0,0 +1,280 @@ + +#ifndef __EA__WrightFisher__ +#define __EA__WrightFisher__ + +#include +#include +#include +#include +#include + +using namespace boost::multiprecision; + +#include "Polynomial.h" +#include "myHelpers.h" + +/// typedef boost::multiprecision::cpp_dec_float_100 double100; /// Can switch +/// to this for increased precision, but makes computations much slower!! +typedef double double100; + +class WrightFisher { +public: + WrightFisher(vector thetaP_in, bool non_neut_in, double100 sigma_in, + int selectionsetup_in, double dom_in, int SelPolyDeg_in, + vector selCoefs_in) + : thetaP(thetaP_in), non_neutral(non_neut_in), sigma(sigma_in), + SelectionSetup(selectionsetup_in), dominanceParameter(dom_in), + SelPolyDeg(SelPolyDeg_in), selectionCoeffs(selCoefs_in) { + ThetaSetter(); + SelectionSetter(); + PhiSetter(); + } + + /// HELPER FUNCTIONS + + void ThetaSetter(); + void ThetaResetter(); + void SelectionSetter(); + void PhiSetter(); + double100 Phitilde(double100 y); + vector PhitildeMinMaxRange(); + double100 Atilde(double100 x); + double100 Atildeplus(); + pair GriffithsParas(double100 t); + double100 computeLogBeta(int m, int k); + double100 NormCDF(double100 x, double100 m, double100 v); + double100 DiscretisedNormCDF(int m, double100 t); + double100 UnconditionedDiffusionDensity(double100 x, double100 y, double100 t, + const Options &o); + double100 DiffusionDensityApproximationDenom(double100 x, double100 t, + const Options &o); + double100 DiffusionDensityApproximation(double100 x, double100 y, double100 t, + const Options &o); + double100 QmApprox(int m, double100 t, const Options &o); + double100 UnconditionedBridgeDensity(double100 x, double100 z, double100 y, + double100 s, double100 t, + const Options &o); + double100 BridgeDenominatorApprox(double100 x, double100 z, double100 t, + const Options &o); + double100 DiffusionBridgeDensityApproximation(double100 x, double100 z, + double100 y, double100 t, + double100 s, const Options &o); + double100 BridgeDenom(double100 x, double100 z, double100 y, double100 s, + double100 t, const Options &o); + double100 ComputeDensity1(double100 x, double100 z, double100 y, double100 s, + double100 t, const Options &o); + double100 ComputeDensity2(double100 x, double100 z, double100 y, double100 s, + double100 t, const Options &o); + double100 ComputeDensity3(double100 x, double100 z, double100 y, double100 s, + double100 t, const Options &o); + double100 ComputeDensity4(double100 x, double100 z, double100 y, double100 s, + double100 t, const Options &o); + double100 BridgeDensity(double100 x, double100 z, double100 y, double100 s, + double100 t, const Options &o); + double100 LogSumExp(vector &vecProb, double100 maxProb); + + /// DIFFUSION SIMULATION - NEUTRAL PATHS + + pair DrawAncestralProcess(double100 t, const Options &o, + boost::random::mt19937 &gen); + pair + DrawAncestralProcessConditionalZero(double100 t, const Options &o, + boost::random::mt19937 &gen); + pair, int> DrawAncestralProcessConditionalInterior( + double100 t, double100 x, const Options &o, boost::random::mt19937 &gen); + int DrawAncestralProcessG1984(double100 t, boost::random::mt19937 &gen); + int DrawSizebiasedAncestralProcess(int d, double100 t, + boost::random::mt19937 &gen); + pair DrawEndpoint(double100 x, double100 t1, double100 t2, + const Options &o, + boost::random::mt19937 &gen); + pair DrawUnconditionedDiffusion(double100 x, double100 t, + const Options &o, + boost::random::mt19937 &gen); + + /// DIFFUSION SIMULATION - NON-NEUTRAL PATHS + + vector> NonNeutralDraw(double100 x, double100 t1, + double100 t2, bool Absorption, + const Options &o, + boost::random::mt19937 &gen); + pair NonNeutralDrawEndpoint(double100 x, double100 t1, + double100 t2, bool Absorption, + const Options &o, + boost::random::mt19937 &gen); + + /// BRIDGE SIMULATION - NEUTRAL PATHS + + vector DrawBridgePMFUnconditional(double100 x, double100 z, double100 s, + double100 t, const Options &o, + boost::random::mt19937 &gen); + vector DrawBridgePMFUnconditionalOneQApprox(double100 x, double100 z, + double100 s, double100 t, + const Options &o, + boost::random::mt19937 &gen); + vector DrawBridgePMFUnconditionalApprox(double100 x, double100 z, + double100 s, double100 t, + const Options &o, + boost::random::mt19937 &gen); + vector DrawBridgePMFSameMutation(double100 x, double100 s, double100 t, + const Options &o, + boost::random::mt19937 &gen); + vector DrawBridgePMFSameMutationOneQApprox(double100 x, double100 s, + double100 t, const Options &o, + boost::random::mt19937 &gen); + vector DrawBridgePMFSameMutationApprox(double100 x, double100 s, + double100 t, + boost::random::mt19937 &gen); + vector DrawBridgePMFDifferentMutation(double100 s, double100 t, + double100 x, const Options &o, + boost::random::mt19937 &gen); + vector + DrawBridgePMFDifferentMutationOneQApprox(double100 s, double100 t, + double100 x, const Options &o, + boost::random::mt19937 &gen); + vector DrawBridgePMFDifferentMutationApprox(double100 s, double100 t, + double100 x, + const Options &o, + boost::random::mt19937 &gen); + vector DrawBridgePMFInteriorMutation(double100 x, double100 z, + double100 s, double100 t, + const Options &o, + boost::random::mt19937 &gen); + vector + DrawBridgePMFInteriorMutationOneQApprox(double100 x, double100 z, double100 s, + double100 t, const Options &o, + boost::random::mt19937 &gen); + vector DrawBridgePMFInteriorMutationApprox(double100 x, double100 z, + double100 s, double100 t, + const Options &o, + boost::random::mt19937 &gen); + vector DrawBridgePMF(double100 x, double100 z, double100 s, double100 t, + const Options &o, boost::random::mt19937 &gen); + vector DrawBridgePMFOneQApprox(double100 x, double100 z, double100 s, + double100 t, const Options &o, + boost::random::mt19937 &gen); + vector DrawBridgePMFG1984(double100 x, double100 z, double100 s, + double100 t, const Options &o, + boost::random::mt19937 &gen); + double100 mkModeFinder_Evaluator(int m, int k, double100 x, double100 z, + double100 s, double100 t, const Options &o); + double100 mkjModeFinder_Evaluator(int m, int k, int j, double100 x, + double100 z, double100 s, double100 t, + const Options &o); + double100 mkljModeFinder_Evaluator(int m, int k, int l, int j, double100 x, + double100 z, double100 s, double100 t, + const Options &o); + double100 mklModeFinder_Evaluator(int m, int k, int l, double100 x, + double100 z, double100 s, double100 t, + const Options &o); + vector mkModeFinder(double100 x, double100 z, double100 s, double100 t, + const Options &o); + vector mkjModeFinder(double100 x, double100 z, double100 s, double100 t, + const Options &o); + vector mkljModeFinder(double100 x, double100 z, double100 s, double100 t, + const Options &o); + vector mklModeFinder(double100 x, double100 z, double100 s, double100 t, + const Options &o); + pair DrawBridgepoint(double100 x, double100 z, double100 t1, + double100 t2, double100 s, + const Options &o, + boost::random::mt19937 &gen); + pair DrawUnconditionedBridge(double100 x, double100 z, + double100 t1, double100 t2, + double100 s, const Options &o, + boost::random::mt19937 &gen); + + /// BRIDGE SIMULATION - NON-NEUTRAL PATHS + + vector> NonNeutralDrawBridge(double100 x, double100 t1, + double100 t2, double100 z, + bool Absorption, + const Options &o, + boost::random::mt19937 &gen); + pair + NonNeutralDrawBridgepoint(double100 x, double100 t1, double100 t2, + double100 z, double100 testT, bool Absorption, + const Options &o, boost::random::mt19937 &gen); + + /// SIMULATION RUNNER FUNCTIONS + + void DiffusionRunner(int nSim, double100 x, double100 startT, double100 endT, + bool Absorption, string &Filename, const Options &o, + boost::random::mt19937 &gen); + void BridgeDiffusionRunner(int nSim, double100 x, double100 z, + double100 startT, double100 endT, + double100 sampleT, bool Absorption, + string &Filename, const Options &o, + boost::random::mt19937 &gen); + void DiffusionDensityCalculator(int meshSize, double100 x, double100 startT, + double100 endT, bool Absorption, + string &Filename, const Options &o); + void BridgeDiffusionDensityCalculator(int meshSize, double100 x, double100 z, + double100 startT, double100 endT, + double100 sampleT, bool Absorption, + string &Filename, const Options &o); + +private: + /// WRIGHT-FISHER PROPERTIES + + vector thetaP; + bool non_neutral; + double theta, sigma; + int SelectionSetup; + double dominanceParameter, phiMin, phiMax, AtildeMax; + int SelPolyDeg; + vector selectionCoeffs; + Polynomial SelectionFunction, PhiFunction, AtildeFunction; + int thetaIndex; + vector> akm; + + /// HELPER FUNCTIONS + + template T Getlogakm(int k, int m); + int radiate_from_mode(int index, const double100 t) const; + void increment_on_mk(vector &mk, const double100 s, + const double100 t) const; + double100 Getd(vector &d, int i, double100 x, double100 z, + double100 t); + double100 Getd2(vector &d, int i, double100 x, double100 t); + double100 GetdBridgeSame(vector &d, int i, double100 x, + double100 t); + double100 GetdBridgeInterior(vector &d, int i, double100 x, + double100 z, double100 t); + double100 GetdBridgeUnconditional(vector &d, int i, double100 x, + double100 z, double100 t); + double100 computeA(int m, int k, int l, int j, double100 x, double100 z); + double100 computeAUnconditional(int m, int k, int l, double100 x, + double100 z); + int computeC(int m, pair, double100> &C); + int computeE(pair, double100> &C); +}; + +template T WrightFisher::Getlogakm(int k, int m) { + assert(k >= m); + if (m > static_cast(akm.size()) - 1) + akm.resize(m + 1); + if ((k - m > static_cast(akm[m].size()) - 1)) { + int oldsize = static_cast(akm[m].size()); + akm[m].resize(k - m + 1, 0); + + for (int i = oldsize + m; i <= k; ++i) { + if (i == 0) + akm[m][i - m] = 0.0; + else { + T a = log(theta + 2.0 * i - 1); + for (int j = 2; j <= i; ++j) { + a += log(theta + m + j - 2.0); + if (j <= i - m) + a -= log(static_cast(j)); /// We need (n-m)! in the denominator + if (j <= m) + a -= log(static_cast(j)); /// We need m! in the denominator + } + akm[m][i - m] = a; /// So akm[m] = (a{m,m}, a{m+1,m} a{m+2,m}, ...) + } + } + } + return akm[m][k - m]; +} + +#endif diff --git a/config.cfg b/config.cfg new file mode 100644 index 0000000..867ec7a --- /dev/null +++ b/config.cfg @@ -0,0 +1,42 @@ +#============================================================================# +#*************************************NB*************************************# +# All floating point numbers *must *be specified with a first decimal place, # +# e.g. 1.0 as opposed to 1! Not doing this will cause silent errors! # +#============================================================================# + +#============================================================================# +#--------------PARAMETERS FOR IMPLEMENTING WRIGHT - FISHER CLASS-------------# +#============================================================================# + +#Mutation parameters(theta_1, theta_2).For no mutation at one of the +#boundaries, set respective entry to be 0.0. +theta_entries = (0.0, 0.0); + +#Boolean entry separating neutral from non - neutral simulation.For non-neutral +#draws set this quantity to true. *NB* if this is false, then the following +#selection parameters will be ignored by the program!! +nonneutral_entry = false; + +#Selection coefficient sigma appearing in the selection function +#sigma * x * (1 - x) * eta(x). For eta the identity function, this corresponds +#to genic selection. +sigma_entry = 0.0; + +#Dominance parameter h in the case of diploid selection - the case h = 0.5 +#reduces to genic selection! +dominance_entry = 0.5; + +#Degree of polynomial for selection coefficient.Current implementation should +#be able to deal with any degree polynomials, but has only been tested for +#degree smaller than 25! Use higher degree polynomials at your own discretion! +polyDeg_entry = 6; + +#Entries for polynomial selection coefficient in increasing order of power - so +#the first entry corresponds to the constant coefficient, the second to the +#coefficient of the x term, the third for the x ^ 2 term, etc. +polyCoeffs_entries = (0.5, 0.25, 0.5, 0.25, 0.5, 0.25); + +#Integer valued function to direct the selection setting function to the +#correct setup. Set this to be 0 for genic selection, 1 for diploid selection, +#or 2 for general polynomial selection. Any other input will be rejected. +selSetup_entry = 0; diff --git a/configBridge.cfg b/configBridge.cfg new file mode 100644 index 0000000..5cf5335 --- /dev/null +++ b/configBridge.cfg @@ -0,0 +1,48 @@ +#============================================================================# +#*************************************NB*************************************# +# All floating point numbers *must *be specified with a first decimal place, # +# e.g. 1.0 as opposed to 1! Not doing this will cause silent errors! # +#============================================================================# + +#============================================================================# +#-------------PARAMETERS FOR IMPLEMENTING DIFFUSION BRIDGE DRAWS-------------# +#============================================================================# + +#Boolean variable determining whether the bridge can be absorbed on hitting +#the boundary.Set false for conditioning on non - absorption, otherwise set to +#be true. +Absorption_entry = false; + +#Number of endpoints for each simulation desired, entries need to be integers. +nEndpoints = (3, 4, 2); + +#Start and end points for each diffusion bridge.These should be concatenated +#as(x0_bridge1, x1_bridge1, ..., xn1_bridge1, x0_bridge2, ... xn2_bridge2, ... +#, xnk + bridgek).* NB * number of entries here should equate the sum of all +#integer entries in nEndpoints ! +bridgePoints_entry = (0.0, 0.1, 0.25, 0.1, 0.3, 0.4, 0.5, 1.0, 0.95); + +#Time stamps for corresponding diffusion bridge, so first entry is +#time stamp corresponding to endpoint x0_bridge1, second entry corresponds to +#the time stamp for endpoint x1_bridge1.*NB *Total number of entries should +#be equal to sum of entries of nEndpoints ! +bridgeTimes_entry = (0.0, 0.05, 0.1, 0.2, 0.3, 0.4, 0.5, 0.0, 0.5); + +#Number of sampling times within each subsequent pair of time stamps belonging +#to the same diffusion bridge.*NB *Entries should be integers, and there must +#be a total of(nEndpoints - number of simulations) integers entered !If there +#are intervals over which no points should be sampled, it should still be +#included in the vector with a 0 showing that no points are to be sampled. +nSampleTimes_entry = (1, 2, 1, 1, 1, 3); + +#Timestamp for desired sampling times for each subsequent pair of time stamps +#belonging to the same diffusion bridge.*NB *Entries need to take values +#between the corresponding diffusion bridge time stamps ! +sampleTimes_entry = (0.025, 0.065, 0.085, 0.25, 0.35, 0.45, 0.1, 0.25, 0.3); + +#Number of simulations desired for each diffusion bridge +nSim_entry = (10000, 10000, 10000, 10000, 10000, 10000, 10000, 10000, 10000); + +#Meshsize desired for calculating the truncated transition density, integer +#entries only.Can be omitted if transition density is not required. +meshSize_entry = (1000, 1000, 1000, 1000, 1000, 1000, 1000, 1000, 1000); diff --git a/configDiffusion.cfg b/configDiffusion.cfg new file mode 100644 index 0000000..4275c2f --- /dev/null +++ b/configDiffusion.cfg @@ -0,0 +1,36 @@ +#============================================================================# +#*************************************NB*************************************# +# All floating point numbers *must *be specified with a first decimal place, # +# e.g. 1.0 as opposed to 1! Not doing this will cause silent errors! # +#============================================================================# + +#============================================================================# +#-----------------PARAMETERS FOR IMPLEMENTING DIFFUSION DRAWS----------------# +#============================================================================# + +#Boolean variable determining whether the diffusion is absorbed on hitting +#the boundary or not .Set false for conditioning on non - absorption, otherwise +#set to be true. +Absorption_entry = false; + +#Starting point for the diffusion, must be within[0, 1].If multiple +#simulations desired with different starting points, input these as +#(x_1, x_2, ..., x_n). +startDiff_entry = (0.0, 0.0, 0.0, 0.5, 0.5, 0.5, 1.0, 1.0, 1.0); + +#Start time for the diffusion, must be strictly smaller than the sampling time. +#Again if multiple simulations desired, input as an array but NB size *must * +#match that of inputted start points ! +startDiffTime_entry = (0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0); + +#Sampling time for diffusion, must be strictly greater than the start time. +#Again if multiple simulations desired, input as an array but NB size *must * +#match that of inputted start points ! +sampleDiffTime_entry = (0.01, 0.05, 0.5, 0.01, 0.05, 0.5, 0.01, 0.05, 0.5); + +#Number of simulations desired for each diffusion +nSim_entry = (10000, 10000, 10000, 10000, 10000, 10000, 10000, 10000, 10000); + +#Meshsize desired for calculating the truncated transition density, integer +#entries only.Can be omitted if transition density is not required. +meshSize_entry = (100000, 10000, 1000, 10000, 10000, 1000, 100000, 10000, 1000); diff --git a/configHorseCoat.cfg b/configHorseCoat.cfg new file mode 100644 index 0000000..ff0690a --- /dev/null +++ b/configHorseCoat.cfg @@ -0,0 +1,63 @@ +#============================================================================# +#*************************************NB*************************************# +# All floating point numbers *must *be specified with a first decimal place, # +# e.g. 1.0 as opposed to 1! Not doing this will cause silent errors! # +#============================================================================# + +#============================================================================# +#-----------PARAMETERS FOR HORSE COAT COLORATION ALLELE FREQUNECIES----------# +#============================================================================# + +#Generation gap in years; +g_entry = 5.0; + +#Mutation parameters +mu_entry = (0.0, 0.0); + +#Boolean entry specifying the presence of selection +nonneutral_entry = true; + +#Integer valued function to direct the selection setting function to the +#correct setup, where Genic selection = 0, Diploid selection = 1 and general +#polynomial selection = 2.We assume genic selection so set it to 0 and ignore +#all other selection parameters. +selSetup_entry = 0; + +#Selection coefficient for genic selection - *NB *This should be the +#prelimiting seleciton coefficient, i.e.sigma = 2 * N_e * s_entry !!! +s_entry = 0.0007; + +#Effective population size +Ne_entry = 10000; + +#Dominance parameter h in the case of diploid selection +dominance_entry = 0.5; + +#Degree of polynomial for selection coefficient. +polyDeg_entry = 6; + +#Entries for polynomial selection coefficient in increasing order of power. +polyCoeffs_entries = (0.5, 0.25, 0.5, 0.25, 0.5, 0.25); + +#Boolean variable determining whether the bridge can be absorbed on hitting +#the boundary.Set false for conditioning on non - absorption, otherwise set to +#be true. +Absorption_entry = false; + +#Number of endpoints for each simulation desired, entries need to be integers. +nEndpoints = 6; + +#Number of samples at each observation time +observationSamples_entry = (10, 22, 20, 20, 36, 38); + +#Number of samples having the tracked allele at each observation time +observationCount_entry = (0, 1, 15, 12, 15, 18); + +#Time stamps for observations in years before present +observationTimes_entry = (20000.0, 13100.0, 3700.0, 2800.0, 1100.0, 500.0); + +#Number of simulations desired +nSim_entry = 30; + +#Number of intermediate times to sample from the whole bridge length +nInterTimes = 1000; diff --git a/main.cpp b/main.cpp new file mode 100644 index 0000000..69bf551 --- /dev/null +++ b/main.cpp @@ -0,0 +1,1011 @@ +#include "WrightFisher.h" +#include +#include +#include +#include // for beta function +#include // for function binomial_coefficient +#include // for erf function +#include +#include +#include +#include +#include +#include +#include +#include + +using namespace std; + +int main(int argc, char **argv) { + if ((argc == 2) && (static_cast(argv[1]) == "horses")) { + cout << "================================" << endl; + cout << "Demo invoked - allele frequency paths for horse coat coloration " + "(ASIP locus) will be generated, using data from Ludwig et al. 2009" + << endl; + cout << "================================" << endl; + + vector thetaP_in; + bool non_neut_in, Absorption; + double100 sigma_in, genGap; + int SelPolyDeg_in, SelSetup_in, Ne_in, nEndpoints, nSim, nInterTimes; + double dom_in; + vector selCoefs_in; + + libconfig::Config cfg; + try { + cfg.readFile("configHorseCoat.cfg"); + } catch (libconfig::FileIOException &e) { + cerr << "FileIOException occurred. Could not read configHorseCoat.cfg!" + << endl; + return (EXIT_FAILURE); + } catch (libconfig::ParseException &e) { + cerr << "Parse error at " << e.getFile() << ":" << e.getLine() << "-" + << e.getError() << endl; + return (EXIT_FAILURE); + } + + if ((cfg.lookupValue("g_entry", genGap)) && (genGap > 0.0)) { + cout << "Generation age set to " << genGap << " years." << endl; + } else { + cerr + << "Error in reading generation age - please check input is correct!"; + return (EXIT_FAILURE); + } + + if (cfg.lookupValue("nonneutral_entry", non_neut_in)) { + if (non_neut_in) { + cout << "You have requested non-neutral paths." << endl; + if (cfg.lookupValue("s_entry", sigma_in)) { + cout << "Prelimiting selection coefficient set to " << sigma_in << "." + << endl; + } else { + cerr << "Error in reading prelimiting selection coefficient - please " + "check input is correct!"; + return (EXIT_FAILURE); + } + + if (cfg.lookupValue("selSetup_entry", SelSetup_in) && + (SelSetup_in == 0 || SelSetup_in == 1 || SelSetup_in == 2)) { + if (SelSetup_in == 0) { + cout << "You have chosen to have genic selection." << endl; + } else if (SelSetup_in == 1) { + cout << "you have chosen to have diploid selection. " << endl; + } else { + cout << "You have chosen to have polynomial selection." << endl; + } + } else { + cerr << "Error in reading selection setup indicator function - " + "please check input is correct!"; + return (EXIT_FAILURE); + } + + if (SelSetup_in == 1) { + if ((cfg.lookupValue("dominance_entry", dom_in)) && (dom_in >= 0.0) && + (dom_in <= 1.0)) { + cout << "You have set the dominance parameter to be " << dom_in + << "." << endl; + } else { + cerr << "Error in reading dominance parameter - please check input " + "is correct!"; + return (EXIT_FAILURE); + } + } + + if (SelSetup_in == 2) { + if (cfg.lookupValue("polyDeg_entry", SelPolyDeg_in) && + (SelPolyDeg_in > 0)) { + cout << "You have chosen a degree " << SelPolyDeg_in + << " polynomial as selection function." << endl; + } else { + cerr << "Error in reading degree of selection polynomial - please " + "check input is correct!"; + return (EXIT_FAILURE); + } + } + } else { + cout << "You have requested neutral paths." << endl; + } + } else { + cerr << "Error in reading non-neutral indicator function - please check " + "input is correct!"; + return (EXIT_FAILURE); + } + + if (cfg.lookupValue("Ne_entry", Ne_in) && (Ne_in > 0)) { + cout << "You have chosen an effective population size of " << Ne_in + << endl; + } else { + cerr << "Error in reading effective population size - please check input " + "is correct!"; + return (EXIT_FAILURE); + } + + if (cfg.lookupValue("Absorption_entry", Absorption)) { + if (Absorption) { + cout << "You have chosen to not condition on non-absorption." << endl; + } else { + cout << "You have chosen to condition on non-absorption." << endl; + } + } else { + cerr << "Error in reading absorption indicator function - please check " + "input is correct!"; + return (EXIT_FAILURE); + } + + if (cfg.lookupValue("nEndpoints", nEndpoints) && (nEndpoints > 0)) { + cout << "You have chosen to have " << nEndpoints << " endpoints." << endl; + } else { + cerr << "Error in number of endpoints - please check input is correct!"; + return (EXIT_FAILURE); + } + + if (cfg.lookupValue("nSim_entry", nSim) && (nSim > 0)) { + cout << "You have chosen to run " << nSim << " simulations." << endl; + } else { + cerr << "Error in reading number of simulations - please check input is " + "correct!"; + return (EXIT_FAILURE); + } + + if (cfg.lookupValue("nInterTimes", nInterTimes) && (nInterTimes > 0)) { + cout << "You have chosen to simulate " << nInterTimes + << " intermediate time points." << endl; + } else { + cerr << "Error in reading number of intermediate times to sample - " + "please check input is correct!"; + return (EXIT_FAILURE); + } + + const libconfig::Setting &root = cfg.getRoot(); + if (root["mu_entry"].getLength() > 2) { + cerr << "Mutation vector should contain only two entries!"; + } + for (int i = 0; i < root["mu_entry"].getLength(); i++) { + thetaP_in.push_back(2.0 * static_cast(Ne_in) * + ((double)root["mu_entry"][i])); + if (i == 0 && (thetaP_in.back() > 0.0)) { + cout << "theta_1 = " << thetaP_in.back() << "." << endl; + } else if (thetaP_in.back() > 0.0) { + cout << "theta_2 = " << thetaP_in.back() << "." << endl; + } + } + if (!(thetaP_in[0] > 0.0) && !(thetaP_in[1] > 0.0)) { + thetaP_in.clear(); + cout << "(theta_1,theta_2) = (0,0)." << endl; + } + + if (SelSetup_in == 2) { + if (root["polyCoeffs_entries"].getLength() != SelPolyDeg_in) { + cerr << "Mismatch in given selection coefficient vector and specified " + "degree of polynomial!"; + return (EXIT_FAILURE); + } + cout << "The inputted selection polynomial has: " << endl; + for (int i = 0; i < root["polyCoeffs_entries"].getLength(); i++) { + selCoefs_in.push_back((double)root["polyCoeffs_entries"][i]); + cout << " a coefficient " << selCoefs_in.back() << " for the " + << root["polyCoeffs_entries"].getLength() - 1 - i + << "-th power of x." << endl; + } + } + + if (non_neut_in) { + sigma_in = 2.0 * static_cast(Ne_in) * sigma_in; + cout << "With the above input, the population rescaled selection " + "coefficient sigma is " + << sigma_in << endl; + } + cout << "================================" << endl; + + WrightFisher Horses(thetaP_in, non_neut_in, sigma_in, SelSetup_in, dom_in, + SelPolyDeg_in, selCoefs_in); + + Options o; + boost::random::mt19937 gen; + + if (!(Absorption)) { + Horses.ThetaResetter(); + } + + if ((root["observationTimes_entry"].getLength() != + root["observationSamples_entry"].getLength()) || + (root["observationTimes_entry"].getLength() != + root["observationCount_entry"].getLength()) || + (root["observationSamples_entry"].getLength() != + root["observationCount_entry"].getLength())) { + cerr << "Mismatch in the inputted observation times, samples and counts!" + << endl; + return (EXIT_FAILURE); + } + + vector obsTimes; + vector obsSamples, obsCount; + + for (int i = 0; i < nEndpoints; i++) { + obsTimes.push_back(root["observationTimes_entry"][i]); + obsSamples.push_back(root["observationSamples_entry"][i]); + obsCount.push_back(root["observationCount_entry"][i]); + } + + vector obsTimesDiff, obsFrequencies; + vector::iterator oSi = obsSamples.begin(), oCi = obsCount.begin(); + for (vector::iterator yearIter = obsTimes.begin(); + yearIter != obsTimes.end(); yearIter++, oSi++, oCi++) { + obsTimesDiff.push_back( + static_cast(abs(*yearIter - obsTimes.front())) / + (2.0 * static_cast(Ne_in) * genGap)); + obsFrequencies.push_back(static_cast(*oCi) / + static_cast(*oSi)); + } + + ofstream originalTrajectoryFile, originalTimesFile; + string originalTrajectoryFilename = "OGHT.txt", + originalTimesFilename = "OGT.txt"; + originalTrajectoryFile.open(originalTrajectoryFilename); + originalTimesFile.open(originalTimesFilename); + + for (vector::iterator tit = obsTimesDiff.begin(), + xit = obsFrequencies.begin(); + tit != obsTimesDiff.end(); tit++, xit++) { + originalTrajectoryFile << *xit << " "; + originalTimesFile << *tit << " "; + if (xit == obsFrequencies.end() - 1) { + originalTrajectoryFile << "\n"; + originalTimesFile << "\n"; + } + } + + originalTrajectoryFile.close(); + originalTimesFile.close(); + + vector skeletonPoints, skeletonTimes, samplingTimes, + samplingValues; + + for (int j = 0; j != nInterTimes; j++) { + samplingTimes.push_back( + obsTimesDiff.back() * + (static_cast(j) / static_cast(nInterTimes))); + } + + ofstream imputedTrajectoryFile, imputedTimesFile; + string imputedTrajectoryFilename = "ImpHT.txt", + imputedTimesFilename = "ImpT.txt"; + imputedTrajectoryFile.open(imputedTrajectoryFilename); + imputedTimesFile.open(imputedTimesFilename); + + for (int i = 0; i != nSim; i++) { + vector::iterator leftTime = samplingTimes.begin(), rightTime; + for (vector::iterator tIt = obsTimesDiff.begin(), + xIt = obsFrequencies.begin(); + tIt != (obsTimesDiff.end() - 1); tIt++, xIt++) { + vector> Skeleton = Horses.NonNeutralDrawBridge( + *xIt, *tIt, *(tIt + 1), *(xIt + 1), Absorption, o, gen); + vector skeletonPoints(Skeleton[0]), + skeletonTimes(Skeleton[1]); + skeletonPoints.push_back(*(xIt + 1)); + skeletonTimes.push_back(*(tIt + 1)); + + vector::iterator timeRunner = leftTime; + if (tIt != obsTimesDiff.end() - 2) { + while (*timeRunner < *(tIt + 1)) { + timeRunner++; + } + + rightTime = timeRunner - 1; + } else { + rightTime = samplingTimes.end() - 1; + } + + vector::iterator skeltimeIt = skeletonTimes.begin(), + skelvalIt = skeletonPoints.begin(); + for (vector::iterator timeIt = leftTime; + timeIt != rightTime - 1; timeIt++) { + if (timeIt == leftTime) { + samplingValues.push_back(*xIt); + imputedTrajectoryFile << samplingValues.back() << " "; + imputedTimesFile << *tIt << " "; + } else { + if (*(timeIt + 1) > *(skeltimeIt)) { + skeltimeIt++; + skelvalIt++; + } + samplingValues.push_back( + Horses + .DrawBridgepoint(samplingValues.back(), *skelvalIt, *timeIt, + *skeltimeIt, *(timeIt + 1), o, gen) + .first); + imputedTrajectoryFile << samplingValues.back() << " "; + imputedTimesFile << *timeIt << " "; + } + } + + leftTime = rightTime; + } + + imputedTrajectoryFile << obsFrequencies.back() << "\n"; + imputedTimesFile << samplingTimes.back() << "\n"; + + cout << "path " << i << " ready!" << endl; + } + + imputedTrajectoryFile.close(); + imputedTimesFile.close(); + cout << "================================" << endl; + cout << "Simulations complete - the generated paths can be found in " + "'ImpHT.txt', whilst 'ImpT.txt' contains the corresponding time " + "stamps." + << endl; + cout << "The files 'OGT.txt' and 'OGHT.txt' contain the observation times " + "and observed frequencies respectively." + << endl; + cout << "================================" << endl; + + } else { + vector thetaP_in; + bool non_neut_in; + double100 sigma_in; + int SelPolyDeg_in, SelSetup_in; + double dom_in; + vector selCoefs_in; + + libconfig::Config cfg; + try { + cfg.readFile("config.cfg"); + } catch (libconfig::FileIOException &e) { + cerr << "FileIOException occurred. Could not read config.cfg!" << endl; + return (EXIT_FAILURE); + } catch (libconfig::ParseException &e) { + cerr << "Parse error at " << e.getFile() << ":" << e.getLine() << "-" + << e.getError() << endl; + return (EXIT_FAILURE); + } + + if (cfg.lookupValue("nonneutral_entry", non_neut_in)) { + if (non_neut_in) { + cout << "You have requested non-neutral paths." << endl; + if ((cfg.lookupValue("sigma_entry", sigma_in))) { + cout << "You have set the population rescaled selection parameter to " + "be " + << sigma_in << "." << endl; + } else { + cerr << "Error in reading population rescaled selection parameter - " + "please check input is correct!"; + return (EXIT_FAILURE); + } + + if (cfg.lookupValue("selSetup_entry", SelSetup_in) && + (SelSetup_in == 0 || SelSetup_in == 1 || SelSetup_in == 2)) { + if (SelSetup_in == 0) { + cout << "You have chosen to have genic selection." << endl; + } else if (SelSetup_in == 1) { + cout << "you have chosen to have diploid selection. " << endl; + } else { + cout << "You have chosen to have polynomial selection." << endl; + } + } else { + cerr << "Error in reading selection setup indicator function - " + "please check input is correct!"; + return (EXIT_FAILURE); + } + + if (SelSetup_in == 1) { + if ((cfg.lookupValue("dominance_entry", dom_in)) && (dom_in >= 0.0) && + (dom_in <= 1.0)) { + cout << "You have set the dominance parameter to be " << dom_in + << "." << endl; + } else { + cerr << "Error in reading dominance parameter - please check input " + "is correct!"; + return (EXIT_FAILURE); + } + } + + if (SelSetup_in == 2) { + if (cfg.lookupValue("polyDeg_entry", SelPolyDeg_in) && + (SelPolyDeg_in > 0)) { + cout << "You have chosen a degree " << SelPolyDeg_in + << " polynomial as selection function." << endl; + } else { + cerr << "Error in reading degree of selection polynomial - please " + "check input is correct!"; + return (EXIT_FAILURE); + } + } + } else { + cout << "You have requested neutral paths." << endl; + } + } else { + cerr << "Error in reading non-neutral indicator function - please check " + "input is correct!"; + return (EXIT_FAILURE); + } + + const libconfig::Setting &root = cfg.getRoot(); + if (root["theta_entries"].getLength() > 2) { + cerr << "Mutation vector should contain only two entries!"; + } + for (int i = 0; i < root["theta_entries"].getLength(); i++) { + thetaP_in.push_back((double)root["theta_entries"][i]); + if (i == 0 && (thetaP_in.back() > 0.0)) { + cout << "theta_1 = " << thetaP_in.back() << "." << endl; + } else if (thetaP_in.back() > 0.0) { + cout << "theta_2 = " << thetaP_in.back() << "." << endl; + } + } + if (!(thetaP_in[0] > 0.0) && !(thetaP_in[1] > 0.0)) { + thetaP_in.clear(); + cout << "(theta_1,theta_2) = (0,0)." << endl; + } + + if (SelSetup_in == 2) { + if (root["polyCoeffs_entries"].getLength() != SelPolyDeg_in) { + cerr << "Mismatch in given selection coefficient vector and specified " + "degree of polynomial!"; + return (EXIT_FAILURE); + } + cout << "The inputted selection polynomial has: " << endl; + for (int i = 0; i < root["polyCoeffs_entries"].getLength(); i++) { + selCoefs_in.push_back((double)root["polyCoeffs_entries"][i]); + cout << " a coefficient " << selCoefs_in.back() << " for the " + << root["polyCoeffs_entries"].getLength() - 1 - i + << "-th power of x." << endl; + } + } + + WrightFisher test(thetaP_in, non_neut_in, sigma_in, SelSetup_in, dom_in, + SelPolyDeg_in, selCoefs_in); + + Options o; + boost::random::mt19937 gen; + + cout << "================================" << endl; + cout << "Please choose whether you wish to simulate draws from the " + "Wright-Fisher diffusion, or from the diffusion bridge." + << endl; + cout << "Enter: 1 for diffusion, 2 for diffusion bridge" << endl; + cout << "================================" << endl; + int DiffOrBridge; + cin >> DiffOrBridge; + bool stop = + (cin.fail() + ? false + : ((DiffOrBridge != 1 && DiffOrBridge != 2) ? false : true)); + + while (!stop) { + cout << "Please enter either 1 for diffusion simulation or 2 for " + "diffusion bridge simulation!" + << endl; + cin.clear(); + cin.ignore(256, '\n'); + cin >> DiffOrBridge; + stop = (cin.fail() + ? false + : ((DiffOrBridge != 1 && DiffOrBridge != 2) ? false : true)); + } + + if (DiffOrBridge == 1) { + cout << "================================" << endl; + cout << "You have chosen to simulate a diffusion!" << endl; + cout << "================================" << endl; + cout << "Would you like to additionally compute the truncated transition " + "density?" + << endl; + cout << "Please enter 1 for yes, 2 for no." << endl; + cout << "================================" << endl; + + int Density; + cin >> Density; + bool stopyn = + (cin.fail() ? false + : ((Density != 1 && Density != 2) ? false : true)); + + while (!stopyn) { + cout << "Please enter either 1 for yes or 2 for no!" << endl; + cin.clear(); + cin.ignore(256, '\n'); + cin >> Density; + stopyn = (cin.fail() ? false + : ((Density != 1 && Density != 2) ? false : true)); + } + + vector startPoints, startTimes, sampleTimes; + vector nSim, meshSize; + + libconfig::Config cfgDiff; + try { + cfgDiff.readFile("configDiffusion.cfg"); + } catch (libconfig::FileIOException &e) { + cerr << "FileIOException occurred. Could not read configDiffusion.cfg!" + << endl; + return (EXIT_FAILURE); + } catch (libconfig::ParseException &e) { + cerr << "Parse error at " << e.getFile() << ":" << e.getLine() << "-" + << e.getError() << endl; + return (EXIT_FAILURE); + } + + bool Absorption; + if (cfgDiff.lookupValue("Absorption_entry", Absorption)) { + if (Absorption) { + cout << "You have chosen to not condition on non-absorption." << endl; + } else { + cout << "You have chosen to condition on non-absorption." << endl; + } + } else { + cerr << "Error in reading absorption indicator function - please check " + "input is correct!"; + return (EXIT_FAILURE); + } + + const libconfig::Setting &root = cfgDiff.getRoot(); + int xlen = root["startDiff_entry"].getLength(), + tlen = root["startDiffTime_entry"].getLength(), + slen = root["sampleDiffTime_entry"].getLength(); + int nlen = root["nSim_entry"].getLength(), + mlen = root["meshSize_entry"].getLength(); + + if ((xlen == tlen) && (tlen == slen) && (slen == nlen)) { + if (Density == 1) { + if (mlen != xlen) { + cout << "Mismatch in the configuration file input!" << endl; + if (mlen < xlen) { + cout << "There are too few mesh size entries!" << endl; + } else { + cout << "There are too many mesh size entries!" << endl; + } + cerr << "Simulation aborted - please fix configDiffusion.cfg as " + "per the above suggestions." + << endl; + return (EXIT_FAILURE); + } + } + cout << "Reading in diffusion simulation configuration from " + "configDiffusion.cfg" + << endl; + cout << "================================" << endl; + } else { + cout << "There is a mismatch in the configuration file input!" << endl; + if (xlen < tlen) { + cout << "There are more diffusion start points than start times!" + << endl; + } + if (xlen > tlen) { + cout << "There are more diffusion start times than start points!" + << endl; + } + if (slen < tlen) { + cout << "There are more diffusion start times than sample times!" + << endl; + } + if (slen > tlen) { + cout << "There are more diffusion sample times than start times!" + << endl; + } + if (xlen < slen) { + cout << "There are more diffusion start points than sample times!" + << endl; + } + if (xlen > slen) { + cout << "There are more diffusion sample times than start points!" + << endl; + } + if (xlen < nlen) { + cout + << "There are more number of samples than diffusion start points!" + << endl; + } + if (xlen > nlen) { + cout + << "There are more diffusion start points than number of samples!" + << endl; + } + if (slen < nlen) { + cout + << "There are more number of samples than diffusion sample times!" + << endl; + } + if (slen > nlen) { + cout + << "There are more diffusion sample times than number of samples!" + << endl; + } + if (tlen < nlen) { + cout << "There are more number of samples than diffusion start times!" + << endl; + } + if (tlen > nlen) { + cout << "There are more diffusion start times than number of samples!" + << endl; + } + cout << "Simulation aborted - please fix configDiffusion.cfg as per " + "the above suggestions." + << endl; + return (EXIT_FAILURE); + } + + cout << "================================" << endl; + cout << "Diffusion input read in without errors." << endl; + cout << "================================" << endl; + + for (int i = 0; i < root["startDiff_entry"].getLength(); i++) { + startPoints.push_back(root["startDiff_entry"][i]); + startTimes.push_back(root["startDiffTime_entry"][i]); + sampleTimes.push_back(root["sampleDiffTime_entry"][i]); + nSim.push_back(root["nSim_entry"][i]); + if (Density == 1) { + meshSize.push_back(root["meshSize_entry"][i]); + } + } + + cout << "You have chosen to perform the following simulations:" << endl; + int i = 1; + vector::iterator nit = nSim.begin(); + for (vector::iterator xit = startPoints.begin(), + tit = startTimes.begin(), + sit = sampleTimes.begin(); + xit != startPoints.end(); xit++, tit++, sit++, nit++) { + cout << "Diffusion " << i << " : x = " << *xit << ", t_0 = " << *tit + << ", t = " << *sit << ", nSim = " << *nit << endl; + i++; + } + + cout << "================================" << endl; + nit = nSim.begin(); + vector::iterator mit = meshSize.begin(); + for (vector::iterator xit = startPoints.begin(), + tit = startTimes.begin(), + sit = sampleTimes.begin(); + xit != startPoints.end(); xit++, tit++, sit++, nit++, mit++) { + cout << " Simulating diffusion draws started at x " << *xit + << " at time " << *tit << ", sampled at time " << *sit << endl; + time_t t = time(0); // get time now + struct tm *now = localtime(&t); + + char bufferSaveFile[80]; + strftime(bufferSaveFile, 80, "%Y-%m-%d-%H-%M", now); + string absnoabs; + if (Absorption) { + absnoabs = "Unconditioned"; + } else { + absnoabs = "Conditioned"; + } + string saveFilename = + static_cast(bufferSaveFile) + absnoabs + "Diffusion" + + "SamplesX" + + boost::lexical_cast(static_cast(100.0 * (*xit))) + + "T" + + boost::lexical_cast(static_cast(100.0 * (*tit))) + + "S" + + boost::lexical_cast(static_cast(100.0 * (*sit))) + + ".txt"; + cout << "Output will be saved in the file " << saveFilename << endl; + + test.DiffusionRunner(*nit, *xit, *tit, *sit, Absorption, saveFilename, + o, gen); + + if (Density == 1) { + string densityFilename = static_cast(bufferSaveFile) + + absnoabs + "Diffusion" + "DensityX" + + boost::lexical_cast( + static_cast(100.0 * (*xit))) + + "T" + + boost::lexical_cast( + static_cast(100.0 * (*tit))) + + "S" + + boost::lexical_cast( + static_cast(100.0 * (*sit))) + + ".txt"; + cout << "Truncated density will be saved in the file " + << densityFilename << endl; + test.DiffusionDensityCalculator(*mit, *xit, *tit, *sit, Absorption, + densityFilename, o); + } + cout << "================================" << endl; + } + + } else { + cout << "================================" << endl; + cout << "You have chosen to simulate a diffusion bridge!" << endl; + cout << "Would you like to additionally compute the truncated transition " + "density?" + << endl; + cout << "Please enter 1 for yes, 2 for no." << endl; + cout << "================================" << endl; + + int Density; + cin >> Density; + bool stopyn = + (cin.fail() ? false + : ((Density != 1 && Density != 2) ? false : true)); + + while (!stopyn) { + cout << "Please enter either 1 for yes or 2 for no!" << endl; + cin.clear(); + cin.ignore(256, '\n'); + cin >> Density; + stopyn = (cin.fail() ? false + : ((Density != 1 && Density != 2) ? false : true)); + } + + libconfig::Config cfgBridge; + try { + cfgBridge.readFile("configBridge.cfg"); + } catch (libconfig::FileIOException &e) { + cerr << "FileIOException occurred. Could not read configBridge.cfg!" + << endl; + return (EXIT_FAILURE); + } catch (libconfig::ParseException &e) { + cerr << "Parse error at " << e.getFile() << ":" << e.getLine() << "-" + << e.getError() << endl; + return (EXIT_FAILURE); + } + + bool Absorption; + if (cfgBridge.lookupValue("Absorption_entry", Absorption)) { + if (Absorption) { + cout << "You have chosen to not condition on non-absorption." << endl; + } else { + cout << "You have chosen to condition on non-absorption." << endl; + } + } else { + cerr << "Error in reading absorption indicator function - please check " + "input is correct!"; + return (EXIT_FAILURE); + } + + const libconfig::Setting &root = cfgBridge.getRoot(); + int nBridges = root["nEndpoints"].getLength(), + xlen = root["bridgePoints_entry"].getLength(), + tlen = root["bridgeTimes_entry"].getLength(); + int nSamples = root["nSampleTimes_entry"].getLength(), + slen = root["sampleTimes_entry"].getLength(), + nlen = root["nSim_entry"].getLength(), + mlen = root["meshSize_entry"].getLength(); + int nBridgeChecker = -1; + + if ((xlen == tlen) && (tlen == slen) && (slen == nlen)) { + if (Density == 1) { + if (mlen != xlen) { + cout << "Mismatch in the configuration file input!" << endl; + if (mlen < xlen) { + cout << "There are too few mesh size entries!" << endl; + } else { + cout << "There are too many mesh size entries!" << endl; + } + cerr << "Simulation aborted - please fix configBridge.cfg as per " + "the above suggestions." + << endl; + return (EXIT_FAILURE); + } + } + cout << "Reading in bridge simulation configuration from " + "configBridge.cfg" + << endl; + cout << "================================" << endl; + } else { + cout << "There is a mismatch in the configuration file input!" << endl; + + if (xlen < tlen) { + cout << "There are more diffusion start points than start times!" + << endl; + } + if (xlen > tlen) { + cout << "There are more diffusion start times than start points!" + << endl; + } + if (slen < tlen) { + cout << "There are more diffusion start times than sample times!" + << endl; + } + if (slen > tlen) { + cout << "There are more diffusion sample times than start times!" + << endl; + } + if (xlen < slen) { + cout << "There are more diffusion start points than sample times!" + << endl; + } + if (xlen > slen) { + cout << "There are more diffusion sample times than start points!" + << endl; + } + if (xlen < nlen) { + cout + << "There are more number of samples than diffusion start points!" + << endl; + } + if (xlen > nlen) { + cout + << "There are more diffusion start points than number of samples!" + << endl; + } + if (slen < nlen) { + cout + << "There are more number of samples than diffusion sample times!" + << endl; + } + if (slen > nlen) { + cout + << "There are more diffusion sample times than number of samples!" + << endl; + } + if (tlen < nlen) { + cout << "There are more number of samples than diffusion start times!" + << endl; + } + if (tlen > nlen) { + cout << "There are more diffusion start times than number of samples!" + << endl; + } + cout << "Simulation aborted - please fix configDiffusion.cfg as per " + "the above suggestions." + << endl; + return (EXIT_FAILURE); + } + + if ((nBridges < 1) || (nSamples < 1)) { + cerr << "No bridge or sampling information provided! Please amend " + "configBridge.cfg appropriately!"; + return (EXIT_FAILURE); + } else { + nBridgeChecker = 0; + for (int i = 0; i < nBridges; i++) { + nBridgeChecker += (int)root["nEndpoints"][i]; + } + + if (nBridgeChecker != nBridges + nSamples) { + cerr << "Mismatch in nEndpoints and nSampleTimes_entry input in " + "configBridge.cfg! Please consult config file for info on " + "how to set these two quantities up!"; + return (EXIT_FAILURE); + } + } + + cout << "================================" << endl; + cout << "Bridge input read in without errors." << endl; + cout << "================================" << endl; + + vector bridgePoints, bridgeTimes, sampleTimes; + vector nSim, meshSize, nEndpoints, nSampleTimes; + + for (int i = 0; i < nBridges; i++) { + nEndpoints.push_back(root["nEndpoints"][i]); + } + + for (int i = 0; i < nSamples; i++) { + nSampleTimes.push_back(root["nSampleTimes_entry"][i]); + } + + for (int i = 0; i < xlen; i++) { + bridgePoints.push_back(root["bridgePoints_entry"][i]); + bridgeTimes.push_back(root["bridgeTimes_entry"][i]); + } + for (int i = 0; i < slen; i++) { + sampleTimes.push_back(root["sampleTimes_entry"][i]); + nSim.push_back(root["nSim_entry"][i]); + meshSize.push_back(root["meshSize_entry"][i]); + } + + cout << "You have chosen to perform the following simulations:" << endl; + vector::iterator indexbP = bridgePoints.begin(); + vector::iterator indexbT = bridgeTimes.begin(); + vector::iterator indexnS = nSampleTimes.begin(); + vector::iterator indexsT = sampleTimes.begin(); + int counter = 1; + for (vector::iterator nEp = nEndpoints.begin(); + nEp != nEndpoints.end(); nEp++) { + cout << "Bridge " << counter << " : " << endl; + vector brPt(indexbP, indexbP + (*nEp)), + brTs(indexbT, indexbT + (*nEp)); + vector nsT(indexnS, indexnS + (*nEp) - 1); + indexbP += *nEp; + indexbT += *nEp; + indexnS += (*nEp) - 1; + vector::iterator nsti = nsT.begin(); + for (vector::iterator bP = brPt.begin(), bT = brTs.begin(); + bP != brPt.end() - 1; bP++, bT++) { + vector nsTs(indexsT, indexsT + *nsti); + indexsT += *nsti; + for (vector::iterator sT = nsTs.begin(); sT != nsTs.end(); + sT++) { + cout << "x = " << *bP << ", z = " << *(bP + 1) << ", t1 = " << *bT + << ", t2 = " << *(bT + 1) << ", s = " << *sT << endl; + } + nsti++; + } + counter++; + } + + indexbP = bridgePoints.begin(); + indexbT = bridgeTimes.begin(); + indexnS = nSampleTimes.begin(); + indexsT = sampleTimes.begin(); + vector::iterator nS = nSim.begin(), nM = meshSize.begin(); + for (vector::iterator nEp = nEndpoints.begin(); + nEp != nEndpoints.end(); nEp++) { + vector brPt(indexbP, indexbP + (*nEp)), + brTs(indexbT, indexbT + (*nEp)); + vector nsT(indexnS, indexnS + (*nEp) - 1); + indexbP += *nEp; + indexbT += *nEp; + indexnS += (*nEp) - 1; + vector::iterator nsti = nsT.begin(); + for (vector::iterator bP = brPt.begin(), bT = brTs.begin(); + bP != brPt.end() - 1; bP++, bT++) { + vector nsTs(indexsT, indexsT + *nsti); + indexsT += *nsti; + for (vector::iterator sT = nsTs.begin(); sT != nsTs.end(); + sT++) { + cout << "================================" << endl; + cout << "Simulating diffusion bridges draws for x = " << *bP + << ", z = " << *(bP + 1) << ", t1 = " << *bT + << ", t2 = " << *(bT + 1) << ", s = " << *sT << endl; + time_t t = time(0); // get time now + struct tm *now = localtime(&t); + + char bufferSaveFile[80]; + strftime(bufferSaveFile, 80, "%Y-%m-%d-%H-%M", now); + string absnoabs; + if (Absorption) { + absnoabs = "Unconditioned"; + } else { + absnoabs = "Conditioned"; + } + string saveFilename = static_cast(bufferSaveFile) + + absnoabs + "Bridge" + "SamplesX" + + boost::lexical_cast( + static_cast(100.0 * (*bP))) + + "Z" + + boost::lexical_cast( + static_cast(100.0 * (*(bP + 1)))) + + "T1" + + boost::lexical_cast( + static_cast(100.0 * (*bT))) + + "T2" + + boost::lexical_cast( + static_cast(100.0 * (*(bT + 1)))) + + "S" + + boost::lexical_cast( + static_cast(100.0 * (*sT))) + + ".txt"; + cout << "Output will be saved in the file " << saveFilename << endl; + + test.BridgeDiffusionRunner(*nS, *bP, *(bP + 1), *bT, *(bT + 1), *sT, + Absorption, saveFilename, o, gen); + nS++; + + if (Density == 1) { + string densityFilename = + static_cast(bufferSaveFile) + absnoabs + "Bridge" + + "DensityX" + + boost::lexical_cast( + static_cast(100.0 * (*bP))) + + "Z" + + boost::lexical_cast( + static_cast(100.0 * (*(bP + 1)))) + + "T1" + + boost::lexical_cast( + static_cast(100.0 * (*bT))) + + "T2" + + boost::lexical_cast( + static_cast(100.0 * (*(bT + 1)))) + + "S" + + boost::lexical_cast( + static_cast(100.0 * (*sT))) + + ".txt"; + cout << "Truncated density will be saved in the file " + << densityFilename << endl; + test.BridgeDiffusionDensityCalculator(*nM, *bP, *(bP + 1), *bT, + *(bT + 1), *sT, Absorption, + densityFilename, o); + } + cout << "================================" << endl; + } + nsti++; + } + } + } + } + + return 0; +} diff --git a/myHelpers.cpp b/myHelpers.cpp new file mode 100644 index 0000000..509b725 --- /dev/null +++ b/myHelpers.cpp @@ -0,0 +1,12 @@ +#include "myHelpers.h" +#include +#include +#include +#include + +ostream &operator<<(ostream &s, const Options &o) { + s << "g1984\t" << o.g1984threshold << endl; + s << "eps\t" << o.eps << endl; + s << "Debug\t" << o.debug << "\n" << endl; + return s; +} diff --git a/myHelpers.h b/myHelpers.h new file mode 100644 index 0000000..777cf98 --- /dev/null +++ b/myHelpers.h @@ -0,0 +1,94 @@ +#ifndef EA_myHelpers_h +#define EA_myHelpers_h + +#include +#include +#include +#include +#include +#include + +using namespace std; +const double pi = boost::math::constants::pi(); + +/// typedef boost::multiprecision::cpp_dec_float_100 double100; /// Can switch +/// to this for increased precision, but makes computations much slower!! +typedef double double100; + +template +bool EqualFirstCoord(const pair &P1, const pair &P2) { + return P1.first == P2.first; +} + +struct Options { + Options() + : w(20), g1984threshold(0.08), bridgethreshold(0.008), eps(0.99), + debug(0){}; + int w; /// w is the field width for outputting + double100 g1984threshold, bridgethreshold, eps; + vector thetaP; + int debug; +}; + +template void printVec(const vector &vec, ostream &o = cout) { + for (unsigned int i = 0; i < vec.size(); i++) { + o << vec[i] << " "; + } + cout << endl; +} +template +void getSortPermutation(std::vector &out, const std::vector &v, + Compare compare = std::less()) { + out.resize(v.size()); + std::iota(out.begin(), out.end(), 0); + + std::sort(out.begin(), out.end(), + [&](unsigned i, unsigned j) { return compare(v[i], v[j]); }); +} + +template +void applyPermutation(const std::vector &order, std::vector &t) { + assert(order.size() == t.size()); + std::vector st(t.size()); + for (unsigned i = 0; i < t.size(); i++) { + st[i] = t[order[i]]; + } + t = st; +} + +template +void applyPermutation(const std::vector &order, std::vector &t, + std::vector &... s) { + applyPermutation(order, t); + applyPermutation(order, s...); +} + +template +void sortVectors(const std::vector &t, Compare comp, + std::vector &... ss) { + std::vector order; + getSortPermutation(order, t, comp); + applyPermutation(order, ss...); +} + +template +void sortVectorsAscending(const std::vector &t, std::vector &... ss) { + sortVectors(t, std::less(), ss...); +} + +template int sgn(T val) { return (T(0) < val) - (val < T(0)); } + +template class Vector2D : public std::vector { +protected: + unsigned _width; + +public: + unsigned width() { return _width; } + void setWidth(unsigned i) { width = i; } + + T &operator()(int x, int y) { return this->operator[](x + _width * y); } + + Vector2D(unsigned newWidth) : std::vector(), _width(newWidth) {} +}; + +#endif diff --git a/run.sh b/run.sh new file mode 100644 index 0000000..e0a4159 --- /dev/null +++ b/run.sh @@ -0,0 +1,7 @@ +#!/ bin / bash + +echo "Compilation started!" +make +echo "Code compiled! Execution started!" +./main horses +echo "Execution completed!"