diff --git a/.travis.yml b/.travis.yml --- a/.travis.yml +++ b/.travis.yml @@ -1,47 +1,71 @@ -# NB: don't set `language: haskell` here +language: c +sudo: false -# The following enables several GHC versions to be tested; often it's enough to test only against the last release in a major GHC version. Feel free to omit lines listings versions you don't need/want testing for. -env: -# - CABALVER=1.16 GHCVER=6.12.3 -# - CABALVER=1.16 GHCVER=7.0.1 -# - CABALVER=1.16 GHCVER=7.0.2 -# - CABALVER=1.16 GHCVER=7.0.3 -# - CABALVER=1.16 GHCVER=7.0.4 -# - CABALVER=1.16 GHCVER=7.2.1 -# - CABALVER=1.16 GHCVER=7.2.2 -# - CABALVER=1.16 GHCVER=7.4.1 -# - CABALVER=1.16 GHCVER=7.4.2 -# - CABALVER=1.16 GHCVER=7.6.1 -# - CABALVER=1.16 GHCVER=7.6.2 - - CABALVER=1.18 GHCVER=7.6.3 -# - CABALVER=1.18 GHCVER=7.8.1 # see note about Alex/Happy for GHC >= 7.8 -# - CABALVER=1.18 GHCVER=7.8.2 - - CABALVER=1.18 GHCVER=7.8.3 COVERAGE=1 - - CABALVER=1.22 GHCVER=7.10.2 -# - CABALVER=head GHCVER=head # see section about GHC HEAD snapshots +cache: + directories: + - $HOME/.cabsnap + - $HOME/.cabal/packages -# Note: the distinction between `before_install` and `install` is not important. +before_cache: + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar + +matrix: + include: + - env: CABALVER=1.16 GHCVER=7.6.3 + compiler: ": #GHC 7.6.3" + addons: {apt: {packages: [cabal-install-1.16,ghc-7.6.3,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}} + - env: CABALVER=1.18 GHCVER=7.8.3 COVERAGE=1 + compiler: ": #GHC 7.8.3" + addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.3,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}} + - env: CABALVER=1.22 GHCVER=7.10.3 + compiler: ": #GHC 7.10.3" + addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}} + allow_failures: + - env: CABALVER=1.16 GHCVER=7.6.3 + before_install: - - travis_retry sudo add-apt-repository -y ppa:hvr/ghc - - travis_retry sudo apt-get update - - travis_retry sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER # see note about happy/alex - - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:~/.cabal/bin:$PATH:$PATH - - | - if [ $GHCVER = "head" ] || [ ${GHCVER%.*} = "7.8" ] || [ ${GHCVER%.*} = "7.10" ]; then - travis_retry sudo apt-get install happy-1.19.4 alex-3.1.3 - export PATH=/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:$PATH - else - travis_retry sudo apt-get install happy alex - fi + - unset CC + - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:/opt/alex/3.1.4/bin:/opt/happy/1.19.5/bin:~/.cabal/bin:$PATH install: - cabal --version - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" - - travis_retry cabal update - - cabal install --only-dependencies --enable-tests --enable-benchmarks --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms - - "[ -n \"$COVERAGE\" ] && cabal install hpc-coveralls --avoid-reinstalls || true" + - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ]; + then + zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz > + $HOME/.cabal/packages/hackage.haskell.org/00-index.tar; + fi + - travis_retry cabal update -v + - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config + - cabal install --only-dependencies --enable-tests --enable-benchmarks --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms --dry -v > installplan.txt + - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt -# Here starts the actual work to be performed for the package under test; any command which exits with a non-zero exit code causes the build to fail. +# check whether current requested install-plan matches cached package-db snapshot + - if diff -u installplan.txt $HOME/.cabsnap/installplan.txt; + then + echo "cabal build-cache HIT"; + rm -rfv .ghc; + cp -a $HOME/.cabsnap/ghc $HOME/.ghc; + cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/; + else + echo "cabal build-cache MISS"; + rm -rf $HOME/.cabsnap; + mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin; + cabal install --only-dependencies --enable-tests --enable-benchmarks --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms; + fi + +# snapshot package-db on cache miss + - if [ ! -d $HOME/.cabsnap ]; + then + echo "snapshotting package-db to build-cache"; + mkdir $HOME/.cabsnap; + cp -a $HOME/.ghc $HOME/.cabsnap/ghc; + cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/; + fi + +# Here starts the actual work to be performed for the package under test; +# any command which exits with a non-zero exit code causes the build to fail. script: - if [ -f configure.ac ]; then autoreconf -i; fi - cabal configure --enable-tests --enable-benchmarks -v2 --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms $([ "$COVERAGE" = "1" ] && echo "--enable-library-coverage") # -v2 provides useful information for debugging @@ -50,16 +74,23 @@ - cabal check - cabal sdist # tests that a source-distribution can be generated -# The following scriptlet checks that the resulting source distribution can be built & installed - - export SRC_TGZ=$(cabal info . | awk '{print $2 ".tar.gz";exit}') ; - cd dist/; - if [ -f "$SRC_TGZ" ]; then - cabal install --force-reinstalls "$SRC_TGZ"; - else - echo "expected '$SRC_TGZ' not found"; - exit 1; - fi ; - cd .. +# Check that the resulting source distribution can be built & installed. +# If there are no other `.tar.gz` files in `dist`, this can be even simpler: +# `cabal install --force-reinstalls dist/*-*.tar.gz` + - SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz && + (cd dist && cabal install --force-reinstalls "$SRC_TGZ") -after_script: - - "[ -n \"$COVERAGE\" ] && hpc-coveralls TestSAT TestSimplex TestSimplex2 TestMIPSolver2 TestPolynomial TestAReal TestArith TestContiTraverso TestCongruenceClosure TestLPFile TestMPSFile TestPBFile TestSDPFile TestUtil --exclude-dir=test || true" +# This block must be executed before before_cache +#after_script: + - "[ -n \"$COVERAGE\" ] && cabal install hpc-coveralls --avoid-reinstalls --constraint=\"regex-posix >=0.95.2\" || true" # regex-posix-0.95.1 has compilation problem + - "[ -n \"$COVERAGE\" ] && hpc-coveralls TestSuite TestPolynomial --exclude-dir=test || true" + +notifications: + webhooks: + urls: + - https://webhooks.gitter.im/e/d83a1749bd96e9513d76 + on_success: change # options: [always|never|change] default: always + on_failure: always # options: [always|never|change] default: always + on_start: never # options: [always|never|change] default: always + +# EOF diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown new file mode 100644 --- /dev/null +++ b/CHANGELOG.markdown @@ -0,0 +1,15 @@ +0.4.0 +----- +* add experimental SMT (Satisfiablity Modulo Theories) solver 'toysmt', which supports theory of uninterpreted functions and linear real arithmetics. +* fix toysat to output model in Max-SAT format instead of PB/WBO format when solving Max-SAT problems +* add experimental getAssumptionsImplications functions to ToySolver.SAT module. +* add getFixedLiterals to ToySolver.SAT module. +* use 'mwc-random' package instead of 'random' package. +* introduce 'Config' data type in ToySolver.SAT to simplify configulation management. +* add subset-sum problem solver +* implement backracking and explanation generation in simplex solver and congruence closure solver. + +0.3.0 +----- +* split OPB/WBO file library into a serarate 'pseudo-boolean' library. + diff --git a/COPYING b/COPYING --- a/COPYING +++ b/COPYING @@ -1,4 +1,4 @@ -Copyright 2010-2013 Masahiro Sakai. All rights reserved. +Copyright 2010-2015 Masahiro Sakai. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are diff --git a/COPYING-GPL b/COPYING-GPL new file mode 100644 --- /dev/null +++ b/COPYING-GPL @@ -0,0 +1,674 @@ + 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. + + + Copyright (C) + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + Copyright (C) + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,10 +1,14 @@ toysolver ========= -[![Build Status](https://secure.travis-ci.org/msakai/toysolver.png?branch=master)](http://travis-ci.org/msakai/toysolver) [![Coverage Status](https://coveralls.io/repos/msakai/toysolver/badge.svg)](https://coveralls.io/r/msakai/toysolver) [![Hackage](https://budueba.com/hackage/toysolver)](https://hackage.haskell.org/package/toysolver) +[![Join the chat at https://gitter.im/msakai/toysolver](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/msakai/toysolver?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) -Assorted decision procedures for SAT, Max-SAT, PB, MIP, etc. +[![Build Status](https://secure.travis-ci.org/msakai/toysolver.png?branch=master)](http://travis-ci.org/msakai/toysolver) [![Build status](https://ci.appveyor.com/api/projects/status/w7g615sp8ysiqk7w/branch/master?svg=true)](https://ci.appveyor.com/project/msakai/toysolver/branch/master) [![Coverage Status](https://coveralls.io/repos/msakai/toysolver/badge.svg)](https://coveralls.io/r/msakai/toysolver) [![Hackage](https://budueba.com/hackage/toysolver)](https://hackage.haskell.org/package/toysolver) +It provides solver implementations of various problems including SAT, SMT, Max-SAT, PBS (Pseudo Boolean Satisfaction), PBO (Pseudo Boolean Optimization), MILP (Mixed Integer Linear Programming) and non-linear real arithmetic. + +In particular it contains moderately-fast pure-Haskell SAT solver 'toysat'. + Installation ------------ @@ -33,7 +37,6 @@ * Weighted Max-SAT * Weighted Partial Max-SAT * Real Closed Field -* LA(Q), LA(Z) (NOT IMPLEMENTED YET) Usage: @@ -83,6 +86,16 @@ * toysat placed 4th in PARTIAL-SMALLINT-LIN and SOFT-SMALLINT-LIN categories * toysat placed 8th in OPT-BIGINT-LIN category +### toysmt + +SMT solver based on toysat. + +Usage: + + toysmt [file.smt2] + +Currently only QF_UF, QF_RDL, QF_LRA, QF_UFRDL and QF_UFLRA logic are supported. + ### toyfmf SAT-based finite model finder for first order logic (FOL). @@ -117,8 +130,14 @@ * Input formats: cnf, wcnf, opb, wbo * Output formats: opb, wbo, lsp, lp, mps, smp, smt2, ys +Bindings +-------- + +* [ersatz-toysat](http://hackage.haskell.org/package/ersatz-toysat) - toysat backend driver for [ersatz](http://hackage.haskell.org/package/ersatz) +* [satchmo-toysat](http://hackage.haskell.org/package/satchmo-toysat) - toysat backend driver for [satchmo](http://hackage.haskell.org/package/satchmo) + TODO ---- * Local search -* Suvery propagation +* Survey propagation diff --git a/Smtlib/Smtlib/Parsers/CommandsParsers.hs b/Smtlib/Smtlib/Parsers/CommandsParsers.hs new file mode 100644 --- /dev/null +++ b/Smtlib/Smtlib/Parsers/CommandsParsers.hs @@ -0,0 +1,653 @@ +{-| +Module : Smtlib.Parsers.CommandsParsers +Description : Parsers for Smtlib Commands +Copyright : Rogério Pontes 2015 +License : WTFPL +Maintainer : rogerp62@outlook.com +Stability : stable + +This module contains all the required individual parsers for each Smtlib command, +plus one parser to parse an entire SMTLib2 file, parseSource. + +-} +module Smtlib.Parsers.CommandsParsers where + +import Control.Applicative as Ctr hiding ((<|>)) +import Control.Monad +import Data.Functor.Identity +import Smtlib.Parsers.CommonParsers +import Smtlib.Syntax.Syntax +import Text.Parsec.Prim as Prim +import Text.ParserCombinators.Parsec as Pc + + + +{- + ######################################################################### + # # + # Parser for an SMTLib2 File # + # # + ######################################################################### +-} + + +parseSource :: ParsecT String u Identity Source +parseSource = emptySpace *> (Pc.many $ parseCommand <* Pc.try emptySpace) + + +{- + "###################### Parser For Commands ############################### +-} +parseCommand :: ParsecT String u Identity Command +parseCommand = Pc.try parseSetLogic + <|> Pc.try parseSetOption + <|> Pc.try parseSetInfo + <|> Pc.try parseDeclareSort + <|> Pc.try parseDefineSort + <|> Pc.try parseDeclareConst + <|> Pc.try parseDeclareFun + <|> Pc.try parseDefineFun + <|> Pc.try parseDefineFunRec + <|> Pc.try parseDefineFunsRec + <|> Pc.try parsePush + <|> Pc.try parsePop + <|> Pc.try parseAssert + <|> Pc.try parseCheckSat + <|> Pc.try parseCheckSatAssuming + <|> Pc.try parseGetAssertions + <|> Pc.try parseGetModel + <|> Pc.try parseGetProof + <|> Pc.try parseGetUnsatCore + <|> Pc.try parseGetUnsatAssumptions + <|> Pc.try parseGetValue + <|> Pc.try parseGetAssignment + <|> Pc.try parseGetOption + <|> Pc.try parseGetInfo + <|> Pc.try parseReset + <|> Pc.try parseResetAssertions + <|> Pc.try parseEcho + <|> parseExit + + + +{- + ######################################################################### + # # + # Parser for each command # + # # + ######################################################################### +-} + + + + +parseSetLogic :: ParsecT String u Identity Command +parseSetLogic = do + _ <- aspO + _ <- emptySpace + _ <- string "set-logic" + _ <- emptySpace + symb <- symbol + _ <- emptySpace + _ <- aspC + return $ SetLogic symb + + +parseSetOption :: ParsecT String u Identity Command +parseSetOption = do + _ <- aspO + _ <- emptySpace + _ <- string "set-option" + _ <- emptySpace + attr <- parseOption + _ <- emptySpace + _ <- aspC + return $ SetOption attr + +parseSetInfo :: ParsecT String u Identity Command +parseSetInfo = do + _ <- aspO + _ <- emptySpace + _ <- string "set-info" + _ <- emptySpace "foi aqui1?" + attr <- parseAttribute "foi aqui2?" + _ <- emptySpace + _ <- aspC + return $ SetInfo attr + + +parseDeclareSort :: ParsecT String u Identity Command +parseDeclareSort = do + _ <- aspO + _ <- emptySpace + _ <- string "declare-sort" + _ <- emptySpace + symb <- symbol + _ <- emptySpace + nume <- numeral + _ <- emptySpace + _ <- aspC + return $ DeclareSort symb (read nume :: Int) + +parseDefineSort :: ParsecT String u Identity Command +parseDefineSort = do + _ <- aspO + _ <- emptySpace + _ <- string "define-sort" + _ <- emptySpace + symb <- symbol + _ <- emptySpace + _ <- aspO + symbs <- Pc.many $ symbol <* Pc.try emptySpace + _ <- aspC + _ <- emptySpace + sort <- parseSort + _ <- emptySpace + _ <- aspC + return $ DefineSort symb symbs sort + + +parseDeclareConst :: ParsecT String u Identity Command +parseDeclareConst = do + _ <-aspO + _ <- emptySpace + _ <- string "declare-const" + _ <- emptySpace + symb <- symbol + _ <- emptySpace + sort <- parseSort + _ <- emptySpace + _ <- aspC + return $ DeclareConst symb sort + + +parseDeclareFun :: ParsecT String u Identity Command +parseDeclareFun = do + _ <-aspO + _ <- emptySpace + _ <- string "declare-fun" + _ <- emptySpace + symb <- symbol + _ <- emptySpace + _ <- aspO + _ <- emptySpace + sorts <- Pc.many $ parseSort <* Pc.try emptySpace + _ <- aspC + _ <- emptySpace + sort <- parseSort + _ <- emptySpace + _ <- aspC + return $ DeclareFun symb sorts sort + + +parseDefineFun :: ParsecT String u Identity Command +parseDefineFun = do + _ <- aspO + _ <- emptySpace + _ <- string "define-fun" + _ <- emptySpace + symb <- symbol + _ <- emptySpace + _ <- aspO + sVars <- Pc.many $ parseSortedVar <* Pc.try emptySpace + _ <- aspC + _ <- emptySpace + sort <- parseSort + _ <- emptySpace + term <- parseTerm + _ <- emptySpace + _ <- aspC + return $ DefineFun symb sVars sort term + + +parseDefineFunRec :: ParsecT String u Identity Command +parseDefineFunRec = do + _ <- aspO + _ <- emptySpace + _ <- string "define-fun-rec" + _ <- emptySpace + symb <- symbol + _ <- emptySpace + _ <- aspO + sVars <- Pc.many $ parseSortedVar <* Pc.try emptySpace + _ <- aspC + _ <- emptySpace + sort <- parseSort + _ <- emptySpace + term <- parseTerm + _ <- emptySpace + _ <- aspC + return $ DefineFunRec symb sVars sort term + + +parseDefineFunsRec :: ParsecT String u Identity Command +parseDefineFunsRec = do + _ <- aspO + _ <- emptySpace + _ <- string "define-funs-rec" + _ <- emptySpace + _ <- aspO + _ <- emptySpace + fundecs <- Pc.many $ parseFunDec <* Pc.try emptySpace + _ <- aspC + _ <- emptySpace + _ <- aspO + _ <- emptySpace + terms <- Pc.many $ parseTerm <* Pc.try emptySpace + _ <- aspC + _ <- emptySpace + _ <- aspC + return $ DefineFunsRec fundecs terms + +parseFunDec :: ParsecT String u Identity FunDec +parseFunDec = do + _ <- aspO + _ <- emptySpace + symb <- symbol + _ <- emptySpace + _ <- aspO + _ <- emptySpace + sVars <- Pc.many $ parseSortedVar <* Pc.try emptySpace + _ <- aspC + _ <- emptySpace + sort <- parseSort + _ <- emptySpace + _ <- aspC + return (FunDec symb sVars sort) + + +parsePush :: ParsecT String u Identity Command +parsePush = do + _ <- aspO + _ <- emptySpace + _ <- string "push" + _ <- emptySpace + nume <- option 1 $ do + nume <- numeral + _ <- emptySpace + return (read nume :: Int) + _ <- aspC + return $ Push nume + + +parsePop :: ParsecT String u Identity Command +parsePop = do + _ <- aspO + _ <- emptySpace + _ <- string "pop" + _ <- emptySpace + nume <- option 1 $ do + nume <- numeral + _ <- emptySpace + return (read nume :: Int) + _ <- aspC + return $ Pop nume + + + +parseAssert :: ParsecT String u Identity Command +parseAssert = do + _ <- aspO + _ <- emptySpace + _ <- string "assert" + _ <- emptySpace + term <- parseTerm + _ <- emptySpace + _ <- aspC + return $ Assert term + + +parseCheckSat :: ParsecT String u Identity Command +parseCheckSat = do + _ <- aspO + _ <- emptySpace + _ <- string "check-sat" + _ <- emptySpace + _ <- aspC + return CheckSat + +parseCheckSatAssuming :: ParsecT String u Identity Command +parseCheckSatAssuming = do + _ <- aspO + _ <- emptySpace + _ <- string "check-sat-assuming" + _ <- emptySpace + _ <- aspO + emptySpace + terms <- Pc.many $ parseTerm <* Pc.try emptySpace + _ <- aspC + _ <- emptySpace + _ <- aspC + return (CheckSatAssuming terms) + + +parseGetAssertions :: ParsecT String u Identity Command +parseGetAssertions = do + _ <- aspO + _ <-emptySpace + _ <- string "get-assertions" + _ <- emptySpace + _ <- aspC + return GetAssertions + +parseGetModel :: ParsecT String u Identity Command +parseGetModel = do + _ <- aspO + _ <- emptySpace + _ <- string "get-model" + _ <- emptySpace + _ <-aspC + return GetModel + +parseGetProof :: ParsecT String u Identity Command +parseGetProof = do + _ <- aspO + _ <- emptySpace + _ <- string "get-proof" + _ <- emptySpace + _ <-aspC + return GetProof + +parseGetUnsatCore :: ParsecT String u Identity Command +parseGetUnsatCore = do + _ <- aspO + _ <- emptySpace + _ <- string "get-unsat-core" + _ <- emptySpace + _ <- aspC + return GetUnsatCore + +parseGetUnsatAssumptions :: ParsecT String u Identity Command +parseGetUnsatAssumptions = do + _ <- aspO + _ <- emptySpace + _ <- string "get-unsat-assumptions" + _ <- emptySpace + _ <- aspC + return GetUnsatAssumptions + +parseGetValue :: ParsecT String u Identity Command +parseGetValue = do + _ <- aspO + _ <- emptySpace + _ <- string "get-value" + _ <- emptySpace + _ <- aspO + terms <- Pc.many1 $ parseTerm <* Pc.try emptySpace + _ <- aspC + _ <- emptySpace + _ <- aspC + return $ GetValue terms + +parseGetAssignment :: ParsecT String u Identity Command +parseGetAssignment = do + _ <- aspO + _ <- emptySpace + _ <- string "get-assignment" + _ <- emptySpace + _ <- aspC + return GetAssignment + + +parseGetOption :: ParsecT String u Identity Command +parseGetOption = do + _ <- aspO + _ <- emptySpace + _ <- string "get-option" + _ <- emptySpace + word <- keyword + _ <- emptySpace + _ <- aspC + return $ GetOption word + + +parseGetInfo :: ParsecT String u Identity Command +parseGetInfo = do + _ <- aspO + _ <- emptySpace + _ <- string "get-info" + _ <- emptySpace + flag <- parseInfoFlags + _ <- emptySpace + _ <- aspC + return $ GetInfo flag + + +parseEcho :: ParsecT String u Identity Command +parseEcho = do + _ <- aspO + _ <- emptySpace + _ <- string "echo" + _ <- emptySpace + s <- str + _ <- emptySpace + _ <- aspC + return $ Echo s + + +parseExit :: ParsecT String u Identity Command +parseExit = do + _ <- aspO + _ <- emptySpace + _ <- string "exit" + _ <- emptySpace + _ <- aspC + return Exit + + +parseReset :: ParsecT String u Identity Command +parseReset = do + _ <- aspO + _ <- emptySpace + _ <- string "reset" + _ <- emptySpace + _ <- aspC + return Reset + + +parseResetAssertions :: ParsecT String u Identity Command +parseResetAssertions = do + _ <- aspO + _ <- emptySpace + _ <- string "reset-assertions" + _ <- emptySpace + _ <- aspC + return ResetAssertions + + +{- + ######################################################################### + # # + # Parse Command Options # + # # + ######################################################################### +-} + +parseOption :: ParsecT String u Identity Option +parseOption = Pc.try parsePrintSuccess + <|> Pc.try parseExpandDefinitions + <|> Pc.try parseInteractiveMode + <|> Pc.try parseProduceProofs + <|> Pc.try parseProduceUnsatCores + <|> Pc.try parseProduceUnsatAssumptions + <|> Pc.try parseProduceModels + <|> Pc.try parseProduceAssignments + <|> Pc.try parseProduceAssertions + <|> Pc.try parseGlobalDeclarations + <|> Pc.try parseRegularOutputChannel + <|> Pc.try parseDiagnosticOutputChannel + <|> Pc.try parseRandomSeed + <|> Pc.try parseVerbosity + <|> Pc.try parseReproducibleResourceLimit + <|> Pc.try parseOptionAttribute + + +-- parse PrintSucess +parsePrintSuccess :: ParsecT String u Identity Option +parsePrintSuccess = do + _ <- string ":print-success" + _ <- spaces + val <- parseBool + return $ PrintSuccess val + + +parseExpandDefinitions :: ParsecT String u Identity Option +parseExpandDefinitions = do + _ <- string ":expand-definitions" + _ <- spaces + val <- parseBool + return $ ExpandDefinitions val + + +parseInteractiveMode :: ParsecT String u Identity Option +parseInteractiveMode = do + _ <- string ":interactive-mode" + _ <- spaces + val <- parseBool + return $ InteractiveMode val + +parseProduceProofs :: ParsecT String u Identity Option +parseProduceProofs = do + _ <- string ":produce-proofs" + _ <- spaces + val <- parseBool + return $ ProduceProofs val + + +parseProduceUnsatCores :: ParsecT String u Identity Option +parseProduceUnsatCores = do + _ <- string ":produce-unsat-cores" + _ <- spaces + val <- parseBool + return $ ProduceUnsatCores val + +parseProduceUnsatAssumptions :: ParsecT String u Identity Option +parseProduceUnsatAssumptions = do + _ <- string ":produce-unsat-assumptions" + _ <- spaces + val <- parseBool + return $ ProduceUnsatAssumptions val + +parseProduceModels :: ParsecT String u Identity Option +parseProduceModels = do + _ <- string ":produce-models" + _ <- spaces + val <- parseBool + return $ ProduceModels val + +parseProduceAssignments :: ParsecT String u Identity Option +parseProduceAssignments = do + _ <- string ":produce-assignments" + _ <- spaces + val <- parseBool + return $ ProduceAssignments val + +parseProduceAssertions :: ParsecT String u Identity Option +parseProduceAssertions = do + _ <- string ":produce-assertions" + _ <- spaces + val <- parseBool + return $ ProduceAssertions val + +parseGlobalDeclarations :: ParsecT String u Identity Option +parseGlobalDeclarations = do + _ <- string ":global-declarations" + _ <- spaces + val <- parseBool + return $ GlobalDeclarations val + + +parseRegularOutputChannel :: ParsecT String u Identity Option +parseRegularOutputChannel = do + _ <- string ":regular-output-channel" + _ <- spaces + val <- str + return $ RegularOutputChannel val + + +parseDiagnosticOutputChannel :: ParsecT String u Identity Option +parseDiagnosticOutputChannel = do + _ <- string ":diagnostic-output-channel" + _ <- spaces + val <- str + return $ DiagnosticOutputChannel val + +parseRandomSeed :: ParsecT String u Identity Option +parseRandomSeed = do + _ <- string ":random-seed" + _ <- spaces + val <- numeral + return $ RandomSeed (read val :: Int) + + +parseVerbosity :: ParsecT String u Identity Option +parseVerbosity = do + _ <- string ":verbosity" + _ <- spaces + val <- numeral + return $ Verbosity (read val :: Int) + + +parseReproducibleResourceLimit :: ParsecT String u Identity Option +parseReproducibleResourceLimit = do + _ <- string ":reproducible-resource-limit" + _ <- spaces + val <- numeral + return $ ReproducibleResourceLimit (read val :: Int) + + +parseOptionAttribute :: ParsecT String u Identity Option +parseOptionAttribute = do + attr <- parseAttribute + return $ OptionAttr attr + + + + +{- + ######################################################################### + # # + # Parsers for Info FLags # + # # + ######################################################################### +-} + +parseInfoFlags :: ParsecT String u Identity InfoFlags +parseInfoFlags = Pc.try parseErrorBehaviour + <|> Pc.try parseName + <|> Pc.try parseAuthors + <|> Pc.try parseVersion + <|> Pc.try parseStatus + <|> Pc.try parseReasonUnknown + <|> Pc.try parseAllStatistics + <|> Pc.try parseAssertionStackLevels + <|> parseInfoKeyword + + +parseErrorBehaviour :: ParsecT String u Identity InfoFlags +parseErrorBehaviour = string ":error-behavior" *> return ErrorBehavior + + +parseName :: ParsecT String u Identity InfoFlags +parseName = string ":name" *> return Name + +parseAuthors :: ParsecT String u Identity InfoFlags +parseAuthors = string ":authors" *> return Authors + +parseVersion :: ParsecT String u Identity InfoFlags +parseVersion = string ":version" *> return Version + +parseStatus :: ParsecT String u Identity InfoFlags +parseStatus = string ":status" *> return Status + +parseReasonUnknown :: ParsecT String u Identity InfoFlags +parseReasonUnknown = string ":reason-unknown" *> return ReasonUnknown + +parseAllStatistics :: ParsecT String u Identity InfoFlags +parseAllStatistics = string ":all-statistics" *> return AllStatistics + +parseAssertionStackLevels :: ParsecT String u Identity InfoFlags +parseAssertionStackLevels = string ":assertion-stack-levels" *> return AssertionStackLevels + +parseInfoKeyword :: ParsecT String u Identity InfoFlags +parseInfoKeyword = liftM InfoFlags keyword diff --git a/Smtlib/Smtlib/Parsers/CommonParsers.hs b/Smtlib/Smtlib/Parsers/CommonParsers.hs new file mode 100644 --- /dev/null +++ b/Smtlib/Smtlib/Parsers/CommonParsers.hs @@ -0,0 +1,470 @@ +{-| +Module : Smtlib.Parsers.CommandsParsers +Description : Common parsers for commands and responses. +Copyright : Rogério Pontes 2015 +License : WTFPL +Maintainer : rogerp62@outlook.com +Stability : stable + +This module contains some auxiliar parsers, used to parse commands or responses. +-} +module Smtlib.Parsers.CommonParsers where + + +{- + In the String terminal, it does not parse C-style characters. + Quoted Symbol does not parse all printable ASCII characters. +-} + +import Control.Applicative as Ctr hiding ((<|>)) +import Data.Functor.Identity +import qualified Data.Set as Set +import Text.Parsec.Prim as Prim +import Text.ParserCombinators.Parsec as Pc +import Smtlib.Syntax.Syntax +import Control.Monad + +(<:>) :: Applicative f => f a -> f [a] -> f [a] +(<:>) a b = (:) <$> a <*> b + +(<++>) :: Applicative f => f [a] -> f [a] -> f [a] +(<++>) a b = (++) <$> a <*> b + +parseBool :: ParsecT String u Identity Bool +parseBool = (true *> return True) <|> (false *> return False) + + +-- Parse a Numeral + +numeral :: ParsecT String u Identity String +numeral = many1 digit + +num :: ParsecT String u Identity String +num = Pc.many digit +-- Parse a decimal + +decimal :: ParsecT String u Identity String +decimal = numeral <++> dot <++> Pc.try zeros <++> num + +zeros :: ParsecT String u Identity String +zeros = Pc.many $ char '0' + + +dot :: ParsecT String u Identity String +dot = string "." + +-- parse a Hexadecimal + +hexadecimal :: ParsecT String u Identity String +hexadecimal = string "#x" *> many1 hexDigit + + +--parsea a Binary +binary :: ParsecT String u Identity String +binary = string "#b" *> many1 bin + +bin :: ParsecT String u Identity Char +bin = char '0' <|> char '1' + + +--parse a String +-- Dosent parse strings with escape characters +str :: ParsecT String u Identity String +str = string "\"" <++> liftM concat (Pc.many (liftM (\c -> [c]) strChar <|> Pc.try (string "\"\""))) <++> string "\"" + +strChar :: ParsecT String u Identity Char +strChar = (oneOf $ ['\t','\n','\r'] ++ [c | c <- [toEnum 32 .. toEnum 126], c /= '"']) <|> satisfy (toEnum 128 <=) + + +--parse a Symbol +symbol :: ParsecT String u Identity String +symbol = simpleSymbol <|> quotedSymbol + +quotedSymbol :: ParsecT String u Identity String +quotedSymbol = char '|' *> Pc.many (noneOf "|") <* char '|' + +simpleSymbol :: ParsecT String u Identity String +simpleSymbol = Pc.try $ do + s <- (letter <|> spcSymb) <:> sq + guard $ s `Set.notMember` reserved + return s + where + sq = Pc.many (alphaNum <|> spcSymb) + reserved = Set.fromList $ + ["BINARY", "DECIMAL", "HEXADECIMAL", "NUMERAL", "STRING", "_", "!", "as", "let", "exists", "forall", "par"] ++ + ["set-logic", "set-option", "set-info", "declare-sort", "define-sort", "declare-const", "declare-fun", "declare-fun-rec", "declare-funs-rec", "push", "pop", "reset", "reset-assertions", "assert", "check-sat", "check-sat-assuming", "get-assertions", "get-model", "get-proof", "get-unsat-core", "get-unsat-assumptions", "get-value", "get-assignment", "get-option", "get-info", "echo", "exit"] + +spcSymb :: ParsecT String u Identity Char +spcSymb = oneOf "+-/*=%?!.$_~^&<>@" + +-- parse a key word +keyword :: ParsecT String u Identity String +keyword = char ':' <:> Pc.many (alphaNum<|> spcSymb) + + +aspO :: ParsecT String u Identity Char +aspO = char '(' + +aspC :: ParsecT String u Identity Char +aspC = char ')' + +aspUS :: ParsecT String u Identity Char +aspUS = char '_' + + +true :: ParsecT String u Identity String +true = string "true" + +false :: ParsecT String u Identity String +false = string "false" + + +emptySpace :: ParsecT String u Identity String +emptySpace = liftM concat $ Pc.try $ Pc.many emptySpaceSingle + +emptySpace1 :: ParsecT String u Identity String +emptySpace1 = liftM concat $ Pc.try $ Pc.many1 emptySpaceSingle + +emptySpaceSingle :: ParsecT String u Identity String +emptySpaceSingle = liftM (\c -> [c]) (char ' ' <|> char '\n' <|> char '\t' <|> char '\r') <|> comment + +comment :: ParsecT String u Identity String +comment = char ';' <:> scan + where + scan = do{ c <- char '\n' <|> char '\r'; return [c] } + <|> + do{ c <- anyChar; cs <- scan; return (c:cs) } + +reservedWords :: ParsecT String u Identity String +reservedWords = string "let" + <|> string "par" + <|> string "_" + <|> string "!" + <|> string "as" + <|> string "forall" + <|> string "exists" + <|> string "NUMERAL" + <|> string "DECIMAL" + <|> string "STRING" + + + + +{- + ######################################################################### + # # + # Parsers for Terms # + # # + ######################################################################### +-} + + +-- Term +parseTerm :: ParsecT String u Identity Term +parseTerm = parseTSPC + <|> Pc.try parseTQID + <|> Pc.try parseTQIT + <|> Pc.try parseTermLet + <|> Pc.try parseTermFA + <|> Pc.try parseTermEX + <|> parseTermAnnot + +parseTSPC :: ParsecT String u Identity Term +parseTSPC = liftM TermSpecConstant parseSpecConstant + +parseTQID :: ParsecT String u Identity Term +parseTQID = liftM TermQualIdentifier parseQualIdentifier + +parseTQIT :: ParsecT String u Identity Term +parseTQIT = do + _ <- aspO + _ <- emptySpace + iden <- parseQualIdentifier + _ <- emptySpace + terms <- Pc.many $ parseTerm <* Pc.try emptySpace + _ <- aspC + return $ TermQualIdentifierT iden terms + +parseTermLet :: ParsecT String u Identity Term +parseTermLet = do + _ <- aspO + _ <- emptySpace + _ <- string "let" + _ <- emptySpace + _ <- aspO + _ <- emptySpace + vb <- Pc.many $ parseVarBinding <* Pc.try emptySpace + _ <- aspC + _ <- emptySpace + term <- parseTerm + _ <- emptySpace + _ <- aspC + return $ TermLet vb term + +parseTermFA :: ParsecT String u Identity Term +parseTermFA = do + _ <- aspO + _ <- emptySpace + _ <- string "forall" + _ <- emptySpace + _ <- aspO + sv <- Pc.many $ parseSortedVar <* Pc.try emptySpace + _ <- aspC + _ <- emptySpace + term <- parseTerm + _ <- emptySpace + _ <- aspC + return $ TermForall sv term + + +parseTermEX :: ParsecT String u Identity Term +parseTermEX = do + _ <- aspO + _ <- emptySpace + _ <- string "exists" + _ <- emptySpace + _ <- aspO + sv <- Pc.many $ parseSortedVar <* Pc.try emptySpace + _ <- aspC + _ <- emptySpace + term <- parseTerm + _ <- emptySpace + _ <- aspC + return $ TermExists sv term + +parseTermAnnot :: ParsecT String u Identity Term +parseTermAnnot = do + _ <- aspO + _ <- emptySpace + _ <- char '!' + _ <- emptySpace + term <- parseTerm + _ <- emptySpace + attr <- Pc.many $ parseAttribute <* Pc.try emptySpace + _ <- aspC + return $ TermAnnot term attr + + +-- -- Parse Sorted Var +parseSortedVar :: ParsecT String u Identity SortedVar +parseSortedVar = do + _ <- aspO + _ <- emptySpace + symb <- symbol + _ <- emptySpace + sort <- parseSort + _ <- emptySpace + _ <- aspC + return $ SV symb sort + +-- -- Parse Qual identifier +parseQualIdentifier :: ParsecT String u Identity QualIdentifier +parseQualIdentifier = Pc.try parseQID <|> parseQIAs + +parseQID :: ParsecT String u Identity QualIdentifier +parseQID = liftM QIdentifier parseIdentifier + + + + +parseQIAs :: ParsecT String u Identity QualIdentifier +parseQIAs = do + _ <- aspO + _ <- emptySpace + _ <- string "as" + _ <- emptySpace1 + ident <- parseIdentifier + _ <- emptySpace + sort <- parseSort + _ <- emptySpace + _ <- aspC + return $ QIdentifierAs ident sort + + +-- -- Parse Var Binding +parseVarBinding :: ParsecT String u Identity VarBinding +parseVarBinding = do + _ <- aspO + _ <- emptySpace + symb <- symbol + _ <- emptySpace + term <- parseTerm + _ <- emptySpace + _ <- aspC + return $ VB symb term + + + + + +{- + ######################################################################### + # # + # Parsers for Attributes # + # # + ######################################################################### +-} + +--Parse Attribute Value +parseAttributeValue :: ParsecT String u Identity AttrValue +parseAttributeValue = parseAVSC <|> parseAVS <|> parseAVSexpr + +parseAVSC :: ParsecT String u Identity AttrValue +parseAVSC = liftM AttrValueConstant parseSpecConstant + +parseAVS :: ParsecT String u Identity AttrValue +parseAVS = liftM AttrValueSymbol symbol + +parseAVSexpr :: ParsecT String u Identity AttrValue +parseAVSexpr = do + _ <- aspO + _ <- emptySpace + expr <- Pc.many $ parseSexpr <* Pc.try emptySpace + _ <- aspC + return $ AttrValueSexpr expr + + + +-- Parse Attribute + +parseAttribute :: ParsecT String u Identity Attribute +parseAttribute = Pc.try parseKeyAttAttribute <|> parseKeyAttribute + + +parseKeyAttribute :: ParsecT String u Identity Attribute +parseKeyAttribute = liftM Attribute keyword + +parseKeyAttAttribute :: ParsecT String u Identity Attribute +parseKeyAttAttribute = do + kw <- keyword + _ <- emptySpace + atr <- parseAttributeValue + return $ AttributeVal kw atr + + +{- + ######################################################################### + # # + # Parsers Sort # + # # + ######################################################################### +-} + +-- Parse Sot + +parseSort :: ParsecT String u Identity Sort +parseSort = Pc.try parseIdentifierS <|> parseIdentifierSort + +parseIdentifierS :: ParsecT String u Identity Sort +parseIdentifierS = liftM SortId parseIdentifier + +parseIdentifierSort :: ParsecT String u Identity Sort +parseIdentifierSort = do + _ <- aspO + _ <- emptySpace + identifier <- parseIdentifier + _ <- emptySpace + sorts <- many1 (parseSort <* Pc.try emptySpace) + _ <- aspC + return $ SortIdentifiers identifier sorts + + + + +{- + ######################################################################### + # # + # Parsers Identifiers # + # # + ######################################################################### +-} + + +-- Parse Identifiers + +parseIdentifier :: ParsecT String u Identity Identifier +parseIdentifier = parseOnlySymbol <|> parseNSymbol + +parseOnlySymbol :: ParsecT String u Identity Identifier +parseOnlySymbol = liftM ISymbol symbol + +parseNSymbol :: ParsecT String u Identity Identifier +parseNSymbol = do + _ <- aspO + _ <- emptySpace + _ <- aspUS + _ <- emptySpace1 + symb <- symbol + _ <- emptySpace + indexes <- many1 ((liftM (IndexNumeral . read) numeral <|> liftM IndexSymbol symbol) <* Pc.try spaces) + _ <- aspC + return $ I_Symbol symb indexes + +{- + ######################################################################### + # # + # Parsers S-exprs # + # # + ######################################################################### +-} + + +-- parse S-expressions + +parseSexprConstant :: ParsecT String u Identity Sexpr +parseSexprConstant = liftM SexprSpecConstant parseSpecConstant + +parseSexprSymbol :: ParsecT String u Identity Sexpr +parseSexprSymbol = liftM SexprSymbol symbol + +parseSexprKeyword :: ParsecT String u Identity Sexpr +parseSexprKeyword = liftM SexprKeyword keyword + +parseAtomSexpr :: ParsecT String u Identity Sexpr +parseAtomSexpr = parseSexprConstant + <|> parseSexprSymbol + <|> parseSexprKeyword + + +parseListSexpr :: ParsecT String u Identity Sexpr +parseListSexpr = do + _ <- aspO + list <- Pc.many parseSexpr + _ <- aspC + return $ SexprSxp list + + + +parseSexpr :: ParsecT String u Identity Sexpr +parseSexpr = do + _ <- emptySpace + expr <- parseAtomSexpr <|> parseListSexpr + _ <- emptySpace + return expr + + + +-- parse Spec Constant +parseSpecConstant :: ParsecT String u Identity SpecConstant +parseSpecConstant = Pc.try parseDecimal + <|> parseNumeral + <|> Pc.try parseHexadecimal + <|> parseBinary + <|> parseString + + + +parseNumeral :: ParsecT String u Identity SpecConstant +parseNumeral = liftM SpecConstantNumeral (read <$> numeral) + +parseDecimal :: ParsecT String u Identity SpecConstant +parseDecimal = liftM SpecConstantDecimal decimal + +parseHexadecimal :: ParsecT String u Identity SpecConstant +parseHexadecimal = liftM SpecConstantHexadecimal hexadecimal + +parseBinary :: ParsecT String u Identity SpecConstant +parseBinary = liftM SpecConstantBinary binary + +parseString :: ParsecT String u Identity SpecConstant +parseString = liftM SpecConstantString str diff --git a/Smtlib/Smtlib/Parsers/ResponseParsers.hs b/Smtlib/Smtlib/Parsers/ResponseParsers.hs new file mode 100644 --- /dev/null +++ b/Smtlib/Smtlib/Parsers/ResponseParsers.hs @@ -0,0 +1,375 @@ +{-| +Module : Smtlib.Parsers.ResponseParsers +Description : Parsers for Smtlib commands response. +Copyright : Rogério Pontes 2015 +License : WTFPL +Maintainer : rogerp62@outlook.com +Stability : stable + +This module contains all the required individual parsers for each reasponse to +a Smtlib command, plus one parser to parse every result, parseCmdResult. + +-} + +module Smtlib.Parsers.ResponseParsers where + +import Control.Applicative as Ctr hiding ((<|>)) +import Control.Monad +import Data.Functor.Identity +import Smtlib.Parsers.CommonParsers +import Smtlib.Parsers.CommandsParsers +import Smtlib.Syntax.Syntax as CmdRsp +import Text.Parsec.Prim as Prim +import Text.ParserCombinators.Parsec as Pc + + + +parseCmdResult :: ParsecT String u Identity CmdResponse +parseCmdResult = Pc.try parseCmdGenResponse + <|> Pc.try parseCmdCheckSatResponse + <|> Pc.try parseCmdGetInfoResponse + <|> Pc.try parseCmdGetAssertions + <|> Pc.try parseCmdGetAssignment + <|> Pc.try parseCmdGetProof + <|> Pc.try parseCmdGetProof + <|> Pc.try parseCmdGetValueResponse + <|> Pc.try parseCmdGetModelResponse + <|> Pc.try parseCmdGetOptionResponse + <|> Pc.try parseCmdEchoResponse + +{- + ######################################################################### + # # + # Parser Cmd Gen Response # + # # + ######################################################################### +-} + +parseCmdGenResponse :: ParsecT String u Identity CmdResponse +parseCmdGenResponse = liftM CmdGenResponse parseGenResponse + +parseGenResponse :: ParsecT String u Identity GenResponse +parseGenResponse = parseUnsupported <|> parseSuccess <|> parseGenError + +parseSuccess :: ParsecT String u Identity GenResponse +parseSuccess = string "success" *> return Success + +parseUnsupported :: ParsecT String u Identity GenResponse +parseUnsupported = string "unsupported" *> return Unsupported + + +parseGenError :: ParsecT String u Identity GenResponse +parseGenError = do + _ <- aspO + _ <- emptySpace + _ <- string "error" + _ <- emptySpace + err <- str + _ <- emptySpace + _ <- aspC + return $ CmdRsp.Error err + + + + + + +{- + ######################################################################### + # # + # Parser get info response # + # # + ######################################################################### +-} + +parseCmdGetInfoResponse :: ParsecT String u Identity CmdResponse +parseCmdGetInfoResponse = liftM CmdGetInfoResponse parseGetInfoResponse + + +parseGetInfoResponse :: ParsecT String u Identity [InfoResponse] +parseGetInfoResponse = do + _ <-aspO + _ <- emptySpace + infoResp <- Pc.many $ parseInfoResponse <* Pc.try emptySpace + _ <- aspC + return infoResp + + + +parseInfoResponse :: ParsecT String u Identity InfoResponse +parseInfoResponse = + Pc.try parseResponseName <|> + Pc.try parseResponseErrorBehavior <|> + Pc.try parseResponseAuthors <|> + Pc.try parseResponseVersion <|> + Pc.try parseResponseReasonUnknown <|> + Pc.try parseResponseAssertionStackLevels <|> + parseResponseAttribute + + + + +parseResponseName :: ParsecT String u Identity InfoResponse +parseResponseName = string ":name" *> emptySpace *> liftM ResponseName str + + +parseResponseErrorBehavior :: ParsecT String u Identity InfoResponse +parseResponseErrorBehavior = string ":error-behavior" *> emptySpace *> + liftM ResponseErrorBehavior parseErrorBehavior + +parseErrorBehavior :: ParsecT String u Identity ErrorBehavior +parseErrorBehavior = + (string "immediate-exit" >> return ImmediateExit) <|> + (string "continued-execution" >> return ContinuedExecution) + + +parseResponseAuthors :: ParsecT String u Identity InfoResponse +parseResponseAuthors = string ":authors" *> emptySpace *> + liftM ResponseAuthors str + +parseResponseVersion :: ParsecT String u Identity InfoResponse +parseResponseVersion = string ":version" *> emptySpace *> + liftM ResponseVersion str + + + +parseResponseReasonUnknown :: ParsecT String u Identity InfoResponse +parseResponseReasonUnknown = string ":reason-unknown" *> emptySpace *> + liftM ResponseReasonUnknown parseRReasonUnknown + +parseRReasonUnknown :: ParsecT String u Identity ReasonUnknown +parseRReasonUnknown = + (string "memout" >> return Memout) <|> + (string "incomplete" >> return Incomplete) + +parseResponseAssertionStackLevels :: ParsecT String u Identity InfoResponse +parseResponseAssertionStackLevels = + string ":assertion-stack-levels" *> emptySpace *> + liftM ResponseAssertionStackLevels (liftM read numeral) + + +parseResponseAttribute :: ParsecT String u Identity InfoResponse +parseResponseAttribute = liftM ResponseAttribute parseAttribute + + + + + + + +{- + ######################################################################### + # # + # Parser check sat response # + # # + ######################################################################### +-} + + + +parseCmdCheckSatResponse :: ParsecT String u Identity CmdResponse +parseCmdCheckSatResponse = liftM CmdCheckSatResponse parseCheckSatResponse + + + +-- Parser for check sat response +parseCheckSatResponse :: ParsecT String u Identity CheckSatResponse +parseCheckSatResponse = + (string "sat" >> return Sat) <|> + Pc.try (string "unsat" >> return Unsat) <|> + (string "unknown" >> return Unknown) + + + + +{- + ######################################################################### + # # + # Parser get assertions cmd # + # # + ######################################################################### +-} + + +parseCmdGetAssertions :: ParsecT String u Identity CmdResponse +parseCmdGetAssertions = + liftM CmdGetAssertionsResponse parseGetAssertionsResponse + + + +-- parse Get Assertion Response +parseGetAssertionsResponse :: ParsecT String u Identity [Term] +parseGetAssertionsResponse = do + _ <- aspO + _ <- emptySpace + terms <- Pc.many $ parseTerm <* Pc.try emptySpace + _ <- aspC + return terms + +{- + ######################################################################### + # # + # Parser get proof response # + # # + ######################################################################### +-} + + +parseCmdGetProof :: ParsecT String u Identity CmdResponse +parseCmdGetProof = liftM CmdGetProofResponse parseGetProofResponse + +-- parse Get Proof response +parseGetProofResponse :: ParsecT String u Identity Sexpr +parseGetProofResponse = parseSexpr + + + +{- + ######################################################################### + # # + # Parser get unsat core response # + # # + ######################################################################### +-} + + +parseCmdGetUnsatCore :: ParsecT String u Identity CmdResponse +parseCmdGetUnsatCore = liftM CmdGetUnsatCoreResponse parseGetUnsatCoreResp + + +-- parse Get unsat core response +parseGetUnsatCoreResp :: ParsecT String u Identity [String] +parseGetUnsatCoreResp = do + _ <- aspO + _ <- emptySpace + symb <- Pc.many $ symbol <* Pc.try emptySpace + _ <- aspC + return symb + + +{- + ######################################################################### + # # + # Parser Cmd Get value response # + # # + ######################################################################### +-} + + +parseCmdGetValueResponse :: ParsecT String u Identity CmdResponse +parseCmdGetValueResponse = liftM CmdGetValueResponse parseGetValueResponse + + + +-- parse Get Value response +parseGetValueResponse :: ParsecT String u Identity [ValuationPair] +parseGetValueResponse = + aspO *> (Pc.many $ parseValuationPair <* Pc.try emptySpace) <* aspC + +parseValuationPair :: ParsecT String u Identity ValuationPair +parseValuationPair = do + _ <- aspO + _ <- emptySpace + term1 <- parseTerm + _ <- emptySpace + term2 <- parseTerm + _ <- emptySpace + _ <- aspC + return $ ValuationPair term1 term2 + + +{- + ######################################################################### + # # + # Parser Cmd get assignment Resp # + # # + ######################################################################### +-} + + +parseCmdGetAssignment :: ParsecT String u Identity CmdResponse +parseCmdGetAssignment = liftM CmdGetAssignmentResponse parseGetAssignmentResp + +-- parse get Assignent Response +parseGetAssignmentResp :: ParsecT String u Identity [TValuationPair] +parseGetAssignmentResp = do + _ <- aspO + _ <- emptySpace + pairs <- Pc.many $ parseTValuationPair <* Pc.try emptySpace + _ <- aspC + return pairs + +-- parse t valuation pair +parseTValuationPair :: ParsecT String u Identity TValuationPair +parseTValuationPair = do + _ <- aspO + _ <- emptySpace + symb <- symbol + _ <- emptySpace + bval <- parseBool + _ <- emptySpace + _ <-aspC + return $ TValuationPair symb bval + + +{- + ######################################################################### + # # + # Parser Cmd Get model response # + # # + ######################################################################### +-} + + +parseCmdGetModelResponse :: ParsecT String u Identity CmdResponse +parseCmdGetModelResponse = liftM CmdGetModelResponse parseGetModelResponse + + + +-- parse Get Model response +parseGetModelResponse :: ParsecT String u Identity [Command] +parseGetModelResponse = + aspO *> (Pc.many $ parseCommand <* Pc.try emptySpace) <* aspC + + +{- + ######################################################################### + # # + # Parser Cmd get option response # + # # + ######################################################################### +-} + + +parseCmdGetOptionResponse :: ParsecT String u Identity CmdResponse +parseCmdGetOptionResponse = liftM CmdGetOptionResponse parseGetOptionResponse + + +-- parse Get Option Response +parseGetOptionResponse :: ParsecT String u Identity AttrValue +parseGetOptionResponse = parseAttributeValue + +{- + ######################################################################### + # # + # Parser Cmd get option response # + # # + ######################################################################### +-} + + +parseCmdEchoResponse :: ParsecT String u Identity CmdResponse +parseCmdEchoResponse = liftM CmdEchoResponse parseEchoResponse + + +-- parse Echo Response +parseEchoResponse :: ParsecT String u Identity EchoResponse +parseEchoResponse = str + +{- + ######################################################################### + # # + # Parser check-sat Alterg'os response # + # # + ######################################################################### +-} diff --git a/Smtlib/Smtlib/Syntax/ShowSL.hs b/Smtlib/Smtlib/Syntax/ShowSL.hs new file mode 100644 --- /dev/null +++ b/Smtlib/Smtlib/Syntax/ShowSL.hs @@ -0,0 +1,248 @@ +{-| +Module : Smtlib.Syntax.ShowSL +Description : Instance to print the syntax. +Copyright : Rogério Pontes 2015 +License : WTFPL +Maintainer : rogerp62@outlook.com +Stability : stable + +Functions to print the syntax as a SMTLib. + +-} +module Smtlib.Syntax.ShowSL where + +import Data.Char +import qualified Data.Set as Set +import Data.List +import Smtlib.Syntax.Syntax + + + + + +joinA ::(ShowSL a) => [a] -> String +joinA = unwords.fmap showSL + +joinNs :: [Int] -> String +joinNs = unwords.fmap show + +showSymbol :: String -> String +showSymbol s + | c:_ <- s, isDigit c = quoted + | all p s && s `Set.notMember` reserved = s + | otherwise = quoted + where + quoted = "|" ++ s ++ "|" + p c = (isAscii c && isAlpha c) || isDigit c || c `elem` "~!@$%^&*_-+=<>.?/" + reserved = Set.fromList $ + ["BINARY", "DECIMAL", "HEXADECIMAL", "NUMERAL", "STRING", "_", "!", "as", "let", "exists", "forall", "par"] ++ + ["set-logic", "set-option", "set-info", "declare-sort", "define-sort", "declare-const", "declare-fun", "declare-fun-rec", "declare-funs-rec", "push", "pop", "reset", "reset-assertions", "assert", "check-sat", "check-sat-assuming", "get-assertions", "get-model", "get-proof", "get-unsat-core", "get-unsat-assumptions", "get-value", "get-assignment", "get-option", "get-info", "echo", "exit"] + + +class ShowSL a where + showSL :: a -> String + + + +{- + ######################################################################### + # # + # ShowSL for an SMTLib2 File # + # # + ######################################################################### +-} + + +instance ShowSL Command where + showSL (SetLogic s) = "(set-logic " ++ showSymbol s ++ ")" + showSL (SetOption opt) = "(set-option " ++ showSL opt ++ ")" + showSL (SetInfo info) = "(set-info " ++ showSL info ++ ")" + showSL (DeclareSort str val) = "(declare-sort " ++ showSymbol str ++ + " " ++ show val ++ ")" + showSL (DefineSort str strs sort) = "(define-sort " ++ showSymbol str ++ + " (" ++ unwords (map showSymbol strs) ++ ") " ++ showSL sort ++ ") " + showSL (DeclareConst str sort) = "(declare-const " ++ showSymbol str ++ + " " ++ showSL sort ++ ") " + showSL (DeclareFun str sorts sort) = "(declare-fun " ++ showSymbol str ++ + " (" ++ joinA sorts ++ ") " ++ showSL sort ++ ") " + showSL (DefineFun str srvs sort term) = "(define-fun " ++ showSymbol str ++ + " (" ++ joinA srvs ++ ") " ++ showSL sort ++ " " ++ showSL term ++ ")" + showSL (DefineFunRec str srvs sort term) = "(define-fun-rec " ++ showSymbol str ++ + " (" ++ joinA srvs ++ ") " ++ showSL sort ++ " " ++ showSL term ++ ")" + showSL (DefineFunsRec fundecs terms) = "(define-funs-rec " ++ + " (" ++ joinA fundecs ++ ") (" ++ joinA terms ++ "))" + showSL (Push n) = "(push " ++ show n ++ ")" + showSL (Pop n) = "(pop " ++show n ++ ")" + showSL (Assert term) = "(assert " ++ showSL term ++ ")" + showSL CheckSat = "(check-sat)" + showSL (CheckSatAssuming terms) = "(check-sat-assuming (" ++ joinA terms ++ "))" + showSL GetAssertions = "(get-assertions)" + showSL GetModel = "(get-model)" + showSL GetProof = "(get-proof)" + showSL GetUnsatCore = "(get-unsat-core)" + showSL GetUnsatAssumptions = "(get-unsat-assumptions)" + showSL (GetValue terms) = "(get-value (" ++ joinA terms ++ "))" + showSL GetAssignment = "(get-assignment)" + showSL (GetOption opt) = "(get-option " ++ opt ++ ")" + showSL (GetInfo info) = "(get-info " ++ showSL info ++ ")" + showSL Reset = "(reset)" + showSL ResetAssertions = "(reset-assertions)" + showSL (Echo str) = "(echo " ++ str ++ ")" + showSL Exit = "(exit)" + + +instance ShowSL Bool where + showSL True = "true" + showSL False = "false" + +instance ShowSL Option where + showSL (PrintSuccess b) = ":print-success " ++ showSL b + showSL (ExpandDefinitions b) = ":expand-definitions " ++ showSL b + showSL (InteractiveMode b) = ":interactive-mode " ++ showSL b + showSL (ProduceProofs b) = ":produce-proofs " ++ showSL b + showSL (ProduceUnsatCores b) = ":produce-unsat-cores " ++ showSL b + showSL (ProduceUnsatAssumptions b) = ":produce-unsat-assumptions " ++ showSL b + showSL (ProduceModels b) = ":produce-models " ++ showSL b + showSL (ProduceAssignments b) = ":produce-assignments " ++ showSL b + showSL (ProduceAssertions b) = ":produce-assertions " ++ showSL b + showSL (GlobalDeclarations b) = ":global-declarations " ++ showSL b + showSL (RegularOutputChannel s) = ":regular-output-channel " ++ s + showSL (DiagnosticOutputChannel s) = ":diagnostic-output-channel " ++ s + showSL (RandomSeed n) = ":random-seed " ++ show n + showSL (Verbosity n) = ":verbosity " ++ show n + showSL (ReproducibleResourceLimit n) = ":reproducible-resource-limit " ++ show n + showSL (OptionAttr attr) = showSL attr + +instance ShowSL InfoFlags where + showSL ErrorBehavior = ":error-behavior" + showSL Name = ":name" + showSL Authors = ":authors" + showSL Version = ":version" + showSL Status = ":status" + showSL ReasonUnknown = ":reason-unknown" + showSL AllStatistics = ":all-statistics" + showSL AssertionStackLevels = ":assertion-stack-levels" + showSL (InfoFlags s) = s + + +instance ShowSL Term where + showSL (TermSpecConstant sc) = showSL sc + showSL (TermQualIdentifier qi) = showSL qi + showSL (TermQualIdentifierT qi terms) = + "(" ++ showSL qi ++ " " ++ joinA terms ++ ")" + showSL (TermLet vb term) = + "(let (" ++ joinA vb ++ ") " ++ showSL term ++ ")" + showSL (TermForall svs term) = + "(forall (" ++ joinA svs ++ " ) " ++ showSL term ++ ")" + showSL (TermExists svs term) = + "(exists (" ++ joinA svs ++ " ) " ++ showSL term ++ ")" + showSL (TermAnnot term atts) = + "(! " ++ showSL term ++ " " ++ joinA atts ++ ")" + +instance ShowSL VarBinding where + showSL (VB str term) = "("++ showSymbol str ++ " " ++ showSL term ++ ")" + +instance ShowSL SortedVar where + showSL (SV str sort) = "(" ++ showSymbol str ++ " " ++ showSL sort ++ ")" + +instance ShowSL QualIdentifier where + showSL (QIdentifier iden) = showSL iden + showSL (QIdentifierAs iden sort) = + "(as " ++ showSL iden ++ " " ++ showSL sort ++ ")" + +instance ShowSL FunDec where + showSL (FunDec str srvs sort) = + "(" ++ showSymbol str ++ " (" ++ joinA srvs ++ ") " ++ showSL sort ++ ")" + +instance ShowSL AttrValue where + showSL (AttrValueConstant spc) = showSL spc + showSL (AttrValueSymbol str) = showSymbol str + showSL (AttrValueSexpr sexprs) = "(" ++ joinA sexprs ++ ")" + +instance ShowSL Attribute where + showSL (Attribute str) = str + showSL (AttributeVal str attrVal) = str ++ " " ++ showSL attrVal + +instance ShowSL Index where + showSL (IndexNumeral i) = show i + showSL (IndexSymbol str) = showSymbol str + +instance ShowSL Identifier where + showSL (ISymbol str) = showSymbol str + showSL (I_Symbol str is) = "(_ " ++ showSymbol str ++ " " ++ joinA is ++ ")" + +instance ShowSL Sort where + showSL (SortId iden) = showSL iden + showSL (SortIdentifiers iden sorts) = + "(" ++ showSL iden ++ " " ++ joinA sorts ++ ")" + +instance ShowSL SpecConstant where + showSL (SpecConstantNumeral n) = show n + showSL (SpecConstantDecimal str) = str + showSL (SpecConstantHexadecimal str) = "#x" ++ str + showSL (SpecConstantBinary str) = "#b" ++ str + showSL (SpecConstantString str) = str + +instance ShowSL Sexpr where + showSL (SexprSpecConstant sc) = showSL sc + showSL (SexprSymbol str) = showSymbol str + showSL (SexprKeyword str) = str + showSL (SexprSxp srps) = "(" ++ joinA srps ++ ")" + + +{- + ######################################################################### + # # + # Command Response # + # # + ######################################################################### +-} + +instance ShowSL CmdResponse where + showSL (CmdGenResponse x) = showSL x + showSL (CmdGetInfoResponse x) = "(" ++ joinA x ++ ")" + showSL (CmdCheckSatResponse x) = showSL x + showSL (CmdGetAssertionsResponse x) = "(" ++ joinA x ++ ")" + showSL (CmdGetAssignmentResponse x) = "(" ++ joinA x ++ ")" + showSL (CmdGetProofResponse x) = showSL x + showSL (CmdGetUnsatCoreResponse x) = "(" ++ unwords (map showSymbol x) ++ ")" + showSL (CmdGetUnsatAssumptionsResponse terms) = "(" ++ joinA terms ++ ")" + showSL (CmdGetValueResponse x) = "(" ++ joinA x ++ ")" + showSL (CmdGetModelResponse cmds) = "(" ++ joinA cmds ++ ")" + showSL (CmdGetOptionResponse x) = showSL x + showSL (CmdEchoResponse x) = x + + +instance ShowSL GenResponse where + showSL Unsupported = "unsupported" + showSL Success = "success" + showSL (Error s) = "(error " ++ s ++ ")" + +instance ShowSL ErrorBehavior where + showSL ImmediateExit = "immediate-exit" + showSL ContinuedExecution = "continued-execution" + +instance ShowSL ReasonUnknown where + showSL Memout = "memout" + showSL Incomplete = "incomplete" + +instance ShowSL CheckSatResponse where + showSL Sat = "sat" + showSL Unsat = "unsat" + showSL Unknown = "unknown" + +instance ShowSL InfoResponse where + showSL (ResponseErrorBehavior x) = ":error-behavior " ++ showSL x + showSL (ResponseName s) = ":name " ++ s + showSL (ResponseAuthors s) = ":authors " ++ s + showSL (ResponseVersion s) = ":version" ++ s + showSL (ResponseReasonUnknown x) = ":reason-unknown " ++ showSL x + showSL (ResponseAssertionStackLevels n) = ":assertion-stack-levels " ++ show n + showSL (ResponseAttribute x) = showSL x + +instance ShowSL ValuationPair where + showSL (ValuationPair term1 term2) = + "(" ++ showSL term1 ++ " " ++ showSL term2 ++ ")" + +instance ShowSL TValuationPair where + showSL (TValuationPair str b) = "(" ++ showSymbol str ++ " " ++ showSL b ++ ")" diff --git a/Smtlib/Smtlib/Syntax/Syntax.hs b/Smtlib/Smtlib/Syntax/Syntax.hs new file mode 100644 --- /dev/null +++ b/Smtlib/Smtlib/Syntax/Syntax.hs @@ -0,0 +1,272 @@ +{-| +Module : Smtlib.Parsers.CommandsParsers +Description : Smtlib Syntax +Copyright : Rogério Pontes 2015 +License : WTFPL +Maintainer : rogerp62@outlook.com +Stability : stable + +This module contains The syntax to create commands and responses. + +-} +module Smtlib.Syntax.Syntax where + +{- + ######################################################################### + # # + # Parser for an SMTLib2 File # + # # + ######################################################################### +-} + + +type Source = [Command] + + +data Command = SetLogic String + | SetOption Option + | SetInfo Attribute + | DeclareSort String Int + | DefineSort String [String] Sort + | DeclareConst String Sort + | DeclareFun String [Sort] Sort + | DefineFun String [SortedVar] Sort Term + | DefineFunRec String [SortedVar] Sort Term + | DefineFunsRec [FunDec] [Term] + | Push Int + | Pop Int + | Reset + | ResetAssertions + | Assert Term + | CheckSat + | CheckSatAssuming [Term] + | GetAssertions + | GetModel + | GetProof + | GetUnsatCore + | GetUnsatAssumptions + | GetValue [Term] + | GetAssignment + | GetOption String + | GetInfo InfoFlags + | Echo String + | Exit + deriving (Show,Eq) + +data Option = PrintSuccess Bool + | ExpandDefinitions Bool + | InteractiveMode Bool + | ProduceProofs Bool + | ProduceUnsatCores Bool + | ProduceUnsatAssumptions Bool + | ProduceModels Bool + | ProduceAssignments Bool + | ProduceAssertions Bool + | GlobalDeclarations Bool + | RegularOutputChannel String + | DiagnosticOutputChannel String + | RandomSeed Int + | Verbosity Int + | ReproducibleResourceLimit Int -- fixme + | OptionAttr Attribute + deriving (Show,Eq) + + +data InfoFlags = ErrorBehavior + | Name + | Authors + | Version + | Status + | ReasonUnknown + | AllStatistics + | AssertionStackLevels + | InfoFlags String + deriving (Show,Eq) + +-- Terms + +data Term = TermSpecConstant SpecConstant + | TermQualIdentifier QualIdentifier + | TermQualIdentifierT QualIdentifier [Term] + | TermLet [VarBinding] Term + | TermForall [SortedVar] Term + | TermExists [SortedVar] Term + | TermAnnot Term [Attribute] + deriving (Show,Eq) + + + +data VarBinding = VB String Term deriving (Show,Eq) + + + +data SortedVar = SV String Sort deriving (Show,Eq) + + + +data QualIdentifier = QIdentifier Identifier + | QIdentifierAs Identifier Sort + deriving (Show,Eq) + + +data FunDec = FunDec String [SortedVar] Sort deriving (Show,Eq) + + + + + +-- Attributes + +data AttrValue = AttrValueConstant SpecConstant + | AttrValueSymbol String + | AttrValueSexpr [Sexpr] + deriving (Show,Eq) + + + +data Attribute = Attribute String + | AttributeVal String AttrValue + deriving (Show,Eq) + +-- Identifiers + +data Index = IndexNumeral Int + | IndexSymbol String + deriving (Show,Eq) + +data Identifier = ISymbol String + | I_Symbol String [Index] deriving (Show,Eq) + +-- Sorts + +data Sort = SortId Identifier | SortIdentifiers Identifier [Sort] + deriving (Show,Eq) + + +-- S-expressions +data SpecConstant = SpecConstantNumeral Integer + | SpecConstantDecimal String + | SpecConstantHexadecimal String + | SpecConstantBinary String + | SpecConstantString String + deriving (Show, Eq) + + + +data Sexpr = SexprSpecConstant SpecConstant + | SexprSymbol String + | SexprKeyword String + | SexprSxp [Sexpr] + deriving (Show, Eq) + + + + + + + + + +{- + ######################################################################### + # # + # Command Response # + # # + ######################################################################### +-} + + + +-- CmdResponse + +data CmdResponse = CmdGenResponse GenResponse + | CmdGetInfoResponse GetInfoResponse + | CmdCheckSatResponse CheckSatResponse + | CmdGetAssertionsResponse GetAssertionsResponse + | CmdGetAssignmentResponse GetAssignmentResponse + | CmdGetProofResponse GetProofResponse + | CmdGetUnsatCoreResponse GetUnsatCoreResponse + | CmdGetUnsatAssumptionsResponse GetUnsatAssumptionsResponse + | CmdGetValueResponse GetValueResponse + | CmdGetModelResponse GetModelResponse + | CmdGetOptionResponse GetOptionResponse + | CmdEchoResponse EchoResponse + deriving (Show, Eq) + + +-- Command Responses + + +-- Gen Response + +data GenResponse = Unsupported | Success | Error String deriving (Show, Eq) + + +-- Error behavior + +data ErrorBehavior = ImmediateExit | ContinuedExecution deriving (Show, Eq) + + +-- Reason unknown + +data ReasonUnknown = Memout | Incomplete deriving (Show, Eq) + +-- Status + +data CheckSatResponse = Sat | Unsat | Unknown deriving (Show, Eq) + +-- Info Response + +type GetInfoResponse = [InfoResponse] + +data InfoResponse = ResponseErrorBehavior ErrorBehavior + | ResponseName String + | ResponseAuthors String + | ResponseVersion String + | ResponseReasonUnknown ReasonUnknown + | ResponseAssertionStackLevels Int + | ResponseAttribute Attribute + deriving (Show, Eq) + +-- Get Assertion Response + +type GetAssertionsResponse = [Term] + + +-- Get Proof Response + +type GetProofResponse = Sexpr + + +--Get Unsat Core Response + +type GetUnsatCoreResponse = [String] + +-- Get Unsat Assumptions Response + +type GetUnsatAssumptionsResponse = [Term] + +-- Get Valuation Pair + +data ValuationPair = ValuationPair Term Term deriving (Show, Eq) + + +type GetValueResponse = [ValuationPair] + +type GetModelResponse = [Command] + + +-- get Assignment Response + +data TValuationPair = TValuationPair String Bool deriving (Show, Eq) + +type GetAssignmentResponse = [TValuationPair] + + +-- Get Option Response + +type GetOptionResponse = AttrValue + +-- Echo Response + +type EchoResponse = String diff --git a/appveyor.yml b/appveyor.yml new file mode 100644 --- /dev/null +++ b/appveyor.yml @@ -0,0 +1,20 @@ +install: +- ps: | + choco install haskellplatform -version 2014.2.0.0 -y + # Haskell Platfrom package doesn't update PATH for the current shell instance + $env:Path += ";${env:ProgramFiles}\Haskell Platform\2014.2.0.0\bin" + $env:Path += ";${env:ProgramFiles}\Haskell Platform\2014.2.0.0\lib\extralibs\bin" + $env:Path += ";${env:ProgramFiles}\Haskell Platform\2014.2.0.0\mingw\bin" + $env:Path += ";.\.cabal-sandbox\bin" +- cabal sandbox init +- cabal update +- cabal install --only-dependencies --enable-tests --enable-benchmarks --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms + +build_script: +- cabal configure --enable-tests --enable-benchmarks -v2 --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms # -v2 provides useful information for debugging +- cabal build + +test_script: +- cabal test +- cabal check +- cabal sdist diff --git a/benchmarks/BenchmarkKnapsack.hs b/benchmarks/BenchmarkKnapsack.hs new file mode 100644 --- /dev/null +++ b/benchmarks/BenchmarkKnapsack.hs @@ -0,0 +1,21 @@ +module Main where + +import Criterion.Main +import qualified ToySolver.Combinatorial.Knapsack.BB as KnapsackBB +import qualified ToySolver.Combinatorial.Knapsack.DPDense as KnapsackDPDense +import qualified ToySolver.Combinatorial.Knapsack.DPSparse as KnapsackDPSparse + +main :: IO () +main = do + Criterion.Main.defaultMain + [ bgroup ("capacity" ++ show capacity) + [ bench "BB" $ nf (uncurry KnapsackBB.solve) (items, fromIntegral capacity) + , bench "DPDense" $ nf (uncurry KnapsackDPDense.solve) (items, capacity) + , bench "DPSparse" $ nf (uncurry KnapsackDPSparse.solveGeneric) (items :: [(Int,Int)], capacity :: Int) + , bench "DPSparseInt" $ nf (uncurry KnapsackDPSparse.solveInt) (items :: [(Int,Int)], capacity) + ] + | capacity <- [200, 500, 1000, 2000, 3000, 4000, 5000] + ] + +items :: (Real value, Real weight) => [(value, weight)] +items = [(398,442),(353,495),(432,370),(628,473),(170,132),(232,356),(448,374),(261,385),(110,157),(264,454),(152,147),(240,438),(405,378),(158,177),(144,160),(521,451),(371,353),(128,184),(336,475),(203,363),(243,475),(339,238),(225,168),(148,291),(427,314),(136,221),(269,384),(312,268),(353,312),(272,281),(553,486),(228,200),(280,428),(337,335),(163,156),(266,281),(534,380),(523,425),(206,186),(536,399),(358,464),(231,316),(132,105),(282,420),(606,426),(319,396),(579,439),(415,452),(239,175),(360,462),(317,450),(307,399),(73,100),(195,141),(117,112),(285,325),(272,370),(229,153),(158,112),(208,364),(252,476),(459,318),(546,410),(87,111),(430,455),(260,345),(232,161),(390,350),(177,243),(131,120),(219,193),(251,461),(460,314),(381,324),(140,159),(291,202),(224,162),(307,242),(95,101),(154,155),(396,447),(72,142),(363,461),(96,119),(330,299),(244,309),(555,399),(137,101),(465,425),(120,102),(299,375),(267,356),(325,261),(300,352),(208,152),(249,359),(163,217),(471,459),(315,222),(295,451),(151,134),(235,399),(478,361),(337,310),(472,409),(244,326),(343,480),(273,205),(458,408),(210,224),(182,131),(585,481),(250,428),(346,466),(385,414),(206,353),(410,276),(197,136),(271,280),(342,487),(315,348),(330,426),(174,262),(129,232),(108,158),(258,347),(208,269),(375,321),(117,159),(358,401),(265,486),(296,306),(125,114),(361,449),(374,348),(451,329),(275,395),(226,221),(162,152),(227,201),(171,272),(516,345),(146,128),(630,441),(260,304),(121,126),(207,200),(107,103),(274,244),(582,494),(317,377),(315,404),(166,113),(492,391),(139,218),(635,429),(164,115),(445,310),(185,142),(528,497),(510,371),(450,438),(233,296),(474,407),(356,355),(432,431),(297,443),(99,188),(256,314),(386,418),(473,446),(215,302),(205,223),(201,222),(200,289),(171,217),(246,362),(177,341),(77,132),(120,175),(227,198),(306,428),(410,498),(151,118),(333,349),(176,185),(158,260),(427,406),(508,475),(540,406),(88,148),(611,409),(608,427),(303,346),(311,334),(139,183),(154,206),(435,295),(134,244),(330,363)] diff --git a/benchmarks/BenchmarkSATLIB.hs b/benchmarks/BenchmarkSATLIB.hs --- a/benchmarks/BenchmarkSATLIB.hs +++ b/benchmarks/BenchmarkSATLIB.hs @@ -2,6 +2,7 @@ import Control.Monad import Data.Array.IArray +import Data.Default.Class import Text.Printf import Criterion.Main import qualified Language.CNF.Parse.ParseDIMACS as DIMACS @@ -13,8 +14,7 @@ case ret of Left err -> error $ show err Right cnf -> do - solver <- SAT.newSolver - SAT.setRandomFreq solver 0 + solver <- SAT.newSolverWithConfig def{ SAT.configRandomFreq = 0 } _ <- replicateM (DIMACS.numVars cnf) (SAT.newVar solver) forM_ (DIMACS.clauses cnf) $ \clause -> SAT.addClause solver (elems clause) diff --git a/benchmarks/BenchmarkSubsetSum.hs b/benchmarks/BenchmarkSubsetSum.hs new file mode 100644 --- /dev/null +++ b/benchmarks/BenchmarkSubsetSum.hs @@ -0,0 +1,49 @@ +module Main where + +import Criterion.Main +import qualified ToySolver.Combinatorial.Knapsack.BB as KnapsackBB +import qualified ToySolver.Combinatorial.Knapsack.DPDense as KnapsackDPDense +import qualified ToySolver.Combinatorial.Knapsack.DPSparse as KnapsackDPSparse +import qualified ToySolver.Combinatorial.SubsetSum as SubsetSum +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as VU + +main :: IO () +main = Criterion.Main.defaultMain $ + [ bgroup "problem1" + [ bench "KnapsackBB" $ nf (\(lhs,rhs) -> KnapsackBB.solve [(fromIntegral x, fromIntegral x) | x <- lhs] (fromIntegral rhs)) problem1 + , bench "KnapsackDPDense" $ nf (\(lhs,rhs) -> KnapsackDPDense.solve [(fromIntegral x, x) | x <- lhs] rhs) problem1 + , bench "KnapsackDPSparse" $ nf (\(lhs,rhs) -> KnapsackDPSparse.solveGeneric [(x, x) | x <- lhs] rhs) problem1 + , bench "KnapsackDPSparseInt" $ nf (\(lhs,rhs) -> KnapsackDPSparse.solveInt [(x, x) | x <- lhs] rhs) problem1 + , bench "SubsetSum" $ nf (\(lhs,rhs) -> SubsetSum.maxSubsetSum (V.fromList (map fromIntegral lhs)) (fromIntegral rhs)) problem1 + ] + ] ++ + [ bgroup ("problem2_" ++ show rhs) $ + [ bench "KnapsackBB" $ nf (\lhs -> KnapsackBB.solve [(fromIntegral x, fromIntegral x) | x <- lhs] (fromIntegral rhs)) problem2_items + ] ++ + (if rhs <= 500 then + [ bench "KnapsackDPDense" $ nf (\lhs -> KnapsackDPDense.solve [(fromIntegral x, x) | x <- lhs] rhs) problem2_items + , bench "KnapsackDPSparse" $ nf (\lhs -> KnapsackDPSparse.solveGeneric [(x, x) | x <- lhs] rhs) problem2_items + , bench "KnapsackDPSparseInt" $ nf (\lhs -> KnapsackDPSparse.solveInt [(x, x) | x <- lhs] rhs) problem2_items + ] + else + []) + ++ + [ bench "SubsetSum" $ nf (\lhs -> SubsetSum.maxSubsetSum (V.fromList (map fromIntegral lhs)) (fromIntegral rhs)) problem2_items ] + | rhs <- [50 :: Int, 100, 200, 500, 1000, 2000, 5000, 10000, 50000, 100000, 150000] + ] ++ + [ bgroup ("problem3_" ++ show rhs) $ + [ bench "KnapsackBB" $ nf (\lhs -> KnapsackBB.solve [(fromIntegral x, fromIntegral x) | x <- lhs] (fromIntegral rhs)) problem3_items + , bench "SubsetSum" $ nf (\lhs -> SubsetSum.maxSubsetSum (V.fromList (map fromIntegral lhs)) (fromIntegral rhs)) problem3_items + ] + | rhs <- [3000000, 5000000, 10000000, 50000000, 100000000, 1000000000] + ] + +problem1 :: ([Int], Int) +problem1 = ([6,2,3,8,1,8,10,4,4,10,7,2,4,4,10,10,8,10,4,8,1,4,5,6,1,6,9,7,10,6,7,3,9,6,6,7,8,1,1,1,10,1,5,10,4,1,3,4,2,9,4,7,7,2,6,10,8,6,5,4,1,2,2,1,2,3,7,7,2,6,1,3,4,6,4,2,1,8,1,4,3,7,4,3,9,4,4,10,5,7,4,4,4,6,10,1,7,2,4,3,5,5,1,5,3,1,9,5,8,2,5,10,1,9,10,4,7,10,1,2,4,2,8,5,6,1,1,5,3,1,3,8,9,5,2,9,5,1,5,4,8,6,4,9,2,1,2,3,9,6,8,5,9,9,9,2,2,8,7,1,1,2,7,6,5,5,2,8,4,3,6,4,5,6,6,3,1,4,2,6,3,10,5,4,9,3,7,2,3,3,3,10,9,9,10,7,8,3,2,2,7,8,8,10,9,1,1,4,3,10,8,7,9,4,5,5,1,7,8,7,6,3,1,5,10,8,7,1,10,4,8,3,7,8,3,10,10,7,1,1,5,6,5,3,10,9,8,3,9,3,3,7,10,3,6,3,1,3,5,7,10,9,4,6,10,4,5,5,7,1,5,8,8,4,1,10,10,3,6,2,8,1,7,2,7,7,1,1,2,10,4,2,5,3,7,2,4,1,6,2,9,10,9,9,2,5,2,5,7,5,9,9,2,10,2,7,6,8,5,8,6,1,5,2,2,4,1,4,3,9,4,4,4,5,8,3,4,1,4,1,5,5,1,3,5,8,7,9,2,1,1,5,1,4,7,10,8,10,3,8,8,5,10,1,5,3,8,6,8,3,6,8,6,10,4,2,5,7,10,4,10,6,4,8,1,9,1,9,7,3,7,3,1,10,8,8,4,8,4,5,7,8,7,6,2,3,6,1,7,10,7,1,6,6,1,5,2,4,1,5,5,2,2,4,10,5,5,3,4,8,4,3,4,9,3,4,5,8,5,9,10,9,9,4,9,6,4,3,6,9,1,2,1,6,4,5,3,9,6,4,8,9,3,3,9,7,9,5,3,8,3,9,2,6,4,10,6,1,2,6,4,1,5,10,3,9,7,1,4,2,8,9,1,3,3,6,2,1,1,5,1,8,1,2,9,10,8,1,2,2,5,4,10,2,7,4,8,2,1,2,1,2,2,2,7,3,9,7,5,7,7,3,9,7,4,1,2,8,1,3,4,1,7,2,10,10,10,1,6,10,2,6,1,4,7,8,7,5,1,2,2,7,1,9,1,2,2,8,1,8,7,2,7,3,9,6,5,1,10,4,2,9,3,3,8,6,4,8,7,7,9,2,1,6,7,1,6,10,3,5,4,8,7,1,10,10,6,5,1,9,2,4,6,9,6,5,2,8,5,9,8,9,3,8,5,9,6,1,1,5,7,5,9,8,1,1,3,5,4,8,4,6,2,8,1,8,7,7,5,9,2,8,2,10,9,1,7,4,6,7,8,10,10], 75) + +problem2_items :: [Int] +problem2_items = [153,170,128,167,178,158,162,142,134,186,141,178,104,178,121,149,111,175,191,163,141,135,157,128,109,136,127,133,188,132,127,109,169,124,158,128,182,121,147,124,198,127,179,156,184,176,134,170,137,168,192,171,158,117,156,138,112,177,152,168,121,129,196,167,131,132,113,151,117,159,121,147,153,155,195,171,159,188,194,149,184,192,199,183,111,155,187,183,198,194,121,172,118,104,171,109,150,160,104,189,119,102,133,197,175,181,114,193,199,163,157,110,175,151,112,142,121,144,191,101,111,103,126,106,109,113,113,191,186,103,153,138,120,166,159,197,159,136,180,187,185,120,158,150,128,106,195,163,153,144,107,174,199,143,112,145,140,196,105,117,181,120,159,114,101,115,186,158,121,121,109,120,155,194,136,164,132,144,182,163,191,194,126,190,146,138,188,178,152,170,198,156,195,150,153,192,159,200,143,167,124,130,165,110,116,178,159,145,188,192,170,173,108,120,156,123,119,175,130,149,129,124,114,163,167,171,148,164,151,166,122,183,148,180,180,159,181,153,132,169,164,128,195,112,182,132,167,168,127,134,108,157,104,200,130,179,187,187,112,142,112,162,188,169,124,110,111,170,134,136,104,147,167,153,172,174,195,159,131,107,151,179,114,100,167,157,133,167,175,100,154,150,128,139,150,174,117,177,192,187,171,174,168,184,187,173,167,134,179,175,178,151,196,123,183,174,136,141,171,105,173,173,167,100,186,120,187,138,106,160,181,141,178,180,164,102,153,165,136,100,172,151,158,169,142,164,104,179,117,173,146,172,114,196,142,111,199,194,118,140,189,187,198,171,127,184,113,139,182,179,199,113,113,189,111,182,169,145,182,149,100,197,193,132,196,128,169,180,122,158,125,176,190,141,140,182,149,157,185,104,188,118,165,199,134,143,186,104,127,158,102,142,187,176,172,187,112,119,200,113,193,124,142,141,137,151,181,155,174,154,159,171,124,122,103,185,182,144,108,156,170,188,140,177,119,148,108,180,193,133,136,144,174,195,198,166,186,133,102,132,183,151,164,182,172,158,109,189,152,190,164,105,160,188,164,108,187,161,162,191,168,105,141,199,182,141,184,104,160,187,101,193,160,120,186,118,163,150,105,111,167,122,118,153,132,127,131,104,164,121,179,167,118,180,174,135,136,181,123,102,118,184,104,166,188,175,133,173,187,165,168,184,123,185,131,143,183,163,112,137,125,154,124,186,158,134,149,145,127,124,121,135,113,191,120,162,185,115,189,101,136,182,182,186,147,123,113,105,198,181,192,135,124,194,183,181,134,128,138,194,184,118,113,121,176,152,188,131,152,124,179,136,176,200,125,164,110,147,194,107,164,199,132,117,196,104,115,165,189,150,134,178,186,171,124,195,146,168,127,102,112,129,182,107,196,193,131,144,121,173,196,171,108,168,124,106,175,110,110,195,200,181,186,186,155,130,150,154,176,105,119,191,110,138,180,175,183,117,189,192,192,179,169,197,131,130,142,193,164,150,152,129,135,114,119,124,144,123,187,129,116,120,108,112,188,189,191,161,103,138,108,114,191,180,107,159,130,174,121,153,187,109,145,194,188,114,108,154,141,130,189,180,158,177,122,160,182,126,164,131,161,115,185,182,109,116,188,118,157,178,152,124,144,149,173,130,155,137,172,153,145,145,195,153,189,106,131,155,188,105,121,165,138,197,119,129,200,128,185,177,198,154,147,144,102,195,141,176,156,176,130,169,118,130,148,107,146,102,194,135,182,154,136,118,146,102,170,185,152,131,165,124,135,132,115,187,200,120,119,183,119,163,174,179,155,153,115,144,104,116,113,160,103,172,130,188,152,185,137,172,134,187,130,140,134,187,146,145,118,137,181,129,149,183,111,181,148,188,126,131,147,154,175,183,122,140,180,108,126,127,122,131,103,195,100,102,167,121,198,160,154,198,134,119,141,149,183,131,188,141,154,193,170,174,163,106,140,152,153,120,169,145,164,168,188,140,116,185,158,192,195,139,122,149,188,120,133,182,171,162,195,182,144,135,167,142,192,169,125,134,102,189,183,157,132,186,174,139,187,149,119,155,113,115,187,188,197,146,159,192,135,138,167,170,125,196,142,143,153,191,144,101,127,130,163,173,150,172,191,171,158,141,185,191,189,184,149,173,194,197,160,139,137,163,110,110,171,165,166,107,161,112,193,158,174,196,122,140,149,100,176,196,200,141,122,187,148,158,148,164,118,135,175,104,180,110,164,199,180,111] + +problem3_items :: [Int] +problem3_items = [207486,278718,392484,332630,124581,307649,132267,136091,375212,163415,164347,430138,212508,309206,215276,251377,491250,373538,307637,447782,240424,461022,357034,223503,144424,207864,284687,420511,153358,321780,330369,369032,135725,268285,150930,383988,129493,281960,474921,257163,373045,223252,331242,411113,352001,351171,487540,489552,327939,469661,113153,340686,371278,470801,213710,446593,387688,231485,395898,459990,364795,399479,217801,246079,452483,446148,192388,403245,297280,271177,143554,232687,449863,104797,358276,468307,453129,219370,190587,415669,430833,331924,138190,359822,267972,376306,366836,421704,465564,209707,469491,397631,472458,167151,485050,165291,484372,251168,472722,468335,338020,194333,463694,263999,465139,268585,247707,173942,349507,165508,462807,398117,337302,413974,476648,468807,355557,304651,365958,193244,387236,484118,278334,258536,446833,152882,383133,486581,219227,459770,387769,387446,476125,277867,486709,248116,257316,130993,185829,417723,170028,198402,372810,182034,407229,366088,372362,383881,352151,114654,443216,447015,498825,459860,139855,192453,338995,321434,379652,481859,416264,105290,402806,457987,169685,252935,310167,268636,241850,100309,226297,191182,188723,374562,320544,243511,103823,426076,412436,468122,464664,316622,201015,229608,154615,412154,112874,369969,341732,304808,246714,290454,387280,303884,171132,193237,223693,488723,308389,181564,346151,368835,436496,353691,453094,355662,455065,137786,249900,113112,191444,407414,452547,168760,134902,162105,406871,450030,381171,378906,338574,157057,141305,186765,234688,375256,475105,491134,334671,431456,365210,118028,148280,330723,172051,258041,117355,205889,495549,493055,154613,162961,379075,196528,190625,423150,175660,375023,289422,237142,463494,235678,434029,327281,445674,369632,458219,388482,212423,372783,180349,335692,267192,448579,330522,313152,369572,426534,248974,222225,292740,284119,132210,429853,105306,352128,122707,472220,134357,285449,275075,248019,412536,179249,280860,294280,211022,168139,218128,139694,322893,121994,199188,100946,162961,453924,149571,364564,460145,495353,458575,213335,379299,275863,499164,274562,498522,321663,398349,318770,280071,331862,416142,308365,357140,319125,453961,480139,457347,377016,390537,196520,362845,154020,349537,385398,489602,423343,406602,123196,125568,417019,445758,458457,426268,452946,484910,448836,433729,324834,245734,380743,331514,157686,252577,428253,367083,471968,107156,427005,338277,262113,243864,269615,101192,170263,377730,270319,453471,391486,312811,443293,442349,487380,275884,440150,401134,166965,219570,104692,122358,120122,123715,498602,481952,347054,139916,401685,128200,149526,379371,331212,255522,159711,451272,156166,128210,211342,406991,366052,465497,100935,409995,280758,196996,397580,302005,480820,411628,348585,176772,111313,325528,411155,464260,347850,381752,259870,467789,477848,364054,436910,140876,134519,298893,325424,297696,184711,489607,338680,148571,443567,121034,322846,266345,222726,407504,414860,263524,434754,480910,207578,100518,347880,491921,134422,491674,182404,272279,444586,208971,192320,105950,157957,494658,205049,387026,339336,120353,383788,112304,275220,173269,169935,459692,410554,192883,175441,335000,222520,191763,302031,384352,274792,329574,103181,355560,127196,398565,417460,435428,451061,142796,101625,430071,353206,195934,364794,289998,467835,432256,288010,180436,460457,254518,387047,302439,152503,382526,152151,276423,450924,258088,322662,417620,344560,375094,395000,422076,366038,377494,332132,130406,229975,356346,203391,341025,283338,482403,336858,381023,438744,498121,176731,283221,449347,203945,480157,116567,198402,273210,258412,409135,348131,293673,409130,289279,302852,483872,177765,278125,486131,323631,392250,148731,352894,462025,394209,218092,400875,199282,318878,469669,396214,444880,220890,461749,284621,248745,456192,258819,103823,338314,191114,424112,268203,102427,267158,388420,239238,490769,371313,402759,162233,350904,127891,183998,123101,490827,176694,447670,397616,394469,323341,288604,297557,127951,218476,326345,354291,222402,384715,121194,405907,225630,363196,478621,252732,207491,186871,272663,230365,292240,227611,261584,362554,315000,179303,421116,270981,116340,483614,442535,446465,227958,343310,222133,307940,497624,113907,309642,126127,144524,222534,353109,486518,466031,162406,206819,154028,175422,384428,317852,489360,361660,173693,113270,349328,375476,374206,204314,450394,225912,201302,182999,356797,245752,398634,117138,177539,378892,331514,155500,399268,275638,173379,493859,142698,377633,269203,449070,269981,447674,413623,371651,156798,407610,249336,405543,236377,244941,169824,100922,156824,137972,155013,295926,361560,486317,435873,120864,141297,167198,425783,188249,441102,445107,395797,264716,471431,497153,136545,301877,354308,462237,227129,456740,472932,459907,391637,497929,399034,143258,411335,426067,470653,188964,108327,111293,336893,137013,194771,372853,329908,171847,194233,106477,380103,274446,450426,206112,415014,379602,439951,340846,272306,470527,133107,115415,259145,122312,338325,369567,470474,451959,338705,437051,452385,216707,449479,151907,428835,180424,241719,151597,244448,130373,430986,229168,459204,179617,199849,237246,306232,397934,243576,285789,277656,377599,156077,499688,231424,262394,415528,280356,234538,227091,345733,453131,217177,146006,333356,200052,470346,474708,168370,151077,371419,330227,231800,325079,199910,471947,493645,308292,122563,399958,162229,429168,474283,236945,140724,209683,388777,182064,136415,372367,400126,278111,369922,289321,113753,438008,324773,321419,188484,475891,411146,233377,175517,289258,339540,214601,176171,423047,483095,171064,462917,189709,303239,312276,204826,241605,155775,128859,326257,468421,236736,207392,333266,409611,286615,207848,314478,269296,343981,421504,353118,385327,367074,401314,281485,462831,279112,306293,198716,101333,418468,215057,346864,161105,159666,471781,112554,120145,230864,391123,227569,324701,277482,368782,280997,458626,452233,234281,391069,144662,336217,434198,481102,133920,263594,214746,471616,419015,223479,138342,462079,447443,134762,331833,429154,117219,285914,250377,118305,101881,498060,218401,213614,223017,300566,158469,121267,286310,301055,107407,178755,141092,456251,166112,402955,408829,439204,426501,480440,304923,201539,445094,205879,162844,228806,103807,427620,202098,209810,139248,424057,348761,109339,347667,374073,175100,495918,112570,135682,310236,407785,167419,257810,156857,261235,443784,352624,110542,224061,222757,253310,146420,411890,365520,297378,401917,191628,105592,316024,490318,492512,487964,433825,156132,126204,105729,467611,496444,457501,265183,195022,278749,439519,322335,137504,427583,245468,366402,460217,356020,274419,156097,205850,436420,128530,473145,479112,473688,169695,326903,290616,203165,453887,143601,223044,496570,366639,261971,186528,100402,285722,496695,398394,398107,473809,397183,239671,499792,214367,364772,376038,473733,324308,248931,468892,478836,244353,217797,442546,338187,247684,115001,131862] diff --git a/build_bdist_linux-i386.sh b/build_bdist_linux-i386.sh deleted file mode 100644 --- a/build_bdist_linux-i386.sh +++ /dev/null @@ -1,27 +0,0 @@ -#!/bin/bash -export CABALVER=1.18 -export GHCVER=7.8.4 - -sudo add-apt-repository -y ppa:hvr/ghc -sudo apt-get update - -sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER -export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:~/.cabal/bin:$PATH - -sudo apt-get install happy-1.19.4 alex-3.1.3 -export PATH=/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:$PATH - -cabal sandbox init -cabal update -cabal install --only-dependencies --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms -cabal configure --disable-shared --ghc-options="-static -optl-static -optl-pthread" --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms -cabal build - -VER=`ghc -e ":m + Control.Monad Distribution.Package Distribution.PackageDescription Distribution.PackageDescription.Parse Distribution.Verbosity Data.Version" -e 'putStrLn =<< liftM (showVersion . pkgVersion . package . packageDescription) (readPackageDescription silent "toysolver.cabal")'` - -PKG=toysolver-$VER-linux-i386 - -rm -r $PKG -mkdir $PKG -cp dist/build/htc/htc dist/build/knapsack/knapsack dist/build/lpconvert/lpconvert dist/build/nqueens/nqueens dist/build/pbconvert/pbconvert dist/build/sudoku/sudoku dist/build/toyfmf/toyfmf dist/build/toysat/toysat dist/build/toysolver/toysolver $PKG/ -tar Jcf $PKG.tar.xz $PKG --owner=sakai --group=sakai diff --git a/build_bdist_linux-x86_64.sh b/build_bdist_linux-x86_64.sh deleted file mode 100644 --- a/build_bdist_linux-x86_64.sh +++ /dev/null @@ -1,27 +0,0 @@ -#!/bin/bash -export CABALVER=1.18 -export GHCVER=7.8.4 - -sudo add-apt-repository -y ppa:hvr/ghc -sudo apt-get update - -sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER -export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:~/.cabal/bin:$PATH - -sudo apt-get install happy-1.19.4 alex-3.1.3 -export PATH=/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:$PATH - -cabal sandbox init -cabal update -cabal install --only-dependencies --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms -cabal configure --disable-shared --ghc-options="-static -optl-static -optl-pthread" --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms -cabal build - -VER=`ghc -e ":m + Control.Monad Distribution.Package Distribution.PackageDescription Distribution.PackageDescription.Parse Distribution.Verbosity Data.Version" -e 'putStrLn =<< liftM (showVersion . pkgVersion . package . packageDescription) (readPackageDescription silent "toysolver.cabal")'` - -PKG=toysolver-$VER-linux-x86_64 - -rm -r $PKG -mkdir $PKG -cp dist/build/htc/htc dist/build/knapsack/knapsack dist/build/lpconvert/lpconvert dist/build/nqueens/nqueens dist/build/pbconvert/pbconvert dist/build/sudoku/sudoku dist/build/toyfmf/toyfmf dist/build/toysat/toysat dist/build/toysolver/toysolver $PKG/ -tar Jcf $PKG.tar.xz $PKG --owner=sakai --group=sakai diff --git a/build_bdist_linux.sh b/build_bdist_linux.sh new file mode 100644 --- /dev/null +++ b/build_bdist_linux.sh @@ -0,0 +1,34 @@ +#!/bin/bash +export CABALVER=1.22 +export GHCVER=7.10.3 + +sudo add-apt-repository -y ppa:hvr/ghc +sudo apt-get update + +sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER +export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:~/.cabal/bin:$PATH + +sudo apt-get install happy-1.19.4 alex-3.1.3 +export PATH=/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:$PATH + +cabal sandbox init +cabal update +cabal install --only-dependencies --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms +#cabal configure --disable-shared --ghc-options="-static -optl-static -optl-pthread" --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms +cabal configure -fLinuxStatic -f-UseHaskeline --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms +cabal build + +VER=`ghc -ignore-dot-ghci -e ":m + Control.Monad Distribution.Package Distribution.PackageDescription Distribution.PackageDescription.Parse Distribution.Verbosity Data.Version" -e 'putStrLn =<< liftM (showVersion . pkgVersion . package . packageDescription) (readPackageDescription silent "toysolver.cabal")'` +OS=`ghc -ignore-dot-ghci -e ":m +System.Info" -e "putStrLn os"` +ARCH=`ghc -ignore-dot-ghci -e ":m +System.Info" -e "putStrLn arch"` + +PKG=toysolver-${VER}-${OS}-${ARCH} + +rm -r $PKG +mkdir $PKG +mkdir $PKG/bin +cp dist/build/htc/htc dist/build/knapsack/knapsack dist/build/lpconvert/lpconvert dist/build/nonogram/nonogram dist/build/nqueens/nqueens dist/build/pbconvert/pbconvert dist/build/sudoku/sudoku dist/build/toyfmf/toyfmf dist/build/toysat/toysat dist/build/toysmt/toysmt dist/build/toysolver/toysolver $PKG/bin +strip $PKG/bin/* +cp -a samples $PKG/ +cp COPYING-GPL README.md CHANGELOG.markdown $PKG/ +tar Jcf $PKG.tar.xz $PKG --owner=sakai --group=sakai diff --git a/build_bdist_macos.sh b/build_bdist_macos.sh --- a/build_bdist_macos.sh +++ b/build_bdist_macos.sh @@ -1,16 +1,22 @@ #!/bin/bash +export MACOSX_DEPLOYMENT_TARGET=10.6 + cabal sandbox init cabal update cabal install --only-dependencies --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms -cabal configure --ghc-options="-optl-mmacosx-version-min=10.6" --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms +cabal configure --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms cabal build -VER=`ghc -e ":m + Control.Monad Distribution.Package Distribution.PackageDescription Distribution.PackageDescription.Parse Distribution.Verbosity Data.Version" -e 'putStrLn =<< liftM (showVersion . pkgVersion . package . packageDescription) (readPackageDescription silent "toysolver.cabal")'` +VER=`ghc -ignore-dot-ghci -e ":m + Control.Monad Distribution.Package Distribution.PackageDescription Distribution.PackageDescription.Parse Distribution.Verbosity Data.Version" -e 'putStrLn =<< liftM (showVersion . pkgVersion . package . packageDescription) (readPackageDescription silent "toysolver.cabal")'` PKG=toysolver-$VER-macos rm -r $PKG mkdir $PKG -cp dist/build/htc/htc dist/build/knapsack/knapsack dist/build/lpconvert/lpconvert dist/build/nqueens/nqueens dist/build/pbconvert/pbconvert dist/build/sudoku/sudoku dist/build/toyfmf/toyfmf dist/build/toysat/toysat dist/build/toysolver/toysolver $PKG/ +mkdir $PKG/bin +cp dist/build/htc/htc dist/build/knapsack/knapsack dist/build/lpconvert/lpconvert dist/build/nonogram/nonogram dist/build/nqueens/nqueens dist/build/pbconvert/pbconvert dist/build/sudoku/sudoku dist/build/toyfmf/toyfmf dist/build/toysat/toysat dist/build/toysmt/toysmt dist/build/toysolver/toysolver $PKG/bin +strip $PKG/bin/* +cp -a samples $PKG/ +cp COPYING-GPL README.md CHANGELOG.markdown $PKG/ zip -r $PKG.zip $PKG diff --git a/build_bdist_maxsat_evaluation.sh b/build_bdist_maxsat_evaluation.sh new file mode 100644 --- /dev/null +++ b/build_bdist_maxsat_evaluation.sh @@ -0,0 +1,44 @@ +#!/bin/bash +export CABALVER=1.22 +export GHCVER=7.10.3 + +sudo add-apt-repository -y ppa:hvr/ghc +sudo apt-get update + +sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER +export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:~/.cabal/bin:$PATH + +sudo apt-get install happy-1.19.4 alex-3.1.3 +export PATH=/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:$PATH + +cabal sandbox init +cabal update +cabal install --only-dependencies +#cabal configure --disable-shared --ghc-options="-static -optl-static -optl-pthread" +cabal configure -fLinuxStatic -fForceChar8 +cabal build + +PKG=toysat-maxsat`date +%Y`-`date +%Y%m%d`-`git rev-parse --short HEAD` +rm -r $PKG +mkdir $PKG +cp dist/build/toysat/toysat $PKG/toysat_main +cp misc/maxsat/toysat/README.md misc/maxsat/toysat/toysat $PKG/ +tar Jcf $PKG.tar.xz $PKG --owner=sakai --group=sakai + +if [ ! -f ubcsat-beta-12-b18.tar.gz ]; then + wget http://ubcsat.dtompkins.com/downloads/ubcsat-beta-12-b18.tar.gz +fi +rm -r ubcsat-beta-12-b18 +mkdir ubcsat-beta-12-b18 +cd ubcsat-beta-12-b18 +tar zxf ../ubcsat-beta-12-b18.tar.gz +gcc -Wall -O3 -static -o ubcsat src/adaptnovelty.c src/algorithms.c src/ddfw.c src/derandomized.c src/g2wsat.c src/gsat-tabu.c src/gsat.c src/gwsat.c src/hsat.c src/hwsat.c src/irots.c src/jack.c src/mt19937ar.c src/mylocal.c src/novelty+p.c src/novelty.c src/parameters.c src/paws.c src/random.c src/reports.c src/rgsat.c src/rnovelty.c src/rots.c src/samd.c src/saps.c src/sparrow.c src/ubcsat-help.c src/ubcsat-internal.c src/ubcsat-io.c src/ubcsat-mem.c src/ubcsat-reports.c src/ubcsat-time.c src/ubcsat-triggers.c src/ubcsat-version.c src/ubcsat.c src/vw.c src/walksat-tabu.c src/walksat.c src/weighted.c -lm +cd .. + +PKG=toysat_ls-maxsat`date +%Y`-`date +%Y%m%d`-`git rev-parse --short HEAD` +rm -r $PKG +mkdir $PKG +cp dist/build/toysat/toysat $PKG/toysat_main +cp misc/maxsat/toysat_ls/README.md misc/maxsat/toysat_ls/toysat_ls $PKG/ +cp ubcsat-beta-12-b18/ubcsat $PKG/ +tar Jcf $PKG.tar.xz $PKG --owner=sakai --group=sakai diff --git a/build_bdist_pb_evaluation.sh b/build_bdist_pb_evaluation.sh new file mode 100644 --- /dev/null +++ b/build_bdist_pb_evaluation.sh @@ -0,0 +1,26 @@ +#!/bin/bash +export CABALVER=1.22 +export GHCVER=7.10.3 + +sudo add-apt-repository -y ppa:hvr/ghc +sudo apt-get update + +sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER +export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:~/.cabal/bin:$PATH + +sudo apt-get install happy-1.19.4 alex-3.1.3 +export PATH=/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:$PATH + +cabal sandbox init +cabal update +cabal install --only-dependencies +#cabal configure --disable-shared --ghc-options="-static -optl-static -optl-pthread" +cabal configure -fLinuxStatic -fForceChar8 +cabal build + +PKG=toysat-pb`date +%Y`-`date +%Y%m%d`-`git rev-parse --short HEAD` +rm -r $PKG +mkdir $PKG +cp dist/build/toysat/toysat $PKG/ +cp misc/pb/README.md $PKG/ +tar Jcf $PKG.tar.xz $PKG --owner=sakai --group=sakai diff --git a/build_bdist_win32.sh b/build_bdist_win32.sh --- a/build_bdist_win32.sh +++ b/build_bdist_win32.sh @@ -1,25 +1,40 @@ #!/bin/bash +HPVER=7.10.3 +HPARCH=i386 +export WINEPREFIX=~/.wine-hp-$HPARCH +GHC_PATH=$WINEPREFIX/drive_c/Program\ Files\ \(x86\)/Haskell\ Platform/$HPVER/bin/ghc.exe +ARCH=win32 +BUILDDIR=dist-$ARCH + sudo apt-get update sudo apt-get install wine wget cabal-install -wget https://www.haskell.org/platform/download/2014.2.0.0/HaskellPlatform-2014.2.0.0-i386-setup.exe -wine HaskellPlatform-2014.2.0.0-i386-setup.exe +if [ ! -f "$GHC_PATH" ]; then + wget -c https://www.haskell.org/platform/download/$HPVER/HaskellPlatform-$HPVER-$HPARCH-setup.exe + wine HaskellPlatform-$HPVER-$HPARCH-setup.exe /S +fi # https://plus.google.com/+MasahiroSakai/posts/RTXUt5MkVPt #wine cabal update cabal update -cp -a ~/.cabal/packages ~/.wine/drive_c/users/`whoami`/Application\ Data/cabal/ +mkdir -p $WINEPREFIX/drive_c/users/`whoami`/Application\ Data/cabal +cp -a ~/.cabal/packages $WINEPREFIX/drive_c/users/`whoami`/Application\ Data/cabal/ wine cabal sandbox init wine cabal install --only-dependencies --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms -wine cabal configure --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms -wine cabal build +wine cabal clean --builddir=$BUILDDIR +wine cabal configure --builddir=$BUILDDIR --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms +wine cabal build --builddir=$BUILDDIR -VER=`wine ghc -e ":m + Control.Monad Distribution.Package Distribution.PackageDescription Distribution.PackageDescription.Parse Distribution.Verbosity Data.Version System.IO" -e "hSetBinaryMode stdout True" -e 'putStrLn =<< liftM (showVersion . pkgVersion . package . packageDescription) (readPackageDescription silent "toysolver.cabal")'` +VER=`wine ghc -ignore-dot-ghci -e ":m + Control.Monad Distribution.Package Distribution.PackageDescription Distribution.PackageDescription.Parse Distribution.Verbosity Data.Version System.IO" -e "hSetBinaryMode stdout True" -e 'putStrLn =<< liftM (showVersion . pkgVersion . package . packageDescription) (readPackageDescription silent "toysolver.cabal")'` -PKG=toysolver-$VER-win32 +PKG=toysolver-$VER-$ARCH rm -r $PKG mkdir $PKG -cp dist/build/htc/htc.exe dist/build/knapsack/knapsack.exe dist/build/lpconvert/lpconvert.exe dist/build/nqueens/nqueens.exe dist/build/pbconvert/pbconvert.exe dist/build/sudoku/sudoku.exe dist/build/toyfmf/toyfmf.exe dist/build/toysat/toysat.exe dist/build/ToySolver/toysolver.exe $PKG/ +mkdir $PKG/bin +cp $BUILDDIR/build/htc/htc.exe $BUILDDIR/build/knapsack/knapsack.exe $BUILDDIR/build/lpconvert/lpconvert.exe $BUILDDIR/build/nonogram/nonogram.exe $BUILDDIR/build/nqueens/nqueens.exe $BUILDDIR/build/pbconvert/pbconvert.exe $BUILDDIR/build/sudoku/sudoku.exe $BUILDDIR/build/toyfmf/toyfmf.exe $BUILDDIR/build/toysat/toysat.exe $BUILDDIR/build/toysmt/toysmt.exe $BUILDDIR/build/ToySolver/toysolver.exe $PKG/bin/ +wine strip $PKG/bin/*.exe +cp -a samples $PKG/ +cp COPYING-GPL README.md CHANGELOG.markdown $PKG/ zip -r $PKG.zip $PKG diff --git a/build_bdist_win64.sh b/build_bdist_win64.sh --- a/build_bdist_win64.sh +++ b/build_bdist_win64.sh @@ -1,25 +1,40 @@ #!/bin/bash +HPVER=7.10.3 +HPARCH=x86_64 +export WINEPREFIX=~/.wine-hp-$HPARCH +GHC_PATH=$WINEPREFIX/drive_c/Program\ Files/Haskell\ Platform/$HPVER/bin/ghc.exe +ARCH=win64 +BUILDDIR=dist-$ARCH + sudo apt-get update sudo apt-get install wine wget cabal-install -wget https://www.haskell.org/platform/download/2014.2.0.0/HaskellPlatform-2014.2.0.0-x86_64-setup.exe -wine HaskellPlatform-2014.2.0.0-x86_64-setup.exe +if [ ! -f "$GHC_PATH" ]; then + wget -c https://www.haskell.org/platform/download/$HPVER/HaskellPlatform-$HPVER-$HPARCH-setup.exe + wine HaskellPlatform-$HPVER-$HPARCH-setup.exe /S +fi # https://plus.google.com/+MasahiroSakai/posts/RTXUt5MkVPt #wine cabal update cabal update -cp -a ~/.cabal/packages ~/.wine/drive_c/users/`whoami`/Application\ Data/cabal/ +mkdir -p $WINEPREFIX/drive_c/users/`whoami`/Application\ Data/cabal +cp -a ~/.cabal/packages $WINEPREFIX/drive_c/users/`whoami`/Application\ Data/cabal/ wine cabal sandbox init wine cabal install --only-dependencies --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms -wine cabal configure --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms -wine cabal build +wine cabal clean --builddir=$BUILDDIR +wine cabal configure --builddir=$BUILDDIR --flag=BuildToyFMF --flag=BuildSamplePrograms --flag=BuildMiscPrograms +wine cabal build --builddir=$BUILDDIR -VER=`wine ghc -e ":m + Control.Monad Distribution.Package Distribution.PackageDescription Distribution.PackageDescription.Parse Distribution.Verbosity Data.Version System.IO" -e "hSetBinaryMode stdout True" -e 'putStrLn =<< liftM (showVersion . pkgVersion . package . packageDescription) (readPackageDescription silent "toysolver.cabal")'` +VER=`wine ghc -ignore-dot-ghci -e ":m + Control.Monad Distribution.Package Distribution.PackageDescription Distribution.PackageDescription.Parse Distribution.Verbosity Data.Version System.IO" -e "hSetBinaryMode stdout True" -e 'putStrLn =<< liftM (showVersion . pkgVersion . package . packageDescription) (readPackageDescription silent "toysolver.cabal")'` -PKG=toysolver-$VER-win64 +PKG=toysolver-$VER-$ARCH rm -r $PKG mkdir $PKG -cp dist/build/htc/htc.exe dist/build/knapsack/knapsack.exe dist/build/lpconvert/lpconvert.exe dist/build/nqueens/nqueens.exe dist/build/pbconvert/pbconvert.exe dist/build/sudoku/sudoku.exe dist/build/toyfmf/toyfmf.exe dist/build/toysat/toysat.exe dist/build/ToySolver/toysolver.exe $PKG/ +mkdir $PKG/bin +cp $BUILDDIR/build/htc/htc.exe $BUILDDIR/build/knapsack/knapsack.exe $BUILDDIR/build/lpconvert/lpconvert.exe $BUILDDIR/build/nonogram/nonogram.exe $BUILDDIR/build/nqueens/nqueens.exe $BUILDDIR/build/pbconvert/pbconvert.exe $BUILDDIR/build/sudoku/sudoku.exe $BUILDDIR/build/toyfmf/toyfmf.exe $BUILDDIR/build/toysat/toysat.exe $BUILDDIR/build/toysmt/toysmt.exe $BUILDDIR/build/ToySolver/toysolver.exe $PKG/bin/ +wine strip $PKG/bin/*.exe +cp -a samples $PKG/ +cp COPYING-GPL README.md CHANGELOG.markdown $PKG/ zip -r $PKG.zip $PKG diff --git a/lpconvert/lpconvert.hs b/lpconvert/lpconvert.hs --- a/lpconvert/lpconvert.hs +++ b/lpconvert/lpconvert.hs @@ -14,6 +14,7 @@ module Main where import Data.Char +import Data.Default.Class import Data.Maybe import qualified Data.Version as V import System.Environment @@ -150,7 +151,7 @@ writeLP :: [Flag] -> MIP.Problem -> IO () writeLP o mip = do let mip2smtOpt = - MIP2SMT.defaultOptions + def { MIP2SMT.optSetLogic = listToMaybe [logic | SMTSetLogic logic <- o] , MIP2SMT.optCheckSAT = not (SMTNoCheck `elem` o) , MIP2SMT.optProduceModel = not (SMTNoProduceModel `elem` o) diff --git a/misc/maxsat/toysat/README.md b/misc/maxsat/toysat/README.md new file mode 100644 --- /dev/null +++ b/misc/maxsat/toysat/README.md @@ -0,0 +1,26 @@ +toysat +====== + +Usage +----- + + ./toysat [file.cnf|file.wcnf] + +Algorithm +--------- + +We have implemented BCD2 algorithm [1] on top on our own CDCL SAT solver +'toysat' with watch-literal based cardinality constraint handler and +counter-based linear pseudo boolean constraint handler. One of the major +difference from the original BCD2 is that our implementation uses incremental +solving features of SAT solver to keep the information such as learnt clauses +in the successive invocations of SAT solver. + +References +---------- + +* [1] A. Morgado, F. Heras, and J. Marques-Silva, + Improvements to Core-Guided binary search for MaxSAT, + in Theory and Applications of Satisfiability Testing (SAT 2012), + pp. 284-297. + diff --git a/misc/maxsat/toysat/toysat b/misc/maxsat/toysat/toysat new file mode 100644 --- /dev/null +++ b/misc/maxsat/toysat/toysat @@ -0,0 +1,2 @@ +#!/bin/sh +./toysat_main +RTS -H1G -K1G -RTS --search=bcd2 --maxsat $@ diff --git a/misc/maxsat/toysat_ls/README.md b/misc/maxsat/toysat_ls/README.md new file mode 100644 --- /dev/null +++ b/misc/maxsat/toysat_ls/README.md @@ -0,0 +1,34 @@ +toysat_ls +========= + +Usage +----- + + ./toysat_ls [file.cnf|file.wcnf] + +Algorithm +--------- + +We have implemented BCD2 algorithm [1] on top on our own CDCL SAT solver +'toysat' with watch-literal based cardinality constraint handler and +counter-based linear pseudo boolean constraint handler. One of the major +difference from the original BCD2 is that our implementation uses incremental +solving features of SAT solver to keep the information such as learnt clauses +in the successive invocations of SAT solver. + +In addition to that, toysat_ls uses UBCSAT (ubcsat-beta-12-b18.tar.gz) [2] to +find compute initial solution quickly. + +References +---------- + +* [1] A. Morgado, F. Heras, and J. Marques-Silva, + Improvements to Core-Guided binary search for MaxSAT, + in Theory and Applications of Satisfiability Testing (SAT 2012), + pp. 284-297. + + +* [2] D. Tompkins and H. Hoos, UBCSAT: An implementation and experimentation + environment for SLS algorithms for SAT and MAX-SAT, in Theory and Applications + of Satisfiability Testing (2004), Springer, 2005, pp. 306-320. + diff --git a/misc/maxsat/toysat_ls/toysat_ls b/misc/maxsat/toysat_ls/toysat_ls new file mode 100644 --- /dev/null +++ b/misc/maxsat/toysat_ls/toysat_ls @@ -0,0 +1,2 @@ +#!/bin/sh +./toysat_main +RTS -H1G -K1G -RTS --maxsat --search=bcd2 --with-ubcsat=./ubcsat --ls-initial $@ diff --git a/misc/pb/README.md b/misc/pb/README.md new file mode 100644 --- /dev/null +++ b/misc/pb/README.md @@ -0,0 +1,51 @@ +Toysat submission for the Pseudo-Boolean Evaluation 2015 +======================================================== + +Usage +----- + + ./toysat +RTS -H1G -K1G -RTS --search=bcd2 file.opb + +About Solver Requirments and Optional Features +---------------------------------------------- + +Minimum Requirments + +* solve decision problems: YES +* handle 32 bit Integers: YES +* handle cardinality constraints: YES + +Optional Features + +* solve optimization problems: YES + * incomplete optimization: + * complete optimization: ✓ +* handle 64 bit Integers: YES (it can handle arbitrary integers) +* handle general pseudo-Boolean constraints: YES + +Algorithm +--------- + +We have implemented BCD2 algorithm [1] on top on our own CDCL SAT solver +'toysat' with watch-literal based cardinality constraint handler and +counter-based linear pseudo boolean constraint handler. One of the major +difference from the original BCD2 is that our implementation uses incremental +solving features of SAT solver to keep the information such as learnt clauses +in the successive invocations of SAT solver. + +Non-linear constraints and objective functions are handled by linearization +using a variant of Tseitin transformation that take the polarity into account +[2]. + +References +---------- + +* [1] A. Morgado, F. Heras, and J. Marques-Silva, + Improvements to Core-Guided binary search for MaxSAT, + in Theory and Applications of Satisfiability Testing (SAT 2012), + pp. 284-297. + + +* [2] N. Eén and N. Sörensson, + Translating pseudo-boolean constraints into SAT, Journal on Satisfiability, + Boolean Modeling and Computation, vol. 2, pp. 1-26, 2006. diff --git a/pbconvert/pbconvert.hs b/pbconvert/pbconvert.hs --- a/pbconvert/pbconvert.hs +++ b/pbconvert/pbconvert.hs @@ -14,6 +14,7 @@ module Main where import Data.Char +import Data.Default.Class import Data.Maybe import qualified Data.Version as V import System.Environment @@ -134,7 +135,7 @@ writePBFile :: [Flag] -> Either PBFile.Formula PBFile.SoftFormula -> IO () writePBFile o pb = do let mip2smtOpt = - MIP2SMT.defaultOptions + def { MIP2SMT.optSetLogic = listToMaybe [logic | SMTSetLogic logic <- o] , MIP2SMT.optCheckSAT = not (SMTNoCheck `elem` o) , MIP2SMT.optProduceModel = not (SMTNoProduceModel `elem` o) diff --git a/samples/gcnf/example.cnf b/samples/gcnf/example.cnf deleted file mode 100644 --- a/samples/gcnf/example.cnf +++ /dev/null @@ -1,8 +0,0 @@ -p cnf 7 3 -1 2 3 0 --1 2 0 --2 3 0 --3 0 -2 -3 0 --2 -3 0 --2 3 0 diff --git a/samples/lp/hoge.lp b/samples/lp/hoge.lp deleted file mode 100644 --- a/samples/lp/hoge.lp +++ /dev/null @@ -1,7 +0,0 @@ -Minimize - obj: x1 + x2 -Subject To - c1: x1 + 2 x2 + x3 = 3 -General - x1 x2 x3 -End diff --git a/samples/lp/test-2.lp b/samples/lp/test-2.lp deleted file mode 100644 --- a/samples/lp/test-2.lp +++ /dev/null @@ -1,14 +0,0 @@ -MAXIMIZE -obj: + x1 + 2 x2 + 3 x3 + x4 -SUBJECT TO -c1: - x1 + x2 + x3 + 10 x4 <= 20 -c2: + x1 - 3 x2 + x3 <= 30 -c3: + x2 - 3.5 x4 = 0 -BOUNDS -2 <= x4 <= 3 -0 <= x1 <= 40 -0 <= x2 <= +inf -0 <= x3 <= +inf -GENERALS -x4 -END diff --git a/samples/lp/test-lazy.lp b/samples/lp/test-lazy.lp deleted file mode 100644 --- a/samples/lp/test-lazy.lp +++ /dev/null @@ -1,16 +0,0 @@ -\ http://pic.dhe.ibm.com/infocenter/cosinfoc/v12r3/topic/ilog.odms.cplex.help/Content/Optimization/Documentation/Optimization_Studio/_pubskel/ps_usrmancplex2051.html -Maximize - obj: 12 x1 + 5 x2 + 15 x3 + 10 x4 -Subject To - c1: 5 x1 + x2 + 9 x3 + 12 x4 <= 15 -Lazy Constraints - l1: 2 x1 + 3 x2 + 4 x3 + x4 <= 10 - l2: 3 x1 + 2 x2 + 4 x3 + 10 x4 <= 8 -Bounds - 0 <= x1 <= 5 - 0 <= x2 <= 5 - 0 <= x3 <= 5 - 0 <= x4 <= 5 -Generals - x1 x2 x3 x4 -End diff --git a/samples/lp/test-semiint-2.lp b/samples/lp/test-semiint-2.lp deleted file mode 100644 --- a/samples/lp/test-semiint-2.lp +++ /dev/null @@ -1,14 +0,0 @@ -MINIMIZE -obj: - 2 x3 -SUBJECT TO -c1: + x2 - x1 <= 10 -c2: + x3 + x2 + x1 <= 20 -BOUNDS -2.1 <= x1 <= 30 -0 <= x2 <= +inf -2 <= x3 <= 3 -GENERALS -x1 x3 -SEMI-CONTINUOUS -x1 x3 -END diff --git a/samples/lp/test2.lp b/samples/lp/test2.lp deleted file mode 100644 --- a/samples/lp/test2.lp +++ /dev/null @@ -1,21 +0,0 @@ -\... -Maximize - obj: x1 + 2 x2 + 3 x3 + x4 -Subject To - c1: - x1 + x2 + x3 + 10 x4 <= 20 - c2: x1 - 3 x2 + x3 <= 30 - c3: x2 - 3.5 x4 = 0 - c4: x6 + x7 + x8 + x9 >= 0 -Bounds - 0 <= x1 <= 40 - -2 <= x4 <= 3 - -inf <= x5 <= +inf - 0 <= x6 <= +inf - -1 <= x7 <= +inf - -inf <= x8 <= +1 - 1 <= x9 <= +inf -General - x4 x5 x6 x7 x8 -SEMI-CONTINUOUS - x9 -End diff --git a/samples/lp/test_utf-8.lp b/samples/lp/test_utf-8.lp deleted file mode 100644 --- a/samples/lp/test_utf-8.lp +++ /dev/null @@ -1,13 +0,0 @@ -\... -Maximize - obj: ほげ + 2 x2 + 3 x3 + x4 -Subject To - c1: - ほげ + x2 + x3 + 10 x4 <= 20 - c2: ほげ - 3 x2 + x3 <= 30 - c3: x2 - 3.5 x4 = 0 -Bounds - 0 <= ほげ <= 40 - 2 <= x4 <= 3 -General - x4 -End diff --git a/samples/maxsat/FM06.cnf b/samples/maxsat/FM06.cnf deleted file mode 100644 --- a/samples/maxsat/FM06.cnf +++ /dev/null @@ -1,8 +0,0 @@ -p cnf 4 7 --1 -2 0 --1 3 0 --1 -3 0 --2 4 0 --2 -4 0 -1 0 -2 0 diff --git a/samples/mps/enlight13-2.mps b/samples/mps/enlight13-2.mps deleted file mode 100644 --- a/samples/mps/enlight13-2.mps +++ /dev/null @@ -1,1819 +0,0 @@ -NAME -OBJSENSE - MIN -ROWS - N moves - E inner_area_1 - E inner_area_2 - E inner_area_3 - E inner_area_4 - E inner_area_5 - E inner_area_6 - E inner_area_7 - E inner_area_8 - E inner_area_9 - E inner_area_10 - E inner_area_11 - E inner_area_12 - E inner_area_13 - E inner_area_14 - E inner_area_15 - E inner_area_16 - E inner_area_17 - E inner_area_18 - E inner_area_19 - E inner_area_20 - E inner_area_21 - E inner_area_22 - E inner_area_23 - E inner_area_24 - E inner_area_25 - E inner_area_26 - E inner_area_27 - E inner_area_28 - E inner_area_29 - E inner_area_30 - E inner_area_31 - E inner_area_32 - E inner_area_33 - E inner_area_34 - E inner_area_35 - E inner_area_36 - E inner_area_37 - E inner_area_38 - E inner_area_39 - E inner_area_40 - E inner_area_41 - E inner_area_42 - E inner_area_43 - E inner_area_44 - E inner_area_45 - E inner_area_46 - E inner_area_47 - E inner_area_48 - E inner_area_49 - E inner_area_50 - E inner_area_51 - E inner_area_52 - E inner_area_53 - E inner_area_54 - E inner_area_55 - E inner_area_56 - E inner_area_57 - E inner_area_58 - E inner_area_59 - E inner_area_60 - E inner_area_61 - E inner_area_62 - E inner_area_63 - E inner_area_64 - E inner_area_65 - E inner_area_66 - E inner_area_67 - E inner_area_68 - E inner_area_69 - E inner_area_70 - E inner_area_71 - E inner_area_72 - E inner_area_73 - E inner_area_74 - E inner_area_75 - E inner_area_76 - E inner_area_77 - E inner_area_78 - E inner_area_79 - E inner_area_80 - E inner_area_81 - E inner_area_82 - E inner_area_83 - E inner_area_84 - E inner_area_85 - E inner_area_86 - E inner_area_87 - E inner_area_88 - E inner_area_89 - E inner_area_90 - E inner_area_91 - E inner_area_92 - E inner_area_93 - E inner_area_94 - E inner_area_95 - E inner_area_96 - E inner_area_97 - E inner_area_98 - E inner_area_99 - E inner_area_100 - E inner_area_101 - E inner_area_102 - E inner_area_103 - E inner_area_104 - E inner_area_105 - E inner_area_106 - E inner_area_107 - E inner_area_108 - E inner_area_109 - E inner_area_110 - E inner_area_111 - E inner_area_112 - E inner_area_113 - E inner_area_114 - E inner_area_115 - E inner_area_116 - E inner_area_117 - E inner_area_118 - E inner_area_119 - E inner_area_120 - E inner_area_121 - E upper_border_1 - E upper_border_2 - E upper_border_3 - E upper_border_4 - E upper_border_5 - E upper_border_6 - E upper_border_7 - E upper_border_8 - E upper_border_9 - E upper_border_10 - E upper_border_11 - E lower_border_1 - E lower_border_2 - E lower_border_3 - E lower_border_4 - E lower_border_5 - E lower_border_6 - E lower_border_7 - E lower_border_8 - E lower_border_9 - E lower_border_10 - E lower_border_11 - E left_border_1 - E left_border_2 - E left_border_3 - E left_border_4 - E left_border_5 - E left_border_6 - E left_border_7 - E left_border_8 - E left_border_9 - E left_border_10 - E left_border_11 - E right_border_1 - E right_border_2 - E right_border_3 - E right_border_4 - E right_border_5 - E right_border_6 - E right_border_7 - E right_border_8 - E right_border_9 - E right_border_10 - E right_border_11 - E left_upper_co@a5 - E left_lower_co@a6 - E right_upper_c@a7 - E right_lower_c@a8 -COLUMNS - MARK0000 'MARKER' 'INTORG' - x#11#4 inner_area_101 1 - x#11#4 inner_area_102 1 - x#11#4 inner_area_103 1 - x#11#4 inner_area_113 1 - x#11#4 inner_area_91 1 - x#11#4 moves 1 - x#11#5 inner_area_102 1 - x#11#5 inner_area_103 1 - x#11#5 inner_area_104 1 - x#11#5 inner_area_114 1 - x#11#5 inner_area_92 1 - x#11#5 moves 1 - x#11#6 inner_area_103 1 - x#11#6 inner_area_104 1 - x#11#6 inner_area_105 1 - x#11#6 inner_area_115 1 - x#11#6 inner_area_93 1 - x#11#6 moves 1 - x#11#7 inner_area_104 1 - x#11#7 inner_area_105 1 - x#11#7 inner_area_106 1 - x#11#7 inner_area_116 1 - x#11#7 inner_area_94 1 - x#11#7 moves 1 - x#11#1 inner_area_100 1 - x#11#1 left_border_10 1 - x#11#1 left_border_11 1 - x#11#1 left_border_9 1 - x#11#1 moves 1 - x#11#2 inner_area_100 1 - x#11#2 inner_area_101 1 - x#11#2 inner_area_111 1 - x#11#2 inner_area_89 1 - x#11#2 left_border_10 1 - x#11#2 moves 1 - x#11#3 inner_area_100 1 - x#11#3 inner_area_101 1 - x#11#3 inner_area_102 1 - x#11#3 inner_area_112 1 - x#11#3 inner_area_90 1 - x#11#3 moves 1 - x#11#8 inner_area_105 1 - x#11#8 inner_area_106 1 - x#11#8 inner_area_107 1 - x#11#8 inner_area_117 1 - x#11#8 inner_area_95 1 - x#11#8 moves 1 - x#11#9 inner_area_106 1 - x#11#9 inner_area_107 1 - x#11#9 inner_area_108 1 - x#11#9 inner_area_118 1 - x#11#9 inner_area_96 1 - x#11#9 moves 1 - x#2#11 inner_area_10 1 - x#2#11 inner_area_11 1 - x#2#11 inner_area_21 1 - x#2#11 inner_area_9 1 - x#2#11 moves 1 - x#2#11 upper_border_10 1 - x#2#10 inner_area_10 1 - x#2#10 inner_area_20 1 - x#2#10 inner_area_8 1 - x#2#10 inner_area_9 1 - x#2#10 moves 1 - x#2#10 upper_border_9 1 - x#2#13 inner_area_11 1 - x#2#13 moves 1 - x#2#13 right_border_1 1 - x#2#13 right_border_2 1 - x#2#13 right_upper_c@a7 1 - x#2#12 inner_area_10 1 - x#2#12 inner_area_11 1 - x#2#12 inner_area_22 1 - x#2#12 moves 1 - x#2#12 right_border_1 1 - x#2#12 upper_border_11 1 - y#8#10 inner_area_75 -2 - y#8#11 inner_area_76 -2 - y#8#12 inner_area_77 -2 - y#1#10 upper_border_9 -2 - x#5#10 inner_area_31 1 - x#5#10 inner_area_41 1 - x#5#10 inner_area_42 1 - x#5#10 inner_area_43 1 - x#5#10 inner_area_53 1 - x#5#10 moves 1 - x#5#11 inner_area_32 1 - x#5#11 inner_area_42 1 - x#5#11 inner_area_43 1 - x#5#11 inner_area_44 1 - x#5#11 inner_area_54 1 - x#5#11 moves 1 - x#5#12 inner_area_33 1 - x#5#12 inner_area_43 1 - x#5#12 inner_area_44 1 - x#5#12 inner_area_55 1 - x#5#12 moves 1 - x#5#12 right_border_4 1 - x#5#13 inner_area_44 1 - x#5#13 moves 1 - x#5#13 right_border_3 1 - x#5#13 right_border_4 1 - x#5#13 right_border_5 1 - y#13#10 lower_border_9 -2 - y#13#11 lower_border_10 -2 - y#13#12 lower_border_11 -2 - y#13#13 right_lower_c@a8 -2 - y#9#13 right_border_8 -2 - y#9#12 inner_area_88 -2 - y#9#11 inner_area_87 -2 - y#9#10 inner_area_86 -2 - y#6#12 inner_area_55 -2 - y#6#13 right_border_5 -2 - y#6#10 inner_area_53 -2 - y#6#11 inner_area_54 -2 - y#12#13 right_border_11 -2 - y#12#12 inner_area_121 -2 - y#12#11 inner_area_120 -2 - y#12#10 inner_area_119 -2 - y#2#12 inner_area_11 -2 - y#2#13 right_border_1 -2 - y#2#10 inner_area_9 -2 - y#2#11 inner_area_10 -2 - x#13#11 inner_area_120 1 - x#13#11 lower_border_10 1 - x#13#11 lower_border_11 1 - x#13#11 lower_border_9 1 - x#13#11 moves 1 - x#13#10 inner_area_119 1 - x#13#10 lower_border_10 1 - x#13#10 lower_border_8 1 - x#13#10 lower_border_9 1 - x#13#10 moves 1 - x#13#13 lower_border_11 1 - x#13#13 moves 1 - x#13#13 right_border_11 1 - x#13#13 right_lower_c@a8 1 - x#13#12 inner_area_121 1 - x#13#12 lower_border_10 1 - x#13#12 lower_border_11 1 - x#13#12 moves 1 - x#13#12 right_lower_c@a8 1 - x#1#10 inner_area_9 1 - x#1#10 moves 1 - x#1#10 upper_border_10 1 - x#1#10 upper_border_8 1 - x#1#10 upper_border_9 1 - x#1#11 inner_area_10 1 - x#1#11 moves 1 - x#1#11 upper_border_10 1 - x#1#11 upper_border_11 1 - x#1#11 upper_border_9 1 - x#1#12 inner_area_11 1 - x#1#12 moves 1 - x#1#12 right_upper_c@a7 1 - x#1#12 upper_border_10 1 - x#1#12 upper_border_11 1 - x#1#13 moves 1 - x#1#13 right_border_1 1 - x#1#13 right_upper_c@a7 1 - x#1#13 upper_border_11 1 - y#1#4 upper_border_3 -2 - y#1#5 upper_border_4 -2 - y#1#6 upper_border_5 -2 - y#1#7 upper_border_6 -2 - x#9#9 inner_area_74 1 - x#9#9 inner_area_84 1 - x#9#9 inner_area_85 1 - x#9#9 inner_area_86 1 - x#9#9 inner_area_96 1 - x#9#9 moves 1 - x#9#8 inner_area_73 1 - x#9#8 inner_area_83 1 - x#9#8 inner_area_84 1 - x#9#8 inner_area_85 1 - x#9#8 inner_area_95 1 - x#9#8 moves 1 - y#1#2 upper_border_1 -2 - y#1#3 upper_border_2 -2 - x#9#5 inner_area_70 1 - x#9#5 inner_area_80 1 - x#9#5 inner_area_81 1 - x#9#5 inner_area_82 1 - x#9#5 inner_area_92 1 - x#9#5 moves 1 - x#9#4 inner_area_69 1 - x#9#4 inner_area_79 1 - x#9#4 inner_area_80 1 - x#9#4 inner_area_81 1 - x#9#4 inner_area_91 1 - x#9#4 moves 1 - x#9#7 inner_area_72 1 - x#9#7 inner_area_82 1 - x#9#7 inner_area_83 1 - x#9#7 inner_area_84 1 - x#9#7 inner_area_94 1 - x#9#7 moves 1 - x#9#6 inner_area_71 1 - x#9#6 inner_area_81 1 - x#9#6 inner_area_82 1 - x#9#6 inner_area_83 1 - x#9#6 inner_area_93 1 - x#9#6 moves 1 - x#9#1 inner_area_78 1 - x#9#1 left_border_7 1 - x#9#1 left_border_8 1 - x#9#1 left_border_9 1 - x#9#1 moves 1 - y#1#9 upper_border_8 -2 - x#9#3 inner_area_68 1 - x#9#3 inner_area_78 1 - x#9#3 inner_area_79 1 - x#9#3 inner_area_80 1 - x#9#3 inner_area_90 1 - x#9#3 moves 1 - x#9#2 inner_area_67 1 - x#9#2 inner_area_78 1 - x#9#2 inner_area_79 1 - x#9#2 inner_area_89 1 - x#9#2 left_border_8 1 - x#9#2 moves 1 - x#12#3 inner_area_101 1 - x#12#3 inner_area_111 1 - x#12#3 inner_area_112 1 - x#12#3 inner_area_113 1 - x#12#3 lower_border_2 1 - x#12#3 moves 1 - x#12#2 inner_area_100 1 - x#12#2 inner_area_111 1 - x#12#2 inner_area_112 1 - x#12#2 left_border_11 1 - x#12#2 lower_border_1 1 - x#12#2 moves 1 - x#12#1 inner_area_111 1 - x#12#1 left_border_10 1 - x#12#1 left_border_11 1 - x#12#1 left_lower_co@a6 1 - x#12#1 moves 1 - y#3#1 left_border_2 -2 - x#12#7 inner_area_105 1 - x#12#7 inner_area_115 1 - x#12#7 inner_area_116 1 - x#12#7 inner_area_117 1 - x#12#7 lower_border_6 1 - x#12#7 moves 1 - x#12#6 inner_area_104 1 - x#12#6 inner_area_114 1 - x#12#6 inner_area_115 1 - x#12#6 inner_area_116 1 - x#12#6 lower_border_5 1 - x#12#6 moves 1 - x#12#5 inner_area_103 1 - x#12#5 inner_area_113 1 - x#12#5 inner_area_114 1 - x#12#5 inner_area_115 1 - x#12#5 lower_border_4 1 - x#12#5 moves 1 - x#12#4 inner_area_102 1 - x#12#4 inner_area_112 1 - x#12#4 inner_area_113 1 - x#12#4 inner_area_114 1 - x#12#4 lower_border_3 1 - x#12#4 moves 1 - y#6#7 inner_area_50 -2 - y#6#6 inner_area_49 -2 - x#12#9 inner_area_107 1 - x#12#9 inner_area_117 1 - x#12#9 inner_area_118 1 - x#12#9 inner_area_119 1 - x#12#9 lower_border_8 1 - x#12#9 moves 1 - x#12#8 inner_area_106 1 - x#12#8 inner_area_116 1 - x#12#8 inner_area_117 1 - x#12#8 inner_area_118 1 - x#12#8 lower_border_7 1 - x#12#8 moves 1 - y#6#3 inner_area_46 -2 - y#6#2 inner_area_45 -2 - y#6#1 left_border_5 -2 - x#8#4 inner_area_58 1 - x#8#4 inner_area_68 1 - x#8#4 inner_area_69 1 - x#8#4 inner_area_70 1 - x#8#4 inner_area_80 1 - x#8#4 moves 1 - x#8#5 inner_area_59 1 - x#8#5 inner_area_69 1 - x#8#5 inner_area_70 1 - x#8#5 inner_area_71 1 - x#8#5 inner_area_81 1 - x#8#5 moves 1 - x#8#6 inner_area_60 1 - x#8#6 inner_area_70 1 - x#8#6 inner_area_71 1 - x#8#6 inner_area_72 1 - x#8#6 inner_area_82 1 - x#8#6 moves 1 - x#8#7 inner_area_61 1 - x#8#7 inner_area_71 1 - x#8#7 inner_area_72 1 - x#8#7 inner_area_73 1 - x#8#7 inner_area_83 1 - x#8#7 moves 1 - x#8#1 inner_area_67 1 - x#8#1 left_border_6 1 - x#8#1 left_border_7 1 - x#8#1 left_border_8 1 - x#8#1 moves 1 - x#8#2 inner_area_56 1 - x#8#2 inner_area_67 1 - x#8#2 inner_area_68 1 - x#8#2 inner_area_78 1 - x#8#2 left_border_7 1 - x#8#2 moves 1 - x#8#3 inner_area_57 1 - x#8#3 inner_area_67 1 - x#8#3 inner_area_68 1 - x#8#3 inner_area_69 1 - x#8#3 inner_area_79 1 - x#8#3 moves 1 - y#10#2 inner_area_89 -2 - y#10#3 inner_area_90 -2 - y#10#1 left_border_9 -2 - x#8#8 inner_area_62 1 - x#8#8 inner_area_72 1 - x#8#8 inner_area_73 1 - x#8#8 inner_area_74 1 - x#8#8 inner_area_84 1 - x#8#8 moves 1 - x#8#9 inner_area_63 1 - x#8#9 inner_area_73 1 - x#8#9 inner_area_74 1 - x#8#9 inner_area_75 1 - x#8#9 inner_area_85 1 - x#8#9 moves 1 - y#10#4 inner_area_91 -2 - y#10#5 inner_area_92 -2 - x#7#7 inner_area_50 1 - x#7#7 inner_area_60 1 - x#7#7 inner_area_61 1 - x#7#7 inner_area_62 1 - x#7#7 inner_area_72 1 - x#7#7 moves 1 - x#7#6 inner_area_49 1 - x#7#6 inner_area_59 1 - x#7#6 inner_area_60 1 - x#7#6 inner_area_61 1 - x#7#6 inner_area_71 1 - x#7#6 moves 1 - x#7#5 inner_area_48 1 - x#7#5 inner_area_58 1 - x#7#5 inner_area_59 1 - x#7#5 inner_area_60 1 - x#7#5 inner_area_70 1 - x#7#5 moves 1 - x#7#4 inner_area_47 1 - x#7#4 inner_area_57 1 - x#7#4 inner_area_58 1 - x#7#4 inner_area_59 1 - x#7#4 inner_area_69 1 - x#7#4 moves 1 - x#7#3 inner_area_46 1 - x#7#3 inner_area_56 1 - x#7#3 inner_area_57 1 - x#7#3 inner_area_58 1 - x#7#3 inner_area_68 1 - x#7#3 moves 1 - x#7#2 inner_area_45 1 - x#7#2 inner_area_56 1 - x#7#2 inner_area_57 1 - x#7#2 inner_area_67 1 - x#7#2 left_border_6 1 - x#7#2 moves 1 - x#7#1 inner_area_56 1 - x#7#1 left_border_5 1 - x#7#1 left_border_6 1 - x#7#1 left_border_7 1 - x#7#1 moves 1 - y#13#2 lower_border_1 -2 - y#13#9 lower_border_8 -2 - y#13#8 lower_border_7 -2 - x#7#9 inner_area_52 1 - x#7#9 inner_area_62 1 - x#7#9 inner_area_63 1 - x#7#9 inner_area_64 1 - x#7#9 inner_area_74 1 - x#7#9 moves 1 - x#7#8 inner_area_51 1 - x#7#8 inner_area_61 1 - x#7#8 inner_area_62 1 - x#7#8 inner_area_63 1 - x#7#8 inner_area_73 1 - x#7#8 moves 1 - x#12#12 inner_area_110 1 - x#12#12 inner_area_120 1 - x#12#12 inner_area_121 1 - x#12#12 lower_border_11 1 - x#12#12 moves 1 - x#12#12 right_border_11 1 - x#12#13 inner_area_121 1 - x#12#13 moves 1 - x#12#13 right_border_10 1 - x#12#13 right_border_11 1 - x#12#13 right_lower_c@a8 1 - x#12#10 inner_area_108 1 - x#12#10 inner_area_118 1 - x#12#10 inner_area_119 1 - x#12#10 inner_area_120 1 - x#12#10 lower_border_9 1 - x#12#10 moves 1 - x#12#11 inner_area_109 1 - x#12#11 inner_area_119 1 - x#12#11 inner_area_120 1 - x#12#11 inner_area_121 1 - x#12#11 lower_border_10 1 - x#12#11 moves 1 - y#12#8 inner_area_117 -2 - y#12#9 inner_area_118 -2 - y#12#4 inner_area_113 -2 - y#12#5 inner_area_114 -2 - y#12#6 inner_area_115 -2 - y#12#7 inner_area_116 -2 - y#12#1 left_border_11 -2 - y#12#2 inner_area_111 -2 - y#12#3 inner_area_112 -2 - y#4#10 inner_area_31 -2 - y#4#11 inner_area_32 -2 - y#4#12 inner_area_33 -2 - y#4#13 right_border_3 -2 - x#6#11 inner_area_43 1 - x#6#11 inner_area_53 1 - x#6#11 inner_area_54 1 - x#6#11 inner_area_55 1 - x#6#11 inner_area_65 1 - x#6#11 moves 1 - x#6#10 inner_area_42 1 - x#6#10 inner_area_52 1 - x#6#10 inner_area_53 1 - x#6#10 inner_area_54 1 - x#6#10 inner_area_64 1 - x#6#10 moves 1 - x#6#13 inner_area_55 1 - x#6#13 moves 1 - x#6#13 right_border_4 1 - x#6#13 right_border_5 1 - x#6#13 right_border_6 1 - x#6#12 inner_area_44 1 - x#6#12 inner_area_54 1 - x#6#12 inner_area_55 1 - x#6#12 inner_area_66 1 - x#6#12 moves 1 - x#6#12 right_border_5 1 - x#6#6 inner_area_38 1 - x#6#6 inner_area_48 1 - x#6#6 inner_area_49 1 - x#6#6 inner_area_50 1 - x#6#6 inner_area_60 1 - x#6#6 moves 1 - x#6#7 inner_area_39 1 - x#6#7 inner_area_49 1 - x#6#7 inner_area_50 1 - x#6#7 inner_area_51 1 - x#6#7 inner_area_61 1 - x#6#7 moves 1 - x#6#4 inner_area_36 1 - x#6#4 inner_area_46 1 - x#6#4 inner_area_47 1 - x#6#4 inner_area_48 1 - x#6#4 inner_area_58 1 - x#6#4 moves 1 - x#6#5 inner_area_37 1 - x#6#5 inner_area_47 1 - x#6#5 inner_area_48 1 - x#6#5 inner_area_49 1 - x#6#5 inner_area_59 1 - x#6#5 moves 1 - x#6#2 inner_area_34 1 - x#6#2 inner_area_45 1 - x#6#2 inner_area_46 1 - x#6#2 inner_area_56 1 - x#6#2 left_border_5 1 - x#6#2 moves 1 - x#6#3 inner_area_35 1 - x#6#3 inner_area_45 1 - x#6#3 inner_area_46 1 - x#6#3 inner_area_47 1 - x#6#3 inner_area_57 1 - x#6#3 moves 1 - x#6#1 inner_area_45 1 - x#6#1 left_border_4 1 - x#6#1 left_border_5 1 - x#6#1 left_border_6 1 - x#6#1 moves 1 - x#6#8 inner_area_40 1 - x#6#8 inner_area_50 1 - x#6#8 inner_area_51 1 - x#6#8 inner_area_52 1 - x#6#8 inner_area_62 1 - x#6#8 moves 1 - x#6#9 inner_area_41 1 - x#6#9 inner_area_51 1 - x#6#9 inner_area_52 1 - x#6#9 inner_area_53 1 - x#6#9 inner_area_63 1 - x#6#9 moves 1 - x#5#1 inner_area_34 1 - x#5#1 left_border_3 1 - x#5#1 left_border_4 1 - x#5#1 left_border_5 1 - x#5#1 moves 1 - x#5#3 inner_area_24 1 - x#5#3 inner_area_34 1 - x#5#3 inner_area_35 1 - x#5#3 inner_area_36 1 - x#5#3 inner_area_46 1 - x#5#3 moves 1 - x#5#2 inner_area_23 1 - x#5#2 inner_area_34 1 - x#5#2 inner_area_35 1 - x#5#2 inner_area_45 1 - x#5#2 left_border_4 1 - x#5#2 moves 1 - x#5#5 inner_area_26 1 - x#5#5 inner_area_36 1 - x#5#5 inner_area_37 1 - x#5#5 inner_area_38 1 - x#5#5 inner_area_48 1 - x#5#5 moves 1 - x#5#4 inner_area_25 1 - x#5#4 inner_area_35 1 - x#5#4 inner_area_36 1 - x#5#4 inner_area_37 1 - x#5#4 inner_area_47 1 - x#5#4 moves 1 - x#5#7 inner_area_28 1 - x#5#7 inner_area_38 1 - x#5#7 inner_area_39 1 - x#5#7 inner_area_40 1 - x#5#7 inner_area_50 1 - x#5#7 moves 1 - x#5#6 inner_area_27 1 - x#5#6 inner_area_37 1 - x#5#6 inner_area_38 1 - x#5#6 inner_area_39 1 - x#5#6 inner_area_49 1 - x#5#6 moves 1 - x#5#9 inner_area_30 1 - x#5#9 inner_area_40 1 - x#5#9 inner_area_41 1 - x#5#9 inner_area_42 1 - x#5#9 inner_area_52 1 - x#5#9 moves 1 - x#5#8 inner_area_29 1 - x#5#8 inner_area_39 1 - x#5#8 inner_area_40 1 - x#5#8 inner_area_41 1 - x#5#8 inner_area_51 1 - x#5#8 moves 1 - y#10#11 inner_area_98 -2 - y#10#10 inner_area_97 -2 - y#10#13 right_border_9 -2 - y#10#12 inner_area_99 -2 - x#4#13 inner_area_33 1 - x#4#13 moves 1 - x#4#13 right_border_2 1 - x#4#13 right_border_3 1 - x#4#13 right_border_4 1 - x#4#12 inner_area_22 1 - x#4#12 inner_area_32 1 - x#4#12 inner_area_33 1 - x#4#12 inner_area_44 1 - x#4#12 moves 1 - x#4#12 right_border_3 1 - x#4#11 inner_area_21 1 - x#4#11 inner_area_31 1 - x#4#11 inner_area_32 1 - x#4#11 inner_area_33 1 - x#4#11 inner_area_43 1 - x#4#11 moves 1 - x#4#10 inner_area_20 1 - x#4#10 inner_area_30 1 - x#4#10 inner_area_31 1 - x#4#10 inner_area_32 1 - x#4#10 inner_area_42 1 - x#4#10 moves 1 - x#3#9 inner_area_18 1 - x#3#9 inner_area_19 1 - x#3#9 inner_area_20 1 - x#3#9 inner_area_30 1 - x#3#9 inner_area_8 1 - x#3#9 moves 1 - x#3#8 inner_area_17 1 - x#3#8 inner_area_18 1 - x#3#8 inner_area_19 1 - x#3#8 inner_area_29 1 - x#3#8 inner_area_7 1 - x#3#8 moves 1 - x#3#3 inner_area_12 1 - x#3#3 inner_area_13 1 - x#3#3 inner_area_14 1 - x#3#3 inner_area_2 1 - x#3#3 inner_area_24 1 - x#3#3 moves 1 - x#3#2 inner_area_1 1 - x#3#2 inner_area_12 1 - x#3#2 inner_area_13 1 - x#3#2 inner_area_23 1 - x#3#2 left_border_2 1 - x#3#2 moves 1 - x#3#1 inner_area_12 1 - x#3#1 left_border_1 1 - x#3#1 left_border_2 1 - x#3#1 left_border_3 1 - x#3#1 moves 1 - x#3#7 inner_area_16 1 - x#3#7 inner_area_17 1 - x#3#7 inner_area_18 1 - x#3#7 inner_area_28 1 - x#3#7 inner_area_6 1 - x#3#7 moves 1 - x#3#6 inner_area_15 1 - x#3#6 inner_area_16 1 - x#3#6 inner_area_17 1 - x#3#6 inner_area_27 1 - x#3#6 inner_area_5 1 - x#3#6 moves 1 - x#3#5 inner_area_14 1 - x#3#5 inner_area_15 1 - x#3#5 inner_area_16 1 - x#3#5 inner_area_26 1 - x#3#5 inner_area_4 1 - x#3#5 moves 1 - x#3#4 inner_area_13 1 - x#3#4 inner_area_14 1 - x#3#4 inner_area_15 1 - x#3#4 inner_area_25 1 - x#3#4 inner_area_3 1 - x#3#4 moves 1 - x#10#9 inner_area_107 1 - x#10#9 inner_area_85 1 - x#10#9 inner_area_95 1 - x#10#9 inner_area_96 1 - x#10#9 inner_area_97 1 - x#10#9 moves 1 - x#10#8 inner_area_106 1 - x#10#8 inner_area_84 1 - x#10#8 inner_area_94 1 - x#10#8 inner_area_95 1 - x#10#8 inner_area_96 1 - x#10#8 moves 1 - x#10#5 inner_area_103 1 - x#10#5 inner_area_81 1 - x#10#5 inner_area_91 1 - x#10#5 inner_area_92 1 - x#10#5 inner_area_93 1 - x#10#5 moves 1 - x#10#4 inner_area_102 1 - x#10#4 inner_area_80 1 - x#10#4 inner_area_90 1 - x#10#4 inner_area_91 1 - x#10#4 inner_area_92 1 - x#10#4 moves 1 - x#10#7 inner_area_105 1 - x#10#7 inner_area_83 1 - x#10#7 inner_area_93 1 - x#10#7 inner_area_94 1 - x#10#7 inner_area_95 1 - x#10#7 moves 1 - x#10#6 inner_area_104 1 - x#10#6 inner_area_82 1 - x#10#6 inner_area_92 1 - x#10#6 inner_area_93 1 - x#10#6 inner_area_94 1 - x#10#6 moves 1 - x#10#1 inner_area_89 1 - x#10#1 left_border_10 1 - x#10#1 left_border_8 1 - x#10#1 left_border_9 1 - x#10#1 moves 1 - x#10#3 inner_area_101 1 - x#10#3 inner_area_79 1 - x#10#3 inner_area_89 1 - x#10#3 inner_area_90 1 - x#10#3 inner_area_91 1 - x#10#3 moves 1 - x#10#2 inner_area_100 1 - x#10#2 inner_area_78 1 - x#10#2 inner_area_89 1 - x#10#2 inner_area_90 1 - x#10#2 left_border_9 1 - x#10#2 moves 1 - y#11#9 inner_area_107 -2 - y#11#8 inner_area_106 -2 - x#9#10 inner_area_75 1 - x#9#10 inner_area_85 1 - x#9#10 inner_area_86 1 - x#9#10 inner_area_87 1 - x#9#10 inner_area_97 1 - x#9#10 moves 1 - x#9#11 inner_area_76 1 - x#9#11 inner_area_86 1 - x#9#11 inner_area_87 1 - x#9#11 inner_area_88 1 - x#9#11 inner_area_98 1 - x#9#11 moves 1 - x#9#12 inner_area_77 1 - x#9#12 inner_area_87 1 - x#9#12 inner_area_88 1 - x#9#12 inner_area_99 1 - x#9#12 moves 1 - x#9#12 right_border_8 1 - x#9#13 inner_area_88 1 - x#9#13 moves 1 - x#9#13 right_border_7 1 - x#9#13 right_border_8 1 - x#9#13 right_border_9 1 - y#11#3 inner_area_101 -2 - y#11#2 inner_area_100 -2 - y#11#1 left_border_10 -2 - y#11#7 inner_area_105 -2 - y#11#6 inner_area_104 -2 - y#11#5 inner_area_103 -2 - y#11#4 inner_area_102 -2 - x#4#8 inner_area_18 1 - x#4#8 inner_area_28 1 - x#4#8 inner_area_29 1 - x#4#8 inner_area_30 1 - x#4#8 inner_area_40 1 - x#4#8 moves 1 - x#4#9 inner_area_19 1 - x#4#9 inner_area_29 1 - x#4#9 inner_area_30 1 - x#4#9 inner_area_31 1 - x#4#9 inner_area_41 1 - x#4#9 moves 1 - x#4#1 inner_area_23 1 - x#4#1 left_border_2 1 - x#4#1 left_border_3 1 - x#4#1 left_border_4 1 - x#4#1 moves 1 - x#4#2 inner_area_12 1 - x#4#2 inner_area_23 1 - x#4#2 inner_area_24 1 - x#4#2 inner_area_34 1 - x#4#2 left_border_3 1 - x#4#2 moves 1 - x#4#3 inner_area_13 1 - x#4#3 inner_area_23 1 - x#4#3 inner_area_24 1 - x#4#3 inner_area_25 1 - x#4#3 inner_area_35 1 - x#4#3 moves 1 - x#4#4 inner_area_14 1 - x#4#4 inner_area_24 1 - x#4#4 inner_area_25 1 - x#4#4 inner_area_26 1 - x#4#4 inner_area_36 1 - x#4#4 moves 1 - x#4#5 inner_area_15 1 - x#4#5 inner_area_25 1 - x#4#5 inner_area_26 1 - x#4#5 inner_area_27 1 - x#4#5 inner_area_37 1 - x#4#5 moves 1 - x#4#6 inner_area_16 1 - x#4#6 inner_area_26 1 - x#4#6 inner_area_27 1 - x#4#6 inner_area_28 1 - x#4#6 inner_area_38 1 - x#4#6 moves 1 - x#4#7 inner_area_17 1 - x#4#7 inner_area_27 1 - x#4#7 inner_area_28 1 - x#4#7 inner_area_29 1 - x#4#7 inner_area_39 1 - x#4#7 moves 1 - y#2#3 inner_area_2 -2 - y#2#2 inner_area_1 -2 - y#8#7 inner_area_72 -2 - y#8#6 inner_area_71 -2 - y#2#7 inner_area_6 -2 - y#2#6 inner_area_5 -2 - y#2#5 inner_area_4 -2 - y#2#4 inner_area_3 -2 - y#2#9 inner_area_8 -2 - y#2#8 inner_area_7 -2 - y#8#9 inner_area_74 -2 - y#8#8 inner_area_73 -2 - x#13#2 inner_area_111 1 - x#13#2 left_lower_co@a6 1 - x#13#2 lower_border_1 1 - x#13#2 lower_border_2 1 - x#13#2 moves 1 - x#13#3 inner_area_112 1 - x#13#3 lower_border_1 1 - x#13#3 lower_border_2 1 - x#13#3 lower_border_3 1 - x#13#3 moves 1 - x#13#1 left_border_11 1 - x#13#1 left_lower_co@a6 1 - x#13#1 lower_border_1 1 - x#13#1 moves 1 - x#13#6 inner_area_115 1 - x#13#6 lower_border_4 1 - x#13#6 lower_border_5 1 - x#13#6 lower_border_6 1 - x#13#6 moves 1 - x#13#7 inner_area_116 1 - x#13#7 lower_border_5 1 - x#13#7 lower_border_6 1 - x#13#7 lower_border_7 1 - x#13#7 moves 1 - x#13#4 inner_area_113 1 - x#13#4 lower_border_2 1 - x#13#4 lower_border_3 1 - x#13#4 lower_border_4 1 - x#13#4 moves 1 - x#13#5 inner_area_114 1 - x#13#5 lower_border_3 1 - x#13#5 lower_border_4 1 - x#13#5 lower_border_5 1 - x#13#5 moves 1 - y#7#6 inner_area_60 -2 - y#7#7 inner_area_61 -2 - x#13#8 inner_area_117 1 - x#13#8 lower_border_6 1 - x#13#8 lower_border_7 1 - x#13#8 lower_border_8 1 - x#13#8 moves 1 - x#13#9 inner_area_118 1 - x#13#9 lower_border_7 1 - x#13#9 lower_border_8 1 - x#13#9 lower_border_9 1 - x#13#9 moves 1 - y#7#2 inner_area_56 -2 - y#7#3 inner_area_57 -2 - y#7#1 left_border_6 -2 - y#4#9 inner_area_30 -2 - y#4#8 inner_area_29 -2 - y#3#11 inner_area_21 -2 - y#3#10 inner_area_20 -2 - y#4#3 inner_area_24 -2 - y#3#12 inner_area_22 -2 - y#4#5 inner_area_26 -2 - y#4#4 inner_area_25 -2 - y#4#7 inner_area_28 -2 - y#4#6 inner_area_27 -2 - x#1#5 inner_area_4 1 - x#1#5 moves 1 - x#1#5 upper_border_3 1 - x#1#5 upper_border_4 1 - x#1#5 upper_border_5 1 - x#1#4 inner_area_3 1 - x#1#4 moves 1 - x#1#4 upper_border_2 1 - x#1#4 upper_border_3 1 - x#1#4 upper_border_4 1 - x#1#7 inner_area_6 1 - x#1#7 moves 1 - x#1#7 upper_border_5 1 - x#1#7 upper_border_6 1 - x#1#7 upper_border_7 1 - x#1#6 inner_area_5 1 - x#1#6 moves 1 - x#1#6 upper_border_4 1 - x#1#6 upper_border_5 1 - x#1#6 upper_border_6 1 - x#1#1 left_border_1 1 - x#1#1 left_upper_co@a5 1 - x#1#1 moves 1 - x#1#1 upper_border_1 1 - x#1#3 inner_area_2 1 - x#1#3 moves 1 - x#1#3 upper_border_1 1 - x#1#3 upper_border_2 1 - x#1#3 upper_border_3 1 - x#1#2 inner_area_1 1 - x#1#2 left_upper_co@a5 1 - x#1#2 moves 1 - x#1#2 upper_border_1 1 - x#1#2 upper_border_2 1 - x#1#9 inner_area_8 1 - x#1#9 moves 1 - x#1#9 upper_border_7 1 - x#1#9 upper_border_8 1 - x#1#9 upper_border_9 1 - x#1#8 inner_area_7 1 - x#1#8 moves 1 - x#1#8 upper_border_6 1 - x#1#8 upper_border_7 1 - x#1#8 upper_border_8 1 - y#7#13 right_border_6 -2 - y#7#12 inner_area_66 -2 - y#5#13 right_border_4 -2 - y#5#12 inner_area_44 -2 - y#5#11 inner_area_43 -2 - y#5#10 inner_area_42 -2 - x#7#12 inner_area_55 1 - x#7#12 inner_area_65 1 - x#7#12 inner_area_66 1 - x#7#12 inner_area_77 1 - x#7#12 moves 1 - x#7#12 right_border_6 1 - x#7#13 inner_area_66 1 - x#7#13 moves 1 - x#7#13 right_border_5 1 - x#7#13 right_border_6 1 - x#7#13 right_border_7 1 - x#7#10 inner_area_53 1 - x#7#10 inner_area_63 1 - x#7#10 inner_area_64 1 - x#7#10 inner_area_65 1 - x#7#10 inner_area_75 1 - x#7#10 moves 1 - x#7#11 inner_area_54 1 - x#7#11 inner_area_64 1 - x#7#11 inner_area_65 1 - x#7#11 inner_area_66 1 - x#7#11 inner_area_76 1 - x#7#11 moves 1 - y#5#1 left_border_4 -2 - y#5#2 inner_area_34 -2 - y#5#3 inner_area_35 -2 - y#5#4 inner_area_36 -2 - y#5#5 inner_area_37 -2 - y#5#6 inner_area_38 -2 - y#5#7 inner_area_39 -2 - y#5#8 inner_area_40 -2 - y#5#9 inner_area_41 -2 - x#3#12 inner_area_11 1 - x#3#12 inner_area_21 1 - x#3#12 inner_area_22 1 - x#3#12 inner_area_33 1 - x#3#12 moves 1 - x#3#12 right_border_2 1 - x#3#13 inner_area_22 1 - x#3#13 moves 1 - x#3#13 right_border_1 1 - x#3#13 right_border_2 1 - x#3#13 right_border_3 1 - x#3#10 inner_area_19 1 - x#3#10 inner_area_20 1 - x#3#10 inner_area_21 1 - x#3#10 inner_area_31 1 - x#3#10 inner_area_9 1 - x#3#10 moves 1 - x#3#11 inner_area_10 1 - x#3#11 inner_area_20 1 - x#3#11 inner_area_21 1 - x#3#11 inner_area_22 1 - x#3#11 inner_area_32 1 - x#3#11 moves 1 - x#10#10 inner_area_108 1 - x#10#10 inner_area_86 1 - x#10#10 inner_area_96 1 - x#10#10 inner_area_97 1 - x#10#10 inner_area_98 1 - x#10#10 moves 1 - x#10#11 inner_area_109 1 - x#10#11 inner_area_87 1 - x#10#11 inner_area_97 1 - x#10#11 inner_area_98 1 - x#10#11 inner_area_99 1 - x#10#11 moves 1 - x#10#12 inner_area_110 1 - x#10#12 inner_area_88 1 - x#10#12 inner_area_98 1 - x#10#12 inner_area_99 1 - x#10#12 moves 1 - x#10#12 right_border_9 1 - x#10#13 inner_area_99 1 - x#10#13 moves 1 - x#10#13 right_border_10 1 - x#10#13 right_border_8 1 - x#10#13 right_border_9 1 - x#11#13 inner_area_110 1 - x#11#13 moves 1 - x#11#13 right_border_10 1 - x#11#13 right_border_11 1 - x#11#13 right_border_9 1 - x#11#12 inner_area_109 1 - x#11#12 inner_area_110 1 - x#11#12 inner_area_121 1 - x#11#12 inner_area_99 1 - x#11#12 moves 1 - x#11#12 right_border_10 1 - x#11#11 inner_area_108 1 - x#11#11 inner_area_109 1 - x#11#11 inner_area_110 1 - x#11#11 inner_area_120 1 - x#11#11 inner_area_98 1 - x#11#11 moves 1 - x#11#10 inner_area_107 1 - x#11#10 inner_area_108 1 - x#11#10 inner_area_109 1 - x#11#10 inner_area_119 1 - x#11#10 inner_area_97 1 - x#11#10 moves 1 - x#2#8 inner_area_18 1 - x#2#8 inner_area_6 1 - x#2#8 inner_area_7 1 - x#2#8 inner_area_8 1 - x#2#8 moves 1 - x#2#8 upper_border_7 1 - x#2#9 inner_area_19 1 - x#2#9 inner_area_7 1 - x#2#9 inner_area_8 1 - x#2#9 inner_area_9 1 - x#2#9 moves 1 - x#2#9 upper_border_8 1 - x#2#2 inner_area_1 1 - x#2#2 inner_area_12 1 - x#2#2 inner_area_2 1 - x#2#2 left_border_1 1 - x#2#2 moves 1 - x#2#2 upper_border_1 1 - x#2#3 inner_area_1 1 - x#2#3 inner_area_13 1 - x#2#3 inner_area_2 1 - x#2#3 inner_area_3 1 - x#2#3 moves 1 - x#2#3 upper_border_2 1 - x#2#1 inner_area_1 1 - x#2#1 left_border_1 1 - x#2#1 left_border_2 1 - x#2#1 left_upper_co@a5 1 - x#2#1 moves 1 - x#2#6 inner_area_16 1 - x#2#6 inner_area_4 1 - x#2#6 inner_area_5 1 - x#2#6 inner_area_6 1 - x#2#6 moves 1 - x#2#6 upper_border_5 1 - x#2#7 inner_area_17 1 - x#2#7 inner_area_5 1 - x#2#7 inner_area_6 1 - x#2#7 inner_area_7 1 - x#2#7 moves 1 - x#2#7 upper_border_6 1 - x#2#4 inner_area_14 1 - x#2#4 inner_area_2 1 - x#2#4 inner_area_3 1 - x#2#4 inner_area_4 1 - x#2#4 moves 1 - x#2#4 upper_border_3 1 - x#2#5 inner_area_15 1 - x#2#5 inner_area_3 1 - x#2#5 inner_area_4 1 - x#2#5 inner_area_5 1 - x#2#5 moves 1 - x#2#5 upper_border_4 1 - y#1#13 right_upper_c@a7 -2 - y#1#12 upper_border_11 -2 - y#1#11 upper_border_10 -2 - y#8#13 right_border_7 -2 - x#8#13 inner_area_77 1 - x#8#13 moves 1 - x#8#13 right_border_6 1 - x#8#13 right_border_7 1 - x#8#13 right_border_8 1 - x#8#12 inner_area_66 1 - x#8#12 inner_area_76 1 - x#8#12 inner_area_77 1 - x#8#12 inner_area_88 1 - x#8#12 moves 1 - x#8#12 right_border_7 1 - x#8#11 inner_area_65 1 - x#8#11 inner_area_75 1 - x#8#11 inner_area_76 1 - x#8#11 inner_area_77 1 - x#8#11 inner_area_87 1 - x#8#11 moves 1 - x#8#10 inner_area_64 1 - x#8#10 inner_area_74 1 - x#8#10 inner_area_75 1 - x#8#10 inner_area_76 1 - x#8#10 inner_area_86 1 - x#8#10 moves 1 - y#9#8 inner_area_84 -2 - y#9#9 inner_area_85 -2 - y#9#4 inner_area_80 -2 - y#9#5 inner_area_81 -2 - y#9#6 inner_area_82 -2 - y#9#7 inner_area_83 -2 - y#1#8 upper_border_7 -2 - y#9#1 left_border_8 -2 - y#9#2 inner_area_78 -2 - y#9#3 inner_area_79 -2 - y#3#2 inner_area_12 -2 - y#3#3 inner_area_13 -2 - y#3#6 inner_area_16 -2 - y#3#7 inner_area_17 -2 - y#3#4 inner_area_14 -2 - y#3#5 inner_area_15 -2 - y#3#8 inner_area_18 -2 - y#3#9 inner_area_19 -2 - y#10#8 inner_area_95 -2 - y#10#9 inner_area_96 -2 - y#10#6 inner_area_93 -2 - y#10#7 inner_area_94 -2 - y#13#5 lower_border_4 -2 - y#13#4 lower_border_3 -2 - y#13#7 lower_border_6 -2 - y#13#6 lower_border_5 -2 - y#13#1 left_lower_co@a6 -2 - y#13#3 lower_border_2 -2 - y#11#12 inner_area_110 -2 - y#11#13 right_border_10 -2 - y#11#10 inner_area_108 -2 - y#11#11 inner_area_109 -2 - y#8#5 inner_area_70 -2 - y#8#4 inner_area_69 -2 - y#2#1 left_border_1 -2 - y#8#1 left_border_7 -2 - y#8#3 inner_area_68 -2 - y#8#2 inner_area_67 -2 - y#7#8 inner_area_62 -2 - y#7#9 inner_area_63 -2 - y#7#4 inner_area_58 -2 - y#7#5 inner_area_59 -2 - y#4#1 left_border_3 -2 - y#3#13 right_border_2 -2 - y#4#2 inner_area_23 -2 - y#7#11 inner_area_65 -2 - y#7#10 inner_area_64 -2 - y#1#1 left_upper_co@a5 -2 - y#6#9 inner_area_52 -2 - y#6#8 inner_area_51 -2 - y#6#5 inner_area_48 -2 - y#6#4 inner_area_47 -2 - MARK0001 'MARKER' 'INTEND' -RHS - rhs left_upper_co@a5 -1 -BOUNDS - BV bound x#11#4 - BV bound x#11#5 - BV bound x#11#6 - BV bound x#11#7 - BV bound x#11#1 - BV bound x#11#2 - BV bound x#11#3 - BV bound x#11#8 - BV bound x#11#9 - BV bound x#2#11 - BV bound x#2#10 - BV bound x#2#13 - BV bound x#2#12 - LI bound y#8#10 0 - PL bound y#8#10 - LI bound y#8#11 0 - PL bound y#8#11 - LI bound y#8#12 0 - PL bound y#8#12 - LI bound y#1#10 0 - PL bound y#1#10 - BV bound x#5#10 - BV bound x#5#11 - BV bound x#5#12 - BV bound x#5#13 - LI bound y#13#10 0 - PL bound y#13#10 - LI bound y#13#11 0 - PL bound y#13#11 - LI bound y#13#12 0 - PL bound y#13#12 - LI bound y#13#13 0 - PL bound y#13#13 - LI bound y#9#13 0 - PL bound y#9#13 - LI bound y#9#12 0 - PL bound y#9#12 - LI bound y#9#11 0 - PL bound y#9#11 - LI bound y#9#10 0 - PL bound y#9#10 - LI bound y#6#12 0 - PL bound y#6#12 - LI bound y#6#13 0 - PL bound y#6#13 - LI bound y#6#10 0 - PL bound y#6#10 - LI bound y#6#11 0 - PL bound y#6#11 - LI bound y#12#13 0 - PL bound y#12#13 - LI bound y#12#12 0 - PL bound y#12#12 - LI bound y#12#11 0 - PL bound y#12#11 - LI bound y#12#10 0 - PL bound y#12#10 - LI bound y#2#12 0 - PL bound y#2#12 - LI bound y#2#13 0 - PL bound y#2#13 - LI bound y#2#10 0 - PL bound y#2#10 - LI bound y#2#11 0 - PL bound y#2#11 - BV bound x#13#11 - BV bound x#13#10 - BV bound x#13#13 - BV bound x#13#12 - BV bound x#1#10 - BV bound x#1#11 - BV bound x#1#12 - BV bound x#1#13 - LI bound y#1#4 0 - PL bound y#1#4 - LI bound y#1#5 0 - PL bound y#1#5 - LI bound y#1#6 0 - PL bound y#1#6 - LI bound y#1#7 0 - PL bound y#1#7 - BV bound x#9#9 - BV bound x#9#8 - LI bound y#1#2 0 - PL bound y#1#2 - LI bound y#1#3 0 - PL bound y#1#3 - BV bound x#9#5 - BV bound x#9#4 - BV bound x#9#7 - BV bound x#9#6 - BV bound x#9#1 - LI bound y#1#9 0 - PL bound y#1#9 - BV bound x#9#3 - BV bound x#9#2 - BV bound x#12#3 - BV bound x#12#2 - BV bound x#12#1 - LI bound y#3#1 0 - PL bound y#3#1 - BV bound x#12#7 - BV bound x#12#6 - BV bound x#12#5 - BV bound x#12#4 - LI bound y#6#7 0 - PL bound y#6#7 - LI bound y#6#6 0 - PL bound y#6#6 - BV bound x#12#9 - BV bound x#12#8 - LI bound y#6#3 0 - PL bound y#6#3 - LI bound y#6#2 0 - PL bound y#6#2 - LI bound y#6#1 0 - PL bound y#6#1 - BV bound x#8#4 - BV bound x#8#5 - BV bound x#8#6 - BV bound x#8#7 - BV bound x#8#1 - BV bound x#8#2 - BV bound x#8#3 - LI bound y#10#2 0 - PL bound y#10#2 - LI bound y#10#3 0 - PL bound y#10#3 - LI bound y#10#1 0 - PL bound y#10#1 - BV bound x#8#8 - BV bound x#8#9 - LI bound y#10#4 0 - PL bound y#10#4 - LI bound y#10#5 0 - PL bound y#10#5 - BV bound x#7#7 - BV bound x#7#6 - BV bound x#7#5 - BV bound x#7#4 - BV bound x#7#3 - BV bound x#7#2 - BV bound x#7#1 - LI bound y#13#2 0 - PL bound y#13#2 - LI bound y#13#9 0 - PL bound y#13#9 - LI bound y#13#8 0 - PL bound y#13#8 - BV bound x#7#9 - BV bound x#7#8 - BV bound x#12#12 - BV bound x#12#13 - BV bound x#12#10 - BV bound x#12#11 - LI bound y#12#8 0 - PL bound y#12#8 - LI bound y#12#9 0 - PL bound y#12#9 - LI bound y#12#4 0 - PL bound y#12#4 - LI bound y#12#5 0 - PL bound y#12#5 - LI bound y#12#6 0 - PL bound y#12#6 - LI bound y#12#7 0 - PL bound y#12#7 - LI bound y#12#1 0 - PL bound y#12#1 - LI bound y#12#2 0 - PL bound y#12#2 - LI bound y#12#3 0 - PL bound y#12#3 - LI bound y#4#10 0 - PL bound y#4#10 - LI bound y#4#11 0 - PL bound y#4#11 - LI bound y#4#12 0 - PL bound y#4#12 - LI bound y#4#13 0 - PL bound y#4#13 - BV bound x#6#11 - BV bound x#6#10 - BV bound x#6#13 - BV bound x#6#12 - BV bound x#6#6 - BV bound x#6#7 - BV bound x#6#4 - BV bound x#6#5 - BV bound x#6#2 - BV bound x#6#3 - BV bound x#6#1 - BV bound x#6#8 - BV bound x#6#9 - BV bound x#5#1 - BV bound x#5#3 - BV bound x#5#2 - BV bound x#5#5 - BV bound x#5#4 - BV bound x#5#7 - BV bound x#5#6 - BV bound x#5#9 - BV bound x#5#8 - LI bound y#10#11 0 - PL bound y#10#11 - LI bound y#10#10 0 - PL bound y#10#10 - LI bound y#10#13 0 - PL bound y#10#13 - LI bound y#10#12 0 - PL bound y#10#12 - BV bound x#4#13 - BV bound x#4#12 - BV bound x#4#11 - BV bound x#4#10 - BV bound x#3#9 - BV bound x#3#8 - BV bound x#3#3 - BV bound x#3#2 - BV bound x#3#1 - BV bound x#3#7 - BV bound x#3#6 - BV bound x#3#5 - BV bound x#3#4 - BV bound x#10#9 - BV bound x#10#8 - BV bound x#10#5 - BV bound x#10#4 - BV bound x#10#7 - BV bound x#10#6 - BV bound x#10#1 - BV bound x#10#3 - BV bound x#10#2 - LI bound y#11#9 0 - PL bound y#11#9 - LI bound y#11#8 0 - PL bound y#11#8 - BV bound x#9#10 - BV bound x#9#11 - BV bound x#9#12 - BV bound x#9#13 - LI bound y#11#3 0 - PL bound y#11#3 - LI bound y#11#2 0 - PL bound y#11#2 - LI bound y#11#1 0 - PL bound y#11#1 - LI bound y#11#7 0 - PL bound y#11#7 - LI bound y#11#6 0 - PL bound y#11#6 - LI bound y#11#5 0 - PL bound y#11#5 - LI bound y#11#4 0 - PL bound y#11#4 - BV bound x#4#8 - BV bound x#4#9 - BV bound x#4#1 - BV bound x#4#2 - BV bound x#4#3 - BV bound x#4#4 - BV bound x#4#5 - BV bound x#4#6 - BV bound x#4#7 - LI bound y#2#3 0 - PL bound y#2#3 - LI bound y#2#2 0 - PL bound y#2#2 - LI bound y#8#7 0 - PL bound y#8#7 - LI bound y#8#6 0 - PL bound y#8#6 - LI bound y#2#7 0 - PL bound y#2#7 - LI bound y#2#6 0 - PL bound y#2#6 - LI bound y#2#5 0 - PL bound y#2#5 - LI bound y#2#4 0 - PL bound y#2#4 - LI bound y#2#9 0 - PL bound y#2#9 - LI bound y#2#8 0 - PL bound y#2#8 - LI bound y#8#9 0 - PL bound y#8#9 - LI bound y#8#8 0 - PL bound y#8#8 - BV bound x#13#2 - BV bound x#13#3 - BV bound x#13#1 - BV bound x#13#6 - BV bound x#13#7 - BV bound x#13#4 - BV bound x#13#5 - LI bound y#7#6 0 - PL bound y#7#6 - LI bound y#7#7 0 - PL bound y#7#7 - BV bound x#13#8 - BV bound x#13#9 - LI bound y#7#2 0 - PL bound y#7#2 - LI bound y#7#3 0 - PL bound y#7#3 - LI bound y#7#1 0 - PL bound y#7#1 - LI bound y#4#9 0 - PL bound y#4#9 - LI bound y#4#8 0 - PL bound y#4#8 - LI bound y#3#11 0 - PL bound y#3#11 - LI bound y#3#10 0 - PL bound y#3#10 - LI bound y#4#3 0 - PL bound y#4#3 - LI bound y#3#12 0 - PL bound y#3#12 - LI bound y#4#5 0 - PL bound y#4#5 - LI bound y#4#4 0 - PL bound y#4#4 - LI bound y#4#7 0 - PL bound y#4#7 - LI bound y#4#6 0 - PL bound y#4#6 - BV bound x#1#5 - BV bound x#1#4 - BV bound x#1#7 - BV bound x#1#6 - BV bound x#1#1 - BV bound x#1#3 - BV bound x#1#2 - BV bound x#1#9 - BV bound x#1#8 - LI bound y#7#13 0 - PL bound y#7#13 - LI bound y#7#12 0 - PL bound y#7#12 - LI bound y#5#13 0 - PL bound y#5#13 - LI bound y#5#12 0 - PL bound y#5#12 - LI bound y#5#11 0 - PL bound y#5#11 - LI bound y#5#10 0 - PL bound y#5#10 - BV bound x#7#12 - BV bound x#7#13 - BV bound x#7#10 - BV bound x#7#11 - LI bound y#5#1 0 - PL bound y#5#1 - LI bound y#5#2 0 - PL bound y#5#2 - LI bound y#5#3 0 - PL bound y#5#3 - LI bound y#5#4 0 - PL bound y#5#4 - LI bound y#5#5 0 - PL bound y#5#5 - LI bound y#5#6 0 - PL bound y#5#6 - LI bound y#5#7 0 - PL bound y#5#7 - LI bound y#5#8 0 - PL bound y#5#8 - LI bound y#5#9 0 - PL bound y#5#9 - BV bound x#3#12 - BV bound x#3#13 - BV bound x#3#10 - BV bound x#3#11 - BV bound x#10#10 - BV bound x#10#11 - BV bound x#10#12 - BV bound x#10#13 - BV bound x#11#13 - BV bound x#11#12 - BV bound x#11#11 - BV bound x#11#10 - BV bound x#2#8 - BV bound x#2#9 - BV bound x#2#2 - BV bound x#2#3 - BV bound x#2#1 - BV bound x#2#6 - BV bound x#2#7 - BV bound x#2#4 - BV bound x#2#5 - LI bound y#1#13 0 - PL bound y#1#13 - LI bound y#1#12 0 - PL bound y#1#12 - LI bound y#1#11 0 - PL bound y#1#11 - LI bound y#8#13 0 - PL bound y#8#13 - BV bound x#8#13 - BV bound x#8#12 - BV bound x#8#11 - BV bound x#8#10 - LI bound y#9#8 0 - PL bound y#9#8 - LI bound y#9#9 0 - PL bound y#9#9 - LI bound y#9#4 0 - PL bound y#9#4 - LI bound y#9#5 0 - PL bound y#9#5 - LI bound y#9#6 0 - PL bound y#9#6 - LI bound y#9#7 0 - PL bound y#9#7 - LI bound y#1#8 0 - PL bound y#1#8 - LI bound y#9#1 0 - PL bound y#9#1 - LI bound y#9#2 0 - PL bound y#9#2 - LI bound y#9#3 0 - PL bound y#9#3 - LI bound y#3#2 0 - PL bound y#3#2 - LI bound y#3#3 0 - PL bound y#3#3 - LI bound y#3#6 0 - PL bound y#3#6 - LI bound y#3#7 0 - PL bound y#3#7 - LI bound y#3#4 0 - PL bound y#3#4 - LI bound y#3#5 0 - PL bound y#3#5 - LI bound y#3#8 0 - PL bound y#3#8 - LI bound y#3#9 0 - PL bound y#3#9 - LI bound y#10#8 0 - PL bound y#10#8 - LI bound y#10#9 0 - PL bound y#10#9 - LI bound y#10#6 0 - PL bound y#10#6 - LI bound y#10#7 0 - PL bound y#10#7 - LI bound y#13#5 0 - PL bound y#13#5 - LI bound y#13#4 0 - PL bound y#13#4 - LI bound y#13#7 0 - PL bound y#13#7 - LI bound y#13#6 0 - PL bound y#13#6 - LI bound y#13#1 0 - PL bound y#13#1 - LI bound y#13#3 0 - PL bound y#13#3 - LI bound y#11#12 0 - PL bound y#11#12 - LI bound y#11#13 0 - PL bound y#11#13 - LI bound y#11#10 0 - PL bound y#11#10 - LI bound y#11#11 0 - PL bound y#11#11 - LI bound y#8#5 0 - PL bound y#8#5 - LI bound y#8#4 0 - PL bound y#8#4 - LI bound y#2#1 0 - PL bound y#2#1 - LI bound y#8#1 0 - PL bound y#8#1 - LI bound y#8#3 0 - PL bound y#8#3 - LI bound y#8#2 0 - PL bound y#8#2 - LI bound y#7#8 0 - PL bound y#7#8 - LI bound y#7#9 0 - PL bound y#7#9 - LI bound y#7#4 0 - PL bound y#7#4 - LI bound y#7#5 0 - PL bound y#7#5 - LI bound y#4#1 0 - PL bound y#4#1 - LI bound y#3#13 0 - PL bound y#3#13 - LI bound y#4#2 0 - PL bound y#4#2 - LI bound y#7#11 0 - PL bound y#7#11 - LI bound y#7#10 0 - PL bound y#7#10 - LI bound y#1#1 0 - PL bound y#1#1 - LI bound y#6#9 0 - PL bound y#6#9 - LI bound y#6#8 0 - PL bound y#6#8 - LI bound y#6#5 0 - PL bound y#6#5 - LI bound y#6#4 0 - PL bound y#6#4 -ENDATA diff --git a/samples/mps/example2-2.mps b/samples/mps/example2-2.mps deleted file mode 100644 --- a/samples/mps/example2-2.mps +++ /dev/null @@ -1,23 +0,0 @@ -NAME -OBJSENSE - MIN -ROWS - N obj - L c1 - L c2 -COLUMNS - x1 c1 -1 - x1 c2 1 - x1 obj -1 - x2 c1 1 - x2 c2 -3 - x2 obj -2 - x3 c1 1 - x3 c2 1 - x3 obj -3 -RHS - rhs c1 20 - rhs c2 30 -BOUNDS - UP bound x1 40 -ENDATA diff --git a/samples/mps/factor35.mps b/samples/mps/factor35.mps deleted file mode 100644 --- a/samples/mps/factor35.mps +++ /dev/null @@ -1,19 +0,0 @@ -NAME -OBJSENSE - MIN -ROWS - N obj - E row1 -COLUMNS - MARK0000 'MARKER' 'INTORG' - P obj 1 - MARK0001 'MARKER' 'INTEND' -RHS - rhs row1 35 -BOUNDS - LI bound P 2 - UI bound P 7 -QCMATRIX row1 - P Q 0.5 - Q P 0.5 -ENDATA diff --git a/samples/mps/ind1-2.mps b/samples/mps/ind1-2.mps deleted file mode 100644 --- a/samples/mps/ind1-2.mps +++ /dev/null @@ -1,28 +0,0 @@ -NAME -OBJSENSE - MIN -ROWS - N obj - L row2 - L row4 - E row1 - E row3 -COLUMNS - x obj -1 - x row1 1 - x row2 1 - x row4 1 - z row3 1 - z row4 1 - MARK0000 'MARKER' 'INTORG' - y row4 1 - MARK0001 'MARKER' 'INTEND' -RHS - rhs row2 10 - rhs row4 15 -BOUNDS - BV bound y -INDICATORS - IF row1 y 1 - IF row3 y 0 -ENDATA diff --git a/samples/mps/intvar1-2.mps b/samples/mps/intvar1-2.mps deleted file mode 100644 --- a/samples/mps/intvar1-2.mps +++ /dev/null @@ -1,32 +0,0 @@ -NAME -OBJSENSE - MIN -ROWS - N obj - L c1 - L c2 - E c3 -COLUMNS - x1 c1 -1 - x1 c2 1 - x1 obj -1 - x2 c1 1 - x2 c2 -3 - x2 c3 1 - x2 obj -2 - x3 c1 1 - x3 c2 1 - x3 obj -3 - MARK0000 'MARKER' 'INTORG' - x4 c1 10 - x4 c3 -3.5 - x4 obj -1 - MARK0001 'MARKER' 'INTEND' -RHS - rhs c1 20 - rhs c2 30 -BOUNDS - LI bound x4 2 - UI bound x4 3 - UP bound x1 40 -ENDATA diff --git a/samples/mps/intvar2-2.mps b/samples/mps/intvar2-2.mps deleted file mode 100644 --- a/samples/mps/intvar2-2.mps +++ /dev/null @@ -1,32 +0,0 @@ -NAME -OBJSENSE - MIN -ROWS - N obj - L c1 - L c2 - E c3 -COLUMNS - x1 c1 -1 - x1 c2 1 - x1 obj -1 - x2 c1 1 - x2 c2 -3 - x2 c3 1 - x2 obj -2 - x3 c1 1 - x3 c2 1 - x3 obj -3 - MARK0000 'MARKER' 'INTORG' - x4 c1 10 - x4 c3 -3.5 - x4 obj -1 - MARK0001 'MARKER' 'INTEND' -RHS - rhs c1 20 - rhs c2 30 -BOUNDS - LI bound x4 2 - UI bound x4 3 - UP bound x1 40 -ENDATA diff --git a/samples/mps/quadobj1-2.mps b/samples/mps/quadobj1-2.mps deleted file mode 100644 --- a/samples/mps/quadobj1-2.mps +++ /dev/null @@ -1,20 +0,0 @@ -NAME -OBJSENSE - MIN -ROWS - N obj - G c1 -COLUMNS - a c1 1 - a obj 1 - b c1 1 - b obj 1 -RHS - rhs c1 10 -BOUNDS -QMATRIX - a a 1 - a b 2 - b a 2 - b b 7 -ENDATA diff --git a/samples/mps/quadobj2-2.mps b/samples/mps/quadobj2-2.mps deleted file mode 100644 --- a/samples/mps/quadobj2-2.mps +++ /dev/null @@ -1,19 +0,0 @@ -NAME -OBJSENSE - MIN -ROWS - N obj - G c1 -COLUMNS - a c1 1 - a obj 1 - b c1 1 - b obj 1 -RHS - rhs c1 10 -BOUNDS -QMATRIX - a a 1 - a b 4 - b b 7 -ENDATA diff --git a/samples/mps/ranges-2.mps b/samples/mps/ranges-2.mps deleted file mode 100644 --- a/samples/mps/ranges-2.mps +++ /dev/null @@ -1,19 +0,0 @@ -NAME -OBJSENSE - MIN -ROWS - N obj - G c1 - L c1 -COLUMNS - x1 c1 1 - x1 obj -1 - x2 c1 -3 - x2 obj -2 - x3 c1 1 - x3 obj -3 -RHS - rhs c1 15 - rhs c1 30 -BOUNDS -ENDATA diff --git a/samples/mps/sc-2.mps b/samples/mps/sc-2.mps deleted file mode 100644 --- a/samples/mps/sc-2.mps +++ /dev/null @@ -1,15 +0,0 @@ -NAME -OBJSENSE - MIN -ROWS - N obj - E c1 -COLUMNS - x1 c1 1 - x1 obj -1 -RHS - rhs c1 0.5 -BOUNDS - LO bound x1 0 - SC bound x1 40 -ENDATA diff --git a/samples/mps/sos-2.mps b/samples/mps/sos-2.mps deleted file mode 100644 --- a/samples/mps/sos-2.mps +++ /dev/null @@ -1,37 +0,0 @@ -NAME -OBJSENSE - MIN -ROWS - N obj - L c1 - L c2 - E c3 -COLUMNS - x1 c1 -1 - x1 c2 1 - x1 obj -1 - x2 c1 1 - x2 c2 -3 - x2 c3 1 - x2 obj -2 - x3 c1 1 - x3 c2 1 - x3 obj -3 - MARK0000 'MARKER' 'INTORG' - x4 c1 10 - x4 c3 -3.5 - x4 obj -1 - MARK0001 'MARKER' 'INTEND' -RHS - rhs c1 20 - rhs c2 30 -BOUNDS - LI bound x4 2 - UI bound x4 3 - UP bound x1 40 -SOS - S1 set1 - x1 10000 - x2 20000 - x4 40000 -ENDATA diff --git a/samples/mps/test-qcp-2.mps b/samples/mps/test-qcp-2.mps deleted file mode 100644 --- a/samples/mps/test-qcp-2.mps +++ /dev/null @@ -1,38 +0,0 @@ -NAME -OBJSENSE - MAX -ROWS - N obj1 - E c0 - L c1 - L qc0 -COLUMNS - MARK0000 'MARKER' 'INTORG' - x c0 1 - x c1 1 - x obj1 1 - x qc0 1 - y c0 1 - y c1 5 - y obj1 1 - y qc0 1 - z c1 2 - z obj1 1 - MARK0001 'MARKER' 'INTEND' -RHS - rhs c0 1 - rhs c1 10 - rhs qc0 5 -BOUNDS - LI bound x 0 - UI bound x 5 - LI bound y 0 - PL bound y - LI bound z 2 - PL bound z -QCMATRIX qc0 - x x 1 - x y -1 - y x -1 - y y 3 -ENDATA diff --git a/samples/mps/test-semiint-gurobi-2.mps b/samples/mps/test-semiint-gurobi-2.mps deleted file mode 100644 --- a/samples/mps/test-semiint-gurobi-2.mps +++ /dev/null @@ -1,25 +0,0 @@ -NAME -OBJSENSE - MIN -ROWS - N OBJ - L c1 - L c2 -COLUMNS - x2 c1 1 - x2 c2 1 - MARK0000 'MARKER' 'INTORG' - x1 c1 -1 - x1 c2 1 - x3 OBJ -2 - x3 c2 1 - MARK0001 'MARKER' 'INTEND' -RHS - rhs c1 10 - rhs c2 20 -BOUNDS - LO bound x1 2.1 - SC bound x1 30 - LO bound x3 2 - SC bound x3 3 -ENDATA diff --git a/samples/mps/test-semiint-lpsolve-2.mps b/samples/mps/test-semiint-lpsolve-2.mps deleted file mode 100644 --- a/samples/mps/test-semiint-lpsolve-2.mps +++ /dev/null @@ -1,25 +0,0 @@ -NAME -OBJSENSE - MIN -ROWS - N OBJ - L c1 - L c2 -COLUMNS - x2 c1 1 - x2 c2 1 - MARK0000 'MARKER' 'INTORG' - x1 c1 -1 - x1 c2 1 - x3 OBJ -2 - x3 c2 1 - MARK0001 'MARKER' 'INTEND' -RHS - rhs c1 10 - rhs c2 20 -BOUNDS - LO bound x1 2.1 - SC bound x1 30 - LO bound x3 2 - SC bound x3 3 -ENDATA diff --git a/samples/programs/nonogram/README.md b/samples/programs/nonogram/README.md new file mode 100644 --- /dev/null +++ b/samples/programs/nonogram/README.md @@ -0,0 +1,10 @@ +nonogram +======== + +LICENSE +------- + +`sample.cwd` is a nonogram problem made by Juraj Simlovic available at + +under [Creative Commons Attribution-Share Alike 3.0 Unported](https://creativecommons.org/licenses/by-sa/3.0/deed.en) +or [GNU Free Documentation License](https://en.wikipedia.org/wiki/en:GNU_Free_Documentation_License). diff --git a/samples/programs/nonogram/nonogram.hs b/samples/programs/nonogram/nonogram.hs new file mode 100644 --- /dev/null +++ b/samples/programs/nonogram/nonogram.hs @@ -0,0 +1,203 @@ +{-# LANGUAGE ScopedTypeVariables, FlexibleContexts #-} +{-# OPTIONS_GHC -Wall #-} +module Main where + +import Control.Applicative +import Control.Monad +import Data.Array.IArray +import Data.Array.Unboxed +import Data.IORef +import Data.List (group) +import Data.Map (Map) +import qualified Data.Map as Map +import System.Console.GetOpt +import System.Environment +import System.Exit +import System.IO +import qualified ToySolver.SAT as SAT +import qualified ToySolver.SAT.TseitinEncoder as Tseitin + +-- row patterns and column patterns +type Problem = ([[Int]], [[Int]]) + +type Solution = UArray (Int,Int) Bool + +readCWDFile :: FilePath -> IO Problem +readCWDFile fname = withFile fname ReadMode hReadCWD + +hReadCWD :: Handle -> IO Problem +hReadCWD h = do + nrows <- read <$> hGetLine h + ncols <- read <$> hGetLine h + (rows::[[Int]]) <- replicateM nrows $ liftM (filter (/=0) . map read . words) $ hGetLine h + _ <- hGetLine h -- empty line + (cols::[[Int]]) <- replicateM ncols $ liftM (filter (/=0) . map read . words) $ hGetLine h + unless (length rows == nrows) $ error "row number mismatch" + unless (length cols == ncols) $ error "column number mismatch" + return (rows, cols) + +checkSolution :: Problem -> Solution -> IO () +checkSolution (rows, cols) sol = do + let nrows = length rows + ncols = length cols + forM_ [0..nrows-1] $ \i -> do + let row_i_expected = rows !! i + row_i_actual = [length g | g <- group [sol ! (i,j) | j <- [0..ncols-1]], head g] + unless (row_i_expected == row_i_actual) $ error (show row_i_expected ++ " /= " ++ show row_i_actual) + forM_ [0..ncols-1] $ \j -> do + let col_j_expected = cols !! j + col_j_actual = [length g | g <- group [sol ! (i,j) | i <- [0..nrows-1]], head g] + unless (col_j_expected == col_j_actual) $ error (show col_j_expected ++ " /= " ++ show col_j_actual) + +hPrintSolution :: Handle -> Solution -> Char -> Char -> IO () +hPrintSolution h sol cell0 cell1 = do + let ((r0,c0),(rn,cn)) = bounds sol + forM_ [r0..rn] $ \i -> do + hPutStrLn h [if sol ! (i,j) then cell1 else cell0 | j <- [c0..cn]] + +solve :: Problem -> IO (IO (Maybe Solution)) +solve (rows, cols) = do + let nrows = length rows + ncols = length cols + solver <- SAT.newSolver + enc <- Tseitin.newEncoder solver + + bTrue <- Tseitin.encodeConj enc [] + bFalse <- Tseitin.encodeDisj enc [] + + (bs :: UArray (Int,Int) SAT.Lit) <- liftM (array ((0,0),(nrows-1,ncols-1)) . concat) $ forM [0..nrows-1] $ \i -> do + forM [0..ncols-1] $ \j -> do + b <- SAT.newVar solver + return ((i,j),b) + + forM_ (zip [0..] rows) $ \(i, xs) -> do + ref <- newIORef Map.empty + let f j [] + | j >= ncols = return bTrue + | otherwise = do + m <- readIORef ref + case Map.lookup (j,[]) m of + Just b -> return b + Nothing -> do + b' <- f (j+1) [] + b <- Tseitin.encodeConj enc [- (bs ! (i,j)), b'] + writeIORef ref (Map.insert (j,[]) b m) + return b + f j ns@(_ : _) | j + sum ns + length ns - 1 > ncols = return bFalse + f j (n : ns) = do + m <- readIORef ref + case Map.lookup (j, n:ns) m of + Just b -> return b + Nothing -> do + b1 <- do + b1' <- f (j+1) (n : ns) + Tseitin.encodeConj enc [- (bs ! (i,j)), b1'] + b2 <- do + b2' <- f (j+n+1) ns + Tseitin.encodeConj enc $ [bs ! (i,j') | j' <- [j..j+n-1]] ++ [- (bs ! (i,j+n)) | j+n < ncols] ++ [b2'] + b <- Tseitin.encodeDisj enc [b1,b2] + writeIORef ref (Map.insert (j,n:ns) b m) + return b + b <- f 0 xs + SAT.addClause solver [b] + + forM_ (zip [0..] cols) $ \(j, xs) -> do + ref <- newIORef Map.empty + let f i [] + | i >= nrows = return bTrue + | otherwise = do + m <- readIORef ref + case Map.lookup (i,[]) m of + Just b -> return b + Nothing -> do + b' <- f (i+1) [] + b <- Tseitin.encodeConj enc [- (bs ! (i,j)), b'] + writeIORef ref (Map.insert (i,[]) b m) + return b + f i ns@(_ : _) | i + sum ns + length ns - 1 > nrows = return bFalse + f i (n : ns) = do + m <- readIORef ref + case Map.lookup (i, n:ns) m of + Just b -> return b + Nothing -> do + b1 <- do + b1' <- f (i+1) (n : ns) + Tseitin.encodeConj enc [- (bs ! (i,j)), b1'] + b2 <- do + b2' <- f (i+n+1) ns + Tseitin.encodeConj enc $ [bs ! (i',j) | i' <- [i..i+n-1]] ++ [- (bs ! (i+n,j)) | i+n < nrows] ++ [b2'] + b <- Tseitin.encodeDisj enc [b1,b2] + writeIORef ref (Map.insert (i,n:ns) b m) + return b + b <- f 0 xs + SAT.addClause solver [b] + + return $ do + ret <- SAT.solve solver + if not ret then + return Nothing + else do + m <- SAT.getModel solver + SAT.addClause solver [if val then -var else var | (var,val) <- assocs m] + let sol = amap (SAT.evalLit m) bs + return (Just sol) + +data Options + = Options + { optHelp :: Bool + , optSolLim :: Int + } + +defaultOptions :: Options +defaultOptions = + Options + { optHelp = False + , optSolLim = 1 + } + +options :: [OptDescr (Options -> Options)] +options = + [ Option ['h'] ["help"] (NoArg (\opt -> opt{ optHelp = True })) "show help" + , Option ['n'] [] + (ReqArg (\val opt -> opt{ optSolLim = read val }) "") + "maximum number of solutions to enumerate, or -1 to enumerate all solutions (default: 1)" + ] + +showHelp :: Handle -> IO () +showHelp h = hPutStrLn h (usageInfo header options) + where + header = "Usage: nonogram [OPTIONS] FILE" + +main :: IO () +main = do + args <- getArgs + case getOpt Permute options args of + (_,_,errs@(_:_)) -> do + mapM_ putStrLn errs + exitFailure + (o,args2,[]) -> do + let opt = foldl (flip id) defaultOptions o + when (optHelp opt) $ do + showHelp stdout + exitSuccess + case args2 of + [] -> do + showHelp stderr + exitFailure + fname : _ -> do + prob <- readCWDFile fname + act <- solve prob + let loop n | optSolLim opt >= 0, n >= optSolLim opt = do + hPutStrLn stderr $ "reached to solution enumeration limit " ++ show n + loop n = do + m <- act + case m of + Nothing -> do + hPutStrLn stderr $ "enumerated all of " ++ show n ++ " solutions" + Just sol -> do + checkSolution prob sol + when (n > 0) $ hPutStrLn stdout "" + hPrintSolution stdout sol '.' '#' + hFlush stdout + loop (n+1) + loop (0::Int) diff --git a/samples/programs/nonogram/sample.cwd b/samples/programs/nonogram/sample.cwd new file mode 100644 --- /dev/null +++ b/samples/programs/nonogram/sample.cwd @@ -0,0 +1,43 @@ +20 +20 +3 +5 +3 1 +2 1 +3 3 4 +2 2 7 +6 1 1 +4 2 2 +1 1 +3 1 +6 +2 7 +6 3 1 +1 2 2 1 1 +4 1 1 3 +4 2 2 +3 3 1 +3 3 +3 +2 1 + +2 +1 2 +2 3 +2 3 +3 1 1 +2 1 1 +1 1 1 2 2 +1 1 3 1 3 +2 6 4 +3 3 9 1 +5 3 2 +3 1 2 2 +2 1 7 +3 3 2 +2 4 +2 1 2 +2 2 1 +2 2 +1 +1 diff --git a/samples/programs/nqueens/nqueens.hs b/samples/programs/nqueens/nqueens.hs --- a/samples/programs/nqueens/nqueens.hs +++ b/samples/programs/nqueens/nqueens.hs @@ -6,7 +6,6 @@ import Data.Array.IArray import System.Environment import qualified ToySolver.SAT as SAT -import qualified ToySolver.SAT.Types as SAT main :: IO () main = do diff --git a/samples/programs/svm2lp/a1a b/samples/programs/svm2lp/a1a new file mode 100644 --- /dev/null +++ b/samples/programs/svm2lp/a1a @@ -0,0 +1,1605 @@ +-1 3:1 11:1 14:1 19:1 39:1 42:1 55:1 64:1 67:1 73:1 75:1 76:1 80:1 83:1 +-1 3:1 6:1 17:1 27:1 35:1 40:1 57:1 63:1 69:1 73:1 74:1 76:1 81:1 103:1 +-1 4:1 6:1 15:1 21:1 35:1 40:1 57:1 63:1 67:1 73:1 74:1 77:1 80:1 83:1 +-1 5:1 6:1 15:1 22:1 36:1 41:1 47:1 66:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 16:1 22:1 36:1 40:1 54:1 63:1 67:1 73:1 75:1 76:1 80:1 83:1 +-1 2:1 6:1 14:1 20:1 37:1 41:1 47:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 14:1 22:1 36:1 42:1 49:1 64:1 67:1 72:1 74:1 77:1 80:1 83:1 +-1 1:1 6:1 17:1 19:1 39:1 42:1 53:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 18:1 20:1 37:1 42:1 48:1 64:1 71:1 73:1 74:1 76:1 81:1 83:1 ++1 5:1 11:1 15:1 32:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 5:1 16:1 30:1 35:1 41:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 15:1 20:1 37:1 40:1 50:1 63:1 67:1 73:1 75:1 76:1 80:1 83:1 +-1 5:1 7:1 16:1 29:1 39:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 1:1 11:1 18:1 20:1 37:1 42:1 59:1 62:1 71:1 72:1 74:1 76:1 80:1 83:1 ++1 5:1 18:1 19:1 39:1 40:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 11:1 18:1 20:1 37:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 17:1 22:1 36:1 42:1 53:1 64:1 67:1 73:1 74:1 76:1 82:1 107:1 +-1 1:1 6:1 14:1 20:1 37:1 40:1 55:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 18:1 22:1 36:1 44:1 51:1 66:1 71:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 15:1 19:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 6:1 16:1 19:1 39:1 42:1 48:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 1:1 10:1 18:1 22:1 36:1 42:1 56:1 64:1 67:1 73:1 74:1 76:1 80:1 100:1 +-1 5:1 6:1 14:1 20:1 37:1 41:1 55:1 64:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 3:1 6:1 14:1 22:1 36:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 5:1 6:1 14:1 27:1 35:1 42:1 57:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 10:1 18:1 22:1 36:1 43:1 51:1 64:1 71:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 8:1 14:1 19:1 39:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 7:1 18:1 22:1 36:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 2:1 6:1 14:1 20:1 37:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 5:1 6:1 14:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 5:1 15:1 22:1 36:1 40:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 15:1 21:1 35:1 45:1 62:1 68:1 72:1 74:1 77:1 80:1 93:1 +-1 3:1 6:1 14:1 20:1 37:1 41:1 55:1 66:1 71:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 17:1 22:1 36:1 40:1 49:1 63:1 67:1 73:1 74:1 76:1 80:1 103:1 +-1 5:1 6:1 16:1 20:1 37:1 41:1 55:1 64:1 68:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 16:1 25:1 38:1 40:1 55:1 63:1 67:1 73:1 74:1 77:1 81:1 83:1 +-1 5:1 6:1 15:1 22:1 36:1 42:1 50:1 64:1 67:1 73:1 74:1 76:1 79:1 83:1 ++1 3:1 6:1 17:1 19:1 39:1 42:1 50:1 64:1 70:1 72:1 74:1 76:1 82:1 83:1 +-1 5:1 7:1 14:1 22:1 36:1 40:1 56:1 63:1 67:1 73:1 74:1 77:1 82:1 83:1 +-1 1:1 6:1 17:1 22:1 36:1 42:1 50:1 64:1 67:1 72:1 75:1 76:1 80:1 83:1 ++1 4:1 6:1 14:1 29:1 39:1 42:1 47:1 64:1 67:1 73:1 74:1 76:1 79:1 83:1 +-1 3:1 6:1 15:1 22:1 36:1 42:1 57:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 5:1 6:1 15:1 22:1 36:1 40:1 49:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 14:1 26:1 35:1 41:1 54:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 14:1 22:1 36:1 42:1 53:1 62:1 67:1 72:1 74:1 76:1 80:1 83:1 ++1 3:1 6:1 16:1 21:1 35:1 40:1 54:1 63:1 67:1 73:1 75:1 76:1 81:1 83:1 +-1 3:1 6:1 15:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 18:1 22:1 36:1 42:1 49:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 17:1 20:1 37:1 42:1 51:1 64:1 67:1 72:1 75:1 76:1 80:1 83:1 +-1 5:1 7:1 15:1 22:1 36:1 42:1 56:1 66:1 67:1 73:1 74:1 76:1 81:1 83:1 ++1 5:1 6:1 16:1 32:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 77:1 82:1 83:1 +-1 3:1 6:1 16:1 29:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 3:1 6:1 15:1 22:1 36:1 42:1 49:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 14:1 20:1 37:1 42:1 50:1 64:1 67:1 72:1 74:1 76:1 82:1 83:1 ++1 5:1 7:1 18:1 19:1 39:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 80:1 87:1 +-1 5:1 6:1 15:1 22:1 36:1 40:1 54:1 63:1 67:1 73:1 75:1 76:1 80:1 83:1 +-1 2:1 6:1 15:1 19:1 39:1 42:1 50:1 64:1 71:1 72:1 74:1 77:1 80:1 83:1 +-1 3:1 6:1 15:1 22:1 36:1 41:1 48:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 4:1 6:1 15:1 19:1 39:1 40:1 48:1 63:1 67:1 73:1 75:1 76:1 80:1 83:1 +-1 4:1 6:1 18:1 25:1 38:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 4:1 6:1 17:1 22:1 36:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 16:1 22:1 36:1 41:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 ++1 4:1 7:1 17:1 29:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 5:1 7:1 17:1 20:1 37:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 5:1 6:1 18:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 4:1 6:1 16:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 16:1 20:1 37:1 42:1 49:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 5:1 6:1 14:1 20:1 37:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 16:1 22:1 36:1 44:1 55:1 62:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 4:1 7:1 16:1 20:1 37:1 40:1 56:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 4:1 6:1 14:1 20:1 37:1 42:1 55:1 62:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 18:1 22:1 36:1 43:1 55:1 64:1 67:1 72:1 74:1 76:1 78:1 83:1 ++1 5:1 6:1 15:1 22:1 36:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 15:1 20:1 37:1 42:1 55:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 ++1 5:1 6:1 15:1 20:1 37:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 ++1 3:1 6:1 17:1 22:1 36:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 11:1 14:1 20:1 37:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 14:1 21:1 35:1 42:1 49:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 3:1 6:1 17:1 24:1 38:1 42:1 55:1 62:1 67:1 72:1 74:1 76:1 81:1 83:1 ++1 3:1 6:1 18:1 22:1 36:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 18:1 22:1 36:1 41:1 48:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 6:1 14:1 20:1 37:1 40:1 48:1 63:1 67:1 73:1 74:1 77:1 81:1 83:1 +-1 1:1 6:1 14:1 25:1 38:1 42:1 59:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 17:1 21:1 35:1 42:1 55:1 62:1 68:1 72:1 74:1 76:1 78:1 83:1 +-1 2:1 6:1 14:1 20:1 37:1 41:1 51:1 66:1 67:1 72:1 74:1 76:1 80:1 83:1 ++1 2:1 6:1 18:1 22:1 36:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 5:1 11:1 14:1 22:1 36:1 41:1 51:1 64:1 67:1 72:1 74:1 76:1 82:1 83:1 +-1 4:1 6:1 14:1 22:1 36:1 42:1 49:1 64:1 71:1 72:1 74:1 76:1 81:1 83:1 +-1 5:1 6:1 15:1 26:1 35:1 41:1 49:1 64:1 67:1 72:1 74:1 76:1 79:1 87:1 +-1 2:1 6:1 17:1 22:1 36:1 42:1 49:1 64:1 67:1 72:1 74:1 76:1 79:1 83:1 +-1 3:1 6:1 17:1 22:1 36:1 42:1 54:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 ++1 4:1 6:1 16:1 19:1 39:1 40:1 52:1 61:1 67:1 72:1 75:1 76:1 78:1 83:1 ++1 2:1 6:1 16:1 20:1 37:1 40:1 47:1 63:1 67:1 73:1 75:1 76:1 80:1 83:1 ++1 4:1 6:1 16:1 22:1 36:1 40:1 49:1 61:1 71:1 72:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 16:1 22:1 36:1 42:1 48:1 65:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 11:1 16:1 19:1 39:1 42:1 55:1 64:1 67:1 73:1 74:1 76:1 79:1 83:1 +-1 2:1 6:1 18:1 20:1 37:1 41:1 55:1 64:1 67:1 72:1 74:1 76:1 81:1 83:1 +-1 1:1 6:1 18:1 22:1 36:1 42:1 49:1 66:1 67:1 73:1 74:1 76:1 80:1 119:1 ++1 4:1 6:1 14:1 20:1 37:1 40:1 47:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 ++1 5:1 10:1 16:1 29:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 16:1 20:1 37:1 42:1 50:1 64:1 71:1 72:1 74:1 76:1 79:1 83:1 +-1 3:1 6:1 14:1 22:1 36:1 42:1 48:1 66:1 67:1 73:1 74:1 76:1 79:1 83:1 +-1 2:1 6:1 18:1 22:1 36:1 42:1 56:1 62:1 71:1 73:1 74:1 76:1 78:1 83:1 +-1 5:1 6:1 16:1 20:1 37:1 42:1 55:1 65:1 71:1 72:1 74:1 76:1 80:1 101:1 +-1 4:1 10:1 15:1 29:1 39:1 41:1 52:1 64:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 2:1 7:1 17:1 25:1 38:1 41:1 50:1 66:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 2:1 9:1 16:1 24:1 38:1 40:1 55:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 16:1 20:1 37:1 42:1 55:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 18:1 31:1 35:1 42:1 50:1 65:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 5:1 6:1 15:1 20:1 37:1 44:1 48:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 10:1 16:1 19:1 39:1 43:1 52:1 64:1 67:1 73:1 74:1 76:1 78:1 +-1 4:1 6:1 15:1 22:1 36:1 42:1 50:1 64:1 71:1 72:1 74:1 76:1 81:1 83:1 ++1 3:1 7:1 18:1 19:1 39:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 3:1 10:1 17:1 19:1 39:1 40:1 55:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 15:1 22:1 36:1 42:1 50:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 11:1 15:1 29:1 39:1 42:1 55:1 64:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 5:1 10:1 15:1 20:1 37:1 41:1 55:1 66:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 18:1 31:1 35:1 43:1 49:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 2:1 7:1 15:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 8:1 14:1 19:1 39:1 40:1 54:1 63:1 67:1 73:1 75:1 76:1 78:1 83:1 +-1 2:1 6:1 18:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 17:1 20:1 37:1 41:1 50:1 66:1 67:1 72:1 74:1 76:1 82:1 83:1 ++1 5:1 6:1 15:1 19:1 39:1 40:1 51:1 63:1 67:1 73:1 75:1 76:1 82:1 83:1 +-1 3:1 6:1 14:1 22:1 36:1 41:1 50:1 64:1 67:1 72:1 74:1 76:1 82:1 83:1 +-1 5:1 16:1 22:1 36:1 40:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 3:1 6:1 17:1 19:1 39:1 40:1 52:1 63:1 67:1 73:1 75:1 76:1 82:1 83:1 +-1 3:1 6:1 15:1 19:1 39:1 40:1 52:1 63:1 68:1 73:1 74:1 76:1 81:1 +-1 1:1 6:1 17:1 20:1 37:1 42:1 49:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 17:1 33:1 35:1 42:1 57:1 64:1 67:1 73:1 74:1 76:1 80:1 103:1 +-1 1:1 6:1 15:1 29:1 39:1 42:1 50:1 64:1 67:1 73:1 74:1 76:1 78:1 83:1 ++1 5:1 9:1 14:1 22:1 36:1 40:1 51:1 63:1 67:1 73:1 75:1 76:1 80:1 83:1 +-1 4:1 9:1 18:1 21:1 35:1 42:1 47:1 64:1 67:1 73:1 74:1 77:1 80:1 83:1 +-1 1:1 11:1 18:1 20:1 37:1 42:1 55:1 64:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 3:1 7:1 17:1 20:1 37:1 43:1 49:1 62:1 67:1 72:1 74:1 76:1 80:1 95:1 +-1 3:1 6:1 18:1 23:1 39:1 42:1 52:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 2:1 6:1 14:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 17:1 20:1 37:1 42:1 52:1 64:1 67:1 73:1 74:1 77:1 80:1 ++1 3:1 6:1 17:1 19:1 39:1 40:1 51:1 63:1 67:1 73:1 75:1 76:1 80:1 83:1 +-1 1:1 6:1 18:1 20:1 37:1 42:1 49:1 62:1 67:1 73:1 74:1 76:1 79:1 83:1 +-1 3:1 6:1 16:1 20:1 37:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 6:1 15:1 21:1 35:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 2:1 9:1 18:1 19:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 16:1 22:1 36:1 40:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 17:1 22:1 36:1 42:1 59:1 65:1 71:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 9:1 14:1 22:1 36:1 46:1 50:1 61:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 14:1 22:1 36:1 43:1 55:1 66:1 67:1 72:1 74:1 76:1 81:1 83:1 +-1 2:1 10:1 15:1 29:1 39:1 42:1 55:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 18:1 34:1 35:1 42:1 49:1 65:1 67:1 72:1 74:1 76:1 79:1 103:1 +-1 1:1 18:1 22:1 36:1 42:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 ++1 5:1 10:1 17:1 21:1 35:1 40:1 48:1 63:1 71:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 11:1 14:1 19:1 39:1 42:1 52:1 64:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 2:1 16:1 22:1 36:1 42:1 62:1 71:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 11:1 15:1 20:1 37:1 42:1 49:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 16:1 20:1 37:1 42:1 55:1 62:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 17:1 22:1 36:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 4:1 6:1 15:1 22:1 36:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 5:1 6:1 17:1 25:1 38:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 88:1 +-1 4:1 6:1 14:1 22:1 36:1 42:1 54:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 3:1 6:1 17:1 29:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 79:1 83:1 +-1 3:1 6:1 18:1 19:1 39:1 40:1 50:1 61:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 2:1 6:1 14:1 24:1 38:1 40:1 53:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 15:1 22:1 36:1 45:1 48:1 64:1 67:1 73:1 74:1 76:1 80:1 100:1 ++1 2:1 10:1 18:1 32:1 39:1 42:1 52:1 64:1 67:1 73:1 74:1 76:1 82:1 103:1 +-1 4:1 6:1 14:1 20:1 37:1 42:1 56:1 65:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 5:1 6:1 17:1 21:1 35:1 41:1 48:1 65:1 67:1 72:1 74:1 76:1 80:1 83:1 ++1 4:1 6:1 16:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 75:1 76:1 81:1 83:1 +-1 3:1 6:1 18:1 20:1 37:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 14:1 22:1 36:1 43:1 49:1 62:1 67:1 72:1 74:1 76:1 79:1 83:1 +-1 3:1 7:1 17:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 5:1 16:1 22:1 36:1 40:1 63:1 71:1 73:1 74:1 76:1 78:1 83:1 +-1 2:1 6:1 17:1 25:1 38:1 40:1 54:1 63:1 69:1 73:1 74:1 76:1 80:1 83:1 ++1 4:1 11:1 16:1 19:1 39:1 40:1 51:1 63:1 67:1 73:1 75:1 76:1 80:1 83:1 +-1 3:1 10:1 18:1 24:1 38:1 41:1 52:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 4:1 8:1 18:1 20:1 37:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 5:1 7:1 18:1 19:1 39:1 40:1 47:1 61:1 67:1 72:1 74:1 76:1 82:1 83:1 +-1 5:1 6:1 14:1 22:1 36:1 41:1 49:1 64:1 67:1 72:1 74:1 76:1 79:1 83:1 ++1 4:1 6:1 17:1 20:1 37:1 40:1 48:1 63:1 71:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 16:1 22:1 36:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 6:1 18:1 22:1 36:1 41:1 51:1 66:1 67:1 72:1 74:1 77:1 82:1 83:1 +-1 1:1 6:1 18:1 20:1 37:1 42:1 49:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 ++1 3:1 6:1 16:1 29:1 39:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 15:1 22:1 36:1 42:1 53:1 62:1 71:1 72:1 74:1 76:1 78:1 83:1 ++1 5:1 6:1 16:1 19:1 39:1 41:1 51:1 64:1 71:1 73:1 75:1 76:1 80:1 83:1 ++1 3:1 6:1 14:1 20:1 37:1 40:1 47:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 4:1 6:1 15:1 22:1 36:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 17:1 22:1 36:1 42:1 52:1 64:1 67:1 72:1 74:1 76:1 80:1 87:1 +-1 4:1 6:1 17:1 33:1 35:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 79:1 103:1 +-1 2:1 6:1 18:1 20:1 37:1 41:1 53:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 2:1 6:1 18:1 22:1 36:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 3:1 6:1 14:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 77:1 80:1 83:1 +-1 2:1 6:1 15:1 20:1 37:1 40:1 55:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 2:1 10:1 15:1 22:1 36:1 42:1 59:1 65:1 71:1 73:1 74:1 77:1 80:1 83:1 ++1 3:1 6:1 14:1 22:1 36:1 40:1 57:1 63:1 67:1 73:1 75:1 76:1 82:1 83:1 +-1 2:1 6:1 17:1 19:1 39:1 40:1 49:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 11:1 15:1 19:1 39:1 42:1 52:1 66:1 67:1 72:1 74:1 76:1 78:1 83:1 ++1 4:1 6:1 17:1 19:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 77:1 80:1 83:1 ++1 4:1 6:1 14:1 25:1 38:1 40:1 50:1 63:1 67:1 73:1 74:1 77:1 82:1 83:1 +-1 5:1 6:1 16:1 20:1 37:1 41:1 50:1 64:1 67:1 72:1 74:1 76:1 82:1 83:1 ++1 5:1 9:1 14:1 22:1 36:1 40:1 55:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 5:1 16:1 20:1 37:1 40:1 61:1 67:1 72:1 74:1 76:1 81:1 83:1 +-1 1:1 16:1 20:1 37:1 42:1 62:1 71:1 73:1 74:1 76:1 78:1 83:1 +-1 5:1 6:1 15:1 22:1 36:1 40:1 49:1 63:1 71:1 73:1 74:1 76:1 82:1 85:1 +-1 5:1 6:1 14:1 29:1 39:1 41:1 52:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 4:1 14:1 22:1 36:1 43:1 66:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 4:1 6:1 18:1 21:1 35:1 40:1 57:1 63:1 67:1 73:1 74:1 77:1 80:1 83:1 +-1 1:1 6:1 17:1 20:1 37:1 42:1 50:1 62:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 17:1 22:1 36:1 42:1 55:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 16:1 22:1 36:1 42:1 53:1 62:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 14:1 22:1 36:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 5:1 6:1 14:1 22:1 36:1 40:1 53:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 16:1 20:1 37:1 42:1 53:1 64:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 4:1 11:1 15:1 22:1 36:1 40:1 59:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 7:1 15:1 25:1 38:1 40:1 56:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 8:1 16:1 19:1 39:1 42:1 50:1 64:1 67:1 73:1 75:1 76:1 82:1 83:1 +-1 1:1 6:1 17:1 21:1 35:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 6:1 16:1 22:1 36:1 40:1 57:1 63:1 67:1 73:1 75:1 76:1 80:1 83:1 ++1 5:1 6:1 16:1 19:1 39:1 43:1 51:1 64:1 67:1 73:1 75:1 76:1 81:1 83:1 +-1 1:1 6:1 17:1 22:1 36:1 40:1 56:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 18:1 20:1 37:1 42:1 62:1 67:1 72:1 74:1 76:1 79:1 83:1 ++1 4:1 6:1 17:1 22:1 36:1 40:1 47:1 63:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 1:1 6:1 15:1 20:1 37:1 42:1 55:1 62:1 68:1 72:1 74:1 76:1 80:1 102:1 +-1 5:1 6:1 14:1 22:1 36:1 44:1 49:1 66:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 17:1 19:1 39:1 42:1 50:1 64:1 67:1 72:1 74:1 76:1 81:1 83:1 +-1 1:1 6:1 17:1 20:1 37:1 42:1 50:1 64:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 5:1 6:1 14:1 22:1 36:1 42:1 55:1 66:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 14:1 22:1 36:1 42:1 53:1 62:1 67:1 73:1 74:1 76:1 79:1 83:1 +-1 1:1 6:1 16:1 28:1 35:1 42:1 50:1 64:1 67:1 72:1 74:1 76:1 78:1 +-1 5:1 6:1 15:1 20:1 37:1 44:1 51:1 66:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 4:1 7:1 17:1 27:1 35:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 99:1 +-1 2:1 7:1 17:1 22:1 36:1 41:1 56:1 66:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 2:1 6:1 18:1 20:1 37:1 40:1 50:1 63:1 70:1 73:1 74:1 76:1 82:1 ++1 5:1 6:1 15:1 24:1 38:1 40:1 51:1 61:1 71:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 9:1 14:1 25:1 38:1 42:1 52:1 65:1 68:1 73:1 74:1 76:1 80:1 83:1 ++1 2:1 10:1 15:1 19:1 39:1 42:1 52:1 64:1 71:1 73:1 75:1 76:1 81:1 ++1 5:1 7:1 14:1 22:1 36:1 40:1 51:1 63:1 67:1 73:1 75:1 76:1 82:1 83:1 +-1 5:1 7:1 15:1 20:1 37:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 14:1 24:1 38:1 42:1 55:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 15:1 20:1 37:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 18:1 27:1 35:1 42:1 56:1 66:1 70:1 73:1 74:1 76:1 79:1 103:1 +-1 4:1 7:1 14:1 20:1 37:1 42:1 56:1 62:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 17:1 20:1 37:1 42:1 48:1 65:1 68:1 72:1 74:1 76:1 80:1 84:1 ++1 4:1 8:1 15:1 19:1 39:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 18:1 22:1 36:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 18:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 4:1 6:1 18:1 22:1 36:1 41:1 49:1 66:1 71:1 73:1 74:1 76:1 78:1 83:1 ++1 3:1 8:1 17:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 82:1 ++1 4:1 6:1 18:1 20:1 37:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 2:1 6:1 18:1 20:1 37:1 42:1 50:1 64:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 2:1 10:1 17:1 20:1 37:1 42:1 55:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 3:1 6:1 17:1 22:1 36:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 6:1 18:1 31:1 35:1 40:1 56:1 63:1 67:1 73:1 74:1 76:1 79:1 103:1 +-1 1:1 6:1 15:1 28:1 35:1 42:1 50:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 ++1 5:1 10:1 15:1 19:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 77:1 80:1 83:1 +-1 3:1 7:1 18:1 30:1 35:1 45:1 48:1 64:1 67:1 73:1 74:1 76:1 80:1 103:1 +-1 4:1 6:1 18:1 30:1 35:1 42:1 49:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 15:1 28:1 35:1 42:1 50:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 2:1 6:1 18:1 19:1 39:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 10:1 16:1 22:1 36:1 41:1 57:1 64:1 71:1 72:1 74:1 76:1 79:1 83:1 +-1 5:1 6:1 15:1 25:1 38:1 44:1 52:1 64:1 67:1 72:1 74:1 76:1 79:1 83:1 +-1 4:1 10:1 15:1 20:1 37:1 41:1 55:1 66:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 17:1 20:1 37:1 42:1 50:1 65:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 17:1 19:1 39:1 42:1 51:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 3:1 10:1 17:1 29:1 39:1 40:1 52:1 61:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 14:1 20:1 37:1 42:1 53:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 18:1 26:1 35:1 43:1 53:1 65:1 67:1 73:1 74:1 76:1 80:1 119:1 ++1 1:1 6:1 16:1 19:1 39:1 40:1 51:1 61:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 18:1 31:1 35:1 42:1 50:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 2:1 6:1 18:1 19:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 10:1 18:1 29:1 39:1 44:1 52:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 15:1 19:1 39:1 42:1 55:1 62:1 67:1 72:1 74:1 76:1 78:1 119:1 ++1 3:1 11:1 14:1 29:1 39:1 40:1 52:1 63:1 67:1 73:1 75:1 76:1 79:1 83:1 +-1 5:1 6:1 15:1 33:1 35:1 40:1 53:1 63:1 67:1 73:1 74:1 76:1 82:1 ++1 4:1 6:1 15:1 20:1 37:1 40:1 50:1 63:1 67:1 73:1 75:1 76:1 80:1 83:1 ++1 5:1 8:1 17:1 20:1 37:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 18:1 22:1 36:1 43:1 57:1 64:1 67:1 73:1 74:1 76:1 81:1 83:1 ++1 4:1 6:1 15:1 29:1 39:1 40:1 47:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 ++1 2:1 6:1 15:1 20:1 37:1 40:1 56:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 2:1 6:1 14:1 22:1 36:1 42:1 49:1 62:1 67:1 72:1 74:1 76:1 79:1 83:1 +-1 4:1 7:1 17:1 19:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 82:1 88:1 +-1 2:1 6:1 18:1 22:1 36:1 40:1 51:1 61:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 3:1 7:1 18:1 22:1 36:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 4:1 6:1 18:1 20:1 37:1 40:1 47:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 16:1 19:1 39:1 40:1 49:1 61:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 17:1 22:1 36:1 42:1 55:1 62:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 15:1 20:1 37:1 41:1 48:1 64:1 67:1 73:1 75:1 76:1 80:1 83:1 +-1 4:1 6:1 17:1 20:1 37:1 41:1 55:1 66:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 3:1 10:1 17:1 20:1 37:1 40:1 48:1 63:1 67:1 73:1 74:1 77:1 80:1 83:1 +-1 3:1 6:1 16:1 22:1 36:1 42:1 58:1 66:1 71:1 72:1 74:1 76:1 78:1 +-1 2:1 6:1 16:1 22:1 36:1 42:1 54:1 65:1 71:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 17:1 19:1 39:1 42:1 52:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 14:1 19:1 39:1 42:1 50:1 62:1 71:1 72:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 18:1 21:1 35:1 42:1 57:1 62:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 4:1 6:1 15:1 22:1 36:1 42:1 54:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 3:1 6:1 15:1 20:1 37:1 40:1 51:1 63:1 67:1 73:1 75:1 76:1 80:1 83:1 +-1 1:1 10:1 16:1 20:1 37:1 40:1 56:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 8:1 17:1 19:1 39:1 43:1 50:1 64:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 4:1 6:1 14:1 22:1 36:1 41:1 54:1 64:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 14:1 20:1 37:1 42:1 50:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 5:1 8:1 15:1 20:1 37:1 41:1 51:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 2:1 11:1 18:1 22:1 36:1 40:1 59:1 63:1 67:1 73:1 74:1 76:1 81:1 83:1 ++1 3:1 6:1 17:1 20:1 37:1 40:1 55:1 61:1 67:1 72:1 74:1 76:1 79:1 83:1 +-1 1:1 10:1 15:1 20:1 37:1 43:1 59:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 5:1 6:1 17:1 20:1 37:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 18:1 31:1 35:1 41:1 48:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 5:1 6:1 16:1 32:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 16:1 22:1 36:1 41:1 49:1 64:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 2:1 6:1 18:1 22:1 36:1 40:1 57:1 63:1 71:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 14:1 20:1 37:1 42:1 52:1 64:1 67:1 73:1 74:1 76:1 79:1 83:1 +-1 2:1 6:1 16:1 19:1 39:1 42:1 52:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 14:1 21:1 35:1 42:1 49:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 17:1 20:1 37:1 42:1 50:1 65:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 3:1 6:1 16:1 22:1 36:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 ++1 3:1 7:1 14:1 19:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 5:1 7:1 18:1 22:1 36:1 44:1 51:1 66:1 68:1 72:1 74:1 76:1 82:1 93:1 +-1 1:1 6:1 18:1 31:1 35:1 42:1 56:1 62:1 67:1 73:1 74:1 76:1 79:1 83:1 +-1 2:1 6:1 15:1 22:1 36:1 42:1 49:1 66:1 71:1 72:1 74:1 76:1 78:1 83:1 +-1 2:1 6:1 15:1 27:1 35:1 44:1 55:1 64:1 67:1 72:1 74:1 76:1 79:1 83:1 +-1 2:1 11:1 17:1 23:1 39:1 42:1 52:1 64:1 68:1 73:1 75:1 76:1 82:1 90:1 +-1 3:1 7:1 15:1 20:1 37:1 40:1 48:1 63:1 69:1 73:1 74:1 76:1 82:1 83:1 ++1 5:1 7:1 14:1 27:1 35:1 45:1 55:1 64:1 67:1 73:1 74:1 76:1 78:1 99:1 +-1 3:1 17:1 25:1 38:1 42:1 62:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 18:1 22:1 36:1 44:1 50:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 18:1 33:1 35:1 40:1 56:1 63:1 67:1 73:1 74:1 76:1 78:1 103:1 +-1 1:1 15:1 20:1 37:1 42:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 ++1 2:1 6:1 16:1 22:1 36:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 18:1 22:1 36:1 40:1 50:1 63:1 67:1 73:1 75:1 76:1 82:1 83:1 +-1 1:1 6:1 18:1 19:1 39:1 42:1 47:1 64:1 71:1 73:1 74:1 76:1 80:1 +-1 2:1 6:1 14:1 19:1 39:1 42:1 52:1 64:1 67:1 72:1 75:1 76:1 80:1 83:1 +-1 2:1 6:1 14:1 19:1 39:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 4:1 10:1 17:1 20:1 37:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 11:1 17:1 20:1 37:1 41:1 51:1 64:1 71:1 72:1 74:1 76:1 80:1 83:1 ++1 3:1 6:1 15:1 19:1 39:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 5:1 6:1 18:1 21:1 35:1 41:1 57:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 5:1 6:1 16:1 22:1 36:1 40:1 52:1 63:1 67:1 73:1 75:1 76:1 80:1 83:1 ++1 5:1 6:1 18:1 19:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 5:1 7:1 14:1 27:1 35:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 6:1 16:1 22:1 36:1 43:1 51:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 9:1 14:1 20:1 37:1 41:1 47:1 66:1 69:1 72:1 74:1 76:1 78:1 83:1 +-1 3:1 6:1 17:1 19:1 39:1 42:1 55:1 64:1 71:1 73:1 74:1 76:1 80:1 83:1 ++1 2:1 7:1 17:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 15:1 20:1 37:1 41:1 49:1 66:1 71:1 72:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 18:1 19:1 39:1 40:1 51:1 61:1 67:1 72:1 74:1 76:1 82:1 88:1 +-1 1:1 16:1 25:1 38:1 42:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 15:1 22:1 36:1 41:1 48:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 16:1 22:1 36:1 42:1 49:1 62:1 67:1 72:1 75:1 76:1 78:1 83:1 +-1 2:1 7:1 17:1 19:1 39:1 42:1 47:1 64:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 2:1 6:1 17:1 19:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 11:1 18:1 19:1 39:1 41:1 59:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 14:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 17:1 19:1 39:1 42:1 47:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 17:1 20:1 37:1 42:1 50:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 ++1 2:1 6:1 15:1 20:1 37:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 7:1 18:1 20:1 37:1 42:1 49:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 5:1 18:1 22:1 36:1 40:1 61:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 3:1 11:1 18:1 29:1 39:1 40:1 59:1 63:1 71:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 16:1 20:1 37:1 40:1 54:1 63:1 71:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 16:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 6:1 16:1 21:1 35:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 16:1 19:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 107:1 +-1 3:1 6:1 15:1 22:1 36:1 41:1 55:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 16:1 21:1 35:1 44:1 49:1 64:1 67:1 72:1 74:1 76:1 78:1 119:1 ++1 3:1 6:1 17:1 19:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 17:1 22:1 36:1 42:1 55:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 14:1 20:1 37:1 41:1 55:1 64:1 68:1 72:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 15:1 28:1 35:1 42:1 50:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 4:1 6:1 16:1 33:1 35:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 1:1 6:1 18:1 27:1 35:1 42:1 49:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 9:1 15:1 22:1 36:1 42:1 49:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 1:1 15:1 20:1 37:1 42:1 65:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 4:1 6:1 17:1 19:1 39:1 43:1 47:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 17:1 24:1 38:1 41:1 50:1 66:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 14:1 22:1 36:1 41:1 52:1 64:1 67:1 72:1 74:1 76:1 81:1 83:1 ++1 4:1 6:1 14:1 20:1 37:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 81:1 83:1 ++1 3:1 6:1 15:1 19:1 39:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 4:1 6:1 14:1 22:1 36:1 42:1 55:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 10:1 16:1 25:1 38:1 42:1 59:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 16:1 22:1 36:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 4:1 6:1 17:1 23:1 39:1 41:1 55:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 7:1 18:1 31:1 35:1 41:1 50:1 64:1 67:1 72:1 74:1 76:1 82:1 83:1 +-1 3:1 6:1 15:1 22:1 36:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 3:1 6:1 17:1 23:1 39:1 43:1 52:1 64:1 67:1 73:1 74:1 76:1 79:1 83:1 +-1 4:1 7:1 14:1 19:1 39:1 40:1 56:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 2:1 6:1 16:1 26:1 35:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 15:1 22:1 36:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 2:1 9:1 18:1 19:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 7:1 15:1 22:1 36:1 40:1 50:1 63:1 68:1 73:1 74:1 76:1 82:1 93:1 +-1 5:1 6:1 17:1 22:1 36:1 41:1 51:1 66:1 67:1 72:1 74:1 76:1 79:1 83:1 ++1 2:1 6:1 17:1 19:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 16:1 20:1 37:1 42:1 50:1 62:1 68:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 14:1 19:1 39:1 42:1 55:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 15:1 22:1 36:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 11:1 18:1 19:1 39:1 42:1 48:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 5:1 8:1 15:1 23:1 39:1 40:1 52:1 63:1 67:1 73:1 75:1 76:1 82:1 83:1 +-1 2:1 6:1 17:1 22:1 36:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 4:1 6:1 16:1 22:1 36:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 15:1 20:1 37:1 42:1 58:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 3:1 11:1 14:1 22:1 36:1 42:1 49:1 62:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 17:1 25:1 38:1 42:1 51:1 62:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 14:1 19:1 39:1 40:1 49:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 5:1 6:1 17:1 27:1 35:1 44:1 54:1 66:1 71:1 72:1 74:1 76:1 80:1 83:1 ++1 4:1 7:1 16:1 20:1 37:1 40:1 48:1 63:1 67:1 73:1 74:1 77:1 80:1 83:1 +-1 3:1 14:1 22:1 36:1 40:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 10:1 18:1 28:1 35:1 42:1 49:1 62:1 71:1 73:1 74:1 76:1 78:1 83:1 ++1 4:1 7:1 14:1 22:1 36:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 15:1 22:1 36:1 42:1 52:1 66:1 67:1 72:1 74:1 77:1 80:1 83:1 ++1 2:1 6:1 16:1 19:1 39:1 46:1 51:1 61:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 17:1 20:1 37:1 42:1 49:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 4:1 6:1 15:1 25:1 38:1 40:1 55:1 61:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 5:1 16:1 19:1 39:1 40:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 3:1 6:1 17:1 20:1 37:1 41:1 47:1 64:1 67:1 72:1 74:1 76:1 80:1 100:1 +-1 1:1 6:1 17:1 22:1 36:1 42:1 50:1 64:1 67:1 73:1 74:1 77:1 82:1 83:1 ++1 5:1 7:1 16:1 22:1 36:1 42:1 56:1 64:1 67:1 73:1 75:1 76:1 80:1 83:1 +-1 3:1 10:1 14:1 22:1 36:1 42:1 49:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 3:1 9:1 16:1 23:1 39:1 42:1 52:1 64:1 67:1 72:1 74:1 76:1 82:1 83:1 ++1 2:1 7:1 16:1 22:1 36:1 40:1 57:1 63:1 67:1 73:1 75:1 76:1 80:1 83:1 +-1 1:1 6:1 15:1 20:1 37:1 40:1 55:1 61:1 69:1 72:1 74:1 76:1 81:1 83:1 +-1 2:1 6:1 17:1 20:1 37:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 5:1 14:1 23:1 39:1 40:1 63:1 67:1 73:1 75:1 76:1 78:1 83:1 +-1 3:1 7:1 17:1 20:1 37:1 41:1 56:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 4:1 7:1 14:1 29:1 39:1 40:1 56:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 5:1 6:1 15:1 29:1 39:1 40:1 51:1 63:1 67:1 73:1 75:1 76:1 82:1 83:1 +-1 2:1 6:1 17:1 19:1 39:1 42:1 52:1 64:1 67:1 72:1 74:1 76:1 82:1 83:1 ++1 2:1 6:1 17:1 22:1 36:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 6:1 17:1 32:1 39:1 41:1 52:1 66:1 67:1 72:1 74:1 76:1 82:1 83:1 +-1 1:1 18:1 20:1 37:1 42:1 62:1 67:1 72:1 74:1 77:1 78:1 83:1 ++1 3:1 6:1 14:1 19:1 39:1 40:1 57:1 63:1 67:1 73:1 75:1 76:1 82:1 83:1 +-1 2:1 6:1 17:1 22:1 36:1 42:1 48:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 18:1 20:1 37:1 42:1 49:1 62:1 67:1 73:1 74:1 77:1 78:1 83:1 +-1 2:1 6:1 14:1 22:1 36:1 42:1 49:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 3:1 6:1 18:1 32:1 39:1 42:1 52:1 64:1 67:1 73:1 74:1 76:1 80:1 110:1 +-1 3:1 6:1 15:1 20:1 37:1 43:1 54:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 4:1 6:1 16:1 32:1 39:1 42:1 52:1 64:1 67:1 73:1 74:1 76:1 79:1 83:1 ++1 4:1 6:1 17:1 19:1 39:1 40:1 51:1 63:1 71:1 73:1 74:1 76:1 79:1 83:1 ++1 4:1 6:1 17:1 25:1 38:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 7:1 17:1 27:1 35:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 ++1 4:1 6:1 14:1 25:1 38:1 40:1 51:1 63:1 67:1 73:1 75:1 76:1 82:1 83:1 ++1 5:1 6:1 14:1 19:1 39:1 40:1 50:1 63:1 67:1 73:1 75:1 76:1 78:1 83:1 +-1 1:1 6:1 15:1 20:1 37:1 42:1 55:1 62:1 68:1 73:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 18:1 33:1 35:1 42:1 53:1 64:1 67:1 73:1 74:1 76:1 78:1 103:1 +-1 1:1 6:1 16:1 22:1 36:1 42:1 53:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 5:1 14:1 19:1 39:1 40:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 16:1 22:1 36:1 42:1 50:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 4:1 6:1 17:1 22:1 36:1 40:1 48:1 63:1 70:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 16:1 26:1 35:1 40:1 54:1 65:1 68:1 72:1 74:1 76:1 81:1 94:1 +-1 1:1 6:1 15:1 25:1 38:1 42:1 55:1 62:1 67:1 72:1 74:1 76:1 82:1 83:1 +-1 1:1 10:1 18:1 31:1 35:1 42:1 49:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 14:1 20:1 37:1 42:1 57:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 2:1 11:1 16:1 22:1 36:1 40:1 59:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 10:1 17:1 19:1 39:1 42:1 52:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 3:1 10:1 17:1 29:1 39:1 44:1 52:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 16:1 22:1 36:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 15:1 22:1 36:1 42:1 57:1 64:1 69:1 73:1 74:1 76:1 80:1 83:1 ++1 3:1 6:1 17:1 19:1 39:1 40:1 47:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 16:1 22:1 36:1 42:1 52:1 66:1 67:1 72:1 74:1 76:1 82:1 83:1 +-1 2:1 10:1 16:1 24:1 38:1 40:1 59:1 63:1 67:1 73:1 74:1 77:1 80:1 85:1 +-1 4:1 6:1 15:1 22:1 36:1 44:1 50:1 66:1 69:1 72:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 15:1 20:1 37:1 42:1 50:1 65:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 3:1 6:1 14:1 19:1 39:1 42:1 50:1 64:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 5:1 10:1 14:1 22:1 36:1 40:1 51:1 63:1 69:1 73:1 74:1 76:1 82:1 83:1 +-1 4:1 7:1 16:1 19:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 7:1 18:1 20:1 37:1 42:1 48:1 64:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 3:1 6:1 18:1 22:1 36:1 40:1 52:1 63:1 67:1 73:1 74:1 77:1 82:1 83:1 +-1 1:1 6:1 15:1 20:1 37:1 41:1 49:1 64:1 67:1 73:1 74:1 76:1 78:1 83:1 ++1 4:1 6:1 17:1 19:1 39:1 40:1 51:1 63:1 67:1 73:1 75:1 76:1 82:1 83:1 +-1 5:1 16:1 21:1 35:1 42:1 66:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 18:1 31:1 35:1 42:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 3:1 11:1 17:1 29:1 39:1 40:1 52:1 61:1 67:1 72:1 75:1 76:1 79:1 83:1 +-1 3:1 6:1 17:1 20:1 37:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 7:1 18:1 22:1 36:1 44:1 49:1 65:1 67:1 72:1 75:1 76:1 78:1 83:1 +-1 1:1 6:1 17:1 21:1 35:1 42:1 55:1 62:1 71:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 18:1 19:1 39:1 42:1 55:1 64:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 5:1 15:1 23:1 39:1 45:1 66:1 68:1 72:1 74:1 76:1 80:1 102:1 +-1 5:1 6:1 15:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 10:1 14:1 19:1 39:1 41:1 52:1 66:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 4:1 6:1 18:1 22:1 36:1 43:1 54:1 66:1 71:1 72:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 14:1 22:1 36:1 42:1 50:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 16:1 22:1 36:1 41:1 54:1 66:1 67:1 72:1 74:1 76:1 82:1 83:1 ++1 3:1 6:1 16:1 20:1 37:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 14:1 31:1 35:1 42:1 49:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 ++1 5:1 11:1 17:1 32:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 82:1 112:1 ++1 2:1 6:1 17:1 22:1 36:1 40:1 53:1 61:1 67:1 72:1 74:1 76:1 80:1 103:1 ++1 5:1 7:1 14:1 23:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 82:1 85:1 +-1 2:1 10:1 18:1 19:1 39:1 42:1 59:1 62:1 71:1 73:1 74:1 76:1 82:1 83:1 +-1 2:1 6:1 17:1 20:1 37:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 18:1 22:1 36:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 17:1 22:1 36:1 42:1 54:1 65:1 67:1 73:1 74:1 76:1 80:1 103:1 +-1 2:1 6:1 14:1 20:1 37:1 40:1 49:1 61:1 69:1 72:1 74:1 76:1 80:1 83:1 ++1 3:1 6:1 18:1 19:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 2:1 6:1 15:1 22:1 36:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 4:1 10:1 15:1 29:1 39:1 41:1 52:1 66:1 71:1 72:1 75:1 76:1 80:1 83:1 +-1 2:1 6:1 15:1 31:1 35:1 40:1 48:1 61:1 70:1 72:1 74:1 76:1 82:1 114:1 +-1 4:1 6:1 15:1 19:1 39:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 4:1 6:1 16:1 22:1 36:1 41:1 54:1 62:1 71:1 72:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 18:1 20:1 37:1 42:1 57:1 62:1 71:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 18:1 32:1 39:1 42:1 52:1 64:1 67:1 73:1 74:1 76:1 80:1 +-1 3:1 8:1 15:1 20:1 37:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 1:1 16:1 24:1 38:1 42:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 5:1 16:1 22:1 36:1 40:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 18:1 19:1 39:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 16:1 21:1 35:1 42:1 53:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 3:1 6:1 14:1 22:1 36:1 41:1 56:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 14:1 22:1 36:1 42:1 53:1 64:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 14:1 27:1 35:1 42:1 54:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 16:1 20:1 37:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 9:1 14:1 22:1 36:1 40:1 47:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 16:1 22:1 36:1 40:1 54:1 63:1 67:1 73:1 75:1 76:1 82:1 105:1 +-1 2:1 7:1 17:1 22:1 36:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 7:1 17:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 6:1 16:1 22:1 36:1 42:1 55:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 18:1 19:1 39:1 42:1 52:1 64:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 5:1 6:1 15:1 34:1 35:1 42:1 54:1 64:1 67:1 73:1 74:1 76:1 80:1 107:1 +-1 2:1 6:1 15:1 26:1 35:1 40:1 56:1 63:1 69:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 8:1 16:1 22:1 36:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 2:1 10:1 17:1 22:1 36:1 40:1 59:1 63:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 5:1 6:1 15:1 22:1 36:1 40:1 59:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 3:1 6:1 15:1 22:1 36:1 40:1 54:1 63:1 68:1 73:1 74:1 76:1 80:1 +-1 2:1 6:1 17:1 22:1 36:1 42:1 55:1 66:1 67:1 72:1 74:1 76:1 79:1 86:1 +-1 5:1 7:1 14:1 19:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 15:1 22:1 36:1 42:1 54:1 64:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 4:1 6:1 14:1 22:1 36:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 4:1 6:1 16:1 22:1 36:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 4:1 6:1 14:1 22:1 36:1 42:1 48:1 64:1 67:1 72:1 74:1 76:1 82:1 83:1 +-1 3:1 8:1 15:1 22:1 36:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 4:1 6:1 14:1 22:1 36:1 40:1 53:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 2:1 6:1 18:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 5:1 9:1 17:1 19:1 39:1 42:1 55:1 64:1 67:1 73:1 74:1 77:1 80:1 83:1 ++1 5:1 6:1 16:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 5:1 11:1 14:1 25:1 38:1 41:1 47:1 64:1 67:1 73:1 74:1 77:1 79:1 83:1 +-1 1:1 6:1 18:1 19:1 39:1 42:1 55:1 62:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 10:1 18:1 19:1 39:1 42:1 52:1 64:1 67:1 72:1 74:1 76:1 81:1 83:1 +-1 1:1 17:1 19:1 39:1 42:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 ++1 4:1 11:1 15:1 22:1 36:1 41:1 55:1 66:1 67:1 72:1 74:1 76:1 82:1 83:1 ++1 5:1 6:1 18:1 20:1 37:1 40:1 57:1 63:1 67:1 73:1 75:1 76:1 78:1 83:1 +-1 1:1 6:1 15:1 21:1 35:1 42:1 49:1 62:1 71:1 73:1 74:1 76:1 78:1 83:1 +-1 2:1 6:1 14:1 19:1 39:1 40:1 47:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 ++1 4:1 10:1 17:1 22:1 36:1 40:1 54:1 63:1 71:1 73:1 74:1 76:1 80:1 83:1 ++1 5:1 11:1 14:1 29:1 39:1 40:1 51:1 63:1 67:1 73:1 75:1 76:1 79:1 83:1 +-1 2:1 6:1 17:1 22:1 36:1 41:1 54:1 66:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 14:1 20:1 37:1 41:1 48:1 64:1 71:1 72:1 74:1 76:1 81:1 83:1 ++1 5:1 9:1 16:1 22:1 36:1 40:1 47:1 63:1 67:1 73:1 74:1 77:1 80:1 83:1 +-1 3:1 6:1 17:1 22:1 36:1 43:1 57:1 65:1 67:1 73:1 74:1 76:1 82:1 103:1 +-1 1:1 6:1 18:1 20:1 37:1 42:1 57:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 18:1 20:1 37:1 42:1 56:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 ++1 4:1 6:1 16:1 22:1 36:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 11:1 15:1 22:1 36:1 43:1 48:1 64:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 5:1 6:1 16:1 22:1 36:1 42:1 49:1 64:1 71:1 72:1 74:1 76:1 79:1 83:1 +-1 1:1 6:1 17:1 22:1 36:1 42:1 50:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 1:1 17:1 31:1 35:1 42:1 62:1 71:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 16:1 19:1 39:1 44:1 52:1 64:1 67:1 72:1 74:1 76:1 82:1 83:1 ++1 4:1 6:1 14:1 29:1 39:1 40:1 47:1 63:1 67:1 73:1 74:1 77:1 80:1 83:1 +-1 3:1 10:1 17:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 +-1 2:1 14:1 20:1 37:1 43:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 5:1 6:1 14:1 21:1 35:1 40:1 50:1 63:1 67:1 73:1 75:1 76:1 78:1 83:1 +-1 4:1 6:1 14:1 19:1 39:1 42:1 55:1 62:1 67:1 72:1 74:1 76:1 79:1 83:1 +-1 2:1 6:1 15:1 27:1 35:1 41:1 53:1 65:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 3:1 7:1 14:1 22:1 36:1 41:1 56:1 64:1 67:1 73:1 75:1 76:1 80:1 83:1 +-1 1:1 6:1 17:1 22:1 36:1 42:1 49:1 62:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 18:1 21:1 35:1 42:1 58:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 5:1 6:1 16:1 22:1 36:1 42:1 51:1 64:1 67:1 72:1 74:1 76:1 79:1 83:1 ++1 3:1 11:1 14:1 22:1 36:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 15:1 19:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 6:1 14:1 31:1 35:1 42:1 50:1 66:1 67:1 72:1 74:1 76:1 79:1 +-1 5:1 10:1 16:1 33:1 35:1 40:1 59:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 3:1 6:1 15:1 20:1 37:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 14:1 20:1 37:1 45:1 50:1 66:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 4:1 10:1 14:1 19:1 39:1 40:1 52:1 61:1 67:1 72:1 74:1 76:1 81:1 83:1 +-1 2:1 6:1 15:1 33:1 35:1 42:1 57:1 64:1 67:1 73:1 74:1 76:1 80:1 112:1 +-1 3:1 6:1 17:1 19:1 39:1 41:1 52:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 ++1 5:1 6:1 15:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 2:1 6:1 18:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 3:1 6:1 14:1 24:1 38:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 18:1 22:1 36:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 10:1 16:1 22:1 36:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 3:1 10:1 14:1 20:1 37:1 40:1 55:1 61:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 15:1 27:1 35:1 40:1 52:1 61:1 67:1 72:1 74:1 76:1 81:1 83:1 +-1 2:1 6:1 17:1 29:1 39:1 42:1 51:1 62:1 67:1 73:1 74:1 76:1 79:1 83:1 +-1 1:1 6:1 16:1 20:1 37:1 42:1 49:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 14:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 81:1 83:1 ++1 4:1 6:1 15:1 25:1 38:1 40:1 56:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 4:1 6:1 18:1 20:1 37:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 1:1 6:1 17:1 19:1 39:1 42:1 52:1 64:1 67:1 73:1 74:1 76:1 78:1 85:1 +-1 5:1 6:1 17:1 33:1 35:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 16:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 2:1 6:1 16:1 20:1 37:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 2:1 6:1 15:1 22:1 36:1 40:1 48:1 61:1 67:1 72:1 74:1 76:1 81:1 83:1 +-1 1:1 6:1 14:1 22:1 36:1 42:1 48:1 64:1 67:1 73:1 74:1 77:1 80:1 83:1 ++1 4:1 10:1 15:1 20:1 37:1 40:1 59:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 16:1 20:1 37:1 42:1 52:1 62:1 67:1 72:1 75:1 76:1 78:1 83:1 +-1 5:1 6:1 14:1 20:1 37:1 41:1 49:1 66:1 71:1 72:1 74:1 76:1 81:1 83:1 +-1 1:1 6:1 18:1 22:1 36:1 40:1 50:1 65:1 67:1 73:1 74:1 76:1 78:1 83:1 ++1 5:1 6:1 18:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 79:1 83:1 +-1 1:1 6:1 17:1 22:1 36:1 42:1 49:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 ++1 4:1 6:1 15:1 29:1 39:1 40:1 55:1 63:1 67:1 73:1 74:1 76:1 81:1 83:1 ++1 3:1 6:1 18:1 22:1 36:1 41:1 51:1 66:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 3:1 7:1 16:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 14:1 24:1 38:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 2:1 6:1 15:1 22:1 36:1 42:1 48:1 64:1 67:1 73:1 74:1 76:1 80:1 114:1 +-1 2:1 6:1 17:1 22:1 36:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 80:1 86:1 +-1 2:1 6:1 15:1 22:1 36:1 42:1 48:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 7:1 18:1 19:1 39:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 2:1 6:1 17:1 22:1 36:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 3:1 10:1 16:1 26:1 35:1 40:1 49:1 61:1 67:1 72:1 74:1 76:1 80:1 118:1 +-1 3:1 6:1 16:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 14:1 22:1 36:1 42:1 50:1 62:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 16:1 22:1 36:1 43:1 54:1 66:1 71:1 72:1 74:1 76:1 80:1 83:1 ++1 5:1 7:1 15:1 22:1 36:1 41:1 51:1 64:1 67:1 72:1 75:1 76:1 79:1 83:1 +-1 1:1 6:1 18:1 20:1 37:1 42:1 55:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 7:1 14:1 19:1 39:1 42:1 52:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 7:1 18:1 20:1 37:1 42:1 50:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 5:1 18:1 20:1 37:1 40:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 16:1 22:1 36:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 16:1 20:1 37:1 40:1 49:1 61:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 2:1 6:1 17:1 20:1 37:1 42:1 52:1 64:1 71:1 72:1 75:1 76:1 82:1 83:1 ++1 4:1 6:1 16:1 20:1 37:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 2:1 6:1 16:1 20:1 37:1 40:1 53:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 11:1 18:1 22:1 36:1 40:1 55:1 63:1 67:1 73:1 75:1 76:1 80:1 83:1 ++1 4:1 6:1 15:1 32:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 3:1 6:1 17:1 19:1 39:1 40:1 50:1 63:1 67:1 73:1 74:1 77:1 82:1 83:1 +-1 5:1 8:1 16:1 19:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 3:1 6:1 17:1 19:1 39:1 40:1 47:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 3:1 10:1 17:1 24:1 38:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 17:1 22:1 36:1 43:1 49:1 66:1 71:1 72:1 74:1 76:1 79:1 83:1 +-1 1:1 15:1 22:1 36:1 42:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 ++1 3:1 6:1 16:1 25:1 38:1 40:1 48:1 63:1 67:1 73:1 75:1 76:1 80:1 83:1 +-1 3:1 6:1 14:1 20:1 37:1 42:1 56:1 66:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 7:1 14:1 22:1 36:1 40:1 56:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 5:1 7:1 15:1 23:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 4:1 6:1 18:1 20:1 37:1 40:1 56:1 61:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 3:1 6:1 16:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 10:1 16:1 22:1 36:1 42:1 52:1 66:1 71:1 72:1 74:1 76:1 79:1 83:1 +-1 5:1 6:1 14:1 22:1 36:1 44:1 55:1 66:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 4:1 11:1 16:1 29:1 39:1 42:1 52:1 62:1 67:1 72:1 74:1 76:1 79:1 83:1 +-1 2:1 6:1 15:1 33:1 35:1 40:1 53:1 63:1 67:1 73:1 74:1 76:1 82:1 103:1 +-1 2:1 18:1 22:1 36:1 42:1 66:1 67:1 72:1 74:1 76:1 78:1 83:1 ++1 2:1 6:1 15:1 19:1 39:1 40:1 52:1 61:1 67:1 72:1 74:1 77:1 78:1 83:1 +-1 5:1 6:1 17:1 22:1 36:1 40:1 53:1 63:1 71:1 73:1 74:1 76:1 80:1 ++1 5:1 6:1 14:1 19:1 39:1 42:1 49:1 64:1 68:1 72:1 74:1 76:1 78:1 91:1 +-1 5:1 6:1 16:1 34:1 35:1 42:1 54:1 64:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 1:1 7:1 18:1 22:1 36:1 42:1 56:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 5:1 6:1 17:1 22:1 36:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 18:1 22:1 36:1 42:1 55:1 62:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 16:1 22:1 36:1 42:1 53:1 62:1 69:1 73:1 74:1 76:1 80:1 83:1 ++1 3:1 6:1 15:1 22:1 36:1 40:1 54:1 61:1 67:1 72:1 74:1 76:1 81:1 83:1 +-1 3:1 7:1 16:1 19:1 39:1 41:1 51:1 64:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 2:1 7:1 17:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 4:1 6:1 15:1 22:1 36:1 44:1 50:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 14:1 28:1 35:1 42:1 57:1 64:1 68:1 73:1 74:1 76:1 79:1 83:1 +-1 4:1 7:1 16:1 20:1 37:1 41:1 48:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 17:1 20:1 37:1 42:1 50:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 2:1 6:1 18:1 24:1 38:1 42:1 52:1 64:1 68:1 73:1 74:1 76:1 80:1 83:1 ++1 2:1 6:1 15:1 29:1 39:1 43:1 51:1 64:1 67:1 73:1 74:1 77:1 82:1 83:1 +-1 1:1 11:1 16:1 20:1 37:1 42:1 49:1 62:1 71:1 73:1 74:1 76:1 78:1 83:1 ++1 2:1 6:1 15:1 23:1 39:1 40:1 52:1 61:1 67:1 72:1 74:1 76:1 82:1 83:1 ++1 5:1 6:1 16:1 22:1 36:1 40:1 57:1 63:1 67:1 73:1 74:1 77:1 82:1 83:1 +-1 2:1 7:1 14:1 24:1 38:1 42:1 49:1 62:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 2:1 6:1 18:1 22:1 36:1 42:1 54:1 62:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 15:1 22:1 36:1 42:1 54:1 62:1 67:1 72:1 74:1 76:1 80:1 83:1 ++1 4:1 9:1 14:1 22:1 36:1 40:1 55:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 15:1 22:1 36:1 42:1 48:1 62:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 11:1 18:1 19:1 39:1 40:1 59:1 63:1 71:1 73:1 74:1 76:1 82:1 83:1 +-1 2:1 6:1 14:1 30:1 35:1 42:1 49:1 65:1 67:1 72:1 74:1 76:1 78:1 119:1 +-1 1:1 6:1 15:1 28:1 35:1 42:1 50:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 ++1 3:1 9:1 15:1 22:1 36:1 40:1 55:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 14:1 19:1 39:1 40:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 14:1 22:1 36:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 5:1 6:1 15:1 22:1 36:1 40:1 51:1 61:1 67:1 72:1 74:1 76:1 80:1 83:1 ++1 3:1 6:1 17:1 22:1 36:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 1:1 6:1 18:1 21:1 35:1 42:1 58:1 64:1 67:1 72:1 74:1 76:1 79:1 83:1 +-1 1:1 6:1 18:1 24:1 38:1 42:1 50:1 64:1 71:1 73:1 74:1 76:1 80:1 +-1 1:1 6:1 14:1 20:1 37:1 42:1 55:1 62:1 67:1 72:1 74:1 76:1 79:1 83:1 +-1 4:1 6:1 15:1 22:1 36:1 42:1 48:1 66:1 67:1 72:1 74:1 76:1 80:1 86:1 ++1 4:1 10:1 17:1 19:1 39:1 41:1 59:1 64:1 71:1 73:1 74:1 76:1 82:1 83:1 ++1 5:1 8:1 14:1 22:1 36:1 40:1 51:1 63:1 67:1 73:1 75:1 76:1 82:1 83:1 +-1 3:1 6:1 18:1 20:1 37:1 42:1 50:1 66:1 71:1 72:1 74:1 76:1 80:1 83:1 ++1 3:1 10:1 16:1 20:1 37:1 40:1 59:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 5:1 7:1 18:1 19:1 39:1 40:1 51:1 63:1 67:1 73:1 75:1 76:1 78:1 83:1 +-1 3:1 6:1 16:1 22:1 36:1 42:1 49:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 17:1 29:1 39:1 42:1 51:1 64:1 70:1 73:1 74:1 76:1 78:1 95:1 +-1 3:1 6:1 14:1 20:1 37:1 41:1 53:1 66:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 16:1 28:1 35:1 42:1 49:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 ++1 5:1 6:1 15:1 19:1 39:1 42:1 55:1 64:1 67:1 72:1 75:1 76:1 80:1 83:1 +-1 3:1 6:1 16:1 20:1 37:1 41:1 54:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 3:1 6:1 14:1 23:1 39:1 42:1 52:1 64:1 67:1 72:1 75:1 76:1 82:1 83:1 +-1 5:1 6:1 17:1 31:1 35:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 16:1 20:1 37:1 41:1 55:1 64:1 67:1 72:1 74:1 76:1 79:1 83:1 +-1 3:1 8:1 14:1 22:1 36:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 17:1 27:1 35:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 103:1 +-1 2:1 6:1 14:1 20:1 37:1 40:1 55:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 4:1 6:1 14:1 22:1 36:1 44:1 55:1 66:1 67:1 72:1 74:1 76:1 79:1 83:1 +-1 1:1 6:1 17:1 21:1 35:1 42:1 50:1 62:1 67:1 72:1 74:1 77:1 78:1 83:1 ++1 4:1 9:1 17:1 20:1 37:1 40:1 53:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 17:1 20:1 37:1 42:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 2:1 7:1 18:1 27:1 35:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 4:1 6:1 18:1 26:1 35:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 103:1 +-1 3:1 6:1 15:1 20:1 37:1 40:1 55:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 4:1 6:1 15:1 26:1 35:1 43:1 53:1 62:1 67:1 73:1 74:1 76:1 79:1 83:1 ++1 3:1 6:1 16:1 20:1 37:1 40:1 54:1 63:1 68:1 73:1 74:1 76:1 82:1 83:1 +-1 5:1 6:1 16:1 30:1 35:1 40:1 49:1 65:1 71:1 72:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 16:1 20:1 37:1 42:1 50:1 62:1 71:1 72:1 74:1 76:1 78:1 83:1 +-1 1:1 16:1 24:1 38:1 42:1 65:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 17:1 22:1 36:1 42:1 49:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 4:1 6:1 18:1 25:1 38:1 40:1 52:1 63:1 67:1 73:1 74:1 77:1 81:1 83:1 +-1 5:1 6:1 16:1 22:1 36:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 3:1 8:1 16:1 20:1 37:1 40:1 50:1 63:1 67:1 73:1 74:1 77:1 80:1 83:1 +-1 5:1 6:1 14:1 23:1 39:1 45:1 52:1 66:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 5:1 8:1 18:1 23:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 77:1 82:1 83:1 +-1 1:1 6:1 15:1 20:1 37:1 42:1 49:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 ++1 4:1 10:1 18:1 19:1 39:1 40:1 51:1 63:1 71:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 11:1 16:1 29:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 4:1 7:1 14:1 19:1 39:1 40:1 56:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 4:1 9:1 15:1 20:1 37:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 5:1 11:1 18:1 20:1 37:1 40:1 54:1 63:1 71:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 7:1 18:1 22:1 36:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 3:1 6:1 17:1 25:1 38:1 42:1 51:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 4:1 6:1 15:1 20:1 37:1 40:1 48:1 63:1 69:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 13:1 17:1 31:1 35:1 42:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 ++1 4:1 6:1 15:1 29:1 39:1 40:1 51:1 61:1 67:1 72:1 74:1 77:1 79:1 83:1 +-1 3:1 10:1 15:1 25:1 38:1 42:1 51:1 66:1 69:1 72:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 16:1 22:1 36:1 42:1 49:1 64:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 3:1 6:1 18:1 22:1 36:1 41:1 48:1 64:1 67:1 73:1 74:1 77:1 79:1 83:1 +-1 3:1 6:1 17:1 20:1 37:1 40:1 49:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 2:1 6:1 16:1 25:1 38:1 42:1 47:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 2:1 8:1 16:1 22:1 36:1 40:1 56:1 63:1 67:1 73:1 74:1 77:1 82:1 83:1 +-1 5:1 6:1 15:1 20:1 37:1 44:1 58:1 66:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 18:1 31:1 35:1 40:1 51:1 61:1 67:1 72:1 74:1 76:1 79:1 83:1 +-1 2:1 6:1 16:1 22:1 36:1 41:1 55:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 16:1 22:1 36:1 42:1 53:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 14:1 25:1 38:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 3:1 6:1 17:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 75:1 76:1 80:1 83:1 +-1 3:1 6:1 16:1 22:1 36:1 42:1 52:1 64:1 67:1 72:1 74:1 77:1 81:1 83:1 +-1 2:1 6:1 16:1 19:1 39:1 42:1 51:1 62:1 68:1 72:1 74:1 76:1 82:1 110:1 ++1 4:1 7:1 18:1 19:1 39:1 41:1 49:1 66:1 68:1 72:1 74:1 76:1 82:1 93:1 +-1 1:1 6:1 14:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 81:1 83:1 ++1 5:1 10:1 15:1 19:1 39:1 40:1 59:1 63:1 67:1 73:1 75:1 76:1 82:1 83:1 ++1 5:1 6:1 18:1 19:1 39:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 2:1 6:1 15:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 5:1 8:1 18:1 20:1 37:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 16:1 31:1 35:1 40:1 61:1 67:1 72:1 74:1 76:1 78:1 95:1 ++1 3:1 7:1 17:1 32:1 39:1 42:1 52:1 64:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 2:1 6:1 17:1 22:1 36:1 40:1 49:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 2:1 6:1 15:1 19:1 39:1 40:1 52:1 61:1 67:1 72:1 74:1 77:1 78:1 83:1 +-1 1:1 6:1 17:1 22:1 36:1 40:1 58:1 61:1 67:1 72:1 75:1 76:1 80:1 83:1 +-1 2:1 6:1 15:1 22:1 36:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 5:1 17:1 29:1 39:1 40:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 14:1 22:1 36:1 42:1 53:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 17:1 25:1 38:1 42:1 64:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 4:1 6:1 18:1 27:1 35:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 16:1 22:1 36:1 41:1 55:1 66:1 67:1 72:1 74:1 76:1 81:1 83:1 +-1 4:1 6:1 17:1 19:1 39:1 42:1 52:1 64:1 71:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 18:1 31:1 35:1 42:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 ++1 4:1 6:1 16:1 22:1 36:1 40:1 55:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 5:1 18:1 26:1 35:1 43:1 64:1 71:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 9:1 17:1 25:1 38:1 41:1 47:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 2:1 6:1 15:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 2:1 7:1 18:1 19:1 39:1 40:1 51:1 61:1 67:1 72:1 74:1 77:1 80:1 83:1 ++1 3:1 6:1 16:1 24:1 38:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 9:1 14:1 20:1 37:1 41:1 51:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 ++1 4:1 6:1 16:1 25:1 38:1 40:1 51:1 61:1 67:1 72:1 75:1 76:1 79:1 83:1 ++1 4:1 6:1 17:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 +-1 2:1 6:1 17:1 22:1 36:1 41:1 54:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 4:1 6:1 14:1 19:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 14:1 20:1 37:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 18:1 22:1 36:1 41:1 54:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 14:1 21:1 35:1 42:1 49:1 62:1 69:1 73:1 74:1 76:1 78:1 83:1 ++1 4:1 8:1 15:1 20:1 37:1 40:1 52:1 61:1 67:1 72:1 74:1 76:1 80:1 ++1 4:1 6:1 17:1 22:1 36:1 40:1 51:1 61:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 14:1 30:1 35:1 40:1 57:1 63:1 71:1 73:1 74:1 76:1 78:1 83:1 ++1 2:1 6:1 16:1 19:1 39:1 42:1 52:1 62:1 67:1 72:1 74:1 77:1 80:1 83:1 +-1 5:1 6:1 16:1 23:1 39:1 42:1 52:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 3:1 6:1 15:1 25:1 38:1 41:1 48:1 66:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 5:1 7:1 17:1 20:1 37:1 41:1 57:1 64:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 2:1 6:1 16:1 22:1 36:1 42:1 50:1 64:1 67:1 72:1 74:1 76:1 79:1 83:1 +-1 4:1 6:1 15:1 22:1 36:1 40:1 51:1 61:1 67:1 72:1 74:1 76:1 80:1 83:1 ++1 4:1 10:1 16:1 29:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 2:1 6:1 17:1 22:1 36:1 42:1 54:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 2:1 6:1 16:1 22:1 36:1 41:1 48:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 4:1 6:1 16:1 22:1 36:1 42:1 50:1 64:1 67:1 72:1 74:1 76:1 78:1 83:1 ++1 2:1 8:1 17:1 22:1 36:1 40:1 50:1 63:1 71:1 73:1 75:1 76:1 80:1 83:1 +-1 1:1 6:1 17:1 22:1 36:1 42:1 49:1 64:1 67:1 73:1 74:1 76:1 79:1 83:1 +-1 5:1 15:1 22:1 36:1 44:1 64:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 15:1 20:1 37:1 40:1 55:1 63:1 71:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 15:1 22:1 36:1 42:1 54:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 ++1 4:1 8:1 14:1 24:1 38:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 14:1 19:1 39:1 40:1 55:1 62:1 69:1 72:1 75:1 76:1 78:1 83:1 +-1 5:1 6:1 16:1 27:1 35:1 45:1 54:1 64:1 67:1 73:1 74:1 76:1 80:1 114:1 ++1 1:1 6:1 15:1 21:1 35:1 40:1 57:1 63:1 67:1 73:1 75:1 76:1 80:1 100:1 ++1 4:1 10:1 15:1 29:1 39:1 40:1 52:1 63:1 71:1 73:1 74:1 76:1 79:1 83:1 +-1 4:1 6:1 15:1 21:1 35:1 42:1 53:1 65:1 71:1 72:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 17:1 24:1 38:1 41:1 55:1 64:1 67:1 73:1 74:1 77:1 80:1 83:1 +-1 5:1 6:1 14:1 31:1 35:1 44:1 55:1 64:1 67:1 72:1 74:1 76:1 78:1 83:1 ++1 4:1 11:1 17:1 32:1 39:1 43:1 52:1 66:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 14:1 20:1 37:1 41:1 55:1 64:1 67:1 72:1 75:1 76:1 80:1 83:1 +-1 1:1 7:1 18:1 26:1 35:1 42:1 52:1 64:1 67:1 73:1 74:1 76:1 79:1 103:1 ++1 4:1 9:1 18:1 20:1 37:1 40:1 51:1 63:1 71:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 14:1 19:1 39:1 42:1 55:1 62:1 68:1 72:1 74:1 76:1 78:1 83:1 +-1 5:1 6:1 16:1 24:1 38:1 40:1 50:1 61:1 67:1 72:1 75:1 76:1 80:1 83:1 +-1 4:1 17:1 25:1 38:1 41:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 6:1 17:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 16:1 22:1 36:1 42:1 54:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 18:1 22:1 36:1 41:1 50:1 65:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 2:1 6:1 18:1 22:1 36:1 42:1 48:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 14:1 19:1 39:1 42:1 52:1 64:1 67:1 73:1 74:1 76:1 78:1 83:1 ++1 5:1 6:1 15:1 29:1 39:1 40:1 51:1 63:1 67:1 73:1 75:1 76:1 82:1 +-1 5:1 6:1 15:1 20:1 37:1 41:1 54:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 4:1 6:1 18:1 29:1 39:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 80:1 109:1 ++1 3:1 6:1 14:1 19:1 39:1 41:1 51:1 66:1 67:1 72:1 74:1 76:1 82:1 83:1 +-1 1:1 15:1 20:1 37:1 42:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 14:1 22:1 36:1 41:1 55:1 65:1 69:1 72:1 74:1 76:1 79:1 83:1 ++1 5:1 6:1 15:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 5:1 6:1 18:1 19:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 15:1 27:1 35:1 44:1 49:1 66:1 69:1 72:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 18:1 20:1 37:1 40:1 55:1 63:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 2:1 15:1 19:1 39:1 42:1 66:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 3:1 7:1 16:1 22:1 36:1 42:1 48:1 64:1 67:1 73:1 74:1 76:1 79:1 83:1 +-1 3:1 9:1 16:1 19:1 39:1 42:1 52:1 62:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 15:1 20:1 37:1 42:1 49:1 64:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 5:1 10:1 15:1 20:1 37:1 44:1 49:1 64:1 67:1 72:1 74:1 76:1 80:1 100:1 +-1 2:1 6:1 14:1 20:1 37:1 42:1 51:1 64:1 67:1 73:1 74:1 77:1 82:1 83:1 +-1 2:1 6:1 16:1 19:1 39:1 42:1 52:1 62:1 67:1 72:1 74:1 76:1 79:1 83:1 +-1 5:1 6:1 16:1 22:1 36:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 2:1 7:1 16:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 17:1 22:1 36:1 42:1 49:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 2:1 6:1 18:1 19:1 39:1 41:1 51:1 64:1 67:1 72:1 74:1 76:1 82:1 83:1 +-1 4:1 6:1 15:1 22:1 36:1 41:1 55:1 66:1 67:1 72:1 74:1 76:1 82:1 83:1 +-1 4:1 6:1 16:1 19:1 39:1 42:1 55:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 11:1 17:1 29:1 39:1 42:1 52:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 3:1 7:1 16:1 21:1 35:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 11:1 18:1 19:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 79:1 83:1 ++1 5:1 7:1 14:1 19:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 14:1 20:1 37:1 42:1 52:1 64:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 2:1 6:1 15:1 24:1 38:1 42:1 49:1 64:1 71:1 72:1 74:1 76:1 80:1 83:1 +-1 5:1 7:1 16:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 75:1 76:1 78:1 83:1 +-1 1:1 6:1 15:1 26:1 35:1 42:1 48:1 66:1 67:1 73:1 75:1 76:1 80:1 83:1 +-1 3:1 6:1 17:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 3:1 6:1 16:1 29:1 39:1 42:1 55:1 64:1 67:1 73:1 75:1 76:1 82:1 83:1 +-1 4:1 6:1 18:1 22:1 36:1 42:1 51:1 66:1 71:1 72:1 74:1 76:1 78:1 83:1 +-1 2:1 6:1 16:1 21:1 35:1 42:1 49:1 62:1 71:1 73:1 75:1 76:1 78:1 83:1 +-1 3:1 6:1 14:1 22:1 36:1 41:1 51:1 66:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 1:1 10:1 16:1 19:1 39:1 42:1 52:1 62:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 11:1 15:1 22:1 36:1 42:1 59:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 16:1 20:1 37:1 42:1 55:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 4:1 10:1 16:1 19:1 39:1 40:1 52:1 61:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 14:1 19:1 39:1 42:1 55:1 64:1 67:1 72:1 74:1 76:1 81:1 83:1 +-1 1:1 6:1 15:1 22:1 36:1 42:1 49:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 14:1 22:1 36:1 44:1 49:1 64:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 2:1 7:1 15:1 26:1 35:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 18:1 26:1 35:1 40:1 54:1 63:1 71:1 73:1 75:1 76:1 80:1 83:1 ++1 2:1 6:1 17:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 4:1 6:1 15:1 25:1 38:1 40:1 47:1 61:1 67:1 72:1 74:1 77:1 78:1 83:1 +-1 3:1 11:1 17:1 20:1 37:1 43:1 51:1 62:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 14:1 20:1 37:1 41:1 52:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 5:1 8:1 15:1 20:1 37:1 40:1 50:1 63:1 67:1 73:1 74:1 77:1 79:1 83:1 ++1 5:1 6:1 14:1 22:1 36:1 40:1 47:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 18:1 22:1 36:1 41:1 54:1 66:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 15:1 20:1 37:1 42:1 50:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 14:1 20:1 37:1 42:1 49:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 2:1 6:1 16:1 31:1 35:1 42:1 55:1 62:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 5:1 6:1 17:1 20:1 37:1 40:1 59:1 63:1 71:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 6:1 16:1 19:1 39:1 42:1 51:1 64:1 67:1 73:1 74:1 76:1 78:1 87:1 +-1 5:1 6:1 16:1 31:1 35:1 44:1 56:1 66:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 14:1 22:1 36:1 42:1 49:1 62:1 67:1 73:1 74:1 76:1 78:1 87:1 +-1 1:1 6:1 14:1 22:1 36:1 42:1 53:1 65:1 71:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 17:1 22:1 36:1 42:1 55:1 66:1 67:1 72:1 74:1 76:1 82:1 83:1 +-1 4:1 6:1 15:1 22:1 36:1 42:1 57:1 64:1 67:1 73:1 74:1 76:1 80:1 100:1 +-1 5:1 6:1 18:1 22:1 36:1 41:1 55:1 66:1 67:1 72:1 74:1 76:1 81:1 83:1 +-1 2:1 6:1 14:1 27:1 35:1 40:1 50:1 65:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 17:1 22:1 36:1 42:1 49:1 62:1 67:1 73:1 74:1 76:1 80:1 103:1 +-1 1:1 6:1 14:1 20:1 37:1 42:1 49:1 62:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 16:1 21:1 35:1 42:1 57:1 62:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 6:1 18:1 22:1 36:1 41:1 49:1 64:1 67:1 72:1 74:1 76:1 82:1 83:1 +-1 3:1 9:1 15:1 19:1 39:1 42:1 55:1 62:1 67:1 73:1 74:1 76:1 79:1 83:1 ++1 4:1 6:1 15:1 29:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 17:1 20:1 37:1 42:1 48:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 10:1 15:1 20:1 37:1 40:1 49:1 61:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 7:1 16:1 19:1 39:1 42:1 52:1 65:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 16:1 22:1 36:1 41:1 48:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 15:1 33:1 35:1 40:1 54:1 63:1 67:1 73:1 74:1 77:1 80:1 83:1 +-1 5:1 6:1 15:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 4:1 10:1 16:1 29:1 39:1 41:1 59:1 64:1 71:1 73:1 74:1 76:1 82:1 83:1 +-1 2:1 6:1 17:1 20:1 37:1 42:1 48:1 64:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 3:1 6:1 18:1 22:1 36:1 43:1 49:1 64:1 71:1 72:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 18:1 33:1 35:1 42:1 53:1 65:1 67:1 73:1 74:1 76:1 78:1 97:1 +-1 4:1 6:1 16:1 22:1 36:1 43:1 52:1 66:1 67:1 72:1 74:1 77:1 80:1 86:1 +-1 2:1 6:1 17:1 20:1 37:1 42:1 49:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 5:1 6:1 15:1 27:1 35:1 42:1 49:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 5:1 7:1 15:1 20:1 37:1 40:1 49:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 4:1 6:1 17:1 19:1 39:1 40:1 52:1 61:1 67:1 72:1 74:1 76:1 78:1 95:1 +-1 3:1 6:1 17:1 22:1 36:1 40:1 53:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 18:1 22:1 36:1 40:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 5:1 6:1 16:1 22:1 36:1 44:1 51:1 66:1 67:1 73:1 74:1 76:1 79:1 83:1 ++1 3:1 6:1 17:1 25:1 38:1 40:1 48:1 63:1 67:1 73:1 75:1 76:1 81:1 83:1 +-1 3:1 6:1 15:1 20:1 37:1 42:1 50:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 5:1 14:1 26:1 35:1 40:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 10:1 18:1 20:1 37:1 42:1 51:1 66:1 71:1 72:1 74:1 76:1 82:1 83:1 +-1 5:1 6:1 15:1 22:1 36:1 41:1 51:1 64:1 67:1 72:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 17:1 20:1 37:1 42:1 49:1 64:1 67:1 73:1 74:1 76:1 79:1 83:1 +-1 3:1 6:1 17:1 22:1 36:1 43:1 50:1 66:1 71:1 72:1 74:1 76:1 78:1 83:1 +-1 5:1 7:1 15:1 20:1 37:1 41:1 50:1 64:1 67:1 72:1 74:1 76:1 79:1 83:1 +-1 1:1 6:1 17:1 20:1 37:1 42:1 50:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 17:1 20:1 37:1 42:1 55:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 15:1 22:1 36:1 41:1 53:1 64:1 67:1 72:1 74:1 76:1 82:1 83:1 +-1 5:1 6:1 17:1 22:1 36:1 42:1 48:1 65:1 68:1 73:1 74:1 76:1 80:1 84:1 +-1 2:1 6:1 16:1 22:1 36:1 42:1 54:1 66:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 3:1 6:1 18:1 29:1 39:1 42:1 55:1 64:1 67:1 72:1 74:1 76:1 82:1 99:1 +-1 2:1 6:1 14:1 20:1 37:1 42:1 53:1 62:1 68:1 73:1 74:1 76:1 80:1 83:1 ++1 4:1 11:1 15:1 22:1 36:1 42:1 57:1 64:1 67:1 72:1 75:1 76:1 80:1 83:1 +-1 5:1 6:1 16:1 20:1 37:1 40:1 56:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 15:1 20:1 37:1 41:1 55:1 64:1 68:1 72:1 74:1 76:1 79:1 83:1 +-1 5:1 18:1 26:1 35:1 41:1 64:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 2:1 7:1 15:1 20:1 37:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 3:1 6:1 18:1 25:1 38:1 40:1 57:1 63:1 67:1 73:1 75:1 76:1 82:1 83:1 +-1 1:1 6:1 15:1 24:1 38:1 42:1 55:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 18:1 31:1 35:1 41:1 48:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 17:1 20:1 37:1 41:1 55:1 66:1 71:1 72:1 74:1 76:1 79:1 83:1 +-1 3:1 6:1 18:1 33:1 35:1 41:1 53:1 66:1 67:1 73:1 74:1 76:1 80:1 103:1 +-1 3:1 6:1 14:1 19:1 39:1 40:1 51:1 61:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 14:1 20:1 37:1 40:1 47:1 63:1 67:1 73:1 74:1 77:1 80:1 83:1 +-1 2:1 6:1 17:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 8:1 18:1 22:1 36:1 42:1 50:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 4:1 6:1 14:1 19:1 39:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 3:1 9:1 18:1 20:1 37:1 40:1 47:1 61:1 67:1 72:1 75:1 76:1 80:1 83:1 ++1 5:1 7:1 16:1 23:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 18:1 22:1 36:1 42:1 52:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 5:1 6:1 18:1 22:1 36:1 44:1 50:1 64:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 2:1 6:1 16:1 24:1 38:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 15:1 22:1 36:1 42:1 51:1 62:1 71:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 8:1 15:1 29:1 39:1 41:1 51:1 64:1 67:1 72:1 74:1 76:1 82:1 83:1 +-1 2:1 6:1 15:1 20:1 37:1 40:1 54:1 63:1 71:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 9:1 14:1 19:1 39:1 45:1 51:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 15:1 20:1 37:1 42:1 49:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 ++1 5:1 7:1 14:1 22:1 36:1 40:1 56:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 5:1 14:1 21:1 35:1 45:1 66:1 71:1 72:1 74:1 76:1 78:1 83:1 +-1 2:1 6:1 16:1 19:1 39:1 42:1 52:1 62:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 15:1 22:1 36:1 40:1 49:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 15:1 22:1 36:1 42:1 52:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 8:1 18:1 29:1 39:1 41:1 51:1 64:1 71:1 72:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 18:1 31:1 35:1 42:1 49:1 64:1 67:1 72:1 74:1 76:1 79:1 83:1 +-1 2:1 6:1 15:1 22:1 36:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 4:1 6:1 16:1 25:1 38:1 42:1 48:1 66:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 7:1 16:1 24:1 38:1 40:1 48:1 63:1 67:1 73:1 75:1 76:1 78:1 113:1 +-1 4:1 6:1 17:1 33:1 35:1 40:1 53:1 63:1 67:1 73:1 74:1 76:1 80:1 103:1 ++1 3:1 6:1 16:1 19:1 39:1 40:1 50:1 61:1 67:1 72:1 74:1 76:1 79:1 83:1 +-1 5:1 6:1 14:1 20:1 37:1 40:1 51:1 63:1 67:1 73:1 74:1 77:1 80:1 83:1 +-1 4:1 11:1 15:1 22:1 36:1 41:1 48:1 66:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 4:1 6:1 15:1 22:1 36:1 40:1 53:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 15:1 25:1 38:1 43:1 52:1 66:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 17:1 20:1 37:1 45:1 57:1 64:1 67:1 72:1 74:1 76:1 79:1 83:1 ++1 5:1 6:1 17:1 20:1 37:1 40:1 55:1 63:1 67:1 73:1 74:1 76:1 81:1 83:1 ++1 5:1 10:1 15:1 22:1 36:1 40:1 51:1 63:1 67:1 73:1 75:1 76:1 80:1 83:1 +-1 3:1 6:1 16:1 22:1 36:1 40:1 50:1 61:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 2:1 6:1 17:1 20:1 37:1 41:1 49:1 64:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 17:1 21:1 35:1 42:1 55:1 65:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 2:1 6:1 17:1 19:1 39:1 42:1 52:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 14:1 20:1 37:1 42:1 51:1 64:1 67:1 72:1 74:1 76:1 79:1 83:1 +-1 5:1 6:1 15:1 22:1 36:1 41:1 50:1 64:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 5:1 6:1 15:1 20:1 37:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 2:1 6:1 16:1 20:1 37:1 42:1 50:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 17:1 22:1 36:1 44:1 49:1 65:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 5:1 18:1 22:1 36:1 40:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 ++1 5:1 8:1 16:1 20:1 37:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 11:1 18:1 20:1 37:1 42:1 55:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 4:1 10:1 15:1 29:1 39:1 41:1 52:1 66:1 71:1 72:1 74:1 76:1 80:1 83:1 +-1 5:1 7:1 16:1 22:1 36:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 1:1 16:1 19:1 39:1 42:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 6:1 14:1 22:1 36:1 42:1 53:1 64:1 67:1 73:1 75:1 76:1 82:1 83:1 +-1 5:1 10:1 15:1 22:1 36:1 41:1 57:1 65:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 4:1 6:1 18:1 20:1 37:1 40:1 48:1 63:1 71:1 73:1 74:1 76:1 81:1 83:1 +-1 4:1 6:1 16:1 25:1 38:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 3:1 7:1 18:1 20:1 37:1 40:1 52:1 61:1 67:1 72:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 17:1 19:1 39:1 42:1 49:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 4:1 7:1 16:1 22:1 36:1 41:1 52:1 64:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 4:1 10:1 14:1 24:1 38:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 5:1 10:1 15:1 22:1 36:1 40:1 55:1 61:1 67:1 72:1 75:1 76:1 78:1 83:1 +-1 3:1 6:1 15:1 19:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 81:1 83:1 ++1 4:1 11:1 17:1 19:1 39:1 40:1 51:1 63:1 71:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 15:1 22:1 36:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 2:1 6:1 15:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 10:1 16:1 25:1 38:1 42:1 59:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 5:1 7:1 16:1 33:1 35:1 40:1 56:1 63:1 67:1 73:1 74:1 76:1 82:1 87:1 +-1 1:1 6:1 18:1 19:1 39:1 42:1 50:1 64:1 67:1 72:1 74:1 76:1 82:1 83:1 ++1 1:1 6:1 14:1 19:1 39:1 42:1 52:1 62:1 67:1 72:1 74:1 77:1 80:1 83:1 ++1 2:1 7:1 14:1 23:1 39:1 40:1 52:1 63:1 67:1 73:1 75:1 76:1 81:1 83:1 ++1 5:1 6:1 17:1 29:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 18:1 26:1 35:1 40:1 58:1 61:1 71:1 72:1 74:1 76:1 78:1 83:1 +-1 3:1 6:1 14:1 22:1 36:1 40:1 57:1 63:1 67:1 73:1 75:1 76:1 80:1 83:1 ++1 2:1 6:1 16:1 21:1 35:1 40:1 53:1 63:1 67:1 73:1 75:1 76:1 80:1 83:1 ++1 3:1 7:1 18:1 19:1 39:1 40:1 50:1 63:1 67:1 73:1 75:1 76:1 82:1 83:1 +-1 5:1 6:1 15:1 22:1 36:1 41:1 55:1 66:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 4:1 6:1 16:1 31:1 35:1 40:1 50:1 63:1 67:1 73:1 74:1 77:1 82:1 83:1 +-1 2:1 7:1 16:1 25:1 38:1 40:1 56:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 5:1 7:1 14:1 22:1 36:1 40:1 56:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 2:1 6:1 16:1 19:1 39:1 42:1 47:1 64:1 67:1 72:1 74:1 76:1 79:1 83:1 +-1 3:1 7:1 17:1 22:1 36:1 40:1 56:1 63:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 3:1 6:1 18:1 21:1 35:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 17:1 20:1 37:1 42:1 57:1 64:1 71:1 73:1 75:1 76:1 82:1 83:1 ++1 5:1 7:1 14:1 22:1 36:1 40:1 56:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 2:1 10:1 16:1 20:1 37:1 45:1 52:1 64:1 67:1 73:1 74:1 76:1 82:1 88:1 +-1 1:1 16:1 20:1 37:1 42:1 65:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 5:1 14:1 22:1 36:1 40:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 ++1 2:1 6:1 16:1 29:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 77:1 80:1 83:1 +-1 5:1 10:1 18:1 25:1 38:1 40:1 57:1 63:1 71:1 73:1 74:1 76:1 80:1 83:1 ++1 5:1 6:1 14:1 31:1 35:1 40:1 50:1 61:1 68:1 72:1 74:1 76:1 78:1 91:1 +-1 1:1 6:1 18:1 22:1 36:1 42:1 54:1 62:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 14:1 27:1 35:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 16:1 22:1 36:1 40:1 49:1 63:1 68:1 73:1 74:1 76:1 80:1 94:1 +-1 4:1 6:1 18:1 22:1 36:1 41:1 50:1 66:1 71:1 73:1 75:1 76:1 80:1 83:1 +-1 2:1 11:1 16:1 32:1 39:1 42:1 52:1 64:1 67:1 72:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 14:1 20:1 37:1 42:1 50:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 5:1 9:1 14:1 19:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 17:1 21:1 35:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 18:1 33:1 35:1 40:1 49:1 63:1 67:1 73:1 74:1 76:1 80:1 103:1 +-1 4:1 10:1 14:1 27:1 35:1 41:1 53:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 7:1 14:1 22:1 36:1 40:1 56:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 4:1 6:1 16:1 24:1 38:1 41:1 51:1 64:1 71:1 72:1 74:1 76:1 80:1 101:1 +-1 5:1 7:1 16:1 22:1 36:1 44:1 50:1 64:1 67:1 72:1 74:1 76:1 82:1 83:1 ++1 3:1 6:1 18:1 19:1 39:1 40:1 48:1 63:1 68:1 73:1 74:1 76:1 80:1 84:1 +-1 3:1 9:1 14:1 22:1 36:1 42:1 55:1 62:1 71:1 72:1 74:1 76:1 80:1 83:1 ++1 4:1 7:1 14:1 19:1 39:1 40:1 56:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 6:1 15:1 20:1 37:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 17:1 21:1 35:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 17:1 20:1 37:1 43:1 50:1 66:1 67:1 72:1 74:1 76:1 81:1 83:1 +-1 2:1 6:1 18:1 21:1 35:1 40:1 56:1 63:1 67:1 73:1 74:1 76:1 82:1 103:1 ++1 4:1 8:1 14:1 19:1 39:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 5:1 7:1 15:1 20:1 37:1 43:1 50:1 64:1 67:1 73:1 74:1 76:1 79:1 83:1 +-1 2:1 6:1 15:1 19:1 39:1 42:1 52:1 66:1 70:1 73:1 74:1 76:1 80:1 83:1 ++1 3:1 6:1 15:1 19:1 39:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 6:1 16:1 19:1 39:1 42:1 49:1 64:1 68:1 72:1 74:1 76:1 79:1 117:1 +-1 1:1 6:1 14:1 20:1 37:1 42:1 53:1 64:1 67:1 72:1 74:1 76:1 79:1 83:1 +-1 1:1 14:1 20:1 37:1 40:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 1:1 17:1 20:1 37:1 45:1 66:1 71:1 72:1 74:1 76:1 80:1 83:1 ++1 4:1 11:1 17:1 19:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 3:1 10:1 18:1 19:1 39:1 40:1 55:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 4:1 6:1 17:1 22:1 36:1 40:1 53:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 5:1 6:1 14:1 22:1 36:1 45:1 55:1 64:1 67:1 72:1 74:1 76:1 82:1 83:1 +-1 5:1 10:1 15:1 24:1 38:1 41:1 49:1 64:1 67:1 72:1 75:1 76:1 78:1 83:1 +-1 1:1 6:1 17:1 20:1 37:1 42:1 55:1 65:1 67:1 73:1 74:1 76:1 78:1 115:1 +-1 5:1 6:1 18:1 31:1 35:1 44:1 54:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 15:1 22:1 36:1 42:1 48:1 62:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 3:1 6:1 16:1 29:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 77:1 80:1 83:1 +-1 2:1 7:1 17:1 19:1 39:1 41:1 50:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 14:1 20:1 37:1 42:1 55:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 17:1 20:1 37:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 80:1 119:1 +-1 4:1 6:1 17:1 20:1 37:1 41:1 50:1 66:1 67:1 72:1 74:1 76:1 80:1 83:1 ++1 4:1 6:1 18:1 24:1 38:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 4:1 10:1 18:1 24:1 38:1 40:1 51:1 63:1 71:1 73:1 74:1 76:1 82:1 83:1 ++1 5:1 6:1 17:1 22:1 36:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 18:1 20:1 37:1 42:1 49:1 64:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 3:1 6:1 18:1 24:1 38:1 41:1 51:1 64:1 67:1 72:1 74:1 76:1 82:1 83:1 ++1 5:1 10:1 14:1 19:1 39:1 40:1 55:1 61:1 67:1 72:1 74:1 76:1 80:1 83:1 ++1 3:1 6:1 14:1 19:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 5:1 6:1 15:1 22:1 36:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 5:1 8:1 14:1 19:1 39:1 40:1 56:1 63:1 67:1 73:1 74:1 77:1 82:1 83:1 +-1 3:1 6:1 16:1 21:1 35:1 42:1 48:1 62:1 67:1 73:1 75:1 76:1 80:1 83:1 +-1 1:1 6:1 15:1 25:1 38:1 42:1 50:1 64:1 71:1 72:1 74:1 76:1 79:1 83:1 +-1 5:1 6:1 14:1 20:1 37:1 41:1 49:1 64:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 3:1 10:1 17:1 24:1 38:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 4:1 9:1 18:1 20:1 37:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 16:1 22:1 36:1 42:1 48:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 18:1 20:1 37:1 42:1 55:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 ++1 4:1 6:1 17:1 19:1 39:1 40:1 50:1 63:1 67:1 73:1 75:1 76:1 80:1 83:1 +-1 5:1 14:1 31:1 35:1 40:1 63:1 69:1 73:1 75:1 76:1 78:1 83:1 +-1 5:1 15:1 20:1 37:1 41:1 64:1 71:1 73:1 74:1 76:1 82:1 83:1 +-1 2:1 6:1 18:1 22:1 36:1 40:1 49:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 4:1 10:1 14:1 19:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 18:1 22:1 36:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 6:1 16:1 21:1 35:1 41:1 54:1 66:1 67:1 72:1 74:1 76:1 80:1 83:1 ++1 2:1 6:1 16:1 19:1 39:1 42:1 51:1 64:1 67:1 72:1 74:1 76:1 81:1 83:1 +-1 2:1 6:1 14:1 22:1 36:1 42:1 57:1 66:1 67:1 72:1 74:1 77:1 82:1 83:1 +-1 2:1 6:1 14:1 24:1 38:1 41:1 47:1 64:1 67:1 72:1 74:1 76:1 81:1 83:1 +-1 2:1 6:1 16:1 19:1 39:1 42:1 55:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 17:1 22:1 36:1 42:1 48:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 16:1 22:1 36:1 42:1 49:1 64:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 14:1 20:1 37:1 41:1 52:1 66:1 67:1 72:1 74:1 76:1 79:1 83:1 +-1 3:1 6:1 17:1 22:1 36:1 42:1 48:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 4:1 6:1 14:1 22:1 36:1 40:1 55:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 3:1 10:1 14:1 20:1 37:1 40:1 59:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 4:1 6:1 15:1 34:1 35:1 40:1 49:1 63:1 67:1 73:1 74:1 76:1 80:1 +-1 1:1 10:1 14:1 20:1 37:1 42:1 49:1 64:1 67:1 72:1 74:1 77:1 80:1 83:1 +-1 3:1 6:1 14:1 22:1 36:1 41:1 49:1 66:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 14:1 20:1 37:1 42:1 55:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 3:1 6:1 14:1 33:1 35:1 45:1 49:1 66:1 68:1 72:1 74:1 76:1 80:1 98:1 +-1 3:1 6:1 18:1 22:1 36:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 6:1 16:1 22:1 36:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 14:1 20:1 37:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 7:1 14:1 19:1 39:1 40:1 51:1 61:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 14:1 19:1 39:1 42:1 55:1 62:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 17:1 21:1 35:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 114:1 +-1 3:1 6:1 15:1 21:1 35:1 41:1 49:1 65:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 3:1 6:1 18:1 21:1 35:1 42:1 54:1 66:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 14:1 22:1 36:1 42:1 48:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 4:1 7:1 17:1 23:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 77:1 82:1 83:1 ++1 5:1 10:1 15:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 77:1 79:1 83:1 +-1 3:1 6:1 15:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 2:1 6:1 14:1 19:1 39:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 18:1 22:1 36:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 10:1 16:1 19:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 4:1 6:1 14:1 22:1 36:1 42:1 54:1 64:1 67:1 73:1 75:1 76:1 81:1 83:1 +-1 5:1 7:1 14:1 20:1 37:1 40:1 56:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 2:1 6:1 16:1 29:1 39:1 42:1 52:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 10:1 14:1 20:1 37:1 43:1 55:1 66:1 69:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 17:1 24:1 38:1 42:1 55:1 64:1 67:1 72:1 74:1 76:1 81:1 83:1 +-1 2:1 6:1 17:1 24:1 38:1 42:1 54:1 66:1 71:1 72:1 74:1 76:1 80:1 83:1 ++1 5:1 10:1 17:1 23:1 39:1 40:1 55:1 63:1 68:1 73:1 74:1 76:1 80:1 98:1 +-1 2:1 6:1 16:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 5:1 10:1 14:1 20:1 37:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 10:1 16:1 19:1 39:1 42:1 52:1 62:1 71:1 72:1 74:1 76:1 79:1 83:1 +-1 3:1 9:1 18:1 29:1 39:1 42:1 47:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 ++1 5:1 11:1 17:1 32:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 18:1 24:1 38:1 42:1 51:1 66:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 17:1 22:1 36:1 42:1 48:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 18:1 20:1 37:1 42:1 52:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 3:1 6:1 17:1 21:1 35:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 78:1 +-1 4:1 7:1 14:1 20:1 37:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 17:1 22:1 36:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 16:1 26:1 35:1 42:1 54:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 15:1 20:1 37:1 42:1 52:1 64:1 67:1 72:1 74:1 76:1 78:1 83:1 ++1 5:1 8:1 15:1 24:1 38:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 4:1 6:1 14:1 25:1 38:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 87:1 +-1 1:1 6:1 18:1 20:1 37:1 42:1 49:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 4:1 9:1 14:1 25:1 38:1 40:1 55:1 63:1 67:1 73:1 75:1 76:1 80:1 83:1 +-1 4:1 6:1 17:1 20:1 37:1 41:1 55:1 66:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 5:1 11:1 18:1 22:1 36:1 41:1 49:1 62:1 71:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 14:1 24:1 38:1 41:1 48:1 64:1 71:1 73:1 74:1 76:1 81:1 83:1 +-1 1:1 6:1 16:1 33:1 35:1 42:1 53:1 65:1 67:1 73:1 74:1 76:1 80:1 114:1 +-1 5:1 6:1 16:1 26:1 35:1 40:1 49:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 18:1 20:1 37:1 40:1 50:1 65:1 68:1 72:1 74:1 76:1 80:1 92:1 +-1 1:1 6:1 15:1 28:1 35:1 42:1 57:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 18:1 20:1 37:1 42:1 50:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 2:1 6:1 16:1 24:1 38:1 40:1 55:1 63:1 67:1 73:1 74:1 76:1 80:1 99:1 +-1 2:1 17:1 22:1 36:1 42:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 15:1 20:1 37:1 42:1 52:1 65:1 68:1 72:1 74:1 76:1 78:1 93:1 +-1 1:1 6:1 17:1 20:1 37:1 42:1 49:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 2:1 17:1 20:1 37:1 42:1 62:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 14:1 25:1 38:1 40:1 55:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 5:1 6:1 17:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 15:1 20:1 37:1 42:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 15:1 20:1 37:1 42:1 50:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 4:1 6:1 16:1 31:1 35:1 40:1 56:1 63:1 71:1 73:1 74:1 76:1 80:1 83:1 ++1 5:1 6:1 14:1 19:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 7:1 15:1 22:1 36:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 5:1 14:1 33:1 35:1 40:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 17:1 19:1 39:1 42:1 53:1 66:1 67:1 73:1 74:1 76:1 79:1 83:1 +-1 2:1 18:1 22:1 36:1 41:1 66:1 71:1 72:1 74:1 76:1 78:1 83:1 +-1 4:1 7:1 15:1 33:1 35:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 16:1 22:1 36:1 41:1 49:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 10:1 18:1 19:1 39:1 42:1 52:1 62:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 2:1 6:1 16:1 20:1 37:1 42:1 54:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 14:1 22:1 36:1 40:1 49:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 11:1 17:1 20:1 37:1 40:1 55:1 63:1 71:1 73:1 74:1 76:1 79:1 83:1 ++1 4:1 7:1 16:1 23:1 39:1 40:1 52:1 63:1 67:1 73:1 75:1 76:1 82:1 83:1 +-1 2:1 6:1 17:1 22:1 36:1 43:1 48:1 66:1 71:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 18:1 22:1 36:1 40:1 54:1 61:1 67:1 72:1 75:1 76:1 80:1 119:1 ++1 3:1 6:1 16:1 19:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 5:1 8:1 18:1 19:1 39:1 40:1 54:1 63:1 68:1 73:1 75:1 76:1 80:1 +-1 4:1 14:1 20:1 37:1 41:1 64:1 69:1 72:1 74:1 76:1 79:1 83:1 +-1 1:1 6:1 14:1 26:1 35:1 42:1 49:1 66:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 17:1 28:1 35:1 42:1 49:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 5:1 8:1 14:1 22:1 36:1 45:1 50:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 14:1 21:1 35:1 42:1 62:1 71:1 72:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 18:1 20:1 37:1 42:1 49:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 5:1 6:1 16:1 24:1 38:1 42:1 52:1 65:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 3:1 11:1 18:1 20:1 37:1 42:1 57:1 62:1 71:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 17:1 22:1 36:1 42:1 57:1 62:1 67:1 73:1 74:1 77:1 80:1 83:1 +-1 5:1 11:1 14:1 29:1 39:1 41:1 52:1 64:1 67:1 72:1 74:1 76:1 79:1 83:1 +-1 5:1 7:1 18:1 31:1 35:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 79:1 83:1 +-1 5:1 6:1 16:1 22:1 36:1 40:1 54:1 63:1 67:1 73:1 75:1 76:1 81:1 83:1 +-1 4:1 10:1 16:1 27:1 35:1 45:1 49:1 64:1 67:1 72:1 74:1 76:1 79:1 86:1 +-1 3:1 6:1 14:1 20:1 37:1 43:1 49:1 64:1 67:1 72:1 75:1 76:1 82:1 83:1 +-1 5:1 7:1 14:1 22:1 36:1 44:1 56:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 14:1 20:1 37:1 42:1 55:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 14:1 20:1 37:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 6:1 18:1 25:1 38:1 40:1 56:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 4:1 6:1 16:1 22:1 36:1 41:1 57:1 62:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 4:1 8:1 17:1 29:1 39:1 40:1 51:1 63:1 67:1 73:1 75:1 76:1 82:1 83:1 ++1 5:1 6:1 15:1 25:1 38:1 40:1 47:1 63:1 67:1 73:1 75:1 76:1 80:1 83:1 +-1 2:1 10:1 16:1 20:1 37:1 42:1 49:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 ++1 2:1 6:1 17:1 19:1 39:1 40:1 51:1 61:1 67:1 72:1 74:1 76:1 80:1 83:1 ++1 5:1 8:1 17:1 20:1 37:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 3:1 6:1 15:1 19:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 77:1 82:1 83:1 +-1 1:1 6:1 14:1 19:1 39:1 42:1 51:1 64:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 5:1 11:1 14:1 19:1 39:1 45:1 52:1 64:1 67:1 73:1 75:1 76:1 80:1 83:1 +-1 4:1 10:1 15:1 22:1 36:1 40:1 59:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 3:1 6:1 17:1 31:1 35:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 15:1 25:1 38:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 15:1 20:1 37:1 42:1 55:1 64:1 67:1 73:1 74:1 76:1 78:1 83:1 ++1 5:1 9:1 17:1 20:1 37:1 40:1 51:1 63:1 67:1 73:1 75:1 76:1 80:1 83:1 +-1 1:1 6:1 17:1 22:1 36:1 42:1 55:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 4:1 6:1 15:1 24:1 38:1 43:1 51:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 5:1 6:1 15:1 19:1 39:1 40:1 51:1 63:1 68:1 73:1 74:1 76:1 80:1 98:1 +-1 2:1 6:1 15:1 32:1 39:1 40:1 52:1 61:1 67:1 72:1 74:1 76:1 82:1 83:1 +-1 5:1 6:1 14:1 20:1 37:1 40:1 51:1 61:1 67:1 72:1 74:1 76:1 81:1 83:1 ++1 5:1 6:1 15:1 20:1 37:1 40:1 48:1 63:1 67:1 73:1 75:1 76:1 82:1 83:1 +-1 2:1 6:1 18:1 22:1 36:1 41:1 48:1 66:1 67:1 73:1 74:1 76:1 79:1 83:1 +-1 5:1 8:1 15:1 22:1 36:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 15:1 20:1 37:1 42:1 53:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 1:1 11:1 17:1 19:1 39:1 42:1 52:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 ++1 4:1 6:1 14:1 29:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 5:1 9:1 18:1 20:1 37:1 40:1 55:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 18:1 22:1 36:1 40:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 16:1 20:1 37:1 42:1 52:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 3:1 6:1 14:1 20:1 37:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 18:1 22:1 36:1 42:1 48:1 62:1 67:1 73:1 75:1 76:1 80:1 83:1 ++1 5:1 6:1 18:1 25:1 38:1 40:1 52:1 63:1 67:1 73:1 75:1 76:1 80:1 83:1 ++1 3:1 7:1 15:1 23:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 4:1 7:1 18:1 32:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 77:1 82:1 83:1 +-1 1:1 6:1 16:1 31:1 35:1 40:1 49:1 63:1 67:1 73:1 75:1 76:1 80:1 83:1 +-1 5:1 18:1 22:1 36:1 40:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 14:1 27:1 35:1 41:1 64:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 5:1 16:1 30:1 35:1 44:1 64:1 71:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 14:1 22:1 36:1 42:1 55:1 64:1 67:1 73:1 74:1 76:1 82:1 103:1 +-1 2:1 6:1 14:1 22:1 36:1 40:1 53:1 63:1 69:1 73:1 74:1 76:1 78:1 83:1 +-1 2:1 6:1 16:1 22:1 36:1 43:1 55:1 62:1 67:1 72:1 74:1 76:1 80:1 83:1 ++1 3:1 18:1 19:1 39:1 40:1 61:1 67:1 72:1 74:1 76:1 78:1 83:1 ++1 4:1 6:1 16:1 22:1 36:1 41:1 48:1 64:1 71:1 73:1 75:1 76:1 81:1 83:1 +-1 2:1 6:1 17:1 26:1 35:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 10:1 14:1 22:1 36:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 2:1 6:1 14:1 19:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 2:1 6:1 16:1 24:1 38:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 3:1 6:1 15:1 22:1 36:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 2:1 6:1 15:1 19:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 77:1 80:1 83:1 ++1 5:1 8:1 15:1 19:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 77:1 82:1 83:1 +-1 5:1 17:1 21:1 35:1 44:1 65:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 5:1 10:1 17:1 20:1 37:1 41:1 49:1 66:1 71:1 72:1 74:1 76:1 80:1 83:1 ++1 3:1 6:1 15:1 22:1 36:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 15:1 22:1 36:1 41:1 64:1 71:1 72:1 74:1 76:1 78:1 83:1 +-1 4:1 6:1 14:1 21:1 35:1 40:1 49:1 61:1 67:1 72:1 74:1 76:1 80:1 83:1 ++1 4:1 6:1 18:1 20:1 37:1 40:1 52:1 63:1 67:1 73:1 75:1 76:1 80:1 83:1 +-1 1:1 10:1 17:1 19:1 39:1 42:1 52:1 64:1 71:1 72:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 15:1 22:1 36:1 40:1 48:1 65:1 69:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 16:1 31:1 35:1 41:1 55:1 66:1 67:1 72:1 74:1 76:1 82:1 83:1 +-1 3:1 6:1 18:1 19:1 39:1 42:1 49:1 64:1 67:1 73:1 74:1 76:1 79:1 83:1 +-1 4:1 6:1 17:1 22:1 36:1 40:1 48:1 63:1 71:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 18:1 19:1 39:1 42:1 51:1 64:1 67:1 72:1 75:1 76:1 82:1 83:1 +-1 2:1 6:1 17:1 22:1 36:1 43:1 51:1 64:1 67:1 73:1 74:1 76:1 80:1 +-1 5:1 6:1 18:1 28:1 35:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 112:1 ++1 2:1 6:1 17:1 23:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 3:1 6:1 15:1 19:1 39:1 44:1 51:1 66:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 14:1 20:1 37:1 42:1 47:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 14:1 27:1 35:1 44:1 49:1 64:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 5:1 6:1 17:1 20:1 37:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 3:1 6:1 14:1 20:1 37:1 40:1 49:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 4:1 6:1 16:1 22:1 36:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 4:1 6:1 15:1 31:1 35:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 17:1 22:1 36:1 42:1 56:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 18:1 22:1 36:1 40:1 53:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 16:1 19:1 39:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 14:1 22:1 36:1 42:1 62:1 67:1 72:1 74:1 76:1 82:1 83:1 +-1 3:1 6:1 17:1 26:1 35:1 40:1 53:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 16:1 24:1 38:1 40:1 59:1 63:1 71:1 73:1 74:1 76:1 82:1 83:1 +-1 4:1 8:1 17:1 27:1 35:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 ++1 3:1 8:1 14:1 25:1 38:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 17:1 22:1 36:1 40:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 18:1 28:1 35:1 42:1 52:1 64:1 68:1 72:1 74:1 76:1 78:1 117:1 ++1 4:1 6:1 15:1 32:1 39:1 42:1 52:1 64:1 67:1 73:1 75:1 76:1 78:1 83:1 +-1 3:1 6:1 15:1 20:1 37:1 42:1 49:1 64:1 67:1 73:1 74:1 77:1 80:1 83:1 +-1 1:1 6:1 16:1 28:1 35:1 42:1 50:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 2:1 6:1 18:1 19:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 17:1 22:1 36:1 42:1 57:1 62:1 71:1 73:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 17:1 34:1 35:1 42:1 49:1 64:1 68:1 72:1 74:1 76:1 80:1 108:1 +-1 3:1 6:1 17:1 22:1 36:1 41:1 47:1 62:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 3:1 6:1 18:1 20:1 37:1 41:1 51:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 8:1 16:1 19:1 39:1 42:1 51:1 62:1 68:1 73:1 74:1 76:1 79:1 110:1 ++1 3:1 11:1 18:1 32:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 81:1 88:1 +-1 2:1 7:1 14:1 29:1 39:1 42:1 52:1 64:1 67:1 73:1 74:1 76:1 81:1 85:1 ++1 4:1 6:1 14:1 19:1 39:1 40:1 51:1 63:1 67:1 73:1 75:1 76:1 82:1 83:1 +-1 4:1 6:1 14:1 22:1 36:1 41:1 49:1 64:1 67:1 73:1 74:1 77:1 80:1 83:1 ++1 5:1 8:1 15:1 19:1 39:1 40:1 51:1 63:1 67:1 73:1 75:1 76:1 82:1 83:1 +-1 3:1 6:1 17:1 24:1 38:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 86:1 +-1 4:1 6:1 18:1 33:1 35:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 80:1 103:1 +-1 1:1 6:1 18:1 20:1 37:1 42:1 52:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 3:1 6:1 14:1 25:1 38:1 41:1 50:1 66:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 3:1 10:1 18:1 22:1 36:1 40:1 49:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 3:1 6:1 15:1 29:1 39:1 40:1 52:1 61:1 67:1 72:1 74:1 77:1 78:1 83:1 +-1 1:1 6:1 14:1 28:1 35:1 42:1 55:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 4:1 11:1 17:1 19:1 39:1 41:1 55:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 17:1 22:1 36:1 45:1 51:1 66:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 2:1 6:1 18:1 19:1 39:1 42:1 52:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 5:1 7:1 17:1 20:1 37:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 81:1 83:1 ++1 4:1 6:1 18:1 20:1 37:1 43:1 50:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 4:1 6:1 14:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 77:1 80:1 83:1 +-1 4:1 6:1 16:1 20:1 37:1 41:1 50:1 66:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 6:1 14:1 29:1 39:1 42:1 49:1 64:1 67:1 72:1 74:1 76:1 78:1 83:1 ++1 3:1 10:1 16:1 19:1 39:1 42:1 59:1 64:1 67:1 72:1 75:1 76:1 81:1 83:1 +-1 1:1 6:1 15:1 21:1 35:1 42:1 57:1 65:1 67:1 73:1 74:1 76:1 80:1 114:1 +-1 2:1 6:1 15:1 20:1 37:1 40:1 53:1 63:1 67:1 73:1 74:1 76:1 80:1 100:1 +-1 4:1 10:1 17:1 22:1 36:1 43:1 49:1 66:1 71:1 72:1 74:1 76:1 80:1 83:1 +-1 4:1 7:1 16:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 82:1 85:1 ++1 3:1 11:1 14:1 20:1 37:1 40:1 51:1 61:1 67:1 72:1 75:1 76:1 79:1 83:1 +-1 2:1 6:1 18:1 19:1 39:1 42:1 47:1 64:1 71:1 72:1 74:1 76:1 80:1 106:1 ++1 5:1 6:1 16:1 22:1 36:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 15:1 22:1 36:1 42:1 64:1 67:1 73:1 74:1 77:1 79:1 83:1 +-1 2:1 6:1 15:1 33:1 35:1 40:1 54:1 63:1 67:1 73:1 75:1 76:1 80:1 103:1 +-1 1:1 6:1 17:1 19:1 39:1 42:1 55:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 14:1 22:1 36:1 41:1 49:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 17:1 22:1 36:1 44:1 54:1 66:1 71:1 72:1 74:1 76:1 81:1 83:1 +-1 1:1 6:1 18:1 21:1 35:1 42:1 52:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 10:1 17:1 22:1 36:1 40:1 57:1 63:1 71:1 73:1 74:1 76:1 80:1 83:1 ++1 4:1 6:1 17:1 25:1 38:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 14:1 24:1 38:1 42:1 55:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 16:1 22:1 36:1 41:1 47:1 66:1 71:1 72:1 74:1 76:1 79:1 83:1 ++1 5:1 8:1 14:1 29:1 39:1 40:1 51:1 63:1 67:1 73:1 75:1 76:1 80:1 83:1 ++1 4:1 11:1 14:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 18:1 22:1 36:1 40:1 63:1 71:1 73:1 74:1 76:1 80:1 83:1 ++1 2:1 6:1 17:1 19:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 81:1 83:1 ++1 5:1 8:1 16:1 19:1 39:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 5:1 6:1 16:1 22:1 36:1 44:1 53:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 14:1 29:1 39:1 44:1 52:1 64:1 67:1 72:1 75:1 76:1 82:1 83:1 +-1 5:1 16:1 22:1 36:1 40:1 63:1 67:1 73:1 75:1 76:1 78:1 83:1 +-1 5:1 6:1 16:1 21:1 35:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 17:1 22:1 36:1 42:1 49:1 64:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 17:1 20:1 37:1 42:1 47:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 1:1 14:1 20:1 37:1 42:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 3:1 7:1 17:1 32:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 3:1 10:1 14:1 32:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 77:1 82:1 83:1 ++1 4:1 10:1 16:1 19:1 39:1 40:1 52:1 61:1 71:1 72:1 74:1 76:1 80:1 83:1 ++1 2:1 7:1 14:1 22:1 36:1 40:1 56:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 17:1 22:1 36:1 42:1 55:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 1:1 18:1 20:1 37:1 42:1 62:1 67:1 72:1 74:1 77:1 80:1 83:1 +-1 2:1 6:1 14:1 31:1 35:1 45:1 55:1 66:1 67:1 72:1 74:1 76:1 80:1 103:1 +-1 1:1 6:1 17:1 22:1 36:1 42:1 50:1 64:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 5:1 7:1 15:1 31:1 35:1 40:1 56:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 7:1 15:1 20:1 37:1 41:1 55:1 66:1 67:1 72:1 74:1 76:1 79:1 83:1 +-1 1:1 18:1 20:1 37:1 42:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 4:1 6:1 16:1 22:1 36:1 40:1 55:1 61:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 15:1 20:1 37:1 42:1 50:1 62:1 71:1 72:1 74:1 76:1 78:1 83:1 +-1 5:1 6:1 18:1 19:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 6:1 16:1 24:1 38:1 41:1 48:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 16:1 22:1 36:1 40:1 48:1 63:1 68:1 73:1 74:1 76:1 80:1 110:1 +-1 5:1 6:1 16:1 20:1 37:1 41:1 49:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 ++1 2:1 6:1 14:1 22:1 36:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 79:1 83:1 +-1 2:1 8:1 14:1 19:1 39:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 2:1 9:1 18:1 29:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 10:1 14:1 19:1 39:1 40:1 52:1 61:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 16:1 22:1 36:1 41:1 55:1 64:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 15:1 31:1 35:1 42:1 50:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 ++1 3:1 11:1 16:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 77:1 80:1 83:1 +-1 1:1 6:1 18:1 25:1 38:1 42:1 55:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 1:1 15:1 20:1 37:1 42:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 5:1 6:1 18:1 27:1 35:1 41:1 54:1 66:1 67:1 72:1 74:1 76:1 80:1 83:1 ++1 4:1 7:1 16:1 22:1 36:1 40:1 56:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 4:1 6:1 14:1 27:1 35:1 42:1 49:1 62:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 5:1 8:1 15:1 25:1 38:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 92:1 +-1 4:1 10:1 17:1 22:1 36:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 11:1 14:1 20:1 37:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 79:1 83:1 +-1 3:1 11:1 15:1 22:1 36:1 41:1 52:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 14:1 19:1 39:1 40:1 50:1 61:1 67:1 73:1 74:1 76:1 82:1 +-1 2:1 6:1 17:1 22:1 36:1 42:1 57:1 62:1 71:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 16:1 20:1 37:1 42:1 55:1 64:1 67:1 72:1 74:1 76:1 81:1 83:1 +-1 4:1 6:1 15:1 22:1 36:1 41:1 55:1 64:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 5:1 9:1 14:1 22:1 36:1 42:1 55:1 64:1 71:1 72:1 74:1 76:1 80:1 83:1 ++1 3:1 6:1 18:1 22:1 36:1 40:1 51:1 63:1 67:1 73:1 75:1 76:1 82:1 83:1 ++1 3:1 6:1 14:1 23:1 39:1 40:1 52:1 63:1 67:1 73:1 75:1 76:1 82:1 83:1 +-1 1:1 6:1 16:1 24:1 38:1 42:1 50:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 3:1 11:1 17:1 29:1 39:1 40:1 52:1 63:1 68:1 73:1 74:1 76:1 78:1 90:1 +-1 3:1 6:1 18:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 17:1 19:1 39:1 41:1 51:1 64:1 67:1 73:1 74:1 76:1 79:1 83:1 ++1 4:1 6:1 15:1 32:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 77:1 82:1 83:1 ++1 2:1 10:1 17:1 22:1 36:1 40:1 59:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 2:1 6:1 18:1 22:1 36:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 16:1 20:1 37:1 42:1 48:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 1:1 17:1 20:1 37:1 42:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 2:1 15:1 22:1 36:1 43:1 66:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 5:1 17:1 22:1 36:1 44:1 64:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 2:1 6:1 17:1 21:1 35:1 43:1 56:1 65:1 67:1 73:1 74:1 76:1 80:1 86:1 +-1 1:1 10:1 16:1 20:1 37:1 42:1 55:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 8:1 15:1 22:1 36:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 5:1 6:1 14:1 22:1 36:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 5:1 6:1 14:1 29:1 39:1 40:1 52:1 63:1 68:1 73:1 74:1 76:1 81:1 90:1 ++1 5:1 9:1 14:1 29:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 104:1 +-1 3:1 6:1 15:1 22:1 36:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 6:1 18:1 20:1 37:1 42:1 57:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 18:1 27:1 35:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 3:1 6:1 18:1 29:1 39:1 42:1 51:1 64:1 71:1 72:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 17:1 22:1 36:1 43:1 53:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 4:1 7:1 17:1 23:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 79:1 83:1 +-1 4:1 11:1 16:1 20:1 37:1 41:1 55:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 ++1 5:1 9:1 14:1 22:1 36:1 40:1 55:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 3:1 6:1 18:1 19:1 39:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 5:1 6:1 15:1 23:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 5:1 6:1 18:1 29:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 4:1 6:1 18:1 22:1 36:1 40:1 57:1 63:1 67:1 73:1 75:1 76:1 81:1 83:1 +-1 5:1 6:1 16:1 22:1 36:1 41:1 59:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 10:1 18:1 19:1 39:1 44:1 52:1 64:1 71:1 72:1 74:1 77:1 78:1 83:1 ++1 5:1 6:1 16:1 19:1 39:1 40:1 47:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 5:1 6:1 16:1 27:1 35:1 44:1 49:1 64:1 67:1 72:1 74:1 76:1 78:1 88:1 +-1 1:1 6:1 16:1 22:1 36:1 42:1 50:1 62:1 67:1 72:1 74:1 76:1 79:1 83:1 +-1 1:1 7:1 14:1 22:1 36:1 42:1 48:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 7:1 15:1 19:1 39:1 41:1 48:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 5:1 6:1 17:1 22:1 36:1 41:1 55:1 66:1 67:1 72:1 74:1 76:1 80:1 83:1 ++1 3:1 6:1 15:1 22:1 36:1 40:1 50:1 63:1 67:1 73:1 74:1 77:1 80:1 83:1 +-1 1:1 6:1 18:1 20:1 37:1 42:1 49:1 62:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 15:1 22:1 36:1 42:1 55:1 66:1 71:1 72:1 75:1 76:1 79:1 83:1 +-1 1:1 6:1 17:1 20:1 37:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 7:1 17:1 22:1 36:1 40:1 56:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 4:1 6:1 16:1 19:1 39:1 43:1 51:1 66:1 67:1 73:1 75:1 76:1 80:1 83:1 +-1 1:1 6:1 18:1 22:1 36:1 42:1 53:1 62:1 69:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 17:1 20:1 37:1 40:1 47:1 61:1 67:1 72:1 74:1 76:1 80:1 83:1 ++1 4:1 7:1 18:1 20:1 37:1 40:1 48:1 63:1 67:1 73:1 74:1 77:1 82:1 83:1 +-1 1:1 6:1 17:1 22:1 36:1 42:1 54:1 66:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 17:1 20:1 37:1 42:1 49:1 64:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 3:1 6:1 18:1 33:1 35:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 103:1 +-1 2:1 9:1 18:1 20:1 37:1 42:1 47:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 16:1 22:1 36:1 42:1 55:1 62:1 67:1 72:1 74:1 76:1 80:1 83:1 ++1 5:1 10:1 17:1 19:1 39:1 44:1 52:1 66:1 67:1 72:1 74:1 76:1 82:1 83:1 +-1 5:1 7:1 14:1 19:1 39:1 44:1 50:1 66:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 5:1 6:1 17:1 19:1 39:1 43:1 55:1 66:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 16:1 20:1 37:1 44:1 52:1 66:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 15:1 20:1 37:1 41:1 55:1 66:1 67:1 72:1 74:1 76:1 79:1 83:1 ++1 4:1 6:1 17:1 20:1 37:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 16:1 27:1 35:1 40:1 48:1 63:1 71:1 73:1 74:1 76:1 80:1 83:1 ++1 5:1 6:1 14:1 29:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 79:1 87:1 +-1 5:1 6:1 16:1 29:1 39:1 40:1 53:1 63:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 5:1 10:1 14:1 20:1 37:1 40:1 59:1 63:1 67:1 73:1 75:1 76:1 81:1 83:1 +-1 1:1 6:1 16:1 22:1 36:1 42:1 53:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 15:1 21:1 35:1 42:1 48:1 64:1 68:1 73:1 74:1 76:1 80:1 90:1 +-1 2:1 6:1 15:1 22:1 36:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 2:1 7:1 15:1 19:1 39:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 4:1 10:1 18:1 20:1 37:1 41:1 59:1 66:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 18:1 22:1 36:1 40:1 57:1 63:1 67:1 73:1 75:1 76:1 81:1 83:1 +-1 1:1 6:1 18:1 31:1 35:1 42:1 53:1 65:1 67:1 73:1 74:1 77:1 81:1 83:1 +-1 3:1 11:1 14:1 29:1 39:1 41:1 55:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 ++1 3:1 6:1 18:1 19:1 39:1 40:1 51:1 63:1 67:1 73:1 75:1 76:1 80:1 83:1 +-1 2:1 6:1 17:1 20:1 37:1 43:1 53:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 17:1 26:1 35:1 42:1 53:1 62:1 67:1 73:1 74:1 76:1 80:1 119:1 ++1 4:1 8:1 17:1 32:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 5:1 7:1 18:1 24:1 38:1 40:1 51:1 61:1 67:1 72:1 75:1 76:1 78:1 83:1 ++1 2:1 10:1 15:1 22:1 36:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 4:1 11:1 17:1 32:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 4:1 6:1 18:1 19:1 39:1 42:1 50:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 6:1 16:1 20:1 37:1 41:1 51:1 64:1 67:1 73:1 74:1 76:1 79:1 83:1 +-1 4:1 11:1 15:1 20:1 37:1 40:1 51:1 63:1 67:1 73:1 74:1 77:1 80:1 83:1 +-1 2:1 6:1 17:1 22:1 36:1 42:1 48:1 64:1 67:1 73:1 74:1 77:1 79:1 83:1 +-1 1:1 6:1 15:1 20:1 37:1 42:1 50:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 1:1 11:1 17:1 19:1 39:1 42:1 47:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 ++1 3:1 6:1 18:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 4:1 10:1 16:1 19:1 39:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 79:1 83:1 +-1 3:1 6:1 15:1 22:1 36:1 42:1 53:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 17:1 22:1 36:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 2:1 6:1 18:1 20:1 37:1 42:1 48:1 66:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 5:1 8:1 14:1 20:1 37:1 40:1 51:1 63:1 67:1 73:1 75:1 76:1 82:1 83:1 ++1 2:1 6:1 16:1 19:1 39:1 40:1 52:1 63:1 67:1 73:1 75:1 76:1 82:1 83:1 +-1 5:1 6:1 17:1 22:1 36:1 40:1 49:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 17:1 22:1 36:1 42:1 53:1 64:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 3:1 11:1 14:1 20:1 37:1 42:1 49:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 14:1 22:1 36:1 42:1 53:1 65:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 15:1 22:1 36:1 42:1 49:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 4:1 6:1 18:1 22:1 36:1 40:1 49:1 63:1 71:1 73:1 74:1 76:1 80:1 83:1 ++1 3:1 6:1 15:1 20:1 37:1 41:1 51:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 18:1 24:1 38:1 42:1 55:1 64:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 4:1 6:1 14:1 22:1 36:1 42:1 49:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 5:1 7:1 17:1 22:1 36:1 40:1 56:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 3:1 6:1 16:1 21:1 35:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 79:1 83:1 +-1 4:1 10:1 15:1 29:1 39:1 41:1 52:1 64:1 69:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 14:1 20:1 37:1 42:1 49:1 64:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 17:1 20:1 37:1 42:1 47:1 66:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 16:1 22:1 36:1 42:1 50:1 64:1 67:1 72:1 74:1 76:1 79:1 83:1 +-1 1:1 6:1 17:1 22:1 36:1 42:1 55:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 2:1 8:1 14:1 19:1 39:1 40:1 50:1 63:1 67:1 73:1 75:1 76:1 82:1 83:1 +-1 4:1 6:1 17:1 20:1 37:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 80:1 86:1 +-1 3:1 7:1 14:1 22:1 36:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 2:1 8:1 16:1 22:1 36:1 41:1 51:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 6:1 18:1 19:1 39:1 41:1 51:1 64:1 67:1 73:1 74:1 77:1 80:1 83:1 +-1 3:1 6:1 17:1 22:1 36:1 41:1 57:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 4:1 10:1 17:1 29:1 39:1 40:1 55:1 63:1 67:1 73:1 74:1 76:1 80:1 99:1 ++1 5:1 9:1 15:1 20:1 37:1 40:1 55:1 63:1 67:1 73:1 75:1 76:1 80:1 83:1 +-1 5:1 10:1 17:1 22:1 36:1 40:1 59:1 63:1 67:1 73:1 75:1 76:1 80:1 83:1 +-1 2:1 6:1 16:1 22:1 36:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 14:1 25:1 38:1 40:1 49:1 63:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 2:1 6:1 17:1 22:1 36:1 42:1 57:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 ++1 3:1 6:1 17:1 22:1 36:1 41:1 52:1 62:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 17:1 20:1 37:1 40:1 53:1 63:1 71:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 18:1 29:1 39:1 42:1 51:1 66:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 2:1 6:1 15:1 29:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 2:1 6:1 18:1 20:1 37:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 4:1 6:1 17:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 18:1 22:1 36:1 42:1 49:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 ++1 1:1 6:1 18:1 20:1 37:1 40:1 55:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 18:1 26:1 35:1 40:1 56:1 63:1 67:1 73:1 74:1 76:1 82:1 103:1 +-1 2:1 7:1 14:1 19:1 39:1 42:1 51:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 3:1 6:1 14:1 19:1 39:1 40:1 52:1 63:1 67:1 73:1 75:1 76:1 82:1 83:1 +-1 1:1 6:1 15:1 22:1 36:1 42:1 48:1 62:1 71:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 18:1 21:1 35:1 42:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 ++1 4:1 9:1 17:1 23:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 82:1 90:1 +-1 1:1 6:1 15:1 20:1 37:1 42:1 48:1 65:1 68:1 72:1 74:1 76:1 80:1 102:1 +-1 1:1 6:1 18:1 21:1 35:1 42:1 49:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 17:1 19:1 39:1 42:1 55:1 62:1 67:1 72:1 74:1 76:1 79:1 83:1 +-1 2:1 6:1 17:1 22:1 36:1 40:1 55:1 63:1 67:1 73:1 74:1 76:1 79:1 83:1 +-1 1:1 7:1 14:1 20:1 37:1 42:1 47:1 64:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 2:1 6:1 17:1 21:1 35:1 40:1 53:1 63:1 67:1 73:1 75:1 76:1 80:1 83:1 +-1 1:1 17:1 21:1 35:1 42:1 62:1 71:1 73:1 74:1 76:1 78:1 83:1 +-1 5:1 8:1 15:1 22:1 36:1 42:1 50:1 65:1 67:1 73:1 74:1 76:1 80:1 ++1 5:1 11:1 15:1 22:1 36:1 40:1 51:1 63:1 67:1 73:1 74:1 77:1 80:1 83:1 +-1 4:1 6:1 18:1 27:1 35:1 41:1 50:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 18:1 20:1 37:1 40:1 61:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 2:1 6:1 18:1 31:1 35:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 14:1 21:1 35:1 42:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 ++1 5:1 6:1 16:1 22:1 36:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 1:1 6:1 15:1 22:1 36:1 42:1 53:1 62:1 71:1 73:1 74:1 76:1 78:1 83:1 +-1 3:1 7:1 14:1 19:1 39:1 42:1 49:1 64:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 3:1 18:1 25:1 38:1 42:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 ++1 5:1 6:1 15:1 31:1 35:1 40:1 48:1 63:1 67:1 73:1 75:1 76:1 80:1 83:1 +-1 3:1 6:1 16:1 22:1 36:1 42:1 53:1 64:1 71:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 16:1 29:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 3:1 10:1 14:1 19:1 39:1 40:1 52:1 61:1 67:1 72:1 74:1 76:1 81:1 83:1 +-1 5:1 6:1 17:1 29:1 39:1 41:1 52:1 64:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 3:1 6:1 17:1 22:1 36:1 41:1 48:1 66:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 4:1 6:1 14:1 19:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 6:1 14:1 22:1 36:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 18:1 19:1 39:1 42:1 55:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 11:1 15:1 24:1 38:1 42:1 52:1 64:1 67:1 73:1 74:1 76:1 78:1 83:1 ++1 3:1 6:1 17:1 19:1 39:1 40:1 55:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 5:1 6:1 16:1 25:1 38:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 14:1 25:1 38:1 42:1 48:1 64:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 4:1 7:1 14:1 22:1 36:1 41:1 51:1 66:1 67:1 72:1 74:1 76:1 82:1 83:1 +-1 3:1 6:1 15:1 20:1 37:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 5:1 7:1 14:1 20:1 37:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 4:1 8:1 15:1 19:1 39:1 41:1 51:1 64:1 67:1 72:1 74:1 76:1 82:1 83:1 +-1 1:1 8:1 16:1 22:1 36:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 82:1 ++1 4:1 8:1 16:1 19:1 39:1 40:1 51:1 63:1 67:1 73:1 75:1 76:1 82:1 83:1 +-1 2:1 6:1 18:1 19:1 39:1 42:1 52:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 16:1 20:1 37:1 42:1 56:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 18:1 24:1 38:1 42:1 52:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 4:1 6:1 18:1 22:1 36:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 3:1 6:1 18:1 22:1 36:1 40:1 51:1 61:1 67:1 72:1 75:1 76:1 80:1 83:1 +-1 2:1 11:1 18:1 19:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 1:1 17:1 21:1 35:1 42:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 ++1 3:1 6:1 15:1 22:1 36:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 81:1 109:1 +-1 3:1 6:1 15:1 20:1 37:1 43:1 49:1 66:1 71:1 72:1 74:1 76:1 78:1 83:1 +-1 3:1 6:1 18:1 20:1 37:1 41:1 48:1 64:1 67:1 72:1 74:1 76:1 79:1 83:1 ++1 5:1 7:1 14:1 19:1 39:1 41:1 56:1 64:1 67:1 73:1 75:1 76:1 82:1 83:1 +-1 4:1 6:1 16:1 27:1 35:1 40:1 49:1 63:1 67:1 73:1 74:1 76:1 80:1 +-1 3:1 6:1 16:1 19:1 39:1 42:1 50:1 64:1 67:1 72:1 74:1 77:1 80:1 83:1 +-1 4:1 6:1 15:1 20:1 37:1 41:1 55:1 66:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 16:1 29:1 39:1 42:1 52:1 64:1 68:1 73:1 74:1 76:1 78:1 90:1 +-1 5:1 6:1 15:1 22:1 36:1 43:1 57:1 64:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 5:1 11:1 17:1 19:1 39:1 41:1 55:1 64:1 71:1 72:1 74:1 76:1 79:1 83:1 +-1 5:1 7:1 14:1 22:1 36:1 40:1 56:1 63:1 67:1 73:1 75:1 76:1 80:1 83:1 ++1 5:1 6:1 16:1 22:1 36:1 40:1 53:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 4:1 6:1 15:1 19:1 39:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 17:1 22:1 36:1 42:1 55:1 64:1 67:1 72:1 74:1 76:1 82:1 83:1 ++1 4:1 10:1 15:1 20:1 37:1 40:1 59:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 15:1 20:1 37:1 40:1 49:1 61:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 8:1 14:1 19:1 39:1 42:1 50:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 6:1 16:1 22:1 36:1 41:1 53:1 65:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 7:1 15:1 24:1 38:1 40:1 48:1 63:1 67:1 73:1 74:1 77:1 82:1 83:1 +-1 2:1 6:1 16:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 81:1 83:1 ++1 4:1 6:1 18:1 20:1 37:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 5:1 7:1 18:1 19:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 1:1 6:1 18:1 24:1 38:1 42:1 55:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 10:1 15:1 24:1 38:1 42:1 55:1 62:1 71:1 72:1 74:1 76:1 79:1 83:1 +-1 3:1 6:1 16:1 19:1 39:1 40:1 52:1 63:1 71:1 73:1 74:1 76:1 82:1 +-1 3:1 7:1 15:1 22:1 36:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 ++1 4:1 6:1 18:1 29:1 39:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 4:1 11:1 14:1 19:1 39:1 41:1 55:1 66:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 15:1 22:1 36:1 40:1 49:1 61:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 2:1 18:1 22:1 36:1 41:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 14:1 20:1 37:1 41:1 53:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 4:1 6:1 17:1 22:1 36:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 3:1 6:1 16:1 19:1 39:1 44:1 52:1 66:1 67:1 72:1 74:1 76:1 81:1 83:1 +-1 3:1 6:1 16:1 22:1 36:1 41:1 57:1 66:1 67:1 73:1 74:1 76:1 81:1 83:1 ++1 3:1 11:1 16:1 19:1 39:1 40:1 59:1 63:1 67:1 73:1 75:1 76:1 82:1 83:1 ++1 2:1 6:1 15:1 19:1 39:1 42:1 51:1 64:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 16:1 22:1 36:1 41:1 48:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 7:1 17:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 5:1 18:1 22:1 36:1 40:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 15:1 20:1 37:1 42:1 55:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 5:1 6:1 17:1 20:1 37:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 16:1 22:1 36:1 41:1 49:1 64:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 5:1 8:1 17:1 20:1 37:1 44:1 50:1 64:1 67:1 72:1 74:1 76:1 82:1 83:1 ++1 3:1 6:1 16:1 19:1 39:1 40:1 51:1 63:1 67:1 73:1 75:1 76:1 82:1 83:1 +-1 5:1 7:1 14:1 24:1 38:1 41:1 47:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 4:1 8:1 15:1 29:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 1:1 6:1 17:1 22:1 36:1 42:1 56:1 62:1 67:1 73:1 74:1 76:1 81:1 83:1 +-1 2:1 6:1 15:1 26:1 35:1 40:1 56:1 63:1 71:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 14:1 21:1 35:1 42:1 55:1 65:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 17:1 22:1 36:1 40:1 57:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 16:1 27:1 35:1 40:1 47:1 63:1 67:1 73:1 74:1 76:1 80:1 103:1 +-1 1:1 6:1 17:1 19:1 39:1 42:1 55:1 64:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 2:1 8:1 17:1 19:1 39:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 82:1 87:1 ++1 4:1 9:1 18:1 20:1 37:1 42:1 55:1 64:1 67:1 73:1 75:1 76:1 82:1 83:1 +-1 1:1 6:1 18:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 6:1 18:1 25:1 38:1 42:1 50:1 64:1 71:1 72:1 74:1 76:1 78:1 83:1 +-1 3:1 11:1 15:1 19:1 39:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 10:1 16:1 19:1 39:1 41:1 52:1 66:1 71:1 72:1 74:1 76:1 78:1 83:1 +-1 4:1 10:1 16:1 22:1 36:1 40:1 48:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 ++1 4:1 8:1 15:1 20:1 37:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 4:1 6:1 15:1 22:1 36:1 41:1 54:1 66:1 67:1 73:1 74:1 76:1 79:1 83:1 ++1 4:1 6:1 18:1 22:1 36:1 40:1 49:1 63:1 67:1 73:1 74:1 77:1 80:1 83:1 +-1 2:1 6:1 16:1 22:1 36:1 40:1 54:1 62:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 5:1 6:1 16:1 22:1 36:1 40:1 57:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 ++1 5:1 10:1 14:1 32:1 39:1 40:1 51:1 63:1 67:1 73:1 74:1 76:1 82:1 83:1 +-1 5:1 6:1 14:1 19:1 39:1 40:1 47:1 63:1 67:1 73:1 74:1 76:1 80:1 83:1 +-1 1:1 15:1 21:1 35:1 42:1 62:1 67:1 72:1 74:1 76:1 78:1 83:1 +-1 4:1 7:1 17:1 25:1 38:1 40:1 52:1 63:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 5:1 6:1 18:1 26:1 35:1 40:1 49:1 63:1 71:1 73:1 74:1 76:1 81:1 83:1 +-1 4:1 6:1 17:1 33:1 35:1 40:1 54:1 63:1 67:1 73:1 74:1 76:1 80:1 +-1 1:1 6:1 17:1 20:1 37:1 42:1 50:1 64:1 67:1 72:1 74:1 76:1 82:1 83:1 ++1 4:1 8:1 14:1 29:1 39:1 40:1 50:1 63:1 67:1 73:1 74:1 76:1 82:1 +-1 5:1 11:1 17:1 27:1 35:1 40:1 49:1 61:1 71:1 72:1 74:1 76:1 80:1 83:1 +-1 2:1 6:1 15:1 22:1 36:1 40:1 54:1 61:1 67:1 72:1 74:1 76:1 80:1 83:1 +-1 3:1 6:1 14:1 22:1 36:1 41:1 55:1 66:1 71:1 72:1 74:1 76:1 80:1 83:1 +-1 4:1 7:1 17:1 22:1 36:1 41:1 50:1 62:1 67:1 73:1 74:1 76:1 82:1 +-1 1:1 6:1 18:1 21:1 35:1 42:1 52:1 62:1 67:1 73:1 74:1 76:1 78:1 83:1 +-1 1:1 6:1 18:1 22:1 36:1 42:1 48:1 65:1 71:1 73:1 74:1 76:1 80:1 83:1 +-1 4:1 10:1 15:1 24:1 38:1 41:1 52:1 66:1 67:1 72:1 74:1 76:1 82:1 83:1 diff --git a/samples/programs/svm2lp/svm2lp.hs b/samples/programs/svm2lp/svm2lp.hs new file mode 100644 --- /dev/null +++ b/samples/programs/svm2lp/svm2lp.hs @@ -0,0 +1,170 @@ +{-# OPTIONS_GHC -Wall #-} +import Control.Monad +import qualified Data.Foldable as F +import Data.Char +import Data.Default.Class +import Data.List.Split +import Data.Maybe +import Data.IntMap (IntMap) +import qualified Data.IntMap as IntMap +import qualified Data.Map as Map +import ToySolver.Data.MIP ((.==.), (.>=.)) +import qualified ToySolver.Data.MIP as MIP +import System.Console.GetOpt +import System.Environment +import System.Exit +import System.IO + +type Problem = [(Int, IntMap Double)] + +-- http://ntucsu.csie.ntu.edu.tw/~cjlin/libsvmtools/datasets/ +loadFile :: FilePath -> IO Problem +loadFile fname = do + s <- readFile fname + return $ map f (lines s) + where + f :: String -> (Int, IntMap Double) + f s = + case words s of + (y : xs) -> (read (dropWhile ('+'==) y), IntMap.fromList [(read v, read val) | x <- xs, let [v,val] = splitOn ":" x]) + +primal :: Maybe Double -> Problem -> MIP.Problem +primal c prob + = def + { MIP.objectiveFunction = def + { MIP.objDir = MIP.OptMin + , MIP.objExpr = + sum [MIP.constExpr (1/2) * wj * wj | wj <- fmap MIP.varExpr $ IntMap.elems w] + + sum [MIP.constExpr (realToFrac (fromJust c)) * xi_i | isJust c, xi_i <- fmap MIP.varExpr xi] + } + , MIP.constraints = + [ MIP.constExpr (fromIntegral y_i) * (IntMap.map MIP.varExpr w `dot` IntMap.map (MIP.constExpr . realToFrac) xs_i - MIP.varExpr b) + .>=. 1 - (if isJust c then MIP.varExpr xi_i else 0) + | ((y_i, xs_i), xi_i) <- zip prob xi + ] + , MIP.varType = Map.fromList [(x, MIP.ContinuousVariable) | x <- b : [w_j | w_j <- IntMap.elems w] ++ [xi_i | isJust c, xi_i <- xi]] + , MIP.varBounds = + Map.unions + [ Map.singleton b (MIP.NegInf, MIP.PosInf) + , Map.fromList [(w_j, (MIP.NegInf, MIP.PosInf)) | w_j <- IntMap.elems w] + , Map.fromList [(xi_i, (0, MIP.PosInf)) | isJust c, xi_i <- xi] + ] + } + where + m = length prob + n = fst $ IntMap.findMax $ IntMap.unions (map snd prob) + w = IntMap.fromList [(j, MIP.toVar ("w_" ++ show j)) | j <- [1..n]] + b = MIP.toVar "b" + xi = [MIP.toVar ("xi_" ++ show i) | i <- [1..m]] + +dual + :: Maybe Double + -> (IntMap Double -> IntMap Double -> Double) + -> Problem + -> MIP.Problem +dual c kernel prob + = def + { MIP.objectiveFunction = def + { MIP.objDir = MIP.OptMax + , MIP.objExpr = MIP.Expr $ + [MIP.Term 1 [a_i] | a_i <- a] ++ + [ MIP.Term (- (1/2) * fromIntegral (y_i * y_j) * realToFrac (kernel xs_i xs_j)) [a_i, a_j] + | ((y_i, xs_i), a_i) <- zip prob a + , ((y_j, xs_j), a_j) <- zip prob a + ] + } + , MIP.constraints = + [ MIP.Expr [ MIP.Term (fromIntegral y_i) [a_i] | ((y_i, _xs_i), a_i) <- zip prob a ] .==. 0 ] + , MIP.varType = Map.fromList [(a_i, MIP.ContinuousVariable) | a_i <- a] + , MIP.varBounds = Map.fromList [(a_i, (0, if isJust c then MIP.Finite (realToFrac (fromJust c)) else MIP.PosInf)) | a_i <- a] + } + where + m = length prob + a = [MIP.toVar ("a_" ++ show i) | i <- [1..m]] + +dot :: Num a => IntMap a -> IntMap a -> a +dot a b = sum $ IntMap.elems $ IntMap.intersectionWith (*) a b + +gaussian :: Double -> IntMap Double -> IntMap Double -> Double +gaussian sigma a b + = exp (- F.sum (IntMap.map (**2) (IntMap.unionWith (+) a (IntMap.map negate b))) / (2 * sigma**2)) + +data Options + = Options + { optHelp :: Bool + , optDual :: Bool + , optKernel :: String + , optC :: Maybe Double + , optGamma :: Maybe Double + } + +defaultOptions :: Options +defaultOptions = + Options + { optHelp = False + , optDual = False + , optKernel = "linear" + , optC = Nothing + , optGamma = Nothing + } + +options :: [OptDescr (Options -> Options)] +options = + [ Option ['h'] ["help"] (NoArg (\opt -> opt{ optHelp = True })) "show help" + , Option [] ["primal"] + (NoArg (\opt -> opt{ optDual = False })) + "Use primal form." + , Option [] ["dual"] + (NoArg (\opt -> opt{ optDual = True } )) + "Use dual form." + , Option [] ["kernel"] + (ReqArg (\val opt -> opt{ optKernel = val }) "") + "Kernel: linear (default), gaussian" + , Option ['c'] [] + (ReqArg (\val opt -> opt{ optC = Just $! read val }) "") + "C parameter" + , Option [] ["gamma"] + (ReqArg (\val opt -> opt{ optGamma = Just $! read val }) "") + "gamma parameter used for gaussian kernel" + ] + +showHelp :: Handle -> IO () +showHelp h = hPutStrLn h (usageInfo header options) + where + header = "Usage: svm2lp [OPTIONS] FILE" + +main :: IO () +main = do + args <- getArgs + case getOpt Permute options args of + (_,_,errs@(_:_)) -> do + mapM_ putStrLn errs + exitFailure + (o,args2,[]) -> do + let opt = foldl (flip id) defaultOptions o + when (optHelp opt) $ do + showHelp stdout + exitSuccess + case args2 of + [] -> do + showHelp stderr + exitFailure + fname : _ -> do + svm <- loadFile fname + let mip = + case map toLower (optKernel opt) of + "linear" -> do + if optDual opt + then dual (optC opt) dot svm + else primal (optC opt) svm + "gaussian" -> do + case optGamma opt of + Nothing -> error "--gamma= must be specified" + Just gamma -> dual (optC opt) (gaussian gamma) svm + _ -> error $ "unknown kernel: " ++ optKernel opt + case MIP.toLPString mip of + Left err -> do + hPutStrLn stderr err + exitFailure + Right s -> do + putStr s diff --git a/samples/smt/QF_UFLRA.smt2 b/samples/smt/QF_UFLRA.smt2 new file mode 100644 --- /dev/null +++ b/samples/smt/QF_UFLRA.smt2 @@ -0,0 +1,14 @@ +(set-option :produce-models) +(set-logic QF_UFLRA) +(declare-sort U 0) +(declare-fun x () Real) +(declare-fun f (U) Real) +(declare-fun P (U) Bool) +(declare-fun g (U) U) +(declare-fun c () U) +(declare-fun d () U) +(assert (= (P c) (= (g c) c))) +(assert (ite (P c) (> x (f d)) (< x (f d)))) +(check-sat) +(get-model) +(exit) diff --git a/samples/smt/assertion-stack-levels-2.smt2 b/samples/smt/assertion-stack-levels-2.smt2 new file mode 100644 --- /dev/null +++ b/samples/smt/assertion-stack-levels-2.smt2 @@ -0,0 +1,14 @@ +(set-logic QF_UF) +(declare-fun a () Bool) +(declare-fun b () Bool) +(assert (or a b)) + +(get-info :assertion-stack-levels) + +; NOTE: omitting arguments of push/pop is not allowed in SMT-LIB2 +; but many solver implement the omission. +(push) +(get-info :assertion-stack-levels) +(pop) + +(get-info :assertion-stack-levels) diff --git a/samples/smt/assertion-stack-levels.smt2 b/samples/smt/assertion-stack-levels.smt2 new file mode 100644 --- /dev/null +++ b/samples/smt/assertion-stack-levels.smt2 @@ -0,0 +1,12 @@ +(set-logic QF_UF) +(declare-fun a () Bool) +(declare-fun b () Bool) +(assert (or a b)) + +(get-info :assertion-stack-levels) + +(push 1) +(get-info :assertion-stack-levels) +(pop 1) + +(get-info :assertion-stack-levels) diff --git a/samples/smt/assumptions.smt2 b/samples/smt/assumptions.smt2 new file mode 100644 --- /dev/null +++ b/samples/smt/assumptions.smt2 @@ -0,0 +1,8 @@ +(set-option :produce-unsat-assumptions true) +(get-option :produce-unsat-assumptions) +(set-logic QF_UF) +(declare-fun a () Bool) +(declare-fun b () Bool) +(assert (or a b)) +(check-sat-assuming ((not a) (not b))) +(get-unsat-assumptions) diff --git a/samples/smt/declare-const.smt2 b/samples/smt/declare-const.smt2 new file mode 100644 --- /dev/null +++ b/samples/smt/declare-const.smt2 @@ -0,0 +1,5 @@ +(set-logic QF_LRA) +(declare-const b Bool) +(declare-const x Real) +(declare-const y Real) +(check-sat) diff --git a/samples/smt/define-fun-rec.smt2 b/samples/smt/define-fun-rec.smt2 new file mode 100644 --- /dev/null +++ b/samples/smt/define-fun-rec.smt2 @@ -0,0 +1,6 @@ +(set-logic QF_UFLIA) +(define-fun-rec fact ((n Int)) Int + (ite (<= n 0) + 1 + (* n (fact (- n 1))))) +(check-sat) diff --git a/samples/smt/define-funs-rec.smt2 b/samples/smt/define-funs-rec.smt2 new file mode 100644 --- /dev/null +++ b/samples/smt/define-funs-rec.smt2 @@ -0,0 +1,7 @@ +(set-logic QF_UFLIA) +(define-funs-rec + ((even ((x Int)) Bool) + (odd ((x Int)) Bool)) + ((ite (= x 0) true (odd (- x 1))) + (ite (= x 0) true (odd (- x 1))))) +(check-sat) diff --git a/samples/smt/division-by-zero.smt2 b/samples/smt/division-by-zero.smt2 new file mode 100644 --- /dev/null +++ b/samples/smt/division-by-zero.smt2 @@ -0,0 +1,16 @@ +(set-option :produce-models true) +(set-logic QF_LRA) +(declare-const x1 Real) +(declare-const x2 Real) + +(define-fun y1 () Real (/ x1 0)) +(define-fun y2 () Real (/ x2 0)) +(check-sat) ; sat +(get-value (x1 x2 y1 y2)) + +(assert (not (= y1 y2))) +(check-sat) ; sat +(get-value (x1 x2 y1 y2)) + +(assert (= x1 x2)) +(check-sat) ; unsat diff --git a/samples/smt/echo.smt2 b/samples/smt/echo.smt2 new file mode 100644 --- /dev/null +++ b/samples/smt/echo.smt2 @@ -0,0 +1,8 @@ +(set-logic QF_LRA) +(declare-const b Bool) +(echo "foo") +(declare-const x Real) +(echo "bar") +(declare-const y Real) +(echo "baz") +(check-sat) diff --git a/samples/smt/get-assertions.smt2 b/samples/smt/get-assertions.smt2 new file mode 100644 --- /dev/null +++ b/samples/smt/get-assertions.smt2 @@ -0,0 +1,13 @@ +(set-option :produce-assertions true) +; (set-option :interactive-mode true) +(get-option :produce-assertions) +(set-logic QF_UF) +(declare-fun a () Bool) +(declare-fun b () Bool) +(assert (or (! a :named aa) (! b :named bb))) +(get-assertions) +(push) + (assert (not (and a bb))) + (get-assertions) +(pop) +(get-assertions) diff --git a/samples/smt/get-assignment.smt2 b/samples/smt/get-assignment.smt2 new file mode 100644 --- /dev/null +++ b/samples/smt/get-assignment.smt2 @@ -0,0 +1,9 @@ +(set-option :produce-assignments true) +(get-option :produce-assignments) +(set-logic QF_UF) +(declare-fun a () Bool) +(declare-fun b () Bool) +(assert (or (! a :named aa) (! b :named bb))) +(assert (not (and a bb))) +(check-sat) +(get-assignment) diff --git a/samples/smt/get-model.smt2 b/samples/smt/get-model.smt2 new file mode 100644 --- /dev/null +++ b/samples/smt/get-model.smt2 @@ -0,0 +1,9 @@ +(set-option :produce-models true) +(get-option :produce-models) +(set-logic QF_UF) +(declare-fun a () Bool) +(declare-fun b () Bool) +(assert (or a b)) +(assert (not (and a b))) +(check-sat) +(get-model) diff --git a/samples/smt/get-value.smt2 b/samples/smt/get-value.smt2 new file mode 100644 --- /dev/null +++ b/samples/smt/get-value.smt2 @@ -0,0 +1,12 @@ +(set-option :produce-models true) +(get-option :produce-models) +(set-logic QF_UF) +(set-info :status sat) +(declare-sort U 0) +(declare-fun f (U) U) +(declare-fun g (U) U) +(declare-fun A () Bool) +(declare-fun x () U) +(declare-fun y () U) +(check-sat) +(get-value (x A (f x) (g y))) diff --git a/samples/smt/global-declarations.smt2 b/samples/smt/global-declarations.smt2 new file mode 100644 --- /dev/null +++ b/samples/smt/global-declarations.smt2 @@ -0,0 +1,22 @@ +(get-option :global-declarations) + +(set-option :global-declarations false) +(get-option :global-declarations) +(set-logic QF_UFLRA) + +(push) +(declare-const x1 Bool) +(pop) +(declare-const x1 Real) + +(reset) + +(set-option :global-declarations true) +(get-option :global-declarations) +(set-logic QF_UFLRA) + +(push) +(define-fun x2 () Real 1.0) +(pop) +(assert (= x2 1.0)) +(check-sat) diff --git a/samples/smt/print-success.smt2 b/samples/smt/print-success.smt2 new file mode 100644 --- /dev/null +++ b/samples/smt/print-success.smt2 @@ -0,0 +1,8 @@ +(set-logic QF_UF) +(get-option :print-success) +(declare-fun a () Bool) +(set-option :print-success false) +(get-option :print-success) +(declare-fun b () Bool) +(assert (or a b)) +(check-sat) diff --git a/samples/smt/quoted-symbol.smt2 b/samples/smt/quoted-symbol.smt2 new file mode 100644 --- /dev/null +++ b/samples/smt/quoted-symbol.smt2 @@ -0,0 +1,6 @@ +(set-logic QF_LRA) +(set-info :status unsat) +(declare-fun abc () Real) +(assert (= abc 0)) +(assert (= |abc| 1)) +(check-sat) diff --git a/samples/smt/reset-assertions.smt2 b/samples/smt/reset-assertions.smt2 new file mode 100644 --- /dev/null +++ b/samples/smt/reset-assertions.smt2 @@ -0,0 +1,14 @@ +(set-option :produce-unsat-assumptions true) +(set-logic QF_UF) +(declare-fun x1 () Bool) +(declare-fun x2 () Bool) +(declare-fun x3 () Bool) +(assert (! x1 :named C1)) +(assert (! (not x1) :named C2)) +(assert (! (or (not x1) x2) :named C3)) +(assert (! (not x2) :named C4)) +(assert (! (or (not x1) x3) :named C5)) +(assert (! (not x3) :named C6)) +(check-sat) +(reset-assertions) +(check-sat) diff --git a/samples/smt/reset.smt2 b/samples/smt/reset.smt2 new file mode 100644 --- /dev/null +++ b/samples/smt/reset.smt2 @@ -0,0 +1,14 @@ +(set-option :produce-unsat-assumptions true) +(set-logic QF_UF) +(declare-fun x1 () Bool) +(declare-fun x2 () Bool) +(declare-fun x3 () Bool) +(assert (! x1 :named C1)) +(assert (! (not x1) :named C2)) +(assert (! (or (not x1) x2) :named C3)) +(assert (! (not x2) :named C4)) +(assert (! (or (not x1) x3) :named C5)) +(assert (! (not x3) :named C6)) +(check-sat) +(reset) +(check-sat) diff --git a/samples/smt/set-info-status.smt2 b/samples/smt/set-info-status.smt2 new file mode 100644 --- /dev/null +++ b/samples/smt/set-info-status.smt2 @@ -0,0 +1,15 @@ +(set-option :produce-models true) +(set-logic QF_UFLRA) +(declare-sort U 0) +(declare-fun x () Real) +(declare-fun f (U) Real) +(declare-fun P (U) Bool) +(declare-fun g (U) U) +(declare-fun c () U) +(declare-fun d () U) +(assert (= (P c) (= (g c) c))) +(assert (ite (P c) (> x (f d)) (< x (f d)))) +(set-info :status sat) +(check-sat) +(get-model) +(exit) diff --git a/samples/smt/unicode-symbol.smt2 b/samples/smt/unicode-symbol.smt2 new file mode 100644 --- /dev/null +++ b/samples/smt/unicode-symbol.smt2 @@ -0,0 +1,4 @@ +(set-logic QF_LRA) +(declare-fun あいうえお () Real) +(declare-fun café () Real) +(check-sat) diff --git a/samples/smt/unsat-core.smt2 b/samples/smt/unsat-core.smt2 new file mode 100644 --- /dev/null +++ b/samples/smt/unsat-core.smt2 @@ -0,0 +1,18 @@ +; http://sun.iwu.edu/~mliffito/publications/jar_liffiton_CAMUS.pdf +; φ= (x1) ∧ (¬x1) ∧ (¬x1∨x2) ∧ (¬x2) ∧ (¬x1∨x3) ∧ (¬x3) +; MUSes(φ) = {{C1, C2}, {C1, C3, C4}, {C1, C5, C6}} +; MCSes(φ) = {{C1}, {C2, C3, C5}, {C2, C3, C6}, {C2, C4, C5}, {C2, C4, C6}} +(set-option :produce-unsat-cores true) +(get-option :produce-unsat-cores) +(set-logic QF_UF) +(declare-fun x1 () Bool) +(declare-fun x2 () Bool) +(declare-fun x3 () Bool) +(assert (! x1 :named C1)) +(assert (! (not x1) :named C2)) +(assert (! (or (not x1) x2) :named C3)) +(assert (! (not x2) :named C4)) +(assert (! (or (not x1) x3) :named C5)) +(assert (! (not x3) :named C6)) +(check-sat) +(get-unsat-core) diff --git a/src/ToySolver/Arith/BoundsInference.hs b/src/ToySolver/Arith/BoundsInference.hs --- a/src/ToySolver/Arith/BoundsInference.hs +++ b/src/ToySolver/Arith/BoundsInference.hs @@ -24,7 +24,7 @@ import Data.VectorSpace import Data.Interval -import ToySolver.Data.ArithRel +import ToySolver.Data.OrdRel import ToySolver.Data.LA (BoundsEnv) import qualified ToySolver.Data.LA as LA import ToySolver.Data.Var @@ -43,7 +43,7 @@ where cs :: VarMap [C r] cs = IM.fromListWith (++) $ do - ArithRel lhs op rhs <- constraints + OrdRel lhs op rhs <- constraints let m = LA.coeffMap (lhs ^-^ rhs) (v,c) <- IM.toList m guard $ v /= LA.unitVar diff --git a/src/ToySolver/Arith/CAD.hs b/src/ToySolver/Arith/CAD.hs --- a/src/ToySolver/Arith/CAD.hs +++ b/src/ToySolver/Arith/CAD.hs @@ -63,7 +63,7 @@ import Data.Sign (Sign (..)) import qualified Data.Sign as Sign -import ToySolver.Data.ArithRel +import ToySolver.Data.OrdRel import ToySolver.Data.AlgebraicNumber.Real (AReal) import qualified ToySolver.Data.AlgebraicNumber.Real as AReal import ToySolver.Data.DNF @@ -448,20 +448,20 @@ project :: (Ord v, Show v, PrettyVar v) => v - -> [ArithRel (Polynomial Rational v)] - -> [([ArithRel (Polynomial Rational v)], Model v -> Model v)] + -> [OrdRel (Polynomial Rational v)] + -> [([OrdRel (Polynomial Rational v)], Model v -> Model v)] project v cs = projectN (Set.singleton v) cs projectN :: (Ord v, Show v, PrettyVar v) => Set v - -> [ArithRel (Polynomial Rational v)] - -> [([ArithRel (Polynomial Rational v)], Model v -> Model v)] + -> [OrdRel (Polynomial Rational v)] + -> [([OrdRel (Polynomial Rational v)], Model v -> Model v)] projectN vs cs = do (cs', mt) <- projectN' vs (map f cs) return (map g cs', mt) where - f (ArithRel lhs op rhs) = (lhs - rhs, h op) + f (OrdRel lhs op rhs) = (lhs - rhs, h op) where h Le = [Zero, Neg] h Ge = [Zero, Pos] @@ -469,7 +469,7 @@ h Gt = [Pos] h Eql = [Zero] h NEq = [Pos,Neg] - g (p,ss) = (ArithRel p op 0) + g (p,ss) = (OrdRel p op 0) where ss' = Set.fromList ss op @@ -502,11 +502,11 @@ solve :: forall v. (Ord v, Show v, PrettyVar v) => Set v - -> [(ArithRel (Polynomial Rational v))] + -> [(OrdRel (Polynomial Rational v))] -> Maybe (Model v) solve vs cs0 = solve' vs (map f cs0) where - f (ArithRel lhs op rhs) = (lhs - rhs, g op) + f (OrdRel lhs op rhs) = (lhs - rhs, g op) g Le = [Zero, Neg] g Ge = [Zero, Pos] g Lt = [Neg] diff --git a/src/ToySolver/Arith/ContiTraverso.hs b/src/ToySolver/Arith/ContiTraverso.hs --- a/src/ToySolver/Arith/ContiTraverso.hs +++ b/src/ToySolver/Arith/ContiTraverso.hs @@ -41,7 +41,7 @@ import Data.OptDir -import ToySolver.Data.ArithRel +import ToySolver.Data.OrdRel import qualified ToySolver.Data.LA as LA import ToySolver.Data.Polynomial (Polynomial, UPolynomial, Monomial, MonomialOrder) import qualified ToySolver.Data.Polynomial as P @@ -82,9 +82,6 @@ vs2 :: [Var] vs2 = [v2 .. v2 + length cs - 1] - - vs2' :: IS.IntSet - vs2' = IS.fromList vs2 t :: Var t = v2 + length cs diff --git a/src/ToySolver/Arith/Cooper/Base.hs b/src/ToySolver/Arith/Cooper/Base.hs --- a/src/ToySolver/Arith/Cooper/Base.hs +++ b/src/ToySolver/Arith/Cooper/Base.hs @@ -59,7 +59,7 @@ import qualified Data.Set as Set import Data.VectorSpace hiding (project) -import ToySolver.Data.ArithRel +import ToySolver.Data.OrdRel import ToySolver.Data.Boolean import ToySolver.Data.BoolExpr (BoolExpr (..)) import qualified ToySolver.Data.BoolExpr as BoolExpr @@ -73,7 +73,7 @@ type ExprZ = LA.Expr Integer fromLAAtom :: LA.Atom Rational -> QFFormula -fromLAAtom (ArithRel a op b) = arithRel op a' b' +fromLAAtom (OrdRel a op b) = ordRel op a' b' where (e1,c1) = toRat a (e2,c2) = toRat b @@ -119,15 +119,19 @@ -- | Quantifier-free formula of Presburger arithmetic. type QFFormula = BoolExpr Lit -instance IsArithRel (LA.Expr Integer) QFFormula where - arithRel op lhs rhs = +instance IsEqRel (LA.Expr Integer) QFFormula where + a .==. b = eqZ a b + a ./=. b = notB $ eqZ a b + +instance IsOrdRel (LA.Expr Integer) QFFormula where + ordRel op lhs rhs = case op of Le -> Atom $ leZ lhs rhs Ge -> Atom $ geZ lhs rhs Lt -> Atom $ ltZ lhs rhs Gt -> Atom $ gtZ lhs rhs - Eql -> eqZ lhs rhs - NEq -> notB $ arithRel Eql lhs rhs + Eql -> lhs .==. rhs + NEq -> lhs ./=. rhs -- | @d | e@ means @e@ can be divided by @d@. (.|.) :: Integer -> ExprZ -> QFFormula @@ -251,6 +255,7 @@ pos (Not x) = neg x pos (Imply x y) = neg x .||. pos y pos (Equiv x y) = pos ((x .=>. y) .&&. (y .=>. x)) + pos (ITE c t e) = pos ((c .=>. t) .&&. (Not c .=>. e)) neg (Atom a) = Atom (notB a) neg (And xs) = Or (map neg xs) @@ -258,6 +263,7 @@ neg (Not x) = pos x neg (Imply x y) = pos x .&&. neg y neg (Equiv x y) = neg ((x .=>. y) .&&. (y .=>. x)) + neg (ITE c t e) = neg ((c .=>. t) .&&. (Not c .=>. e)) -- xの係数の最小公倍数 c :: Integer diff --git a/src/ToySolver/Arith/Cooper/FOL.hs b/src/ToySolver/Arith/Cooper/FOL.hs --- a/src/ToySolver/Arith/Cooper/FOL.hs +++ b/src/ToySolver/Arith/Cooper/FOL.hs @@ -17,7 +17,7 @@ import Control.Monad -import ToySolver.Data.ArithRel +import ToySolver.Data.OrdRel import ToySolver.Data.Boolean import qualified ToySolver.Data.FOL.Arith as FOL import qualified ToySolver.Data.LA.FOL as LAFOL @@ -39,10 +39,10 @@ where f FOL.T = return true f FOL.F = return false - f (FOL.Atom (ArithRel a op b)) = do + f (FOL.Atom (OrdRel a op b)) = do a' <- LAFOL.fromFOLExpr a b' <- LAFOL.fromFOLExpr b - return $ fromLAAtom (ArithRel a' op b') + return $ fromLAAtom (OrdRel a' op b') f (FOL.And a b) = liftM2 (.&&.) (f a) (f b) f (FOL.Or a b) = liftM2 (.||.) (f a) (f b) f (FOL.Not a) = liftM notB (f a) diff --git a/src/ToySolver/Arith/FourierMotzkin/Base.hs b/src/ToySolver/Arith/FourierMotzkin/Base.hs --- a/src/ToySolver/Arith/FourierMotzkin/Base.hs +++ b/src/ToySolver/Arith/FourierMotzkin/Base.hs @@ -58,7 +58,7 @@ import qualified Data.Interval as Interval import Data.Interval (Interval, Extended (..), (<=..<), (<..<=), (<..<)) -import ToySolver.Data.ArithRel +import ToySolver.Data.OrdRel import ToySolver.Data.Boolean import ToySolver.Data.DNF import qualified ToySolver.Data.LA as LA @@ -149,7 +149,7 @@ -- --------------------------------------------------------------------------- fromLAAtom :: LA.Atom Rational -> DNF Constr -fromLAAtom (ArithRel a op b) = atomR' op (toRat a) (toRat b) +fromLAAtom (OrdRel a op b) = atomR' op (toRat a) (toRat b) where atomR' :: RelOp -> Rat -> Rat -> DNF Constr atomR' op a b = diff --git a/src/ToySolver/Arith/FourierMotzkin/FOL.hs b/src/ToySolver/Arith/FourierMotzkin/FOL.hs --- a/src/ToySolver/Arith/FourierMotzkin/FOL.hs +++ b/src/ToySolver/Arith/FourierMotzkin/FOL.hs @@ -7,11 +7,10 @@ where import Control.Monad -import qualified Data.IntSet as IS import Data.Maybe import Data.VectorSpace hiding (project) -import ToySolver.Data.ArithRel +import ToySolver.Data.OrdRel import ToySolver.Data.Boolean import ToySolver.Data.DNF import qualified ToySolver.Data.FOL.Arith as FOL @@ -59,10 +58,10 @@ where f FOL.T = return true f FOL.F = return false - f (FOL.Atom (ArithRel a op b)) = do + f (FOL.Atom (OrdRel a op b)) = do a' <- LAFOL.fromFOLExpr a b' <- LAFOL.fromFOLExpr b - return $ fromLAAtom $ ArithRel a' op b' + return $ fromLAAtom $ OrdRel a' op b' f (FOL.And a b) = liftM2 (.&&.) (f a) (f b) f (FOL.Or a b) = liftM2 (.||.) (f a) (f b) f (FOL.Not a) = f (FOL.pushNot a) diff --git a/src/ToySolver/Arith/LPSolver.hs b/src/ToySolver/Arith/LPSolver.hs --- a/src/ToySolver/Arith/LPSolver.hs +++ b/src/ToySolver/Arith/LPSolver.hs @@ -62,7 +62,7 @@ import Data.Interval ((<=!), (>=!), (==!), (!), (/=!)) import qualified Data.Interval as Interval -import ToySolver.Data.ArithRel +import ToySolver.Data.OrdRel import qualified ToySolver.Data.LA as LA import ToySolver.Data.Var import qualified ToySolver.Arith.Simplex as Simplex @@ -165,7 +165,7 @@ -- addConstraint :: Real r => LA.Atom r -> LP r () addConstraint c = do - ArithRel lhs rop rhs <- expandDefs' c + OrdRel lhs rop rhs <- expandDefs' c let (b', e) = LA.extract LA.unitVar (lhs ^-^ rhs) b = - b' @@ -203,10 +203,10 @@ return $ LA.applySubst defs e expandDefs' :: (Num r, Eq r) => LA.Atom r -> LP r (LA.Atom r) -expandDefs' (ArithRel lhs op rhs) = do +expandDefs' (OrdRel lhs op rhs) = do lhs' <- expandDefs lhs rhs' <- expandDefs rhs - return $ ArithRel lhs' op rhs' + return $ OrdRel lhs' op rhs' tableau :: (RealFrac r) => [LA.Atom r] -> LP r () tableau cs = do @@ -297,7 +297,7 @@ -- convert right hand side to be non-negative normalizeConstraint :: forall r. Real r => LA.Atom r -> (LA.Expr r, RelOp, r) -normalizeConstraint (ArithRel a op b) +normalizeConstraint (OrdRel a op b) | rhs < 0 = (negateV lhs, flipOp op, negate rhs) | otherwise = (lhs, op, rhs) where @@ -314,7 +314,7 @@ nonnegVars = IS.filter (\v -> 0 <=! (bounds IM.! v)) vs isTriviallyTrue :: LA.Atom r -> Bool - isTriviallyTrue (ArithRel a op b) = + isTriviallyTrue (OrdRel a op b) = case op of Le -> i <=! 0 Ge -> i >=! 0 diff --git a/src/ToySolver/Arith/LPSolverHL.hs b/src/ToySolver/Arith/LPSolverHL.hs --- a/src/ToySolver/Arith/LPSolverHL.hs +++ b/src/ToySolver/Arith/LPSolverHL.hs @@ -28,7 +28,7 @@ import Data.OptDir import Data.VectorSpace -import ToySolver.Data.ArithRel +import ToySolver.Data.OrdRel import qualified ToySolver.Data.LA as LA import ToySolver.Data.Var import qualified ToySolver.Arith.Simplex as Simplex diff --git a/src/ToySolver/Arith/LPUtil.hs b/src/ToySolver/Arith/LPUtil.hs --- a/src/ToySolver/Arith/LPUtil.hs +++ b/src/ToySolver/Arith/LPUtil.hs @@ -13,13 +13,13 @@ import qualified Data.Interval as Interval -import ToySolver.Data.ArithRel +import ToySolver.Data.OrdRel import qualified ToySolver.Data.LA as LA import ToySolver.Data.Var import qualified ToySolver.Arith.BoundsInference as BI toStandardForm - :: (LA.Expr Rational, [ArithRel (LA.Expr Rational)]) + :: (LA.Expr Rational, [OrdRel (LA.Expr Rational)]) -> ( (LA.Expr Rational, [(LA.Expr Rational, Rational)]) , Model Rational -> Model Rational ) @@ -36,7 +36,7 @@ type M = State Var toStandardForm' - :: (LA.Expr Rational, [ArithRel (LA.Expr Rational)]) + :: (LA.Expr Rational, [OrdRel (LA.Expr Rational)]) -> ( (LA.Expr Rational, [(LA.Expr Rational, Rational)]) , VarMap (LA.Expr Rational) ) @@ -67,7 +67,7 @@ return $ IM.singleton v (LA.var v1 ^-^ LA.constant lb) let obj2 = LA.applySubst s obj - cs2 <- liftM concat $ forM cs $ \(ArithRel lhs op rhs) -> do + cs2 <- liftM catMaybes $ forM cs $ \(OrdRel lhs op rhs) -> do case LA.extract LA.unitVar (LA.applySubst s (lhs ^-^ rhs)) of (c,e) -> do let (lhs2,op2,rhs2) = @@ -75,16 +75,16 @@ then (e,op,-c) else (negateV e, flipOp op, c) case op2 of - Eql -> return [(lhs2,rhs2)] + Eql -> return $ Just (lhs2,rhs2) Le -> do v <- gensym - return [(lhs2 ^+^ LA.var v, rhs2)] + return $ Just (lhs2 ^+^ LA.var v, rhs2) Ge -> do case LA.terms lhs2 of - [(1,_)] | rhs2<=0 -> return [] + [(1,_)] | rhs2<=0 -> return Nothing _ -> do v <- gensym - return [(lhs2 ^-^ LA.var v, rhs2)] + return $ Just (lhs2 ^-^ LA.var v, rhs2) _ -> error $ "ToySolver.LPUtil.toStandardForm: " ++ show op2 ++ " is not supported" assert (and [isNothing $ LA.lookupCoeff LA.unitVar c | (c,_) <- cs2]) $ return () diff --git a/src/ToySolver/Arith/MIPSolver2.hs b/src/ToySolver/Arith/MIPSolver2.hs --- a/src/ToySolver/Arith/MIPSolver2.hs +++ b/src/ToySolver/Arith/MIPSolver2.hs @@ -77,7 +77,7 @@ import Text.Printf import qualified ToySolver.Data.LA as LA -import ToySolver.Data.ArithRel ((.<=.), (.>=.)) +import ToySolver.Data.OrdRel ((.<=.), (.>=.)) import qualified ToySolver.Arith.Simplex2 as Simplex2 import ToySolver.Arith.Simplex2 (OptResult (..), Var, Model) import ToySolver.Internal.Util (isInteger, fracPart) @@ -108,12 +108,12 @@ forM_ (IS.toList ivs) $ \v -> do lb <- Simplex2.getLB lp2 v case lb of - Just l | not (isInteger l) -> + Just (l,_) | not (isInteger l) -> Simplex2.assertLower lp2 v (fromInteger (ceiling l)) _ -> return () ub <- Simplex2.getUB lp2 v case ub of - Just u | not (isInteger u) -> + Just (u,_) | not (isInteger u) -> Simplex2.assertLower lp2 v (fromInteger (floor u)) _ -> return () @@ -459,22 +459,22 @@ js <- flip filterM ns $ \(_, xj) -> do vj <- Simplex2.getValue lp xj lb <- Simplex2.getLB lp xj - return $ Just vj == lb + return $ Just vj == Simplex2.boundValue lb ks <- flip filterM ns $ \(_, xj) -> do vj <- Simplex2.getValue lp xj ub <- Simplex2.getUB lp xj - return $ Just vj == ub + return $ Just vj == Simplex2.boundValue ub xs1 <- forM js $ \(aij, xj) -> do let fj = fracPart aij - Just lj <- Simplex2.getLB lp xj + Just (lj,_) <- Simplex2.getLB lp xj let c = if xj `IS.member` ivs then (if fj <= 1 - f0 then fj / (1 - f0) else ((1 - fj) / f0)) else (if aij > 0 then aij / (1 - f0) else (-aij / f0)) return $ c *^ (LA.var xj ^-^ LA.constant lj) xs2 <- forM ks $ \(aij, xj) -> do let fj = fracPart aij - Just uj <- Simplex2.getUB lp xj + Just (uj, _) <- Simplex2.getUB lp xj let c = if xj `IS.member` ivs then (if fj <= f0 then fj / f0 else ((1 - fj) / (1 - f0))) else (if aij > 0 then aij / f0 else (-aij / (1 - f0))) @@ -498,5 +498,5 @@ vj <- Simplex2.getValue lp xj lb <- Simplex2.getLB lp xj ub <- Simplex2.getUB lp xj - return $ Just vj == lb || Just vj == ub + return $ Just vj == Simplex2.boundValue lb || Just vj == Simplex2.boundValue ub return (and ys) diff --git a/src/ToySolver/Arith/MIPSolverHL.hs b/src/ToySolver/Arith/MIPSolverHL.hs --- a/src/ToySolver/Arith/MIPSolverHL.hs +++ b/src/ToySolver/Arith/MIPSolverHL.hs @@ -44,7 +44,7 @@ import Data.OptDir import Data.VectorSpace -import ToySolver.Data.ArithRel +import ToySolver.Data.OrdRel import ToySolver.Data.Var import qualified ToySolver.Data.LA as LA import qualified ToySolver.Arith.Simplex as Simplex diff --git a/src/ToySolver/Arith/OmegaTest.hs b/src/ToySolver/Arith/OmegaTest.hs --- a/src/ToySolver/Arith/OmegaTest.hs +++ b/src/ToySolver/Arith/OmegaTest.hs @@ -32,7 +32,6 @@ , solveQFLIRAConj -- * Options for solving , Options (..) - , defaultOptions , checkRealNoCheck , checkRealByFM , checkRealByCAD @@ -72,7 +71,7 @@ checkRealBySimplex :: VarSet -> [LA.Atom Rational] -> Bool checkRealBySimplex vs as = unsafePerformIO $ do solver <- Simplex2.newSolver - s <- liftM IM.fromList $ forM (IS.toList vs) $ \v -> do + s <- liftM IM.fromAscList $ forM (IS.toAscList vs) $ \v -> do v2 <- Simplex2.newVar solver return (v, LA.var v2) forM_ as $ \a -> do diff --git a/src/ToySolver/Arith/OmegaTest/Base.hs b/src/ToySolver/Arith/OmegaTest/Base.hs --- a/src/ToySolver/Arith/OmegaTest/Base.hs +++ b/src/ToySolver/Arith/OmegaTest/Base.hs @@ -29,7 +29,6 @@ , solve , solveQFLIRAConj , Options (..) - , defaultOptions , checkRealNoCheck , checkRealByFM @@ -48,7 +47,7 @@ import qualified Data.IntSet as IS import Data.VectorSpace -import ToySolver.Data.ArithRel +import ToySolver.Data.OrdRel import ToySolver.Data.Boolean import ToySolver.Data.DNF import qualified ToySolver.Data.LA as LA @@ -58,6 +57,9 @@ -- --------------------------------------------------------------------------- +-- | Options for solving. +-- +-- The default option can be obtained by 'def'. data Options = Options { optCheckReal :: VarSet -> [LA.Atom Rational] -> Bool @@ -69,15 +71,12 @@ } instance Default Options where - def = defaultOptions - -defaultOptions :: Options -defaultOptions = - Options - { optCheckReal = - -- checkRealNoCheck - checkRealByFM - } + def = + Options + { optCheckReal = + -- checkRealNoCheck + checkRealByFM + } checkRealNoCheck :: VarSet -> [LA.Atom Rational] -> Bool checkRealNoCheck _ _ = True @@ -299,7 +298,7 @@ solve opt vs cs = msum [solve' opt vs cs | cs <- unDNF dnf] where dnf = andB (map f cs) - f (ArithRel lhs op rhs) = + f (OrdRel lhs op rhs) = case op of Lt -> DNF [[a `ltZ` b]] Le -> DNF [[a `leZ` b]] diff --git a/src/ToySolver/Arith/Simplex.hs b/src/ToySolver/Arith/Simplex.hs --- a/src/ToySolver/Arith/Simplex.hs +++ b/src/ToySolver/Arith/Simplex.hs @@ -328,7 +328,7 @@ then Left PDUnbounded -- dual infeasible else Right (pivot q p tbl) where - qs = [ (Right i, bi) | (i, (row_i, bi)) <- IM.toList tbl, i /= objRowIndex, 0 > bi ] + qs = [ (Right i, bi) | (i, (_row_i, bi)) <- IM.toList tbl, i /= objRowIndex, 0 > bi ] ps = [ (Left j, cj') | (j,cj) <- IM.toList (fst (lookupRow objRowIndex tbl)) , let cj' = if optdir==OptMax then cj else -cj diff --git a/src/ToySolver/Arith/Simplex2.hs b/src/ToySolver/Arith/Simplex2.hs --- a/src/ToySolver/Arith/Simplex2.hs +++ b/src/ToySolver/Arith/Simplex2.hs @@ -41,10 +41,16 @@ , RelOp (..) , (.<=.), (.>=.), (.==.), (.<.), (.>.) , Atom (..) + , ConstrID + , ConstrIDSet , assertAtom + , assertAtom' , assertAtomEx + , assertAtomEx' , assertLower + , assertLower' , assertUpper + , assertUpper' , setObj , getObj , OptDir (..) @@ -56,7 +62,6 @@ , pushBacktrackPoint , popBacktrackPoint , Options (..) - , defaultOptions , OptResult (..) , optimize , dualSimplex @@ -68,6 +73,7 @@ , getRawModel , getValue , getObjValue + , explain -- * Reading status , getTableau @@ -81,6 +87,9 @@ , isOptimal , getLB , getUB + , Bound + , boundValue + , boundExplanation -- * Configulation , setLogger @@ -90,6 +99,9 @@ -- * Debug , dump + + -- * Misc + , simplifyAtom ) where import Prelude hiding (log) @@ -100,11 +112,14 @@ import Data.IORef import Data.List import Data.Maybe +import Data.Monoid import Data.Ratio import Data.Map (Map) import qualified Data.Map as Map import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap +import Data.IntSet (IntSet) +import qualified Data.IntSet as IntSet import Text.Printf import Data.Time import Data.OptDir @@ -113,7 +128,7 @@ import qualified ToySolver.Data.LA as LA import ToySolver.Data.LA (Atom (..)) -import ToySolver.Data.ArithRel +import ToySolver.Data.OrdRel import ToySolver.Data.Delta import ToySolver.Internal.Util (showRational) @@ -126,9 +141,10 @@ data GenericSolver v = GenericSolver { svTableau :: !(IORef (IntMap (LA.Expr Rational))) - , svLB :: !(IORef (IntMap v)) - , svUB :: !(IORef (IntMap v)) + , svLB :: !(IORef (IntMap (v, ConstrIDSet))) + , svUB :: !(IORef (IntMap (v, ConstrIDSet))) , svModel :: !(IORef (IntMap v)) + , svExplanation :: !(IORef ConstrIDSet) , svVCnt :: !(IORef Int) , svOk :: !(IORef Bool) , svOptDir :: !(IORef OptDir) @@ -154,6 +170,7 @@ l <- newIORef IntMap.empty u <- newIORef IntMap.empty m <- newIORef (IntMap.singleton objVar zeroV) + e <- newIORef mempty v <- newIORef 0 ok <- newIORef True dir <- newIORef OptMin @@ -168,6 +185,7 @@ , svLB = l , svUB = u , svModel = m + , svExplanation = e , svVCnt = v , svOk = ok , svOptDir = dir @@ -184,6 +202,7 @@ l <- newIORef =<< readIORef (svLB solver) u <- newIORef =<< readIORef (svUB solver) m <- newIORef =<< readIORef (svModel solver) + e <- newIORef =<< readIORef (svExplanation solver) v <- newIORef =<< readIORef (svVCnt solver) ok <- newIORef =<< readIORef (svOk solver) dir <- newIORef =<< readIORef (svOptDir solver) @@ -198,6 +217,7 @@ , svLB = l , svUB = u , svModel = m + , svExplanation = e , svVCnt = v , svOk = ok , svOptDir = dir @@ -228,14 +248,25 @@ lb <- getLB solver x ub <- getUB solver x return $ - [(p - c) / (k - q) | Just (Delta c k) <- return lb, c < p, k > q] ++ - [(d - p) / (q - h) | Just (Delta d h) <- return ub, p < d, q > h] + [(p - c) / (k - q) | Just (Delta c k, _) <- return lb, c < p, k > q] ++ + [(d - p) / (q - h) | Just (Delta d h, _) <- return ub, p < d, q > h] let delta0 :: Rational delta0 = if null ys then 0.1 else minimum ys f :: Delta Rational -> Rational f (Delta r k) = r + k * delta0 liftM (IntMap.map f) $ readIORef (svModel solver) +type ConstrID = Int +type ConstrIDSet = IntSet + +type Bound v = Maybe (v, ConstrIDSet) + +boundValue :: SolverValue v => Bound v -> Maybe v +boundValue = fmap fst + +boundExplanation :: SolverValue v => Bound v -> ConstrIDSet +boundExplanation = maybe mempty snd + {- Largest coefficient rule: original rule suggested by G. Dantzig. Largest increase rule: computationally more expensive in comparison with Largest coefficient, but locally maximizes the progress. @@ -259,8 +290,8 @@ data BacktrackPoint v = BacktrackPoint - { bpSavedLB :: !(IORef (IntMap (Maybe v))) - , bpSavedUB :: !(IORef (IntMap (Maybe v))) + { bpSavedLB :: !(IORef (IntMap (Bound v))) + , bpSavedUB :: !(IORef (IntMap (Bound v))) } cloneBacktrackPoint :: BacktrackPoint v -> IO (BacktrackPoint v) @@ -335,32 +366,38 @@ return v assertAtom :: Solver -> LA.Atom Rational -> IO () -assertAtom solver atom = do +assertAtom solver atom = assertAtom' solver atom Nothing + +assertAtom' :: Solver -> LA.Atom Rational -> Maybe ConstrID -> IO () +assertAtom' solver atom cid = do (v,op,rhs') <- simplifyAtom solver atom case op of - Le -> assertUpper solver v (toValue rhs') - Ge -> assertLower solver v (toValue rhs') + Le -> assertUpper' solver v (toValue rhs') cid + Ge -> assertLower' solver v (toValue rhs') cid Eql -> do - assertLower solver v (toValue rhs') - assertUpper solver v (toValue rhs') + assertLower' solver v (toValue rhs') cid + assertUpper' solver v (toValue rhs') cid _ -> error "unsupported" return () assertAtomEx :: GenericSolver (Delta Rational) -> LA.Atom Rational -> IO () -assertAtomEx solver atom = do +assertAtomEx solver atom = assertAtomEx' solver atom Nothing + +assertAtomEx' :: GenericSolver (Delta Rational) -> LA.Atom Rational -> Maybe ConstrID -> IO () +assertAtomEx' solver atom cid = do (v,op,rhs') <- simplifyAtom solver atom case op of - Le -> assertUpper solver v (toValue rhs') - Ge -> assertLower solver v (toValue rhs') - Lt -> assertUpper solver v (toValue rhs' ^-^ delta) - Gt -> assertLower solver v (toValue rhs' ^+^ delta) + Le -> assertUpper' solver v (toValue rhs') cid + Ge -> assertLower' solver v (toValue rhs') cid + Lt -> assertUpper' solver v (toValue rhs' ^-^ delta) cid + Gt -> assertLower' solver v (toValue rhs' ^+^ delta) cid Eql -> do - assertLower solver v (toValue rhs') - assertUpper solver v (toValue rhs') + assertLower' solver v (toValue rhs') cid + assertUpper' solver v (toValue rhs') cid return () simplifyAtom :: SolverValue v => GenericSolver v -> LA.Atom Rational -> IO (Var, RelOp, Rational) -simplifyAtom solver (ArithRel lhs op rhs) = do +simplifyAtom solver (OrdRel lhs op rhs) = do let (lhs',rhs') = case LA.extract LA.unitVar (lhs ^-^ rhs) of (n,e) -> (e, -n) @@ -379,6 +416,11 @@ v <- newVar solver setRow solver v lhs'' modifyIORef (svDefDB solver) $ Map.insert lhs'' v + case LA.asConst lhs'' of + Just 0 -> do + modifyIORef (svLB solver) (IntMap.insert v (toValue 0, mempty)) + modifyIORef (svUB solver) (IntMap.insert v (toValue 0, mempty)) + _ -> return () return (v,op'',rhs'') where scale :: LA.Expr Rational -> (Rational, LA.Expr Rational) @@ -387,32 +429,44 @@ c = c1 * c2 c1 = fromIntegral $ foldl' lcm 1 [denominator c | (c, _) <- LA.terms e] c2 = signum $ head ([c | (c,x) <- LA.terms e] ++ [1]) - + assertLower :: SolverValue v => GenericSolver v -> Var -> v -> IO () -assertLower solver x l = do +assertLower solver x l = assertLower' solver x l Nothing + +assertLower' :: SolverValue v => GenericSolver v -> Var -> v -> Maybe ConstrID -> IO () +assertLower' solver x l cid = do + let cidSet = IntSet.fromList $ maybeToList cid l0 <- getLB solver x u0 <- getUB solver x case (l0,u0) of - (Just l0', _) | l <= l0' -> return () - (_, Just u0') | u0' < l -> markBad solver + (Just (l0', _), _) | l <= l0' -> return () + (_, Just (u0', cidSet2)) | u0' < l -> do + writeIORef (svExplanation solver) $ cidSet `IntSet.union` cidSet2 + markBad solver _ -> do bpSaveLB solver x - modifyIORef (svLB solver) (IntMap.insert x l) + modifyIORef (svLB solver) (IntMap.insert x (l, cidSet)) b <- isNonBasicVariable solver x v <- getValue solver x when (b && not (l <= v)) $ update solver x l checkNBFeasibility solver assertUpper :: SolverValue v => GenericSolver v -> Var -> v -> IO () -assertUpper solver x u = do +assertUpper solver x u = assertUpper' solver x u Nothing + +assertUpper' :: SolverValue v => GenericSolver v -> Var -> v -> Maybe ConstrID -> IO () +assertUpper' solver x u cid = do + let cidSet = IntSet.fromList $ maybeToList cid l0 <- getLB solver x u0 <- getUB solver x - case (l0,u0) of - (_, Just u0') | u0' <= u -> return () - (Just l0', _) | u < l0' -> markBad solver + case (l0,u0) of + (_, Just (u0', _)) | u0' <= u -> return () + (Just (l0', cidSet2), _) | u < l0' -> do + writeIORef (svExplanation solver) $ cidSet `IntSet.union` cidSet2 + markBad solver _ -> do bpSaveUB solver x - modifyIORef (svUB solver) (IntMap.insert x u) + modifyIORef (svUB solver) (IntMap.insert x (u, cidSet)) b <- isNonBasicVariable solver x v <- getValue solver x when (b && not (v <= u)) $ update solver x u @@ -497,9 +551,24 @@ xi_def <- getRow solver xi r <- liftM (fmap snd) $ findM q (LA.terms xi_def) case r of - Nothing -> markBad solver >> return False + Nothing -> do + let c = if isLBViolated then li else ui + core <- liftM (mconcat . map boundExplanation . (c :)) $ forM (LA.terms xi_def) $ \(aij, xj) -> do + if isLBViolated then do + if aij > 0 then do + getUB solver xj + else do + getLB solver xj + else do + if aij > 0 then do + getLB solver xj + else do + getUB solver xj + writeIORef (svExplanation solver) core + markBad solver + return False Just xj -> do - pivotAndUpdate solver xi xj (fromJust (if isLBViolated then li else ui)) + pivotAndUpdate solver xi xj (fromJust $ boundValue $ if isLBViolated then li else ui) loop ok <- readIORef (svOk solver) @@ -537,8 +606,8 @@ li <- getLB solver xi ui <- getUB solver xi if not (testLB li vi) - then return (xi, fromJust li ^-^ vi) - else return (xi, vi ^-^ fromJust ui) + then return (xi, fromJust (boundValue li) ^-^ vi) + else return (xi, vi ^-^ fromJust (boundValue ui)) return $ Just $ fst $ maximumBy (comparing snd) xs2 {-------------------------------------------------------------------- @@ -549,6 +618,9 @@ data OptResult = Optimum | Unsat | Unbounded | ObjLimit deriving (Show, Eq, Ord) +-- | Options for solving. +-- +-- The default option can be obtained by 'def'. data Options = Options { objLimit :: Maybe Rational @@ -556,13 +628,10 @@ deriving (Show, Eq, Ord) instance Default Options where - def = defaultOptions - -defaultOptions :: Options -defaultOptions - = Options - { objLimit = Nothing - } + def = + Options + { objLimit = Nothing + } optimize :: Solver -> Options -> IO OptResult optimize solver opt = do @@ -637,7 +706,7 @@ v <- getValue solver x case u of Nothing -> return True - Just uv -> return $! (v < uv) + Just (uv, _) -> return $! (v < uv) canDecrease1 :: SolverValue v => GenericSolver v -> Var -> IO Bool canDecrease1 solver x = do @@ -645,7 +714,7 @@ v <- getValue solver x case l of Nothing -> return True - Just lv -> return $! (lv < v) + Just (lv, _) -> return $! (lv < v) -- | feasibility を保ちつつ non-basic variable xj の値を大きくする increaseNB :: Solver -> Var -> IO Bool @@ -659,7 +728,7 @@ li <- getLB solver xi ui <- getUB solver xi return [ assert (theta >= zeroV) ((xi,v2), theta) - | Just v2 <- [ui | aij > 0] ++ [li | aij < 0] + | Just v2 <- [boundValue ui | aij > 0] ++ [boundValue li | aij < 0] , let theta = (v2 ^-^ v1) ^/ aij ] -- β(xj) := β(xj) + θ なので θ を大きく @@ -682,7 +751,7 @@ li <- getLB solver xi ui <- getUB solver xi return [ assert (theta <= zeroV) ((xi,v2), theta) - | Just v2 <- [li | aij > 0] ++ [ui | aij < 0] + | Just v2 <- [boundValue li | aij > 0] ++ [boundValue ui | aij < 0] , let theta = (v2 ^-^ v1) ^/ aij ] -- β(xj) := β(xj) + θ なので θ を小さく @@ -716,9 +785,25 @@ return $ not (testLB li vi) r <- dualRTest solver xi_def isLBViolated case r of - Nothing -> markBad solver >> return Unsat -- dual unbounded + Nothing -> do + -- dual unbounded + let c = if isLBViolated then li else ui + core <- liftM (mconcat . map boundExplanation . (c :)) $ forM (LA.terms xi_def) $ \(aij, xj) -> do + if isLBViolated then do + if aij > 0 then do + getUB solver xj + else do + getLB solver xj + else do + if aij > 0 then do + getLB solver xj + else do + getUB solver xj + writeIORef (svExplanation solver) core + markBad solver + return Unsat Just xj -> do - pivotAndUpdate solver xi xj (fromJust (if isLBViolated then li else ui)) + pivotAndUpdate solver xi xj (fromJust $ boundValue $ if isLBViolated then li else ui) loop ok <- readIORef (svOk solver) @@ -789,6 +874,9 @@ getObjValue solver = getValue solver objVar type Model = IntMap Rational + +explain :: GenericSolver v -> IO ConstrIDSet +explain solver = readIORef (svExplanation solver) {-------------------------------------------------------------------- major function @@ -844,12 +932,12 @@ -- log solver $ printf "after pivotAndUpdate x%d x%d (%s)" xi xj (show v) -- dump solver -getLB :: GenericSolver v -> Var -> IO (Maybe v) +getLB :: GenericSolver v -> Var -> IO (Bound v) getLB solver x = do lb <- readIORef (svLB solver) return $ IntMap.lookup x lb -getUB :: GenericSolver v -> Var -> IO (Maybe v) +getUB :: GenericSolver v -> Var -> IO (Bound v) getUB solver x = do ub <- readIORef (svUB solver) return $ IntMap.lookup x ub @@ -896,13 +984,13 @@ then return (Just x) else findM p xs -testLB :: SolverValue v => Maybe v -> v -> Bool +testLB :: SolverValue v => Bound v -> v -> Bool testLB Nothing _ = True -testLB (Just l) x = l <= x +testLB (Just (l,_)) x = l <= x -testUB :: SolverValue v => Maybe v -> v -> Bool +testUB :: SolverValue v => Bound v -> v -> Bool testUB Nothing _ = True -testUB (Just u) x = x <= u +testUB (Just (u,_)) x = x <= u variables :: GenericSolver v -> IO [Var] variables solver = do @@ -914,15 +1002,6 @@ t <- readIORef (svTableau solver) return (IntMap.keys t) -#if !MIN_VERSION_base(4,6,0) - -modifyIORef' :: IORef a -> (a -> a) -> IO () -modifyIORef' ref f = do - x <- readIORef ref - writeIORef ref $! f x - -#endif - recordTime :: SolverValue v => GenericSolver v -> IO a -> IO a recordTime solver act = do dumpSize solver @@ -987,8 +1066,8 @@ x1 <- newVar solver writeIORef (svTableau solver) (IntMap.fromList [(x1, LA.var x0)]) - writeIORef (svLB solver) (IntMap.fromList [(x0, toValue 0), (x1, toValue 0)]) - writeIORef (svUB solver) (IntMap.fromList [(x0, toValue 2), (x1, toValue 3)]) + writeIORef (svLB solver) $ fmap (\v -> (v, mempty)) $ IntMap.fromList [(x0, 0), (x1, 0)] + writeIORef (svUB solver) $ fmap (\v -> (v, mempty)) $ IntMap.fromList [(x0, 2), (x1, 3)] setObj solver (LA.fromTerms [(-1, x0)]) ret <- optimize solver def @@ -1003,8 +1082,8 @@ x1 <- newVar solver writeIORef (svTableau solver) (IntMap.fromList [(x1, LA.var x0)]) - writeIORef (svLB solver) (IntMap.fromList [(x0, toValue 0), (x1, toValue 0)]) - writeIORef (svUB solver) (IntMap.fromList [(x0, toValue 2), (x1, toValue 0)]) + writeIORef (svLB solver) $ fmap (\v -> (v, mempty)) $ IntMap.fromList [(x0, 0), (x1, 0)] + writeIORef (svUB solver) $ fmap (\v -> (v, mempty)) $ IntMap.fromList [(x0, 2), (x1, 0)] setObj solver (LA.fromTerms [(-1, x0)]) checkFeasibility solver @@ -1059,7 +1138,7 @@ u <- getUB solver x v <- getValue solver x let f Nothing = "Nothing" - f (Just x) = showValue True x + f (Just (x,_)) = showValue True x log solver $ printf "beta(x%d) = %s; %s <= x%d <= %s" x (showValue True v) (f l) x (f u) log solver "" @@ -1080,7 +1159,7 @@ l <- getLB solver x u <- getUB solver x let f Nothing = "Nothing" - f (Just x) = showValue True x + f (Just (x,_)) = showValue True x unless (testLB l v) $ error (printf "(%s) <= x%d is violated; x%d = (%s)" (f l) x x (showValue True v)) unless (testUB u v) $ @@ -1098,7 +1177,7 @@ l <- getLB solver x u <- getUB solver x let f Nothing = "Nothing" - f (Just x) = showValue True x + f (Just (x,_)) = showValue True x unless (testLB l v) $ error (printf "checkNBFeasibility: (%s) <= x%d is violated; x%d = (%s)" (f l) x x (showValue True v)) unless (testUB u v) $ diff --git a/src/ToySolver/Arith/VirtualSubstitution.hs b/src/ToySolver/Arith/VirtualSubstitution.hs --- a/src/ToySolver/Arith/VirtualSubstitution.hs +++ b/src/ToySolver/Arith/VirtualSubstitution.hs @@ -45,7 +45,7 @@ import Data.Maybe import Data.VectorSpace hiding (project) -import ToySolver.Data.ArithRel +import ToySolver.Data.OrdRel import ToySolver.Data.Boolean import ToySolver.Data.BoolExpr (BoolExpr (..)) import qualified ToySolver.Data.BoolExpr as BoolExpr @@ -59,7 +59,7 @@ evalQFFormula :: Model Rational -> QFFormula -> Bool evalQFFormula m = BoolExpr.fold f where - f (ArithRel lhs op rhs) = evalOp op (LA.evalExpr m lhs) (LA.evalExpr m rhs) + f (OrdRel lhs op rhs) = evalOp op (LA.evalExpr m lhs) (LA.evalExpr m rhs) {-| @'project' x φ@ returns @(ψ, lift)@ such that: @@ -153,17 +153,17 @@ simplify = BoolExpr.simplify . BoolExpr.fold simplifyLit simplifyLit :: LA.Atom Rational -> QFFormula -simplifyLit (ArithRel lhs op rhs) = +simplifyLit (OrdRel lhs op rhs) = case LA.asConst e of Just c -> if evalOp op c 0 then true else false - Nothing -> Atom (ArithRel e op (LA.constant 0)) + Nothing -> Atom (OrdRel e op (LA.constant 0)) where e = lhs ^-^ rhs collect :: Var -> QFFormula -> Set (LA.Expr Rational) collect v = Foldable.foldMap f where - f (ArithRel lhs _ rhs) = assert (rhs == LA.constant 0) $ + f (OrdRel lhs _ rhs) = assert (rhs == LA.constant 0) $ case LA.extractMaybe v lhs of Nothing -> Set.empty Just (a,b) -> Set.singleton (negateV (b ^/ a)) diff --git a/src/ToySolver/Combinatorial/HittingSet/FredmanKhachiyan1996.hs b/src/ToySolver/Combinatorial/HittingSet/FredmanKhachiyan1996.hs --- a/src/ToySolver/Combinatorial/HittingSet/FredmanKhachiyan1996.hs +++ b/src/ToySolver/Combinatorial/HittingSet/FredmanKhachiyan1996.hs @@ -37,6 +37,16 @@ -- * Utilities for testing , isCounterExampleOf , occurFreq + + -- * Internal functions exported only for testing purpose + , condition_1_1 + , condition_1_2 + , condition_1_3 + , condition_2_1 + , condition_1_1_solve + , condition_1_2_solve + , condition_1_3_solve + , condition_2_1_solve ) where import Prelude hiding (all, any) @@ -373,61 +383,3 @@ -- An implicant /I∈F/ of a DNF /F/ is redundant if /F/ contains proper subset of /I/. -- A DNF /F/ is called redundant if it contains redundant implicants. -- The main functions of this modules does not care about redundancy of DNFs. - -test_condition_1_1_solve_L = xs `isCounterExampleOf` (f,g) - where - Just xs = condition_1_1_solve f g - f = Set.fromList $ map IntSet.fromList [[2,4,7], [7,8], [9], [4]] - g = Set.fromList $ map IntSet.fromList [[7,9], [4,8,9], [2,8,9]] - -test_condition_1_1_solve_R = xs `isCounterExampleOf` (f,g) - where - Just xs = condition_1_1_solve f g - f = Set.fromList $ map IntSet.fromList [[2,4,7], [7,8], [9]] - g = Set.fromList $ map IntSet.fromList [[7,9], [4,8,9], [2,8,9], [4,7,8]] - -test_condition_1_2_solve_L = xs `isCounterExampleOf` (f,g) - where - Just xs = condition_1_2_solve f g - f = Set.fromList $ map IntSet.fromList [[2,4,7], [7,8], [9,10]] - g = Set.fromList $ map IntSet.fromList [[7,9], [4,8,9], [2,8,9]] - -test_condition_1_2_solve_R = xs `isCounterExampleOf` (f,g) - where - Just xs = condition_1_2_solve f g - f = Set.fromList $ map IntSet.fromList [[2,4,7], [7,8], [9]] - g = Set.fromList $ map IntSet.fromList [[7,9], [4,8,9], [2,8,9,10]] - -test_condition_1_3_solve_L = xs `isCounterExampleOf` (f,g) - where - Just xs = condition_1_3_solve f g - f = Set.fromList $ map IntSet.fromList [[2,4,7,10], [7,8], [9]] - g = Set.fromList $ map IntSet.fromList [[7,9,10], [4,8,9], [2,8,9]] - -test_condition_1_3_solve_R = xs `isCounterExampleOf` (f,g) - where - Just xs = condition_1_3_solve f g - f = Set.fromList $ map IntSet.fromList [[2,4,7], [7,8], [9,10]] - g = Set.fromList $ map IntSet.fromList [[7,9], [4,8,9], [2,8,9,10]] - -test_condition_2_1_solve_L = xs `isCounterExampleOf` (f,g) - where - Just xs = condition_2_1_solve f g - f = Set.fromList $ map IntSet.fromList [[2,4,7], [4,7,9], [7,8,9]] - g = Set.fromList $ map IntSet.fromList [[2,4,7], [2,8,9], [4,8,9]] - -test_condition_2_1_solve_R = xs `isCounterExampleOf` (f,g) - where - Just xs = condition_2_1_solve f g - g = Set.fromList $ map IntSet.fromList [[2,4,7], [4,7,9], [7,8,9]] - f = Set.fromList $ map IntSet.fromList [[2,4,7], [2,8,9], [4,8,9]] - -test_checkDualityA = checkDualityA f g == Nothing - where - f = Set.fromList $ map IntSet.fromList [[2,4,7], [7,8], [9]] - g = Set.fromList $ map IntSet.fromList [[7,9], [4,8,9], [2,8,9]] - -test_checkDualityB = checkDualityB f g == Nothing - where - f = Set.fromList $ map IntSet.fromList [[2,4,7], [7,8], [9]] - g = Set.fromList $ map IntSet.fromList [[7,9], [4,8,9], [2,8,9]] diff --git a/src/ToySolver/Combinatorial/HittingSet/GurvichKhachiyan1999.hs b/src/ToySolver/Combinatorial/HittingSet/GurvichKhachiyan1999.hs --- a/src/ToySolver/Combinatorial/HittingSet/GurvichKhachiyan1999.hs +++ b/src/ToySolver/Combinatorial/HittingSet/GurvichKhachiyan1999.hs @@ -25,7 +25,6 @@ , enumMinimalHittingSets ) where -import Control.Monad import Data.IntSet (IntSet) import qualified Data.IntSet as IntSet import Data.Set (Set) @@ -125,7 +124,7 @@ case findPrimeImplicateOrPrimeImplicant vs f cs dnf of Nothing -> [] Just (Left c) -> c : loop (Set.insert c cs) - Just (Right d) -> error "GurvichKhachiyan1999.enumMinimalHittingSets: should not happen" + Just (Right _) -> error "GurvichKhachiyan1999.enumMinimalHittingSets: should not happen" evalDNF :: Set IntSet -> IntSet -> Bool evalDNF dnf xs = or [is `IntSet.isSubsetOf` xs | is <- Set.toList dnf] @@ -134,12 +133,15 @@ evalCNF cnf xs = and [not $ IntSet.null $ is `IntSet.intersection` xs | is <- Set.toList cnf] +f, g :: Set IntSet f = Set.fromList $ map IntSet.fromList [[2,4,7], [7,8], [9]] g = Set.fromList $ map IntSet.fromList [[7,9], [4,8,9], [2,8,9]] +testA1, testA2, testA3, testA4 :: Maybe (Either IntSet IntSet) testA1 = findPrimeImplicateOrPrimeImplicant (IntSet.fromList [2,4,7,8,9]) (evalDNF f) Set.empty f testA2 = findPrimeImplicateOrPrimeImplicant (IntSet.fromList [2,4,7,8,9]) (evalDNF f) (Set.singleton (IntSet.fromList [2,8,9])) f testA3 = findPrimeImplicateOrPrimeImplicant (IntSet.fromList [2,4,7,8,9]) (evalDNF f) (Set.fromList [IntSet.fromList [2,8,9], IntSet.fromList [4,8,9]]) f testA4 = findPrimeImplicateOrPrimeImplicant (IntSet.fromList [2,4,7,8,9]) (evalDNF f) (Set.fromList [IntSet.fromList [2,8,9], IntSet.fromList [4,8,9], IntSet.fromList [7,9]]) f +testB1 :: Maybe (Either IntSet IntSet) testB1 = findPrimeImplicateOrPrimeImplicant (IntSet.fromList [2,4,7,8,9]) (evalDNF f) g Set.empty diff --git a/src/ToySolver/Combinatorial/HittingSet/HTCBDD.hs b/src/ToySolver/Combinatorial/HittingSet/HTCBDD.hs --- a/src/ToySolver/Combinatorial/HittingSet/HTCBDD.hs +++ b/src/ToySolver/Combinatorial/HittingSet/HTCBDD.hs @@ -20,7 +20,6 @@ ( Options (..) , Method (..) , Failure (..) - , defaultOptions , minimalHittingSets ) where @@ -41,6 +40,9 @@ import System.IO.Temp import ToySolver.Internal.ProcessUtil (runProcessWithOutputCallback) +-- | Options for solving. +-- +-- The default option can be obtained by 'def'. data Options = Options { optHTCBDDCommand :: FilePath @@ -58,16 +60,13 @@ def = MethodToda instance Default Options where - def = defaultOptions - -defaultOptions :: Options -defaultOptions = - Options - { optHTCBDDCommand = "htcbdd" - , optMethod = def - , optOnGetLine = \_ -> return () - , optOnGetErrorLine = \_ -> return () - } + def = + Options + { optHTCBDDCommand = "htcbdd" + , optMethod = def + , optOnGetLine = \_ -> return () + , optOnGetErrorLine = \_ -> return () + } data Failure = Failure !Int deriving (Show, Typeable) diff --git a/src/ToySolver/Combinatorial/HittingSet/SHD.hs b/src/ToySolver/Combinatorial/HittingSet/SHD.hs --- a/src/ToySolver/Combinatorial/HittingSet/SHD.hs +++ b/src/ToySolver/Combinatorial/HittingSet/SHD.hs @@ -19,7 +19,6 @@ module ToySolver.Combinatorial.HittingSet.SHD ( Options (..) , Failure (..) - , defaultOptions , minimalHittingSets ) where @@ -40,6 +39,9 @@ import System.IO.Temp import ToySolver.Internal.ProcessUtil (runProcessWithOutputCallback) +-- | Options for solving. +-- +-- The default option can be obtained by 'def'. data Options = Options { optSHDCommand :: FilePath @@ -49,16 +51,13 @@ } instance Default Options where - def = defaultOptions - -defaultOptions :: Options -defaultOptions = - Options - { optSHDCommand = "shd" - , optSHDArgs = ["0"] - , optOnGetLine = \_ -> return () - , optOnGetErrorLine = \_ -> return () - } + def = + Options + { optSHDCommand = "shd" + , optSHDArgs = ["0"] + , optOnGetLine = \_ -> return () + , optOnGetErrorLine = \_ -> return () + } data Failure = Failure !Int deriving (Show, Typeable) diff --git a/src/ToySolver/Combinatorial/Knapsack/BB.hs b/src/ToySolver/Combinatorial/Knapsack/BB.hs --- a/src/ToySolver/Combinatorial/Knapsack/BB.hs +++ b/src/ToySolver/Combinatorial/Knapsack/BB.hs @@ -18,7 +18,7 @@ , solve ) where -import Control.Monad.State +import Control.Monad.State.Strict import Data.Function (on) import Data.IntSet (IntSet) import qualified Data.IntSet as IntSet @@ -38,10 +38,11 @@ ) where items' :: [(Value, Weight, Int)] - items' = map fst $ sortBy (flip compare `on` snd) [((v, w, n), (v / w, v)) | (n, (v, w)) <- zip [0..] items] + items' = map fst $ sortBy (flip compare `on` snd) [((v, w, n), (v / w, v)) | (n, (v, w)) <- zip [0..] items, w > 0, v > 0] sol :: IntSet - sol = IntSet.fromList $ fst $ execState (f items' limit ([],0)) ([],0) + sol = IntSet.fromList [n | (n, (v, w)) <- zip [0..] items, w == 0, v > 0] `IntSet.union` + IntSet.fromList (fst $ execState (f items' limit ([],0)) ([],0)) f :: [(Value, Weight, Int)] -> Weight -> ([Int],Value) -> State ([Int],Value) () f items !slack (is, !value) = do @@ -51,7 +52,8 @@ [] -> put (is,value) (v,w,i):items -> do when (slack >= w) $ f items (slack - w) (i : is, v + value) - f items slack (is, value) + -- Drop all indistingushable items for symmetry breaking + f (dropWhile (\(v',w',_) -> v==v' && w==w') items) slack (is, value) computeUB :: [(Value, Weight, Int)] -> Weight -> Value -> Value computeUB items slack value = go items slack value diff --git a/src/ToySolver/Combinatorial/Knapsack/DP.hs b/src/ToySolver/Combinatorial/Knapsack/DP.hs deleted file mode 100644 --- a/src/ToySolver/Combinatorial/Knapsack/DP.hs +++ /dev/null @@ -1,49 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : ToySolver.Combinatorial.Knapsack.DP --- Copyright : (c) Masahiro Sakai 2014 --- License : BSD-style --- --- Maintainer : masahiro.sakai@gmail.com --- Stability : provisional --- Portability : portable --- --- Simple 0-1 knapsack problem solver that uses DP. --- ------------------------------------------------------------------------------ -module ToySolver.Combinatorial.Knapsack.DP - ( Weight - , Value - , solve - ) where - -import Data.Array -import Data.Function (on) -import Data.List - -type Weight = Int -type Value = Rational - -solve - :: [(Value, Weight)] - -> Weight - -> (Value, Weight, [Bool]) -solve items limit = (val, sum [w | (b,(_,w)) <- zip bs items, b], bs) - where - bs = reverse bs' - (bs',val) = m!(n-1, limit) - - n = length items - m = array ((-1, 0), (n-1, limit)) $ - [((-1,w), ([],0)) | w <- [0 .. limit]] ++ - [((i,0), ([],0)) | i <- [0 .. n-1]] ++ - [((i,w), best) - | (i,(vi,wi)) <- zip [0..] items - , w <- [1..limit] - , let s1 = [(False:bs,v) | let (bs,v) = m!(i-1, w)] - , let s2 = [(True:as,v+vi) | w >= wi, let (as,v) = m!(i-1, w-wi)] - , let best = maximumBy (compare `on` snd) (s1 ++ s2) - ] - -test1 = solve [(5,4), (4,5), (3,2)] 9 -test2 = solve [(45,5), (48,8), (35,3)] 10 diff --git a/src/ToySolver/Combinatorial/Knapsack/DPDense.hs b/src/ToySolver/Combinatorial/Knapsack/DPDense.hs new file mode 100644 --- /dev/null +++ b/src/ToySolver/Combinatorial/Knapsack/DPDense.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE ScopedTypeVariables #-} +----------------------------------------------------------------------------- +-- | +-- Module : ToySolver.Combinatorial.Knapsack.DPDense +-- Copyright : (c) Masahiro Sakai 2014 +-- License : BSD-style +-- +-- Maintainer : masahiro.sakai@gmail.com +-- Stability : provisional +-- Portability : non-portable (ScopedTypeVariables) +-- +-- Simple 0-1 knapsack problem solver that uses DP. +-- +----------------------------------------------------------------------------- +module ToySolver.Combinatorial.Knapsack.DPDense + ( Weight + , Value + , solve + ) where + +import Control.Exception (assert) +import Control.Loop +import Control.Monad +import Control.Monad.ST +import Data.Array.ST +import Data.Function (on) +import Data.List + +type Weight = Int +type Value = Rational + +solve + :: [(Value, Weight)] + -> Weight + -> (Value, Weight, [Bool]) +solve items limit = runST m + where + m :: forall s. ST s (Value, Weight, [Bool]) + m = do + (table :: STArray s Weight (Value, Weight, [Bool])) <- newArray (0, limit) (0,0,[]) + forM_ items $ \(v,w) -> do + forLoop limit (>=0) (subtract 1) $ \c -> do + assert (w >= 0) $ return () + if w <= c then do + (obj1, w1, sol1) <- readArray table c + (obj2, w2, sol2) <- readArray table (c - w) + seq w1 $ seq w2 $ return () -- XXX + if v >= 0 && obj2 + v > obj1 then do + writeArray table c (obj2 + v, w2 + w, True : sol2) + else + writeArray table c (obj1, w1, False : sol1) + else do + (obj1, w1, sol1) <- readArray table c + writeArray table c (obj1, w1, False : sol1) + (obj, w, sol) <- readArray table limit + return (obj, w, reverse sol) + +test1 = solve [(5,4), (4,5), (3,2)] 9 +test2 = solve [(45,5), (48,8), (35,3)] 10 diff --git a/src/ToySolver/Combinatorial/Knapsack/DPSparse.hs b/src/ToySolver/Combinatorial/Knapsack/DPSparse.hs new file mode 100644 --- /dev/null +++ b/src/ToySolver/Combinatorial/Knapsack/DPSparse.hs @@ -0,0 +1,140 @@ +{-# LANGUAGE ScopedTypeVariables, BangPatterns #-} +{-# OPTIONS_GHC -Wall #-} +----------------------------------------------------------------------------- +-- | +-- Module : ToySolver.Combinatorial.Knapsack.DPSparse +-- Copyright : (c) Masahiro Sakai 2015 +-- License : BSD-style +-- +-- Maintainer : masahiro.sakai@gmail.com +-- Stability : provisional +-- Portability : non-portable (ScopedTypeVariables) +-- +-- Simple 0-1 knapsack problem solver that uses DP. +-- +----------------------------------------------------------------------------- +module ToySolver.Combinatorial.Knapsack.DPSparse + ( solve + , solveInt + , solveInteger + , solveGeneric + ) where + +import Data.List +import Data.IntMap.Strict (IntMap) +import qualified Data.IntMap.Strict as IntMap +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map + +{-# RULES +"solve/Int" solve = solveInt +"solve/Integer" solve = solveInteger + #-} + +solve + :: forall value weight. (Real value, Real weight) + => [(value, weight)] + -> weight + -> (value, weight, [Bool]) +solve = solveGeneric + +solveGeneric + :: forall value weight. (Real value, Real weight) + => [(value, weight)] + -> weight + -> (value, weight, [Bool]) +solveGeneric items limit = + case Map.findMax table of + (w, (v, sol)) -> (v, w, reverse sol) + where + table :: Map weight (value, [Bool]) + table = foldl' f empty items + + empty :: Map weight (value, [Bool]) + empty = Map.singleton 0 (0,[]) + + f :: Map weight (value, [Bool]) -> (value, weight) -> Map weight (value, [Bool]) + f m (vi,wi) + | wi < 0 = error "negative weight" + | vi <= 0 = m0 + | wi == 0 = Map.map (\(v,sol) -> (v+vi, True : sol)) m + | otherwise = removeDominated m2 + where + m0 = Map.map (\(v,sol) -> (v, False : sol)) m + m1 = splitLE limit $ Map.mapKeysMonotonic (+wi) $ Map.map (\(v,sol) -> (v+vi, True : sol)) $ m + m2 = Map.unionWith (\a@(v1,_) b@(v2,_) -> if v1 < v2 then b else a) m0 m1 + + removeDominated :: Map weight (value, [Bool]) -> Map weight (value, [Bool]) + removeDominated m = m2 + where + m2 = Map.fromDistinctAscList . loop (-1) . Map.toAscList $ m + loop _ [] = [] + loop !vmax (x@(_,(v1,_)) : xs) + | vmax < v1 = x : loop v1 xs + | otherwise = loop vmax xs + + splitLE :: Ord k => k -> Map k v -> Map k v + splitLE k m = + case Map.splitLookup k m of + (lo, Nothing, _) -> lo + (lo, Just v, _) -> Map.insert k v lo + +solveInt + :: forall value. (Real value) + => [(value, Int)] + -> Int + -> (value, Int, [Bool]) +solveInt items limit = + case IntMap.findMax table of + (w, (v, sol)) -> (v, w, reverse sol) + where + table :: IntMap (value, [Bool]) + table = foldl' f empty items + + empty :: IntMap (value, [Bool]) + empty = IntMap.singleton 0 (0,[]) + + f :: IntMap (value, [Bool]) -> (value, Int) -> IntMap (value, [Bool]) + f m (vi,wi) + | wi < 0 = error "negative weight" + | vi <= 0 = m0 + | wi == 0 = IntMap.map (\(v,sol) -> (v+vi, True : sol)) m + | otherwise = removeDominated m2 + where + m0 = IntMap.map (\(v,sol) -> (v, False : sol)) m + m1 = splitLE limit $ IntMap.mapKeysMonotonic (+wi) $ IntMap.map (\(v,sol) -> (v+vi, True : sol)) $ m + m2 = IntMap.unionWith (\a@(v1,_) b@(v2,_) -> if v1 < v2 then b else a) m0 m1 + + removeDominated :: IntMap (value, [Bool]) -> IntMap (value, [Bool]) + removeDominated m = m2 + where + m2 = IntMap.fromDistinctAscList . loop (-1) . IntMap.toAscList $ m + loop _ [] = [] + loop !vmax (x@(_,(v1,_)) : xs) + | vmax < v1 = x : loop v1 xs + | otherwise = loop vmax xs + + splitLE :: Int -> IntMap v -> IntMap v + splitLE k m + | k == maxBound = m + | otherwise = + case IntMap.splitLookup (k+1) m of + (lo, _, _) -> lo + +solveInteger + :: forall value. (Real value) + => [(value, Integer)] + -> Integer + -> (value, Integer, [Bool]) +solveInteger items limit + | all (\(_,w) -> w <= maxInt) items' && limit' <= maxInt = + case solveInt [(v, fromIntegral w) | (v,w) <- items'] (fromIntegral limit') of + (v, w, sol) -> (v, fromIntegral w * d, sol) + | otherwise = + case solveGeneric items' limit' of + (v, w, sol) -> (v, w * d, sol) + where + d = if null items then 1 else foldl1' gcd [w | (_v, w) <- items] + items' = [(v, w `div` d) | (v, w) <- items] + limit' = limit `div` d + maxInt = fromIntegral (maxBound :: Int) diff --git a/src/ToySolver/Combinatorial/SubsetSum.hs b/src/ToySolver/Combinatorial/SubsetSum.hs new file mode 100644 --- /dev/null +++ b/src/ToySolver/Combinatorial/SubsetSum.hs @@ -0,0 +1,386 @@ +{-# LANGUAGE ScopedTypeVariables, BangPatterns, FlexibleContexts #-} +{-# OPTIONS_GHC -Wall #-} +----------------------------------------------------------------------------- +-- | +-- Module : ToySolver.Combinatorial.SubsetSum +-- Copyright : (c) Masahiro Sakai 2015 +-- License : BSD-style +-- +-- Maintainer : masahiro.sakai@gmail.com +-- Stability : provisional +-- Portability : non-portable (ScopedTypeVariables, BangPatterns, FlexibleContexts) +-- +-- References +-- +-- * D. Pisinger, "An exact algorithm for large multiple knapsack problems," +-- European Journal of Operational Research, vol. 114, no. 3, pp. 528-541, +-- May 1999. DOI:10.1016/s0377-2217(98)00120-9 +-- +-- +-- +----------------------------------------------------------------------------- +module ToySolver.Combinatorial.SubsetSum + ( Weight + , subsetSum + , maxSubsetSum + , minSubsetSum + ) where + +import Control.Exception (assert) +import Control.Monad +import Control.Monad.ST +import Data.STRef +import Data.IntMap.Strict (IntMap) +import qualified Data.IntMap.Strict as IntMap +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map +import Data.Vector.Generic ((!)) +import qualified Data.Vector as V +import qualified Data.Vector.Generic as VG +import qualified Data.Vector.Generic.Mutable as VM +import qualified Data.Vector.Unboxed as VU + +type Weight = Integer + +-- | Maximize Σ_{i=1}^n wi xi subject to Σ_{i=1}^n wi xi ≤ c and xi ∈ {0,1}. +-- +-- Note: 0 (resp. 1) is identified with False (resp. True) in the assignment. +maxSubsetSum + :: VG.Vector v Weight + => v Weight -- ^ weights @[w1, w2 .. wn]@ + -> Weight -- ^ capacity @c@ + -> Maybe (Weight, VU.Vector Bool) + -- ^ + -- * the objective value Σ_{i=1}^n wi xi, and + -- + -- * the assignment @[x1, x2 .. xn]@, identifying 0 (resp. 1) with @False@ (resp. @True@). +maxSubsetSum w c = + case normalizeWeightsToPositive (w,c) of + (w1, c1, trans1) + | c1 < 0 -> Nothing + | otherwise -> + case normalize2 (w1, c1) of + (w2, c2, trans2) -> + case normalizeGCDLe (w2, c2) of + (w3, c3, trans3) -> + Just $ trans1 $ trans2 $ trans3 $ maxSubsetSum' w3 c3 + +normalizeWeightsToPositive + :: VG.Vector v Weight + => (v Weight, Weight) + -> (V.Vector Weight, Weight, (Weight, VU.Vector Bool) -> (Weight, VU.Vector Bool)) +normalizeWeightsToPositive (w,c) + | VG.all (>=0) w = (VG.convert w, c, id) + | otherwise = runST $ do + w2 <- VM.new (VG.length w) + let loop !i !offset + | i >= VG.length w = return offset + | otherwise = do + let wi = w ! i + if wi < 0 then do + VM.write w2 i (- wi) + loop (i+1) (offset + wi) + else do + VM.write w2 i wi + loop (i+1) offset + offset <- loop 0 (0::Integer) + w2 <- VG.unsafeFreeze w2 + let trans (obj, bs) = (obj + offset, bs2) + where + bs2 = VU.imap (\i bi -> if w ! i < 0 then not bi else bi) bs + return (w2, c - offset, trans) + +normalize2 + :: (V.Vector Weight, Weight) + -> (V.Vector Weight, Weight, (Weight, VU.Vector Bool) -> (Weight, VU.Vector Bool)) +normalize2 (w,c) + | VG.all (\wi -> 0 0 (V.Vector Weight, Weight, (Weight, VU.Vector Bool) -> (Weight, VU.Vector Bool)) +normalizeGCDLe (w,c) + | VG.null w || d == 1 = (w, c, id) + | otherwise = (VG.map (`div` d) w, c `div` d, trans) + where + d = VG.foldl1' gcd w + trans (obj, bs) = (obj * d, bs) + +normalizeGCDEq + :: (V.Vector Weight, Weight) + -> Maybe (V.Vector Weight, Weight, (Weight, VU.Vector Bool) -> (Weight, VU.Vector Bool)) +normalizeGCDEq (w,c) + | VG.null w || d == 1 = Just (w, c, id) + | c `mod` d == 0 = Just (VG.map (`div` d) w, c `div` d, trans) + | otherwise = Nothing + where + d = VG.foldl1' gcd w + trans (obj, bs) = (obj * d, bs) + +maxSubsetSum' :: V.Vector Weight -> Weight -> (Weight, VU.Vector Bool) +maxSubsetSum' !w !c + | wsum <= c = (wsum, VG.replicate (VG.length w) True) + | c <= fromIntegral (maxBound :: Int) = + maxSubsetSumInt' (VG.generate (VG.length w) (\i -> fromIntegral (w VG.! i))) (fromIntegral c) wsum + | otherwise = + maxSubsetSumInteger' w c wsum + where + wsum = VG.sum w + +maxSubsetSumInteger' :: V.Vector Weight -> Weight -> Weight -> (Weight, VU.Vector Bool) +maxSubsetSumInteger' w !c wsum = assert (wbar <= c) $ assert (wbar + (w ! b) > c) $ runST $ do + objRef <- newSTRef (wbar, [], []) + let updateObj gs ft = do + let loop [] _ = return () + loop _ [] = return () + loop xxs@((gobj,gsol):xs) yys@((fobj,fsol):ys) + | c < gobj + fobj = loop xs yys + | otherwise = do + (curr, _, _) <- readSTRef objRef + when (curr < gobj + fobj) $ writeSTRef objRef (gobj + fobj, gsol, fsol) + loop xxs ys + loop (Map.toDescList gs) (Map.toAscList ft) + + let loop !s !t !gs !ft !flag = do + (obj, gsol, fsol) <- readSTRef objRef + if obj == c || (s == 0 && t == n-1) then do + let sol = VG.create $ do + bs <- VM.new n + forM_ [0..b-1] $ \i -> VM.write bs i True + forM_ [b..n-1] $ \i -> VM.write bs i False + forM_ fsol $ \i -> VM.write bs i True + forM_ gsol $ \i -> VM.write bs i False + return bs + return (obj, sol) + else do + let updateF = do + -- Compute f_{t+1} from f_t + let t' = t + 1 + wt' = w ! t' + m = Map.mapKeysMonotonic (+ wt') $ Map.map (t' :) $ splitLE (c - wt') ft + ft' = ft `Map.union` m + updateObj gs m + loop s t' gs ft' (not flag) + updateG = do + -- Compute g_{s-1} from g_s + let s' = s - 1 + ws = w ! s' + m = Map.map (s' :) $ g_drop $ Map.mapKeysMonotonic (subtract ws) $ gs + gs' = gs `Map.union` m + updateObj m ft + loop s' t gs' ft (not flag) + if s == 0 then + updateF + else if t == n-1 then + updateG + else + if flag then updateG else updateF + + let -- f_{b-1} + fb' :: Map Integer [Int] + fb' = Map.singleton 0 [] + -- g_{b} + gb :: Map Integer [Int] + gb = Map.singleton wbar [] + loop b (b-1) gb fb' True + + where + n = VG.length w + + b :: Int + b = loop (-1) 0 + where + loop :: Int -> Integer -> Int + loop !i !s + | s > c = i + | otherwise = loop (i+1) (s + (w ! (i+1))) + + wbar :: Weight + wbar = VG.sum $ VG.slice 0 b w + + max_f :: Weight + max_f = wsum - fromIntegral wbar + + min_g :: Weight + min_g = 0 `max` (c - max_f) + + g_drop :: Map Integer [Int] -> Map Integer [Int] + g_drop g = + case Map.splitLookup min_g g of + (lo, _, _) | Map.null lo -> g + (_, Just v, hi) -> Map.insert min_g v hi + (lo, Nothing, hi) -> + case Map.findMax lo of + (k,v) -> Map.insert k v hi + + splitLE :: Ord k => k -> Map k v -> Map k v + splitLE k m = + case Map.splitLookup k m of + (lo, Nothing, _) -> lo + (lo, Just v, _) -> Map.insert k v lo + +maxSubsetSumInt' :: VU.Vector Int -> Int -> Weight -> (Weight, VU.Vector Bool) +maxSubsetSumInt' w !c wsum = assert (wbar <= c) $ assert (wbar + (w ! b) > c) $ runST $ do + objRef <- newSTRef (wbar, [], []) + let updateObj gs ft = do + let loop [] _ = return () + loop _ [] = return () + loop xxs@((gobj,gsol):xs) yys@((fobj,fsol):ys) + | c < gobj + fobj = loop xs yys + | otherwise = do + (curr, _, _) <- readSTRef objRef + when (curr < gobj + fobj) $ writeSTRef objRef (gobj + fobj, gsol, fsol) + loop xxs ys + loop (IntMap.toDescList gs) (IntMap.toAscList ft) + + let loop !s !t !gs !ft !flag = do + (obj, gsol, fsol) <- readSTRef objRef + if obj == c || (s == 0 && t == n-1) then do + let sol = VG.create $ do + bs <- VM.new n + forM_ [0..b-1] $ \i -> VM.write bs i True + forM_ [b..n-1] $ \i -> VM.write bs i False + forM_ fsol $ \i -> VM.write bs i True + forM_ gsol $ \i -> VM.write bs i False + return bs + return (fromIntegral obj, sol) + else do + let updateF = do + -- Compute f_{t+1} from f_t + let t' = t + 1 + wt' = w ! t' + m = IntMap.mapKeysMonotonic (+ wt') $ IntMap.map (t' :) $ splitLE (c - wt') ft + ft' = ft `IntMap.union` m + updateObj gs m + loop s t' gs ft' (not flag) + updateG = do + -- Compute g_{s-1} from g_s + let s' = s - 1 + ws = w ! s' + m = IntMap.map (s' :) $ g_drop $ IntMap.mapKeysMonotonic (subtract ws) $ gs + gs' = gs `IntMap.union` m + updateObj m ft + loop s' t gs' ft (not flag) + if s == 0 then + updateF + else if t == n-1 then + updateG + else + if flag then updateG else updateF + + let -- f_{b-1} + fb' :: IntMap [Int] + fb' = IntMap.singleton 0 [] + -- g_{b} + gb :: IntMap [Int] + gb = IntMap.singleton wbar [] + loop b (b-1) gb fb' True + + where + n = VG.length w + + b :: Int + b = loop (-1) 0 + where + loop :: Int -> Integer -> Int + loop !i !s + | s > fromIntegral c = i + | otherwise = loop (i+1) (s + fromIntegral (w ! (i+1))) + + wbar :: Int + wbar = VG.sum $ VG.slice 0 b w + + max_f :: Integer + max_f = wsum - fromIntegral wbar + + min_g :: Int + min_g = if max_f < fromIntegral c then c - fromIntegral max_f else 0 + + g_drop :: IntMap [Int] -> IntMap [Int] + g_drop g = + case IntMap.splitLookup min_g g of + (lo, _, _) | IntMap.null lo -> g + (_, Just v, hi) -> IntMap.insert min_g v hi + (lo, Nothing, hi) -> + case IntMap.findMax lo of + (k,v) -> IntMap.insert k v hi + + splitLE :: Int -> IntMap v -> IntMap v + splitLE k m = + case IntMap.splitLookup k m of + (lo, Nothing, _) -> lo + (lo, Just v, _) -> IntMap.insert k v lo + +-- | Minimize Σ_{i=1}^n wi xi subject to Σ_{i=1}^n wi x≥ l and xi ∈ {0,1}. +-- +-- Note: 0 (resp. 1) is identified with False (resp. True) in the assignment. +minSubsetSum + :: VG.Vector v Weight + => v Weight -- ^ weights @[w1, w2 .. wn]@ + -> Weight -- ^ @l@ + -> Maybe (Weight, VU.Vector Bool) + -- ^ + -- * the objective value Σ_{i=1}^n wi xi, and + -- + -- * the assignment @[x1, x2 .. xn]@, identifying 0 (resp. 1) with @False@ (resp. @True@). +minSubsetSum w l = + case maxSubsetSum w (wsum - l) of + Nothing -> Nothing + Just (obj, bs) -> Just (wsum - obj, VG.map not bs) + where + wsum = VG.sum w + +{- +minimize Σ wi xi = Σ wi (1 - ¬xi) = Σ wi - (Σ wi ¬xi) +subject to Σ wi xi ≥ n + +maximize Σ wi ¬xi +subject to Σ wi ¬xi ≤ (Σ wi) - n + +Σ wi xi ≥ n +Σ wi (1 - ¬xi) ≥ n +(Σ wi) - (Σ wi ¬xi) ≥ n +(Σ wi ¬xi) ≤ (Σ wi) - n +-} + +-- | Solve Σ_{i=1}^n wi x = c and xi ∈ {0,1}. +-- +-- Note that this is different from usual definition of the subset sum problem, +-- as this definition allows all xi to be zero. +-- +-- Note: 0 (resp. 1) is identified with False (resp. True) in the assignment. +subsetSum + :: VG.Vector v Weight + => v Weight -- ^ weights @[w1, w2 .. wn]@ + -> Weight -- ^ @l@ + -> Maybe (VU.Vector Bool) + -- ^ + -- the assignment @[x1, x2 .. xn]@, identifying 0 (resp. 1) with @False@ (resp. @True@). +subsetSum w c = + case normalizeWeightsToPositive (w,c) of + (w1, c1, trans1) + | c1 < 0 -> Nothing + | otherwise -> + case normalize2 (w1, c1) of + (w2, c2, trans2) -> do + (w3, c3, trans3) <- normalizeGCDEq (w2,c2) + let (obj, sol) = maxSubsetSum' w3 c3 + guard $ obj == c3 + return $ snd $ trans1 $ trans2 $ trans3 (obj, sol) diff --git a/src/ToySolver/CongruenceClosure.hs b/src/ToySolver/CongruenceClosure.hs deleted file mode 100644 --- a/src/ToySolver/CongruenceClosure.hs +++ /dev/null @@ -1,188 +0,0 @@ -{-# OPTIONS_GHC -Wall #-} ------------------------------------------------------------------------------ --- | --- Module : ToySolver.CongruenceClosure --- Copyright : (c) Masahiro Sakai 2012 --- License : BSD-style --- --- Maintainer : masahiro.sakai@gmail.com --- Stability : provisional --- Portability : portable --- --- References: --- --- * R. Nieuwenhuis and A. Oliveras, "Fast congruence closure and extensions," --- Information and Computation, vol. 205, no. 4, pp. 557-580, Apr. 2007. --- --- ------------------------------------------------------------------------------ -module ToySolver.CongruenceClosure - ( Solver - , Var - , FlatTerm (..) - , newSolver - , newVar - , merge - , areCongruent - ) where - -import Prelude hiding (lookup) - -import Control.Monad -import Data.IORef -import Data.Maybe -import Data.IntMap (IntMap) -import qualified Data.IntMap as IntMap - -type Var = Int - -data FlatTerm - = FTConst Var - | FTApp Var Var - deriving (Ord, Eq, Show) - -type Eqn1 = (FlatTerm, Var) -type PendingEqn = Either (Var,Var) (Eqn1, Eqn1) - -data Solver - = Solver - { svVarCounter :: IORef Int - , svPending :: IORef [PendingEqn] - , svRepresentativeTable :: IORef (IntMap Var) -- 本当は配列が良い - , svClassList :: IORef (IntMap [Var]) - , svUseList :: IORef (IntMap [Eqn1]) - , svLookupTable :: IORef (IntMap (IntMap Eqn1)) - } - -newSolver :: IO Solver -newSolver = do - vcnt <- newIORef 0 - pending <- newIORef [] - rep <- newIORef IntMap.empty - classes <- newIORef IntMap.empty - useList <- newIORef IntMap.empty - lookup <- newIORef IntMap.empty - return $ - Solver - { svVarCounter = vcnt - , svPending = pending - , svRepresentativeTable = rep - , svClassList = classes - , svUseList = useList - , svLookupTable = lookup - } - -newVar :: Solver -> IO Var -newVar solver = do - v <- readIORef (svVarCounter solver) - writeIORef (svVarCounter solver) $! v + 1 - modifyIORef (svRepresentativeTable solver) (IntMap.insert v v) - modifyIORef (svClassList solver) (IntMap.insert v [v]) - modifyIORef (svUseList solver) (IntMap.insert v []) - return v - -merge :: Solver -> (FlatTerm, Var) -> IO () -merge solver (s, a) = do - case s of - FTConst c -> do - addToPending solver (Left (c, a)) - propagate solver - FTApp a1 a2 -> do - a1' <- getRepresentative solver a1 - a2' <- getRepresentative solver a2 - ret <- lookup solver a1' a2' - case ret of - Just (FTApp b1 b2, b) -> do - addToPending solver $ Right ((FTApp a1 a2, a), (FTApp b1 b2, b)) - propagate solver - Nothing -> do - setLookup solver a1' a2' (FTApp a1 a2, a) - modifyIORef (svUseList solver) $ - IntMap.alter (Just . ((FTApp a1 a2, a) :) . fromMaybe []) a1' . - IntMap.alter (Just . ((FTApp a1 a2, a) :) . fromMaybe []) a2' - -propagate :: Solver -> IO () -propagate solver = go - where - go = do - ps <- readIORef (svPending solver) - case ps of - [] -> return () - (p:ps') -> do - writeIORef (svPending solver) ps' - processEqn p - go - - processEqn p = do - let (a,b) = case p of - Left (a,b) -> (a,b) - Right ((_, a), (_, b)) -> (a,b) - a' <- getRepresentative solver a - b' <- getRepresentative solver b - if a' == b' - then return () - else do - clist <- readIORef (svClassList solver) - let classA = clist IntMap.! a' - classB = clist IntMap.! b' - if length classA < length classB - then update a' b' classA classB - else update b' a' classB classA - - update a' b' classA classB = do - modifyIORef (svRepresentativeTable solver) $ - IntMap.union (IntMap.fromList [(c,b') | c <- classA]) - modifyIORef (svClassList solver) $ - IntMap.insert b' (classA ++ classB) . IntMap.delete a' - - useList <- readIORef (svUseList solver) - forM_ (useList IntMap.! a') $ \(FTApp c1 c2, c) -> do -- FIXME: not exhaustive - c1' <- getRepresentative solver c1 - c2' <- getRepresentative solver c2 - ret <- lookup solver c1' c2' - case ret of - Just (FTApp d1 d2, d) -> do -- FIXME: not exhaustive - addToPending solver $ Right ((FTApp c1 c2, c), (FTApp d1 d2, d)) - Nothing -> do - return () - writeIORef (svUseList solver) $ IntMap.delete a' useList - -areCongruent :: Solver -> FlatTerm -> FlatTerm -> IO Bool -areCongruent solver t1 t2 = do - u1 <- normalize solver t1 - u2 <- normalize solver t2 - return $ u1 == u2 - -normalize :: Solver -> FlatTerm -> IO FlatTerm -normalize solver (FTConst c) = liftM FTConst $ getRepresentative solver c -normalize solver (FTApp t1 t2) = do - u1 <- getRepresentative solver t1 - u2 <- getRepresentative solver t2 - ret <- lookup solver u1 u2 - case ret of - Just (FTApp _ _, a) -> liftM FTConst $ getRepresentative solver a - Nothing -> return $ FTApp u1 u2 - -{-------------------------------------------------------------------- - Helper funcions ---------------------------------------------------------------------} - -lookup :: Solver -> Var -> Var -> IO (Maybe Eqn1) -lookup solver c1 c2 = do - tbl <- readIORef $ svLookupTable solver - return $ do - m <- IntMap.lookup c1 tbl - IntMap.lookup c2 m - -setLookup :: Solver -> Var -> Var -> Eqn1 -> IO () -setLookup solver a1 a2 eqn = do - modifyIORef (svLookupTable solver) $ - IntMap.insertWith IntMap.union a1 (IntMap.singleton a2 eqn) - -addToPending :: Solver -> PendingEqn -> IO () -addToPending solver eqn = modifyIORef (svPending solver) (eqn :) - -getRepresentative :: Solver -> Var -> IO Var -getRepresentative solver c = do - m <- readIORef $ svRepresentativeTable solver - return $ m IntMap.! c diff --git a/src/ToySolver/Converter/MIP2SMT.hs b/src/ToySolver/Converter/MIP2SMT.hs --- a/src/ToySolver/Converter/MIP2SMT.hs +++ b/src/ToySolver/Converter/MIP2SMT.hs @@ -13,7 +13,6 @@ module ToySolver.Converter.MIP2SMT ( convert , Options (..) - , defaultOptions , Language (..) , YicesVersion (..) ) where @@ -32,6 +31,9 @@ import qualified ToySolver.Data.MIP as MIP import ToySolver.Internal.Util (showRationalAsFiniteDecimal, isInteger) +-- | Translation options. +-- +-- The default option can be obtained by 'def'. data Options = Options { optLanguage :: Language @@ -43,17 +45,14 @@ deriving (Show, Eq, Ord) instance Default Options where - def = defaultOptions - -defaultOptions :: Options -defaultOptions - = Options - { optLanguage = SMTLIB2 - , optSetLogic = Nothing - , optCheckSAT = True - , optProduceModel = True - , optOptimize = False - } + def = + Options + { optLanguage = SMTLIB2 + , optSetLogic = Nothing + , optCheckSAT = True + , optProduceModel = True + , optOptimize = False + } data Language = SMTLIB2 @@ -93,11 +92,11 @@ not' x = list [showString "not", x] intExpr :: Options -> Env -> MIP.Problem -> MIP.Expr -> ShowS -intExpr opt env mip e = - case e of +intExpr opt env _mip e = + case MIP.terms e of [] -> intNum opt 0 [t] -> f t - _ -> list (showChar '+' : map f e) + ts -> list (showChar '+' : map f ts) where f (MIP.Term c _) | not (isInteger c) = error ("ToySolver.Converter.MIP2SMT.intExpr: fractional coefficient: " ++ show c) @@ -114,10 +113,10 @@ realExpr :: Options -> Env -> MIP.Problem -> MIP.Expr -> ShowS realExpr opt env mip e = - case e of + case MIP.terms e of [] -> realNum opt 0 [t] -> f t - _ -> list (showChar '+' : map f e) + ts -> list (showChar '+' : map f ts) where f (MIP.Term c []) = realNum opt c f (MIP.Term (-1) vs) = list [showChar '-', f (MIP.Term 1 vs)] @@ -163,10 +162,24 @@ Just s -> showString s Nothing -> list [showChar '/', shows (numerator r) . showString ".0", shows (denominator r) . showString ".0"] +rel2 :: Options -> Env -> MIP.Problem -> Bool -> MIP.BoundExpr -> MIP.Expr -> MIP.BoundExpr -> ShowS +rel2 opt env mip q lb e ub = and' (c1 ++ c2) + where + c1 = + case lb of + MIP.NegInf -> [] + MIP.Finite x -> [rel opt env mip q MIP.Ge e x] + MIP.PosInf -> [showString "false"] + c2 = + case ub of + MIP.NegInf -> [showString "false"] + MIP.Finite x -> [rel opt env mip q MIP.Le e x] + MIP.PosInf -> [] + rel :: Options -> Env -> MIP.Problem -> Bool -> MIP.RelOp -> MIP.Expr -> Rational -> ShowS rel opt env mip q op lhs rhs | and [isInt mip v | v <- Set.toList (MIP.vars lhs)] && - and [isInteger c | MIP.Term c _ <- lhs] && isInteger rhs = + and [isInteger c | MIP.Term c _ <- MIP.terms lhs] && isInteger rhs = f q op (intExpr opt env mip lhs) (intNum opt (floor rhs)) | otherwise = f q op (realExpr opt env mip lhs) (realNum opt rhs) @@ -200,15 +213,17 @@ MIP.Constraint { MIP.constrLabel = label , MIP.constrIndicator = g - , MIP.constrBody = (e, op, b) + , MIP.constrExpr = e + , MIP.constrLB = lb + , MIP.constrUB = ub } = (c1, label) where - c0 = rel opt env mip q op e b + c0 = rel2 opt env mip q lb e ub c1 = case g of Nothing -> c0 Just (var,val) -> list [ showString "=>" - , rel opt env mip q MIP.Eql [MIP.Term 1 [var]] val + , rel opt env mip q MIP.Eql (MIP.varExpr var) val , c0 ] @@ -317,7 +332,7 @@ SMTLIB2 -> "Int" YICES _ -> "int" ts = [(v, realType) | v <- Set.toList real_vs] ++ [(v, intType) | v <- Set.toList int_vs] - obj = snd (MIP.objectiveFunction mip) + obj = MIP.objectiveFunction mip env = Map.fromList [(v, encode opt (MIP.fromVar v)) | v <- Set.toList vs] -- Note that identifiers of LPFile does not contain '-'. -- So that there are no name crash. @@ -351,8 +366,8 @@ YICES _ -> list [showString $ printf "%s::%s" (env2 Map.! v) t | (v,t) <- ts] body = list [showString "=>" , and' (map fst (conditions opt True env2 mip)) - , list [ showString $ if MIP.dir mip == MIP.OptMin then "<=" else ">=" - , realExpr opt env mip obj, realExpr opt env2 mip obj + , list [ showString $ if MIP.objDir obj == MIP.OptMin then "<=" else ">=" + , realExpr opt env mip (MIP.objExpr obj), realExpr opt env2 mip (MIP.objExpr obj) ] ] diff --git a/src/ToySolver/Converter/PB2IP.hs b/src/ToySolver/Converter/PB2IP.hs --- a/src/ToySolver/Converter/PB2IP.hs +++ b/src/ToySolver/Converter/PB2IP.hs @@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : ToySolver.Converter.PB2IP --- Copyright : (c) Masahiro Sakai 2011-2014 +-- Copyright : (c) Masahiro Sakai 2011-2015 -- License : BSD-style -- -- Maintainer : masahiro.sakai@gmail.com @@ -16,73 +16,48 @@ ) where import Data.Array.IArray -import Data.List +import Data.Default.Class import Data.Maybe import Data.Map (Map) import qualified Data.Map as Map import qualified Data.PseudoBoolean as PBFile import qualified ToySolver.Data.MIP as MIP +import ToySolver.Data.MIP ((.==.), (.<=.), (.>=.)) import qualified ToySolver.SAT.Types as SAT convert :: PBFile.Formula -> (MIP.Problem, Map MIP.Var Rational -> SAT.Model) convert formula = (mip, mtrans (PBFile.pbNumVars formula)) where - mip = MIP.Problem - { MIP.dir = dir - , MIP.objectiveFunction = (Nothing, obj2) + mip = def + { MIP.objectiveFunction = obj2 , MIP.constraints = cs2 - , MIP.sosConstraints = [] - , MIP.userCuts = [] - , MIP.varInfo = Map.fromList - [ ( v - , MIP.VarInfo - { MIP.varType = MIP.IntegerVariable - , MIP.varBounds = (0, 1) - } - ) - | v <- vs - ] + , MIP.varType = Map.fromList [(v, MIP.IntegerVariable) | v <- vs] + , MIP.varBounds = Map.fromList [(v, (0,1)) | v <- vs] } vs = [convVar v | v <- [1..PBFile.pbNumVars formula]] - (dir,obj2) = + obj2 = case PBFile.pbObjectiveFunction formula of - Just obj' -> (MIP.OptMin, convExpr obj') - Nothing -> (MIP.OptMin, convExpr []) + Just obj' -> def{ MIP.objDir = MIP.OptMin, MIP.objExpr = convExpr obj' } + Nothing -> def{ MIP.objDir = MIP.OptMin, MIP.objExpr = 0 } cs2 = do (lhs,op,rhs) <- PBFile.pbConstraints formula - let op2 = case op of - PBFile.Ge -> MIP.Ge - PBFile.Eq -> MIP.Eql - lhs2 = convExpr lhs - lhs3a = [t | t@(MIP.Term _ (_:_)) <- lhs2] - lhs3b = sum [c | MIP.Term c [] <- lhs2] - return $ MIP.Constraint - { MIP.constrLabel = Nothing - , MIP.constrIndicator = Nothing - , MIP.constrIsLazy = False - , MIP.constrBody = (lhs3a, op2, fromIntegral rhs - lhs3b) - } + let (lhs2,c) = splitConst $ convExpr lhs + rhs2 = fromIntegral rhs - c + return $ case op of + PBFile.Ge -> def{ MIP.constrExpr = lhs2, MIP.constrLB = MIP.Finite rhs2 } + PBFile.Eq -> def{ MIP.constrExpr = lhs2, MIP.constrLB = MIP.Finite rhs2, MIP.constrUB = MIP.Finite rhs2 } convExpr :: PBFile.Sum -> MIP.Expr -convExpr s = concatMap g2 s +convExpr s = sum [product (fromIntegral w : map f tm) | (w,tm) <- s] where - g2 :: PBFile.WeightedTerm -> MIP.Expr - g2 (w, tm) = foldl' prodE [MIP.Term (fromIntegral w) []] (map g3 tm) - - g3 :: PBFile.Lit -> MIP.Expr - g3 x - | x > 0 = [MIP.Term 1 [convVar x]] - | otherwise = [MIP.Term 1 [], MIP.Term (-1) [convVar (abs x)]] - - prodE :: MIP.Expr -> MIP.Expr -> MIP.Expr - prodE e1 e2 = [prodT t1 t2 | t1 <- e1, t2 <- e2] - - prodT :: MIP.Term -> MIP.Term -> MIP.Term - prodT (MIP.Term c1 vs1) (MIP.Term c2 vs2) = MIP.Term (c1*c2) (vs1++vs2) + f :: PBFile.Lit -> MIP.Expr + f x + | x > 0 = MIP.varExpr (convVar x) + | otherwise = 1 - MIP.varExpr (convVar (abs x)) convVar :: PBFile.Var -> MIP.Var convVar x = MIP.toVar ("x" ++ show x) @@ -90,94 +65,69 @@ convertWBO :: Bool -> PBFile.SoftFormula -> (MIP.Problem, Map MIP.Var Rational -> SAT.Model) convertWBO useIndicator formula = (mip, mtrans (PBFile.wboNumVars formula)) where - mip = MIP.Problem - { MIP.dir = MIP.OptMin - , MIP.objectiveFunction = (Nothing, obj2) + mip = def + { MIP.objectiveFunction = obj2 , MIP.constraints = topConstr ++ map snd cs2 - , MIP.sosConstraints = [] - , MIP.userCuts = [] - , MIP.varInfo = Map.fromList - [ ( v - , MIP.VarInfo - { MIP.varType = MIP.IntegerVariable - , MIP.varBounds = (0, 1) - } - ) - | v <- vs - ] + , MIP.varType = Map.fromList [(v, MIP.IntegerVariable) | v <- vs] + , MIP.varBounds = Map.fromList [(v, (0,1)) | v <- vs] } vs = [convVar v | v <- [1..PBFile.wboNumVars formula]] ++ [v | (ts, _) <- cs2, (_, v) <- ts] - obj2 = [MIP.Term (fromIntegral w) [v] | (ts, _) <- cs2, (w, v) <- ts] + obj2 = def + { MIP.objDir = MIP.OptMin + , MIP.objExpr = MIP.Expr [MIP.Term (fromIntegral w) [v] | (ts, _) <- cs2, (w, v) <- ts] + } topConstr :: [MIP.Constraint] topConstr = case PBFile.wboTopCost formula of Nothing -> [] Just t -> - [ MIP.Constraint - { MIP.constrLabel = Nothing - , MIP.constrIndicator = Nothing - , MIP.constrIsLazy = False - , MIP.constrBody = (obj2, MIP.Le, fromInteger t - 1) - } - ] + [ def{ MIP.constrExpr = MIP.objExpr obj2, MIP.constrUB = MIP.Finite (fromInteger t - 1) } ] cs2 :: [([(Integer, MIP.Var)], MIP.Constraint)] cs2 = do (n, (w, (lhs,op,rhs))) <- zip [(0::Int)..] (PBFile.wboConstraints formula) - let - lhs2 = convExpr lhs - lhs3 = [t | t@(MIP.Term _ (_:_)) <- lhs2] - rhs3 = fromIntegral rhs - sum [c | MIP.Term c [] <- lhs2] + let (lhs2,c) = splitConst $ convExpr lhs + rhs2 = fromIntegral rhs - c v = MIP.toVar ("r" ++ show n) (ts,ind) = case w of Nothing -> ([], Nothing) Just w2 -> ([(w2,v)], Just (v,0)) if isNothing w || useIndicator then do - let op2 = + let c = case op of - PBFile.Ge -> MIP.Ge - PBFile.Eq -> MIP.Eql - c = MIP.Constraint - { MIP.constrLabel = Nothing - , MIP.constrIndicator = ind - , MIP.constrIsLazy = False - , MIP.constrBody = (lhs3, op2, rhs3) - } + PBFile.Ge -> (lhs2 .>=. MIP.constExpr rhs2) { MIP.constrIndicator = ind } + PBFile.Eq -> (lhs2 .==. MIP.constExpr rhs2) { MIP.constrIndicator = ind } return (ts, c) - else do - let (lhsGE,rhsGE) = relaxGE v (lhs3,rhs3) - c1 = MIP.Constraint - { MIP.constrLabel = Nothing - , MIP.constrIndicator = Nothing - , MIP.constrIsLazy = False - , MIP.constrBody = (lhsGE, MIP.Ge, rhsGE) - } + else do + let (lhsGE,rhsGE) = relaxGE v (lhs2,rhs2) + c1 = lhsGE .>=. MIP.constExpr rhsGE case op of PBFile.Ge -> do return (ts, c1) PBFile.Eq -> do - let (lhsLE,rhsLE) = relaxLE v (lhs3,rhs3) - c2 = MIP.Constraint - { MIP.constrLabel = Nothing - , MIP.constrIndicator = Nothing - , MIP.constrIsLazy = False - , MIP.constrBody = (lhsLE, MIP.Le, rhsLE) - } + let (lhsLE,rhsLE) = relaxLE v (lhs2,rhs2) + c2 = lhsLE .<=. MIP.constExpr rhsLE [ (ts, c1), ([], c2) ] +splitConst :: MIP.Expr -> (MIP.Expr, Rational) +splitConst e = (e2, c) + where + e2 = MIP.Expr [t | t@(MIP.Term _ (_:_)) <- MIP.terms e] + c = sum [c | MIP.Term c [] <- MIP.terms e] + relaxGE :: MIP.Var -> (MIP.Expr, Rational) -> (MIP.Expr, Rational) -relaxGE v (lhs, rhs) = (MIP.Term (rhs - lhs_lb) [v] : lhs, rhs) +relaxGE v (lhs, rhs) = (MIP.constExpr (rhs - lhs_lb) * MIP.varExpr v + lhs, rhs) where - lhs_lb = sum [min c 0 | MIP.Term c _ <- lhs] + lhs_lb = sum [min c 0 | MIP.Term c _ <- MIP.terms lhs] relaxLE :: MIP.Var -> (MIP.Expr, Rational) -> (MIP.Expr, Rational) -relaxLE v (lhs, rhs) = (MIP.Term (rhs - lhs_ub) [v] : lhs, rhs) +relaxLE v (lhs, rhs) = (MIP.constExpr (rhs - lhs_ub) * MIP.varExpr v + lhs, rhs) where - lhs_ub = sum [max c 0 | MIP.Term c _ <- lhs] + lhs_ub = sum [max c 0 | MIP.Term c _ <- MIP.terms lhs] mtrans :: Int -> Map MIP.Var Rational -> SAT.Model mtrans nvar m = diff --git a/src/ToySolver/Data/ArithRel.hs b/src/ToySolver/Data/ArithRel.hs deleted file mode 100644 --- a/src/ToySolver/Data/ArithRel.hs +++ /dev/null @@ -1,138 +0,0 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FunctionalDependencies #-} ------------------------------------------------------------------------------ --- | --- Module : ToySolver.Data.ArithRel --- Copyright : (c) Masahiro Sakai 2011 --- License : BSD-style --- --- Maintainer : masahiro.sakai@gmail.com --- Stability : provisional --- Portability : non-portable (FlexibleInstances, MultiParamTypeClasses, FunctionalDependencies) --- --- Arithmetic relations --- ------------------------------------------------------------------------------ -module ToySolver.Data.ArithRel - ( - -- * Relational operators - RelOp (..) - , flipOp - , negOp - , showOp - , evalOp - - -- * Relation - , ArithRel (..) - , fromArithRel - - -- * DSL - , IsArithRel (..) - , (.<.), (.<=.), (.>=.), (.>.), (.==.), (./=.) - ) where - -import qualified Data.IntSet as IS - -import ToySolver.Data.Boolean -import ToySolver.Data.Var - -infix 4 .<., .<=., .>=., .>., .==., ./=. - --- --------------------------------------------------------------------------- - --- | relational operators -data RelOp = Lt | Le | Ge | Gt | Eql | NEq - deriving (Show, Eq, Ord) - - --- | flipping relational operator --- --- @rel (flipOp op) a b@ is equivalent to @rel op b a@ -flipOp :: RelOp -> RelOp -flipOp Le = Ge -flipOp Ge = Le -flipOp Lt = Gt -flipOp Gt = Lt -flipOp Eql = Eql -flipOp NEq = NEq - --- | negating relational operator --- --- @rel (negOp op) a b@ is equivalent to @notB (rel op a b)@ -negOp :: RelOp -> RelOp -negOp Lt = Ge -negOp Le = Gt -negOp Ge = Lt -negOp Gt = Le -negOp Eql = NEq -negOp NEq = Eql - --- | operator symbol -showOp :: RelOp -> String -showOp Lt = "<" -showOp Le = "<=" -showOp Ge = ">=" -showOp Gt = ">" -showOp Eql = "=" -showOp NEq = "/=" - --- | evaluate an operator into a comparision function -evalOp :: Ord a => RelOp -> a -> a -> Bool -evalOp Lt = (<) -evalOp Le = (<=) -evalOp Ge = (>=) -evalOp Gt = (>) -evalOp Eql = (==) -evalOp NEq = (/=) - --- --------------------------------------------------------------------------- - --- | type class for constructing relational formula -class IsArithRel e r | r -> e where - arithRel :: RelOp -> e -> e -> r - --- | constructing relational formula -(.<.) :: IsArithRel e r => e -> e -> r -a .<. b = arithRel Lt a b - --- | constructing relational formula -(.<=.) :: IsArithRel e r => e -> e -> r -a .<=. b = arithRel Le a b - --- | constructing relational formula -(.>.) :: IsArithRel e r => e -> e -> r -a .>. b = arithRel Gt a b - --- | constructing relational formula -(.>=.) :: IsArithRel e r => e -> e -> r -a .>=. b = arithRel Ge a b - --- | constructing relational formula -(.==.) :: IsArithRel e r => e -> e -> r -a .==. b = arithRel Eql a b - --- | constructing relational formula -(./=.) :: IsArithRel e r => e -> e -> r -a ./=. b = arithRel NEq a b - --- --------------------------------------------------------------------------- - --- | Atomic formula -data ArithRel e = ArithRel e RelOp e - deriving (Show, Eq, Ord) - -instance Complement (ArithRel c) where - notB (ArithRel lhs op rhs) = ArithRel lhs (negOp op) rhs - -instance IsArithRel e (ArithRel e) where - arithRel op a b = ArithRel a op b - -instance Variables e => Variables (ArithRel e) where - vars (ArithRel a _ b) = vars a `IS.union` vars b - -instance Functor ArithRel where - fmap f (ArithRel a op b) = ArithRel (f a) op (f b) - -fromArithRel :: IsArithRel e r => ArithRel e -> r -fromArithRel (ArithRel a op b) = arithRel op a b - --- --------------------------------------------------------------------------- diff --git a/src/ToySolver/Data/BoolExpr.hs b/src/ToySolver/Data/BoolExpr.hs --- a/src/ToySolver/Data/BoolExpr.hs +++ b/src/ToySolver/Data/BoolExpr.hs @@ -1,14 +1,14 @@ -{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses #-} {-# OPTIONS_GHC -Wall #-} ----------------------------------------------------------------------------- -- | -- Module : ToySolver.Data.BoolExpr --- Copyright : (c) Masahiro Sakai 2014 +-- Copyright : (c) Masahiro Sakai 2014-2015 -- License : BSD-style -- -- Maintainer : masahiro.sakai@gmail.com -- Stability : provisional --- Portability : portable +-- Portability : non-portable (MultiParamTypeClasses, DeriveDataTypeable) -- -- Boolean expression over a given type of atoms -- @@ -92,10 +92,12 @@ andB = And orB = Or +instance IfThenElse (BoolExpr a) (BoolExpr a) where + ite = ITE + instance Boolean (BoolExpr a) where (.=>.) = Imply (.<=>.) = Equiv - ite = ITE instance Variables a => Variables (BoolExpr a) where vars = foldMap vars @@ -141,6 +143,12 @@ f (And zs) = zs f z = [z] +instance IfThenElse (Simplify a) (Simplify a) where + ite (Simplify c) (Simplify t) (Simplify e) + | isTrue c = Simplify t + | isFalse c = Simplify e + | otherwise = Simplify (ITE c t e) + instance Boolean (Simplify a) where Simplify x .=>. Simplify y | isFalse x = true @@ -148,10 +156,6 @@ | isTrue x = Simplify y | isFalse y = notB (Simplify x) | otherwise = Simplify (x .=>. y) - ite (Simplify c) (Simplify t) (Simplify e) - | isTrue c = Simplify t - | isFalse c = Simplify e - | otherwise = Simplify (ITE c t e) isTrue :: BoolExpr a -> Bool isTrue (And []) = True diff --git a/src/ToySolver/Data/Boolean.hs b/src/ToySolver/Data/Boolean.hs --- a/src/ToySolver/Data/Boolean.hs +++ b/src/ToySolver/Data/Boolean.hs @@ -1,13 +1,14 @@ +{-# LANGUAGE MultiParamTypeClasses #-} {-# OPTIONS_GHC -Wall #-} ----------------------------------------------------------------------------- -- | -- Module : ToySolver.Data.Boolean --- Copyright : (c) Masahiro Sakai 2012-2014 +-- Copyright : (c) Masahiro Sakai 2012-2015 -- License : BSD-style -- -- Maintainer : masahiro.sakai@gmail.com -- Stability : provisional --- Portability : portable +-- Portability : non-portable (MultiParamTypeClasses) -- -- Type classes for lattices and boolean algebras. -- @@ -17,6 +18,8 @@ -- * Boolean algebra MonotoneBoolean (..) , Complement (..) + , IfThenElse (..) + , iteBoolean , Boolean (..) ) where @@ -52,14 +55,18 @@ class Complement a where notB :: a -> a +class IfThenElse b a where + ite :: b -> a -> a -> a + +iteBoolean :: Boolean a => a -> a -> a -> a +iteBoolean c t e = (c .&&. t) .||. (notB c .&&. e) + -- | types that can be combined with boolean operations. -class (MonotoneBoolean a, Complement a) => Boolean a where +class (MonotoneBoolean a, Complement a, IfThenElse a a) => Boolean a where (.=>.), (.<=>.) :: a -> a -> a - ite :: a -> a -> a -> a x .=>. y = notB x .||. y x .<=>. y = (x .=>. y) .&&. (y .=>. x) - ite c t e = (c .&&. t) .||. (notB c .&&. e) instance (Complement a, Complement b) => Complement (a, b) where @@ -73,10 +80,12 @@ andB = (andB *** andB) . unzip orB = (orB *** orB) . unzip +instance (Boolean a, Boolean b) => IfThenElse (a, b) (a, b) where + ite (c1,c2) (t1,t2) (e1,e2) = (ite c1 t1 e1, ite c2 t2 e2) + instance (Boolean a, Boolean b) => Boolean (a, b) where (xs1,ys1) .=>. (xs2,ys2) = (xs1 .=>. xs2, ys1 .=>. ys2) (xs1,ys1) .<=>. (xs2,ys2) = (xs1 .<=>. xs2, ys1 .<=>. ys2) - ite (c1,c2) (t1,t2) (e1,e2) = (ite c1 t1 e1, ite c2 t2 e2) instance Complement a => Complement (b -> a) where notB f = \x -> notB (f x) @@ -89,10 +98,12 @@ andB fs = \x -> andB [f x | f <- fs] orB fs = \x -> orB [f x | f <- fs] +instance (Boolean a) => IfThenElse (b -> a) (b -> a) where + ite c t e = \x -> ite (c x) (t x) (e x) + instance (Boolean a) => Boolean (b -> a) where f .=>. g = \x -> f x .=>. g x f .<=>. g = \x -> f x .<=>. g x - ite c t e = \x -> ite (c x) (t x) (e x) instance Complement Bool where @@ -104,7 +115,8 @@ (.&&.) = (&&) (.||.) = (||) -instance Boolean Bool where - (.<=>.) = (==) +instance IfThenElse Bool Bool where ite c t e = if c then t else e +instance Boolean Bool where + (.<=>.) = (==) diff --git a/src/ToySolver/Data/DNF.hs b/src/ToySolver/Data/DNF.hs --- a/src/ToySolver/Data/DNF.hs +++ b/src/ToySolver/Data/DNF.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : ToySolver.Data.DNF @@ -32,5 +33,7 @@ DNF xs .||. DNF ys = DNF (xs++ys) DNF xs .&&. DNF ys = DNF [x++y | x<-xs, y<-ys] -instance Complement lit => Boolean (DNF lit) +instance Complement lit => IfThenElse (DNF lit) (DNF lit) where + ite = iteBoolean +instance Complement lit => Boolean (DNF lit) diff --git a/src/ToySolver/Data/Delta.hs b/src/ToySolver/Data/Delta.hs --- a/src/ToySolver/Data/Delta.hs +++ b/src/ToySolver/Data/Delta.hs @@ -72,6 +72,44 @@ type Scalar (Delta r) = r c *^ Delta r k = Delta (c*r) (c*k) +-- | This instance assumes the symbolic infinitesimal parameter δ is a nilpotent with δ² = 0. +instance (Num r, Ord r) => Num (Delta r) where + (+) = (^+^) + negate = negateV + Delta r1 k1 * Delta r2 k2 = Delta (r1*r2) (r1*k2+r2*k1) + abs x = + case x `compare` 0 of + LT -> negateV x + EQ -> x + GT -> x + signum x = + case x `compare` 0 of + LT -> -1 + EQ -> 0 + GT -> 1 + fromInteger x = Delta (fromInteger x) 0 + +-- | This is unsafe instance in the sense that only a proper real can be a divisor. +instance (Fractional r, Ord r) => Fractional (Delta r) where + Delta r1 k1 / Delta r2 0 = Delta (r1 / r2) (k1 / r2) + Delta r1 k1 / Delta r2 k2 = + error "Fractional{ToySolver.Data.Delta.Delta}.(/): divisor must be a proper real" + fromRational x = Delta (fromRational x) 0 + +instance (Real r, Eq r) => Real (Delta r) where + toRational (Delta r 0) = toRational r + toRational (Delta r k) = + error "Real{ToySolver.Data.Delta.Delta}.toRational: not a real number" + +instance (RealFrac r, Eq r) => RealFrac (Delta r) where + properFraction x = + case x `compare` 0 of + LT -> let n = ceiling' x in (n, x - fromIntegral n) + EQ -> (0, 0) + GT -> let n = floor' x in (n, x - fromIntegral n) + ceiling = ceiling' + floor = floor' + -- | 'Delta' version of 'floor'. -- @'floor'' x@ returns the greatest integer not greater than @x@ floor' :: (RealFrac r, Integral a) => Delta r -> a diff --git a/src/ToySolver/Data/FOL/Arith.hs b/src/ToySolver/Data/FOL/Arith.hs --- a/src/ToySolver/Data/FOL/Arith.hs +++ b/src/ToySolver/Data/FOL/Arith.hs @@ -20,7 +20,7 @@ , evalExpr -- * Atomic formula - , module ToySolver.Data.ArithRel + , module ToySolver.Data.OrdRel , Atom (..) , evalAtom @@ -35,7 +35,7 @@ import qualified Data.IntSet as IS import Data.Ratio -import ToySolver.Data.ArithRel +import ToySolver.Data.OrdRel import ToySolver.Data.FOL.Formula import ToySolver.Data.Var @@ -96,13 +96,17 @@ -- --------------------------------------------------------------------------- -- | Atomic formula -type Atom c = ArithRel (Expr c) +type Atom c = OrdRel (Expr c) evalAtom :: (Real r, Fractional r) => Model r -> Atom r -> Bool -evalAtom m (ArithRel a op b) = evalOp op (evalExpr m a) (evalExpr m b) +evalAtom m (OrdRel a op b) = evalOp op (evalExpr m a) (evalExpr m b) -instance IsArithRel (Expr c) (Formula (Atom c)) where - arithRel op a b = Atom (arithRel op a b) +instance IsEqRel (Expr c) (Formula (Atom c)) where + a .==. b = Atom (a .==. b) + a ./=. b = Atom (a ./=. b) + +instance IsOrdRel (Expr c) (Formula (Atom c)) where + ordRel op a b = Atom (ordRel op a b) -- --------------------------------------------------------------------------- diff --git a/src/ToySolver/Data/FOL/Formula.hs b/src/ToySolver/Data/FOL/Formula.hs --- a/src/ToySolver/Data/FOL/Formula.hs +++ b/src/ToySolver/Data/FOL/Formula.hs @@ -1,7 +1,8 @@ +{-# LANGUAGE MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : ToySolver.Data.FOL.Formula --- Copyright : (c) Masahiro Sakai 2011-2013 +-- Copyright : (c) Masahiro Sakai 2011-2015 -- License : BSD-style -- -- Maintainer : masahiro.sakai@gmail.com @@ -62,6 +63,9 @@ false = F (.&&.) = And (.||.) = Or + +instance IfThenElse (Formula c) (Formula c) where + ite = iteBoolean instance Boolean (Formula c) where (.=>.) = Imply diff --git a/src/ToySolver/Data/LA.hs b/src/ToySolver/Data/LA.hs --- a/src/ToySolver/Data/LA.hs +++ b/src/ToySolver/Data/LA.hs @@ -16,6 +16,7 @@ ( -- * Expression of linear arithmetics Expr + , Var -- ** Conversion , var @@ -50,7 +51,7 @@ , applySubstAtom , applySubst1Atom , solveFor - , module ToySolver.Data.ArithRel + , module ToySolver.Data.OrdRel -- * misc , BoundsEnv @@ -61,14 +62,14 @@ import Control.DeepSeq import Data.List import Data.Maybe -import Data.IntMap (IntMap) -import qualified Data.IntMap as IntMap +import Data.IntMap.Strict (IntMap) +import qualified Data.IntMap.Strict as IntMap import qualified Data.IntSet as IntSet import Data.Interval import Data.VectorSpace -import qualified ToySolver.Data.ArithRel as ArithRel -import ToySolver.Data.ArithRel +import qualified ToySolver.Data.OrdRel as OrdRel +import ToySolver.Data.OrdRel import ToySolver.Data.Var ----------------------------------------------------------------------------- @@ -253,28 +254,28 @@ ----------------------------------------------------------------------------- -- | Atomic Formula of Linear Arithmetics -type Atom r = ArithRel (Expr r) +type Atom r = OrdRel (Expr r) showAtom :: (Num r, Eq r, Show r) => Atom r -> String -showAtom (ArithRel lhs op rhs) = showExpr lhs ++ showOp op ++ showExpr rhs +showAtom (OrdRel lhs op rhs) = showExpr lhs ++ showOp op ++ showExpr rhs -- | evaluate the formula under the model. evalAtom :: (Num r, Ord r) => Model r -> Atom r -> Bool -evalAtom m (ArithRel lhs op rhs) = evalOp op (evalExpr m lhs) (evalExpr m rhs) +evalAtom m (OrdRel lhs op rhs) = evalOp op (evalExpr m lhs) (evalExpr m rhs) applySubstAtom :: (Num r, Eq r) => VarMap (Expr r) -> Atom r -> Atom r -applySubstAtom s (ArithRel lhs op rhs) = ArithRel (applySubst s lhs) op (applySubst s rhs) +applySubstAtom s (OrdRel lhs op rhs) = OrdRel (applySubst s lhs) op (applySubst s rhs) -- | applySubst1 x e phi == phi[e/x] applySubst1Atom :: (Num r, Eq r) => Var -> Expr r -> Atom r -> Atom r -applySubst1Atom x e (ArithRel lhs op rhs) = ArithRel (applySubst1 x e lhs) op (applySubst1 x e rhs) +applySubst1Atom x e (OrdRel lhs op rhs) = OrdRel (applySubst1 x e lhs) op (applySubst1 x e rhs) -- | Solve linear (in)equation for the given variable. -- -- @solveFor a v@ returns @Just (op, e)@ such that @Atom v op e@ -- is equivalent to @a@. solveFor :: (Real r, Fractional r) => Atom r -> Var -> Maybe (RelOp, Expr r) -solveFor (ArithRel lhs op rhs) v = do +solveFor (OrdRel lhs op rhs) v = do (c,e) <- extractMaybe v (lhs ^-^ rhs) return ( if c < 0 then flipOp op else op , (1/c) *^ negateV e diff --git a/src/ToySolver/Data/LA/FOL.hs b/src/ToySolver/Data/LA/FOL.hs --- a/src/ToySolver/Data/LA/FOL.hs +++ b/src/ToySolver/Data/LA/FOL.hs @@ -9,17 +9,17 @@ import Control.Monad import Data.VectorSpace -import ToySolver.Data.ArithRel +import ToySolver.Data.OrdRel import ToySolver.Data.FOL.Arith import qualified ToySolver.Data.LA as LA -- --------------------------------------------------------------------------- fromFOLAtom :: (Real r, Fractional r) => Atom r -> Maybe (LA.Atom r) -fromFOLAtom (ArithRel a op b) = do +fromFOLAtom (OrdRel a op b) = do a' <- fromFOLExpr a b' <- fromFOLExpr b - return $ arithRel op a' b' + return $ ordRel op a' b' toFOLFormula :: (Real r, Fractional r) => LA.Atom r -> Formula (Atom r) toFOLFormula r = Atom $ fmap toFOLExpr r diff --git a/src/ToySolver/Data/MIP/Base.hs b/src/ToySolver/Data/MIP/Base.hs --- a/src/ToySolver/Data/MIP/Base.hs +++ b/src/ToySolver/Data/MIP/Base.hs @@ -14,16 +14,21 @@ ----------------------------------------------------------------------------- module ToySolver.Data.MIP.Base ( Problem (..) - , Expr + , Expr (..) + , varExpr + , constExpr + , terms , Term (..) , OptDir (..) - , ObjectiveFunction + , ObjectiveFunction (..) , Constraint (..) + , (.==.) + , (.<=.) + , (.>=.) , Bounds , Label , Var , VarType (..) - , VarInfo (..) , BoundExpr , Extended (..) , RelOp (..) @@ -34,7 +39,6 @@ , defaultUB , toVar , fromVar - , getVarInfo , getVarType , getBounds , variables @@ -57,55 +61,118 @@ import Data.ExtendedReal import Data.OptDir +infix 4 .<=., .>=., .==. + -- --------------------------------------------------------------------------- -- | Problem data Problem = Problem - { dir :: OptDir + { name :: Maybe String , objectiveFunction :: ObjectiveFunction , constraints :: [Constraint] , sosConstraints :: [SOSConstraint] , userCuts :: [Constraint] - , varInfo :: Map Var VarInfo + , varType :: Map Var VarType + , varBounds :: Map Var Bounds } deriving (Show, Eq, Ord) instance Default Problem where def = Problem - { dir = OptMin - , objectiveFunction = (Nothing, []) + { name = Nothing + , objectiveFunction = def , constraints = [] , sosConstraints = [] , userCuts = [] - , varInfo = Map.empty + , varType = Map.empty + , varBounds = Map.empty } -- | expressions -type Expr = [Term] +newtype Expr = Expr [Term] + deriving (Eq, Ord, Show) +varExpr :: Var -> Expr +varExpr v = Expr [Term 1 [v]] + +constExpr :: Rational -> Expr +constExpr 0 = Expr [] +constExpr c = Expr [Term c []] + +terms :: Expr -> [Term] +terms (Expr ts) = ts + +instance Num Expr where + Expr e1 + Expr e2 = Expr (e1 ++ e2) + Expr e1 * Expr e2 = Expr [Term (c1*c2) (vs1 ++ vs2) | Term c1 vs1 <- e1, Term c2 vs2 <- e2] + negate (Expr e) = Expr [Term (-c) vs | Term c vs <- e] + abs = id + signum _ = 1 + fromInteger 0 = Expr [] + fromInteger c = Expr [Term (fromInteger c) []] + -- | terms data Term = Term Rational [Var] deriving (Eq, Ord, Show) -- | objective function -type ObjectiveFunction = (Maybe Label, Expr) +data ObjectiveFunction + = ObjectiveFunction + { objLabel :: Maybe Label + , objDir :: OptDir + , objExpr :: Expr + } + deriving (Eq, Ord, Show) +instance Default ObjectiveFunction where + def = + ObjectiveFunction + { objLabel = Nothing + , objDir = OptMin + , objExpr = 0 + } + -- | constraint data Constraint = Constraint { constrLabel :: Maybe Label , constrIndicator :: Maybe (Var, Rational) - , constrBody :: (Expr, RelOp, Rational) + , constrExpr :: Expr + , constrLB :: BoundExpr + , constrUB :: BoundExpr , constrIsLazy :: Bool } deriving (Eq, Ord, Show) +(.==.) :: Expr -> Expr -> Constraint +lhs .==. rhs = + case splitConst (lhs - rhs) of + (e, c) -> def{ constrExpr = e, constrLB = Finite (- c), constrUB = Finite (- c) } + +(.<=.) :: Expr -> Expr -> Constraint +lhs .<=. rhs = + case splitConst (lhs - rhs) of + (e, c) -> def{ constrExpr = e, constrUB = Finite (- c) } + +(.>=.) :: Expr -> Expr -> Constraint +lhs .>=. rhs = + case splitConst (lhs - rhs) of + (e, c) -> def{ constrExpr = e, constrLB = Finite (- c) } + +splitConst :: Expr -> (Expr, Rational) +splitConst e = (e2, c) + where + e2 = Expr [t | t@(Term _ (_:_)) <- terms e] + c = sum [c | Term c [] <- terms e] + instance Default Constraint where def = Constraint { constrLabel = Nothing , constrIndicator = Nothing - , constrBody = ([], Le, 0) + , constrExpr = 0 + , constrLB = -inf + , constrUB = inf , constrIsLazy = False } @@ -121,23 +188,6 @@ instance Default VarType where def = ContinuousVariable -data VarInfo - = VarInfo - { varType :: VarType - , varBounds :: Bounds - } - deriving (Eq, Ord, Show) - -instance Default VarInfo where - def = defaultVarInfo - -defaultVarInfo :: VarInfo -defaultVarInfo - = VarInfo - { varType = ContinuousVariable - , varBounds = defaultBounds - } - -- | type for representing lower/upper bound of variables type Bounds = (BoundExpr, BoundExpr) @@ -182,12 +232,17 @@ instance Variables Problem where vars = variables +instance Variables Expr where + vars (Expr e) = vars e + instance Variables Term where vars (Term _ xs) = Set.fromList xs +instance Variables ObjectiveFunction where + vars ObjectiveFunction{ objExpr = e } = vars e + instance Variables Constraint where - vars Constraint{ constrIndicator = ind, constrBody = (lhs, _, _) } = - vars lhs `Set.union` vs2 + vars Constraint{ constrIndicator = ind, constrExpr = e } = Set.union (vars e) vs2 where vs2 = maybe Set.empty (Set.singleton . fst) ind @@ -214,35 +269,25 @@ fromVar :: Var -> String fromVar = unintern --- | looking up attributes for a variable -getVarInfo :: Problem -> Var -> VarInfo -getVarInfo lp v = Map.findWithDefault defaultVarInfo v (varInfo lp) - -- | looking up bounds for a variable getVarType :: Problem -> Var -> VarType -getVarType lp v = varType $ getVarInfo lp v +getVarType mip v = Map.findWithDefault def v (varType mip) -- | looking up bounds for a variable getBounds :: Problem -> Var -> Bounds -getBounds lp v = varBounds $ getVarInfo lp v +getBounds mip v = Map.findWithDefault defaultBounds v (varBounds mip) intersectBounds :: Bounds -> Bounds -> Bounds intersectBounds (lb1,ub1) (lb2,ub2) = (max lb1 lb2, min ub1 ub2) variables :: Problem -> Set Var -variables lp = Map.keysSet $ varInfo lp +variables mip = Map.keysSet $ varType mip integerVariables :: Problem -> Set Var -integerVariables lp = Map.keysSet $ Map.filter p (varInfo lp) - where - p VarInfo{ varType = vt } = vt == IntegerVariable +integerVariables mip = Map.keysSet $ Map.filter (IntegerVariable ==) (varType mip) semiContinuousVariables :: Problem -> Set Var -semiContinuousVariables lp = Map.keysSet $ Map.filter p (varInfo lp) - where - p VarInfo{ varType = vt } = vt == SemiContinuousVariable +semiContinuousVariables mip = Map.keysSet $ Map.filter (SemiContinuousVariable ==) (varType mip) semiIntegerVariables :: Problem -> Set Var -semiIntegerVariables lp = Map.keysSet $ Map.filter p (varInfo lp) - where - p VarInfo{ varType = vt } = vt == SemiIntegerVariable +semiIntegerVariables mip = Map.keysSet $ Map.filter (SemiIntegerVariable ==) (varType mip) diff --git a/src/ToySolver/Data/MIP/LPFile.hs b/src/ToySolver/Data/MIP/LPFile.hs --- a/src/ToySolver/Data/MIP/LPFile.hs +++ b/src/ToySolver/Data/MIP/LPFile.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, BangPatterns #-} {-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-} ----------------------------------------------------------------------------- -- | @@ -28,9 +28,12 @@ , render ) where +import Control.Applicative ((<*)) import Control.Monad import Control.Monad.Writer +import Control.Monad.ST import Data.Char +import Data.Default.Class import Data.List import Data.Maybe import Data.Ratio @@ -38,6 +41,7 @@ import qualified Data.Map as Map import Data.Set (Set) import qualified Data.Set as Set +import Data.STRef import Data.OptDir import Text.Parsec hiding (label) import Text.Parsec.String @@ -51,11 +55,11 @@ -- | Parse a string containing LP file data. -- The source name is only | used in error messages and may be the empty string. parseString :: SourceName -> String -> Either ParseError MIP.Problem -parseString = parse parser +parseString = parse (parser <* eof) -- | Parse a file containing LP file data. parseFile :: FilePath -> IO (Either ParseError MIP.Problem) -parseFile = parseFromFile parser +parseFile = parseFromFile (parser <* eof) -- --------------------------------------------------------------------------- @@ -115,8 +119,12 @@ -- | LP file parser parser :: Parser MIP.Problem parser = do + name <- optionMaybe $ try $ do + spaces + string' "\\* Problem: " + manyTill anyChar (try (string " *\\\n")) sep - (flag, obj) <- problem + obj <- problem cs <- liftM concat $ many $ msum $ [ liftM (map Left) constraintSection @@ -139,43 +147,38 @@ , ints , bins , scs - , MIP.vars (snd obj) + , MIP.vars obj , MIP.vars ss ] isInt v = v `Set.member` ints || v `Set.member` bins isSemi v = v `Set.member` scs return $ MIP.Problem - { MIP.dir = flag + { MIP.name = name , MIP.objectiveFunction = obj , MIP.constraints = [c | Left c <- cs] , MIP.userCuts = [c | Right c <- cs] , MIP.sosConstraints = ss - , MIP.varInfo = - Map.fromAscList - [ ( v - , MIP.VarInfo - { MIP.varBounds = Map.findWithDefault MIP.defaultBounds v bnds2 - , MIP.varType = - if isInt v then - if isSemi v then MIP.SemiIntegerVariable - else MIP.IntegerVariable - else - if isSemi v then MIP.SemiContinuousVariable - else MIP.ContinuousVariable - } - ) - | v <- Set.toAscList vs - ] + , MIP.varType = Map.fromAscList + [ ( v + , if isInt v then + if isSemi v then MIP.SemiIntegerVariable + else MIP.IntegerVariable + else + if isSemi v then MIP.SemiContinuousVariable + else MIP.ContinuousVariable + ) + | v <- Set.toAscList vs ] + , MIP.varBounds = Map.fromAscList [ (v, Map.findWithDefault MIP.defaultBounds v bnds2) | v <- Set.toAscList vs] } -problem :: Parser (OptDir, MIP.ObjectiveFunction) +problem :: Parser MIP.ObjectiveFunction problem = do flag <- (try minimize >> return OptMin) <|> (try maximize >> return OptMax) name <- optionMaybe (try label) obj <- expr - return (flag, (name, obj)) + return def{ MIP.objLabel = name, MIP.objDir = flag, MIP.objExpr = obj } minimize, maximize :: Parser () minimize = tok $ string' "min" >> optional (string' "imize") @@ -213,11 +216,20 @@ e <- expr op <- relOp s <- option 1 sign - rhs <- number + rhs <- liftM (s*) number + + let (lb,ub) = + case op of + MIP.Le -> (MIP.NegInf, MIP.Finite rhs) + MIP.Ge -> (MIP.Finite rhs, MIP.PosInf) + MIP.Eql -> (MIP.Finite rhs, MIP.Finite rhs) + return $ MIP.Constraint { MIP.constrLabel = name , MIP.constrIndicator = g - , MIP.constrBody = (e, op, s*rhs) + , MIP.constrExpr = e + , MIP.constrLB = lb + , MIP.constrUB = ub , MIP.constrIsLazy = isLazy } @@ -337,13 +349,13 @@ -- --------------------------------------------------------------------------- expr :: Parser MIP.Expr -expr = try expr1 <|> return [] +expr = try expr1 <|> return 0 where expr1 :: Parser MIP.Expr expr1 = do t <- term True ts <- many (term False) - return $ concat (t : ts) + return $ sum (t : ts) sign :: Num a => Parser a sign = tok ((char '+' >> return 1) <|> (char '-' >> return (-1))) @@ -352,21 +364,22 @@ term flag = do s <- if flag then optionMaybe sign else liftM Just sign c <- optionMaybe number - e <- liftM (\s' -> [MIP.Term 1 [s']]) variable <|> qexpr + e <- liftM MIP.varExpr variable <|> qexpr return $ case combineMaybe (*) s c of Nothing -> e - Just d -> [MIP.Term (d*c') vs | MIP.Term c' vs <- e] + Just d -> MIP.constExpr d * e qexpr :: Parser MIP.Expr qexpr = do tok (char '[') t <- qterm True ts <- many (qterm False) + let e = MIP.Expr (t:ts) tok (char ']') -- Gurobi allows ommiting "/2" (do mapM_ (tok . char) ("/2" :: String) -- Explicit type signature is necessary because the type of mapM_ in GHC-7.10 is generalized for arbitrary Foldable - return [MIP.Term (r / 2) vs | MIP.Term r vs <- t:ts]) - <|> return (t:ts) + return $ MIP.constExpr (1/2) * e) + <|> return e qterm :: Bool -> Parser MIP.Term qterm flag = do @@ -428,24 +441,28 @@ -- | Render a problem into a string. render :: MIP.Problem -> Either String String -render mip = Right $ execM $ render' $ removeEmptyExpr mip +render mip = Right $ execM $ render' $ normalize mip writeVar :: MIP.Var -> M () writeVar v = writeString $ MIP.fromVar v render' :: MIP.Problem -> M () render' mip = do + case MIP.name mip of + Just name -> writeString $ "\\* Problem: " ++ name ++ " *\\\n" + Nothing -> return () + + let obj = MIP.objectiveFunction mip + writeString $ - case MIP.dir mip of + case MIP.objDir obj of OptMin -> "MINIMIZE" OptMax -> "MAXIMIZE" writeChar '\n' - do - let (l, obj) = MIP.objectiveFunction mip - renderLabel l - renderExpr True obj - writeChar '\n' + renderLabel (MIP.objLabel obj) + renderExpr True (MIP.objExpr obj) + writeChar '\n' writeString "SUBJECT TO\n" forM_ (MIP.constraints mip) $ \c -> do @@ -472,7 +489,7 @@ scs = MIP.semiContinuousVariables mip `Set.union` MIP.semiIntegerVariables mip writeString "BOUNDS\n" - forM_ (Map.toAscList (MIP.varInfo mip)) $ \(v, MIP.VarInfo{ MIP.varBounds = (lb,ub) }) -> do + forM_ (Map.toAscList (MIP.varBounds mip)) $ \(v, (lb,ub)) -> do unless (v `Set.member` bins) $ do renderBoundExpr lb writeString " <= " @@ -512,7 +529,7 @@ renderExpr :: Bool -> MIP.Expr -> M () renderExpr isObj e = fill 80 (ts1 ++ ts2) where - (ts,qts) = partition isLin e + (ts,qts) = partition isLin (MIP.terms e) isLin (MIP.Term _ []) = True isLin (MIP.Term _ [_]) = True isLin _ = False @@ -522,7 +539,8 @@ | null qts = [] | otherwise = -- マイナスで始めるとSCIP 2.1.1 は「cannot have '-' in front of quadratic part ('[')」というエラーを出す - ["+ ["] ++ map g qts ++ [if isObj then "] / 2" else "]"] + -- SCIP-3.1.0 does not allow spaces between '/' and '2'. + ["+ ["] ++ map g qts ++ [if isObj then "] /2" else "]"] f :: MIP.Term -> String f (MIP.Term c []) = showConstTerm c @@ -567,7 +585,7 @@ renderOp MIP.Eql = writeString "=" renderConstraint :: MIP.Constraint -> M () -renderConstraint c@MIP.Constraint{ MIP.constrBody = (e,op,val) } = do +renderConstraint c@MIP.Constraint{ MIP.constrExpr = e, MIP.constrLB = lb, MIP.constrUB = ub } = do renderLabel (MIP.constrLabel c) case MIP.constrIndicator c of Nothing -> return () @@ -579,6 +597,12 @@ renderExpr False e writeChar ' ' + let (op, val) = + case (lb, ub) of + (MIP.NegInf, MIP.Finite x) -> (MIP.Le, x) + (MIP.Finite x, MIP.PosInf) -> (MIP.Ge, x) + (MIP.Finite x1, MIP.Finite x2) | x1==x2 -> (MIP.Eql, x1) + _ -> error "ToySolver.Data.MIP.LPFile.renderConstraint: should not happen" renderOp op writeChar ' ' writeString $ showValue val @@ -615,22 +639,64 @@ -- --------------------------------------------------------------------------- +normalize :: MIP.Problem -> MIP.Problem +normalize = removeEmptyExpr . removeRangeConstraints + +removeRangeConstraints :: MIP.Problem -> MIP.Problem +removeRangeConstraints prob = runST $ do + vsRef <- newSTRef $ MIP.variables prob + cntRef <- newSTRef (0::Int) + newvsRef <- newSTRef [] + + let gensym = do + vs <- readSTRef vsRef + let loop !c = do + let v = MIP.toVar ("~r_" ++ show c) + if v `Set.member` vs then + loop (c+1) + else do + writeSTRef cntRef $! c+1 + modifySTRef vsRef (Set.insert v) + return v + loop =<< readSTRef cntRef + + cs2 <- forM (MIP.constraints prob) $ \c -> do + case (MIP.constrLB c, MIP.constrUB c) of + (MIP.NegInf, MIP.Finite _) -> return c + (MIP.Finite _, MIP.PosInf) -> return c + (MIP.Finite x1, MIP.Finite x2) | x1 == x2 -> return c + (lb, ub) -> do + v <- gensym + modifySTRef newvsRef ((v, (lb,ub)) :) + return $ + c + { MIP.constrExpr = MIP.constrExpr c - MIP.varExpr v + , MIP.constrLB = 0 + , MIP.constrUB = 0 + } + + newvs <- liftM reverse $ readSTRef newvsRef + return $ + prob + { MIP.constraints = cs2 + , MIP.varType = MIP.varType prob `Map.union` Map.fromList [(v, MIP.ContinuousVariable) | (v,_) <- newvs] + , MIP.varBounds = MIP.varBounds prob `Map.union` (Map.fromList newvs) + } + removeEmptyExpr :: MIP.Problem -> MIP.Problem removeEmptyExpr prob = prob - { MIP.objectiveFunction = - case MIP.objectiveFunction prob of - (label, e) -> (label, convertExpr e) + { MIP.objectiveFunction = obj{ MIP.objExpr = convertExpr (MIP.objExpr obj) } , MIP.constraints = map convertConstr $ MIP.constraints prob , MIP.userCuts = map convertConstr $ MIP.userCuts prob } where - convertExpr [] = [MIP.Term 0 [MIP.toVar "x0"]] + obj = MIP.objectiveFunction prob + + convertExpr (MIP.Expr []) = MIP.Expr [MIP.Term 0 [MIP.toVar "x0"]] convertExpr e = e convertConstr constr = constr - { MIP.constrBody = - case MIP.constrBody constr of - (lhs,op,rhs) -> (convertExpr lhs, op, rhs) + { MIP.constrExpr = convertExpr $ MIP.constrExpr constr } diff --git a/src/ToySolver/Data/MIP/MPSFile.hs b/src/ToySolver/Data/MIP/MPSFile.hs --- a/src/ToySolver/Data/MIP/MPSFile.hs +++ b/src/ToySolver/Data/MIP/MPSFile.hs @@ -30,8 +30,10 @@ , render ) where +import Control.Applicative ((<*)) import Control.Monad import Control.Monad.Writer +import Data.Default.Class import Data.Maybe import Data.Set (Set) import qualified Data.Set as Set @@ -72,11 +74,11 @@ -- | Parse a string containing MPS file data. -- The source name is only | used in error messages and may be the empty string. parseString :: SourceName -> String -> Either ParseError MIP.Problem -parseString = parse parser +parseString = parse (parser <* eof) -- | Parse a file containing MPS file data. parseFile :: FilePath -> IO (Either ParseError MIP.Problem) -parseFile = parseFromFile parser +parseFile = parseFromFile (parser <* eof) -- --------------------------------------------------------------------------- @@ -157,7 +159,7 @@ parser = do many commentline - _name <- nameSection + name <- nameSection -- http://pic.dhe.ibm.com/infocenter/cosinfoc/v12r4/topic/ilog.odms.cplex.help/CPLEX/File_formats_reference/topics/MPS_ext_objsen.html -- CPLEX extends the MPS standard by allowing two additional sections: OBJSEN and OBJNAME. @@ -197,6 +199,7 @@ inds <- option Map.empty indicatorsSection string "ENDATA" + P.spaces let objrow = case objname of @@ -283,55 +286,57 @@ let lhs = [MIP.Term c [col] | (col,c) <- Map.toList (Map.findWithDefault Map.empty row rowCoeffs)] ++ Map.findWithDefault [] row qterms let rhs = Map.findWithDefault 0 row rhss - (op2,rhs2) <- - case Map.lookup row rngs of - Nothing -> return (op, rhs) - Just rng -> - case op of - MIP.Ge -> [(MIP.Ge, rhs), (MIP.Le, rhs + abs rng)] - MIP.Le -> [(MIP.Ge, rhs - abs rng), (MIP.Le, rhs)] - MIP.Eql -> - if rng < 0 - then [(MIP.Ge, rhs + rng), (MIP.Le, rhs)] - else [(MIP.Ge, rhs), (MIP.Le, rhs + rng)] + (lb,ub) = + case Map.lookup row rngs of + Nothing -> + case op of + MIP.Ge -> (MIP.Finite rhs, MIP.PosInf) + MIP.Le -> (MIP.NegInf, MIP.Finite rhs) + MIP.Eql -> (MIP.Finite rhs, MIP.Finite rhs) + Just rng -> + case op of + MIP.Ge -> (MIP.Finite rhs, MIP.Finite (rhs + abs rng)) + MIP.Le -> (MIP.Finite (rhs - abs rng), MIP.Finite rhs) + MIP.Eql -> + if rng < 0 + then (MIP.Finite (rhs + rng), MIP.Finite rhs) + else (MIP.Finite rhs, MIP.Finite (rhs + rng)) return $ MIP.Constraint { MIP.constrLabel = Just $ unintern row , MIP.constrIndicator = Map.lookup row inds , MIP.constrIsLazy = isLazy - , MIP.constrBody = (lhs, op2, rhs2) + , MIP.constrExpr = MIP.Expr lhs + , MIP.constrLB = lb + , MIP.constrUB = ub } let mip = MIP.Problem - { MIP.dir = objdir - , MIP.objectiveFunction = - ( Just (unintern objrow) - , [MIP.Term c [col] | (col,m) <- Map.toList cols, c <- maybeToList (Map.lookup objrow m)] ++ qobj - ) + { MIP.name = name + , MIP.objectiveFunction = def + { MIP.objDir = objdir + , MIP.objLabel = Just (unintern objrow) + , MIP.objExpr = MIP.Expr $ [MIP.Term c [col] | (col,m) <- Map.toList cols, c <- maybeToList (Map.lookup objrow m)] ++ qobj + } , MIP.constraints = concatMap (f False) rows ++ concatMap (f True) lazycons , MIP.sosConstraints = sos , MIP.userCuts = concatMap (f False) usercuts - , MIP.varInfo = - Map.fromAscList + , MIP.varType = Map.fromAscList [ ( v - , MIP.VarInfo - { MIP.varBounds = Map.findWithDefault MIP.defaultBounds v bounds - , MIP.varType = - if v `Set.member` sivs then - MIP.SemiIntegerVariable - else if v `Set.member` intvs1 && v `Set.member` scvs then - MIP.SemiIntegerVariable - else if v `Set.member` intvs1 || v `Set.member` intvs2 then - MIP.IntegerVariable - else if v `Set.member` scvs then - MIP.SemiContinuousVariable - else - MIP.ContinuousVariable - } + , if v `Set.member` sivs then + MIP.SemiIntegerVariable + else if v `Set.member` intvs1 && v `Set.member` scvs then + MIP.SemiIntegerVariable + else if v `Set.member` intvs1 || v `Set.member` intvs2 then + MIP.IntegerVariable + else if v `Set.member` scvs then + MIP.SemiContinuousVariable + else + MIP.ContinuousVariable ) - | v <- Set.toAscList vs - ] + | v <- Set.toAscList vs ] + , MIP.varBounds = Map.fromAscList [(v, Map.findWithDefault MIP.defaultBounds v bounds) | v <- Set.toAscList vs] } return mip @@ -586,21 +591,25 @@ render' :: MIP.Problem -> M () render' mip = do - let probName = "" + let probName = fromMaybe "" (MIP.name mip) -- NAME section -- The name starts in column 15 in fixed formats. writeSectionHeader $ "NAME" ++ replicate 10 ' ' ++ probName + + let MIP.ObjectiveFunction + { MIP.objLabel = Just objName + , MIP.objDir = dir + , MIP.objExpr = obj + } = MIP.objectiveFunction mip -- OBJSENSE section -- Note: GLPK-4.48 does not support this section. writeSectionHeader "OBJSENSE" - case MIP.dir mip of + case dir of OptMin -> writeFields ["MIN"] OptMax -> writeFields ["MAX"] - let (Just objName, obj) = MIP.objectiveFunction mip - {- -- OBJNAME section -- Note: GLPK-4.48 does not support this section. @@ -608,9 +617,18 @@ writeFields [objName] -} + let splitRange c = + case (MIP.constrLB c, MIP.constrUB c) of + (MIP.Finite x, MIP.PosInf) -> ((MIP.Ge, x), Nothing) + (MIP.NegInf, MIP.Finite x) -> ((MIP.Le, x), Nothing) + (MIP.Finite x1, MIP.Finite x2) + | x1 == x2 -> ((MIP.Eql, x1), Nothing) + | x1 < x2 -> ((MIP.Eql, x1), Just (x2 - x1)) + _ -> error "invalid constraint bound" + let renderRows cs = do forM_ cs $ \c -> do - let (_,op,_) = MIP.constrBody c + let ((op,_), _) = splitRange c let s = case op of MIP.Le -> "L" MIP.Ge -> "G" @@ -639,9 +657,9 @@ cols = Map.fromListWith Map.union [ (v, Map.singleton l d) | (Just l, xs) <- - MIP.objectiveFunction mip : - [(MIP.constrLabel c, lhs) | c <- MIP.constraints mip ++ MIP.userCuts mip, let (lhs,_,_) = MIP.constrBody c] - , MIP.Term d [v] <- xs + (Just objName, obj) : + [(MIP.constrLabel c, lhs) | c <- MIP.constraints mip ++ MIP.userCuts mip, let lhs = MIP.constrExpr c] + , MIP.Term d [v] <- MIP.terms xs ] f col xs = forM_ (Map.toList xs) $ \(row, d) -> do @@ -654,17 +672,23 @@ writeFields ["", "MARK0001", "'MARKER'", "", "'INTEND'"] -- RHS section - let rs = [(fromJust $ MIP.constrLabel c, rhs) | c <- MIP.constraints mip ++ MIP.userCuts mip, let (_,_,rhs) = MIP.constrBody c, rhs /= 0] + let rs = [(fromJust $ MIP.constrLabel c, rhs) | c <- MIP.constraints mip ++ MIP.userCuts mip, let ((_,rhs),_) = splitRange c, rhs /= 0] writeSectionHeader "RHS" forM_ rs $ \(name, val) -> do writeFields ["", "rhs", name, showValue val] + -- RANGES section + let rngs = [(fromJust $ MIP.constrLabel c, fromJust rng) | c <- MIP.constraints mip ++ MIP.userCuts mip, let ((_,_), rng) = splitRange c, isJust rng] + unless (null rngs) $ do + writeSectionHeader "RANGES" + forM_ rngs $ \(name, val) -> do + writeFields ["", "rhs", name, showValue val] + -- BOUNDS section writeSectionHeader "BOUNDS" - forM_ (Map.toList (MIP.varInfo mip)) $ \(col, vinfo) -> do - let (lb,ub) = MIP.varBounds vinfo - vt = MIP.varType vinfo - case (lb,ub) of + forM_ (Map.toList (MIP.varType mip)) $ \(col, vt) -> do + let (lb,ub) = MIP.getBounds mip col + case (lb,ub) of (MIP.NegInf, MIP.PosInf) -> do -- free variable (no lower or upper bound) writeFields ["FR", "bound", unintern col] @@ -729,7 +753,7 @@ -- QCMATRIX section let xs = [ (fromJust $ MIP.constrLabel c, qm) | c <- MIP.constraints mip ++ MIP.userCuts mip - , let (lhs,_,_) = MIP.constrBody c + , let lhs = MIP.constrExpr c , let qm = quadMatrix lhs , not (Map.null qm) ] unless (null xs) $ do @@ -807,13 +831,13 @@ nameRows :: MIP.Problem -> MIP.Problem nameRows mip = mip - { MIP.objectiveFunction = (Just objName', obj) + { MIP.objectiveFunction = (MIP.objectiveFunction mip){ MIP.objLabel = Just objName' } , MIP.constraints = f (MIP.constraints mip) ["row" ++ show n | n <- [(1::Int)..]] , MIP.userCuts = f (MIP.userCuts mip) ["usercut" ++ show n | n <- [(1::Int)..]] , MIP.sosConstraints = g (MIP.sosConstraints mip) ["sos" ++ show n | n <- [(1::Int)..]] } where - (objName, obj) = MIP.objectiveFunction mip + objName = MIP.objLabel $ MIP.objectiveFunction mip used = Set.fromList $ catMaybes $ objName : [MIP.constrLabel c | c <- MIP.constraints mip ++ MIP.userCuts mip] ++ [MIP.sosLabel c | c <- MIP.sosConstraints mip] objName' = fromMaybe (head [name | n <- [(1::Int)..], let name = "obj" ++ show n, name `Set.notMember` used]) objName @@ -831,7 +855,7 @@ quadMatrix :: MIP.Expr -> Map (MIP.Var, MIP.Var) Rational quadMatrix e = Map.fromList $ do - let m = Map.fromListWith (+) [(if v1<=v2 then (v1,v2) else (v2,v1), c) | MIP.Term c [v1,v2] <- e] + let m = Map.fromListWith (+) [(if v1<=v2 then (v1,v2) else (v2,v1), c) | MIP.Term c [v1,v2] <- MIP.terms e] ((v1,v2),c) <- Map.toList m if v1==v2 then [((v1,v2), c)] @@ -839,10 +863,10 @@ [((v1,v2), c/2), ((v2,v1), c/2)] checkAtMostQuadratic :: MIP.Problem -> Bool -checkAtMostQuadratic mip = all (all f) es +checkAtMostQuadratic mip = all (all f . MIP.terms) es where - es = snd (MIP.objectiveFunction mip) : - [lhs | c <- MIP.constraints mip ++ MIP.userCuts mip, let (lhs,_,_) = MIP.constrBody c] + es = MIP.objExpr (MIP.objectiveFunction mip) : + [lhs | c <- MIP.constraints mip ++ MIP.userCuts mip, let lhs = MIP.constrExpr c] f :: MIP.Term -> Bool f (MIP.Term _ [_]) = True f (MIP.Term _ [_,_]) = True diff --git a/src/ToySolver/Data/OrdRel.hs b/src/ToySolver/Data/OrdRel.hs new file mode 100644 --- /dev/null +++ b/src/ToySolver/Data/OrdRel.hs @@ -0,0 +1,138 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FunctionalDependencies #-} +----------------------------------------------------------------------------- +-- | +-- Module : ToySolver.Data.OrdRel +-- Copyright : (c) Masahiro Sakai 2011 +-- License : BSD-style +-- +-- Maintainer : masahiro.sakai@gmail.com +-- Stability : provisional +-- Portability : non-portable (FlexibleInstances, MultiParamTypeClasses, FunctionalDependencies) +-- +-- Ordering relations +-- +----------------------------------------------------------------------------- +module ToySolver.Data.OrdRel + ( + -- * Relational operators + RelOp (..) + , flipOp + , negOp + , showOp + , evalOp + + -- * Relation + , OrdRel (..) + , fromOrdRel + + -- * DSL + , IsEqRel (..) + , IsOrdRel (..) + ) where + +import qualified Data.IntSet as IS + +import ToySolver.Data.Boolean +import ToySolver.Data.Var + +infix 4 .<., .<=., .>=., .>., .==., ./=. + +-- --------------------------------------------------------------------------- + +-- | relational operators +data RelOp = Lt | Le | Ge | Gt | Eql | NEq + deriving (Show, Eq, Ord) + + +-- | flipping relational operator +-- +-- @rel (flipOp op) a b@ is equivalent to @rel op b a@ +flipOp :: RelOp -> RelOp +flipOp Le = Ge +flipOp Ge = Le +flipOp Lt = Gt +flipOp Gt = Lt +flipOp Eql = Eql +flipOp NEq = NEq + +-- | negating relational operator +-- +-- @rel (negOp op) a b@ is equivalent to @notB (rel op a b)@ +negOp :: RelOp -> RelOp +negOp Lt = Ge +negOp Le = Gt +negOp Ge = Lt +negOp Gt = Le +negOp Eql = NEq +negOp NEq = Eql + +-- | operator symbol +showOp :: RelOp -> String +showOp Lt = "<" +showOp Le = "<=" +showOp Ge = ">=" +showOp Gt = ">" +showOp Eql = "=" +showOp NEq = "/=" + +-- | evaluate an operator into a comparision function +evalOp :: Ord a => RelOp -> a -> a -> Bool +evalOp Lt = (<) +evalOp Le = (<=) +evalOp Ge = (>=) +evalOp Gt = (>) +evalOp Eql = (==) +evalOp NEq = (/=) + +-- --------------------------------------------------------------------------- + +-- | type class for constructing relational formula +class IsEqRel e r | r -> e where + (.==.) :: e -> e -> r + (./=.) :: e -> e -> r + +-- | type class for constructing relational formula +class IsEqRel e r => IsOrdRel e r | r -> e where + (.<.), (.<=.), (.>.), (.>=.) :: e -> e -> r + ordRel :: RelOp -> e -> e -> r + + a .<. b = ordRel Lt a b + a .<=. b = ordRel Le a b + a .>. b = ordRel Gt a b + a .>=. b = ordRel Ge a b + + ordRel Lt a b = a .<. b + ordRel Gt a b = a .>. b + ordRel Le a b = a .<=. b + ordRel Ge a b = a .>=. b + ordRel Eql a b = a .==. b + ordRel NEq a b = a ./=. b + + {-# MINIMAL ((.<.), (.<=.), (.>.), (.>=.)) | ordRel #-} + +-- --------------------------------------------------------------------------- + +-- | Atomic formula +data OrdRel e = OrdRel e RelOp e + deriving (Show, Eq, Ord) + +instance Complement (OrdRel c) where + notB (OrdRel lhs op rhs) = OrdRel lhs (negOp op) rhs + +instance IsEqRel e (OrdRel e) where + (.==.) = ordRel Eql + (./=.) = ordRel NEq + +instance IsOrdRel e (OrdRel e) where + ordRel op a b = OrdRel a op b + +instance Variables e => Variables (OrdRel e) where + vars (OrdRel a _ b) = vars a `IS.union` vars b + +instance Functor OrdRel where + fmap f (OrdRel a op b) = OrdRel (f a) op (f b) + +fromOrdRel :: IsOrdRel e r => OrdRel e -> r +fromOrdRel (OrdRel a op b) = ordRel op a b + +-- --------------------------------------------------------------------------- diff --git a/src/ToySolver/Data/Polyhedron.hs b/src/ToySolver/Data/Polyhedron.hs --- a/src/ToySolver/Data/Polyhedron.hs +++ b/src/ToySolver/Data/Polyhedron.hs @@ -31,7 +31,7 @@ import Algebra.Lattice import qualified Data.Interval as Interval -import ToySolver.Data.ArithRel +import ToySolver.Data.OrdRel import qualified ToySolver.Data.LA as LA import ToySolver.Data.Var diff --git a/src/ToySolver/Data/Polynomial.hs b/src/ToySolver/Data/Polynomial.hs --- a/src/ToySolver/Data/Polynomial.hs +++ b/src/ToySolver/Data/Polynomial.hs @@ -114,7 +114,6 @@ -- * Pretty Printing , PrintOptions (..) - , defaultPrintOptions , prettyPrint , PrettyCoeff (..) , PrettyVar (..) diff --git a/src/ToySolver/Data/Polynomial/Base.hs b/src/ToySolver/Data/Polynomial/Base.hs --- a/src/ToySolver/Data/Polynomial/Base.hs +++ b/src/ToySolver/Data/Polynomial/Base.hs @@ -115,7 +115,6 @@ -- * Pretty Printing , PrintOptions (..) - , defaultPrintOptions , prettyPrint , PrettyCoeff (..) , PrettyVar (..) @@ -135,13 +134,12 @@ import Data.Monoid import Data.Ratio import Data.String (IsString (..)) -import Data.Map (Map) -import qualified Data.Map as Map +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map import Data.Set (Set) import qualified Data.Set as Set -import Data.IntMap (IntMap) -import qualified Data.IntMap as IntMap -import Data.Typeable +import Data.IntMap.Strict (IntMap) +import qualified Data.IntMap.Strict as IntMap import Data.VectorSpace import qualified Text.PrettyPrint.HughesPJClass as PP import Text.PrettyPrint.HughesPJClass (Doc, PrettyLevel, Pretty (..), prettyParen) @@ -224,13 +222,20 @@ scale :: (Eq k, Num k, Ord v) => k -> Polynomial k v -> Polynomial k v scale 0 _ = zero scale 1 p = p -scale a (Polynomial m) = normalize $ Polynomial (Map.map (a*) m) +scale a (Polynomial m) = Polynomial (Map.mapMaybe f m) + where + f b = if c == 0 then Nothing else Just c + where c = a * b zero :: (Eq k, Num k, Ord v) => Polynomial k v zero = Polynomial $ Map.empty plus :: (Eq k, Num k, Ord v) => Polynomial k v -> Polynomial k v -> Polynomial k v -plus (Polynomial m1) (Polynomial m2) = normalize $ Polynomial $ Map.unionWith (+) m1 m2 +plus (Polynomial m1) (Polynomial m2) = Polynomial $ Map.mergeWithKey f id id m1 m2 + where + f _ a b = if c == 0 then Nothing else Just c + where + c = a + b neg :: (Eq k, Num k, Ord v) => Polynomial k v -> Polynomial k v neg (Polynomial m) = Polynomial $ Map.map negate m @@ -239,7 +244,7 @@ mult a b | Just c <- asConstant a = scale c b | Just c <- asConstant b = scale c a -mult (Polynomial m1) (Polynomial m2) = normalize $ Polynomial $ Map.fromListWith (+) +mult (Polynomial m1) (Polynomial m2) = fromCoeffMap $ Map.fromListWith (+) [ (xs1 `mmult` xs2, c1*c2) | (xs1,c1) <- Map.toList m1, (xs2,c2) <- Map.toList m2 ] @@ -253,14 +258,15 @@ -- | construct a polynomial from a list of terms fromTerms :: (Eq k, Num k, Ord v) => [Term k v] -> Polynomial k v -fromTerms = normalize . Polynomial . Map.fromListWith (+) . map (\(c,xs) -> (xs,c)) +fromTerms = fromCoeffMap . Map.fromListWith (+) . map (\(c,xs) -> (xs,c)) fromCoeffMap :: (Eq k, Num k, Ord v) => Map (Monomial v) k -> Polynomial k v fromCoeffMap m = normalize $ Polynomial m -- | construct a polynomial from a singlet term fromTerm :: (Eq k, Num k, Ord v) => Term k v -> Polynomial k v -fromTerm (c,xs) = normalize $ Polynomial $ Map.singleton xs c +fromTerm (0,_) = zero +fromTerm (c,xs) = Polynomial $ Map.singleton xs c -- | list of terms terms :: Polynomial k v -> [Term k v] @@ -450,6 +456,9 @@ Pretty printing --------------------------------------------------------------------} +-- | Options for pretty printing polynomials +-- +-- The default value can be obtained by 'def'. data PrintOptions k v = PrintOptions { pOptPrintVar :: PrettyLevel -> Rational -> v -> Doc @@ -459,16 +468,13 @@ } instance (PrettyCoeff k, PrettyVar v, Ord v) => Default (PrintOptions k v) where - def = defaultPrintOptions - -defaultPrintOptions :: (PrettyCoeff k, PrettyVar v, Ord v) => PrintOptions k v -defaultPrintOptions - = PrintOptions - { pOptPrintVar = pPrintVar - , pOptPrintCoeff = pPrintCoeff - , pOptIsNegativeCoeff = isNegativeCoeff - , pOptMonomialOrder = grlex - } + def = + PrintOptions + { pOptPrintVar = pPrintVar + , pOptPrintCoeff = pPrintCoeff + , pOptIsNegativeCoeff = isNegativeCoeff + , pOptMonomialOrder = grlex + } instance (Ord k, Num k, Ord v, PrettyCoeff k, PrettyVar v) => Pretty (Polynomial k v) where pPrintPrec = prettyPrint def diff --git a/src/ToySolver/Data/Polynomial/Factorization/FiniteField.hs b/src/ToySolver/Data/Polynomial/Factorization/FiniteField.hs --- a/src/ToySolver/Data/Polynomial/Factorization/FiniteField.hs +++ b/src/ToySolver/Data/Polynomial/Factorization/FiniteField.hs @@ -1,5 +1,5 @@ {-# LANGUAGE ScopedTypeVariables, BangPatterns, TypeSynonymInstances, FlexibleInstances #-} -{-# OPTIONS_GHC -Wall #-} +{-# OPTIONS_GHC -Wall -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- | -- Module : ToySolver.Data.Polynomial.Factorization.FiniteField diff --git a/src/ToySolver/Data/Polynomial/GroebnerBasis.hs b/src/ToySolver/Data/Polynomial/GroebnerBasis.hs --- a/src/ToySolver/Data/Polynomial/GroebnerBasis.hs +++ b/src/ToySolver/Data/Polynomial/GroebnerBasis.hs @@ -30,7 +30,6 @@ -- * Options Options (..) , Strategy (..) - , defaultOptions -- * Gröbner basis computation , basis @@ -45,19 +44,19 @@ import ToySolver.Data.Polynomial.Base (Polynomial, Monomial, MonomialOrder) import qualified ToySolver.Data.Polynomial.Base as P +-- | Options for Gröbner Basis computation. +-- +-- The default option can be obtained by 'def'. data Options = Options { optStrategy :: Strategy } instance Default Options where - def = defaultOptions - -defaultOptions :: Options -defaultOptions = - Options - { optStrategy = NormalStrategy - } + def = + Options + { optStrategy = NormalStrategy + } data Strategy = NormalStrategy diff --git a/src/ToySolver/EUF/CongruenceClosure.hs b/src/ToySolver/EUF/CongruenceClosure.hs new file mode 100644 --- /dev/null +++ b/src/ToySolver/EUF/CongruenceClosure.hs @@ -0,0 +1,796 @@ +{-# LANGUAGE BangPatterns, ScopedTypeVariables, FlexibleInstances #-} +{-# OPTIONS_GHC -Wall #-} +----------------------------------------------------------------------------- +-- | +-- Module : ToySolver.EUF.CongruenceClosure +-- Copyright : (c) Masahiro Sakai 2012, 2015 +-- License : BSD-style +-- +-- Maintainer : masahiro.sakai@gmail.com +-- Stability : provisional +-- Portability : non-portable (BangPatterns, ScopedTypeVariables, FlexibleInstances) +-- +-- References: +-- +-- * R. Nieuwenhuis and A. Oliveras, "Fast congruence closure and extensions," +-- Information and Computation, vol. 205, no. 4, pp. 557-580, Apr. 2007. +-- +-- +----------------------------------------------------------------------------- +module ToySolver.EUF.CongruenceClosure + ( + -- * The @Solver@ type + Solver + , newSolver + + -- * Problem description + , FSym + , Term (..) + , FlatTerm (..) + , ConstrID + , newFSym + , VAFun (..) + , newFun + , newConst + , merge + , merge' + , mergeFlatTerm + , mergeFlatTerm' + + -- * Query + , areCongruent + , areCongruentFlatTerm + + -- * Explanation + , explain + , explainFlatTerm + , explainConst + + -- * Model Construction + , Entity + , EntityTuple + , Model (..) + , getModel + , eval + , evalAp + + -- * Backtracking + , pushBacktrackPoint + , popBacktrackPoint + + -- * Low-level operations + , termToFlatTerm + , termToFSym + , fsymToTerm + , fsymToFlatTerm + , flatTermToFSym + ) where + +import Prelude hiding (lookup) + +import Control.Exception (assert) +import Control.Loop +import Control.Monad +import Data.IORef +import Data.IntMap.Strict (IntMap) +import qualified Data.IntMap.Strict as IntMap +import Data.IntSet (IntSet) +import qualified Data.IntSet as IntSet +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map +import Data.Semigroup +import Data.Set (Set) +import qualified Data.Set as Set + +import qualified ToySolver.Internal.Data.Vec as Vec + +type FSym = Int + +data Term = TApp FSym [Term] + deriving (Ord, Eq, Show) + +data FlatTerm + = FTConst !FSym + | FTApp !FSym !FSym + deriving (Ord, Eq, Show) + +type ConstrID = Int + +-- | @Eqn0 cid a b@ represents an equation "a = b" +data Eqn0 = Eqn0 (Maybe ConstrID) !FSym !FSym + deriving (Eq, Ord, Show) + +-- | @Eqn1 cid a b c@ represents an equation "f(a,b) = c" +data Eqn1 = Eqn1 (Maybe ConstrID) !FSym !FSym !FSym + deriving (Eq, Ord, Show) + +-- | An equation @a = b@ represented as either +-- +-- * @a = b@ or +-- +-- * @f(a1,a2) = a, f(b1,b2) = b@ where @a1 = b1@ and @a2 = b2@ has already been derived. +-- +type Eqn = Either Eqn0 (Eqn1, Eqn1) + +data Class + = ClassSingleton !FSym + | ClassUnion !Int Class Class + deriving (Show) + +instance Semigroup Class where + xs <> ys = ClassUnion (classSize xs + classSize ys) xs ys + stimes = stimesIdempotent + +classSize :: Class -> Int +classSize (ClassSingleton _) = 1 +classSize (ClassUnion size _ _) = size + +-- Use mono-traversable package? +classToList :: Class -> [FSym] +classToList c = f c [] + where + f (ClassSingleton v) = (v :) + f (ClassUnion _ xs ys) = f xs . f ys + +-- Use mono-traversable package? +classForM_ :: Monad m => Class -> (FSym -> m ()) -> m () +classForM_ xs f = g xs + where + g (ClassSingleton v) = f v + g (ClassUnion _ xs ys) = g xs >> g ys + +data Solver + = Solver + { svDefs :: !(IORef (IntMap (FSym,FSym), Map (FSym,FSym) FSym)) + , svRepresentativeTable :: !(Vec.UVec FSym) + , svClassList :: !(Vec.Vec Class) + , svParent :: !(IORef (IntMap (FSym, Eqn))) + , svUseList :: !(IORef (IntMap [(Eqn1, Level, Gen)])) + , svLookupTable :: !(IORef (IntMap (IntMap Eqn1))) + + -- workspace for constraint propagation + , svPending :: !(Vec.Vec Eqn) + + -- workspace for explanation generation + , svERepresentativeTable :: !(Vec.UVec FSym) + , svEClassList :: !(Vec.Vec Class) + , svEHighestNodeTable :: !(Vec.UVec FSym) + , svEPendingProofs :: !(Vec.Vec (FSym,FSym)) + + -- for backtracking + , svTrail :: !(Vec.Vec [TrailItem]) + , svLevelGen :: !(Vec.UVec Int) + , svIsAfterBacktracking :: !(IORef Bool) + } + +newSolver :: IO Solver +newSolver = do + defs <- newIORef (IntMap.empty, Map.empty) + rep <- Vec.new + classes <- Vec.new + parent <- newIORef IntMap.empty + useList <- newIORef IntMap.empty + lookup <- newIORef IntMap.empty + + pending <- Vec.new + + repE <- Vec.new + classesE <- Vec.new + highE <- Vec.new + pendingE <- Vec.new + + trail <- Vec.new + gen <- Vec.new + Vec.push gen 0 + isAfterBT <- newIORef False + + return $ + Solver + { svDefs = defs + , svRepresentativeTable = rep + , svClassList = classes + , svParent = parent + , svUseList = useList + , svLookupTable = lookup + + -- workspace for constraint propagation + , svPending = pending + + -- workspace for explanation generation + , svERepresentativeTable = repE + , svEClassList = classesE + , svEHighestNodeTable = highE + , svEPendingProofs = pendingE + + -- for backtracking + , svTrail = trail + , svLevelGen = gen + , svIsAfterBacktracking = isAfterBT + } + +getNFSyms :: Solver -> IO Int +getNFSyms solver = Vec.getSize (svRepresentativeTable solver) + +newFSym :: Solver -> IO FSym +newFSym solver = do + v <- getNFSyms solver + Vec.push (svRepresentativeTable solver) v + Vec.push (svClassList solver) (ClassSingleton v) + modifyIORef' (svUseList solver) (IntMap.insert v []) + Vec.push (svERepresentativeTable solver) v + Vec.push (svEClassList solver) undefined + Vec.push (svEHighestNodeTable solver) v + return v + +class VAFun a where + withVArgs :: ([Term] -> Term) -> a + +instance VAFun Term where + withVArgs k = k [] + +instance VAFun a => VAFun (Term -> a) where + withVArgs k x = withVArgs (\xs -> k (x : xs)) + +newFun :: VAFun a => Solver -> IO a +newFun solver = do + c <- newFSym solver + return $ withVArgs (TApp c) + +newConst :: Solver -> IO Term +newConst = newFun + +merge :: Solver -> Term -> Term -> IO () +merge solver t u = merge' solver t u Nothing + +merge' :: Solver -> Term -> Term -> Maybe ConstrID -> IO () +merge' solver t u cid = do + t' <- termToFlatTerm solver t + u' <- termToFlatTerm solver u + case (t', u') of + (FTConst c, _) -> mergeFlatTerm' solver u' c cid + (_, FTConst c) -> mergeFlatTerm' solver t' c cid + _ -> do + c <- flatTermToFSym solver u' + mergeFlatTerm' solver t' c cid + +mergeFlatTerm :: Solver -> FlatTerm -> FSym -> IO () +mergeFlatTerm solver s a = mergeFlatTerm' solver s a Nothing + +mergeFlatTerm' :: Solver -> FlatTerm -> FSym -> Maybe ConstrID -> IO () +mergeFlatTerm' solver s a cid = do + initAfterBacktracking solver + case s of + FTConst c -> do + let eq1 = Eqn0 cid c a + addToPending solver (Left eq1) + propagate solver + checkInvariant solver + FTApp a1 a2 -> do + let eq1 = Eqn1 cid a1 a2 a + a1' <- getRepresentative solver a1 + a2' <- getRepresentative solver a2 + ret <- lookup solver a1' a2' + case ret of + Just eq2 -> do + addToPending solver $ Right (eq1, eq2) + propagate solver + checkInvariant solver + Nothing -> do + setLookup solver a1' a2' eq1 + lv <- getCurrentLevel solver + gen <- getLevelGen solver lv + modifyIORef' (svUseList solver) $ + IntMap.adjust ((eq1, lv, gen) :) a1' . + IntMap.adjust ((eq1, lv, gen) :) a2' + checkInvariant solver + +propagate :: Solver -> IO () +propagate solver = go + where + go = do + checkInvariant solver + n <- Vec.getSize (svPending solver) + unless (n == 0) $ do + processEqn =<< Vec.unsafePop (svPending solver) + go + + processEqn p = do + let (a,b) = case p of + Left (Eqn0 _ a b) -> (a,b) + Right (Eqn1 _ _ _ a, Eqn1 _ _ _ b) -> (a,b) + a' <- getRepresentative solver a + b' <- getRepresentative solver b + unless (a' == b') $ do + classA <- Vec.unsafeRead (svClassList solver) a' + classB <- Vec.unsafeRead (svClassList solver) b' + (a,b,a',b',classA,classB) <- return $ + if classSize classA < classSize classB then + (a,b,a',b',classA,classB) + else + (b,a,b',a',classB,classA) + origRootA <- updateParent a b p + update a' b' classA classB + addToTrail solver (TrailMerge a' b' a origRootA) + + update a' b' classA classB = do + classForM_ classA $ \c -> do + Vec.unsafeWrite (svRepresentativeTable solver) c b' + Vec.unsafeWrite (svClassList solver) b' (classA <> classB) + + lv <- getCurrentLevel solver + lv_gen <- getLevelGen solver lv + useList <- readIORef (svUseList solver) + useList_a' <- flip filterM (useList IntMap.! a') $ \(eq1@(Eqn1 _ c1 c2 _), lv2, lv2_gen2) -> do + lv2_gen <- getLevelGen solver lv2 + if lv2 <= lv && lv2_gen2 == lv2_gen then do + c1' <- getRepresentative solver c1 + c2' <- getRepresentative solver c2 + assert (b' == c1' || b' == c2') $ return () + -- unless (b' == c1' || b' == c2') $ error "ToySolver.EUF.CongruenceClosure.propagate.update: should not happen" + ret <- lookup solver c1' c2' + case ret of + Just eq2 -> do + addToPending solver $ Right (eq1, eq2) + Nothing -> do + setLookup solver c1' c2' eq1 + modifyIORef (svUseList solver) $ IntMap.adjust ((eq1, lv, lv_gen) :) b' + return () + return True + else do + -- out-of-date entry + return False + modifyIORef' (svUseList solver) (IntMap.insert a' useList_a') + + -- Insert edge a→b labelled with a_eq_b into the proof forest, and re-orient its original ancestors. + updateParent a b a_eq_b = do + let loop d (c, c_eq_d) = do + tbl <- readIORef (svParent solver) + writeIORef (svParent solver) (IntMap.insert d (c, c_eq_d) tbl) + case IntMap.lookup d tbl of + Nothing -> return d + Just (e, d_eq_e) -> loop e (d, d_eq_e) + loop a (b, a_eq_b) + +areCongruent :: Solver -> Term -> Term -> IO Bool +areCongruent solver t1 t2 = do + u1 <- termToFlatTerm solver t1 + u2 <- termToFlatTerm solver t2 + areCongruentFlatTerm solver u1 u2 + +areCongruentFlatTerm :: Solver -> FlatTerm -> FlatTerm -> IO Bool +areCongruentFlatTerm solver t1 t2 = do + initAfterBacktracking solver + u1 <- normalize solver t1 + u2 <- normalize solver t2 + return $ u1 == u2 + +normalize :: Solver -> FlatTerm -> IO FlatTerm +normalize solver (FTConst c) = liftM FTConst $ getRepresentative solver c +normalize solver (FTApp t1 t2) = do + u1 <- getRepresentative solver t1 + u2 <- getRepresentative solver t2 + ret <- lookup solver u1 u2 + case ret of + Just (Eqn1 _ _ _ a) -> liftM FTConst $ getRepresentative solver a + Nothing -> return $ FTApp u1 u2 + +checkInvariant :: Solver -> IO () +checkInvariant _ | True = return () +checkInvariant solver = do + nv <- getNFSyms solver + + representatives <- liftM IntSet.fromList $ Vec.getElems (svRepresentativeTable solver) + + ref <- newIORef IntSet.empty + forM_ (IntSet.toList representatives) $ \a' -> do + bs <- Vec.read (svClassList solver) a' + forM_ (classToList bs) $ \b -> do + b' <- getRepresentative solver b + unless (a' == b') $ + error "ToySolver.EUF.CongruenceClosure.checkInvariant: inconsistency between classList and representativeTable" + modifyIORef' ref (IntSet.insert b) + + xs <- readIORef ref + unless (xs == IntSet.fromList [0..nv-1]) $ + error "ToySolver.EUF.CongruenceClosure.checkInvariant: classList is not exhaustive" + + pendings <- Vec.getElems (svPending solver) + forM_ pendings $ \p -> do + case p of + Left _ -> return () + Right (Eqn1 _ a1 a2 _, Eqn1 _ b1 b2 _) -> do + a1' <- getRepresentative solver a1 + a2' <- getRepresentative solver a2 + b1' <- getRepresentative solver b1 + b2' <- getRepresentative solver b2 + unless (a1' == b1' && a2' == b2') $ + error "ToySolver.EUF.CongruenceClosure.checkInvariant: error in pendingList" + + useList <- readIORef (svUseList solver) + lv <- getCurrentLevel solver + forM_ (IntSet.toList representatives) $ \a -> do + forM_ (useList IntMap.! a) $ \(Eqn1 _ b1 b2 _, lv2, lv2_gen2) -> do + lv2_gen <- getLevelGen solver lv2 + when (lv2 <= lv && lv2_gen2 == lv2_gen) $ do + b1' <- getRepresentative solver b1 + b2' <- getRepresentative solver b2 + unless (a == b1' || a == b2') $ + error "ToySolver.EUF.CongruenceClosure.checkInvariant: error in useList" + + forM_ (IntSet.toList representatives) $ \b -> do + forM_ (IntSet.toList representatives) $ \c -> do + m <- lookup solver b c + case m of + Nothing -> return () + Just (Eqn1 _ a1 a2 _) -> do + a1' <- getRepresentative solver a1 + a2' <- getRepresentative solver a2 + unless (b == a1' && c == a2') $ + error "ToySolver.EUF.CongruenceClosure.checkInvariant: error in lookupTable" + +-- ------------------------------------------------------------------- +-- Explanation +-- ------------------------------------------------------------------- + +explain :: Solver -> Term -> Term -> IO (Maybe IntSet) +explain solver t1 t2 = do + c1 <- termToFlatTerm solver t1 + c2 <- termToFlatTerm solver t2 + explainFlatTerm solver c1 c2 + +explainFlatTerm :: Solver -> FlatTerm -> FlatTerm -> IO (Maybe IntSet) +explainFlatTerm solver t1 t2 = do + c1 <- flatTermToFSym solver t1 + c2 <- flatTermToFSym solver t2 + explainConst solver c1 c2 + +explainConst :: Solver -> FSym -> FSym -> IO (Maybe IntSet) +explainConst solver c1 c2 = do + initAfterBacktracking solver + n <- getNFSyms solver + + -- Additional union-find data structure + forLoop 0 ( do + Vec.unsafeWrite (svERepresentativeTable solver) a a + Vec.unsafeWrite (svEClassList solver) a (ClassSingleton a) + Vec.unsafeWrite (svEHighestNodeTable solver) a a + + let union :: FSym -> FSym -> IO () + union a b = do + a' <- getERepresentative solver a + b' <- getERepresentative solver b + classA <- Vec.unsafeRead (svEClassList solver) a' + classB <- Vec.unsafeRead (svEClassList solver) b' + h <- getHighestNode solver b' + (a', b', classA, classB) <- + if classSize classA < classSize classB then do + return (a', b', classA, classB) + else + return (b', a', classB, classA) + classForM_ classA $ \c -> do + Vec.unsafeWrite (svERepresentativeTable solver) c b' + Vec.unsafeWrite (svEClassList solver) b' (classA <> classB) + Vec.unsafeWrite (svEHighestNodeTable solver) b' h + + Vec.clear (svEPendingProofs solver) + Vec.push (svEPendingProofs solver) (c1,c2) + result <- newIORef IntSet.empty + + let loop = do + n <- Vec.getSize (svEPendingProofs solver) + if n == 0 then + return True + else do + (a,b) <- Vec.unsafePop (svEPendingProofs solver) + m <- nearestCommonAncestor solver a b + case m of + Nothing -> return False + Just c -> do + explainAlongPath a c + explainAlongPath b c + loop + + explainAlongPath :: FSym -> FSym -> IO () + explainAlongPath a c = do + a <- getHighestNode solver a + -- note that c is already @getHighestNode solver c@ + let loop a = + unless (a == c) $ do + Just (b, eq) <- getParent solver a + case eq of + Left (Eqn0 cid _ _) -> do + modifyIORef' result (maybeToIntSet cid <>) + Right (Eqn1 cid1 a1 a2 _, Eqn1 cid2 b1 b2 _) -> do + modifyIORef' result ((maybeToIntSet cid1 <> maybeToIntSet cid2) <>) + Vec.push (svEPendingProofs solver) (a1,b1) + Vec.push (svEPendingProofs solver) (a2,b2) + union a b + loop =<< getHighestNode solver b + loop a + + b <- loop + if b + then liftM Just $ readIORef result + else return Nothing + +-- ------------------------------------------------------------------- +-- Model construction +-- ------------------------------------------------------------------- + +type Entity = Int +type EntityTuple = [Entity] + +data Model + = Model + { mUniverse :: !IntSet + , mFunctions :: !(IntMap (Map EntityTuple Entity)) + , mUnspecified :: !Entity + , mEquivClasses :: [(Set Term, Entity)] + } + deriving (Show) + +getModel :: Solver -> IO Model +getModel solver = do + n <- Vec.getSize (svRepresentativeTable solver) + univRef <- newIORef IntSet.empty + reprRef <- newIORef IntMap.empty + forM_ [0..n-1] $ \a -> do + a' <- Vec.unsafeRead (svRepresentativeTable solver) a + when (a == a') $ modifyIORef' univRef (IntSet.insert a) + modifyIORef' reprRef (IntMap.insert a a') + -- univ <- readIORef univRef + repr <- readIORef reprRef + + lookups <- readIORef (svLookupTable solver) + -- (defs1,_) <- readIORef (svDefs solver) + + let -- "(b,c) ∈ appRel[a]" means f(b,c)=a + appRel :: IntMap (Set (FSym, FSym)) + appRel = IntMap.fromListWith Set.union $ + [ (repr IntMap.! c, Set.singleton (repr IntMap.! a, repr IntMap.! b)) + | (a,m) <- IntMap.toList lookups, (b, Eqn1 _ _ _ c) <- IntMap.toList m + ] + + partialApps :: IntSet + partialApps = IntSet.fromList [b | xs <- IntMap.elems appRel, (b,_) <- Set.toList xs] + + xs1 :: IntMap (Map EntityTuple Entity) + xs1 = IntMap.fromListWith Map.union $ + [ (f, Map.singleton (reverse argsRev) (repr IntMap.! a)) + | a <- IntMap.keys appRel, a `IntSet.notMember` partialApps, (f, argsRev) <- expand a + ] + where + expand :: FSym -> [(FSym, [FSym])] + expand a = + case IntMap.lookup a appRel of + Nothing -> return (repr IntMap.! a, []) + Just xs -> do + (c,d) <- Set.toList xs + (f,xs) <- expand c + return (f, repr IntMap.! d : xs) + + xs2 :: IntMap (Map EntityTuple Entity) + xs2 = IntMap.fromListWith Map.union $ + [ (a, Map.singleton [] a') | (a, a') <- IntMap.toList repr, a `IntMap.notMember` xs1 ] + + funcs :: IntMap (Map EntityTuple Entity) + funcs = IntMap.unionWith Map.union xs1 xs2 + + used :: IntSet + used = IntSet.unions [IntSet.fromList (y : xs) | m <- IntMap.elems funcs, (xs,y) <- Map.toList m] + + classes <- forM (IntSet.toList used) $ \a -> do + classA <- Vec.unsafeRead (svClassList solver) a + classA' <- liftM Set.fromList $ mapM (fsymToTerm solver) (classToList classA) + return (classA', a) + + -- renaming + let univ2 :: IntSet + univ2 = IntSet.insert (-1) $ IntSet.fromList [0 .. IntSet.size used - 1] + + to_univ2' :: IntMap Entity + to_univ2' = IntMap.fromList (zip (IntSet.toList used) [0..]) + + to_univ2 :: FSym -> Entity + to_univ2 = (to_univ2' IntMap.!) + + funcs2 :: IntMap (Map EntityTuple Entity) + funcs2 = fmap (\m -> Map.fromList [(map to_univ2 xs, to_univ2 y) | (xs,y) <- Map.toList m]) funcs + + classes2 :: [(Set Term, Entity)] + classes2 = [(classA, to_univ2 a) | (classA,a) <- classes] + + return $ + Model + { mUniverse = univ2 + , mFunctions = funcs2 + , mUnspecified = -1 + , mEquivClasses = classes2 + } + +eval :: Model -> Term -> Entity +eval m (TApp f xs) = evalAp m f (map (eval m) xs) + +evalAp :: Model -> FSym -> [Entity] -> Entity +evalAp m f xs = + case IntMap.lookup f (mFunctions m) of + Nothing -> mUnspecified m + Just fdef -> + case Map.lookup xs fdef of + Nothing -> mUnspecified m + Just e -> e + +-- ------------------------------------------------------------------- +-- Backtracking +-- ------------------------------------------------------------------- + +type Level = Int +type Gen = Int + +data TrailItem + = TrailMerge !FSym !FSym !FSym !FSym + | TrailSetLookup !FSym !FSym + deriving (Show) + +addToTrail :: Solver -> TrailItem -> IO () +addToTrail solver item = do + lv <- getCurrentLevel solver + when (lv /= 0) $ do + seq item $ Vec.unsafeModify (svTrail solver) (lv - 1) (item :) + +getCurrentLevel :: Solver -> IO Level +getCurrentLevel solver = Vec.getSize (svTrail solver) + +getLevelGen :: Solver -> Level -> IO Gen +getLevelGen solver lv = Vec.unsafeRead (svLevelGen solver) lv + +pushBacktrackPoint :: Solver -> IO () +pushBacktrackPoint solver = do + Vec.push (svTrail solver) [] + lv <- getCurrentLevel solver + size <- Vec.getSize (svLevelGen solver) + if lv < size then do + g <- Vec.unsafeRead (svLevelGen solver) lv + Vec.unsafeWrite (svLevelGen solver) lv (g + 1) + else + Vec.push (svLevelGen solver) 0 + +popBacktrackPoint :: Solver -> IO () +popBacktrackPoint solver = do + writeIORef (svIsAfterBacktracking solver) True + xs <- Vec.unsafePop (svTrail solver) + forM_ xs $ \item -> do + case item of + TrailSetLookup a' b' -> do + modifyIORef' (svLookupTable solver) (IntMap.adjust (IntMap.delete b') a') + TrailMerge a' b' a origRootA -> do + -- Revert changes to Union-Find data strucutres + ClassUnion _ origClassA origClassB <- Vec.unsafeRead (svClassList solver) b' + classForM_ origClassA $ \c -> do + Vec.unsafeWrite (svRepresentativeTable solver) c a' + Vec.unsafeWrite (svClassList solver) b' origClassB + + -- Revert changes to proof-forest data strucutres + let loop c p = do + tbl <- readIORef (svParent solver) + writeIORef (svParent solver) (IntMap.update (const p) c tbl) + unless (c == a) $ do + let (d, c_eq_d) = tbl IntMap.! c + loop d (Just (c, c_eq_d)) + loop origRootA Nothing + +initAfterBacktracking :: Solver -> IO () +initAfterBacktracking solver = do + b <- readIORef (svIsAfterBacktracking solver) + when b $ do + writeIORef (svIsAfterBacktracking solver) False + (defs, _) <- readIORef (svDefs solver) + forM_ (IntMap.toList defs) $ \(a,(a1,a2)) -> do + mergeFlatTerm solver (FTApp a1 a2) a + +{-------------------------------------------------------------------- + Helper funcions +--------------------------------------------------------------------} + +lookup :: Solver -> FSym -> FSym -> IO (Maybe Eqn1) +lookup solver c1 c2 = do + tbl <- readIORef $ svLookupTable solver + return $ do + m <- IntMap.lookup c1 tbl + IntMap.lookup c2 m + +setLookup :: Solver -> FSym -> FSym -> Eqn1 -> IO () +setLookup solver a1 a2 eqn = do + modifyIORef' (svLookupTable solver) $ + IntMap.insertWith IntMap.union a1 (IntMap.singleton a2 eqn) + addToTrail solver (TrailSetLookup a1 a2) + +addToPending :: Solver -> Eqn -> IO () +addToPending solver eqn = Vec.push (svPending solver) eqn + +getRepresentative :: Solver -> FSym -> IO FSym +getRepresentative solver c = Vec.unsafeRead (svRepresentativeTable solver) c + +getParent :: Solver -> FSym -> IO (Maybe (FSym, Eqn)) +getParent solver c = do + m <- readIORef $ svParent solver + return $ IntMap.lookup c m + +getERepresentative :: Solver -> FSym -> IO FSym +getERepresentative solver a = Vec.unsafeRead (svERepresentativeTable solver) a + +getHighestNode :: Solver -> FSym -> IO FSym +getHighestNode solver c = do + d <- getERepresentative solver c + Vec.unsafeRead (svEHighestNodeTable solver) d + +nearestCommonAncestor :: Solver -> FSym -> FSym -> IO (Maybe FSym) +nearestCommonAncestor solver a b = do + let loop c !ret = do + m <- getParent solver c + case m of + Nothing -> return ret + Just (d,_) -> loop d (IntSet.insert d ret) + a_ancestors <- loop a (IntSet.singleton a) + + let loop2 c = do + if c `IntSet.member` a_ancestors then + liftM Just $ getHighestNode solver c + else do + m <- getParent solver c + case m of + Nothing -> return Nothing + Just (d,_) -> loop2 d + loop2 b + +termToFlatTerm :: Solver -> Term -> IO FlatTerm +termToFlatTerm solver (TApp f xs) = do + xs' <- mapM (termToFlatTerm solver) xs + let phi t u = do + t' <- flatTermToFSym solver t + u' <- flatTermToFSym solver u + return $ FTApp t' u' + foldM phi (FTConst f) xs' + +flatTermToFSym :: Solver -> FlatTerm -> IO FSym +flatTermToFSym _ (FTConst c) = return c +flatTermToFSym solver (FTApp c d) = do + (defs1,defs2) <- readIORef $ svDefs solver + a <- case Map.lookup (c,d) defs2 of + Just a -> return a + Nothing -> do + a <- newFSym solver + writeIORef (svDefs solver) (IntMap.insert a (c,d) defs1, Map.insert (c,d) a defs2) + mergeFlatTerm solver (FTApp c d) a + return a + return a + +fsymToFlatTerm :: Solver -> FSym -> IO FlatTerm +fsymToFlatTerm solver a = do + (defs1,_) <- readIORef $ svDefs solver + case IntMap.lookup a defs1 of + Just (c,d) -> return (FTApp c d) + Nothing -> return (FTConst a) + +termToFSym :: Solver -> Term -> IO FSym +termToFSym solver t = flatTermToFSym solver =<< termToFlatTerm solver t + +fsymToTerm :: Solver -> FSym -> IO Term +fsymToTerm solver a = do + (defs1,_) <- readIORef $ svDefs solver + let convert :: FSym -> Term + convert a = + case convert' a of + (f, xs) -> TApp f (reverse xs) + convert' :: FSym -> (FSym, [Term]) + convert' a = + case IntMap.lookup a defs1 of + Nothing -> (a, []) + Just (c,d) -> + case convert' c of + (f,xs) -> (f, convert d : xs) + return (convert a) + +maybeToIntSet :: Maybe Int -> IntSet +maybeToIntSet Nothing = IntSet.empty +maybeToIntSet (Just x) = IntSet.singleton x diff --git a/src/ToySolver/EUF/EUFSolver.hs b/src/ToySolver/EUF/EUFSolver.hs new file mode 100644 --- /dev/null +++ b/src/ToySolver/EUF/EUFSolver.hs @@ -0,0 +1,199 @@ +{-# LANGUAGE CPP #-} +----------------------------------------------------------------------------- +-- | +-- Module : ToySolver.EUF.EUFSolver +-- Copyright : (c) Masahiro Sakai 2015 +-- License : BSD-style +-- +-- Maintainer : masahiro.sakai@gmail.com +-- Stability : unstable +-- Portability : non-portable (CPP) +-- +----------------------------------------------------------------------------- +module ToySolver.EUF.EUFSolver + ( -- * The @Solver@ type + Solver + , newSolver + + -- * Problem description + , FSym + , Term (..) + , ConstrID + , VAFun (..) + , newFSym + , newFun + , newConst + , assertEqual + , assertEqual' + , assertNotEqual + , assertNotEqual' + + -- * Query + , check + , areEqual + + -- * Explanation + , explain + + -- * Model Construction + , Entity + , EntityTuple + , Model (..) + , getModel + , eval + , evalAp + + -- * Backtracking + , pushBacktrackPoint + , popBacktrackPoint + + -- * Low-level operations + , termToFlatTerm + , termToFSym + , fsymToTerm + , fsymToFlatTerm + , flatTermToFSym + ) where + +import Control.Monad +import Control.Monad.Trans +import Control.Monad.Trans.Except +import Data.Either +import Data.IntSet (IntSet) +import qualified Data.IntSet as IntSet +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Set (Set) +import qualified Data.Set as Set +import Data.IORef + +import qualified ToySolver.Internal.Data.Vec as Vec +import ToySolver.EUF.CongruenceClosure (FSym, Term (..), ConstrID, VAFun (..)) +import ToySolver.EUF.CongruenceClosure (Model (..), Entity, EntityTuple, eval, evalAp) +import qualified ToySolver.EUF.CongruenceClosure as CC + +data Solver + = Solver + { svCCSolver :: !CC.Solver + , svDisequalities :: IORef (Map (Term, Term) (Maybe ConstrID)) + , svExplanation :: IORef IntSet + , svBacktrackPoints :: !(Vec.Vec (Map (Term, Term) ())) + } + +newSolver :: IO Solver +newSolver = do + cc <- CC.newSolver + deqs <- newIORef Map.empty + expl <- newIORef undefined + bp <- Vec.new + + let solver = + Solver + { svCCSolver = cc + , svDisequalities = deqs + , svExplanation = expl + , svBacktrackPoints = bp + } + return solver + +newFSym :: Solver -> IO FSym +newFSym solver = CC.newFSym (svCCSolver solver) + +newConst :: Solver -> IO Term +newConst solver = CC.newConst (svCCSolver solver) + +newFun :: CC.VAFun a => Solver -> IO a +newFun solver = CC.newFun (svCCSolver solver) + +assertEqual :: Solver -> Term -> Term -> IO () +assertEqual solver t1 t2 = assertEqual' solver t1 t2 Nothing + +assertEqual' :: Solver -> Term -> Term -> Maybe ConstrID -> IO () +assertEqual' solver t1 t2 cid = CC.merge' (svCCSolver solver) t1 t2 cid + +assertNotEqual :: Solver -> Term -> Term -> IO () +assertNotEqual solver t1 t2 = assertNotEqual' solver t1 t2 Nothing + +assertNotEqual' :: Solver -> Term -> Term -> Maybe ConstrID -> IO () +assertNotEqual' solver t1 t2 cid = if t1 < t2 then f (t1,t2) cid else f (t2,t1) cid + where + f deq cid = do + ds <- readIORef (svDisequalities solver) + unless (deq `Map.member` ds) $ do + _ <- termToFSym solver (fst deq) -- It is important to name the term for model generation + _ <- termToFSym solver (snd deq) -- It is important to name the term for model generation + writeIORef (svDisequalities solver) $! Map.insert deq cid ds + lv <- getCurrentLevel solver + unless (lv==0) $ do + Vec.unsafeModify' (svBacktrackPoints solver) (lv - 1) $ Map.insert deq () + +check :: Solver -> IO Bool +check solver = do + ds <- readIORef (svDisequalities solver) + liftM isRight $ runExceptT $ forM_ (Map.toList ds) $ \((t1,t2), cid) -> do + b <- lift $ CC.areCongruent (svCCSolver solver) t1 t2 + if b then do + Just cs <- lift $ CC.explain (svCCSolver solver) t1 t2 + lift $ writeIORef (svExplanation solver) $! + case cid of + Nothing -> cs + Just c -> IntSet.insert c cs + throwE () + else + return () + +areEqual :: Solver -> Term -> Term -> IO Bool +areEqual solver t1 t2 = CC.areCongruent (svCCSolver solver) t1 t2 + +explain :: Solver -> Maybe (Term,Term) -> IO IntSet +explain solver Nothing = readIORef (svExplanation solver) +explain solver (Just (t1,t2)) = do + ret <- CC.explain (svCCSolver solver) t1 t2 + case ret of + Nothing -> error "ToySolver.EUF.EUFSolver.explain: should not happen" + Just cs -> return cs + +-- ------------------------------------------------------------------- +-- Model construction +-- ------------------------------------------------------------------- + +getModel :: Solver -> IO Model +getModel = CC.getModel . svCCSolver + +-- ------------------------------------------------------------------- +-- Backtracking +-- ------------------------------------------------------------------- + +type Level = Int + +getCurrentLevel :: Solver -> IO Level +getCurrentLevel solver = Vec.getSize (svBacktrackPoints solver) + +pushBacktrackPoint :: Solver -> IO () +pushBacktrackPoint solver = do + CC.pushBacktrackPoint (svCCSolver solver) + Vec.push (svBacktrackPoints solver) Map.empty + +popBacktrackPoint :: Solver -> IO () +popBacktrackPoint solver = do + lv <- getCurrentLevel solver + if lv==0 then + error "ToySolver.EUF.EUFSolver.popBacktrackPoint: root level" + else do + CC.popBacktrackPoint (svCCSolver solver) + xs <- Vec.unsafePop (svBacktrackPoints solver) + modifyIORef' (svDisequalities solver) $ (`Map.difference` xs) + +termToFlatTerm = CC.termToFlatTerm . svCCSolver +termToFSym = CC.termToFSym . svCCSolver +fsymToTerm = CC.fsymToTerm . svCCSolver +fsymToFlatTerm = CC.fsymToFlatTerm . svCCSolver +flatTermToFSym = CC.flatTermToFSym . svCCSolver + +#if !MIN_VERSION_base(4,7,0) + +isRight :: Either a b -> Bool +isRight (Left _) = False +isRight (Right _) = True + +#endif diff --git a/src/ToySolver/EUF/FiniteModelFinder.hs b/src/ToySolver/EUF/FiniteModelFinder.hs new file mode 100644 --- /dev/null +++ b/src/ToySolver/EUF/FiniteModelFinder.hs @@ -0,0 +1,637 @@ +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, ScopedTypeVariables, MultiParamTypeClasses #-} +----------------------------------------------------------------------------- +-- | +-- Module : ToySolver.EUF.FiniteModelFinder +-- Copyright : (c) Masahiro Sakai 2012, 2015 +-- License : BSD-style +-- +-- Maintainer : masahiro.sakai@gmail.com +-- Stability : provisional +-- Portability : non-portable (TypeSynonymInstances, FlexibleInstances, ScopedTypeVariables, MultiParamTypeClasses) +-- +-- A simple model finder. +-- +-- References: +-- +-- * Koen Claessen and Niklas Sörensson. +-- New Techniques that Improve MACE-style Finite Model Finding. +-- CADE-19. 2003. +-- +-- +----------------------------------------------------------------------------- +module ToySolver.EUF.FiniteModelFinder + ( + -- * Formula types + Var + , FSym + , PSym + , GenLit (..) + , Term (..) + , Atom (..) + , Lit + , Clause + , Formula + , GenFormula (..) + , toSkolemNF + + -- * Model types + , Model (..) + , Entity + , EntityTuple + , showModel + , showEntity + , evalFormula + , evalAtom + , evalTerm + , evalLit + , evalClause + , evalClauses + , evalClausesU + + -- * Main function + , findModel + ) where + +import Control.Monad +import Control.Monad.State +import Data.Array.IArray +import Data.IORef +import Data.List +import Data.Maybe +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Set (Set) +import qualified Data.Set as Set +import Text.Printf + +import ToySolver.Data.Boolean +import qualified ToySolver.SAT as SAT + +-- --------------------------------------------------------------------------- + +-- | Variable +type Var = String + +-- | Function Symbol +type FSym = String + +-- | Predicate Symbol +type PSym = String + +class Vars a where + vars :: a -> Set Var + +instance Vars a => Vars [a] where + vars = Set.unions . map vars + +-- | Generalized literal type parameterized by atom type +data GenLit a + = Pos a + | Neg a + deriving (Show, Eq, Ord) + +instance Complement (GenLit a) where + notB (Pos a) = Neg a + notB (Neg a) = Pos a + +instance Vars a => Vars (GenLit a) where + vars (Pos a) = vars a + vars (Neg a) = vars a + +-- --------------------------------------------------------------------------- + +-- | Term +data Term + = TmApp FSym [Term] + | TmVar Var + deriving (Show, Eq, Ord) + +data Atom = PApp PSym [Term] + deriving (Show, Eq, Ord) + +type Lit = GenLit Atom + +type Clause = [Lit] + +instance Vars Term where + vars (TmVar v) = Set.singleton v + vars (TmApp _ ts) = vars ts + +instance Vars Atom where + vars (PApp _ ts) = vars ts + +-- --------------------------------------------------------------------------- + +-- Formula type +type Formula = GenFormula Atom + +-- Generalized formula parameterized by atom type +data GenFormula a + = T + | F + | Atom a + | And (GenFormula a) (GenFormula a) + | Or (GenFormula a) (GenFormula a) + | Not (GenFormula a) + | Imply (GenFormula a) (GenFormula a) + | Equiv (GenFormula a) (GenFormula a) + | Forall Var (GenFormula a) + | Exists Var (GenFormula a) + deriving (Show, Eq, Ord) + +instance MonotoneBoolean (GenFormula a) where + true = T + false = F + (.&&.) = And + (.||.) = Or + +instance Complement (GenFormula a) where + notB = Not + +instance IfThenElse (GenFormula a) (GenFormula a) where + ite = iteBoolean + +instance Boolean (GenFormula a) where + (.=>.) = Imply + (.<=>.) = Equiv + +instance Vars a => Vars (GenFormula a) where + vars T = Set.empty + vars F = Set.empty + vars (Atom a) = vars a + vars (And phi psi) = vars phi `Set.union` vars psi + vars (Or phi psi) = vars phi `Set.union` vars psi + vars (Not phi) = vars phi + vars (Imply phi psi) = vars phi `Set.union` vars psi + vars (Equiv phi psi) = vars phi `Set.union` vars psi + vars (Forall v phi) = Set.delete v (vars phi) + vars (Exists v phi) = Set.delete v (vars phi) + +toNNF :: Formula -> Formula +toNNF = f + where + f (And phi psi) = f phi .&&. f psi + f (Or phi psi) = f phi .||. f psi + f (Not phi) = g phi + f (Imply phi psi) = g phi .||. f psi + f (Equiv phi psi) = f ((phi .=>. psi) .&&. (psi .=>. phi)) + f (Forall v phi) = Forall v (f phi) + f (Exists v phi) = Exists v (f phi) + f phi = phi + + g :: Formula -> Formula + g T = F + g F = T + g (And phi psi) = g phi .||. g psi + g (Or phi psi) = g phi .&&. g psi + g (Not phi) = f phi + g (Imply phi psi) = f phi .&&. g psi + g (Equiv phi psi) = g ((phi .=>. psi) .&&. (psi .=>. phi)) + g (Forall v phi) = Exists v (g phi) + g (Exists v phi) = Forall v (g phi) + g (Atom a) = notB (Atom a) + +-- | normalize a formula into a skolem normal form. +-- +-- TODO: +-- +-- * Tseitin encoding +toSkolemNF :: forall m. Monad m => (String -> Int -> m FSym) -> Formula -> m [Clause] +toSkolemNF skolem phi = f [] Map.empty (toNNF phi) + where + f :: [Var] -> Map Var Term -> Formula -> m [Clause] + f _ _ T = return [] + f _ _ F = return [[]] + f _ s (Atom a) = return [[Pos (substAtom s a)]] + f _ s (Not (Atom a)) = return [[Neg (substAtom s a)]] + f uvs s (And phi psi) = do + phi' <- f uvs s phi + psi' <- f uvs s psi + return $ phi' ++ psi' + f uvs s (Or phi psi) = do + phi' <- f uvs s phi + psi' <- f uvs s psi + return $ [c1++c2 | c1 <- phi', c2 <- psi'] + f uvs s psi@(Forall v phi) = do + let v' = gensym v (vars psi `Set.union` Set.fromList uvs) + f (v' : uvs) (Map.insert v (TmVar v') s) phi + f uvs s (Exists v phi) = do + fsym <- skolem v (length uvs) + f uvs (Map.insert v (TmApp fsym [TmVar v | v <- reverse uvs]) s) phi + f _ _ _ = error "ToySolver.EUF.FiniteModelFinder.toSkolemNF: should not happen" + + gensym :: String -> Set Var -> Var + gensym template vs = head [name | name <- names, Set.notMember name vs] + where + names = template : [template ++ show n | n <-[1..]] + + substAtom :: Map Var Term -> Atom -> Atom + substAtom s (PApp p ts) = PApp p (map (substTerm s) ts) + + substTerm :: Map Var Term -> Term -> Term + substTerm s (TmVar v) = fromMaybe (TmVar v) (Map.lookup v s) + substTerm s (TmApp f ts) = TmApp f (map (substTerm s) ts) + +test_toSkolemNF = do + ref <- newIORef 0 + let skolem name _ = do + n <- readIORef ref + let fsym = name ++ "#" ++ show n + writeIORef ref (n+1) + return fsym + + -- ∀x. animal(a) → (∃y. heart(y) ∧ has(x,y)) + let phi = Forall "x" $ + Atom (PApp "animal" [TmVar "x"]) .=>. + (Exists "y" $ + Atom (PApp "heart" [TmVar "y"]) .&&. + Atom (PApp "has" [TmVar "x", TmVar "y"])) + + phi' <- toSkolemNF skolem phi + + print phi' +{- +[[Neg (PApp "animal" [TmVar "x"]),Pos (PApp "heart" [TmApp "y#0" [TmVar "x"]])],[Neg (PApp "animal" [TmVar "x"]),Pos (PApp "has" [TmVar "x",TmApp "y#0" [TmVar "x"]])]] + +{¬animal(x) ∨ heart(y#1(x)), ¬animal(x) ∨ has(x1, y#0(x))} +-} + +-- --------------------------------------------------------------------------- + +-- | Shallow term +data SGenTerm v + = STmApp FSym [v] + | STmVar v + deriving (Show, Eq, Ord) + +-- | Shallow atom +data SGenAtom v + = SPApp PSym [v] + | SEq (SGenTerm v) v + deriving (Show, Eq, Ord) + +type STerm = SGenTerm Var +type SAtom = SGenAtom Var +type SLit = GenLit SAtom +type SClause = [SLit] + +instance Vars STerm where + vars (STmApp _ xs) = Set.fromList xs + vars (STmVar v) = Set.singleton v + +instance Vars SAtom where + vars (SPApp _ xs) = Set.fromList xs + vars (SEq t v) = Set.insert v (vars t) + +-- --------------------------------------------------------------------------- + +type M = State (Set Var, Int, Map (FSym, [Var]) Var, [SLit]) + +flatten :: Clause -> Maybe SClause +flatten c = + case runState (mapM flattenLit c) (vars c, 0, Map.empty, []) of + (c, (_,_,_,ls)) -> removeTautology $ removeNegEq $ ls ++ c + where + gensym :: M Var + gensym = do + (vs, n, defs, ls) <- get + let go :: Int -> M Var + go m = do + let v = "#" ++ show m + if v `Set.member` vs + then go (m+1) + else do + put (Set.insert v vs, m+1, defs, ls) + return v + go n + + flattenLit :: Lit -> M SLit + flattenLit (Pos a) = liftM Pos $ flattenAtom a + flattenLit (Neg a) = liftM Neg $ flattenAtom a + + flattenAtom :: Atom -> M SAtom + flattenAtom (PApp "=" [TmVar x, TmVar y]) = return $ SEq (STmVar x) y + flattenAtom (PApp "=" [TmVar x, TmApp f ts]) = do + xs <- mapM flattenTerm ts + return $ SEq (STmApp f xs) x + flattenAtom (PApp "=" [TmApp f ts, TmVar x]) = do + xs <- mapM flattenTerm ts + return $ SEq (STmApp f xs) x + flattenAtom (PApp "=" [TmApp f ts, t2]) = do + xs <- mapM flattenTerm ts + x <- flattenTerm t2 + return $ SEq (STmApp f xs) x + flattenAtom (PApp p ts) = do + xs <- mapM flattenTerm ts + return $ SPApp p xs + + flattenTerm :: Term -> M Var + flattenTerm (TmVar x) = return x + flattenTerm (TmApp f ts) = do + xs <- mapM flattenTerm ts + (_, _, defs, _) <- get + case Map.lookup (f, xs) defs of + Just x -> return x + Nothing -> do + x <- gensym + (vs, n, defs, ls) <- get + put (vs, n, Map.insert (f, xs) x defs, Neg (SEq (STmApp f xs) x) : ls) + return x + + removeNegEq :: SClause -> SClause + removeNegEq = go [] + where + go r [] = r + go r (Neg (SEq (STmVar x) y) : ls) = go (map (substLit x y) r) (map (substLit x y) ls) + go r (l : ls) = go (l : r) ls + + substLit :: Var -> Var -> SLit -> SLit + substLit x y (Pos a) = Pos $ substAtom x y a + substLit x y (Neg a) = Neg $ substAtom x y a + + substAtom :: Var -> Var -> SAtom -> SAtom + substAtom x y (SPApp p xs) = SPApp p (map (substVar x y) xs) + substAtom x y (SEq t v) = SEq (substTerm x y t) (substVar x y v) + + substTerm :: Var -> Var -> STerm -> STerm + substTerm x y (STmApp f xs) = STmApp f (map (substVar x y) xs) + substTerm x y (STmVar v) = STmVar (substVar x y v) + + substVar :: Var -> Var -> Var -> Var + substVar x y v + | v==x = y + | otherwise = v + + removeTautology :: SClause -> Maybe SClause + removeTautology lits + | Set.null (pos `Set.intersection` neg) = Just $ [Neg l | l <- Set.toList neg] ++ [Pos l | l <- Set.toList pos] + | otherwise = Nothing + where + pos = Set.fromList [l | Pos l <- lits] + neg = Set.fromList [l | Neg l <- lits] + +test_flatten = flatten [Pos $ PApp "P" [TmApp "a" [], TmApp "f" [TmVar "x"]]] + +{- +[Pos $ PApp "P" [TmApp "a" [], TmApp "f" [TmVar "x"]]] + +P(a, f(x)) + +[Pos (SPApp "P" ["#0","#1"]),Neg (SEq (STmApp "a" []) "#0"),Neg (SEq (STmApp "f" ["x"]) "#1")] + +f(x) ≠ z ∨ a ≠ y ∨ P(y,z) +(f(x) = z ∧ a = y) → P(y,z) +-} + +-- --------------------------------------------------------------------------- + +-- | Element of model. +type Entity = Int + +type EntityTuple = [Entity] + +-- | print entity +showEntity :: Entity -> String +showEntity e = "$" ++ show e + +showEntityTuple :: EntityTuple -> String +showEntityTuple xs = printf "(%s)" $ intercalate ", " $ map showEntity xs + +-- --------------------------------------------------------------------------- + +type GroundTerm = SGenTerm Entity +type GroundAtom = SGenAtom Entity +type GroundLit = GenLit GroundAtom +type GroundClause = [GroundLit] + +type Subst = Map Var Entity + +enumSubst :: Set Var -> [Entity] -> [Subst] +enumSubst vs univ = do + ps <- sequence [[(v,e) | e <- univ] | v <- Set.toList vs] + return $ Map.fromList ps + +applySubst :: Subst -> SClause -> GroundClause +applySubst s = map substLit + where + substLit :: SLit -> GroundLit + substLit (Pos a) = Pos $ substAtom a + substLit (Neg a) = Neg $ substAtom a + + substAtom :: SAtom -> GroundAtom + substAtom (SPApp p xs) = SPApp p (map substVar xs) + substAtom (SEq t v) = SEq (substTerm t) (substVar v) + + substTerm :: STerm -> GroundTerm + substTerm (STmApp f xs) = STmApp f (map substVar xs) + substTerm (STmVar v) = STmVar (substVar v) + + substVar :: Var -> Entity + substVar = (s Map.!) + +simplifyGroundClause :: GroundClause -> Maybe GroundClause +simplifyGroundClause = liftM concat . mapM f + where + f :: GroundLit -> Maybe [GroundLit] + f (Pos (SEq (STmVar x) y)) = if x==y then Nothing else return [] + f lit = return [lit] + +collectFSym :: Clause -> Set (FSym, Int) +collectFSym = Set.unions . map f + where + f :: Lit -> Set (FSym, Int) + f (Pos a) = g a + f (Neg a) = g a + + g :: Atom -> Set (FSym, Int) + g (PApp _ xs) = Set.unions $ map h xs + + h :: Term -> Set (FSym, Int) + h (TmVar _) = Set.empty + h (TmApp f xs) = Set.unions $ Set.singleton (f, length xs) : map h xs + +collectPSym :: Clause -> Set (PSym, Int) +collectPSym = Set.unions . map f + where + f :: Lit -> Set (PSym, Int) + f (Pos a) = g a + f (Neg a) = g a + + g :: Atom -> Set (PSym, Int) + g (PApp "=" [_,_]) = Set.empty + g (PApp p xs) = Set.singleton (p, length xs) + +-- --------------------------------------------------------------------------- + +data Model + = Model + { mUniverse :: [Entity] + , mRelations :: Map PSym (Set EntityTuple) + , mFunctions :: Map FSym (Map EntityTuple Entity) + } + +showModel :: Model -> [String] +showModel m = + printf "DOMAIN = {%s}" (intercalate ", " (map showEntity (mUniverse m))) : + [ printf "%s = { %s }" p s + | (p, xss) <- Map.toList (mRelations m) + , let s = intercalate ", " [if length xs == 1 then showEntity (head xs) else showEntityTuple xs | xs <- Set.toList xss] + ] ++ + [ printf "%s%s = %s" f (if length xs == 0 then "" else showEntityTuple xs) (showEntity y) + | (f, xss) <- Map.toList (mFunctions m) + , (xs, y) <- Map.toList xss + ] + +evalFormula :: Model -> Formula -> Bool +evalFormula m = f Map.empty + where + f :: Map Var Entity -> Formula -> Bool + f env T = True + f env F = False + f env (Atom a) = evalAtom m env a + f env (And phi1 phi2) = f env phi1 && f env phi2 + f env (Or phi1 phi2) = f env phi1 || f env phi2 + f env (Not phi) = not (f env phi) + f env (Imply phi1 phi2) = not (f env phi1) || f env phi2 + f env (Equiv phi1 phi2) = f env phi1 == f env phi2 + f env (Forall v phi) = all (\e -> f (Map.insert v e env) phi) (mUniverse m) + f env (Exists v phi) = any (\e -> f (Map.insert v e env) phi) (mUniverse m) + +evalAtom :: Model -> Map Var Entity -> Atom -> Bool +evalAtom m env (PApp "=" [x1,x2]) = evalTerm m env x1 == evalTerm m env x2 +evalAtom m env (PApp p xs) = map (evalTerm m env) xs `Set.member` (mRelations m Map.! p) + +evalTerm :: Model -> Map Var Entity -> Term -> Entity +evalTerm m env (TmVar v) = env Map.! v +evalTerm m env (TmApp f xs) = (mFunctions m Map.! f) Map.! map (evalTerm m env) xs + +evalLit :: Model -> Map Var Entity -> Lit -> Bool +evalLit m env (Pos atom) = evalAtom m env atom +evalLit m env (Neg atom) = not $ evalAtom m env atom + +evalClause :: Model -> Map Var Entity -> Clause -> Bool +evalClause m env = any (evalLit m env) + +evalClauses :: Model -> Map Var Entity -> [Clause] -> Bool +evalClauses m env = all (evalClause m env) + +evalClausesU :: Model -> [Clause] -> Bool +evalClausesU m cs = all (\env -> evalClauses m env cs) (enumSubst (vars cs) (mUniverse m)) + +-- --------------------------------------------------------------------------- + +findModel :: Int -> [Clause] -> IO (Maybe Model) +findModel size cs = do + let univ = [0..size-1] + + let cs2 = mapMaybe flatten cs + fs = Set.unions $ map collectFSym cs + ps = Set.unions $ map collectPSym cs + + solver <- SAT.newSolver + + ref <- newIORef Map.empty + + let translateAtom :: GroundAtom -> IO SAT.Var + translateAtom (SEq (STmVar _) _) = error "should not happen" + translateAtom a = do + m <- readIORef ref + case Map.lookup a m of + Just b -> return b + Nothing -> do + b <- SAT.newVar solver + writeIORef ref (Map.insert a b m) + return b + + translateLit :: GroundLit -> IO SAT.Lit + translateLit (Pos a) = translateAtom a + translateLit (Neg a) = liftM negate $ translateAtom a + + translateClause :: GroundClause -> IO SAT.Clause + translateClause = mapM translateLit + + -- Instances + forM_ cs2 $ \c -> do + forM_ (enumSubst (vars c) univ) $ \s -> do + case simplifyGroundClause (applySubst s c) of + Nothing -> return () + Just c' -> SAT.addClause solver =<< translateClause c' + + -- Functional definitions + forM_ (Set.toList fs) $ \(f, arity) -> do + forM_ (replicateM arity univ) $ \args -> + forM_ [(y1,y2) | y1 <- univ, y2 <- univ, y1 < y2] $ \(y1,y2) -> do + let c = [Neg (SEq (STmApp f args) y1), Neg (SEq (STmApp f args) y2)] + c' <- translateClause c + SAT.addClause solver c' + + -- Totality definitions + forM_ (Set.toList fs) $ \(f, arity) -> do + forM_ (replicateM arity univ) $ \args -> do + let c = [Pos (SEq (STmApp f args) y) | y <- univ] + c' <- translateClause c + SAT.addClause solver c' + + ret <- SAT.solve solver + if ret + then do + bmodel <- SAT.getModel solver + m <- readIORef ref + + let rels = Map.fromList $ do + (p,_) <- Set.toList ps + let tbl = Set.fromList [xs | (SPApp p' xs, b) <- Map.toList m, p == p', bmodel ! b] + return (p, tbl) + let funs = Map.fromList $ do + (f,_) <- Set.toList fs + let tbl = Map.fromList [(xs, y) | (SEq (STmApp f' xs) y, b) <- Map.toList m, f == f', bmodel ! b] + return (f, tbl) + + let model = Model + { mUniverse = univ + , mRelations = rels + , mFunctions = funs + } + + return (Just model) + else do + return Nothing + +-- --------------------------------------------------------------------------- + +{- +∀x. ∃y. x≠y && f(y)=x +∀x. x≠g(x) ∧ f(g(x))=x +-} + +test = do + let c1 = [Pos $ PApp "=" [TmApp "f" [TmApp "g" [TmVar "x"]], TmVar "x"]] + c2 = [Neg $ PApp "=" [TmVar "x", TmApp "g" [TmVar "x"]]] + ret <- findModel 3 [c1, c2] + case ret of + Nothing -> putStrLn "=== NO MODEL FOUND ===" + Just m -> do + putStrLn "=== A MODEL FOUND ===" + mapM_ putStrLn $ showModel m + +test2 = do + let phi = Forall "x" $ Exists "y" $ + notB (Atom (PApp "=" [TmVar "x", TmVar "y"])) .&&. + Atom (PApp "=" [TmApp "f" [TmVar "y"], TmVar "x"]) + + ref <- newIORef 0 + let skolem name _ = do + n <- readIORef ref + let fsym = name ++ "#" ++ show n + writeIORef ref (n+1) + return fsym + cs <- toSkolemNF skolem phi + + ret <- findModel 3 cs + case ret of + Nothing -> putStrLn "=== NO MODEL FOUND ===" + Just m -> do + putStrLn "=== A MODEL FOUND ===" + mapM_ putStrLn $ showModel m + +-- --------------------------------------------------------------------------- diff --git a/src/ToySolver/FOLModelFinder.hs b/src/ToySolver/FOLModelFinder.hs deleted file mode 100644 --- a/src/ToySolver/FOLModelFinder.hs +++ /dev/null @@ -1,573 +0,0 @@ -{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, ScopedTypeVariables #-} ------------------------------------------------------------------------------ --- | --- Module : ToySolver.FOLModelFinder --- Copyright : (c) Masahiro Sakai 2012 --- License : BSD-style --- --- Maintainer : masahiro.sakai@gmail.com --- Stability : provisional --- Portability : non-portable (TypeSynonymInstances, FlexibleInstances, ScopedTypeVariables) --- --- A simple model finder. --- --- References: --- --- * Koen Claessen and Niklas Sörensson. --- New Techniques that Improve MACE-style Finite Model Finding. --- CADE-19. 2003. --- --- ------------------------------------------------------------------------------ -module ToySolver.FOLModelFinder - ( - -- * Formula types - Var - , FSym - , PSym - , GenLit (..) - , Term (..) - , Atom (..) - , Lit - , Clause - , Formula - , GenFormula (..) - , toSkolemNF - - -- * Model types - , Model (..) - , Entity - , showModel - , showEntity - - -- * Main function - , findModel - ) where - -import Control.Monad -import Control.Monad.State -import Data.Array.IArray -import Data.IORef -import Data.List -import Data.Maybe -import Data.Map (Map) -import qualified Data.Map as Map -import Data.Set (Set) -import qualified Data.Set as Set -import Text.Printf - -import ToySolver.Data.Boolean -import qualified ToySolver.SAT as SAT - --- --------------------------------------------------------------------------- - --- | Variable -type Var = String - --- | Function Symbol -type FSym = String - --- | Predicate Symbol -type PSym = String - -class Vars a where - vars :: a -> Set Var - -instance Vars a => Vars [a] where - vars = Set.unions . map vars - --- | Generalized literal type parameterized by atom type -data GenLit a - = Pos a - | Neg a - deriving (Show, Eq, Ord) - -instance Complement (GenLit a) where - notB (Pos a) = Neg a - notB (Neg a) = Pos a - -instance Vars a => Vars (GenLit a) where - vars (Pos a) = vars a - vars (Neg a) = vars a - --- --------------------------------------------------------------------------- - --- | Term -data Term - = TmApp FSym [Term] - | TmVar Var - deriving (Show, Eq, Ord) - -data Atom = PApp PSym [Term] - deriving (Show, Eq, Ord) - -type Lit = GenLit Atom - -type Clause = [Lit] - -instance Vars Term where - vars (TmVar v) = Set.singleton v - vars (TmApp _ ts) = vars ts - -instance Vars Atom where - vars (PApp _ ts) = vars ts - --- --------------------------------------------------------------------------- - --- Formula type -type Formula = GenFormula Atom - --- Generalized formula parameterized by atom type -data GenFormula a - = T - | F - | Atom a - | And (GenFormula a) (GenFormula a) - | Or (GenFormula a) (GenFormula a) - | Not (GenFormula a) - | Imply (GenFormula a) (GenFormula a) - | Equiv (GenFormula a) (GenFormula a) - | Forall Var (GenFormula a) - | Exists Var (GenFormula a) - deriving (Show, Eq, Ord) - -instance MonotoneBoolean (GenFormula a) where - true = T - false = F - (.&&.) = And - (.||.) = Or - -instance Complement (GenFormula a) where - notB = Not - -instance Boolean (GenFormula a) where - (.=>.) = Imply - (.<=>.) = Equiv - -instance Vars a => Vars (GenFormula a) where - vars T = Set.empty - vars F = Set.empty - vars (Atom a) = vars a - vars (And phi psi) = vars phi `Set.union` vars psi - vars (Or phi psi) = vars phi `Set.union` vars psi - vars (Not phi) = vars phi - vars (Imply phi psi) = vars phi `Set.union` vars psi - vars (Equiv phi psi) = vars phi `Set.union` vars psi - vars (Forall v phi) = Set.delete v (vars phi) - vars (Exists v phi) = Set.delete v (vars phi) - -toNNF :: Formula -> Formula -toNNF = f - where - f (And phi psi) = f phi .&&. f psi - f (Or phi psi) = f phi .||. f psi - f (Not phi) = g phi - f (Imply phi psi) = g phi .||. f psi - f (Equiv phi psi) = f ((phi .=>. psi) .&&. (psi .=>. phi)) - f (Forall v phi) = Forall v (f phi) - f (Exists v phi) = Exists v (f phi) - f phi = phi - - g :: Formula -> Formula - g T = F - g F = T - g (And phi psi) = g phi .||. g psi - g (Or phi psi) = g phi .&&. g psi - g (Not phi) = f phi - g (Imply phi psi) = f phi .&&. g psi - g (Equiv phi psi) = g ((phi .=>. psi) .&&. (psi .=>. phi)) - g (Forall v phi) = Exists v (g phi) - g (Exists v phi) = Forall v (g phi) - g (Atom a) = notB (Atom a) - --- | normalize a formula into a skolem normal form. --- --- TODO: --- --- * Tseitin encoding -toSkolemNF :: forall m. Monad m => (String -> Int -> m FSym) -> Formula -> m [Clause] -toSkolemNF skolem phi = f [] Map.empty (toNNF phi) - where - f :: [Var] -> Map Var Term -> Formula -> m [Clause] - f _ _ T = return [] - f _ _ F = return [[]] - f _ s (Atom a) = return [[Pos (substAtom s a)]] - f _ s (Not (Atom a)) = return [[Neg (substAtom s a)]] - f uvs s (And phi psi) = do - phi' <- f uvs s phi - psi' <- f uvs s psi - return $ phi' ++ psi' - f uvs s (Or phi psi) = do - phi' <- f uvs s phi - psi' <- f uvs s psi - return $ [c1++c2 | c1 <- phi', c2 <- psi'] - f uvs s psi@(Forall v phi) = do - let v' = gensym v (vars psi `Set.union` Set.fromList uvs) - f (v' : uvs) (Map.insert v (TmVar v') s) phi - f uvs s (Exists v phi) = do - fsym <- skolem v (length uvs) - f uvs (Map.insert v (TmApp fsym [TmVar v | v <- reverse uvs]) s) phi - f _ _ _ = error "ToySolver.FOLModelFinder.toSkolemNF: should not happen" - - gensym :: String -> Set Var -> Var - gensym template vs = head [name | name <- names, Set.notMember name vs] - where - names = template : [template ++ show n | n <-[1..]] - - substAtom :: Map Var Term -> Atom -> Atom - substAtom s (PApp p ts) = PApp p (map (substTerm s) ts) - - substTerm :: Map Var Term -> Term -> Term - substTerm s (TmVar v) = fromMaybe (TmVar v) (Map.lookup v s) - substTerm s (TmApp f ts) = TmApp f (map (substTerm s) ts) - -test_toSkolemNF = do - ref <- newIORef 0 - let skolem name _ = do - n <- readIORef ref - let fsym = name ++ "#" ++ show n - writeIORef ref (n+1) - return fsym - - -- ∀x. animal(a) → (∃y. heart(y) ∧ has(x,y)) - let phi = Forall "x" $ - Atom (PApp "animal" [TmVar "x"]) .=>. - (Exists "y" $ - Atom (PApp "heart" [TmVar "y"]) .&&. - Atom (PApp "has" [TmVar "x", TmVar "y"])) - - phi' <- toSkolemNF skolem phi - - print phi' -{- -[[Neg (PApp "animal" [TmVar "x"]),Pos (PApp "heart" [TmApp "y#0" [TmVar "x"]])],[Neg (PApp "animal" [TmVar "x"]),Pos (PApp "has" [TmVar "x",TmApp "y#0" [TmVar "x"]])]] - -{¬animal(x) ∨ heart(y#1(x)), ¬animal(x) ∨ has(x1, y#0(x))} --} - --- --------------------------------------------------------------------------- - --- | Shallow term -data SGenTerm v - = STmApp FSym [v] - | STmVar v - deriving (Show, Eq, Ord) - --- | Shallow atom -data SGenAtom v - = SPApp PSym [v] - | SEq (SGenTerm v) v - deriving (Show, Eq, Ord) - -type STerm = SGenTerm Var -type SAtom = SGenAtom Var -type SLit = GenLit SAtom -type SClause = [SLit] - -instance Vars STerm where - vars (STmApp _ xs) = Set.fromList xs - vars (STmVar v) = Set.singleton v - -instance Vars SAtom where - vars (SPApp _ xs) = Set.fromList xs - vars (SEq t v) = Set.insert v (vars t) - --- --------------------------------------------------------------------------- - -type M = State (Set Var, Int, [SLit]) - -flatten :: Clause -> SClause -flatten c = - case runState (mapM flattenLit c) (vars c, 0, []) of - (c, (_,_,ls)) -> removeNegEq $ ls ++ c - where - gensym :: M Var - gensym = do - (vs, n, ls) <- get - let go :: Int -> M Var - go m = do - let v = "#" ++ show m - if v `Set.member` vs - then go (m+1) - else do - put (Set.insert v vs, m+1, ls) - return v - go n - - flattenLit :: Lit -> M SLit - flattenLit (Pos a) = liftM Pos $ flattenAtom a - flattenLit (Neg a) = liftM Neg $ flattenAtom a - - flattenAtom :: Atom -> M SAtom - flattenAtom (PApp "=" [TmVar x, TmVar y]) = return $ SEq (STmVar x) y - flattenAtom (PApp "=" [TmVar x, TmApp f ts]) = do - xs <- mapM flattenTerm ts - return $ SEq (STmApp f xs) x - flattenAtom (PApp "=" [TmApp f ts, TmVar x]) = do - xs <- mapM flattenTerm ts - return $ SEq (STmApp f xs) x - flattenAtom (PApp "=" [TmApp f ts, t2]) = do - xs <- mapM flattenTerm ts - x <- flattenTerm t2 - return $ SEq (STmApp f xs) x - flattenAtom (PApp p ts) = do - xs <- mapM flattenTerm ts - return $ SPApp p xs - - flattenTerm :: Term -> M Var - flattenTerm (TmVar x) = return x - flattenTerm (TmApp f ts) = do - xs <- mapM flattenTerm ts - x <- gensym - (vs, n, ls) <- get - put (vs, n, Neg (SEq (STmApp f xs) x) : ls) - return x - - removeNegEq :: SClause -> SClause - removeNegEq = go [] - where - go r [] = r - go r (Neg (SEq (STmVar x) y) : ls) = go (map (substLit x y) r) (map (substLit x y) ls) - go r (l : ls) = go (l : r) ls - - substLit :: Var -> Var -> SLit -> SLit - substLit x y (Pos a) = Pos $ substAtom x y a - substLit x y (Neg a) = Neg $ substAtom x y a - - substAtom :: Var -> Var -> SAtom -> SAtom - substAtom x y (SPApp p xs) = SPApp p (map (substVar x y) xs) - substAtom x y (SEq t v) = SEq (substTerm x y t) (substVar x y v) - - substTerm :: Var -> Var -> STerm -> STerm - substTerm x y (STmApp f xs) = STmApp f (map (substVar x y) xs) - substTerm x y (STmVar v) = STmVar (substVar x y v) - - substVar :: Var -> Var -> Var -> Var - substVar x y v - | v==x = y - | otherwise = v - -test_flatten = flatten [Pos $ PApp "P" [TmApp "a" [], TmApp "f" [TmVar "x"]]] - -{- -[Pos $ PApp "P" [TmApp "a" [], TmApp "f" [TmVar "x"]]] - -P(a, f(x)) - -[Pos (SPApp "P" ["#0","#1"]),Neg (SEq (STmApp "a" []) "#0"),Neg (SEq (STmApp "f" ["x"]) "#1")] - -f(x) ≠ z ∨ a ≠ y ∨ P(y,z) -(f(x) = z ∧ a = y) → P(y,z) --} - --- --------------------------------------------------------------------------- - --- | Element of model. -type Entity = Int - --- | print entity -showEntity :: Entity -> String -showEntity e = "$" ++ show e - -showEntityTuple :: [Entity] -> String -showEntityTuple xs = printf "(%s)" $ intercalate ", " $ map showEntity xs - --- --------------------------------------------------------------------------- - -type GroundTerm = SGenTerm Entity -type GroundAtom = SGenAtom Entity -type GroundLit = GenLit GroundAtom -type GroundClause = [GroundLit] - -type Subst = Map Var Entity - -enumSubst :: Set Var -> [Entity] -> [Subst] -enumSubst vs univ = do - ps <- sequence [[(v,e) | e <- univ] | v <- Set.toList vs] - return $ Map.fromList ps - -applySubst :: Subst -> SClause -> GroundClause -applySubst s = map substLit - where - substLit :: SLit -> GroundLit - substLit (Pos a) = Pos $ substAtom a - substLit (Neg a) = Neg $ substAtom a - - substAtom :: SAtom -> GroundAtom - substAtom (SPApp p xs) = SPApp p (map substVar xs) - substAtom (SEq t v) = SEq (substTerm t) (substVar v) - - substTerm :: STerm -> GroundTerm - substTerm (STmApp f xs) = STmApp f (map substVar xs) - substTerm (STmVar v) = STmVar (substVar v) - - substVar :: Var -> Entity - substVar = (s Map.!) - -simplifyGroundClause :: GroundClause -> Maybe GroundClause -simplifyGroundClause = liftM concat . mapM f - where - f :: GroundLit -> Maybe [GroundLit] - f (Pos (SEq (STmVar x) y)) = if x==y then Nothing else return [] - f lit = return [lit] - -collectFSym :: SClause -> Set (FSym, Int) -collectFSym = Set.unions . map f - where - f :: SLit -> Set (FSym, Int) - f (Pos a) = g a - f (Neg a) = g a - - g :: SAtom -> Set (FSym, Int) - g (SEq (STmApp f xs) _) = Set.singleton (f, length xs) - g _ = Set.empty - -collectPSym :: SClause -> Set (PSym, Int) -collectPSym = Set.unions . map f - where - f :: SLit -> Set (PSym, Int) - f (Pos a) = g a - f (Neg a) = g a - - g :: SAtom -> Set (PSym, Int) - g (SPApp p xs) = Set.singleton (p, length xs) - g _ = Set.empty - --- --------------------------------------------------------------------------- - -data Model - = Model - { mUniverse :: [Entity] - , mRelations :: Map PSym [[Entity]] - , mFunctions :: Map FSym [([Entity], Entity)] - } - -showModel :: Model -> [String] -showModel m = - printf "DOMAIN = {%s}" (intercalate ", " (map showEntity (mUniverse m))) : - [ printf "%s = { %s }" p s - | (p, xss) <- Map.toList (mRelations m) - , let s = intercalate ", " [if length xs == 1 then showEntity (head xs) else showEntityTuple xs | xs <- xss] - ] ++ - [ printf "%s%s = %s" f (if length xs == 0 then "" else showEntityTuple xs) (showEntity y) - | (f, xss) <- Map.toList (mFunctions m) - , (xs, y) <- xss - ] - --- --------------------------------------------------------------------------- - -findModel :: Int -> [Clause] -> IO (Maybe Model) -findModel size cs = do - let univ = [0..size-1] - - let cs2 = map flatten cs - fs = Set.unions $ map collectFSym cs2 - ps = Set.unions $ map collectPSym cs2 - - solver <- SAT.newSolver - - ref <- newIORef Map.empty - - let translateAtom :: GroundAtom -> IO SAT.Var - translateAtom (SEq (STmVar _) _) = error "should not happen" - translateAtom a = do - m <- readIORef ref - case Map.lookup a m of - Just b -> return b - Nothing -> do - b <- SAT.newVar solver - writeIORef ref (Map.insert a b m) - return b - - translateLit :: GroundLit -> IO SAT.Lit - translateLit (Pos a) = translateAtom a - translateLit (Neg a) = liftM negate $ translateAtom a - - translateClause :: GroundClause -> IO SAT.Clause - translateClause = mapM translateLit - - -- Instances - forM_ cs2 $ \c -> do - forM_ (enumSubst (vars c) univ) $ \s -> do - case simplifyGroundClause (applySubst s c) of - Nothing -> return () - Just c' -> SAT.addClause solver =<< translateClause c' - - -- Functional definitions - forM_ (Set.toList fs) $ \(f, arity) -> do - forM_ (replicateM arity univ) $ \args -> - forM_ [(y1,y2) | y1 <- univ, y2 <- univ, y1 < y2] $ \(y1,y2) -> do - let c = [Neg (SEq (STmApp f args) y1), Neg (SEq (STmApp f args) y2)] - c' <- translateClause c - SAT.addClause solver c' - - -- Totality definitions - forM_ (Set.toList fs) $ \(f, arity) -> do - forM_ (replicateM arity univ) $ \args -> do - let c = [Pos (SEq (STmApp f args) y) | y <- univ] - c' <- translateClause c - SAT.addClause solver c' - - ret <- SAT.solve solver - if ret - then do - bmodel <- SAT.getModel solver - m <- readIORef ref - - let rels = Map.fromList $ do - (p,_) <- Set.toList ps - let tbl = sort [xs | (SPApp p' xs, b) <- Map.toList m, p == p', bmodel ! b] - return (p, tbl) - let funs = Map.fromList $ do - (f,_) <- Set.toList fs - let tbl = sort [(xs, y) | (SEq (STmApp f' xs) y, b) <- Map.toList m, f == f', bmodel ! b] - return (f, tbl) - - let model = Model - { mUniverse = univ - , mRelations = rels - , mFunctions = funs - } - - return (Just model) - else do - return Nothing - --- --------------------------------------------------------------------------- - -{- -∀x. ∃y. x≠y && f(y)=x -∀x. x≠g(x) ∧ f(g(x))=x --} - -test = do - let c1 = [Pos $ PApp "=" [TmApp "f" [TmApp "g" [TmVar "x"]], TmVar "x"]] - c2 = [Neg $ PApp "=" [TmVar "x", TmApp "g" [TmVar "x"]]] - ret <- findModel 3 [c1, c2] - case ret of - Nothing -> putStrLn "=== NO MODEL FOUND ===" - Just m -> do - putStrLn "=== A MODEL FOUND ===" - mapM_ putStrLn $ showModel m - -test2 = do - let phi = Forall "x" $ Exists "y" $ - notB (Atom (PApp "=" [TmVar "x", TmVar "y"])) .&&. - Atom (PApp "=" [TmApp "f" [TmVar "y"], TmVar "x"]) - - ref <- newIORef 0 - let skolem name _ = do - n <- readIORef ref - let fsym = name ++ "#" ++ show n - writeIORef ref (n+1) - return fsym - cs <- toSkolemNF skolem phi - - ret <- findModel 3 cs - case ret of - Nothing -> putStrLn "=== NO MODEL FOUND ===" - Just m -> do - putStrLn "=== A MODEL FOUND ===" - mapM_ putStrLn $ showModel m - --- --------------------------------------------------------------------------- diff --git a/src/ToySolver/Internal/Data/PriorityQueue.hs b/src/ToySolver/Internal/Data/PriorityQueue.hs --- a/src/ToySolver/Internal/Data/PriorityQueue.hs +++ b/src/ToySolver/Internal/Data/PriorityQueue.hs @@ -38,7 +38,6 @@ , resizeHeapCapacity ) where -import Control.Monad import qualified Data.Array.IO as A import Data.Queue.Classes import qualified ToySolver.Internal.Data.Vec as Vec diff --git a/src/ToySolver/Internal/Data/Vec.hs b/src/ToySolver/Internal/Data/Vec.hs --- a/src/ToySolver/Internal/Data/Vec.hs +++ b/src/ToySolver/Internal/Data/Vec.hs @@ -29,12 +29,20 @@ , getSize , read , write + , modify + , modify' , unsafeRead , unsafeWrite + , unsafeModify + , unsafeModify' , resize , growTo , push + , pop + , popMaybe , unsafePop + , peek + , unsafePeek , clear , getElems @@ -84,7 +92,7 @@ if 0 <= i && i < s then A.unsafeRead a i else - error $ "ToySolver.Data.Vec.read: index " ++ show i ++ " out of bounds" + error $ "ToySolver.Internal.Data.Vec.read: index " ++ show i ++ " out of bounds" {-# SPECIALIZE write :: Vec e -> Int -> e -> IO () #-} {-# SPECIALIZE write :: UVec Int -> Int -> Int -> IO () #-} @@ -97,8 +105,44 @@ if 0 <= i && i < s then A.unsafeWrite a i e else - error $ "ToySolver.Data.Vec.write: index " ++ show i ++ " out of bounds" + error $ "ToySolver.Internal.Data.Vec.write: index " ++ show i ++ " out of bounds" +{-# INLINE modify #-} +modify :: A.MArray a e IO => GenericVec a e -> Int -> (e -> e) -> IO () +modify !v !i f = do + a <- getArray v + s <- getSize v + if 0 <= i && i < s then do + x <- A.unsafeRead a i + A.unsafeWrite a i (f x) + else + error $ "ToySolver.Internal.Data.Vec.modify: index " ++ show i ++ " out of bounds" + +{-# INLINE modify' #-} +modify' :: A.MArray a e IO => GenericVec a e -> Int -> (e -> e) -> IO () +modify' !v !i f = do + a <- getArray v + s <- getSize v + if 0 <= i && i < s then do + x <- A.unsafeRead a i + A.unsafeWrite a i $! f x + else + error $ "ToySolver.Internal.Data.Vec.modify': index " ++ show i ++ " out of bounds" + +{-# INLINE unsafeModify #-} +unsafeModify :: A.MArray a e IO => GenericVec a e -> Int -> (e -> e) -> IO () +unsafeModify !v !i f = do + a <- getArray v + x <- A.unsafeRead a i + A.unsafeWrite a i (f x) + +{-# INLINE unsafeModify' #-} +unsafeModify' :: A.MArray a e IO => GenericVec a e -> Int -> (e -> e) -> IO () +unsafeModify' !v !i f = do + a <- getArray v + x <- A.unsafeRead a i + A.unsafeWrite a i $! f x + {-# INLINE unsafeRead #-} unsafeRead :: A.MArray a e IO => GenericVec a e -> Int -> IO e unsafeRead !v !i = do @@ -145,16 +189,55 @@ resize v (s+1) unsafeWrite v s e +popMaybe :: A.MArray a e IO => GenericVec a e -> IO (Maybe e) +popMaybe v = do + s <- getSize v + if s == 0 then + return Nothing + else do + e <- unsafeRead v (s-1) + resize v (s-1) + return (Just e) + {-# SPECIALIZE unsafePop :: Vec e -> IO e #-} {-# SPECIALIZE unsafePop :: UVec Int -> IO Int #-} {-# SPECIALIZE unsafePop :: UVec Double -> IO Double #-} {-# SPECIALIZE unsafePop :: UVec Bool -> IO Bool #-} +pop :: A.MArray a e IO => GenericVec a e -> IO e +pop v = do + s <- getSize v + if s == 0 then + error $ "ToySolver.Internal.Data.Vec.pop: empty Vec" + else do + e <- unsafeRead v (s-1) + resize v (s-1) + return e + +{-# SPECIALIZE unsafePop :: Vec e -> IO e #-} +{-# SPECIALIZE unsafePop :: UVec Int -> IO Int #-} +{-# SPECIALIZE unsafePop :: UVec Double -> IO Double #-} +{-# SPECIALIZE unsafePop :: UVec Bool -> IO Bool #-} unsafePop :: A.MArray a e IO => GenericVec a e -> IO e unsafePop v = do s <- getSize v e <- unsafeRead v (s-1) resize v (s-1) return e + +{-# INLINE peek #-} +peek :: A.MArray a e IO => GenericVec a e -> IO e +peek v = do + s <- getSize v + if s == 0 then + error $ "ToySolver.Internal.Data.Vec.peek: empty Vec" + else do + unsafeRead v (s-1) + +{-# INLINE unsafePeek #-} +unsafePeek :: A.MArray a e IO => GenericVec a e -> IO e +unsafePeek v = do + s <- getSize v + unsafeRead v (s-1) clear :: A.MArray a e IO => GenericVec a e -> IO () clear v = resize v 0 diff --git a/src/ToySolver/Internal/ProcessUtil.hs b/src/ToySolver/Internal/ProcessUtil.hs --- a/src/ToySolver/Internal/ProcessUtil.hs +++ b/src/ToySolver/Internal/ProcessUtil.hs @@ -23,11 +23,7 @@ import Foreign.C import System.Exit import System.IO -#if MIN_VERSION_base(4,6,0) import System.IO.Error -#else -import System.IO.Error hiding (try) -#endif import System.Process #ifdef __GLASGOW_HASKELL__ diff --git a/src/ToySolver/SAT.hs b/src/ToySolver/SAT.hs --- a/src/ToySolver/SAT.hs +++ b/src/ToySolver/SAT.hs @@ -1,13 +1,8 @@ {-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-} -{-# LANGUAGE BangPatterns, ScopedTypeVariables, CPP, DeriveDataTypeable #-} +{-# LANGUAGE BangPatterns, ScopedTypeVariables, CPP, DeriveDataTypeable, RecursiveDo #-} #ifdef __GLASGOW_HASKELL__ {-# LANGUAGE UnboxedTuples, MagicHash #-} #endif -#if __GLASGOW_HASKELL__ < 706 -{-# LANGUAGE DoRec #-} -#else -{-# LANGUAGE RecursiveDo #-} -#endif ----------------------------------------------------------------------------- -- | -- Module : ToySolver.SAT @@ -34,6 +29,7 @@ -- * The @Solver@ type Solver , newSolver + , newSolverWithConfig -- * Basic data structures , Var @@ -42,25 +38,46 @@ , litNot , litVar , litPolarity - , Clause + , evalLit -- * Problem specification , newVar , newVars , newVars_ , resizeVarCapacity + -- ** Clauses , addClause + , Clause + , evalClause + -- ** Cardinality constraints , addAtLeast , addAtMost , addExactly + , AtLeast + , Exactly + , evalAtLeast + , evalExactly + + -- ** (Linear) pseudo-boolean constraints , addPBAtLeast , addPBAtMost , addPBExactly , addPBAtLeastSoft , addPBAtMostSoft , addPBExactlySoft + , PBLinTerm + , PBLinSum + , PBLinAtLeast + , PBLinExactly + , evalPBLinSum + , evalPBLinAtLeast + , evalPBLinExactly + -- ** XOR clauses , addXORClause , addXORClauseSoft + , XORClause + , evalXORClause + -- ** Thery , setTheory -- * Solving @@ -69,14 +86,28 @@ , BudgetExceeded (..) -- * Extract results + , IModel (..) , Model , getModel , getFailedAssumptions + , getAssumptionsImplications -- * Solver configulation + , Config (..) + , getConfig + , setConfig + , modifyConfig , RestartStrategy (..) + , LearningStrategy (..) + , setVarPolarity + , setLogger + , setRandomGen + , getRandomGen + , setConfBudget + , PBHandlerType (..) + + -- ** Deprecated , setRestartStrategy - , defaultRestartStrategy , setRestartFirst , defaultRestartFirst , setRestartInc @@ -87,9 +118,7 @@ , defaultLearntSizeInc , setCCMin , defaultCCMin - , LearningStrategy (..) , setLearningStrategy - , defaultLearningStrategy , setEnablePhaseSaving , getEnablePhaseSaving , defaultEnablePhaseSaving @@ -99,17 +128,10 @@ , setEnableBackwardSubsumptionRemoval , getEnableBackwardSubsumptionRemoval , defaultEnableBackwardSubsumptionRemoval - , setVarPolarity - , setLogger , setCheckModel , setRandomFreq , defaultRandomFreq - , setRandomGen - , getRandomGen - , setConfBudget - , PBHandlerType (..) , setPBHandlerType - , defaultPBHandlerType , setPBSplitClausePart , getPBSplitClausePart , defaultPBSplitClausePart @@ -120,6 +142,7 @@ , getNLearntConstraints , getVarFixed , getLitFixed + , getFixedLiterals -- * Read state (deprecated) , nVars @@ -133,6 +156,7 @@ ) where import Prelude hiding (log) +import Control.Applicative hiding (empty) import Control.Loop import Control.Monad import Control.Exception @@ -146,6 +170,7 @@ #if MIN_VERSION_hashable(1,2,0) import Data.Bits (xor) -- for defining 'combine' function #endif +import Data.Default.Class import Data.Function (on) import Data.Hashable import Data.HashSet (HashSet) @@ -154,7 +179,7 @@ import Data.List import Data.Maybe import Data.Ord -import qualified Data.IntMap as IM +import qualified Data.IntMap.Strict as IM import qualified Data.IntSet as IS import qualified Data.Set as Set import ToySolver.Internal.Data.IOURef @@ -163,7 +188,7 @@ import Data.Time import Data.Typeable import System.CPUTime -import qualified System.Random as Rand +import qualified System.Random.MWC as Rand import Text.Printf #ifdef __GLASGOW_HASKELL__ @@ -174,6 +199,7 @@ import ToySolver.Data.LBool import ToySolver.SAT.Types import ToySolver.SAT.TheorySolver +import ToySolver.Internal.Util (revMapM) {-------------------------------------------------------------------- internal data structures @@ -298,6 +324,12 @@ else Vec.unsafeRead (svTrailLimit solver) 0 +-- | it returns a set of literals that are fixed without any assumptions. +getFixedLiterals :: Solver -> IO [Lit] +getFixedLiterals solver = do + n <- getNFixed solver + revMapM (Vec.unsafeRead (svTrail solver)) [0..n-1] + varLevel :: Solver -> Var -> IO Level varLevel solver !v = do vd <- varData solver v @@ -343,6 +375,7 @@ -- Result , svModel :: !(IORef (Maybe Model)) , svFailedAssumptions :: !(IORef [Lit]) + , svAssumptionsImplications :: !(IORef LitSet) -- Statistics , svNDecision :: !(IOURef Int) @@ -353,52 +386,8 @@ , svNRemovedConstr :: !(IOURef Int) -- Configulation - - -- | Inverse of the variable activity decay factor. (default 1 / 0.95) - , svVarDecay :: !(IOURef Double) - - -- | Amount to bump next variable with. - , svVarInc :: !(IOURef Double) - - -- | Inverse of the constraint activity decay factor. (1 / 0.999) - , svConstrDecay :: !(IOURef Double) - - -- | Amount to bump next constraint with. - , svConstrInc :: !(IOURef Double) - - , svRestartStrategy :: !(IORef RestartStrategy) - - -- | The initial restart limit. (default 100) - , svRestartFirst :: !(IORef Int) - - -- | The factor with which the restart limit is multiplied in each restart. (default 1.5) - , svRestartInc :: !(IORef Double) - - -- | The initial limit for learnt constraints. - , svLearntSizeFirst :: !(IORef Int) - - -- | The limit for learnt constraints is multiplied with this factor periodically. (default 1.1) - , svLearntSizeInc :: !(IORef Double) - - -- | Controls conflict constraint minimization (0=none, 1=local, 2=recursive) - , svCCMin :: !(IORef Int) - - , svEnablePhaseSaving :: !(IORef Bool) - , svEnableForwardSubsumptionRemoval :: !(IORef Bool) - - , svLearningStrategy :: !(IORef LearningStrategy) - - , svPBHandlerType :: !(IORef PBHandlerType) - , svPBSplitClausePart :: !(IORef Bool) - - , svEnableBackwardSubsumptionRemoval :: !(IORef Bool) - - , svCheckModel :: !(IORef Bool) - - , svRandomFreq :: !(IORef Double) - - , svRandomGen :: !(IORef Rand.StdGen) - + , svConfig :: !(IORef Config) + , svRandomGen :: !(IORef Rand.GenIO) , svConfBudget :: !(IOURef Int) -- Logging @@ -411,6 +400,12 @@ , svLearntLim :: !(IORef Int) , svLearntLimAdjCnt :: !(IORef Int) , svLearntLimSeq :: !(IORef [(Int,Int)]) + + -- | Amount to bump next variable with. + , svVarInc :: !(IOURef Double) + + -- | Amount to bump next constraint with. + , svConstrInc :: !(IOURef Double) } markBad :: Solver -> IO () @@ -536,12 +531,6 @@ vd <- varData solver lit modifyIORef (vdWatches vd) (delete c) --- | Returns list of constraints that are watching the literal. -watches :: Solver -> Lit -> IO [SomeConstraintHandler] -watches solver !lit = do - ld <- litData solver lit - readIORef (ldWatches ld) - addToDB :: ConstraintHandler c => Solver -> c -> IO () addToDB solver c = do let c2 = toConstraintHandler c @@ -605,7 +594,7 @@ varDecayActivity :: Solver -> IO () varDecayActivity solver = do - d <- readIOURef (svVarDecay solver) + d <- configVarDecay <$> getConfig solver modifyIOURef (svVarInc solver) (d*) varBumpActivity :: Solver -> Var -> IO () @@ -681,9 +670,13 @@ Solver --------------------------------------------------------------------} --- | Create a new Solver instance. +-- | Create a new 'Solver' instance. newSolver :: IO Solver -newSolver = do +newSolver = newSolverWithConfig def + +-- | Create a new 'Solver' instance with a given configulation. +newSolverWithConfig :: Config -> IO Solver +newSolverWithConfig config = do rec ok <- newIORef True trail <- Vec.new @@ -702,24 +695,11 @@ nlearntgc <- newIOURef 0 nremoved <- newIOURef 0 - constrDecay <- newIOURef (1 / 0.999) constrInc <- newIOURef 1 - varDecay <- newIOURef (1 / 0.95) varInc <- newIOURef 1 - restartStrat <- newIORef defaultRestartStrategy - restartFirst <- newIORef defaultRestartFirst - restartInc <- newIORef defaultRestartInc - learning <- newIORef defaultLearningStrategy - learntSizeFirst <- newIORef defaultLearntSizeFirst - learntSizeInc <- newIORef defaultLearntSizeInc - ccMin <- newIORef defaultCCMin - checkModel <- newIORef False - pbHandlerType <- newIORef defaultPBHandlerType - pbSplitClausePart <- newIORef defaultPBSplitClausePart - enablePhaseSaving <- newIORef defaultEnablePhaseSaving - enableForwardSubsumptionRemoval <- newIORef defaultEnableForwardSubsumptionRemoval - enableBackwardSubsumptionRemoval <- newIORef defaultEnableBackwardSubsumptionRemoval + configRef <- newIORef config + learntLim <- newIORef undefined learntLimAdjCnt <- newIORef (-1) learntLimSeq <- newIORef undefined @@ -728,10 +708,10 @@ startWC <- newIORef undefined lastStatWC <- newIORef undefined - randfreq <- newIORef defaultRandomFreq - randgen <- newIORef =<< Rand.newStdGen + randgen <- newIORef =<< Rand.create failed <- newIORef [] + implied <- newIORef IS.empty confBudget <- newIOURef (-1) @@ -756,6 +736,7 @@ -- Result , svModel = m , svFailedAssumptions = failed + , svAssumptionsImplications = implied -- Statistics , svNDecision = ndecision @@ -766,24 +747,7 @@ , svNRemovedConstr = nremoved -- Configulation - , svVarDecay = varDecay - , svVarInc = varInc - , svConstrDecay = constrDecay - , svConstrInc = constrInc - , svRestartStrategy = restartStrat - , svRestartFirst = restartFirst - , svRestartInc = restartInc - , svLearningStrategy = learning - , svLearntSizeFirst = learntSizeFirst - , svLearntSizeInc = learntSizeInc - , svCCMin = ccMin - , svEnablePhaseSaving = enablePhaseSaving - , svEnableForwardSubsumptionRemoval = enableForwardSubsumptionRemoval - , svPBHandlerType = pbHandlerType - , svPBSplitClausePart = pbSplitClausePart - , svEnableBackwardSubsumptionRemoval = enableBackwardSubsumptionRemoval - , svCheckModel = checkModel - , svRandomFreq = randfreq + , svConfig = configRef , svRandomGen = randgen , svConfBudget = confBudget @@ -797,6 +761,8 @@ , svLearntLim = learntLim , svLearntLimAdjCnt = learntLimAdjCnt , svLearntLimSeq = learntLimSeq + , svVarInc = varInc + , svConstrInc = constrInc } return solver @@ -924,7 +890,7 @@ -- | Add a pseudo boolean constraints /c1*l1 + c2*l2 + … ≥ n/. addPBAtLeast :: Solver -- ^ The 'Solver' argument. - -> [(Integer,Lit)] -- ^ set of terms @[(c1,l1),(c2,l2),…]@ + -> PBLinSum -- ^ list of terms @[(c1,l1),(c2,l2),…]@ -> Integer -- ^ /n/ -> IO () addPBAtLeast solver ts n = do @@ -963,7 +929,7 @@ Just _ -> markBad solver -- | See documentation of 'setPBSplitClausePart'. -pbSplitClausePart :: Solver -> ([(Integer,Lit)], Integer) -> IO ([(Integer,Lit)], Integer) +pbSplitClausePart :: Solver -> PBLinAtLeast -> IO PBLinAtLeast pbSplitClausePart solver (lhs,rhs) = do let (ts1,ts2) = partition (\(c,_) -> c >= rhs) lhs if length ts1 < 2 then @@ -975,14 +941,14 @@ -- | Add a pseudo boolean constraints /c1*l1 + c2*l2 + … ≤ n/. addPBAtMost :: Solver -- ^ The 'Solver' argument. - -> [(Integer,Lit)] -- ^ list of @[(c1,l1),(c2,l2),…]@ + -> PBLinSum -- ^ list of @[(c1,l1),(c2,l2),…]@ -> Integer -- ^ /n/ -> IO () addPBAtMost solver ts n = addPBAtLeast solver [(-c,l) | (c,l) <- ts] (negate n) -- | Add a pseudo boolean constraints /c1*l1 + c2*l2 + … = n/. addPBExactly :: Solver -- ^ The 'Solver' argument. - -> [(Integer,Lit)] -- ^ list of terms @[(c1,l1),(c2,l2),…]@ + -> PBLinSum -- ^ list of terms @[(c1,l1),(c2,l2),…]@ -> Integer -- ^ /n/ -> IO () addPBExactly solver ts n = do @@ -994,7 +960,7 @@ addPBAtLeastSoft :: Solver -- ^ The 'Solver' argument. -> Lit -- ^ Selector literal @sel@ - -> [(Integer,Lit)] -- ^ set of terms @[(c1,l1),(c2,l2),…]@ + -> PBLinSum -- ^ list of terms @[(c1,l1),(c2,l2),…]@ -> Integer -- ^ /n/ -> IO () addPBAtLeastSoft solver sel lhs rhs = do @@ -1005,7 +971,7 @@ addPBAtMostSoft :: Solver -- ^ The 'Solver' argument. -> Lit -- ^ Selector literal @sel@ - -> [(Integer,Lit)] -- ^ set of terms @[(c1,l1),(c2,l2),…]@ + -> PBLinSum -- ^ list of terms @[(c1,l1),(c2,l2),…]@ -> Integer -- ^ /n/ -> IO () addPBAtMostSoft solver sel lhs rhs = @@ -1015,7 +981,7 @@ addPBExactlySoft :: Solver -- ^ The 'Solver' argument. -> Lit -- ^ Selector literal @sel@ - -> [(Integer,Lit)] -- ^ set of terms @[(c1,l1),(c2,l2),…]@ + -> PBLinSum -- ^ list of terms @[(c1,l1),(c2,l2),…]@ -> Integer -- ^ /n/ -> IO () addPBExactlySoft solver sel lhs rhs = do @@ -1083,6 +1049,9 @@ solve_ :: Solver -> IO Bool solve_ solver = do + config <- getConfig solver + writeIORef (svAssumptionsImplications solver) IS.empty + log solver "Solving starts ..." resetStat solver writeIORef (svModel solver) Nothing @@ -1099,9 +1068,10 @@ nv <- getNVars solver Vec.resizeCapacity (svTrail solver) nv - restartStrategy <- readIORef (svRestartStrategy solver) - restartFirst <- readIORef (svRestartFirst solver) - restartInc <- readIORef (svRestartInc solver) + restartStrategy <- configRestartStrategy <$> getConfig solver + restartFirst <- configRestartFirst <$> getConfig solver + restartInc <- configRestartInc <$> getConfig solver + unless (restartInc > 1) $ error "restartInc must be >1" let restartSeq = if restartFirst > 0 then mkRestartSeq restartStrategy restartFirst restartInc @@ -1119,8 +1089,9 @@ cnt <- readIORef (svLearntLimAdjCnt solver) when (cnt == -1) $ do - learntSizeFirst <- readIORef (svLearntSizeFirst solver) - learntSizeInc <- readIORef (svLearntSizeInc solver) + learntSizeFirst <- configLearntSizeFirst <$> getConfig solver + learntSizeInc <- configLearntSizeInc <$> getConfig solver + unless (learntSizeInc > 1) $ error "learntSizeInc must be >1" nc <- getNConstraints solver let initialLearntLim = if learntSizeFirst > 0 then learntSizeFirst else max ((nc + nv) `div` 3) 16 learntSizeSeq = iterate (ceiling . (learntSizeInc*) . fromIntegral) initialLearntLim @@ -1150,9 +1121,14 @@ endWC <- getCurrentTime when (result == Just True) $ do - checkModel <- readIORef (svCheckModel solver) - when checkModel $ checkSatisfied solver + when (configCheckModel config) $ checkSatisfied solver constructModel solver + mt <- getTheory solver + case mt of + Nothing -> return () + Just t -> thConstructModel t + unless (result == Just False) $ do + saveAssumptionsImplications solver backtrackTo solver levelRoot @@ -1273,7 +1249,7 @@ else if conflict_lim > 0 && c >= conflict_lim then return $ Just SRRestart else do - strat <- readIORef (svLearningStrategy solver) + strat <- configLearningStrategy <$> getConfig solver case strat of LearningClause -> learnClause constr >> return Nothing LearningHybrid -> learnHybrid conflictCounter constr @@ -1298,8 +1274,11 @@ learnHybrid :: IORef Int -> SomeConstraintHandler -> IO (Maybe SearchResult) learnHybrid conflictCounter constr = do - ((learntClause, clauseLevel), (pb, pbLevel)) <- analyzeConflictHybrid solver constr - let minLevel = min clauseLevel pbLevel + ((learntClause, clauseLevel), pb) <- analyzeConflictHybrid solver constr + let minLevel = + case pb of + Nothing -> clauseLevel + Just (_, pbLevel) -> min clauseLevel pbLevel backtrackTo solver minLevel case learntClause of @@ -1323,21 +1302,23 @@ handleConflict conflictCounter conflicted -- TODO: should also learn the PB constraint? Nothing -> do - let (lhs,rhs) = pb - h <- newPBHandlerPromoted solver lhs rhs True - case h of - CHClause _ -> do - {- We don't want to add additional clause, - since it would be subsumed by already added one. -} - return Nothing - _ -> do - addToLearntDB solver h - ret2 <- attach solver h - constrBumpActivity solver h - if ret2 then - return Nothing - else - handleConflict conflictCounter h + case pb of + Nothing -> return Nothing + Just ((lhs,rhs), _pbLevel) -> do + h <- newPBHandlerPromoted solver lhs rhs True + case h of + CHClause _ -> do + {- We don't want to add additional clause, + since it would be subsumed by already added one. -} + return Nothing + _ -> do + addToLearntDB solver h + ret2 <- attach solver h + constrBumpActivity solver h + if ret2 then + return Nothing + else + handleConflict conflictCounter h -- | After 'solve' returns True, it returns an satisfying assignment. getModel :: Solver -> IO Model @@ -1351,6 +1332,11 @@ getFailedAssumptions :: Solver -> IO [Lit] getFailedAssumptions solver = readIORef (svFailedAssumptions solver) +-- | __EXPERIMENTAL API__: After 'solveWith' returns True or failed with 'BudgetExceeded' exception, +-- it returns a set of literals that are implied by assumptions. +getAssumptionsImplications :: Solver -> IO [Lit] +getAssumptionsImplications solver = liftM IS.toList $ readIORef (svAssumptionsImplications solver) + {-------------------------------------------------------------------- Simplification --------------------------------------------------------------------} @@ -1457,72 +1443,167 @@ Parameter settings. --------------------------------------------------------------------} -setRestartStrategy :: Solver -> RestartStrategy -> IO () -setRestartStrategy solver s = writeIORef (svRestartStrategy solver) s +{-------------------------------------------------------------------- + Configulation +--------------------------------------------------------------------} + +data Config + = Config + { configRestartStrategy :: !RestartStrategy + , configRestartFirst :: !Int + -- ^ The initial restart limit. (default 100) + -- Zero and negative values are used to disable restart. + , configRestartInc :: !Double + -- ^ The factor with which the restart limit is multiplied in each restart. (default 1.5) + -- This must be @>1@. + , configLearningStrategy :: !LearningStrategy + , configLearntSizeFirst :: !Int + -- ^ The initial limit for learnt constraints. + -- Negative value means computing default value from problem instance. + , configLearntSizeInc :: !Double + -- ^ The limit for learnt constraints is multiplied with this factor periodically. (default 1.1) + -- This must be @>1@. + , configCCMin :: !Int + -- ^ Controls conflict constraint minimization (0=none, 1=local, 2=recursive) + , configEnablePhaseSaving :: !Bool + , configEnableForwardSubsumptionRemoval :: !Bool + , configEnableBackwardSubsumptionRemoval :: !Bool + , configRandomFreq :: !Double + -- ^ The frequency with which the decision heuristic tries to choose a random variable + , configPBHandlerType :: !PBHandlerType + , configEnablePBSplitClausePart :: !Bool + -- ^ Split PB-constraints into a PB part and a clause part. + -- + -- Example from minisat+ paper: + -- + -- * 4 x1 + 4 x2 + 4 x3 + 4 x4 + 2y1 + y2 + y3 ≥ 4 + -- + -- would be split into + -- + -- * x1 + x2 + x3 + x4 + ¬z ≥ 1 (clause part) + -- + -- * 2 y1 + y2 + y3 + 4 z ≥ 4 (PB part) + -- + -- where z is a newly introduced variable, not present in any other constraint. + -- + -- Reference: + -- + -- * N . Eéen and N. Sörensson. Translating Pseudo-Boolean Constraints into SAT. JSAT 2:1–26, 2006. + -- + , configCheckModel :: !Bool + , configVarDecay :: !Double + -- ^ Inverse of the variable activity decay factor. (default 1 / 0.95) + , configConstrDecay :: !Double + -- ^ Inverse of the constraint activity decay factor. (1 / 0.999) + } deriving (Show, Eq, Ord) --- | default value for @RestartStrategy@. -defaultRestartStrategy :: RestartStrategy -defaultRestartStrategy = MiniSATRestarts +instance Default Config where + def = + Config + { configRestartStrategy = def + , configRestartFirst = defaultRestartFirst + , configRestartInc = defaultRestartInc + , configLearningStrategy = def + , configLearntSizeFirst = defaultLearntSizeFirst + , configLearntSizeInc = defaultLearntSizeInc + , configCCMin = defaultCCMin + , configEnablePhaseSaving = defaultEnablePhaseSaving + , configEnableForwardSubsumptionRemoval = defaultEnableForwardSubsumptionRemoval + , configEnableBackwardSubsumptionRemoval = defaultEnableBackwardSubsumptionRemoval + , configRandomFreq = defaultRandomFreq + , configPBHandlerType = def + , configEnablePBSplitClausePart = defaultPBSplitClausePart + , configCheckModel = False + , configVarDecay = 1 / 0.95 + , configConstrDecay = 1 / 0.999 + } +getConfig :: Solver -> IO Config +getConfig solver = readIORef $ svConfig solver + +setConfig :: Solver -> Config -> IO () +setConfig solver = writeIORef (svConfig solver) + +modifyConfig :: Solver -> (Config -> Config) -> IO () +modifyConfig solver = modifyIORef' (svConfig solver) + +{-# DEPRECATED setRestartStrategy "Use setConfig" #-} +setRestartStrategy :: Solver -> RestartStrategy -> IO () +setRestartStrategy solver s = modifyIORef' (svConfig solver) $ \config -> config{ configRestartStrategy = s } + -- | The initial restart limit. (default 100) -- Zero and negative values are used to disable restart. +{-# DEPRECATED setRestartFirst "Use setConfig" #-} setRestartFirst :: Solver -> Int -> IO () -setRestartFirst solver !n = writeIORef (svRestartFirst solver) n +setRestartFirst solver !n = modifyIORef' (svConfig solver) $ \config -> config{ configRestartFirst = n } -- | default value for @RestartFirst@. +{-# DEPRECATED defaultRestartFirst "Use configRestartFirst def" #-} defaultRestartFirst :: Int defaultRestartFirst = 100 -- | The factor with which the restart limit is multiplied in each restart. (default 1.5) -- -- This must be @>1@. +{-# DEPRECATED setRestartInc "Use setConfig" #-} setRestartInc :: Solver -> Double -> IO () setRestartInc solver !r - | r > 1 = writeIORef (svRestartInc solver) r + | r > 1 = modifyIORef' (svConfig solver) $ \config -> config{ configRestartInc = r } | otherwise = error "setRestartInc: RestartInc must be >1" -- | default value for @RestartInc@. +{-# DEPRECATED defaultRestartInc "Use configRestartInc def" #-} defaultRestartInc :: Double defaultRestartInc = 1.5 +-- | Learning strategy. +-- +-- The default value can be obtained by 'def'. data LearningStrategy = LearningClause | LearningHybrid deriving (Show, Eq, Ord, Enum, Bounded) -setLearningStrategy :: Solver -> LearningStrategy -> IO () -setLearningStrategy solver l = writeIORef (svLearningStrategy solver) $! l +instance Default LearningStrategy where + def = LearningClause -defaultLearningStrategy :: LearningStrategy -defaultLearningStrategy = LearningClause +{-# DEPRECATED setLearningStrategy "Use setConfig" #-} +setLearningStrategy :: Solver -> LearningStrategy -> IO () +setLearningStrategy solver l = modifyIORef' (svConfig solver) $ \config -> config{ configLearningStrategy = l } -- | The initial limit for learnt clauses. -- -- Negative value means computing default value from problem instance. +{-# DEPRECATED setLearntSizeFirst "Use setConfig" #-} setLearntSizeFirst :: Solver -> Int -> IO () -setLearntSizeFirst solver !x = writeIORef (svLearntSizeFirst solver) x +setLearntSizeFirst solver !x = modifyIORef' (svConfig solver) $ \config -> config{ configLearntSizeFirst = x } -- | default value for @LearntSizeFirst@. +{-# DEPRECATED defaultLearntSizeFirst "Use learntSizeFirst def" #-} defaultLearntSizeFirst :: Int defaultLearntSizeFirst = -1 -- | The limit for learnt clauses is multiplied with this factor each restart. (default 1.1) -- -- This must be @>1@. +{-# DEPRECATED setLearntSizeInc "Use setConfig" #-} setLearntSizeInc :: Solver -> Double -> IO () setLearntSizeInc solver !r - | r > 1 = writeIORef (svLearntSizeInc solver) r + | r > 1 = modifyIORef' (svConfig solver) $ \config -> config{ configLearntSizeInc = r } | otherwise = error "setLearntSizeInc: LearntSizeInc must be >1" -- | default value for @LearntSizeInc@. +{-# DEPRECATED defaultLearntSizeInc "Use learntSizeInc def" #-} defaultLearntSizeInc :: Double defaultLearntSizeInc = 1.1 -- | Controls conflict clause minimization (0=none, 1=basic, 2=deep) +{-# DEPRECATED setCCMin "Use setConfig" #-} setCCMin :: Solver -> Int -> IO () -setCCMin solver !v = writeIORef (svCCMin solver) v +setCCMin solver !v = modifyIORef' (svConfig solver) $ \config -> config{ configCCMin = v } -- | default value for @CCMin@. +{-# DEPRECATED defaultCCMin "Use ccMin def" #-} defaultCCMin :: Int defaultCCMin = 2 @@ -1532,39 +1613,46 @@ vd <- varData solver v writeIORef (vdPolarity vd) val +{-# DEPRECATED setCheckModel "Use setConfig" #-} setCheckModel :: Solver -> Bool -> IO () setCheckModel solver flag = do - writeIORef (svCheckModel solver) flag + modifyIORef' (svConfig solver) $ \config -> config{ configCheckModel = flag } -- | The frequency with which the decision heuristic tries to choose a random variable +{-# DEPRECATED setRandomFreq "Use setConfig" #-} setRandomFreq :: Solver -> Double -> IO () -setRandomFreq solver r = do - writeIORef (svRandomFreq solver) r +setRandomFreq solver r = + modifyIORef' (svConfig solver) $ \config -> config{ configRandomFreq = r } +{-# DEPRECATED defaultRandomFreq "Use configRandomFreq def" #-} defaultRandomFreq :: Double defaultRandomFreq = 0.005 -- | Set random generator used by the random variable selection -setRandomGen :: Solver -> Rand.StdGen -> IO () +setRandomGen :: Solver -> Rand.GenIO -> IO () setRandomGen solver = writeIORef (svRandomGen solver) -- | Get random generator used by the random variable selection -getRandomGen :: Solver -> IO Rand.StdGen +getRandomGen :: Solver -> IO Rand.GenIO getRandomGen solver = readIORef (svRandomGen solver) setConfBudget :: Solver -> Maybe Int -> IO () setConfBudget solver (Just b) | b >= 0 = writeIOURef (svConfBudget solver) b setConfBudget solver _ = writeIOURef (svConfBudget solver) (-1) +-- | Pseudo boolean constraint handler implimentation. +-- +-- The default value can be obtained by 'def'. data PBHandlerType = PBHandlerTypeCounter | PBHandlerTypePueblo deriving (Show, Eq, Ord, Enum, Bounded) -defaultPBHandlerType :: PBHandlerType -defaultPBHandlerType = PBHandlerTypeCounter +instance Default PBHandlerType where + def = PBHandlerTypeCounter +{-# DEPRECATED setPBHandlerType "Use setConfig" #-} setPBHandlerType :: Solver -> PBHandlerType -> IO () setPBHandlerType solver ht = do - writeIORef (svPBHandlerType solver) ht + modifyIORef' (svConfig solver) $ \config -> config{ configPBHandlerType = ht } -- | Split PB-constraints into a PB part and a clause part. -- @@ -1583,49 +1671,61 @@ -- Reference: -- -- * N . Eéen and N. Sörensson. Translating Pseudo-Boolean Constraints into SAT. JSAT 2:1–26, 2006. --- +-- +{-# DEPRECATED setPBSplitClausePart "Use setConfig" #-} setPBSplitClausePart :: Solver -> Bool -> IO () setPBSplitClausePart solver b = - writeIORef (svPBSplitClausePart solver) b + modifyIORef' (svConfig solver) $ \config -> config{ configEnablePBSplitClausePart = b } -- | See documentation of 'setPBSplitClausePart'. getPBSplitClausePart :: Solver -> IO Bool -getPBSplitClausePart solver = readIORef (svPBSplitClausePart solver) +getPBSplitClausePart solver = + configEnablePBSplitClausePart <$> getConfig solver -- | See documentation of 'setPBSplitClausePart'. +{-# DEPRECATED defaultPBSplitClausePart "Use configEnablePBSplitClausePart def" #-} defaultPBSplitClausePart :: Bool defaultPBSplitClausePart = False +{-# DEPRECATED setEnablePhaseSaving "Use setConfig" #-} setEnablePhaseSaving :: Solver -> Bool -> IO () setEnablePhaseSaving solver flag = do - writeIORef (svEnablePhaseSaving solver) flag + modifyIORef' (svConfig solver) $ \config -> config{ configEnablePhaseSaving = flag } +{-# DEPRECATED getEnablePhaseSaving "Use getConfig" #-} getEnablePhaseSaving :: Solver -> IO Bool getEnablePhaseSaving solver = do - readIORef (svEnablePhaseSaving solver) + configEnablePhaseSaving <$> getConfig solver +{-# DEPRECATED defaultEnablePhaseSaving "Use configEnablePhaseSaving def" #-} defaultEnablePhaseSaving :: Bool defaultEnablePhaseSaving = True +{-# DEPRECATED setEnableForwardSubsumptionRemoval "Use setConfig" #-} setEnableForwardSubsumptionRemoval :: Solver -> Bool -> IO () setEnableForwardSubsumptionRemoval solver flag = do - writeIORef (svEnableForwardSubsumptionRemoval solver) flag + modifyIORef' (svConfig solver) $ \config -> config{ configEnableForwardSubsumptionRemoval = flag } +{-# DEPRECATED getEnableForwardSubsumptionRemoval "Use getConfig" #-} getEnableForwardSubsumptionRemoval :: Solver -> IO Bool getEnableForwardSubsumptionRemoval solver = do - readIORef (svEnableForwardSubsumptionRemoval solver) + configEnableForwardSubsumptionRemoval <$> getConfig solver +{-# DEPRECATED defaultEnableForwardSubsumptionRemoval "Use configEnableForwardSubsumptionRemoval def" #-} defaultEnableForwardSubsumptionRemoval :: Bool defaultEnableForwardSubsumptionRemoval = False +{-# DEPRECATED setEnableBackwardSubsumptionRemoval "Use setConfig" #-} setEnableBackwardSubsumptionRemoval :: Solver -> Bool -> IO () setEnableBackwardSubsumptionRemoval solver flag = do - writeIORef (svEnableBackwardSubsumptionRemoval solver) flag + modifyIORef' (svConfig solver) $ \config -> config{ configEnableBackwardSubsumptionRemoval = flag } +{-# DEPRECATED getEnableBackwardSubsumptionRemoval "Use getConfig" #-} getEnableBackwardSubsumptionRemoval :: Solver -> IO Bool getEnableBackwardSubsumptionRemoval solver = do - readIORef (svEnableBackwardSubsumptionRemoval solver) + configEnableBackwardSubsumptionRemoval <$> getConfig solver +{-# DEPRECATED defaultEnableBackwardSubsumptionRemoval "Use configEnableBackwardSubsumptionRemoval def" #-} defaultEnableBackwardSubsumptionRemoval :: Bool defaultEnableBackwardSubsumptionRemoval = False @@ -1635,22 +1735,16 @@ pickBranchLit :: Solver -> IO Lit pickBranchLit !solver = do + gen <- readIORef (svRandomGen solver) let vqueue = svVarQueue solver - - -- Random decision - let withRandGen :: (Rand.StdGen -> (a, Rand.StdGen)) -> IO a - withRandGen f = do - randgen <- readIORef (svRandomGen solver) - let (r, randgen') = f randgen - writeIORef (svRandomGen solver) randgen' - return r - !randfreq <- readIORef (svRandomFreq solver) + !randfreq <- configRandomFreq <$> getConfig solver !size <- PQ.queueSize vqueue - !r <- withRandGen Rand.random + -- System.Random.random produces [0,1), but System.Random.MWC.uniform produces (0,1] + !r <- liftM (1 -) $ Rand.uniform gen var <- if (r < randfreq && size >= 2) then do a <- PQ.getHeapArray vqueue - i <- withRandGen $ Rand.randomR (0, size-1) + i <- Rand.uniformR (0, size-1) gen var <- readArray a i val <- varValue solver var if val == lUndef then do @@ -1723,7 +1817,7 @@ case ret of Just _ -> return ret Nothing -> do - ret <- processVar (litVar lit) + ret <- processVar lit case ret of Just _ -> return ret Nothing -> loop @@ -1849,7 +1943,7 @@ n <- Vec.getSize (svTrail solver) go (n-1) (IS.singleton (litVar p)) [p] -analyzeConflictHybrid :: ConstraintHandler c => Solver -> c -> IO ((Clause, Level), (PBLinAtLeast, Level)) +analyzeConflictHybrid :: ConstraintHandler c => Solver -> c -> IO ((Clause, Level), Maybe (PBLinAtLeast, Level)) analyzeConflictHybrid solver constr = do d <- getDecisionLevel solver @@ -1932,37 +2026,41 @@ [] -> error "analyzeConflict: should not happen" [_] -> levelRoot _:(_,lv):_ -> lv - pblevel <- pbBacktrackLevel solver pb - return ((map fst xs, level), (pb, pblevel)) + case pbToClause pb of + Nothing -> do + pblevel <- pbBacktrackLevel solver pb + return ((map fst xs, level), Just (pb, pblevel)) + Just _ -> do + return ((map fst xs, level), Nothing) + pbBacktrackLevel :: Solver -> PBLinAtLeast -> IO Level pbBacktrackLevel _ ([], rhs) = assert (rhs > 0) $ return levelRoot pbBacktrackLevel solver (lhs, rhs) = do - levelToLiterals <- liftM (IM.unionsWith IM.union) $ forM lhs $ \(_,lit) -> do + levelToLiterals <- liftM (IM.unionsWith IM.union) $ forM lhs $ \(c,lit) -> do val <- litValue solver lit if val /= lUndef then do level <- litLevel solver lit - return $ IM.singleton level (IM.singleton lit val) + return $ IM.singleton level (IM.singleton lit (c,val)) else - return $ IM.empty + return $ IM.singleton maxBound (IM.singleton lit (c,val)) - let replay [] _ _ = error "pbBacktrackLevel: should not happen" - replay ((lv,lv_lits) : lvs) lhs slack = do - let slack_lv = slack - sum [c | (c,lit) <- lhs, IM.lookup lit lv_lits == Just lFalse] - lhs_lv = [tm | tm@(_,lit) <- lhs, IM.notMember lit lv_lits] + let replay [] !_ = error "pbBacktrackLevel: should not happen" + replay ((lv,lv_lits) : lvs) !slack = do + let slack_lv = slack - sum [c | (_,(c,val)) <- IM.toList lv_lits, val == lFalse] if slack_lv < 0 then return lv -- CONFLICT - else if any (\(c,_) -> c > slack_lv) lhs_lv then + else if any (\(_, lits2) -> any (\(c,_) -> c > slack_lv) (IM.elems lits2)) lvs then return lv -- UNIT else - replay lvs lhs_lv slack_lv + replay lvs slack_lv let initial_slack = sum [c | (c,_) <- lhs] - rhs - replay (IM.toList levelToLiterals) lhs initial_slack + replay (IM.toList levelToLiterals) initial_slack minimizeConflictClause :: Solver -> LitSet -> IO LitSet minimizeConflictClause solver lits = do - ccmin <- readIORef (svCCMin solver) + ccmin <- configCCMin <$> getConfig solver if ccmin >= 2 then minimizeConflictClauseRecursive solver lits else if ccmin >= 1 then @@ -2097,9 +2195,33 @@ m <- unsafeFreeze marr writeIORef (svModel solver) (Just m) +saveAssumptionsImplications :: Solver -> IO () +saveAssumptionsImplications solver = do + n <- Vec.getSize (svAssumptions solver) + lv <- getDecisionLevel solver + + lim_beg <- + if lv == 0 then + return 0 + else + Vec.read (svTrailLimit solver) 0 + lim_end <- + if lv > n then + Vec.read (svTrailLimit solver) n + else + Vec.getSize (svTrail solver) + + let ref = svAssumptionsImplications solver + forM_ [lim_beg .. lim_end-1] $ \i -> do + lit <- Vec.read (svTrail solver) i + modifyIORef' ref (IS.insert lit) + forM_ [0..n-1] $ \i -> do + lit <- Vec.read (svAssumptions solver) i + modifyIORef' ref (IS.delete lit) + constrDecayActivity :: Solver -> IO () constrDecayActivity solver = do - d <- readIOURef (svConstrDecay solver) + d <- configConstrDecay <$> getConfig solver modifyIOURef (svConstrInc solver) (d*) constrBumpActivity :: ConstraintHandler a => Solver -> a -> IO () @@ -2936,7 +3058,7 @@ newPBHandler :: Solver -> PBLinSum -> Integer -> Bool -> IO SomeConstraintHandler newPBHandler solver ts degree learnt = do - config <- readIORef (svPBHandlerType solver) + config <- configPBHandlerType <$> getConfig solver case config of PBHandlerTypeCounter -> do c <- newPBHandlerCounter ts degree learnt @@ -2973,6 +3095,12 @@ let c = head cs return $ (map snd lhs, fromInteger ((rhs+c-1) `div` c)) +pbToClause :: PBLinAtLeast -> Maybe Clause +pbToClause pb = do + (lhs, rhs) <- pbToAtLeast pb + guard $ rhs == 1 + return lhs + {-------------------------------------------------------------------- Pseudo Boolean Constraint (Counter) --------------------------------------------------------------------} @@ -3184,11 +3312,7 @@ return (IM.insert idx tm m) else return m -#if MIN_VERSION_containers(0,5,0) xs <- liftM (map snd . IM.toDescList) $ foldM f IM.empty (puebloTerms this2) -#else - xs <- liftM (reverse . map snd . IM.toAscList) $ foldM f IM.empty (puebloTerms this2) -#endif let g !_ [] = return () g !s ((c,l):ts) = do addOnUnassigned solver this l @@ -3612,7 +3736,8 @@ constrReasonOf solver _this l = do Just t <- readIORef (svTheorySolver solver) - thExplain t l + lits <- thExplain t l + return $ [-lit | lit <- lits] constrOnUnassigned _solver _this _this2 _lit = return () @@ -3632,9 +3757,15 @@ Restart strategy --------------------------------------------------------------------} +-- | Restart strategy. +-- +-- The default value can be obtained by 'def'. data RestartStrategy = MiniSATRestarts | ArminRestarts | LubyRestarts deriving (Show, Eq, Ord, Enum, Bounded) +instance Default RestartStrategy where + def = MiniSATRestarts + mkRestartSeq :: RestartStrategy -> Int -> Double -> [Int] mkRestartSeq MiniSATRestarts = miniSatRestartSeq mkRestartSeq ArminRestarts = arminRestartSeq @@ -3713,15 +3844,6 @@ if b then return True else go xs - -#if !MIN_VERSION_base(4,6,0) - -modifyIORef' :: IORef a -> (a -> a) -> IO () -modifyIORef' ref f = do - x <- readIORef ref - writeIORef ref $! f x - -#endif shift :: IORef [a] -> IO a shift ref = do diff --git a/src/ToySolver/SAT/Integer.hs b/src/ToySolver/SAT/Integer.hs --- a/src/ToySolver/SAT/Integer.hs +++ b/src/ToySolver/SAT/Integer.hs @@ -13,7 +13,7 @@ import Data.VectorSpace import Text.Printf -import ToySolver.Data.ArithRel +import ToySolver.Data.OrdRel import qualified ToySolver.SAT as SAT import qualified ToySolver.SAT.Types as SAT import qualified ToySolver.SAT.TseitinEncoder as TseitinEncoder @@ -59,8 +59,8 @@ zs <- PBNLC.linearizePBSum enc ys return (zs, c) -addConstraint :: TseitinEncoder.Encoder -> ArithRel Expr -> IO () -addConstraint enc (ArithRel lhs op rhs) = do +addConstraint :: TseitinEncoder.Encoder -> OrdRel Expr -> IO () +addConstraint enc (OrdRel lhs op rhs) = do let solver = TseitinEncoder.encSolver enc let Expr e = lhs - rhs case op of @@ -74,8 +74,8 @@ PBNLC.addPBAtLeastSoft enc sel e 1 PBNLC.addPBAtMostSoft enc (-sel) e (-1) -addConstraintSoft :: TseitinEncoder.Encoder -> SAT.Lit -> ArithRel Expr -> IO () -addConstraintSoft enc sel (ArithRel lhs op rhs) = do +addConstraintSoft :: TseitinEncoder.Encoder -> SAT.Lit -> OrdRel Expr -> IO () +addConstraintSoft enc sel (OrdRel lhs op rhs) = do let solver = TseitinEncoder.encSolver enc let Expr e = lhs - rhs case op of diff --git a/src/ToySolver/SAT/MUS.hs b/src/ToySolver/SAT/MUS.hs --- a/src/ToySolver/SAT/MUS.hs +++ b/src/ToySolver/SAT/MUS.hs @@ -14,7 +14,6 @@ module ToySolver.SAT.MUS ( module ToySolver.SAT.MUS.Types , Options (..) - , defaultOptions , findMUSAssumptions ) where @@ -27,6 +26,8 @@ import ToySolver.SAT.MUS.Types -- | Options for 'findMUSAssumptions' function +-- +-- The default value can be obtained by 'def'. data Options = Options { optLogger :: String -> IO () @@ -35,16 +36,12 @@ } instance Default Options where - def = defaultOptions - --- | default 'Options' value -defaultOptions :: Options -defaultOptions = - Options - { optLogger = \_ -> return () - , optUpdateBest = \_ -> return () - , optLitPrinter = show - } + def = + Options + { optLogger = \_ -> return () + , optUpdateBest = \_ -> return () + , optLitPrinter = show + } -- | Find a minimal set of assumptions that causes a conflict. -- Initial set of assumptions is taken from 'SAT.getFailedAssumptions'. diff --git a/src/ToySolver/SAT/MUS/CAMUS.hs b/src/ToySolver/SAT/MUS/CAMUS.hs --- a/src/ToySolver/SAT/MUS/CAMUS.hs +++ b/src/ToySolver/SAT/MUS/CAMUS.hs @@ -30,7 +30,6 @@ module ToySolver.SAT.MUS.CAMUS ( module ToySolver.SAT.MUS.Types , Options (..) - , defaultOptions , allMCSAssumptions , allMUSAssumptions , enumMCSAssumptions @@ -51,6 +50,8 @@ import ToySolver.SAT.MUS.Types -- | Options for 'enumMCSAssumptions', 'allMCSAssumptions', 'allMUSAssumptions' +-- +-- The default value can be obtained by 'def'. data Options = Options { optLogger :: String -> IO () @@ -64,19 +65,15 @@ } instance Default Options where - def = defaultOptions - --- | default 'Options' value -defaultOptions :: Options -defaultOptions = - Options - { optLogger = \_ -> return () - , optOnMCSFound = \_ -> return () - , optOnMUSFound = \_ -> return () - , optKnownMCSes = [] - , optKnownMUSes = [] - , optKnownCSes = [] - } + def = + Options + { optLogger = \_ -> return () + , optOnMCSFound = \_ -> return () + , optOnMUSFound = \_ -> return () + , optKnownMCSes = [] + , optKnownMUSes = [] + , optKnownCSes = [] + } enumMCSAssumptions :: SAT.Solver -> [Lit] -> Options -> IO () enumMCSAssumptions solver sels opt = do diff --git a/src/ToySolver/SAT/MUS/DAA.hs b/src/ToySolver/SAT/MUS/DAA.hs --- a/src/ToySolver/SAT/MUS/DAA.hs +++ b/src/ToySolver/SAT/MUS/DAA.hs @@ -21,14 +21,12 @@ module ToySolver.SAT.MUS.DAA ( module ToySolver.SAT.MUS.Types , Options (..) - , defaultOptions , allMCSAssumptions , allMUSAssumptions , daa ) where import Control.Monad -import Data.IntSet (IntSet) import qualified Data.IntSet as IntSet import Data.Set (Set) import qualified Data.Set as Set @@ -36,7 +34,7 @@ import qualified ToySolver.SAT as SAT import ToySolver.SAT.Types import ToySolver.SAT.MUS.Types -import ToySolver.SAT.MUS.CAMUS (Options (..), defaultOptions) +import ToySolver.SAT.MUS.CAMUS (Options (..)) allMCSAssumptions :: SAT.Solver -> [Lit] -> Options -> IO [MCS] allMCSAssumptions solver sels opt = do diff --git a/src/ToySolver/SAT/MUS/QuickXplain.hs b/src/ToySolver/SAT/MUS/QuickXplain.hs --- a/src/ToySolver/SAT/MUS/QuickXplain.hs +++ b/src/ToySolver/SAT/MUS/QuickXplain.hs @@ -20,7 +20,6 @@ module ToySolver.SAT.MUS.QuickXplain ( module ToySolver.SAT.MUS.Types , Options (..) - , defaultOptions , findMUSAssumptions ) where diff --git a/src/ToySolver/SAT/PBO.hs b/src/ToySolver/SAT/PBO.hs --- a/src/ToySolver/SAT/PBO.hs +++ b/src/ToySolver/SAT/PBO.hs @@ -17,6 +17,7 @@ -- * The @Optimizer@ type Optimizer , newOptimizer + , newOptimizer2 -- * Solving , optimize @@ -32,7 +33,6 @@ -- * Configulation , SearchStrategy (..) - , defaultSearchStrategy , getSearchStrategy , setSearchStrategy , defaultEnableObjFunVarsHeuristics @@ -49,13 +49,13 @@ import Control.Concurrent.STM import Control.Exception import Control.Monad +import Data.Array.IArray import Data.Default.Class import Data.IORef import qualified Data.Set as Set import qualified Data.Map as Map import Text.Printf import qualified ToySolver.SAT as SAT -import qualified ToySolver.SAT.Types as SAT import qualified ToySolver.SAT.PBO.Context as C import qualified ToySolver.SAT.PBO.BC as BC import qualified ToySolver.SAT.PBO.BCD as BCD @@ -63,6 +63,9 @@ import qualified ToySolver.SAT.PBO.UnsatBased as UnsatBased import qualified ToySolver.SAT.PBO.MSU4 as MSU4 +-- | Optimization strategy +-- +-- The default value can be obtained by 'def'. data SearchStrategy = LinearSearch | BinarySearch @@ -72,12 +75,10 @@ | BC | BCD | BCD2 + deriving (Eq, Ord, Show, Enum, Bounded) instance Default SearchStrategy where - def = defaultSearchStrategy - -defaultSearchStrategy :: SearchStrategy -defaultSearchStrategy = LinearSearch + def = LinearSearch data Optimizer = Optimizer @@ -89,8 +90,11 @@ } newOptimizer :: SAT.Solver -> SAT.PBLinSum -> IO Optimizer -newOptimizer solver obj = do - cxt <- C.newSimpleContext obj +newOptimizer solver obj = newOptimizer2 solver obj (\m -> SAT.evalPBLinSum m obj) + +newOptimizer2 :: SAT.Solver -> SAT.PBLinSum -> (SAT.Model -> Integer) -> IO Optimizer +newOptimizer2 solver obj obj2 = do + cxt <- C.newSimpleContext2 obj obj2 strategyRef <- newIORef def heuristicsRef <- newIORef defaultEnableObjFunVarsHeuristics trialLimitRef <- newIORef defaultTrialLimitConf @@ -112,6 +116,13 @@ getEnableObjFunVarsHeuristics opt >>= \b -> when b $ tweakParams solver obj + m <- getBestModel opt + case m of + Nothing -> return () + Just m -> do + forM_ (assocs m) $ \(v, val) -> do + SAT.setVarPolarity solver v val + strategy <- getSearchStrategy opt case strategy of UnsatBased -> UnsatBased.solve cxt solver @@ -122,7 +133,7 @@ let opt2 = def BCD2.solve cxt solver opt2 _ -> do - SAT.setEnableBackwardSubsumptionRemoval solver True + SAT.modifyConfig solver $ \config -> config{ SAT.configEnableBackwardSubsumptionRemoval = True } join $ atomically $ do ret <- C.getBestValue cxt @@ -218,8 +229,8 @@ loop = do result <- SAT.solve solver if result then do - m <- SAT.getModel solver - let val = SAT.evalPBLinSum m obj + m <- SAT.getModel solver + let val = C.evalObjectiveFunction cxt m let ub = val - 1 C.addSolution cxt m SAT.addPBAtMost solver obj ub @@ -248,7 +259,7 @@ ret <- SAT.solveWith solver [sel] if ret then do m <- SAT.getModel solver - let v = SAT.evalPBLinSum m obj + let v = C.evalObjectiveFunction cxt m let ub' = v - 1 C.logMessage cxt $ printf "Binary Search: updating upper bound: %d -> %d" ub ub' C.addSolution cxt m @@ -286,7 +297,7 @@ result <- SAT.solve solver if result then do m <- SAT.getModel solver - let v = SAT.evalPBLinSum m obj + let v = C.evalObjectiveFunction cxt m let ub' = v - 1 C.addSolution cxt m SAT.addPBAtMost solver obj ub' @@ -309,7 +320,7 @@ let fraction' = min 0.5 (fraction + 0.1) if ret then do m <- SAT.getModel solver - let v = SAT.evalPBLinSum m obj + let v = C.evalObjectiveFunction cxt m let ub' = v - 1 C.logMessage cxt $ printf "Adaptive Search: updating upper bound: %d -> %d" ub ub' C.addSolution cxt m diff --git a/src/ToySolver/SAT/PBO/BC.hs b/src/ToySolver/SAT/PBO/BC.hs --- a/src/ToySolver/SAT/PBO/BC.hs +++ b/src/ToySolver/SAT/PBO/BC.hs @@ -36,7 +36,7 @@ solveWBO :: C.Context cxt => cxt -> SAT.Solver -> IO () solveWBO cxt solver = do - SAT.setEnableBackwardSubsumptionRemoval solver True + SAT.modifyConfig solver $ \config -> config{ SAT.configEnableBackwardSubsumptionRemoval = True } ub <- atomically $ C.getSearchUpperBound cxt loop (IntSet.fromList [lit | (lit,_) <- sels], IntSet.empty) (0, ub) @@ -61,7 +61,7 @@ ret <- SAT.solveWith solver (sel : IntSet.toList unrelaxed) if ret then do m <- SAT.getModel solver - let val = SAT.evalPBLinSum m obj + let val = C.evalObjectiveFunction cxt m let ub' = val - 1 C.logMessage cxt $ printf "BC: updating upper bound: %d -> %d" ub ub' C.addSolution cxt m diff --git a/src/ToySolver/SAT/PBO/BCD.hs b/src/ToySolver/SAT/PBO/BCD.hs --- a/src/ToySolver/SAT/PBO/BCD.hs +++ b/src/ToySolver/SAT/PBO/BCD.hs @@ -61,7 +61,7 @@ solveWBO :: C.Context cxt => cxt -> SAT.Solver -> IO () solveWBO cxt solver = do - SAT.setEnableBackwardSubsumptionRemoval solver True + SAT.modifyConfig solver $ \config -> config{ SAT.configEnableBackwardSubsumptionRemoval = True } ub <- atomically $ C.getSearchUpperBound cxt loop (IntSet.fromList [lit | (lit,_) <- sels], IntSet.empty) [] ub @@ -97,7 +97,7 @@ if ret then do m <- SAT.getModel solver - let val = SAT.evalPBLinSum m obj + let val = C.evalObjectiveFunction cxt m let ub' = val - 1 C.logMessage cxt $ printf "BCD: updating upper bound: %d -> %d" ub ub' C.addSolution cxt m diff --git a/src/ToySolver/SAT/PBO/BCD2.hs b/src/ToySolver/SAT/PBO/BCD2.hs --- a/src/ToySolver/SAT/PBO/BCD2.hs +++ b/src/ToySolver/SAT/PBO/BCD2.hs @@ -27,22 +27,27 @@ ----------------------------------------------------------------------------- module ToySolver.SAT.PBO.BCD2 ( Options (..) - , defaultOptions , solve ) where import Control.Concurrent.STM -import Control.Exception import Control.Monad +import Data.IORef import Data.Default.Class import qualified Data.IntSet as IntSet import qualified Data.IntMap as IntMap +import Data.Map (Map) +import qualified Data.Map as Map +import qualified Data.Vector as V import qualified ToySolver.SAT as SAT import qualified ToySolver.SAT.Types as SAT import qualified ToySolver.SAT.PBO.Context as C -import qualified ToySolver.Combinatorial.Knapsack.BB as Knapsack +import qualified ToySolver.Combinatorial.SubsetSum as SubsetSum import Text.Printf +-- | Options for BCD2 algorithm. +-- +-- The default value can be obtained by 'def'. data Options = Options { optEnableHardening :: Bool @@ -51,51 +56,205 @@ } instance Default Options where - def = defaultOptions - -defaultOptions :: Options -defaultOptions - = Options - { optEnableHardening = True - , optEnableBiasedSearch = True - , optSolvingNormalFirst = True - } + def = + Options + { optEnableHardening = True + , optEnableBiasedSearch = True + , optSolvingNormalFirst = True + } data CoreInfo = CoreInfo { coreLits :: SAT.LitSet - , coreLB :: !Integer + , coreLBRef :: !(IORef Integer) + , coreUBSelectors :: !(IORef (Map Integer SAT.Lit)) } +newCoreInfo :: SAT.LitSet -> Integer -> IO CoreInfo +newCoreInfo lits lb = do + lbRef <- newIORef lb + selsRef <- newIORef Map.empty + return + CoreInfo + { coreLits = lits + , coreLBRef = lbRef + , coreUBSelectors = selsRef + } + +deleteCoreInfo :: SAT.Solver -> CoreInfo -> IO () +deleteCoreInfo solver core = do + m <- readIORef (coreUBSelectors core) + -- Delete soft upperbound constraints by fixing selector variables + forM_ (Map.elems m) $ \sel -> + SAT.addClause solver [-sel] + +getCoreLB :: CoreInfo -> IO Integer +getCoreLB = readIORef . coreLBRef + solve :: C.Context cxt => cxt -> SAT.Solver -> Options -> IO () solve cxt solver opt = solveWBO (C.normalize cxt) solver opt solveWBO :: C.Context cxt => cxt -> SAT.Solver -> Options -> IO () solveWBO cxt solver opt = do - SAT.setEnableBackwardSubsumptionRemoval solver True - let unrelaxed = IntSet.fromList [lit | (lit,_) <- sels] - relaxed = IntSet.empty - hardened = IntSet.empty - cnt = (1,1) + C.logMessage cxt $ printf "BCD2: Hardening is %s." (if optEnableHardening opt then "enabled" else "disabled") + C.logMessage cxt $ printf "BCD2: BiasedSearch is %s." (if optEnableBiasedSearch opt then "enabled" else "disabled") + + SAT.modifyConfig solver $ \config -> config{ SAT.configEnableBackwardSubsumptionRemoval = True } + + unrelaxedRef <- newIORef $ IntSet.fromList [lit | (lit,_) <- sels] + relaxedRef <- newIORef IntSet.empty + hardenedRef <- newIORef IntSet.empty + nsatRef <- newIORef 1 + nunsatRef <- newIORef 1 + + lastUBRef <- newIORef $ SAT.pbUpperBound obj + + coresRef <- newIORef [] + let getLB = do + xs <- readIORef coresRef + foldM (\s core -> do{ v <- getCoreLB core; return $! s + v }) 0 xs + + deductedWeightRef <- newIORef weights + let deductWeight d core = + modifyIORef' deductedWeightRef $ IntMap.unionWith (+) $ + IntMap.fromList [(lit, - d) | lit <- IntSet.toList (coreLits core)] + updateLB oldLB core = do + newLB <- getLB + C.addLowerBound cxt newLB + deductWeight (newLB - oldLB) core + SAT.addPBAtLeast solver (coreCostFun core) =<< getCoreLB core -- redundant, but useful for direct search + + let loop = do + lb <- getLB + ub <- do + ub1 <- atomically $ C.getSearchUpperBound cxt + -- FIXME: The refinement should be done in Context.addSolution, + -- for generality and to avoid duplicated computation. + let ub2 = refineUB (map fst obj) ub1 + when (ub1 /= ub2) $ C.logMessage cxt $ printf "BCD2: refineUB: %d -> %d" ub1 ub2 + return ub2 + when (ub < lb) $ C.setFinished cxt + + fin <- atomically $ C.isFinished cxt + unless fin $ do + + when (optEnableHardening opt) $ do + deductedWeight <- readIORef deductedWeightRef + hardened <- readIORef hardenedRef + let lits = IntMap.keysSet (IntMap.filter (\w -> lb + w > ub) deductedWeight) `IntSet.difference` hardened + unless (IntSet.null lits) $ do + C.logMessage cxt $ printf "BCD2: hardening fixes %d literals" (IntSet.size lits) + forM_ (IntSet.toList lits) $ \lit -> SAT.addClause solver [lit] + modifyIORef unrelaxedRef (`IntSet.difference` lits) + modifyIORef relaxedRef (`IntSet.difference` lits) + modifyIORef hardenedRef (`IntSet.union` lits) + + ub0 <- readIORef lastUBRef + when (ub < ub0) $ do + C.logMessage cxt $ printf "BCD2: updating upper bound: %d -> %d" ub0 ub + SAT.addPBAtMost solver obj ub + writeIORef lastUBRef ub + + cores <- readIORef coresRef + unrelaxed <- readIORef unrelaxedRef + relaxed <- readIORef relaxedRef + hardened <- readIORef hardenedRef + nsat <- readIORef nsatRef + nunsat <- readIORef nunsatRef + C.logMessage cxt $ printf "BCD2: %d <= obj <= %d" lb ub + C.logMessage cxt $ printf "BCD2: #cores=%d, #unrelaxed=%d, #relaxed=%d, #hardened=%d" + (length cores) (IntSet.size unrelaxed) (IntSet.size relaxed) (IntSet.size hardened) + C.logMessage cxt $ printf "BCD2: #sat=%d #unsat=%d bias=%d/%d" nsat nunsat nunsat (nunsat + nsat) + + lastModel <- atomically $ C.getBestModel cxt + sels <- liftM IntMap.fromList $ forM cores $ \core -> do + coreLB <- getCoreLB core + let coreUB = SAT.pbUpperBound (coreCostFun core) + if coreUB < coreLB then do + -- Note: we have detected unsatisfiability + C.logMessage cxt $ printf "BCD2: coreLB (%d) exceeds coreUB (%d)" coreLB coreUB + SAT.addClause solver [] + sel <- getCoreUBAssumption core coreUB + return (sel, (core, coreUB)) + else do + let estimated = + case lastModel of + Nothing -> coreUB + Just m -> + -- Since we might have added some hard constraints after obtaining @m@, + -- it's possible that @coreLB@ is larger than @SAT.evalPBLinSum m (coreCostFun core)@. + coreLB `max` SAT.evalPBLinSum m (coreCostFun core) + mid = + if optEnableBiasedSearch opt + then coreLB + (estimated - coreLB) * nunsat `div` (nunsat + nsat) + else (coreLB + estimated) `div` 2 + sel <- getCoreUBAssumption core mid + return (sel, (core,mid)) + + ret <- SAT.solveWith solver (IntMap.keys sels ++ IntSet.toList unrelaxed) + + if ret then do + modifyIORef' nsatRef (+1) + C.addSolution cxt =<< SAT.getModel solver + loop + else do + modifyIORef' nunsatRef (+1) + failed <- SAT.getFailedAssumptions solver + + case failed of + [] -> C.setFinished cxt + [sel] | Just (core,mid) <- IntMap.lookup sel sels -> do + C.logMessage cxt $ printf "BCD2: updating lower bound of a core" + let newCoreLB = mid + 1 + newCoreLB' = refineLB [weights IntMap.! lit | lit <- IntSet.toList (coreLits core)] newCoreLB + when (newCoreLB /= newCoreLB') $ C.logMessage cxt $ + printf "BCD2: refineLB: %d -> %d" newCoreLB newCoreLB' + writeIORef (coreLBRef core) newCoreLB' + SAT.addClause solver [-sel] -- Delete soft upperbound constraint(s) by fixing a selector variable + updateLB lb core + loop + _ -> do + let failed' = IntSet.fromList failed + torelax = unrelaxed `IntSet.intersection` failed' + intersected = [(core,mid) | (sel,(core,mid)) <- IntMap.toList sels, sel `IntSet.member` failed'] + disjoint = [core | (sel,(core,_)) <- IntMap.toList sels, sel `IntSet.notMember` failed'] + modifyIORef unrelaxedRef (`IntSet.difference` torelax) + modifyIORef relaxedRef (`IntSet.union` torelax) + delta <- do + xs1 <- forM intersected $ \(core,mid) -> do + coreLB <- getCoreLB core + return $ mid - coreLB + 1 + let xs2 = [weights IntMap.! lit | lit <- IntSet.toList torelax] + return $! minimum (xs1 ++ xs2) + let mergedCoreLits = IntSet.unions $ torelax : [coreLits core | (core,_) <- intersected] + mergedCoreLB <- liftM ((delta +) . sum) $ mapM (getCoreLB . fst) intersected + let mergedCoreLB' = refineLB [weights IntMap.! lit | lit <- IntSet.toList mergedCoreLits] mergedCoreLB + mergedCore <- newCoreInfo mergedCoreLits mergedCoreLB' + writeIORef coresRef (mergedCore : disjoint) + forM_ intersected $ \(core, _) -> deleteCoreInfo solver core + + if null intersected then + C.logMessage cxt $ printf "BCD2: found a new core of size %d: cost of the new core is >=%d" + (IntSet.size torelax) mergedCoreLB' + else + C.logMessage cxt $ printf "BCD2: relaxing %d and merging with %d cores into a new core of size %d: cost of the new core is >=%d" + (IntSet.size torelax) (length intersected) (IntSet.size mergedCoreLits) mergedCoreLB' + when (mergedCoreLB /= mergedCoreLB') $ + C.logMessage cxt $ printf "BCD2: refineLB: %d -> %d" mergedCoreLB mergedCoreLB' + updateLB lb mergedCore + loop + best <- atomically $ C.getBestModel cxt case best of - Just m -> do - loop (unrelaxed, relaxed, hardened) weights [] (SAT.evalPBLinSum m obj - 1) (Just m) cnt - Nothing - | optSolvingNormalFirst opt -> do - ret <- SAT.solve solver - if ret then do - m <- SAT.getModel solver - let val = SAT.evalPBLinSum m obj - let ub' = val - 1 - C.logMessage cxt $ printf "BCD2: updating upper bound: %d -> %d" (SAT.pbUpperBound obj) ub' - C.addSolution cxt m - SAT.addPBAtMost solver obj ub' - loop (unrelaxed, relaxed, hardened) weights [] ub' (Just m) cnt - else - C.setFinished cxt - | otherwise -> do - loop (unrelaxed, relaxed, hardened) weights [] (SAT.pbUpperBound obj) Nothing cnt + Nothing | optSolvingNormalFirst opt -> do + ret <- SAT.solve solver + if ret then + C.addSolution cxt =<< SAT.getModel solver + else + C.setFinished cxt + _ -> return () + loop + where obj :: SAT.PBLinSum obj = C.getObjectiveFunction cxt @@ -109,117 +268,40 @@ coreCostFun :: CoreInfo -> SAT.PBLinSum coreCostFun c = [(weights IntMap.! lit, -lit) | lit <- IntSet.toList (coreLits c)] - computeLB :: [CoreInfo] -> Integer - computeLB cores = sum [coreLB info | info <- cores] - - loop :: (SAT.LitSet, SAT.LitSet, SAT.LitSet) -> SAT.LitMap Integer -> [CoreInfo] -> Integer -> Maybe SAT.Model -> (Integer,Integer) -> IO () - loop (unrelaxed, relaxed, hardened) deductedWeight cores ub lastModel (!nsat,!nunsat) = do - let lb = computeLB cores - C.logMessage cxt $ printf "BCD2: %d <= obj <= %d" lb ub - C.logMessage cxt $ printf "BCD2: #cores=%d, #unrelaxed=%d, #relaxed=%d, #hardened=%d" - (length cores) (IntSet.size unrelaxed) (IntSet.size relaxed) (IntSet.size hardened) - - when (optEnableBiasedSearch opt) $ do - C.logMessage cxt $ printf "BCD2: bias = %d/%d" nunsat (nunsat + nsat) - - sels <- liftM IntMap.fromList $ forM cores $ \info -> do - sel <- SAT.newVar solver - let ep = case lastModel of - Nothing -> sum [weights IntMap.! lit | lit <- IntSet.toList (coreLits info)] - Just m -> SAT.evalPBLinSum m (coreCostFun info) - mid - | optEnableBiasedSearch opt = coreLB info + (ep - coreLB info) * nunsat `div` (nunsat + nsat) - | otherwise = (coreLB info + ep) `div` 2 - SAT.addPBAtMostSoft solver sel (coreCostFun info) mid - return (sel, (info,mid)) - - ret <- SAT.solveWith solver (IntMap.keys sels ++ IntSet.toList unrelaxed) - - if ret then do - m <- SAT.getModel solver - let val = SAT.evalPBLinSum m obj - let ub' = val - 1 - C.logMessage cxt $ printf "BCD2: updating upper bound: %d -> %d" ub ub' - C.addSolution cxt m - SAT.addPBAtMost solver obj ub' - cont (unrelaxed, relaxed, hardened) deductedWeight cores ub' (Just m) (nsat+1,nunsat) - else do - core <- SAT.getFailedAssumptions solver - case core of - [] -> C.setFinished cxt - [sel] | Just (info,mid) <- IntMap.lookup sel sels -> do - let newLB = refine [weights IntMap.! lit | lit <- IntSet.toList (coreLits info)] mid - info' = info{ coreLB = newLB } - cores' = IntMap.elems $ IntMap.insert sel info' $ IntMap.map fst sels - lb' = computeLB cores' - deductedWeight' = IntMap.unionWith (+) deductedWeight (IntMap.fromList [(lit, - d) | let d = lb' - lb, d /= 0, lit <- IntSet.toList (coreLits info)]) - C.logMessage cxt $ printf "BCD2: updating lower bound of a core" - SAT.addPBAtLeast solver (coreCostFun info') (coreLB info') -- redundant, but useful for direct search - cont (unrelaxed, relaxed, hardened) deductedWeight' cores' ub lastModel (nsat,nunsat+1) - _ -> do - let coreSet = IntSet.fromList core - torelax = unrelaxed `IntSet.intersection` coreSet - unrelaxed' = unrelaxed `IntSet.difference` torelax - relaxed' = relaxed `IntSet.union` torelax - intersected = [(info,mid) | (sel,(info,mid)) <- IntMap.toList sels, sel `IntSet.member` coreSet] - rest = [info | (sel,(info,_)) <- IntMap.toList sels, sel `IntSet.notMember` coreSet] - delta = minimum $ [mid - coreLB info + 1 | (info,mid) <- intersected] ++ - [weights IntMap.! lit | lit <- IntSet.toList torelax] - newLits = IntSet.unions $ torelax : [coreLits info | (info,_) <- intersected] - mergedCore = CoreInfo - { coreLits = newLits - , coreLB = refine [weights IntMap.! lit | lit <- IntSet.toList relaxed'] (sum [coreLB info | (info,_) <- intersected] + delta - 1) - } - cores' = mergedCore : rest - lb' = computeLB cores' - deductedWeight' = IntMap.unionWith (+) deductedWeight (IntMap.fromList [(lit, - d) | let d = lb' - lb, d /= 0, lit <- IntSet.toList newLits]) - if null intersected then do - C.logMessage cxt $ printf "BCD2: found a new core of size %d" (IntSet.size torelax) - else do - C.logMessage cxt $ printf "BCD2: merging cores" - SAT.addPBAtLeast solver (coreCostFun mergedCore) (coreLB mergedCore) -- redundant, but useful for direct search - forM_ (IntMap.keys sels) $ \sel -> SAT.addClause solver [-sel] -- delete temporary constraints - cont (unrelaxed', relaxed', hardened) deductedWeight' cores' ub lastModel (nsat,nunsat+1) - - cont :: (SAT.LitSet, SAT.LitSet, SAT.LitSet) -> SAT.LitMap Integer -> [CoreInfo] -> Integer -> Maybe SAT.Model -> (Integer,Integer) -> IO () - cont (unrelaxed, relaxed, hardened) deductedWeight cores ub lastModel (!nsat,!nunsat) - | lb > ub = C.setFinished cxt - | optEnableHardening opt = do - let lits = IntMap.keysSet $ IntMap.filter (\w -> lb + w > ub) deductedWeight - forM_ (IntSet.toList lits) $ \lit -> SAT.addClause solver [lit] - let unrelaxed' = unrelaxed `IntSet.difference` lits - relaxed' = relaxed `IntSet.difference` lits - hardened' = hardened `IntSet.union` lits - cores' = map (\core -> core{ coreLits = coreLits core `IntSet.difference` lits }) cores - loop (unrelaxed', relaxed', hardened') deductedWeight cores' ub lastModel (nsat,nunsat) - | otherwise = - loop (unrelaxed, relaxed, hardened) deductedWeight cores ub lastModel (nsat,nunsat) - where - lb = computeLB cores + getCoreUBAssumption :: CoreInfo -> Integer -> IO SAT.Lit + getCoreUBAssumption core ub = do + m <- readIORef (coreUBSelectors core) + case Map.splitLookup ub m of + (_, Just sel, _) -> return sel + (lo, Nothing, hi) -> do + sel <- SAT.newVar solver + SAT.addPBAtMostSoft solver sel (coreCostFun core) ub + writeIORef (coreUBSelectors core) (Map.insert ub sel m) + unless (Map.null lo) $ + SAT.addClause solver [- snd (Map.findMax lo), sel] -- snd (Map.findMax lo) → sel + unless (Map.null hi) $ + SAT.addClause solver [- sel, snd (Map.findMin hi)] -- sel → Map.findMin hi + return sel --- | The smallest integer greater than @n@ that can be obtained by summing a subset of @ws@. -refine +-- | The smallest integer greater-than or equal-to @n@ that can be obtained by summing a subset of @ws@. +-- Note that the definition is different from the one in Morgado et al. +refineLB :: [Integer] -- ^ @ws@ -> Integer -- ^ @n@ -> Integer -refine ws n = n+1 -{- -refine ws n = assert (n+1 <= result) $ result - where - sum_ws = sum ws - (v,_,_) = Knapsack.solve [(fromInteger w, fromInteger w) | w <- ws] (fromInteger (sum_ws - n - 1)) - result = sum_ws - floor v --} -{- -minimize Σ wi xi = Σ wi (1 - ¬xi) = Σ wi - (Σ wi ¬xi) -subject to Σ wi xi > n - -maximize Σ wi ¬xi -subject to Σ wi ¬xi ≤ (Σ wi) - n - 1 +refineLB ws n = + case SubsetSum.minSubsetSum (V.fromList ws) n of + Nothing -> sum [w | w <- ws, w > 0] + 1 + Just (obj, _) -> obj -Σ wi xi > n -Σ wi (1 - ¬xi) > n -(Σ wi) - (Σ wi ¬xi) > n -(Σ wi ¬xi) < (Σ wi) - n -(Σ wi ¬xi) ≤ (Σ wi) - n - 1 --} +-- | The greatest integer lesser-than or equal-to @n@ that can be obtained by summing a subset of @ws@. +refineUB + :: [Integer] -- ^ @ws@ + -> Integer -- ^ @n@ + -> Integer +refineUB ws n + | n < 0 = n + | otherwise = + case SubsetSum.maxSubsetSum (V.fromList ws) n of + Nothing -> sum [w | w <- ws, w < 0] - 1 + Just (obj, _) -> obj diff --git a/src/ToySolver/SAT/PBO/Context.hs b/src/ToySolver/SAT/PBO/Context.hs --- a/src/ToySolver/SAT/PBO/Context.hs +++ b/src/ToySolver/SAT/PBO/Context.hs @@ -11,6 +11,7 @@ , SimpleContext , newSimpleContext + , newSimpleContext2 , setOnUpdateBestSolution , setOnUpdateLowerBound , setLogger @@ -31,6 +32,7 @@ class Context a where getObjectiveFunction :: a -> SAT.PBLinSum + evalObjectiveFunction :: a -> SAT.Model -> Integer isUnsat :: a -> STM Bool getBestSolution :: a -> STM (Maybe (SAT.Model, Integer)) @@ -41,6 +43,8 @@ addLowerBound :: a -> Integer -> IO () logMessage :: a -> String -> IO () + evalObjectiveFunction c m = SAT.evalPBLinSum m (getObjectiveFunction c) + getBestValue :: Context a => a -> STM (Maybe Integer) getBestValue cxt = liftM (fmap snd) $ getBestSolution cxt @@ -51,7 +55,11 @@ isOptimum cxt = do ub <- getBestValue cxt lb <- getLowerBound cxt - return $ ub == Just lb + case ub of + Nothing -> return False + Just val -> return $ val <= lb + -- Note that solving with the assumption 'obj < val' can yield + -- a lower bound that is higher than val! isFinished :: Context a => a -> STM Bool isFinished cxt = do @@ -81,6 +89,7 @@ data SimpleContext = SimpleContext { scGetObjectiveFunction :: SAT.PBLinSum + , scEvalObjectiveFunction :: SAT.Model -> Integer , scUnsatRef :: TVar Bool , scBestSolutionRef :: TVar (Maybe (SAT.Model, Integer)) @@ -93,6 +102,7 @@ instance Context SimpleContext where getObjectiveFunction = scGetObjectiveFunction + evalObjectiveFunction = scEvalObjectiveFunction isUnsat sc = readTVar (scUnsatRef sc) getBestSolution sc = readTVar (scBestSolutionRef sc) @@ -105,7 +115,7 @@ writeTVar (scUnsatRef sc) True addSolution sc m = do - let !val = SAT.evalPBLinSum m (getObjectiveFunction sc) + let !val = evalObjectiveFunction sc m join $ atomically $ do unsat <- isUnsat sc when unsat $ error "addSolution: already marked as unsatisfiable" -- FIXME: use throwSTM? @@ -135,7 +145,10 @@ h msg newSimpleContext :: SAT.PBLinSum -> IO SimpleContext -newSimpleContext obj = do +newSimpleContext obj = newSimpleContext2 obj (\m -> SAT.evalPBLinSum m obj) + +newSimpleContext2 :: SAT.PBLinSum -> (SAT.Model -> Integer) -> IO SimpleContext +newSimpleContext2 obj obj2 = do unsatRef <- newTVarIO False bestsolRef <- newTVarIO Nothing lbRef <- newTVarIO $! SAT.pbLowerBound obj @@ -147,6 +160,7 @@ return $ SimpleContext { scGetObjectiveFunction = obj + , scEvalObjectiveFunction = obj2 , scUnsatRef = unsatRef , scBestSolutionRef = bestsolRef @@ -179,6 +193,8 @@ instance Context a => Context (Normalized a) where getObjectiveFunction = nObjectiveFunction + + evalObjectiveFunction cxt m = evalObjectiveFunction (nBase cxt) m - nOffset cxt isUnsat cxt = isUnsat (nBase cxt) diff --git a/src/ToySolver/SAT/PBO/MSU4.hs b/src/ToySolver/SAT/PBO/MSU4.hs --- a/src/ToySolver/SAT/PBO/MSU4.hs +++ b/src/ToySolver/SAT/PBO/MSU4.hs @@ -38,7 +38,7 @@ solveWBO :: C.Context cxt => cxt -> SAT.Solver -> IO () solveWBO cxt solver = do - SAT.setEnableBackwardSubsumptionRemoval solver True + SAT.modifyConfig solver $ \config -> config{ SAT.configEnableBackwardSubsumptionRemoval = True } loop (IM.keysSet weights, IS.empty) 0 where diff --git a/src/ToySolver/SAT/PBO/UnsatBased.hs b/src/ToySolver/SAT/PBO/UnsatBased.hs --- a/src/ToySolver/SAT/PBO/UnsatBased.hs +++ b/src/ToySolver/SAT/PBO/UnsatBased.hs @@ -35,7 +35,7 @@ solveWBO :: C.Context cxt => cxt -> SAT.Solver -> IO () solveWBO cxt solver = do - SAT.setEnableBackwardSubsumptionRemoval solver True + SAT.modifyConfig solver $ \config -> config{ SAT.configEnableBackwardSubsumptionRemoval = True } let sels0 = [(-v, c) | (c,v) <- C.getObjectiveFunction cxt] loop 0 (IntMap.fromList sels0) where diff --git a/src/ToySolver/SAT/TheorySolver.hs b/src/ToySolver/SAT/TheorySolver.hs --- a/src/ToySolver/SAT/TheorySolver.hs +++ b/src/ToySolver/SAT/TheorySolver.hs @@ -12,6 +12,7 @@ , thExplain :: Maybe Lit -> IO [Lit] , thPushBacktrackPoint :: IO () , thPopBacktrackPoint :: IO () + , thConstructModel :: IO () } emptyTheory :: TheorySolver @@ -22,4 +23,5 @@ , thExplain = \_ -> error "should not happen" , thPushBacktrackPoint = return () , thPopBacktrackPoint = return () + , thConstructModel = return () } diff --git a/src/ToySolver/SAT/TseitinEncoder.hs b/src/ToySolver/SAT/TseitinEncoder.hs --- a/src/ToySolver/SAT/TseitinEncoder.hs +++ b/src/ToySolver/SAT/TseitinEncoder.hs @@ -63,6 +63,8 @@ -- * Encoding of boolean formulas , addFormula + , encodeFormula + , encodeFormulaWithPolarity , encodeConj , encodeConjWithPolarity , encodeDisj @@ -78,7 +80,6 @@ import Data.IORef import Data.Map (Map) import qualified Data.Map as Map -import Data.IntSet (IntSet) import qualified Data.IntSet as IntSet import ToySolver.Data.Boolean import ToySolver.Data.BoolExpr @@ -126,16 +127,16 @@ case formula of And xs -> mapM_ (addFormula encoder) xs Equiv a b -> do - lit1 <- encodeToLit encoder a - lit2 <- encodeToLit encoder b + lit1 <- encodeFormula encoder a + lit2 <- encodeFormula encoder b SAT.addClause solver [SAT.litNot lit1, lit2] -- a→b SAT.addClause solver [SAT.litNot lit2, lit1] -- b→a Not (Not a) -> addFormula encoder a Not (Or xs) -> addFormula encoder (andB (map notB xs)) Not (Imply a b) -> addFormula encoder (a .&&. notB b) Not (Equiv a b) -> do - lit1 <- encodeToLit encoder a - lit2 <- encodeToLit encoder b + lit1 <- encodeFormula encoder a + lit2 <- encodeFormula encoder b SAT.addClause solver [lit1, lit2] -- a ∨ b SAT.addClause solver [SAT.litNot lit1, SAT.litNot lit2] -- ¬a ∨ ¬b _ -> do @@ -155,30 +156,30 @@ Imply a b -> do encodeToClause encoder (notB a .||. b) _ -> do - l <- encodeToLitWithPolarity encoder polarityPos formula + l <- encodeFormulaWithPolarity encoder polarityPos formula return [l] -encodeToLit :: Encoder -> Formula -> IO SAT.Lit -encodeToLit encoder = encodeToLitWithPolarity encoder polarityBoth +encodeFormula :: Encoder -> Formula -> IO SAT.Lit +encodeFormula encoder = encodeFormulaWithPolarity encoder polarityBoth -encodeToLitWithPolarity :: Encoder -> Polarity -> Formula -> IO SAT.Lit -encodeToLitWithPolarity encoder p formula = do +encodeFormulaWithPolarity :: Encoder -> Polarity -> Formula -> IO SAT.Lit +encodeFormulaWithPolarity encoder p formula = do case formula of Atom l -> return l - And xs -> encodeConjWithPolarity encoder p =<< mapM (encodeToLitWithPolarity encoder p) xs - Or xs -> encodeDisjWithPolarity encoder p =<< mapM (encodeToLitWithPolarity encoder p) xs - Not x -> liftM SAT.litNot $ encodeToLitWithPolarity encoder (negatePolarity p) x + And xs -> encodeConjWithPolarity encoder p =<< mapM (encodeFormulaWithPolarity encoder p) xs + Or xs -> encodeDisjWithPolarity encoder p =<< mapM (encodeFormulaWithPolarity encoder p) xs + Not x -> liftM SAT.litNot $ encodeFormulaWithPolarity encoder (negatePolarity p) x Imply x y -> do - encodeToLitWithPolarity encoder p (notB x .||. y) + encodeFormulaWithPolarity encoder p (notB x .||. y) Equiv x y -> do - lit1 <- encodeToLitWithPolarity encoder polarityBoth x - lit2 <- encodeToLitWithPolarity encoder polarityBoth y - encodeToLitWithPolarity encoder p $ + lit1 <- encodeFormulaWithPolarity encoder polarityBoth x + lit2 <- encodeFormulaWithPolarity encoder polarityBoth y + encodeFormulaWithPolarity encoder p $ (Atom lit1 .=>. Atom lit2) .&&. (Atom lit2 .=>. Atom lit1) ITE c t e -> do - c' <- encodeToLitWithPolarity encoder polarityBoth c - t' <- encodeToLitWithPolarity encoder p t - e' <- encodeToLitWithPolarity encoder p e + c' <- encodeFormulaWithPolarity encoder polarityBoth c + t' <- encodeFormulaWithPolarity encoder p t + e' <- encodeFormulaWithPolarity encoder p e encodeITEWithPolarity encoder p c' t' e' -- | Return an literal which is equivalent to a given conjunction. diff --git a/src/ToySolver/SAT/Types.hs b/src/ToySolver/SAT/Types.hs --- a/src/ToySolver/SAT/Types.hs +++ b/src/ToySolver/SAT/Types.hs @@ -33,9 +33,11 @@ -- * Cardinality Constraint , AtLeast + , Exactly , normalizeAtLeast , instantiateAtLeast , evalAtLeast + , evalExactly -- * Pseudo Boolean Constraint , PBLinTerm @@ -69,11 +71,13 @@ import Data.Array.Unboxed import Data.Ord import Data.List -import Data.IntMap (IntMap) -import qualified Data.IntMap as IntMap +import Data.IntMap.Strict (IntMap) +import qualified Data.IntMap.Strict as IntMap import Data.IntSet (IntSet) import qualified Data.IntSet as IntSet +import qualified Data.Vector as V import ToySolver.Data.LBool +import qualified ToySolver.Combinatorial.SubsetSum as SubsetSum -- | Variable is represented as positive integers (DIMACS format). type Var = Int @@ -188,6 +192,7 @@ clauseToPBLinAtLeast xs = ([(1,l) | l <- xs], 1) type AtLeast = ([Lit], Int) +type Exactly = ([Lit], Int) normalizeAtLeast :: AtLeast -> AtLeast normalizeAtLeast (lits,n) = assert (IntSet.size ys `mod` 2 == 0) $ @@ -216,6 +221,9 @@ evalAtLeast :: IModel m => m -> AtLeast -> Bool evalAtLeast m (lits,n) = sum [1 | lit <- lits, evalLit m lit] >= n +evalExactly :: IModel m => m -> Exactly -> Bool +evalExactly m (lits,n) = sum [1 | lit <- lits, evalLit m lit] == n + type PBLinTerm = (Integer, Lit) type PBLinSum = [PBLinTerm] type PBLinAtLeast = (PBLinSum, Integer) @@ -255,7 +263,7 @@ normalizePBLinAtLeast a = case step1 a of (xs,n) - | n > 0 -> step3 (saturate n xs, n) + | n > 0 -> step4 $ step3 (xs,n) | otherwise -> ([], 0) -- trivially true where step1 :: PBLinAtLeast -> PBLinAtLeast @@ -263,23 +271,29 @@ case normalizePBLinSum (xs,-n) of (ys,m) -> (ys, -m) - -- degree以上の係数はそこで抑える。 - saturate :: Integer -> PBLinSum -> PBLinSum - saturate n xs = [assert (c>0) (min n c, l) | (c,l) <- xs] - - -- omega test と同様の係数の gcd による単純化 + -- saturation + gcd reduction step3 :: PBLinAtLeast -> PBLinAtLeast - step3 ([],n) = ([],n) - step3 (xs,n) = ([(c `div` d, l) | (c,l) <- xs], (n+d-1) `div` d) - where - d = foldl1' gcd [c | (c,_) <- xs] + step3 (xs,n) = + case [c | (c,_) <- xs, assert (c>0) (c < n)] of + [] -> ([(1,l) | (c,l) <- xs], 1) + cs -> + let d = foldl1' gcd cs + m = (n+d-1) `div` d + in ([(if c >= n then m else c `div` d, l) | (c,l) <- xs], m) + -- subset sum + step4 :: PBLinAtLeast -> PBLinAtLeast + step4 (xs,n) = + case SubsetSum.minSubsetSum (V.fromList [c | (c,_) <- xs]) n of + Just (m, _) -> (xs, m) + Nothing -> ([], 1) -- false + -- | normalizing PB constraint of the form /c1 x1 + c2 cn ... cn xn = b/. normalizePBLinExactly :: PBLinExactly -> PBLinExactly normalizePBLinExactly a = 　case step1 $ a of (xs,n) - | n >= 0 -> step2 (xs, n) + | n >= 0 -> step3 $ step2 (xs, n) | otherwise -> ([], 1) -- false where step1 :: PBLinExactly -> PBLinExactly @@ -295,6 +309,13 @@ | otherwise = ([], 1) -- false where d = foldl1' gcd [c | (c,_) <- xs] + + -- subset sum + step3 :: PBLinExactly -> PBLinExactly + step3 constr@(xs,n) = + case SubsetSum.subsetSum (V.fromList [c | (c,_) <- xs]) n of + Just _ -> constr + Nothing -> ([], 1) -- false {-# SPECIALIZE instantiatePBLinAtLeast :: (Lit -> IO LBool) -> PBLinAtLeast -> IO PBLinAtLeast #-} instantiatePBLinAtLeast :: forall m. Monad m => (Lit -> m LBool) -> PBLinAtLeast -> m PBLinAtLeast diff --git a/src/ToySolver/SMT.hs b/src/ToySolver/SMT.hs new file mode 100644 --- /dev/null +++ b/src/ToySolver/SMT.hs @@ -0,0 +1,933 @@ +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, DeriveDataTypeable, CPP #-} +----------------------------------------------------------------------------- +-- | +-- Module : ToySolver.SMT +-- Copyright : (c) Masahiro Sakai 2015 +-- License : BSD-style +-- +-- Maintainer : masahiro.sakai@gmail.com +-- Stability : unstable +-- Portability : non-portable (MultiParamTypeClasses, FlexibleInstances, DeriveDataTypeable, CPP) +-- +----------------------------------------------------------------------------- +module ToySolver.SMT + ( + -- * The Solver type + Solver + , newSolver + , Exception (..) + + -- * Problem Specification + , SSym (..) + , ssymArity + , Sort (..) + , sBool + , sReal + , FunType + , Expr (..) + , exprSort + , FSym + , declareSSym + , declareSort + , VASortFun + , declareFSym + , declareFun + , declareConst + , VAFun + , assert + , assertNamed + , getGlobalDeclarations + , setGlobalDeclarations + + -- * Solving + , checkSAT + , checkSATAssuming + , push + , pop + + -- * Inspecting models + , Model + , Value (..) + , getModel + , eval + , valSort + , FunDef (..) + , evalFSym + + -- * Inspecting proofs + , getUnsatAssumptions + , getUnsatCore + ) where + +import qualified Control.Exception as E +import Control.Monad +import Control.Monad.Trans +import Control.Monad.Trans.Except +import Data.Either +import Data.IntMap (IntMap) +import qualified Data.IntMap as IntMap +import Data.IntSet (IntSet) +import qualified Data.IntSet as IntSet +import Data.IORef +import Data.List +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Maybe (catMaybes) +import Data.Set (Set) +import qualified Data.Set as Set +import Data.Typeable +import Data.VectorSpace + +import ToySolver.Data.Delta +import ToySolver.Data.Boolean +import ToySolver.Data.BoolExpr +import ToySolver.Data.OrdRel +import qualified ToySolver.Data.LA as LA +import qualified ToySolver.Internal.Data.Vec as Vec +import qualified ToySolver.SAT as SAT +import ToySolver.SAT.TheorySolver +import qualified ToySolver.SAT.TseitinEncoder as Tseitin +import qualified ToySolver.Arith.Simplex2 as Simplex2 +import qualified ToySolver.EUF.EUFSolver as EUF + +type FSym = String + +-- | Sort symbols +data SSym + = SSymBool + | SSymReal + | SSymUserDeclared String !Int + deriving (Show, Eq, Ord) + +ssymArity :: SSym -> Int +ssymArity SSymBool = 0 +ssymArity SSymReal = 0 +ssymArity (SSymUserDeclared _ ar) = ar + +data Sort = Sort SSym [Sort] + deriving (Show, Eq, Ord) + +sBool :: Sort +sBool = Sort SSymBool [] + +sReal :: Sort +sReal = Sort SSymReal [] + +type FunType = ([Sort],Sort) + +data Expr + = EAp FSym [Expr] + | EFrac Rational + deriving (Show, Eq, Ord) + +instance MonotoneBoolean Expr where + true = EAp "true" [] + false = EAp "false" [] + andB = EAp "and" + orB = EAp "or" + +instance Complement Expr where + notB x = EAp "not" [x] + +instance IfThenElse Expr Expr where + ite x y z = EAp "ite" [x,y,z] + +instance Boolean Expr where + x .=>. y = EAp "=>" [x,y] + x .<=>. y = EAp "=" [x,y] + +instance Num Expr where + x + y = EAp "+" [x,y] + x - y = EAp "-" [x,y] + x * y = EAp "*" [x,y] + negate x = EAp "-" [x] + abs x = error "Num{ToySolver.SMT.Expr}.abs is not implemented" + signum x = error "Num{ToySolver.SMT.Expr}.signum is not implemented" + fromInteger x = EFrac (fromInteger x) + +instance Fractional Expr where + x / y = EAp "/" [x,y] + fromRational x = EFrac x + +instance IsEqRel Expr Expr where + a .==. b = EAp "=" [a,b] + a ./=. b = notB (a .==. b) + +instance IsOrdRel Expr Expr where + a .<. b = EAp "<" [a,b] + a .>. b = EAp ">" [a,b] + a .<=. b = EAp "<=" [a,b] + a .>=. b = EAp ">=" [a,b] + +data FDef + = FBoolVar SAT.Var + | FLRAVar LA.Var + | FEUFFun FunType EUF.FSym + deriving (Show) + +data Exception + = Error String + | Unsupported + deriving (Show, Typeable) + +instance E.Exception Exception + +data Solver + = Solver + { smtSAT :: !SAT.Solver + , smtEnc :: !Tseitin.Encoder + , smtEUF :: !EUF.Solver + , smtLRA :: !(Simplex2.GenericSolver (Delta Rational)) + + , smtEUFAtomDefs :: !(IORef (Map (EUF.Term, EUF.Term) SAT.Var, IntMap (EUF.Term, EUF.Term))) + , smtLRAAtomDefs :: !(IORef (Map (LA.Var, Rational) (SAT.Lit, SAT.Lit, SAT.Lit), IntMap (LA.Atom Rational))) + , smtBoolTermDefs :: !(IORef (Map EUF.Term SAT.Lit, IntMap EUF.Term)) + , smtRealTermDefs :: !(IORef (Map (LA.Expr Rational) EUF.FSym, IntMap (LA.Expr Rational))) + , smtEUFTrue :: !EUF.Term + , smtEUFFalse :: !EUF.Term + + , smtEUFModel :: !(IORef EUF.Model) + , smtLRAModel :: !(IORef Simplex2.Model) + + , smtGlobalDeclarationsRef :: !(IORef Bool) + , smtFDefs :: !(IORef (Map FSym FDef)) + , smtNamedAssertions :: !(IORef (Map String SAT.Lit)) + , smtAssertionStack :: !(Vec.Vec AssertionLevel) + + , smtUnsatAssumptions :: !(IORef [Expr]) + , smtUnsatCore :: !(IORef [String]) + } + +data AssertionLevel + = AssertionLevel + { alSavedNamedAssertions :: Map String SAT.Lit + , alSavedFDefs :: Maybe (Map FSym FDef) + , alSelector :: SAT.Lit + } + +newSolver :: IO Solver +newSolver = do + sat <- SAT.newSolver + enc <- Tseitin.newEncoder sat + euf <- EUF.newSolver + lra <- Simplex2.newSolver + + litTrue <- Tseitin.encodeConj enc [] + let litFalse = -litTrue + + eufTrue <- EUF.newConst euf + eufFalse <- EUF.newConst euf + EUF.assertNotEqual euf eufTrue eufFalse + divByZero <- EUF.newFSym euf + + eufAtomDefs <- newIORef (Map.empty, IntMap.empty) + lraAtomDefs <- newIORef (Map.empty, IntMap.empty) + boolTermDefs <- newIORef $ + ( Map.fromList [(eufTrue, litTrue), (eufFalse, litFalse)] + , IntMap.fromList [(litTrue, eufTrue), (litFalse, eufFalse)] + ) + realTermDefs <- newIORef (Map.empty, IntMap.empty) + + eufModelRef <- newIORef (undefined :: EUF.Model) + lraModelRef <- newIORef (undefined :: Simplex2.Model) + + globalDeclarationsRef <- newIORef False + fdefs <- newIORef $ Map.singleton "_/0" (FEUFFun ([sReal], sReal) divByZero) + + conflictTheory <- newIORef True + + let tsolver = + TheorySolver + { thAssertLit = \_ l -> do + (_, defsLRA) <- readIORef lraAtomDefs + (_, defsEUF) <- readIORef eufAtomDefs + case IntMap.lookup l defsLRA of + Just atom -> do + Simplex2.assertAtomEx' lra atom (Just l) + return True + Nothing -> + case IntMap.lookup (SAT.litVar l) defsEUF of + Just (t1,t2) -> do + if SAT.litPolarity l then do + EUF.assertEqual' euf t1 t2 (Just l) + return True + else do + EUF.assertNotEqual' euf t1 t2 (Just l) + return True + Nothing -> + return True + , thCheck = \callback -> do + b <- Simplex2.check lra + if b then do + b2 <- EUF.check euf + if b2 then do + (_, defsEUF) <- readIORef eufAtomDefs + liftM isRight $ runExceptT $ do + forM_ (IntMap.toList defsEUF) $ \(v, (t1, t2)) -> do + b3 <- lift $ EUF.areEqual euf t1 t2 + when b3 $ do + b4 <- lift $ callback v + unless b4 $ throwE () + else do + writeIORef conflictTheory False + return b2 + else do + writeIORef conflictTheory True + return False + , thExplain = \m -> do + case m of + Nothing -> do + b <- readIORef conflictTheory + if b then + liftM IntSet.toList $ Simplex2.explain lra + else + liftM IntSet.toList $ EUF.explain euf Nothing + Just v -> do + (_, defsEUF) <- readIORef eufAtomDefs + case IntMap.lookup v defsEUF of + Nothing -> error "should not happen" + Just (t1,t2) -> liftM IntSet.toList $ EUF.explain euf (Just (t1,t2)) + , thPushBacktrackPoint = do + Simplex2.pushBacktrackPoint lra + EUF.pushBacktrackPoint euf + , thPopBacktrackPoint = do + Simplex2.popBacktrackPoint lra + EUF.popBacktrackPoint euf + , thConstructModel = do + writeIORef eufModelRef =<< EUF.getModel euf + -- We need to call Simplex2.getModel here. + -- Because backtracking removes constraints that are necessary + -- for computing the value of delta. + writeIORef lraModelRef =<< Simplex2.getModel lra + return () + } + SAT.setTheory sat tsolver + + named <- newIORef Map.empty + + stack <- Vec.new + + unsatAssumptionsRef <- newIORef undefined + unsatCoreRef <- newIORef undefined + + return $ + Solver + { smtSAT = sat + , smtEnc = enc + , smtEUF = euf + , smtLRA = lra + + , smtEUFAtomDefs = eufAtomDefs + , smtLRAAtomDefs = lraAtomDefs + , smtBoolTermDefs = boolTermDefs + , smtRealTermDefs = realTermDefs + , smtEUFTrue = eufTrue + , smtEUFFalse = eufFalse + + , smtEUFModel = eufModelRef + , smtLRAModel = lraModelRef + + , smtGlobalDeclarationsRef = globalDeclarationsRef + , smtFDefs = fdefs + , smtNamedAssertions = named + , smtAssertionStack = stack + + , smtUnsatAssumptions = unsatAssumptionsRef + , smtUnsatCore = unsatCoreRef + } + +declareSSym :: Solver -> String -> Int -> IO SSym +declareSSym solver name arity = return (SSymUserDeclared name arity) + +declareSort :: VASortFun a => Solver -> String -> Int -> IO a +declareSort solver name arity = do + ssym <- declareSSym solver name arity + let f = withSortVArgs (Sort ssym) + unless (arityVASortFun f == arity) $ do + E.throwIO $ Error "ToySolver.SMT.declareSort: argument number error" + return f + +class VASortFun a where + withSortVArgs :: ([Sort] -> Sort) -> a + arityVASortFun :: a -> Int + +instance VASortFun Sort where + withSortVArgs k = k [] + arityVASortFun f = 0 + +instance VASortFun a => VASortFun (Sort -> a) where + withSortVArgs k x = withSortVArgs (\xs -> k (x : xs)) + arityVASortFun f = arityVASortFun (f undefined) + 1 + +declareFSym :: Solver -> String -> [Sort] -> Sort -> IO FSym +declareFSym solver f xs y = do + fdefs <- readIORef (smtFDefs solver) + when (f `Map.member` fdefs) $ do + E.throwIO $ Error $ "function symbol " ++ f ++ " is already used" + fdef <- + case (xs, y) of + ([], Sort SSymBool []) -> do + v <- SAT.newVar (smtSAT solver) + return (FBoolVar v) + ([], Sort SSymReal []) -> do + v <- Simplex2.newVar (smtLRA solver) + return (FLRAVar v) + _ -> do + v <- EUF.newFSym (smtEUF solver) + return (FEUFFun (xs,y) v) + writeIORef (smtFDefs solver) $ Map.insert f fdef fdefs + return f + +class VAFun a where + withVArgs :: ([Expr] -> Expr) -> a + arityVAFun :: a -> Int + +instance VAFun Expr where + withVArgs k = k [] + arityVAFun _ = 0 + +instance VAFun a => VAFun (Expr -> a) where + withVArgs k x = withVArgs (\xs -> k (x : xs)) + arityVAFun f = arityVAFun (f undefined) + 1 + +declareFun :: VAFun a => Solver -> String -> [Sort] -> Sort -> IO a +declareFun solver name ps r = do + fsym <- declareFSym solver name ps r + let f = withVArgs (EAp fsym) + unless (arityVAFun f == length ps) $ do + E.throwIO $ Error "ToySolver.SMT.declareFun: argument number error" + return f + +declareConst :: Solver -> String -> Sort -> IO Expr +declareConst solver name s = declareFun solver name [] s + +assert :: Solver -> Expr -> IO () +assert solver e = do + formula <- exprToFormula solver e + n <- Vec.getSize (smtAssertionStack solver) + if n>0 then do + assertionLevel <- Vec.peek (smtAssertionStack solver) + Tseitin.addFormula (smtEnc solver) $ Atom (alSelector assertionLevel) .=>. formula + else + Tseitin.addFormula (smtEnc solver) formula + +assertNamed :: Solver -> String -> Expr -> IO () +assertNamed solver name e = do + lit <- Tseitin.encodeFormula (smtEnc solver) =<< exprToFormula solver e + modifyIORef (smtNamedAssertions solver) (Map.insert name lit) + +getGlobalDeclarations :: Solver -> IO Bool +getGlobalDeclarations solver = readIORef (smtGlobalDeclarationsRef solver) + +setGlobalDeclarations :: Solver -> Bool -> IO () +setGlobalDeclarations solver = writeIORef (smtGlobalDeclarationsRef solver) + +exprSort :: Solver -> Expr -> IO Sort +exprSort solver e = do + fdefs <- readIORef (smtFDefs solver) + return $! exprSort' fdefs e + +exprSort' :: Map FSym FDef -> Expr -> Sort +exprSort' _fdefs (EFrac _) = Sort SSymReal [] +exprSort' fdefs (EAp f xs) + | f `Set.member` Set.fromList ["true","false","and","or","not","=>","=",">=","<=",">","<"] = Sort SSymBool [] + | f `Set.member` Set.fromList ["+", "-", "*", "/"] = Sort SSymReal [] + | f == "ite" = exprSort' fdefs (xs !! 1) + | otherwise = + case fdefs Map.! f of + FBoolVar _ -> Sort SSymBool [] + FLRAVar _ -> Sort SSymReal [] + FEUFFun (_,s) _ -> s + +-- ------------------------------------------------------------------- + +exprToFormula :: Solver -> Expr -> IO Tseitin.Formula +exprToFormula solver (EAp "true" []) = return true +exprToFormula solver (EAp "false" []) = return false +exprToFormula solver (EAp "and" xs) = + liftM andB $ mapM (exprToFormula solver) xs +exprToFormula solver (EAp "or" xs) = + liftM orB $ mapM (exprToFormula solver) xs +exprToFormula solver (EAp "not" [x]) = + liftM notB $ exprToFormula solver x +exprToFormula solver (EAp "not" _) = undefined +exprToFormula solver (EAp "=>" [e1,e2]) = do + b1 <- exprToFormula solver e1 + b2 <- exprToFormula solver e2 + return $ b1 .=>. b2 +exprToFormula solver (EAp "ite" [e1,e2,e3]) = do + b1 <- exprToFormula solver e1 + b2 <- exprToFormula solver e2 + b3 <- exprToFormula solver e3 + return $ ite b1 b2 b3 +exprToFormula solver (EAp "=" []) = return true -- ??? +exprToFormula solver (EAp "=" xs) = + chain solver (abstractEq solver) xs +exprToFormula solver (EAp "distinct" []) = return true -- ??? +exprToFormula solver (EAp "distinct" xs) = + pairwise solver (\e1 e2 -> liftM notB (abstractEq solver e1 e2)) xs +exprToFormula solver (EAp ">=" xs) = do + let f e1 e2 = do + e1' <- exprToLRAExpr solver e1 + e2' <- exprToLRAExpr solver e2 + liftM Atom $ abstractLRAAtom solver (e1' .>=. e2') + chain solver f xs +exprToFormula solver (EAp "<=" xs) = do + let f e1 e2 = do + e1' <- exprToLRAExpr solver e1 + e2' <- exprToLRAExpr solver e2 + liftM Atom $ abstractLRAAtom solver (e1' .<=. e2') + chain solver f xs +exprToFormula solver (EAp ">" xs) = do + let f e1 e2 = do + e1' <- exprToLRAExpr solver e1 + e2' <- exprToLRAExpr solver e2 + liftM Atom $ abstractLRAAtom solver (e1' .>. e2') + chain solver f xs +exprToFormula solver (EAp "<" xs) = do + let f e1 e2 = do + e1' <- exprToLRAExpr solver e1 + e2' <- exprToLRAExpr solver e2 + liftM Atom $ abstractLRAAtom solver (e1' .<. e2') + chain solver f xs +exprToFormula solver (EAp f []) = do + fdefs <- readIORef (smtFDefs solver) + case Map.lookup f fdefs of + Just (FBoolVar v) -> return (Atom v) + Just _ -> E.throwIO $ Error "non Bool constant appears in a boolean context" + Nothing -> E.throwIO $ Error $ "unknown function symbol: " ++ show f +exprToFormula solver (EAp f xs) = do + e' <- exprToEUFTerm solver f xs + formulaFromEUFTerm solver e' + +chain :: Solver -> (Expr -> Expr -> IO Tseitin.Formula) -> [Expr] -> IO Tseitin.Formula +chain _ _ [] = return true +chain solver p xs = liftM andB $ mapM (uncurry p) (zip xs (tail xs)) + +pairwise :: Solver -> (Expr -> Expr -> IO Tseitin.Formula) -> [Expr] -> IO Tseitin.Formula +pairwise _ _ [] = return true +pairwise solver p xs = liftM andB $ mapM (uncurry p) (pairs xs) + +abstractEq :: Solver -> Expr -> Expr -> IO Tseitin.Formula +abstractEq solver e1 e2 = do + s <- exprSort solver e1 + case s of + (Sort SSymBool _) -> do + b1 <- exprToFormula solver e1 + b2 <- exprToFormula solver e2 + return $ b1 .<=>. b2 + (Sort SSymReal _) -> do + e1' <- exprToLRAExpr solver e1 + e2' <- exprToLRAExpr solver e2 + liftM Atom $ abstractLRAAtom solver (e1' .==. e2') + (Sort (SSymUserDeclared _ _) _) -> do + e1' <- exprToEUFArg solver e1 + e2' <- exprToEUFArg solver e2 + liftM Atom $ abstractEUFAtom solver (e1',e2') + +-- ------------------------------------------------------------------- + +exprToLRAExpr :: Solver -> Expr -> IO (LA.Expr Rational) +exprToLRAExpr solver (EFrac r) = return (LA.constant r) +exprToLRAExpr solver (EAp "-" []) = E.throwIO $ Error "ToySolver.SMT: nullary '-' function" +exprToLRAExpr solver (EAp "-" [x]) = liftM negateV $ exprToLRAExpr solver x +exprToLRAExpr solver (EAp "-" (x:xs)) = do + x' <- exprToLRAExpr solver x + xs' <- mapM (exprToLRAExpr solver) xs + return $ foldl' (^-^) x' xs' +exprToLRAExpr solver (EAp "+" xs) = liftM sumV $ mapM (exprToLRAExpr solver) xs +exprToLRAExpr solver (EAp "*" xs) = liftM (foldr mult (LA.constant 1)) $ mapM (exprToLRAExpr solver) xs + where + mult e1 e2 + | Just c <- LA.asConst e1 = c *^ e2 + | Just c <- LA.asConst e2 = c *^ e1 + | otherwise = E.throw $ Error "non-linear multiplication is not supported" +exprToLRAExpr solver (EAp "/" [x,y]) = do + y' <- exprToLRAExpr solver y + case LA.asConst y' of + Nothing -> E.throwIO $ Error "division by non-constant is not supported" + Just 0 -> do + lraExprFromTerm solver =<< exprToEUFTerm solver "_/0" [x] + Just c -> do + x' <- exprToLRAExpr solver x + return $ (1/c) *^ x' +exprToLRAExpr solver (EAp "ite" [c,t,e]) = do + c' <- exprToFormula solver c + ret <- liftM LA.var $ Simplex2.newVar (smtLRA solver) + t' <- exprToLRAExpr solver t + e' <- exprToLRAExpr solver e + c1 <- abstractLRAAtom solver (ret .==. t') + c2 <- abstractLRAAtom solver (ret .==. e') + Tseitin.addFormula (smtEnc solver) $ ite c' (Atom c1) (Atom c2) + return ret +exprToLRAExpr solver (EAp f xs) = + lraExprFromTerm solver =<< exprToEUFTerm solver f xs + +abstractLRAAtom :: Solver -> LA.Atom Rational -> IO SAT.Lit +abstractLRAAtom solver atom = do + (v,op,rhs) <- Simplex2.simplifyAtom (smtLRA solver) atom + (tbl,defs) <- readIORef (smtLRAAtomDefs solver) + (vLt, vEq, vGt) <- + case Map.lookup (v,rhs) tbl of + Just (vLt, vEq, vGt) -> return (vLt, vEq, vGt) + Nothing -> do + vLt <- SAT.newVar (smtSAT solver) + vEq <- SAT.newVar (smtSAT solver) + vGt <- SAT.newVar (smtSAT solver) + SAT.addClause (smtSAT solver) [vLt,vEq,vGt] + SAT.addClause (smtSAT solver) [-vLt, -vEq] + SAT.addClause (smtSAT solver) [-vLt, -vGt] + SAT.addClause (smtSAT solver) [-vEq, -vGt] + let xs = IntMap.fromList + [ (vEq, LA.var v .==. LA.constant rhs) + , (vLt, LA.var v .<. LA.constant rhs) + , (vGt, LA.var v .>. LA.constant rhs) + , (-vLt, LA.var v .>=. LA.constant rhs) + , (-vGt, LA.var v .<=. LA.constant rhs) + ] + writeIORef (smtLRAAtomDefs solver) (Map.insert (v,rhs) (vLt, vEq, vGt) tbl, IntMap.union xs defs) + return (vLt, vEq, vGt) + case op of + Lt -> return vLt + Gt -> return vGt + Eql -> return vEq + Le -> return (-vGt) + Ge -> return (-vLt) + NEq -> return (-vEq) + + +lraExprToEUFTerm :: Solver -> LA.Expr Rational -> IO EUF.Term +lraExprToEUFTerm solver e = do + (realToFSym, fsymToReal) <- readIORef (smtRealTermDefs solver) + case Map.lookup e realToFSym of + Just c -> return (EUF.TApp c []) + Nothing -> do + c <- EUF.newFSym (smtEUF solver) + forM_ (IntMap.toList fsymToReal) $ \(d, d_lra) -> do + -- allocate interface equalities + b1 <- abstractEUFAtom solver (EUF.TApp c [], EUF.TApp d []) + b2 <- abstractLRAAtom solver (e .==. d_lra) + Tseitin.addFormula (smtEnc solver) (Atom b1 .<=>. Atom b2) + writeIORef (smtRealTermDefs solver) $ + ( Map.insert e c realToFSym + , IntMap.insert c e fsymToReal + ) + return (EUF.TApp c []) + +lraExprFromTerm :: Solver -> EUF.Term -> IO (LA.Expr Rational) +lraExprFromTerm solver t = do + (realToFSym, fsymToReal) <- readIORef (smtRealTermDefs solver) + c <- EUF.termToFSym (smtEUF solver) t + case IntMap.lookup c fsymToReal of + Just e -> return e + Nothing -> do + v <- Simplex2.newVar (smtLRA solver) + let e = LA.var v + forM_ (IntMap.toList fsymToReal) $ \(d, d_lra) -> do + -- allocate interface equalities + b1 <- abstractEUFAtom solver (EUF.TApp c [], EUF.TApp d []) + b2 <- abstractLRAAtom solver (e .==. d_lra) + Tseitin.addFormula (smtEnc solver) (Atom b1 .<=>. Atom b2) + writeIORef (smtRealTermDefs solver) $ + ( Map.insert e c realToFSym + , IntMap.insert c e fsymToReal + ) + return e + +-- ------------------------------------------------------------------- + +exprToEUFTerm :: Solver -> FSym -> [Expr] -> IO EUF.Term +exprToEUFTerm solver "ite" [c,t,e] = do + c' <- exprToFormula solver c + ret <- EUF.newConst (smtEUF solver) + t' <- exprToEUFArg solver t + e' <- exprToEUFArg solver e + c1 <- abstractEUFAtom solver (ret, t') + c2 <- abstractEUFAtom solver (ret, e') + Tseitin.addFormula (smtEnc solver) $ ite c' (Atom c1) (Atom c2) + return ret +exprToEUFTerm solver f xs = do + fdefs <- readIORef (smtFDefs solver) + case Map.lookup f fdefs of + Just (FBoolVar v) -> formulaToEUFTerm solver (Atom v) + Just (FLRAVar v) -> lraExprToEUFTerm solver (LA.var v) + Just (FEUFFun (ps,_) fsym) -> do + unless (length ps == length xs) $ do + E.throwIO $ Error "argument number error" + liftM (EUF.TApp fsym) $ mapM (exprToEUFArg solver) xs + _ -> E.throw $ Error $ "unknown function symbol: " ++ show f + +exprToEUFArg :: Solver -> Expr -> IO EUF.Term +exprToEUFArg solver (EFrac r) = lraExprToEUFTerm solver (LA.constant r) +exprToEUFArg solver e@(EAp f xs) = do + Sort s _ <- exprSort solver e + case s of + SSymBool -> formulaToEUFTerm solver =<< exprToFormula solver e + SSymReal -> lraExprToEUFTerm solver =<< exprToLRAExpr solver e + _ -> exprToEUFTerm solver f xs + +abstractEUFAtom :: Solver -> (EUF.Term, EUF.Term) -> IO SAT.Lit +abstractEUFAtom solver (t1,t2) | t1 > t2 = abstractEUFAtom solver (t2,t1) +abstractEUFAtom solver (t1,t2) = do + (tbl,defs) <- readIORef (smtEUFAtomDefs solver) + case Map.lookup (t1,t2) tbl of + Just v -> return v + Nothing -> do + v <- SAT.newVar (smtSAT solver) + writeIORef (smtEUFAtomDefs solver) (Map.insert (t1,t2) v tbl, IntMap.insert v (t1,t2) defs) + return v + +formulaToEUFTerm :: Solver -> Tseitin.Formula -> IO EUF.Term +formulaToEUFTerm solver formula = do + lit <- Tseitin.encodeFormula (smtEnc solver) formula + (_, boolToTerm) <- readIORef (smtBoolTermDefs solver) + case IntMap.lookup lit boolToTerm of + Just t -> return t + Nothing -> do + t <- EUF.newConst (smtEUF solver) + connectBoolTerm solver lit t + return t + +formulaFromEUFTerm :: Solver -> EUF.Term -> IO Tseitin.Formula +formulaFromEUFTerm solver t = do + (termToBool, _) <- readIORef (smtBoolTermDefs solver) + case Map.lookup t termToBool of + Just lit -> return (Atom lit) + Nothing -> do + lit <- SAT.newVar (smtSAT solver) + connectBoolTerm solver lit t + return $ Atom lit + +connectBoolTerm :: Solver -> SAT.Lit -> EUF.Term -> IO () +connectBoolTerm solver lit t = do + lit1 <- abstractEUFAtom solver (t, smtEUFTrue solver) + lit2 <- abstractEUFAtom solver (t, smtEUFFalse solver) + SAT.addClause (smtSAT solver) [-lit, lit1] -- lit -> lit1 + SAT.addClause (smtSAT solver) [-lit1, lit] -- lit1 -> lit + SAT.addClause (smtSAT solver) [lit, lit2] -- -lit -> lit2 + SAT.addClause (smtSAT solver) [-lit2, -lit] -- lit2 -> -lit + modifyIORef (smtBoolTermDefs solver) $ \(termToBool, boolToTerm) -> + ( Map.insert t lit termToBool + , IntMap.insert lit t boolToTerm + ) + +-- ------------------------------------------------------------------- + +checkSAT :: Solver -> IO Bool +checkSAT solver = checkSATAssuming solver [] + +checkSATAssuming :: Solver -> [Expr] -> IO Bool +checkSATAssuming solver xs = do + l <- getContextLit solver + named <- readIORef (smtNamedAssertions solver) + + ref <- newIORef IntMap.empty + ls <- forM xs $ \x -> do + b <- Tseitin.encodeFormula (smtEnc solver) =<< exprToFormula solver x + modifyIORef ref (IntMap.insert b x) + return b + + ret <- SAT.solveWith (smtSAT solver) (l : ls ++ Map.elems named) + if ret then do + writeIORef (smtUnsatAssumptions solver) undefined + writeIORef (smtUnsatCore solver) undefined + else do + m1 <- readIORef ref + let m2 = IntMap.fromList [(lit, name) | (name, lit) <- Map.toList named] + failed <- SAT.getFailedAssumptions (smtSAT solver) + writeIORef (smtUnsatAssumptions solver) $ catMaybes [IntMap.lookup l m1 | l <- failed] + writeIORef (smtUnsatCore solver) $ catMaybes [IntMap.lookup l m2 | l <- failed] + return ret + +getContextLit :: Solver -> IO SAT.Lit +getContextLit solver = do + n <- Vec.getSize (smtAssertionStack solver) + if n>0 then do + assertionLevel <- Vec.peek (smtAssertionStack solver) + return $ alSelector assertionLevel + else + Tseitin.encodeConj (smtEnc solver) [] -- true + +push :: Solver -> IO () +push solver = do + l1 <- getContextLit solver + l2 <- SAT.newVar (smtSAT solver) + SAT.addClause (smtSAT solver) [-l2, l1] -- l2 → l1 + globalDeclarations <- readIORef (smtGlobalDeclarationsRef solver) + named <- readIORef (smtNamedAssertions solver) + fdefs <- readIORef (smtFDefs solver) + let newLevel = + AssertionLevel + { alSavedNamedAssertions = named + , alSavedFDefs = if globalDeclarations then Nothing else Just fdefs + , alSelector = l2 + } + Vec.push (smtAssertionStack solver) newLevel + +pop :: Solver -> IO () +pop solver = do + n <- Vec.getSize (smtAssertionStack solver) + if n==0 then + E.throwIO $ Error $ "cannot pop first assertion level" + else do + assertionLevel <- Vec.unsafePop (smtAssertionStack solver) + SAT.addClause (smtSAT solver) [- alSelector assertionLevel] + writeIORef (smtNamedAssertions solver) (alSavedNamedAssertions assertionLevel) + case alSavedFDefs assertionLevel of + Nothing -> return () + Just fdefs -> writeIORef (smtFDefs solver) fdefs + return () + +-- ------------------------------------------------------------------- + +data Model + = Model + { mDefs :: !(Map FSym FDef) + , mBoolModel :: !SAT.Model + , mLRAModel :: !Simplex2.Model + , mEUFModel :: !EUF.Model + , mEUFTrue :: !EUF.Entity + , mEUFFalse :: !EUF.Entity + , mEntityToRational :: !(IntMap Rational) + , mRationalToEntity :: !(Map Rational EUF.Entity) + } + deriving (Show) + +data Value + = ValRational !Rational + | ValBool !Bool + | ValUninterpreted !Int !Sort + deriving (Eq, Show) + +getModel :: Solver -> IO Model +getModel solver = do + defs <- readIORef (smtFDefs solver) + boolModel <- SAT.getModel (smtSAT solver) + lraModel <- readIORef (smtLRAModel solver) + eufModel <- readIORef (smtEUFModel solver) + (_, fsymToReal) <- readIORef (smtRealTermDefs solver) + let xs = [(e, LA.evalExpr lraModel lraExpr) | (fsym, lraExpr) <- IntMap.toList fsymToReal, let e = EUF.evalAp eufModel fsym [], e /= EUF.mUnspecified eufModel] + return $ + Model + { mDefs = defs + , mBoolModel = boolModel + , mLRAModel = lraModel + , mEUFModel = eufModel + , mEUFTrue = EUF.eval eufModel (smtEUFTrue solver) + , mEUFFalse = EUF.eval eufModel (smtEUFFalse solver) + , mEntityToRational = IntMap.fromList xs + , mRationalToEntity = Map.fromList [(r,e) | (e,r) <- xs] + } + +eval :: Model -> Expr -> Value +eval m (EFrac r) = ValRational r +eval m (EAp "true" []) = ValBool True +eval m (EAp "false" []) = ValBool False +eval m (EAp "ite" [a,b,c]) = if valToBool m (eval m a) then eval m b else eval m c +eval m (EAp "and" xs) = ValBool $ and $ map (valToBool m . eval m) xs +eval m (EAp "or" xs) = ValBool $ or $ map (valToBool m . eval m) xs +eval m (EAp "not" [x]) = ValBool $ not $ valToBool m $ eval m x +eval m (EAp "=>" [x,y]) = ValBool $ valToBool m (eval m x) .=>. valToBool m (eval m y) +eval m (EAp "<=" [x,y]) = ValBool $ valToRational m (eval m x) <= valToRational m (eval m y) +eval m (EAp ">=" [x,y]) = ValBool $ valToRational m (eval m x) >= valToRational m (eval m y) +eval m (EAp ">" [x,y]) = ValBool $ valToRational m (eval m x) > valToRational m (eval m y) +eval m (EAp "<" [x,y]) = ValBool $ valToRational m (eval m x) < valToRational m (eval m y) +eval m (EAp "+" xs) = ValRational $ sum $ map (valToRational m . eval m) xs +eval m (EAp "-" [x]) = ValRational $ negate $ valToRational m (eval m x) +eval m (EAp "-" [x,y]) = ValRational $ valToRational m (eval m x) - valToRational m (eval m y) +eval m (EAp "*" xs) = ValRational $ product $ map (valToRational m . eval m) xs +eval m (EAp "/" [x,y]) + | y' == 0 = eval m (EAp "_/0" [x]) + | otherwise = ValRational $ valToRational m (eval m x) / y' + where + y' = valToRational m (eval m y) +eval m (EAp "=" [x,y]) = ValBool $ + case (eval m x, eval m y) of + (v1, v2) -> v1 == v2 +eval m expr@(EAp f xs) = + case Map.lookup f (mDefs m) of + Nothing -> E.throw $ Error $ "unknown function symbol: " ++ show f + Just (FBoolVar v) -> ValBool $ SAT.evalLit (mBoolModel m) v + Just (FLRAVar v) -> ValRational $ mLRAModel m IntMap.! v + Just (FEUFFun (_, Sort s []) sym) -> + let e = EUF.evalAp (mEUFModel m) sym (map (valToEntity m . eval m) xs) + in case s of + SSymUserDeclared _ _ -> ValUninterpreted e (exprSort' (mDefs m) expr) + SSymBool -> ValBool (e == mEUFTrue m) + SSymReal -> + case IntMap.lookup e (mEntityToRational m) of + Just r -> ValRational r + Nothing -> ValRational (fromIntegral (1000000 + e)) + +valToBool :: Model -> Value -> Bool +valToBool _ (ValBool b) = b +valToBool _ _ = E.throw $ Error "boolean value is expected" + +valToRational :: Model -> Value -> Rational +valToRational _ (ValRational r) = r +valToRational _ _ = E.throw $ Error "rational value is expected" + +valToEntity :: Model -> Value -> EUF.Entity +valToEntity _ (ValUninterpreted e _) = e +valToEntity m (ValBool b) = if b then mEUFTrue m else mEUFFalse m +valToEntity m (ValRational r) = + case Map.lookup r (mRationalToEntity m) of + Just e -> e + Nothing -> EUF.mUnspecified (mEUFModel m) + +entityToValue :: Model -> EUF.Entity -> Sort -> Value +entityToValue m e s = + case s of + Sort SSymBool _ -> ValBool (e == mEUFTrue m) + Sort SSymReal _ -> + case IntMap.lookup e (mEntityToRational m) of + Just r -> ValRational r + Nothing -> ValRational (fromIntegral (1000000 + e)) + Sort (SSymUserDeclared _ _) _ -> ValUninterpreted e s + +valSort :: Model -> Value -> Sort +valSort _m (ValUninterpreted _e s) = s +valSort _m (ValBool _b) = sBool +valSort _m (ValRational _r) = sReal + +data FunDef = FunDef [([Value], Value)] Value + +evalFSym :: Model -> FSym -> FunDef +evalFSym m f = + case Map.lookup f (mDefs m) of + Just (FEUFFun (argsSorts@(_:_), resultSort) sym) -> -- proper function symbol + let tbl = EUF.mFunctions (mEUFModel m) IntMap.! sym + defaultVal = + case resultSort of + Sort SSymReal [] -> ValRational 555555 -- Is it ok? + Sort SSymBool [] -> ValBool False -- Is it ok? + Sort (SSymUserDeclared _s _ar) _ss -> ValUninterpreted (EUF.mUnspecified (mEUFModel m)) resultSort + in FunDef [ (zipWith (entityToValue m) args argsSorts, entityToValue m result resultSort) + | (args, result) <- Map.toList tbl ] + defaultVal + Just _ -> FunDef [] $ eval m (EAp f []) -- constant symbol + Nothing -> E.throw $ Error $ "unknown function symbol: " ++ show f + +-- ------------------------------------------------------------------- + +getUnsatAssumptions :: Solver -> IO [Expr] +getUnsatAssumptions solver = do + readIORef (smtUnsatAssumptions solver) + +getUnsatCore :: Solver -> IO [String] +getUnsatCore solver = do + readIORef (smtUnsatCore solver) + +-- ------------------------------------------------------------------- + +pairs :: [a] -> [(a,a)] +pairs [] = [] +pairs (x:xs) = [(x,y) | y <- xs] ++ pairs xs + +#if !MIN_VERSION_base(4,7,0) + +isRight :: Either a b -> Bool +isRight (Left _) = False +isRight (Right _) = True + +#endif diff --git a/src/ToySolver/Text/SDPFile.hs b/src/ToySolver/Text/SDPFile.hs --- a/src/ToySolver/Text/SDPFile.hs +++ b/src/ToySolver/Text/SDPFile.hs @@ -44,6 +44,7 @@ , parseSparseDataFile ) where +import Control.Applicative ((<*)) import Control.Monad import Data.List (intersperse) import Data.Ratio @@ -103,19 +104,19 @@ -- | Parse a SDPA format (.dat) string. parseDataString :: SourceName -> String -> Either ParseError Problem -parseDataString = parse pDataFile +parseDataString = parse (pDataFile <* eof) -- | Parse a SDPA format file (.dat). parseDataFile :: FilePath -> IO (Either ParseError Problem) -parseDataFile = parseFromFile pDataFile +parseDataFile = parseFromFile (pDataFile <* eof) -- | Parse a SDPA sparse format (.dat-s) string. parseSparseDataString :: SourceName -> String -> Either ParseError Problem -parseSparseDataString = parse pSparseDataFile +parseSparseDataString = parse (pSparseDataFile <* eof) -- | Parse a SDPA sparse format file (.dat-s). parseSparseDataFile :: FilePath -> IO (Either ParseError Problem) -parseSparseDataFile = parseFromFile pSparseDataFile +parseSparseDataFile = parseFromFile (pSparseDataFile <* eof) pDataFile :: Parser Problem pDataFile = do @@ -125,6 +126,7 @@ bs <- pBlockStruct -- bLOCKsTRUCT cs <- pCosts ms <- pDenseMatrices (fromIntegral m) bs + spaces return $ Problem { blockStruct = bs @@ -140,6 +142,7 @@ bs <- pBlockStruct -- bLOCKsTRUCT cs <- pCosts ms <- pSparseMatrices (fromIntegral m) bs + spaces return $ Problem { blockStruct = bs diff --git a/src/ToySolver/Version.hs b/src/ToySolver/Version.hs --- a/src/ToySolver/Version.hs +++ b/src/ToySolver/Version.hs @@ -1,11 +1,15 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP, TemplateHaskell #-} module ToySolver.Version ( version , packageVersions + , gitHash + , compilationTime ) where import Data.List +import Data.Time import Data.Version +import ToySolver.Version.TH import Paths_toysolver packageVersions :: [(String, String)] @@ -68,8 +72,11 @@ #ifdef VERSION_multiset , ("multiset", VERSION_multiset ) #endif +#ifdef VERSION_mwc_random + , ("mwc-random", VERSION_mwc_random ) +#endif #ifdef VERSION_old_locale - , ("old_locale", VERSION_old_locale ) + , ("old-locale", VERSION_old_locale ) #endif #ifdef VERSION_parse_dimacs , ("parse_dimacs", VERSION_parse_dimacs ) @@ -92,8 +99,8 @@ #ifdef VERSION_queue , ("queue", VERSION_queue ) #endif -#ifdef VERSION_random - , ("random", VERSION_random ) +#ifdef VERSION_semigroups + , ("semigroups", VERSION_semigroups ) #endif #ifdef VERSION_sign , ("sign", VERSION_sign ) @@ -101,8 +108,14 @@ #ifdef VERSION_stm , ("stm", VERSION_stm ) #endif +#ifdef VERSION_transformers + , ("transformers", VERSION_transformers ) +#endif +#ifdef VERSION_transformers_compat + , ("transformers-compat", VERSION_transformers_compat) +#endif #ifdef VERSION_temporary - , ("temporary", VERSION_time ) + , ("temporary", VERSION_temporary ) #endif #ifdef VERSION_time , ("time", VERSION_time ) @@ -116,6 +129,9 @@ #ifdef VERSION_unordered_containers , ("unordered-containers", VERSION_unordered_containers) #endif +#ifdef VERSION_vector + , ("vector", VERSION_vector) +#endif #ifdef VERSION_vector_space , ("vector-space", VERSION_vector_space) #endif @@ -123,3 +139,9 @@ , ("logic-TPTP", VERSION_logic_TPTP ) #endif ] + +gitHash :: Maybe String +gitHash = $(gitHashQ) + +compilationTime :: UTCTime +compilationTime = $(compilationTimeQ) diff --git a/src/ToySolver/Version/TH.hs b/src/ToySolver/Version/TH.hs new file mode 100644 --- /dev/null +++ b/src/ToySolver/Version/TH.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE ScopedTypeVariables, TemplateHaskell #-} +{-# OPTIONS_GHC -Wall #-} +module ToySolver.Version.TH + ( gitHashQ + , compilationTimeQ + ) where + +import Control.Exception +import Control.Monad +import Data.Time +import System.Process +import Language.Haskell.TH + +getGitHash :: IO (Maybe String) +getGitHash = + liftM (Just . takeWhile (/='\n')) (readProcess "git" ["rev-parse", "--short", "HEAD"] "") + `catch` \(_::SomeException) -> return Nothing + +gitHashQ :: ExpQ +gitHashQ = do + m <- runIO getGitHash + case m of + Nothing -> [| Nothing |] + Just s -> [| Just |] `appE` litE (stringL s) + +compilationTimeQ :: ExpQ +compilationTimeQ = do + tm <- runIO getCurrentTime + [| read $(litE (stringL (show tm))) :: UTCTime |] diff --git a/src/ToySolver/Wang.hs b/src/ToySolver/Wang.hs --- a/src/ToySolver/Wang.hs +++ b/src/ToySolver/Wang.hs @@ -8,8 +8,6 @@ import Control.Monad (guard,msum) import Data.List (intersect) import Data.Maybe (isJust, listToMaybe) - -import ToySolver.Data.Boolean import ToySolver.Data.BoolExpr type Formula a = BoolExpr a diff --git a/test/Test/AReal.hs b/test/Test/AReal.hs new file mode 100644 --- /dev/null +++ b/test/Test/AReal.hs @@ -0,0 +1,292 @@ +{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-} +module Test.AReal (arealTestGroup) where + +import Data.Maybe +import Data.Ratio +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.Tasty.HUnit +import Test.Tasty.TH + +import ToySolver.Data.Polynomial (UPolynomial, X (..)) +import qualified ToySolver.Data.Polynomial as P +import qualified ToySolver.Data.AlgebraicNumber.Sturm as Sturm +import ToySolver.Data.AlgebraicNumber.Real +import ToySolver.Data.AlgebraicNumber.Root + +import Data.Interval (Interval, Extended (..), (<=..<=), (<..<=), (<=..<), (<..<)) +import qualified Data.Interval as Interval + +import Control.Monad +import Control.Exception +import System.IO + +{-------------------------------------------------------------------- + sample values +--------------------------------------------------------------------} + +-- ±√2 +sqrt2 :: AReal +[neg_sqrt2, sqrt2] = realRoots (x^2 - 2) + where + x = P.var X + +-- ±√3 +sqrt3 :: AReal +[neg_sqrt3, sqrt3] = realRoots (x^2 - 3) + where + x = P.var X + +{-------------------------------------------------------------------- + root manipulation +--------------------------------------------------------------------} + +case_rootAdd_sqrt2_sqrt3 = assertBool "" $ abs valP <= 0.0001 + where + x = P.var X + + p :: UPolynomial Rational + p = rootAdd (x^2 - 2) (x^2 - 3) + + valP :: Double + valP = P.eval (\X -> sqrt 2 + sqrt 3) $ P.mapCoeff fromRational p + +-- bug? +sample_rootAdd = p + where + x = P.var X + p :: UPolynomial Rational + p = rootAdd (x^2 - 2) (x^6 + 6*x^3 - 2*x^2 + 9) + +case_rootSub_sqrt2_sqrt3 = assertBool "" $ abs valP <= 0.0001 + where + x = P.var X + + p :: UPolynomial Rational + p = rootAdd (x^2 - 2) (rootScale (-1) (x^2 - 3)) + + valP :: Double + valP = P.eval (\X -> sqrt 2 - sqrt 3) $ P.mapCoeff fromRational p + +case_rootMul_sqrt2_sqrt3 = assertBool "" $ abs valP <= 0.0001 + where + x = P.var X + + p :: UPolynomial Rational + p = rootMul (x^2 - 2) (x^2 - 3) + + valP :: Double + valP = P.eval (\X -> sqrt 2 * sqrt 3) $ P.mapCoeff fromRational p + +case_rootNegate_test1 = assertBool "" $ abs valP <= 0.0001 + where + x = P.var X + + p :: UPolynomial Rational + p = rootScale (-1) (x^3 - 3) + + valP :: Double + valP = P.eval (\X -> - (3 ** (1/3))) $ P.mapCoeff fromRational p + +case_rootNegate_test2 = rootScale (-1) p @?= normalizePoly q + where + x :: UPolynomial Rational + x = P.var X + p = x^3 - 3 + q = x^3 + 3 + +case_rootNegate_test3 = rootScale (-1) p @?= normalizePoly q + where + x :: UPolynomial Rational + x = P.var X + p = (x-2)*(x-3)*(x-4) + q = (x+2)*(x+3)*(x+4) + +case_rootScale = rootScale 2 p @?= normalizePoly q + where + x :: UPolynomial Rational + x = P.var X + p = (x-2)*(x-3)*(x-4) + q = (x-4)*(x-6)*(x-8) + +case_rootScale_zero = rootScale 0 p @?= normalizePoly q + where + x :: UPolynomial Rational + x = P.var X + p = (x-2)*(x-3)*(x-4) + q = x + +case_rootRecip = assertBool "" $ abs valP <= 0.0001 + where + x = P.var X + + p :: UPolynomial Rational + p = rootRecip (x^3 - 3) + + valP :: Double + valP = P.eval (\X -> 1 / (3 ** (1/3))) $ P.mapCoeff fromRational p + +{-------------------------------------------------------------------- + algebraic reals +--------------------------------------------------------------------} + +case_realRoots_zero = realRoots (0 :: UPolynomial Rational) @?= [] + +case_realRoots_nonminimal = + realRoots ((x^2 - 1) * (x - 3)) @?= [-1,1,3] + where + x = P.var X + +case_realRoots_minus_one = realRoots (x^2 + 1) @?= [] + where + x = P.var X + +case_realRoots_two = length (realRoots (x^2 - 2)) @?= 2 + where + x = P.var X + +case_realRoots_multipleRoots = length (realRoots (x^2 + 2*x + 1)) @?= 1 + where + x = P.var X + +case_eq = sqrt2*sqrt2 - 2 @?= 0 + +case_eq_refl = assertBool "" $ sqrt2 == sqrt2 + +case_diseq_1 = assertBool "" $ sqrt2 /= sqrt3 + +case_diseq_2 = assertBool "" $ sqrt2 /= neg_sqrt2 + +case_cmp_1 = assertBool "" $ 0 < sqrt2 + +case_cmp_2 = assertBool "" $ neg_sqrt2 < 0 + +case_cmp_3 = assertBool "" $ 0 < neg_sqrt2 * neg_sqrt2 + +case_cmp_4 = assertBool "" $ neg_sqrt2 * neg_sqrt2 * neg_sqrt2 < 0 + +case_floor_sqrt2 = floor sqrt2 @?= 1 + +case_floor_neg_sqrt2 = floor neg_sqrt2 @?= -2 + +case_floor_1 = floor 1 @?= 1 + +case_floor_neg_1 = floor (-1) @?= -1 + +case_ceiling_sqrt2 = ceiling sqrt2 @?= 2 + +case_ceiling_neg_sqrt2 = ceiling neg_sqrt2 @?= -1 + +case_ceiling_1 = ceiling 1 @?= 1 + +case_ceiling_neg_1 = ceiling (-1) @?= -1 + +case_round_sqrt2 = round sqrt2 @?= 1 + +case_toRational = toRational r @?= 3/2 + where + x = P.var X + [r] = realRoots (2*x - 3) + +case_toRational_error = do + r <- try $ evaluate $ toRational sqrt2 + case r of + Left (e :: SomeException) -> return () + Right _ -> assertFailure "shuold be error" + +-- 期待値は Wolfram Alpha で x^3 - Sqrt[2]*x + 3 を調べて Real root の exact form で得た +case_simpARealPoly = simpARealPoly p @?= q + where + x :: forall k. (Num k, Eq k) => UPolynomial k + x = P.var X + p = x^3 - P.constant sqrt2 * x + 3 + q = x^6 + 6*x^3 - 2*x^2 + 9 + +case_deg_sqrt2 = P.deg sqrt2 @?= 2 + +case_deg_neg_sqrt2 = P.deg neg_sqrt2 @?= 2 + +case_deg_sqrt2_minus_sqrt2 = P.deg (sqrt2 - sqrt2) @?= 1 + +case_deg_sqrt2_times_sqrt2 = P.deg (sqrt2 * sqrt2) @?= 1 + +case_isAlgebraicInteger_sqrt2 = isAlgebraicInteger sqrt2 @?= True + +case_isAlgebraicInteger_neg_sqrt2 = isAlgebraicInteger neg_sqrt2 @?= True + +case_isAlgebraicInteger_one_half = isAlgebraicInteger (1/2) @?= False + +case_isAlgebraicInteger_one_sqrt2 = isAlgebraicInteger (1 / sqrt2) @?= False + +case_height_sqrt2 = height sqrt2 @?= 2 + +case_height_10 = height 10 @?= 10 + +prop_approx_sqrt2 = + forAll epsilons $ \epsilon -> + abs (sqrt2 - fromRational (approx sqrt2 epsilon)) <= fromRational epsilon + +prop_approxInterval_sqrt2 = + forAll epsilons $ \epsilon -> + Interval.width (approxInterval sqrt2 epsilon) <= epsilon + +epsilons :: Gen Rational +epsilons = do + r <- liftM abs $ arbitrary `suchThat` (0/=) + if r > 0 + then return (1/r) + else return r + +------------------------------------------------------------------------ + +-- http://mathworld.wolfram.com/SturmFunction.html +case_sturmChain = Sturm.sturmChain p0 @?= chain + where + x = P.var X + p0 = x^5 - 3*x - 1 + p1 = 5*x^4 - 3 + p2 = P.constant (1/5) * (12*x + 5) + p3 = P.constant (59083 / 20736) + chain = [p0, p1, p2, p3] + +-- http://mathworld.wolfram.com/SturmFunction.html +case_numRoots_1 = + sequence_ + [ Sturm.numRoots p (Finite (-2) <=..<= Finite 0) @?= 2 + , Sturm.numRoots p (Finite 0 <=..<= Finite 2) @?= 1 + , Sturm.numRoots p (Finite (-1.5) <=..<= Finite (-1.0)) @?= 1 + , Sturm.numRoots p (Finite (-0.5) <=..<= Finite 0) @?= 1 + , Sturm.numRoots p (Finite 1 <=..<= Finite (1.5)) @?= 1 + ] + where + x = P.var X + p = x^5 - 3*x - 1 + +-- check interpretation of intervals +case_numRoots_2 = + sequence_ + [ Sturm.numRoots p (Finite 2 <..<= Finite 3) @?= 0 + , Sturm.numRoots p (Finite 2 <=..<= Finite 3) @?= 1 + , Sturm.numRoots p (Finite 1 <..< Finite 2) @?= 0 + , Sturm.numRoots p (Finite 1 <..<= Finite 2) @?= 1 + ] + where + x = P.var X + p = x^2 - 4 + +case_separate = do + forM_ (zip vals intervals) $ \(v,ival) -> do + Interval.member v ival @?= True + forM_ (filter (v/=) vals) $ \v2 -> do + Interval.member v2 ival @?= False + where + x = P.var X + p = x^5 - 3*x - 1 + intervals = Sturm.separate p + vals = [-1.21465, -0.334734, 1.38879] + +------------------------------------------------------------------------ +-- Test harness + +arealTestGroup :: TestTree +arealTestGroup = $(testGroupGenerator) diff --git a/test/Test/AReal2.hs b/test/Test/AReal2.hs new file mode 100644 --- /dev/null +++ b/test/Test/AReal2.hs @@ -0,0 +1,87 @@ +{-# LANGUAGE TemplateHaskell #-} +module Test.AReal2 (areal2TestGroup) where + +import Data.Maybe +import Data.Ratio +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.Tasty.HUnit +import Test.Tasty.TH + +import ToySolver.Data.Polynomial (UPolynomial, X (..)) +import qualified ToySolver.Data.Polynomial as P +import ToySolver.Data.AlgebraicNumber.Real + +import Control.Monad +import System.IO + +{-------------------------------------------------------------------- + Num +--------------------------------------------------------------------} + +prop_add_comm = + forAll areals $ \a -> + forAll areals $ \b -> + a + b == b + a + +prop_add_assoc = + forAll areals $ \a -> + forAll areals $ \b -> + forAll areals $ \c -> + a + (b + c) == (a + b) + c + +prop_add_unitL = + forAll areals $ \a -> + 0 + a == a + +prop_add_unitR = + forAll areals $ \a -> + a + 0 == a + +prop_mult_comm = + forAll areals $ \a -> + forAll areals $ \b -> + a * b == b * a + +prop_mult_assoc = + forAll areals $ \a -> + forAll areals $ \b -> + forAll areals $ \c -> + a * (b * c) == (a * b) * c + +prop_mult_unitL = + forAll areals $ \a -> + 1 * a == a + +prop_mult_unitR = + forAll areals $ \a -> + a * 1 == a + +prop_mult_dist = + forAll areals $ \a -> + forAll areals $ \b -> + forAll areals $ \c -> + a * (b + c) == a * b + a * c + +prop_mult_zero = + forAll areals $ \a -> + 0 * a == 0 + +{-------------------------------------------------------------------- + Generators +--------------------------------------------------------------------} + +areals :: Gen AReal +areals = oneof $ map return $ samples + +samples :: [AReal] +samples = [0, 1, -1, 2, -2] ++ concatMap realRoots ps + where + x = P.var X + ps = [x^2 - 2, x^2 - 3 {- , x^3 - 2, x^6 + 6*x^3 - 2*x^2 + 9 -}] + +------------------------------------------------------------------------ +-- Test harness + +areal2TestGroup :: TestTree +areal2TestGroup = $(testGroupGenerator) diff --git a/test/Test/Arith.hs b/test/Test/Arith.hs new file mode 100644 --- /dev/null +++ b/test/Test/Arith.hs @@ -0,0 +1,501 @@ +{-# LANGUAGE TemplateHaskell #-} +module Test.Arith (arithTestGroup) where + +import Control.Monad +import Data.List +import Data.Default.Class +import qualified Data.IntMap as IM +import qualified Data.IntSet as IS +import qualified Data.Map as Map +import qualified Data.Set as Set +import Data.Maybe +import Data.VectorSpace + +import Test.Tasty +import Test.Tasty.QuickCheck hiding ((.&&.), (.||.)) +import Test.Tasty.HUnit +import Test.Tasty.TH +import qualified Test.QuickCheck as QC +import qualified Test.QuickCheck.Monadic as QM + +import qualified Data.Interval as Interval +import Data.OptDir + +import ToySolver.Data.AlgebraicNumber.Real +import ToySolver.Data.OrdRel +import ToySolver.Data.FOL.Arith +import qualified ToySolver.Data.LA as LA +import qualified ToySolver.Data.Polynomial as P +import ToySolver.Data.Var + +import qualified ToySolver.Arith.FourierMotzkin as FourierMotzkin +import qualified ToySolver.Arith.FourierMotzkin.Optimization as FMOpt +import qualified ToySolver.Arith.OmegaTest as OmegaTest +import qualified ToySolver.Arith.OmegaTest.Base as OmegaTest +import qualified ToySolver.Arith.Cooper as Cooper +import qualified ToySolver.Arith.CAD as CAD +import qualified ToySolver.Arith.Simplex2 as Simplex2 +import qualified ToySolver.Arith.ContiTraverso as ContiTraverso +import qualified ToySolver.Arith.VirtualSubstitution as VirtualSubstitution + +------------------------------------------------------------------------ + +{- +Example from the OmegaTest paper + +7x + 12y + 31z = 17 +3x + 5y + 14z = 7 +1 ≤ x ≤ 40 +-50 ≤ y ≤ 50 + +satisfiable in R +satisfiable in Z + +(declare-fun x () Int) +(declare-fun y () Int) +(declare-fun z () Int) +(assert (= (+ (* 7 x) (* 12 y) (* 31 z)) 17)) +(assert (= (+ (* 3 x) (* 5 y) (* 14 z)) 7)) +(assert (<= 1 x)) +(assert (<= x 40)) +(assert (<= (- 50) y)) +(assert (<= y 50)) +(check-sat) ; => sat +(get-model) + +Just (DNF {unDNF = [[Nonneg (fromTerms [(-17,-1),(7,0),(12,1),(31,2)]),Nonneg (fromTerms [(17,-1),(-7,0),(-12,1),(-31,2)]),Nonneg (fromTerms [(-7,-1),(3,0),(5,1),(14,2)]),Nonneg (fromTerms [(7,-1),(-3,0),(-5,1),(-14,2)]),Nonneg (fromTerms [(-1,-1),(1,0)]),Nonneg (fromTerms [(40,-1),(-1,0)]),Nonneg (fromTerms [(50,-1),(1,1)]),Nonneg (fromTerms [(50,-1),(-1,1)])]]}) + +7x+12y+31z - 17 >= 0 +-7x-12y-31z + 17 >= 0 +3x+5y+14z - 7 >= 0 +-3x-5y-14z + 7 >= 0 +x - 1 >= 0 +-x + 40 >= 0 +y + 50 >= 0 +-y + 50 >= 0 +-} +test1 :: Formula (Atom Rational) +test1 = c1 .&&. c2 .&&. c3 .&&. c4 + where + x = Var 0 + y = Var 1 + z = Var 2 + c1 = 7*x + 12*y + 31*z .==. 17 + c2 = 3*x + 5*y + 14*z .==. 7 + c3 = 1 .<=. x .&&. x .<=. 40 + c4 = (-50) .<=. y .&&. y .<=. 50 + +test1' :: (VarSet, [LA.Atom Rational]) +test1' = (IS.fromList [0,1,2], [c1, c2] ++ c3 ++ c4) + where + x = LA.var 0 + y = LA.var 1 + z = LA.var 2 + c1 = 7*^x ^+^ 12*^y ^+^ 31*^z .==. LA.constant 17 + c2 = 3*^x ^+^ 5*^y ^+^ 14*^z .==. LA.constant 7 + c3 = [LA.constant 1 .<=. x, x .<=. LA.constant 40] + c4 = [LA.constant (-50) .<=. y, y .<=. LA.constant 50] + + +{- +Example from the OmegaTest paper + +27 ≤ 11x+13y ≤ 45 +-10 ≤ 7x-9y ≤ 4 + +satisfiable in R +but unsatisfiable in Z + +(declare-fun x () Int) +(declare-fun y () Int) +(define-fun t1 () Int (+ (* 11 x) (* 13 y))) +(define-fun t2 () Int (- (* 7 x) (* 9 y))) +(assert (<= 27 t1)) +(assert (<= t1 45)) +(assert (<= (- 10) t2)) +(assert (<= t2 4)) +(check-sat) ; unsat +(get-model) +-} +test2 :: Formula (Atom Rational) +test2 = c1 .&&. c2 + where + x = Var 0 + y = Var 1 + t1 = 11*x + 13*y + t2 = 7*x - 9*y + c1 = 27 .<=. t1 .&&. t1 .<=. 45 + c2 = (-10) .<=. t2 .&&. t2 .<=. 4 + +test2' :: (VarSet, [LA.Atom Rational]) +test2' = + ( IS.fromList [0,1] + , [ LA.constant 27 .<=. t1 + , t1 .<=. LA.constant 45 + , LA.constant (-10) .<=. t2 + , t2 .<=. LA.constant 4 + ] + ) + where + x = LA.var 0 + y = LA.var 1 + t1 = 11*^x ^+^ 13*^y + t2 = 7*^x ^-^ 9*^y + + +genLAExpr :: [Var] -> Gen (LA.Expr Rational) +genLAExpr vs = do + size <- choose (0,3) + liftM LA.fromTerms $ replicateM size $ do + x <- elements (LA.unitVar : vs) + c <- arbitrary + return (c,x) + +genLAExprSmallInt :: [Var] -> Gen (LA.Expr Rational) +genLAExprSmallInt vs = do + size <- choose (0,3) + liftM LA.fromTerms $ replicateM size $ do + x <- elements (LA.unitVar : vs) + c <- choose (-10,10) + return (fromInteger c,x) + +genQFLAConj :: Gen (VarSet, [LA.Atom Rational]) +genQFLAConj = do + nv <- choose (0, 5) + nc <- choose (0, 5) + let vs = IS.fromList [1..nv] + cs <- replicateM nc $ do + op <- elements [Lt, Le, Ge, Gt, Eql] -- , NEq + lhs <- genLAExpr [1..nv] + rhs <- genLAExpr [1..nv] + return $ ordRel op lhs rhs + return (vs, cs) + +genQFLAConjSmallInt :: Gen (VarSet, [LA.Atom Rational]) +genQFLAConjSmallInt = do + nv <- choose (0, 3) + nc <- choose (0, 3) + let vs = IS.fromList [1..nv] + cs <- replicateM nc $ do + op <- elements [Lt, Le, Ge, Gt, Eql] -- , NEq + lhs <- genLAExprSmallInt [1..nv] + rhs <- genLAExprSmallInt [1..nv] + return $ ordRel op lhs rhs + return (vs, cs) + +genModel :: Arbitrary a => VarSet -> Gen (Model a) +genModel xs = do + liftM IM.fromList $ forM (IS.toList xs) $ \x -> do + val <- arbitrary + return (x,val) + +------------------------------------------------------------------------ + +prop_FourierMotzkin_solve :: Property +prop_FourierMotzkin_solve = + forAll genQFLAConj $ \(vs,cs) -> + case FourierMotzkin.solve vs cs of + Nothing -> forAll (genModel vs) $ \m -> all (LA.evalAtom m) cs == False + Just m -> property $ all (LA.evalAtom m) cs + +case_FourierMotzkin_test1 :: Assertion +case_FourierMotzkin_test1 = + case uncurry FourierMotzkin.solve test1' of + Nothing -> assertFailure "expected: Just\n but got: Nothing" + Just m -> + forM_ (snd test1') $ \a -> do + LA.evalAtom m a @?= True + +case_FourierMotzkin_test2 :: Assertion +case_FourierMotzkin_test2 = + case uncurry FourierMotzkin.solve test2' of + Nothing -> assertFailure "expected: Just\n but got: Nothing" + Just m -> + forM_ (snd test2') $ \a -> do + LA.evalAtom m a @?= True + +{- +Maximize + obj: x1 + 2 x2 + 3 x3 + x4 +Subject To + c1: - x1 + x2 + x3 + 10 x4 <= 20 + c2: x1 - 3 x2 + x3 <= 30 + c3: x2 - 3.5 x4 = 0 +Bounds + 0 <= x1 <= 40 + 2 <= x4 <= 3 +End +-} +case_FourierMotzkinOptimization_test1 :: Assertion +case_FourierMotzkinOptimization_test1 = do + Interval.upperBound' i @?= (3005/24, True) + and [LA.evalAtom m c | c <- cs] @?= True + where + (i, f) = FMOpt.optimize (IS.fromList vs) OptMax obj cs + m = f (3005/24) + + vs@[x1,x2,x3,x4] = [1..4] + obj = LA.fromTerms [(1,x1), (2,x2), (3,x3), (1,x4)] + cs = [ LA.fromTerms [(-1,x1), (1,x2), (1,x3), (10,x4)] .<=. LA.constant 20 + , LA.fromTerms [(1,x1), (-3,x2), (1,x3)] .<=. LA.constant 30 + , LA.fromTerms [(1,x2), (-3.5,x4)] .==. LA.constant 0 + , LA.fromTerms [(1,x1)] .>=. LA.constant 0 + , LA.fromTerms [(1,x1)] .<=. LA.constant 40 + , LA.fromTerms [(1,x2)] .>=. LA.constant 0 + , LA.fromTerms [(1,x3)] .>=. LA.constant 0 + , LA.fromTerms [(1,x4)] .>=. LA.constant 2 + , LA.fromTerms [(1,x4)] .<=. LA.constant 3 + ] + +------------------------------------------------------------------------ + +prop_VirtualSubstitution_solve :: Property +prop_VirtualSubstitution_solve = + forAll genQFLAConj $ \(vs,cs) -> + case VirtualSubstitution.solve vs cs of + Nothing -> forAll (genModel vs) $ \m -> all (LA.evalAtom m) cs == False + Just m -> property $ all (LA.evalAtom m) cs + +case_VirtualSubstitution_test1 :: Assertion +case_VirtualSubstitution_test1 = + case uncurry VirtualSubstitution.solve test1' of + Nothing -> assertFailure "expected: Just\n but got: Nothing" + Just m -> + forM_ (snd test1') $ \a -> do + LA.evalAtom m a @?= True + +case_VirtualSubstitution_test2 :: Assertion +case_VirtualSubstitution_test2 = + case uncurry VirtualSubstitution.solve test2' of + Nothing -> assertFailure "expected: Just\n but got: Nothing" + Just m -> + forM_ (snd test2') $ \a -> do + LA.evalAtom m a @?= True + +------------------------------------------------------------------------ + +-- too slow +disabled_prop_CAD_solve :: Property +disabled_prop_CAD_solve = + forAll genQFLAConj $ \(vs,cs) -> + let vs' = Set.fromAscList $ IS.toAscList vs + cs' = map toPRel cs + in case CAD.solve vs' cs' of + Nothing -> + forAll (genModel vs) $ \m -> + let m' = Map.fromAscList [(x, fromRational v) | (x,v) <- IM.toAscList m] + in all (evalPAtom m') cs' == False + Just m -> property $ all (evalPAtom m) cs' + +case_CAD_test1 :: Assertion +case_CAD_test1 = + case CAD.solve vs cs of + Nothing -> assertFailure "expected: Just\n but got: Nothing" + Just m -> + forM_ cs $ \a -> do + evalPAtom m a @?= True + where + vs = Set.fromAscList $ IS.toAscList $ fst test1' + cs = map toPRel $ snd test1' + +case_CAD_test2 :: Assertion +case_CAD_test2 = + case CAD.solve vs cs of + Nothing -> assertFailure "expected: Just\n but got: Nothing" + Just m -> + forM_ cs $ \a -> do + evalPAtom m a @?= True + where + vs = Set.fromAscList $ IS.toAscList $ fst test2' + cs = map toPRel $ snd test2' + +case_CAD_test_nonlinear_multivariate :: Assertion +case_CAD_test_nonlinear_multivariate = + case CAD.solve vs cs of + Nothing -> assertFailure "expected: Just\n but got: Nothing" + Just m -> + forM_ cs $ \a -> do + evalPAtom m a @?= True + where + vs = Set.fromList [0,1] + cs = [x^2 - y^2 - 2 .==. 0, 2*y*x .==. 0] + x = P.var (0::Int) + y = P.var 1 + +toP :: LA.Expr Rational -> P.Polynomial Rational Int +toP e = P.fromTerms [(c, if x == LA.unitVar then P.mone else P.var x) | (c,x) <- LA.terms e] + +toPRel :: LA.Atom Rational -> OrdRel (P.Polynomial Rational Int) +toPRel = fmap toP + +evalP :: Map.Map Int AReal -> P.Polynomial Rational Int -> AReal +evalP m p = P.eval (m Map.!) $ P.mapCoeff fromRational p + +evalPAtom :: Map.Map Int AReal -> OrdRel (P.Polynomial Rational Int) -> Bool +evalPAtom m (OrdRel lhs op rhs) =　evalOp op (evalP m lhs) (evalP m rhs) + +------------------------------------------------------------------------ + +prop_OmegaTest_solve :: Property +prop_OmegaTest_solve = + forAll genQFLAConjSmallInt $ \(vs,cs) -> + case OmegaTest.solve def vs cs of + Nothing -> forAll (genModel vs) $ \m -> all (LA.evalAtom (fmap fromInteger m)) cs == False + Just m -> property $ all (LA.evalAtom (fmap fromInteger m)) cs + +case_OmegaTest_test1 :: Assertion +case_OmegaTest_test1 = + case uncurry (OmegaTest.solve def) test1' of + Nothing -> assertFailure "expected: Just\n but got: Nothing" + Just m -> do + forM_ (snd test1') $ \a -> do + LA.evalAtom (IM.map fromInteger m) a @?= True + +case_OmegaTest_test2 :: Assertion +case_OmegaTest_test2 = + case uncurry (OmegaTest.solve def) test2' of + Just _ -> assertFailure "expected: Nothing\n but got: Just" + Nothing -> return () + +prop_OmegaTest_zmod = + forAll arbitrary $ \a -> + forAll arbitrary $ \b -> + b /= 0 ==> + let c = a `OmegaTest.zmod` b + in (a - c) `mod` b == 0 && abs c <= abs b `div` 2 + +------------------------------------------------------------------------ + +prop_Cooper_solve :: Property +prop_Cooper_solve = + forAll genQFLAConjSmallInt $ \(vs,cs) -> + case Cooper.solve vs cs of + Nothing -> + (forAll (genModel vs) $ \m -> all (LA.evalAtom (fmap fromInteger m)) cs == False) QC..&&. + property (OmegaTest.solve def vs cs == Nothing) + Just m -> property $ all (LA.evalAtom (fmap fromInteger m)) cs + +case_Cooper_test1 :: Assertion +case_Cooper_test1 = + case uncurry Cooper.solve test1' of + Nothing -> assertFailure "expected: Just\n but got: Nothing" + Just m -> do + forM_ (snd test1') $ \a -> do + LA.evalAtom (IM.map fromInteger m) a @?= True + +case_Cooper_test2 :: Assertion +case_Cooper_test2 = + case uncurry Cooper.solve test2' of + Just _ -> assertFailure "expected: Nothing\n but got: Just" + Nothing -> return () + +------------------------------------------------------------------------ + +prop_Simplex2_solve :: Property +prop_Simplex2_solve = QM.monadicIO $ do + (vs,cs) <- QM.pick genQFLAConj + join $ QM.run $ do + solver <- Simplex2.newSolver + m <- liftM IM.fromList $ forM (IS.toList vs) $ \v -> do + v2 <- Simplex2.newVar solver + return (v, LA.var v2) + let cs' = map (LA.applySubstAtom m) cs + forM_ cs' $ \c -> do + Simplex2.assertAtomEx solver c + ret <- Simplex2.check solver + if ret then do + m <- Simplex2.getModel solver + return $ forM_ cs' $ \c -> QM.assert (LA.evalAtom m c) + else do + return $ return () + +case_Simplex2_test1 :: Assertion +case_Simplex2_test1 = do + solver <- Simplex2.newSolver + forM_ (IS.toList (fst test1')) $ \_ -> Simplex2.newVar solver + mapM_ (Simplex2.assertAtomEx solver) (snd test1') + ret <- Simplex2.check solver + ret @?= True + +case_Simplex2_test2 :: Assertion +case_Simplex2_test2 = do + solver <- Simplex2.newSolver + forM_ (IS.toList (fst test2')) $ \_ -> Simplex2.newVar solver + mapM_ (Simplex2.assertAtomEx solver) (snd test2') + ret <- Simplex2.check solver + ret @?= True + +prop_Simplex2_backtrack :: Property +prop_Simplex2_backtrack = QM.monadicIO $ do + (vs,cs) <- QM.pick genQFLAConj + (vs2,cs2) <- QM.pick genQFLAConj + + join $ QM.run $ do + solver <- Simplex2.newSolver + m <- liftM IM.fromList $ forM (IS.toList (vs `IS.union` vs2)) $ \v -> do + v2 <- Simplex2.newVar solver + return (v, LA.var v2) + forM_ cs $ \c -> do + Simplex2.assertAtomEx solver (LA.applySubstAtom m c) + ret <- Simplex2.check solver + if ret then do + Simplex2.pushBacktrackPoint solver + forM_ cs2 $ \c -> do + Simplex2.assertAtomEx solver (LA.applySubstAtom m c) + _ <- Simplex2.check solver + Simplex2.popBacktrackPoint solver + ret2 <- Simplex2.check solver + return $ QM.assert ret2 + else do + return $ return () + +prop_Simplex2_explain :: Property +prop_Simplex2_explain = QM.monadicIO $ do + (vs,cs) <- QM.pick genQFLAConj + + let f p = QM.run $ do + solver <- Simplex2.newSolver + m <- liftM IM.fromList $ forM (IS.toList vs) $ \v -> do + v2 <- Simplex2.newVar solver + return (v, LA.var v2) + forM (zip [0..] cs) $ \(i,c) -> do + when (p i) $ + Simplex2.assertAtomEx' solver (LA.applySubstAtom m c) (Just i) + ret <- Simplex2.check solver + if ret then do + return Nothing + else do + liftM Just $ Simplex2.explain solver + + ret <- f (const True) + case ret of + Nothing -> return () + Just e -> do + ret2 <- f (`IS.member` e) + QM.assert (ret2 == Just e) + forM_ (IS.toList e) $ \i -> do + ret3 <- f (`IS.member` (IS.delete i e)) + QM.assert (isNothing ret3) + +------------------------------------------------------------------------ + +-- Too slow + +disabled_case_ContiTraverso_test1 :: Assertion +disabled_case_ContiTraverso_test1 = + case ContiTraverso.solve P.grlex (fst test1') OptMin (LA.constant 0) (snd test1') of + Nothing -> assertFailure "expected: Just\n but got: Nothing" + Just m -> do + forM_ (snd test1') $ \a -> do + LA.evalAtom (IM.map fromInteger m) a @?= True + +disabled_case_ContiTraverso_test2 :: Assertion +disabled_case_ContiTraverso_test2 = + case ContiTraverso.solve P.grlex (fst test2') OptMin (LA.constant 0) (snd test2') of + Just _ -> assertFailure "expected: Nothing\n but got: Just" + Nothing -> return () +------------------------------------------------------------------------ +-- Test harness + +arithTestGroup :: TestTree +arithTestGroup = $(testGroupGenerator) diff --git a/test/Test/BoolExpr.hs b/test/Test/BoolExpr.hs new file mode 100644 --- /dev/null +++ b/test/Test/BoolExpr.hs @@ -0,0 +1,121 @@ +{-# OPTIONS_GHC -Wall -fno-warn-orphans #-} +{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-} +module Test.BoolExpr (boolExprTestGroup) where + +import Control.Applicative +import Test.QuickCheck.Function +import Test.Tasty +import Test.Tasty.QuickCheck hiding ((.&&.), (.||.)) +import Test.Tasty.TH +import ToySolver.Data.BoolExpr + +-- --------------------------------------------------------------------- +-- BoolExpr + +instance Arbitrary a => Arbitrary (BoolExpr a) where + arbitrary = sized f + where + f n | n <= 0 = Atom <$> arbitrary + f n = + oneof + [ Atom <$> arbitrary + , And <$> list (n-1) + , Or <$> list (n-1) + , Not <$> (f (n-1)) + , uncurry Imply <$> pair (n-1) + , uncurry Equiv <$> pair (n-1) + , triple (n-1) >>= \(c,t,e) -> return (ITE c t e) + ] + + pair n | n <= 0 = do + a <- f 0 + b <- f 0 + return (a,b) + pair n = do + m <- choose (0,n) + a <- f m + b <- f (n-m) + return (a,b) + + triple n | n <= 0 = do + a <- f 0 + b <- f 0 + c <- f 0 + return (a,b,c) + triple n = do + m <- choose (0, n) + o <- choose (0, n-m) + a <- f m + b <- f o + c <- f (n - m - o) + return (a,b,c) + + list n | n <= 0 = return [] + list n = oneof $ + [ return [] + , do m <- choose (0,n) + x <- f m + xs <- list (n-m-1) + return (x:xs) + ] + +prop_BoolExpr_Functor_identity :: Property +prop_BoolExpr_Functor_identity = + forAll arbitrary $ \(b :: BoolExpr Int) -> + fmap id b == b + +prop_BoolExpr_Functor_compsition :: Property +prop_BoolExpr_Functor_compsition = + forAll arbitrary $ \(b :: BoolExpr Int) -> + forAll arbitrary $ \(f :: Fun Int Int) -> + forAll arbitrary $ \(g :: Fun Int Int) -> + fmap (apply f . apply g) b == fmap (apply f) (fmap (apply g) b) + +prop_BoolExpr_Applicative_identity :: Property +prop_BoolExpr_Applicative_identity = + forAll arbitrary $ \(b :: BoolExpr Int) -> + (pure id <*> b) == b + +prop_BoolExpr_Applicative_composition :: Property +prop_BoolExpr_Applicative_composition = + forAll arbitrary $ \(w :: BoolExpr Int) -> + forAll arbitrary $ \(u :: BoolExpr (Fun Int Int)) -> + forAll arbitrary $ \(v :: BoolExpr (Fun Int Int)) -> + (pure (.) <*> fmap apply u <*> fmap apply v <*> w) == (fmap apply u <*> (fmap apply v <*> w)) + +prop_BoolExpr_Applicative_homomorphism :: Property +prop_BoolExpr_Applicative_homomorphism = + forAll arbitrary $ \(x :: Int) -> + forAll arbitrary $ \(f :: Fun Int Int) -> + (pure (apply f) <*> pure x) == (pure (apply f x) :: BoolExpr Int) + +prop_BoolExpr_Applicative_interchange :: Property +prop_BoolExpr_Applicative_interchange = + forAll arbitrary $ \(y :: Int) -> + forAll arbitrary $ \(u :: BoolExpr (Fun Int Int)) -> + (fmap apply u <*> pure y) == (pure ($ y) <*> fmap apply u) + +prop_BoolExpr_Monad_left_identity :: Property +prop_BoolExpr_Monad_left_identity = + forAll arbitrary $ \(b :: BoolExpr Int) -> + forAll arbitrary $ \(f :: Fun Int (BoolExpr Int)) -> + (b >>= (\x -> return x >>= apply f)) == (b >>= apply f) + +prop_BoolExpr_Monad_bind_right_identity :: Property +prop_BoolExpr_Monad_bind_right_identity = + forAll arbitrary $ \(b :: BoolExpr Int) -> + forAll arbitrary $ \(f :: Fun Int (BoolExpr Int)) -> + (b >>= (\x -> apply f x >>= return)) == (b >>= apply f) + +prop_BoolExpr_Monad_bind_associativity :: Property +prop_BoolExpr_Monad_bind_associativity = + forAll arbitrary $ \(b :: BoolExpr Int) -> + forAll arbitrary $ \(f :: Fun Int (BoolExpr Int)) -> + forAll arbitrary $ \(g :: Fun Int (BoolExpr Int)) -> + (b >>= apply f >>= apply g) == (b >>= (\x -> apply f x >>= apply g)) + +------------------------------------------------------------------------ +-- Test harness + +boolExprTestGroup :: TestTree +boolExprTestGroup = $(testGroupGenerator) diff --git a/test/Test/CongruenceClosure.hs b/test/Test/CongruenceClosure.hs new file mode 100644 --- /dev/null +++ b/test/Test/CongruenceClosure.hs @@ -0,0 +1,326 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -Wall #-} +module Test.CongruenceClosure (ccTestGroup) where + +import Control.Monad +import Control.Monad.State +import Data.Array +import Data.Graph +import qualified Data.Tree as Tree +import Data.IntSet (IntSet) +import qualified Data.IntSet as IntSet +import Data.Set (Set) +import qualified Data.Set as Set + +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.Tasty.HUnit +import Test.Tasty.TH +import qualified Test.QuickCheck.Monadic as QM + +import ToySolver.EUF.CongruenceClosure +import qualified ToySolver.EUF.EUFSolver as EUF + +------------------------------------------------------------------------ +-- Test cases + +case_Example_1 :: Assertion +case_Example_1 = do + solver <- newSolver + a <- newFSym solver + b <- newFSym solver + c <- newFSym solver + d <- newFSym solver + + merge solver (TApp a []) (TApp c []) + ret <- areCongruent solver (TApp a [TApp b []]) (TApp c [TApp d []]) + ret @?= False + + merge solver (TApp b []) (TApp d []) + ret <- areCongruent solver (TApp a [TApp b []]) (TApp c [TApp d []]) + ret @?= True + +case_Example_1_FlatTerm :: Assertion +case_Example_1_FlatTerm = do + solver <- newSolver + a <- newFSym solver + b <- newFSym solver + c <- newFSym solver + d <- newFSym solver + + mergeFlatTerm solver (FTConst a) c + ret <- areCongruentFlatTerm solver (FTApp a b) (FTApp c d) + ret @?= False + + mergeFlatTerm solver (FTConst b) d + ret <- areCongruentFlatTerm solver (FTApp a b) (FTApp c d) + ret @?= True + +case_Example_2 :: Assertion +case_Example_2 = do + solver <- newSolver + a <- newConst solver + b <- newConst solver + c <- newConst solver + f <- newFun solver + g <- newFun solver + h <- newFun solver + + merge solver (f b) c + merge solver (f c) a + merge solver (g a) (h a a) + ret <- areCongruent solver (g b) (h c b) + ret @?= False + + merge solver b c + ret <- areCongruent solver (g b) (h c b) + ret @?= True + +case_NO2007_Example_11 :: Assertion +case_NO2007_Example_11 = do + solver <- newSolver + replicateM_ 15 $ newFSym solver + let xs = [(1,8),(7,2),(3,13),(7,1),(6,7),(6,7),(9,5),(9,3),(14,11),(10,4),(12,9),(4,11),(10,7)] + forM_ (zip [0..] xs) $ \(i,(a,b)) -> mergeFlatTerm' solver (FTConst a) b (Just i) + m <- explainConst solver 1 4 + fmap (Set.fromList . map (xs!!) . IntSet.toList) m @?= Just (Set.fromList [(7,1), (10,4), (10,7)]) + +-- f(g,h)=d, c=d, f(g,d)=a, e=c, e=b, b=h +case_NO2007_Example_16 :: Assertion +case_NO2007_Example_16 = do + solver <- newSolver + a <- newFSym solver + b <- newFSym solver + c <- newFSym solver + d <- newFSym solver + e <- newFSym solver + g <- newFSym solver + h <- newFSym solver + mergeFlatTerm' solver (FTApp g h) d (Just 0) + mergeFlatTerm' solver (FTConst c) d (Just 1) + mergeFlatTerm' solver (FTApp g d) a (Just 2) + mergeFlatTerm' solver (FTConst e) c (Just 3) + mergeFlatTerm' solver (FTConst e) b (Just 4) + mergeFlatTerm' solver (FTConst b) h (Just 5) + m <- explainConst solver a b + m @?= Just (IntSet.fromList [1,3,4,5,0,2]) + -- d = c = e = b = h + -- a = f(g,d) = f(g,h) = d = c = e = b + +case_backtracking_1 :: Assertion +case_backtracking_1 = do + solver <- newSolver + a1 <- newFSym solver + a2 <- newFSym solver + b1 <- newFSym solver + b2 <- newFSym solver + + mergeFlatTerm solver (FTConst a1) b1 + + pushBacktrackPoint solver + mergeFlatTerm solver (FTConst a2) b2 + ret <- areCongruentFlatTerm solver (FTApp a1 a2) (FTApp b1 b2) + ret @?= True + popBacktrackPoint solver + + ret <- areCongruentFlatTerm solver (FTConst a2) (FTConst b2) + ret @?= False + ret <- areCongruentFlatTerm solver (FTApp a1 a2) (FTApp b1 b2) + ret @?= False + + pushBacktrackPoint solver + ret <- areCongruentFlatTerm solver (FTConst a2) (FTConst b2) + ret @?= False + ret <- areCongruentFlatTerm solver (FTApp a1 a2) (FTApp b1 b2) + ret @?= False + popBacktrackPoint solver + +case_backtracking_preserve_definition :: Assertion +case_backtracking_preserve_definition = do + solver <- newSolver + a1 <- newFSym solver + a2 <- newFSym solver + b1 <- newFSym solver + b2 <- newFSym solver + pushBacktrackPoint solver + a <- flatTermToFSym solver (FTApp a1 a2) + b <- flatTermToFSym solver (FTApp b1 b2) + popBacktrackPoint solver + c <- newFSym solver + mergeFlatTerm solver (FTApp a1 a2) c + mergeFlatTerm solver (FTApp b1 b2) c + ret <- areCongruentFlatTerm solver (FTConst a) (FTConst b) + ret @?= True + +prop_components :: Property +prop_components = QM.monadicIO $ do + nv <- QM.pick $ choose (1, 10) + ne <- QM.pick $ choose (1, 100) + edges <- QM.pick $ replicateM ne $ do + s <- choose (0,nv-1) + t <- choose (0,nv-1) + return (s,t) + let g = buildG (0,nv-1) edges + repr = array (0,nv-1) [(c, Tree.rootLabel comp) | comp <- components g, c <- Tree.flatten comp] + + solver <- QM.run $ newSolver + QM.run $ do + replicateM_ nv $ newFSym solver + forM_ edges $ \(s,t) -> mergeFlatTerm solver (FTConst s) t + forM_ [0..(nv-1)] $ \c -> + forM_ [0..(nv-1)] $ \d -> do + b <- QM.run $ areCongruentFlatTerm solver (FTConst c) (FTConst d) + QM.assert $ b == (repr ! c == repr ! d) + +case_fsymToTerm_termToSym :: Assertion +case_fsymToTerm_termToSym = do + solver <- newSolver + f <- liftM (\f x y -> TApp f [x,y]) $ newFSym solver + g <- liftM (\f x -> TApp f [x]) $ newFSym solver + a <- newConst solver + + let t = f (g a) (g (g a)) + c <- termToFSym solver t + t2 <- fsymToTerm solver c + t2 @?= t + +case_getModel_test1 :: Assertion +case_getModel_test1 = do + solver <- newSolver + a <- newConst solver + b <- newConst solver + c <- newConst solver + d <- newConst solver + f <- newFun solver + g <- newFun solver + h <- newFun solver + + merge solver (f b) c + merge solver (f c) a + merge solver (g a) (h a a) + m1 <- getModel solver + (eval m1 (f b) == eval m1 c) @?= True + (eval m1 (f c) == eval m1 a) @?= True + (eval m1 (g a) == eval m1 (h a a)) @?= True + (eval m1 (f b) == eval m1 (f c)) @?= False + + merge solver b c + m2 <- getModel solver + (eval m2 (f b) == eval m2 c) @?= True + (eval m2 (f c) == eval m2 a) @?= True + (eval m2 (g a) == eval m2 (h a a)) @?= True + (eval m2 (f b) == eval m2 (f c)) @?= True + (eval m2 (g b) == eval m2 (g c)) @?= True + +case_EUF_getModel_test1 :: Assertion +case_EUF_getModel_test1 = do + solver <- EUF.newSolver + a <- EUF.newConst solver -- 0 + b <- EUF.newConst solver -- 1 + c <- EUF.newConst solver -- 2 + f <- EUF.newFun solver -- 3 + g <- EUF.newFun solver -- 4 + h <- EUF.newFun solver -- 5 + + EUF.assertEqual solver (f b) c + EUF.assertEqual solver (f c) a + EUF.assertEqual solver (g a) (h a a) + True <- EUF.check solver + m1 <- EUF.getModel solver + (eval m1 (g b) == eval m1 (h c b)) @?= True + + EUF.assertNotEqual solver (g b) (h c b) + True <- EUF.check solver + m2 <- EUF.getModel solver + (eval m2 (g b) == eval m2 (h c b)) @?= False + +prop_getModel_eval_1 :: Property +prop_getModel_eval_1 = QM.monadicIO $ do + solver <- QM.run newSolver + a <- QM.run $ newConst solver + b <- QM.run $ newConst solver + c <- QM.run $ newConst solver + f <- QM.run $ newFun solver + g <- QM.run $ newFun solver + h <- QM.run $ newFun solver + + let genExpr :: Gen Term + genExpr = evalStateT genExpr' 10 + + genExpr' :: StateT Int Gen Term + genExpr' = do + budget <- get + modify (subtract 1) + join $ lift $ elements $ concat $ + [ map return [a,b,c] + , [ liftM f genExpr' | budget >= 2 ] + , [ liftM g genExpr' | budget >= 2 ] + , [ liftM2 h genExpr' genExpr' | budget >= 3 ] + ] + + es <- QM.pick $ do + n <- choose (0, 20) + replicateM n $ do + lhs <- genExpr + rhs <- genExpr + return (lhs,rhs) + + join $ QM.run $ do + forM_ es $ \(lhs,rhs) -> + merge solver lhs rhs + m <- getModel solver + return $ + forM_ es $ \(lhs,rhs) -> do + QM.assert (eval m lhs == eval m rhs) + +prop_getModel_eval_2 :: Property +prop_getModel_eval_2 = QM.monadicIO $ do + solver <- QM.run newSolver + a <- QM.run $ newConst solver + b <- QM.run $ newConst solver + c <- QM.run $ newConst solver + f <- QM.run $ newFun solver + g <- QM.run $ newFun solver + h <- QM.run $ newFun solver + + let genExpr :: Gen Term + genExpr = evalStateT genExpr' 10 + + genExpr' :: StateT Int Gen Term + genExpr' = do + budget <- get + modify (subtract 1) + join $ lift $ elements $ concat $ + [ map return [a,b,c] + , [ liftM f genExpr' | budget >= 2 ] + , [ liftM g genExpr' | budget >= 2 ] + , [ liftM2 h genExpr' genExpr' | budget >= 3 ] + ] + + es <- QM.pick $ do + n <- choose (0, 20) + replicateM n $ do + lhs <- genExpr + rhs <- genExpr + return (lhs,rhs) + + (lhs,rhs) <- QM.pick $ do + lhs <- genExpr + rhs <- genExpr + return (lhs,rhs) + + join $ QM.run $ do + forM_ es $ \(lhs,rhs) -> do + merge solver lhs rhs + b <- areCongruent solver lhs rhs + if b then do + m <- getModel solver + return $ QM.assert (eval m lhs == eval m rhs) + else + return $ return () + +------------------------------------------------------------------------ +-- Test harness + +ccTestGroup :: TestTree +ccTestGroup = $(testGroupGenerator) diff --git a/test/Test/ContiTraverso.hs b/test/Test/ContiTraverso.hs new file mode 100644 --- /dev/null +++ b/test/Test/ContiTraverso.hs @@ -0,0 +1,103 @@ +{-# LANGUAGE TemplateHaskell #-} +module Test.ContiTraverso (ctTestGroup) where + +import Control.Monad +import Data.List +import qualified Data.IntMap as IM +import qualified Data.IntSet as IS +import qualified Data.Map as Map +import Data.VectorSpace + +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.Tasty.HUnit +import Test.Tasty.TH + +import Data.OptDir + +import ToySolver.Arith.ContiTraverso + +import ToySolver.Data.OrdRel +import qualified ToySolver.Data.LA as LA +import ToySolver.Data.Polynomial (Polynomial) +import qualified ToySolver.Data.Polynomial as P + +-- http://madscientist.jp/~ikegami/articles/IntroSequencePolynomial.html +-- optimum is (3,2,0) +case_ikegami = solve P.grlex (IS.fromList vs) OptMin obj cs @?= Just (IM.fromList [(1,3),(2,2),(3,0)]) + where + vs = [1..3] + [x,y,z] = map LA.var vs + cs = [ 2*^x ^+^ 2*^y ^+^ 2*^z .==. LA.constant 10 + , 3*^x ^+^ y ^+^ z .==. LA.constant 11 + , x .>=. LA.constant 0 + , y .>=. LA.constant 0 + , z .>=. LA.constant 0 + ] + obj = x ^+^ 2*^y ^+^ 3*^z + +case_ikegami' = solve' P.grlex (IS.fromList vs) obj cs @?= Just (IM.fromList [(1,3),(2,2),(3,0)]) + where + vs@[x,y,z] = [1..3] + cs = [ (LA.fromTerms [(2,x),(2,y),(2,z)], 10) + , (LA.fromTerms [(3,x),(1,y),(1,z)], 11) + ] + obj = LA.fromTerms [(1,x),(2,y),(3,z)] + +-- http://posso.dm.unipi.it/users/traverso/conti-traverso-ip.ps +-- optimum is (39, 75, 1, 8, 122) +disabled_case_test1 = solve P.grlex (IS.fromList vs) OptMin obj cs @?= Just (IM.fromList [(1,39), (2,75), (3,1), (4,8), (5,122)]) + where + vs = [1..5] + vs2@[x1,x2,x3,x4,x5] = map LA.var vs + cs = [ 2*^x1 ^+^ 5*^x2 ^-^ 3*^x3 ^+^ x4 ^-^ 2*^x5 .==. LA.constant 214 + , x1 ^+^ 7*^x2 ^+^ 2*^x3 ^+^ 3*^x4 ^+^ x5 .==. LA.constant 712 + , 4*^x1 ^-^ 2*^x2 ^-^ x3 ^-^ 5*^x4 ^+^ 3*^x5 .==. LA.constant 331 + ] ++ + [ v .>=. LA.constant 0 | v <- vs2 ] + obj = x1 ^+^ x2 ^+^ x3 ^+^ x4 ^+^ x5 + +disabled_case_test1' = solve' P.grlex (IS.fromList vs) obj cs @?= Just (IM.fromList [(1,39), (2,75), (3,1), (4,8), (5,122)]) + where + vs@[x1,x2,x3,x4,x5] = [1..5] + cs = [ (LA.fromTerms [(2, x1), ( 5, x2), (-3, x3), ( 1,x4), (-2, x5)], 214) + , (LA.fromTerms [(1, x1), ( 7, x2), ( 2, x3), ( 3,x4), ( 1, x5)], 712) + , (LA.fromTerms [(4, x1), (-2, x2), (-1, x3), (-5,x4), ( 3, x5)], 331) + ] + obj = LA.fromTerms [(1,x1),(1,x2),(1,x3),(1,x4),(1,x5)] + +-- optimum is (0,2,2) +case_test2 = solve P.grlex (IS.fromList vs) OptMin obj cs @?= Just (IM.fromList [(1,0),(2,2),(3,2)]) + where + vs = [1..3] + vs2@[x1,x2,x3] = map LA.var vs + cs = [ 2*^x1 ^+^ 3*^x2 ^-^ x3 .==. LA.constant 4 ] ++ + [ v .>=. LA.constant 0 | v <- vs2 ] + obj = 2*^x1 ^+^ x2 + +case_test2' = solve' P.grlex (IS.fromList vs) obj cs @?= Just (IM.fromList [(1,0),(2,2),(3,2)]) + where + vs@[x1,x2,x3] = [1..3] + cs = [ (LA.fromTerms [(2, x1), (3, x2), (-1, x3)], 4) ] + obj = LA.fromTerms [(2,x1),(1,x2)] + +-- infeasible +case_test3 = solve P.grlex (IS.fromList vs) OptMin obj cs @?= Nothing + where + vs = [1..3] + vs2@[x1,x2,x3] = map LA.var vs + cs = [ 2*^x1 ^+^ 2*^x2 ^+^ 2*^x3 .==. LA.constant 3 ] ++ + [ v .>=. LA.constant 0 | v <- vs2 ] + obj = x1 + +case_test3' = solve' P.grlex (IS.fromList vs) obj cs @?= Nothing + where + vs@[x1,x2,x3] = [1..3] + cs = [ (LA.fromTerms [(2, x1), (2, x2), (2, x3)], 3) ] + obj = LA.fromTerms [(1,x1)] + +------------------------------------------------------------------------ +-- Test harness + +ctTestGroup :: TestTree +ctTestGroup = $(testGroupGenerator) diff --git a/test/Test/Delta.hs b/test/Test/Delta.hs new file mode 100644 --- /dev/null +++ b/test/Test/Delta.hs @@ -0,0 +1,119 @@ +{-# OPTIONS_GHC -Wall -fno-warn-orphans #-} +{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-} +module Test.Delta (deltaTestGroup) where + +import Data.VectorSpace ((*^)) +import Test.Tasty +import Test.Tasty.QuickCheck hiding ((.&&.), (.||.)) +import Test.Tasty.TH +import ToySolver.Data.Delta (Delta (..)) +import qualified ToySolver.Data.Delta as Delta + +-- --------------------------------------------------------------------- +-- Delta + +instance Arbitrary r => Arbitrary (Delta r) where + arbitrary = do + r <- arbitrary + k <- arbitrary + return (Delta r k) + +prop_Delta_add_comm :: Property +prop_Delta_add_comm = + forAll arbitrary $ \(a :: Delta Rational) -> + forAll arbitrary $ \b -> + a + b == b + a + +prop_Delta_add_assoc :: Property +prop_Delta_add_assoc = + forAll arbitrary $ \(a :: Delta Rational) -> + forAll arbitrary $ \b -> + forAll arbitrary $ \c -> + a + (b + c) == (a + b) + c + +prop_Delta_add_unitL :: Property +prop_Delta_add_unitL = + forAll arbitrary $ \(a :: Delta Rational) -> + 0 + a == a + +prop_Delta_add_unitR :: Property +prop_Delta_add_unitR = + forAll arbitrary $ \(a :: Delta Rational) -> + a + 0 == a + +prop_Delta_mult_comm :: Property +prop_Delta_mult_comm = + forAll arbitrary $ \(a :: Delta Rational) -> + forAll arbitrary $ \b -> + a * b == b * a + +prop_Delta_mult_assoc :: Property +prop_Delta_mult_assoc = + forAll arbitrary $ \(a :: Delta Rational) -> + forAll arbitrary $ \b -> + forAll arbitrary $ \c -> + a * (b * c) == (a * b) * c + +prop_Delta_mult_unitL :: Property +prop_Delta_mult_unitL = + forAll arbitrary $ \(a :: Delta Rational) -> + 1 * a == a + +prop_Delta_mult_unitR :: Property +prop_Delta_mult_unitR = + forAll arbitrary $ \(a :: Delta Rational) -> + a * 1 == a + +prop_Delta_mult_dist :: Property +prop_Delta_mult_dist = + forAll arbitrary $ \(a :: Delta Rational) -> + forAll arbitrary $ \b -> + forAll arbitrary $ \c -> + a * (b + c) == a * b + a * c + +prop_Delta_mult_zero :: Property +prop_Delta_mult_zero = + forAll arbitrary $ \(a :: Delta Rational) -> + 0 * a == 0 + +prop_Delta_scale_mult :: Property +prop_Delta_scale_mult = + forAll arbitrary $ \(a :: Delta Rational) -> + forAll arbitrary $ \b -> + Delta.fromReal a * b == a *^ b + +prop_Delta_signum_abs :: Property +prop_Delta_signum_abs = + forAll arbitrary $ \(x :: Delta Rational) -> + abs x * signum x == x + +prop_Delta_floor :: Property +prop_Delta_floor = + forAll arbitrary $ \(x :: Delta Rational) -> + let y :: Integer + y = Delta.floor' x + in fromIntegral y <= x && x < fromIntegral (y+1) + +prop_Delta_ceiling :: Property +prop_Delta_ceiling = + forAll arbitrary $ \(x :: Delta Rational) -> + let y :: Integer + y = Delta.ceiling' x + in fromIntegral (y-1) < x && x <= fromIntegral y + +prop_Delta_properFraction :: Property +prop_Delta_properFraction = + forAll arbitrary $ \(x :: Delta Rational) -> + let n :: Integer + (n,f) = properFraction x + in and + [ abs f < 1 + , not (x >= 0) || (n >= 0 && f >= 0) + , not (x <= 0) || (n <= 0 && f <= 0) + ] + +------------------------------------------------------------------------ +-- Test harness + +deltaTestGroup :: TestTree +deltaTestGroup = $(testGroupGenerator) diff --git a/test/Test/FiniteModelFinder.hs b/test/Test/FiniteModelFinder.hs new file mode 100644 --- /dev/null +++ b/test/Test/FiniteModelFinder.hs @@ -0,0 +1,115 @@ +{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-} +module Test.FiniteModelFinder (fmfTestGroup) where + +import Control.Monad +import Control.Monad.State +import Control.Monad.Trans +import Data.Map (Map) +import qualified Data.Map as Map + +import Test.Tasty +import Test.Tasty.QuickCheck hiding ((.&&.), (.||.)) +import Test.Tasty.HUnit +import Test.Tasty.TH +import qualified Test.QuickCheck.Monadic as QM + +import qualified ToySolver.EUF.FiniteModelFinder as MF + +type Sig = (Map MF.FSym Int, Map MF.PSym Int) + +genTerm' :: Sig -> [MF.Var] -> StateT Int Gen MF.Term +genTerm' (fsyms, _) vs = m + where + m = do + budget <- get + f <- lift $ elements $ map Left vs ++ [Right (f, arity) | (f, arity) <- Map.toList fsyms, arity == 0 || budget >= arity+1] + modify (subtract 1) + case f of + Left v -> return (MF.TmVar v) + Right (f', arity) -> do + args <- replicateM arity m + return $ MF.TmApp f' args + +genAtom' :: Sig -> [MF.Var] -> StateT Int Gen MF.Atom +genAtom' sig@(fsyms, psyms) vs = do + budget <- get + (p, arity) <- lift $ elements $ ("=",2) : [(p, arity) | (p, arity) <- Map.toList psyms, arity == 0 || budget >= arity+1] + modify (subtract 1) + args <- replicateM arity (genTerm' sig vs) + return $ MF.PApp p args + +genLit' :: Sig -> [MF.Var] -> StateT Int Gen MF.Lit +genLit' sig vs = do + atom <- genAtom' sig vs + lift $ elements [MF.Pos atom, MF.Neg atom] + +genClause' :: Sig -> [MF.Var] -> StateT Int Gen MF.Clause +genClause' sig vs = do + n <- lift $ choose (1,4) + replicateM n $ genLit' sig vs + +genClause :: Sig -> [MF.Var] -> Gen MF.Clause +--genClause sig vs = sized (evalStateT (genClause' sig vs)) +genClause sig vs = evalStateT (genClause' sig vs) 8 + +genSmallSig :: Gen Sig +genSmallSig = do + nFun <- choose (1::Int, 5) + nPred <- choose (0::Int, 3) + fsyms <- liftM Map.fromList $ forM [0..nFun-1] $ \i -> do + arity <- if i == 0 then return 0 else choose (0, 3) + return ("f" ++ show i, arity) + psyms <- liftM Map.fromList $ forM [0..nPred-1] $ \i -> do + arity <- choose (0, 3) + return ("p" ++ show i, arity) + return (fsyms, psyms) + +prop_findModel_soundness = QM.monadicIO $ do + sig <- QM.pick genSmallSig + nv <- QM.pick $ choose (0::Int, 2) + let vs = ["v" ++ show i | i <- [0..nv-1]] + nc <- QM.pick $ choose (0::Int, 3) + cs <- QM.pick $ replicateM nc $ genClause sig vs + size <- QM.pick $ choose (1::Int, 5) + ret <- QM.run $ MF.findModel size cs + case ret of + Nothing -> return () + Just m -> QM.assert (MF.evalClausesU m cs) + +case_example_1 = do + ret <- MF.findModel 2 cs + case ret of + Nothing -> assertFailure (show cs ++ " should be satisfiable") + Just m -> assertBool (show cs ++ " should be evaluated to true on " ++ unlines (MF.showModel m)) (MF.evalClausesU m cs) + where + cs = [[f b .=. c], [f c .=. a], [g a .=. h a a], [g b ./=. h c b]] + (.=.) x y = MF.Pos $ MF.PApp "=" [x, y] + (./=.) x y = MF.Neg $ MF.PApp "=" [x, y] + a = MF.TmApp "a" [] + b = MF.TmApp "b" [] + c = MF.TmApp "c" [] + f x = MF.TmApp "f" [x] + g x = MF.TmApp "g" [x] + h x y = MF.TmApp "h" [x, y] + +case_example_2 = do + ret <- MF.findModel 5 cs + case ret of + Nothing -> return () + Just _ -> assertFailure (show cs ++ " should be unsatisfiable") + where + cs = [[f b .=. c], [f c .=. a], [g a .=. h a a], [g b ./=. h c b], [b .=. c]] + (.=.) x y = MF.Pos $ MF.PApp "=" [x, y] + (./=.) x y = MF.Neg $ MF.PApp "=" [x, y] + a = MF.TmApp "a" [] + b = MF.TmApp "b" [] + c = MF.TmApp "c" [] + f x = MF.TmApp "f" [x] + g x = MF.TmApp "g" [x] + h x y = MF.TmApp "h" [x, y] + +-- --------------------------------------------------------------------- +-- Test harness + +fmfTestGroup :: TestTree +fmfTestGroup = $(testGroupGenerator) diff --git a/test/Test/HittingSets.hs b/test/Test/HittingSets.hs new file mode 100644 --- /dev/null +++ b/test/Test/HittingSets.hs @@ -0,0 +1,291 @@ +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-} +module Test.HittingSets (hittingSetsTestGroup) where + +import Prelude hiding (all) + +import Control.Arrow +import Control.Monad +import Data.Foldable (all) +import Data.IntSet (IntSet) +import qualified Data.IntSet as IntSet +import Data.Ratio +import Data.Set (Set) +import qualified Data.Set as Set +import Test.Tasty +import Test.Tasty.QuickCheck hiding ((.&&.), (.||.)) +import Test.Tasty.HUnit +import Test.Tasty.TH +import qualified ToySolver.Combinatorial.HittingSet.Simple as HittingSet +import qualified ToySolver.Combinatorial.HittingSet.FredmanKhachiyan1996 as FredmanKhachiyan1996 +import qualified ToySolver.Combinatorial.HittingSet.GurvichKhachiyan1999 as GurvichKhachiyan1999 + +-- --------------------------------------------------------------------- +-- Hitting sets + +case_minimalHittingSets_1 :: Assertion +case_minimalHittingSets_1 = actual @?= expected + where + actual = HittingSet.minimalHittingSets $ Set.fromList $ map IntSet.fromList [[1], [2,3,5], [2,3,6], [2,4,5], [2,4,6]] + expected = Set.fromList $ map IntSet.fromList [[1,2], [1,3,4], [1,5,6]] + +-- an example from http://kuma-san.net/htcbdd.html +case_minimalHittingSets_2 :: Assertion +case_minimalHittingSets_2 = actual @?= expected + where + actual = HittingSet.minimalHittingSets $ Set.fromList $ map IntSet.fromList [[2,4,7], [7,8], [9], [9,10]] + expected = Set.fromList $ map IntSet.fromList [[7,9], [4,8,9], [2,8,9]] + +hyperGraph :: Gen (Set IntSet) +hyperGraph = do + nv <- choose (0, 10) + ne <- if nv==0 then return 0 else choose (0, 20) + liftM Set.fromList $ replicateM ne $ do + n <- choose (1,nv) + liftM IntSet.fromList $ replicateM n $ choose (1, nv) + +isHittingSetOf :: IntSet -> Set IntSet -> Bool +isHittingSetOf s g = all (\e -> not (IntSet.null (s `IntSet.intersection` e))) g + +prop_minimalHittingSets_duality :: Property +prop_minimalHittingSets_duality = + forAll hyperGraph $ \g -> + let h = HittingSet.minimalHittingSets g + in h == HittingSet.minimalHittingSets (HittingSet.minimalHittingSets h) + +prop_minimalHittingSets_isHittingSet :: Property +prop_minimalHittingSets_isHittingSet = + forAll hyperGraph $ \g -> + all (`isHittingSetOf` g) (HittingSet.minimalHittingSets g) + +prop_minimalHittingSets_minimality :: Property +prop_minimalHittingSets_minimality = + forAll hyperGraph $ \g -> + forAll (elements (Set.toList (HittingSet.minimalHittingSets g))) $ \s -> + if IntSet.null s then + property True + else + forAll (elements (IntSet.toList s)) $ \v -> + not $ IntSet.delete v s `isHittingSetOf` g + +mutuallyDualHypergraphs :: Gen (Set IntSet, Set IntSet) +mutuallyDualHypergraphs = do + g <- liftM HittingSet.minimalHittingSets hyperGraph + let f = HittingSet.minimalHittingSets g + return (f,g) + +mutuallyDualDNFs :: Gen (Set IntSet, Set IntSet) +mutuallyDualDNFs = do + (f,g) <- mutuallyDualHypergraphs + let xs = IntSet.unions $ Set.toList $ f `Set.union` g + if IntSet.null xs then + return (f,g) + else do + let xs' = IntSet.toList xs + let mutate h = liftM Set.unions $ do + forM (Set.toList h) $ \is -> oneof $ + [ return $ Set.singleton is + , do i <- elements xs' + return $ Set.fromList [is, IntSet.insert i is] + ] + f' <- mutate f + g' <- mutate g + return (f',g') + +-- Pair of DNFs that are nearly dual. +pairOfDNFs :: Gen (Set IntSet, Set IntSet) +pairOfDNFs = do + (f,g) <- mutuallyDualDNFs + let mutate h = liftM Set.unions $ do + forM (Set.toList h) $ \is -> oneof $ + [return Set.empty, return (Set.singleton is)] ++ + [ do x <- elements (IntSet.toList is) + return $ Set.singleton $ IntSet.delete x is + | not (IntSet.null is) + ] + return (f,g) + +prop_FredmanKhachiyan1996_checkDualityA_prop1 :: Property +prop_FredmanKhachiyan1996_checkDualityA_prop1 = + forAll mutuallyDualDNFs $ \(f,g) -> + FredmanKhachiyan1996.checkDualityA f g == Nothing + +prop_FredmanKhachiyan1996_checkDualityA_prop2 :: Property +prop_FredmanKhachiyan1996_checkDualityA_prop2 = + forAll pairOfDNFs $ \(f,g) -> + case FredmanKhachiyan1996.checkDualityA f g of + Nothing -> True + Just xs -> xs `FredmanKhachiyan1996.isCounterExampleOf` (f,g) + +prop_FredmanKhachiyan1996_checkDualityB_prop1 :: Property +prop_FredmanKhachiyan1996_checkDualityB_prop1 = + forAll mutuallyDualDNFs $ \(f,g) -> + FredmanKhachiyan1996.checkDualityA f g == Nothing + +prop_FredmanKhachiyan1996_checkDualityB_prop2 :: Property +prop_FredmanKhachiyan1996_checkDualityB_prop2 = + forAll pairOfDNFs $ \(f,g) -> + case FredmanKhachiyan1996.checkDualityB f g of + Nothing -> True + Just xs -> xs `FredmanKhachiyan1996.isCounterExampleOf` (f,g) + +prop_FredmanKhachiyan1996_lemma_1 :: Property +prop_FredmanKhachiyan1996_lemma_1 = + forAll mutuallyDualHypergraphs $ \(f,g) -> + let e :: Rational + e = sum [1 % (2 ^ IntSet.size i) | i <- Set.toList f] + + sum [1 % (2 ^ IntSet.size j) | j <- Set.toList g] + in e >= 1 + +prop_FredmanKhachiyan1996_corollary_1 :: Property +prop_FredmanKhachiyan1996_corollary_1 = + forAll mutuallyDualHypergraphs $ \(f,g) -> + let n = Set.size f + Set.size g + m = minimum [IntSet.size is | is <- Set.toList (f `Set.union` g)] + in (fromIntegral m :: Double) <= logBase 2 (fromIntegral n) + +prop_FredmanKhachiyan1996_lemma_2 :: Property +prop_FredmanKhachiyan1996_lemma_2 = + forAll mutuallyDualHypergraphs $ \(f,g) -> + let n = Set.size f + Set.size g + epsilon :: Double + epsilon = 1 / logBase 2 (fromIntegral n) + vs = IntSet.unions $ Set.toList $ f `Set.union` g + in (Set.size f * Set.size g >= 1) + ==> any (\v -> FredmanKhachiyan1996.occurFreq v f >= epsilon || FredmanKhachiyan1996.occurFreq v g >= epsilon) (IntSet.toList vs) + +prop_FredmanKhachiyan1996_lemma_3_a :: Property +prop_FredmanKhachiyan1996_lemma_3_a = + forAll mutuallyDualHypergraphs $ \(f,g) -> + let vs = IntSet.unions $ Set.toList $ f `Set.union` g + x = IntSet.findMin vs + -- f = x f0 ∨ f1 + (f0, f1) = Set.map (IntSet.delete x) *** id $ Set.partition (x `IntSet.member`) f + -- g = x g0 ∨ g1 + (g0, g1) = Set.map (IntSet.delete x) *** id $ Set.partition (x `IntSet.member`) g + in not (IntSet.null vs) + ==> + HittingSet.minimalHittingSets f1 == FredmanKhachiyan1996.deleteRedundancy (g0 `Set.union` g1) && + HittingSet.minimalHittingSets g1 == FredmanKhachiyan1996.deleteRedundancy (f0 `Set.union` f1) + +prop_FredmanKhachiyan1996_to_selfDuality :: Property +prop_FredmanKhachiyan1996_to_selfDuality = + forAll mutuallyDualHypergraphs $ \(f,g) -> + let vs = IntSet.unions $ Set.toList $ f `Set.union` g + y = if IntSet.null vs then 0 else IntSet.findMax vs + 1 + z = y + 1 + h = FredmanKhachiyan1996.deleteRedundancy $ Set.unions + [ Set.map (IntSet.insert y) f + , Set.map (IntSet.insert z) g + , Set.singleton (IntSet.fromList [y,z]) + ] + in HittingSet.minimalHittingSets h == h + +case_FredmanKhachiyan1996_condition_1_1_solve_L :: Assertion +case_FredmanKhachiyan1996_condition_1_1_solve_L = (xs `FredmanKhachiyan1996.isCounterExampleOf` (f,g)) @?= True + where + Just xs = FredmanKhachiyan1996.condition_1_1_solve f g + f = Set.fromList $ map IntSet.fromList [[2,4,7], [7,8], [9], [4]] + g = Set.fromList $ map IntSet.fromList [[7,9], [4,8,9], [2,8,9]] + +case_FredmanKhachiyan1996_condition_1_1_solve_R :: Assertion +case_FredmanKhachiyan1996_condition_1_1_solve_R = (xs `FredmanKhachiyan1996.isCounterExampleOf` (f,g)) @?= True + where + Just xs = FredmanKhachiyan1996.condition_1_1_solve f g + f = Set.fromList $ map IntSet.fromList [[2,4,7], [7,8], [9]] + g = Set.fromList $ map IntSet.fromList [[7,9], [4,8,9], [2,8,9], [4,7,8]] + +case_FredmanKhachiyan1996_condition_1_2_solve_L :: Assertion +case_FredmanKhachiyan1996_condition_1_2_solve_L = (xs `FredmanKhachiyan1996.isCounterExampleOf` (f,g)) @?= True + where + Just xs = FredmanKhachiyan1996.condition_1_2_solve f g + f = Set.fromList $ map IntSet.fromList [[2,4,7], [7,8], [9,10]] + g = Set.fromList $ map IntSet.fromList [[7,9], [4,8,9], [2,8,9]] + +case_FredmanKhachiyan1996_condition_1_2_solve_R :: Assertion +case_FredmanKhachiyan1996_condition_1_2_solve_R = (xs `FredmanKhachiyan1996.isCounterExampleOf` (f,g)) @?= True + where + Just xs = FredmanKhachiyan1996.condition_1_2_solve f g + f = Set.fromList $ map IntSet.fromList [[2,4,7], [7,8], [9]] + g = Set.fromList $ map IntSet.fromList [[7,9], [4,8,9], [2,8,9,10]] + +case_FredmanKhachiyan1996_condition_1_3_solve_L :: Assertion +case_FredmanKhachiyan1996_condition_1_3_solve_L = (xs `FredmanKhachiyan1996.isCounterExampleOf` (f,g)) @?= True + where + Just xs = FredmanKhachiyan1996.condition_1_3_solve f g + f = Set.fromList $ map IntSet.fromList [[2,4,7,10], [7,8], [9]] + g = Set.fromList $ map IntSet.fromList [[7,9,10], [4,8,9], [2,8,9]] + +case_FredmanKhachiyan1996_condition_1_3_solve_R :: Assertion +case_FredmanKhachiyan1996_condition_1_3_solve_R = (xs `FredmanKhachiyan1996.isCounterExampleOf` (f,g)) @?= True + where + Just xs = FredmanKhachiyan1996.condition_1_3_solve f g + f = Set.fromList $ map IntSet.fromList [[2,4,7], [7,8], [9,10]] + g = Set.fromList $ map IntSet.fromList [[7,9], [4,8,9], [2,8,9,10]] + +case_FredmanKhachiyan1996_condition_2_1_solve_L :: Assertion +case_FredmanKhachiyan1996_condition_2_1_solve_L = (xs `FredmanKhachiyan1996.isCounterExampleOf` (f,g)) @?= True + where + Just xs = FredmanKhachiyan1996.condition_2_1_solve f g + f = Set.fromList $ map IntSet.fromList [[2,4,7], [4,7,9], [7,8,9]] + g = Set.fromList $ map IntSet.fromList [[2,4,7], [2,8,9], [4,8,9]] + +case_FredmanKhachiyan1996_condition_2_1_solve_R :: Assertion +case_FredmanKhachiyan1996_condition_2_1_solve_R = (xs `FredmanKhachiyan1996.isCounterExampleOf` (f,g)) @?= True + where + Just xs = FredmanKhachiyan1996.condition_2_1_solve f g + g = Set.fromList $ map IntSet.fromList [[2,4,7], [4,7,9], [7,8,9]] + f = Set.fromList $ map IntSet.fromList [[2,4,7], [2,8,9], [4,8,9]] + +case_FredmanKhachiyan1996_checkDualityA :: Assertion +case_FredmanKhachiyan1996_checkDualityA = FredmanKhachiyan1996.checkDualityA f g @?= Nothing + where + f = Set.fromList $ map IntSet.fromList [[2,4,7], [7,8], [9]] + g = Set.fromList $ map IntSet.fromList [[7,9], [4,8,9], [2,8,9]] + +case_FredmanKhachiyan1996_checkDualityB :: Assertion +case_FredmanKhachiyan1996_checkDualityB = FredmanKhachiyan1996.checkDualityB f g @?= Nothing + where + f = Set.fromList $ map IntSet.fromList [[2,4,7], [7,8], [9]] + g = Set.fromList $ map IntSet.fromList [[7,9], [4,8,9], [2,8,9]] + +prop_GurvichKhachiyan1999_generateCNFAndDNF :: Property +prop_GurvichKhachiyan1999_generateCNFAndDNF = + forAll hyperGraph $ \g -> + let vs = IntSet.unions $ Set.toList g + f xs = any (\is -> not $ IntSet.null $ xs `IntSet.intersection` is) (Set.toList g) + dual f is = not $ f (vs `IntSet.difference` is) + is `isImplicantOf` f = f is + is `isImplicateOf` f = is `isImplicantOf` dual f + is `isPrimeImplicantOf` f = is `isImplicantOf` f && all (\i -> not (IntSet.delete i is `isImplicantOf` f)) (IntSet.toList is) + is `isPrimeImplicateOf` f = is `isImplicateOf` f && all (\i -> not (IntSet.delete i is `isImplicateOf` f)) (IntSet.toList is) + (cnf,dnf) = GurvichKhachiyan1999.generateCNFAndDNF vs f Set.empty Set.empty + in all (`isPrimeImplicantOf` f) (Set.toList dnf) && + all (`isPrimeImplicateOf` f) (Set.toList cnf) + +prop_GurvichKhachiyan1999_minimalHittingSets_duality :: Property +prop_GurvichKhachiyan1999_minimalHittingSets_duality = + forAll hyperGraph $ \g -> + let h = GurvichKhachiyan1999.minimalHittingSets g + in h == GurvichKhachiyan1999.minimalHittingSets (GurvichKhachiyan1999.minimalHittingSets h) + +prop_GurvichKhachiyan1999_minimalHittingSets_isHittingSet :: Property +prop_GurvichKhachiyan1999_minimalHittingSets_isHittingSet = + forAll hyperGraph $ \g -> + all (`isHittingSetOf` g) (GurvichKhachiyan1999.minimalHittingSets g) + +prop_GurvichKhachiyan1999_minimalHittingSets_minimality :: Property +prop_GurvichKhachiyan1999_minimalHittingSets_minimality = + forAll hyperGraph $ \g -> + forAll (elements (Set.toList (GurvichKhachiyan1999.minimalHittingSets g))) $ \s -> + if IntSet.null s then + property True + else + forAll (elements (IntSet.toList s)) $ \v -> + not $ IntSet.delete v s `isHittingSetOf` g + +------------------------------------------------------------------------ +-- Test harness + +hittingSetsTestGroup :: TestTree +hittingSetsTestGroup = $(testGroupGenerator) diff --git a/test/Test/Knapsack.hs b/test/Test/Knapsack.hs new file mode 100644 --- /dev/null +++ b/test/Test/Knapsack.hs @@ -0,0 +1,66 @@ +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-} +module Test.Knapsack (knapsackTestGroup) where + +import Control.Monad +import Test.Tasty +import Test.Tasty.QuickCheck hiding ((.&&.), (.||.)) +import Test.Tasty.HUnit +import Test.Tasty.TH +import qualified ToySolver.Combinatorial.Knapsack.BB as KnapsackBB +import qualified ToySolver.Combinatorial.Knapsack.DPDense as KnapsackDPDense +import qualified ToySolver.Combinatorial.Knapsack.DPSparse as KnapsackDPSparse + +-- --------------------------------------------------------------------- +-- Knapsack problems + +case_knapsack_BB_1 :: Assertion +case_knapsack_BB_1 = KnapsackBB.solve [(5,4), (6,5), (3,2)] 9 @?= (11, 9, [True,True,False]) + +case_knapsack_BB_2 :: Assertion +case_knapsack_BB_2 = KnapsackBB.solve [(16,2), (19,3), (23,4), (28,5)] 7 @?= (44, 7, [True,False,False,True]) + +case_knapsack_DPDense_1 :: Assertion +case_knapsack_DPDense_1 = KnapsackDPDense.solve [(5,4), (6,5), (3,2)] 9 @?= (11, 9, [True,True,False]) + +case_knapsack_DPDense_2 :: Assertion +case_knapsack_DPDense_2 = KnapsackDPDense.solve [(16,2), (19,3), (23,4), (28,5)] 7 @?= (44, 7, [True,False,False,True]) + +prop_knapsack_DPDense_equals_BB :: Property +prop_knapsack_DPDense_equals_BB = + forAll knapsackProblems $ \(items,lim) -> + let items' = [(v, fromIntegral w) | (v,w) <- items] + lim' = fromIntegral lim + (v1,_,_) = KnapsackBB.solve items' lim' + (v2,_,_) = KnapsackDPDense.solve items lim + in v1 == v2 + +case_knapsack_DPSparse_1 :: Assertion +case_knapsack_DPSparse_1 = KnapsackDPSparse.solve [(5::Int,4::Int), (6,5), (3,2)] 9 @?= (11, 9, [True,True,False]) + +case_knapsack_DPSparse_2 :: Assertion +case_knapsack_DPSparse_2 = KnapsackDPSparse.solve [(16::Int,2::Int), (19,3), (23,4), (28,5)] 7 @?= (44, 7, [True,False,False,True]) + +prop_knapsack_DPSparse_equals_BB :: Property +prop_knapsack_DPSparse_equals_BB = + forAll knapsackProblems $ \(items,lim) -> + let -- items' :: Num a => [(Rational, a)] + items' = [(v, fromIntegral w) | (v,w) <- items] + (v1,_,_) = KnapsackBB.solve items' (fromIntegral lim) + (v2,_,_) = KnapsackDPSparse.solve items' (fromIntegral lim) + in v1 == v2 + +knapsackProblems :: Gen ([(KnapsackDPDense.Value, KnapsackDPDense.Weight)], KnapsackDPDense.Weight) +knapsackProblems = do + lim <- choose (0,30) + items <- listOf $ do + v <- liftM abs arbitrary + w <- choose (0,30) + return (v,w) + return (items, lim) + +------------------------------------------------------------------------ +-- Test harness + +knapsackTestGroup :: TestTree +knapsackTestGroup = $(testGroupGenerator) diff --git a/test/Test/LPFile.hs b/test/Test/LPFile.hs new file mode 100644 --- /dev/null +++ b/test/Test/LPFile.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE TemplateHaskell #-} +module Test.LPFile (lpTestGroup) where + +import Control.Monad +import Data.List +import Data.Maybe +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.Tasty.HUnit +import Test.Tasty.TH +import ToySolver.Data.MIP.LPFile + +case_testdata = checkString "testdata" testdata +case_test_indicator = checkFile "samples/lp/test-indicator.lp" +case_test_qcp = checkFile "samples/lp/test-qcp.lp" +case_test_qcp2 = checkFile "samples/lp/test-qcp2.lp" +case_test_qp = checkFile "samples/lp/test-qp.lp" +case_empty_obj_1 = checkFile "samples/lp/empty_obj_1.lp" +case_empty_obj_2 = checkFile "samples/lp/empty_obj_2.lp" + +------------------------------------------------------------------------ +-- Sample data + +testdata :: String +testdata = unlines + [ "Maximize" + , " obj: x1 + 2 x2 + 3 x3 + x4" + , "Subject To" + , " c1: - x1 + x2 + x3 + 10 x4 <= 20" + , " c2: x1 - 3 x2 + x3 <= 30" + , " c3: x2 - 3.5 x4 = 0" + , "Bounds" + , " 0 <= x1 <= 40" + , " 2 <= x4 <= 3" + , "General" + , " x4" + , "End" + ] + +------------------------------------------------------------------------ +-- Utilities + +checkFile :: FilePath -> Assertion +checkFile fname = do + r <- parseFile fname + case r of + Left err -> assertFailure $ show err + Right lp -> + case render lp of + Left err -> assertFailure ("render failure: " ++ err) + Right _ -> return () + +checkString :: String -> String -> Assertion +checkString name str = do + case parseString name str of + Left err -> assertFailure $ show err + Right lp -> + case render lp of + Left err -> assertFailure ("render failure: " ++ err) + Right _ -> return () + +------------------------------------------------------------------------ +-- Test harness + +lpTestGroup :: TestTree +lpTestGroup = $(testGroupGenerator) diff --git a/test/Test/MIPSolver2.hs b/test/Test/MIPSolver2.hs new file mode 100644 --- /dev/null +++ b/test/Test/MIPSolver2.hs @@ -0,0 +1,125 @@ +{-# LANGUAGE TemplateHaskell #-} +module Test.MIPSolver2 (mipSolver2TestGroup) where + +import Control.Monad +import Data.List +import Data.Ratio +import qualified Data.IntMap as IM +import qualified Data.IntSet as IS +import Data.VectorSpace +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.TH +import Text.Printf + +import qualified ToySolver.Data.LA as LA +import qualified ToySolver.Arith.Simplex2 as Simplex2 +import ToySolver.Arith.Simplex2 +import qualified ToySolver.Arith.MIPSolver2 as MIPSolver2 + +------------------------------------------------------------------------ + +example1 :: (OptDir, LA.Expr Rational, [Atom Rational], IS.IntSet) +example1 = (optdir, obj, cs, ivs) + where + optdir = OptMax + x1 = LA.var 1 + x2 = LA.var 2 + x3 = LA.var 3 + x4 = LA.var 4 + obj = x1 ^+^ 2 *^ x2 ^+^ 3 *^ x3 ^+^ x4 + cs = + [ (-1) *^ x1 ^+^ x2 ^+^ x3 ^+^ 10*^x4 .<=. LA.constant 20 + , x1 ^-^ 3 *^ x2 ^+^ x3 .<=. LA.constant 30 + , x2 ^-^ 3.5 *^ x4 .==. LA.constant 0 + , LA.constant 0 .<=. x1 + , x1 .<=. LA.constant 40 + , LA.constant 0 .<=. x2 + , LA.constant 0 .<=. x3 + , LA.constant 2 .<=. x4 + , x4 .<=. LA.constant 3 + ] + ivs = IS.singleton 4 + +case_test1 = do + let (optdir, obj, cs, ivs) = example1 + lp <- Simplex2.newSolver + replicateM 5 (Simplex2.newVar lp) + setOptDir lp optdir + setObj lp obj + mapM_ (Simplex2.assertAtom lp) cs + mip <- MIPSolver2.newSolver lp ivs + ret <- MIPSolver2.optimize mip + + ret @?= Simplex2.Optimum + + Just m <- MIPSolver2.getBestModel mip + forM_ [(1,40),(2,21/2),(3,39/2),(4,3)] $ \(var, val) -> + m IM.! var @?= val + + Just v <- MIPSolver2.getBestValue mip + v @?= 245/2 + +case_test1' = do + let (optdir, obj, cs, ivs) = example1 + lp <- Simplex2.newSolver + replicateM 5 (Simplex2.newVar lp) + setOptDir lp (f optdir) + setObj lp (negateV obj) + mapM_ (Simplex2.assertAtom lp) cs + mip <- MIPSolver2.newSolver lp ivs + ret <- MIPSolver2.optimize mip + + ret @?= Simplex2.Optimum + + Just m <- MIPSolver2.getBestModel mip + forM_ [(1,40),(2,21/2),(3,39/2),(4,3)] $ \(var, val) -> + m IM.! var @?= val + + Just v <- MIPSolver2.getBestValue mip + v @?= -245/2 + + where + f OptMin = OptMax + f OptMax = OptMin + +-- 『数理計画法の基礎』(坂和 正敏) p.109 例 3.8 +example2 = (optdir, obj, cs, ivs) + where + optdir = OptMin + [x1,x2,x3] = map LA.var [1..3] + obj = (-1) *^ x1 ^-^ 3 *^ x2 ^-^ 5 *^ x3 + cs = + [ 3 *^ x1 ^+^ 4 *^ x2 .<=. LA.constant 10 + , 2 *^ x1 ^+^ x2 ^+^ x3 .<=. LA.constant 7 + , 3 *^ x1 ^+^ x2 ^+^ 4 *^ x3 .==. LA.constant 12 + , LA.constant 0 .<=. x1 + , LA.constant 0 .<=. x2 + , LA.constant 0 .<=. x3 + ] + ivs = IS.fromList [1,2] + +case_test2 = do + let (optdir, obj, cs, ivs) = example2 + lp <- Simplex2.newSolver + replicateM 4 (Simplex2.newVar lp) + setOptDir lp optdir + setObj lp obj + mapM_ (Simplex2.assertAtom lp) cs + mip <- MIPSolver2.newSolver lp ivs + ret <- MIPSolver2.optimize mip + + ret @?= Simplex2.Optimum + + Just m <- MIPSolver2.getBestModel mip + forM_ [(1,0),(2,2),(3,5/2)] $ \(var, val) -> + m IM.! var @?= val + + Just v <- MIPSolver2.getBestValue mip + v @?= -37/2 + +------------------------------------------------------------------------ +-- Test harness + +mipSolver2TestGroup :: TestTree +mipSolver2TestGroup = $(testGroupGenerator) diff --git a/test/Test/MPSFile.hs b/test/Test/MPSFile.hs new file mode 100644 --- /dev/null +++ b/test/Test/MPSFile.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE TemplateHaskell #-} +module Test.MPSFile (mpsTestGroup) where + +import Control.Monad +import Data.List +import Data.Maybe +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.Tasty.HUnit +import Test.Tasty.TH +import ToySolver.Data.MIP.MPSFile + +case_testdata = checkString "testdata" testdata +case_example2 = checkFile "samples/mps/example2.mps" +case_ind1 = checkFile "samples/mps/ind1.mps" +case_intvar1 = checkFile "samples/mps/intvar1.mps" +case_intvar2 = checkFile "samples/mps/intvar2.mps" +case_quadobj1 = checkFile "samples/mps/quadobj1.mps" +case_quadobj2 = checkFile "samples/mps/quadobj2.mps" +case_ranges = checkFile "samples/mps/ranges.mps" +case_sos = checkFile "samples/mps/sos.mps" +case_sc = checkFile "samples/mps/sc.mps" + +------------------------------------------------------------------------ +-- Sample data + +testdata :: String +testdata = unlines + [ "NAME example2.mps" + , "ROWS" + , " N obj " + , " L c1 " + , " L c2 " + , "COLUMNS" + , " x1 obj -1 c1 -1" + , " x1 c2 1" + , " x2 obj -2 c1 1" + , " x2 c2 -3" + , " x3 obj -3 c1 1" + , " x3 c2 1" + , "RHS" + , " rhs c1 20 c2 30" + , "BOUNDS" + , " UP BOUND x1 40" + , "ENDATA" + ] + +------------------------------------------------------------------------ +-- Utilities + +checkFile :: FilePath -> Assertion +checkFile fname = do + r <- parseFile fname + case r of + Left err -> assertFailure (show err) + Right lp -> return () + +checkString :: String -> String -> Assertion +checkString name str = do + case parseString name str of + Left err -> assertFailure (show err) + Right lp -> return () + +------------------------------------------------------------------------ +-- Test harness + +mpsTestGroup :: TestTree +mpsTestGroup = $(testGroupGenerator) diff --git a/test/Test/Misc.hs b/test/Test/Misc.hs new file mode 100644 --- /dev/null +++ b/test/Test/Misc.hs @@ -0,0 +1,136 @@ +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-} +module Test.Misc (miscTestGroup) where + +import Control.Monad +import Test.Tasty +import Test.Tasty.QuickCheck hiding ((.&&.), (.||.)) +import Test.Tasty.HUnit +import Test.Tasty.TH +import ToySolver.Data.Boolean +import ToySolver.Data.BoolExpr +import qualified ToySolver.Internal.Data.Vec as Vec +import ToySolver.Internal.Util +import ToySolver.Internal.TextUtil +import qualified ToySolver.Wang as Wang + +case_showRationalAsDecimal :: Assertion +case_showRationalAsDecimal = do + showRationalAsFiniteDecimal 0 @?= Just "0.0" + showRationalAsFiniteDecimal 1 @?= Just "1.0" + showRationalAsFiniteDecimal (-1) @?= Just "-1.0" + showRationalAsFiniteDecimal 0.1 @?= Just "0.1" + showRationalAsFiniteDecimal (-0.1) @?= Just "-0.1" + showRationalAsFiniteDecimal 1.1 @?= Just "1.1" + showRationalAsFiniteDecimal (-1.1) @?= Just "-1.1" + showRationalAsFiniteDecimal (5/4) @?= Just "1.25" + showRationalAsFiniteDecimal (-5/4) @?= Just "-1.25" + showRationalAsFiniteDecimal (4/3) @?= Nothing + showRationalAsFiniteDecimal (-4/3) @?= Nothing + +case_readUnsignedInteger_maxBound_bug :: Assertion +case_readUnsignedInteger_maxBound_bug = + readUnsignedInteger "006666666666666667" @?= 6666666666666667 + +prop_readUnsignedInteger :: Property +prop_readUnsignedInteger = + forAll (choose (0, 2^(128::Int))) $ \i -> + readUnsignedInteger (show i) == i + +-- --------------------------------------------------------------------- +-- Vec + +case_Vec :: Assertion +case_Vec = do + (v::Vec.UVec Int) <- Vec.new + let xs = [0..100] + forM_ xs $ \i -> Vec.push v i + ys <- Vec.getElems v + ys @?= xs + + Vec.resize v 4 + zs <- Vec.getElems v + zs @?= take 4 xs + + Vec.push v 1 + Vec.push v 2 + Vec.push v 3 + + ws <- Vec.getElems v + ws @?= take 4 xs ++ [1,2,3] + + x3 <- Vec.unsafePop v + x3 @?= 3 + s <- Vec.getSize v + s @?= 6 + ws <- Vec.getElems v + ws @?= take 4 xs ++ [1,2] + +case_Vec_clone :: Assertion +case_Vec_clone = do + (v::Vec.UVec Int) <- Vec.new + Vec.push v 0 + v2 <- Vec.clone v + Vec.write v2 0 1 + + a <- Vec.read v 0 + a @?= 0 + + b <- Vec.read v2 0 + b @?= 1 + +-- --------------------------------------------------------------------- +-- Wang + +-- (x1 ∨ x2) ∧ (x1 ∨ ¬x2) ∧ (¬x1 ∨ ¬x2) is satisfiable +-- ¬((x1 ∨ x2) ∧ (x1 ∨ ¬x2) ∧ (¬x1 ∨ ¬x2)) is invalid +case_Wang_1 :: Assertion +case_Wang_1 = + Wang.isValid ([], [phi]) @?= False + where + phi = notB $ andB [x1 .||. x2, x1 .||. notB x2, notB x1 .||. notB x2] + x1, x2 :: BoolExpr Int + x1 = Atom 1 + x2 = Atom 2 + +-- (x1 ∨ x2) ∧ (¬x1 ∨ x2) ∧ (x1 ∨ ¬x2) ∧ (¬x1 ∨ ¬x2) is unsatisfiable +-- ¬((x1 ∨ x2) ∧ (¬x1 ∨ x2) ∧ (x1 ∨ ¬x2) ∧ (¬x1 ∨ ¬x2)) is valid +case_Wang_2 :: Assertion +case_Wang_2 = + Wang.isValid ([], [phi]) @?= True + where + phi = notB $ andB [x1 .||. x2, notB x1 .||. x2, x1 .||. notB x2, notB x1 .||. notB x2] + x1, x2 :: BoolExpr Int + x1 = Atom 1 + x2 = Atom 2 + +case_Wang_EM :: Assertion +case_Wang_EM = + Wang.isValid ([], [phi]) @?= True + where + phi = x1 .||. notB x1 + x1 :: BoolExpr Int + x1 = Atom 1 + +case_Wang_DNE :: Assertion +case_Wang_DNE = + Wang.isValid ([], [phi]) @?= True + where + phi = notB (notB x1) .<=>. x1 + x1 :: BoolExpr Int + x1 = Atom 1 + +case_Wang_Peirces_Law :: Assertion +case_Wang_Peirces_Law = + Wang.isValid ([], [phi]) @?= True + where + phi = ((x1 .=>. x2) .=>. x1) .=>. x1 + x1, x2 :: BoolExpr Int + x1 = Atom 1 + x2 = Atom 2 + +------------------------------------------------------------------------ +-- Test harness + +miscTestGroup :: TestTree +miscTestGroup = $(testGroupGenerator) diff --git a/test/Test/SAT.hs b/test/Test/SAT.hs new file mode 100644 --- /dev/null +++ b/test/Test/SAT.hs @@ -0,0 +1,1671 @@ +{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-} +module Test.SAT (satTestGroup) where + +import Control.Monad +import Data.Array.IArray +import Data.Default.Class +import Data.IORef +import Data.List +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Set (Set) +import qualified Data.Set as Set +import Data.IntMap (IntMap) +import qualified Data.IntMap as IntMap +import Data.IntSet (IntSet) +import qualified Data.IntSet as IntSet +import qualified Data.Traversable as Traversable +import qualified Data.Vector as V +import qualified System.Random.MWC as Rand + +import Test.Tasty +import Test.Tasty.QuickCheck hiding ((.&&.), (.||.)) +import Test.Tasty.HUnit +import Test.Tasty.TH +import qualified Test.QuickCheck.Monadic as QM + +import ToySolver.Data.LBool +import ToySolver.Data.BoolExpr +import ToySolver.Data.Boolean +import qualified ToySolver.SAT as SAT +import qualified ToySolver.SAT.Types as SAT +import ToySolver.SAT.TheorySolver +import qualified ToySolver.SAT.TseitinEncoder as Tseitin +import qualified ToySolver.SAT.MUS as MUS +import qualified ToySolver.SAT.MUS.QuickXplain as QuickXplain +import qualified ToySolver.SAT.MUS.CAMUS as CAMUS +import qualified ToySolver.SAT.MUS.DAA as DAA +import qualified ToySolver.SAT.PBO as PBO +import qualified ToySolver.SAT.PBNLC as PBNLC + +import ToySolver.Data.OrdRel +import qualified ToySolver.Data.LA as LA +import qualified ToySolver.Arith.Simplex2 as Simplex2 +import qualified ToySolver.EUF.EUFSolver as EUF + +allAssignments :: Int -> [SAT.Model] +allAssignments nv = [array (1,nv) (zip [1..nv] xs) | xs <- replicateM nv [True,False]] + +prop_solveCNF :: Property +prop_solveCNF = QM.monadicIO $ do + cnf@(nv,_) <- QM.pick arbitraryCNF + solver <- arbitrarySolver + ret <- QM.run $ solveCNF solver cnf + case ret of + Just m -> QM.assert $ evalCNF m cnf + Nothing -> do + forM_ (allAssignments nv) $ \m -> do + QM.assert $ not (evalCNF m cnf) + +solveCNF :: SAT.Solver -> (Int,[SAT.Clause]) -> IO (Maybe SAT.Model) +solveCNF solver (nv,cs) = do + SAT.newVars_ solver nv + forM_ cs $ \c -> SAT.addClause solver c + ret <- SAT.solve solver + if ret then do + m <- SAT.getModel solver + return (Just m) + else do + return Nothing + +arbitraryCNF :: Gen (Int,[SAT.Clause]) +arbitraryCNF = do + nv <- choose (0,10) + nc <- choose (0,50) + cs <- replicateM nc $ do + len <- choose (0,10) + if nv == 0 then + return [] + else + replicateM len $ choose (-nv, nv) `suchThat` (/= 0) + return (nv, cs) + +evalCNF :: SAT.Model -> (Int,[SAT.Clause]) -> Bool +evalCNF m (_,cs) = all (SAT.evalClause m) cs + + +prop_solvePB :: Property +prop_solvePB = QM.monadicIO $ do + prob@(nv,_) <- QM.pick arbitraryPB + solver <- arbitrarySolver + ret <- QM.run $ solvePB solver prob + case ret of + Just m -> QM.assert $ evalPB m prob + Nothing -> do + forM_ (allAssignments nv) $ \m -> do + QM.assert $ not (evalPB m prob) + +data PBRel = PBRelGE | PBRelEQ | PBRelLE deriving (Eq, Ord, Enum, Bounded, Show) + +instance Arbitrary PBRel where + arbitrary = arbitraryBoundedEnum + +evalPBRel :: Ord a => PBRel -> a -> a -> Bool +evalPBRel PBRelGE = (>=) +evalPBRel PBRelLE = (<=) +evalPBRel PBRelEQ = (==) + +solvePB :: SAT.Solver -> (Int,[(PBRel,SAT.PBLinSum,Integer)]) -> IO (Maybe SAT.Model) +solvePB solver (nv,cs) = do + SAT.newVars_ solver nv + forM_ cs $ \(o,lhs,rhs) -> do + case o of + PBRelGE -> SAT.addPBAtLeast solver lhs rhs + PBRelLE -> SAT.addPBAtMost solver lhs rhs + PBRelEQ -> SAT.addPBExactly solver lhs rhs + ret <- SAT.solve solver + if ret then do + m <- SAT.getModel solver + return (Just m) + else do + return Nothing + +arbitraryPB :: Gen (Int,[(PBRel,SAT.PBLinSum,Integer)]) +arbitraryPB = do + nv <- choose (0,10) + nc <- choose (0,50) + cs <- replicateM nc $ do + rel <- arbitrary + lhs <- arbitraryPBLinSum nv + rhs <- arbitrary + return $ (rel,lhs,rhs) + return (nv, cs) + +arbitraryPBLinSum :: Int -> Gen SAT.PBLinSum +arbitraryPBLinSum nv = do + len <- choose (0,10) + if nv == 0 then + return [] + else + replicateM len $ do + l <- choose (-nv, nv) `suchThat` (/= 0) + c <- arbitrary + return (c,l) + +evalPB :: SAT.Model -> (Int,[(PBRel,SAT.PBLinSum,Integer)]) -> Bool +evalPB m (_,cs) = all (\(o,lhs,rhs) -> evalPBRel o (SAT.evalPBLinSum m lhs) rhs) cs + +prop_optimizePBO :: Property +prop_optimizePBO = QM.monadicIO $ do + prob@(nv,_) <- QM.pick arbitraryPB + obj <- QM.pick $ arbitraryPBLinSum nv + solver <- arbitrarySolver + opt <- arbitraryOptimizer solver obj + ret <- QM.run $ optimizePBO solver opt prob + case ret of + Just (m, v) -> do + QM.assert $ evalPB m prob + QM.assert $ SAT.evalPBLinSum m obj == v + forM_ (allAssignments nv) $ \m2 -> do + QM.assert $ not (evalPB m2 prob) || SAT.evalPBLinSum m obj <= SAT.evalPBLinSum m2 obj + Nothing -> do + forM_ (allAssignments nv) $ \m -> do + QM.assert $ not (evalPB m prob) + +optimizePBO :: SAT.Solver -> PBO.Optimizer -> (Int,[(PBRel,SAT.PBLinSum,Integer)]) -> IO (Maybe (SAT.Model, Integer)) +optimizePBO solver opt (nv,cs) = do + SAT.newVars_ solver nv + forM_ cs $ \(o,lhs,rhs) -> do + case o of + PBRelGE -> SAT.addPBAtLeast solver lhs rhs + PBRelLE -> SAT.addPBAtMost solver lhs rhs + PBRelEQ -> SAT.addPBExactly solver lhs rhs + PBO.optimize opt + PBO.getBestSolution opt + + +prop_solvePBNLC :: Property +prop_solvePBNLC = QM.monadicIO $ do + prob@(nv,_) <- QM.pick arbitraryPBNLC + solver <- arbitrarySolver + ret <- QM.run $ solvePBNLC solver prob + case ret of + Just m -> QM.assert $ evalPBNLC m prob + Nothing -> do + forM_ (allAssignments nv) $ \m -> do + QM.assert $ not (evalPBNLC m prob) + +solvePBNLC :: SAT.Solver -> (Int,[(PBRel,PBNLC.PBSum,Integer)]) -> IO (Maybe SAT.Model) +solvePBNLC solver (nv,cs) = do + SAT.newVars_ solver nv + enc <- Tseitin.newEncoder solver + forM_ cs $ \(o,lhs,rhs) -> do + case o of + PBRelGE -> PBNLC.addPBAtLeast enc lhs rhs + PBRelLE -> PBNLC.addPBAtMost enc lhs rhs + PBRelEQ -> PBNLC.addPBExactly enc lhs rhs + ret <- SAT.solve solver + if ret then do + m <- SAT.getModel solver + return (Just m) + else do + return Nothing + +arbitraryPBNLC :: Gen (Int,[(PBRel,PBNLC.PBSum,Integer)]) +arbitraryPBNLC = do + nv <- choose (0,10) + nc <- choose (0,50) + cs <- replicateM nc $ do + rel <- arbitrary + len <- choose (0,10) + lhs <- + if nv == 0 then + return [] + else + replicateM len $ do + ls <- listOf $ choose (-nv, nv) `suchThat` (/= 0) + c <- arbitrary + return (c,ls) + rhs <- arbitrary + return $ (rel,lhs,rhs) + return (nv, cs) + +evalPBNLC :: SAT.Model -> (Int,[(PBRel,PBNLC.PBSum,Integer)]) -> Bool +evalPBNLC m (_,cs) = all (\(o,lhs,rhs) -> evalPBRel o (PBNLC.evalPBSum m lhs) rhs) cs + + +prop_solveXOR :: Property +prop_solveXOR = QM.monadicIO $ do + prob@(nv,_) <- QM.pick arbitraryXOR + solver <- arbitrarySolver + ret <- QM.run $ solveXOR solver prob + case ret of + Just m -> QM.assert $ evalXOR m prob + Nothing -> do + forM_ (allAssignments nv) $ \m -> do + QM.assert $ not (evalXOR m prob) + +solveXOR :: SAT.Solver -> (Int,[SAT.XORClause]) -> IO (Maybe SAT.Model) +solveXOR solver (nv,cs) = do + SAT.modifyConfig solver $ \config -> config{ SAT.configCheckModel = True } + SAT.newVars_ solver nv + forM_ cs $ \c -> SAT.addXORClause solver (fst c) (snd c) + ret <- SAT.solve solver + if ret then do + m <- SAT.getModel solver + return (Just m) + else do + return Nothing + +arbitraryXOR :: Gen (Int,[SAT.XORClause]) +arbitraryXOR = do + nv <- choose (0,10) + nc <- choose (0,50) + cs <- replicateM nc $ do + len <- choose (0,10) + lhs <- + if nv == 0 then + return [] + else + replicateM len $ choose (-nv, nv) `suchThat` (/= 0) + rhs <- arbitrary + return (lhs,rhs) + return (nv, cs) + +evalXOR :: SAT.Model -> (Int,[SAT.XORClause]) -> Bool +evalXOR m (_,cs) = all (SAT.evalXORClause m) cs + + +newTheorySolver :: (Int, [SAT.Clause]) -> IO TheorySolver +newTheorySolver cnf@(nv,cs) = do + solver <- SAT.newSolver + SAT.newVars_ solver nv + forM_ cs $ \c -> SAT.addClause solver c + + ref <- newIORef [] + let tsolver = + TheorySolver + { thAssertLit = \_ l -> do + if abs l > nv then + return True + else do + m <- readIORef ref + case m of + [] -> SAT.addClause solver [l] + xs : xss -> writeIORef ref ((l : xs) : xss) + return True + , thCheck = \_ -> do + xs <- liftM concat $ readIORef ref + SAT.solveWith solver xs + , thExplain = \m -> do + case m of + Nothing -> SAT.getFailedAssumptions solver + Just _ -> return [] + , thPushBacktrackPoint = modifyIORef ref ([] :) + , thPopBacktrackPoint = modifyIORef ref tail + , thConstructModel = return () + } + return tsolver + +prop_solveCNF_using_BooleanTheory :: Property +prop_solveCNF_using_BooleanTheory = QM.monadicIO $ do + cnf@(nv,cs) <- QM.pick arbitraryCNF + let cnf1 = (nv, [c | (i,c) <- zip [0..] cs, i `mod` 2 == 0]) + cnf2 = (nv, [c | (i,c) <- zip [0..] cs, i `mod` 2 /= 0]) + + solver <- arbitrarySolver + + ret <- QM.run $ do + SAT.newVars_ solver nv + + tsolver <- newTheorySolver cnf1 + SAT.setTheory solver tsolver + + forM_ (snd cnf2) $ \c -> SAT.addClause solver c + ret <- SAT.solve solver + if ret then do + m <- SAT.getModel solver + return (Just m) + else do + return Nothing + + case ret of + Just m -> QM.assert $ evalCNF m cnf + Nothing -> do + forM_ (allAssignments nv) $ \m -> do + QM.assert $ not (evalCNF m cnf) + +case_QF_LRA :: Assertion +case_QF_LRA = do + satSolver <- SAT.newSolver + lraSolver <- Simplex2.newSolver + + tblRef <- newIORef $ Map.empty + defsRef <- newIORef $ IntMap.empty + let abstractLAAtom :: LA.Atom Rational -> IO SAT.Lit + abstractLAAtom atom = do + (v,op,rhs) <- Simplex2.simplifyAtom lraSolver atom + tbl <- readIORef tblRef + (vLt, vEq, vGt) <- + case Map.lookup (v,rhs) tbl of + Just (vLt, vEq, vGt) -> return (vLt, vEq, vGt) + Nothing -> do + vLt <- SAT.newVar satSolver + vEq <- SAT.newVar satSolver + vGt <- SAT.newVar satSolver + SAT.addClause satSolver [vLt,vEq,vGt] + SAT.addClause satSolver [-vLt, -vEq] + SAT.addClause satSolver [-vLt, -vGt] + SAT.addClause satSolver [-vEq, -vGt] + writeIORef tblRef (Map.insert (v,rhs) (vLt, vEq, vGt) tbl) + let xs = IntMap.fromList + [ (vEq, LA.var v .==. LA.constant rhs) + , (vLt, LA.var v .<. LA.constant rhs) + , (vGt, LA.var v .>. LA.constant rhs) + , (-vLt, LA.var v .>=. LA.constant rhs) + , (-vGt, LA.var v .<=. LA.constant rhs) + ] + modifyIORef defsRef (IntMap.union xs) + return (vLt, vEq, vGt) + case op of + Lt -> return vLt + Gt -> return vGt + Eql -> return vEq + Le -> return (-vGt) + Ge -> return (-vLt) + NEq -> return (-vEq) + + abstract :: BoolExpr (Either SAT.Lit (LA.Atom Rational)) -> IO (BoolExpr SAT.Lit) + abstract = Traversable.mapM f + where + f (Left lit) = return lit + f (Right atom) = abstractLAAtom atom + + let tsolver = + TheorySolver + { thAssertLit = \_ l -> do + defs <- readIORef defsRef + case IntMap.lookup l defs of + Nothing -> return True + Just atom -> do + Simplex2.assertAtomEx' lraSolver atom (Just l) + return True + , thCheck = \_ -> do + Simplex2.check lraSolver + , thExplain = \m -> do + case m of + Nothing -> liftM IntSet.toList $ Simplex2.explain lraSolver + Just _ -> return [] + , thPushBacktrackPoint = do + Simplex2.pushBacktrackPoint lraSolver + , thPopBacktrackPoint = do + Simplex2.popBacktrackPoint lraSolver + , thConstructModel = do + return () + } + SAT.setTheory satSolver tsolver + + enc <- Tseitin.newEncoder satSolver + let addFormula :: BoolExpr (Either SAT.Lit (LA.Atom Rational)) -> IO () + addFormula c = Tseitin.addFormula enc =<< abstract c + + a <- SAT.newVar satSolver + x <- Simplex2.newVar lraSolver + y <- Simplex2.newVar lraSolver + + let le1 = LA.fromTerms [(2,x), (1/3,y)] .<=. LA.constant (-4) -- 2 x + (1/3) y <= -4 + eq2 = LA.fromTerms [(1.5,x)] .==. LA.fromTerms [(-2,x)] -- 1.5 y = -2 x + gt3 = LA.var x .>. LA.var y -- x > y + lt4 = LA.fromTerms [(3,x)] .<. LA.fromTerms [(-1,LA.unitVar), (1/5,x), (1/5,y)] -- 3 x < -1 + (1/5) (x + y) + + c1, c2 :: BoolExpr (Either SAT.Lit (LA.Atom Rational)) + c1 = ite (Atom (Left a) :: BoolExpr (Either SAT.Lit (LA.Atom Rational))) (Atom $ Right le1) (Atom $ Right eq2) + c2 = Atom (Right gt3) .||. (Atom (Left a) .<=>. Atom (Right lt4)) + + addFormula c1 + addFormula c2 + + ret <- SAT.solve satSolver + ret @?= True + + m1 <- SAT.getModel satSolver + m2 <- Simplex2.getModel lraSolver + defs <- readIORef defsRef + let f (Left lit) = SAT.evalLit m1 lit + f (Right atom) = LA.evalAtom m2 atom + fold f c1 @?= True + fold f c2 @?= True + + +case_QF_EUF :: Assertion +case_QF_EUF = do + satSolver <- SAT.newSolver + eufSolver <- EUF.newSolver + enc <- Tseitin.newEncoder satSolver + + tblRef <- newIORef (Map.empty :: Map (EUF.Term, EUF.Term) SAT.Var) + defsRef <- newIORef (IntMap.empty :: IntMap (EUF.Term, EUF.Term)) + eufModelRef <- newIORef (undefined :: EUF.Model) + + let abstractEUFAtom :: (EUF.Term, EUF.Term) -> IO SAT.Lit + abstractEUFAtom (t1,t2) | t1 >= t2 = abstractEUFAtom (t2,t1) + abstractEUFAtom (t1,t2) = do + tbl <- readIORef tblRef + case Map.lookup (t1,t2) tbl of + Just v -> return v + Nothing -> do + v <- SAT.newVar satSolver + writeIORef tblRef $! Map.insert (t1,t2) v tbl + modifyIORef' defsRef $! IntMap.insert v (t1,t2) + return v + + abstract :: BoolExpr (Either SAT.Lit (EUF.Term, EUF.Term)) -> IO (BoolExpr SAT.Lit) + abstract = Traversable.mapM f + where + f (Left lit) = return lit + f (Right atom) = abstractEUFAtom atom + + let tsolver = + TheorySolver + { thAssertLit = \_ l -> do + defs <- readIORef defsRef + case IntMap.lookup (SAT.litVar l) defs of + Nothing -> return True + Just (t1,t2) -> do + if SAT.litPolarity l then + EUF.assertEqual' eufSolver t1 t2 (Just l) + else + EUF.assertNotEqual' eufSolver t1 t2 (Just l) + return True + , thCheck = \callback -> do + b <- EUF.check eufSolver + when b $ do + defs <- readIORef defsRef + forM_ (IntMap.toList defs) $ \(v, (t1, t2)) -> do + b2 <- EUF.areEqual eufSolver t1 t2 + when b2 $ do + callback v + return () + return b + , thExplain = \m -> do + case m of + Nothing -> liftM IntSet.toList $ EUF.explain eufSolver Nothing + Just v -> do + defs <- readIORef defsRef + case IntMap.lookup v defs of + Nothing -> error "should not happen" + Just (t1,t2) -> do + liftM IntSet.toList $ EUF.explain eufSolver (Just (t1,t2)) + , thPushBacktrackPoint = do + EUF.pushBacktrackPoint eufSolver + , thPopBacktrackPoint = do + EUF.popBacktrackPoint eufSolver + , thConstructModel = do + writeIORef eufModelRef =<< EUF.getModel eufSolver + return () + } + SAT.setTheory satSolver tsolver + + true <- EUF.newConst eufSolver + false <- EUF.newConst eufSolver + EUF.assertNotEqual eufSolver true false + boolToTermRef <- newIORef (IntMap.empty :: IntMap EUF.Term) + termToBoolRef <- newIORef (Map.empty :: Map EUF.Term SAT.Lit) + + let connectBoolTerm :: SAT.Lit -> EUF.Term -> IO () + connectBoolTerm lit t = do + lit1 <- abstractEUFAtom (t, true) + lit2 <- abstractEUFAtom (t, false) + SAT.addClause satSolver [-lit, lit1] -- lit -> lit1 + SAT.addClause satSolver [-lit1, lit] -- lit1 -> lit + SAT.addClause satSolver [lit, lit2] -- -lit -> lit2 + SAT.addClause satSolver [-lit2, -lit] -- lit2 -> -lit + modifyIORef' boolToTermRef $ IntMap.insert lit t + modifyIORef' termToBoolRef $ Map.insert t lit + + boolToTerm :: SAT.Lit -> IO EUF.Term + boolToTerm lit = do + tbl <- readIORef boolToTermRef + case IntMap.lookup lit tbl of + Just t -> return t + Nothing -> do + t <- EUF.newConst eufSolver + connectBoolTerm lit t + return t + + termToBool :: EUF.Term -> IO SAT.Lit + termToBool t = do + tbl <- readIORef termToBoolRef + case Map.lookup t tbl of + Just lit -> return lit + Nothing -> do + lit <- SAT.newVar satSolver + connectBoolTerm lit t + return lit + + let addFormula :: BoolExpr (Either SAT.Lit (EUF.Term, EUF.Term)) -> IO () + addFormula c = Tseitin.addFormula enc =<< abstract c + + do + x <- SAT.newVar satSolver + x' <- boolToTerm x + f <- EUF.newFun eufSolver + fx <- termToBool (f x') + ftt <- abstractEUFAtom (f true, true) + ret <- SAT.solveWith satSolver [-fx, ftt] + ret @?= True + + m1 <- SAT.getModel satSolver + m2 <- readIORef eufModelRef + let e (Left lit) = SAT.evalLit m1 lit + e (Right (lhs,rhs)) = EUF.eval m2 lhs == EUF.eval m2 rhs + fold e (notB (Atom (Left fx)) .||. (Atom (Right (f true, true)))) @?= True + SAT.evalLit m1 x @?= False + + ret <- SAT.solveWith satSolver [-fx, ftt, x] + ret @?= False + + do + -- a : Bool + -- f : U -> U + -- x : U + -- y : U + -- (a or x=y) + -- f x /= f y + a <- SAT.newVar satSolver + f <- EUF.newFun eufSolver + x <- EUF.newConst eufSolver + y <- EUF.newConst eufSolver + let c1, c2 :: BoolExpr (Either SAT.Lit (EUF.Term, EUF.Term)) + c1 = Atom (Left a) .||. Atom (Right (x,y)) + c2 = notB $ Atom (Right (f x, f y)) + addFormula c1 + addFormula c2 + ret <- SAT.solve satSolver + ret @?= True + m1 <- SAT.getModel satSolver + m2 <- readIORef eufModelRef + let e (Left lit) = SAT.evalLit m1 lit + e (Right (lhs,rhs)) = EUF.eval m2 lhs == EUF.eval m2 rhs + fold e c1 @?= True + fold e c2 @?= True + + ret <- SAT.solveWith satSolver [-a] + ret @?= False + +-- should be SAT +case_solve_SAT :: Assertion +case_solve_SAT = do + solver <- SAT.newSolver + x1 <- SAT.newVar solver + x2 <- SAT.newVar solver + SAT.addClause solver [x1, x2] -- x1 or x2 + SAT.addClause solver [x1, -x2] -- x1 or not x2 + SAT.addClause solver [-x1, -x2] -- not x1 or not x2 + ret <- SAT.solve solver + ret @?= True + +-- shuld be UNSAT +case_solve_UNSAT :: Assertion +case_solve_UNSAT = do + solver <- SAT.newSolver + x1 <- SAT.newVar solver + x2 <- SAT.newVar solver + SAT.addClause solver [x1, x2] -- x1 or x2 + SAT.addClause solver [-x1, x2] -- not x1 or x2 + SAT.addClause solver [x1, -x2] -- x1 or not x2 + SAT.addClause solver [-x1, -x2] -- not x2 or not x2 + ret <- SAT.solve solver + ret @?= False + +-- top level でいきなり矛盾 +case_root_inconsistent :: Assertion +case_root_inconsistent = do + solver <- SAT.newSolver + x1 <- SAT.newVar solver + SAT.addClause solver [x1] + SAT.addClause solver [-x1] + ret <- SAT.solve solver -- unsat + ret @?= False + +-- incremental に制約を追加 +case_incremental_solving :: Assertion +case_incremental_solving = do + solver <- SAT.newSolver + x1 <- SAT.newVar solver + x2 <- SAT.newVar solver + SAT.addClause solver [x1, x2] -- x1 or x2 + SAT.addClause solver [x1, -x2] -- x1 or not x2 + SAT.addClause solver [-x1, -x2] -- not x1 or not x2 + ret <- SAT.solve solver -- sat + ret @?= True + + SAT.addClause solver [-x1, x2] -- not x1 or x2 + ret <- SAT.solve solver -- unsat + ret @?= False + +-- 制約なし +case_empty_constraint :: Assertion +case_empty_constraint = do + solver <- SAT.newSolver + ret <- SAT.solve solver + ret @?= True + +-- 空の節 +case_empty_claue :: Assertion +case_empty_claue = do + solver <- SAT.newSolver + SAT.addClause solver [] + ret <- SAT.solve solver + ret @?= False + +-- 自明に真な節 +case_excluded_middle_claue :: Assertion +case_excluded_middle_claue = do + solver <- SAT.newSolver + x1 <- SAT.newVar solver + SAT.addClause solver [x1, -x1] -- x1 or not x1 + ret <- SAT.solve solver + ret @?= True + +-- 冗長な節 +case_redundant_clause :: Assertion +case_redundant_clause = do + solver <- SAT.newSolver + x1 <- SAT.newVar solver + SAT.addClause solver [x1,x1] -- x1 or x1 + ret <- SAT.solve solver + ret @?= True + +case_instantiateClause :: Assertion +case_instantiateClause = do + solver <- SAT.newSolver + x1 <- SAT.newVar solver + x2 <- SAT.newVar solver + SAT.addClause solver [x1] + SAT.addClause solver [x1,x2] + SAT.addClause solver [-x1,x2] + ret <- SAT.solve solver + ret @?= True + +case_instantiateAtLeast :: Assertion +case_instantiateAtLeast = do + solver <- SAT.newSolver + x1 <- SAT.newVar solver + x2 <- SAT.newVar solver + x3 <- SAT.newVar solver + x4 <- SAT.newVar solver + SAT.addClause solver [x1] + + SAT.addAtLeast solver [x1,x2,x3,x4] 2 + ret <- SAT.solve solver + ret @?= True + + SAT.addAtLeast solver [-x1,-x2,-x3,-x4] 2 + ret <- SAT.solve solver + ret @?= True + +case_inconsistent_AtLeast :: Assertion +case_inconsistent_AtLeast = do + solver <- SAT.newSolver + x1 <- SAT.newVar solver + x2 <- SAT.newVar solver + SAT.addAtLeast solver [x1,x2] 3 + ret <- SAT.solve solver -- unsat + ret @?= False + +case_trivial_AtLeast :: Assertion +case_trivial_AtLeast = do + solver <- SAT.newSolver + x1 <- SAT.newVar solver + x2 <- SAT.newVar solver + SAT.addAtLeast solver [x1,x2] 0 + ret <- SAT.solve solver + ret @?= True + + solver <- SAT.newSolver + x1 <- SAT.newVar solver + x2 <- SAT.newVar solver + SAT.addAtLeast solver [x1,x2] (-1) + ret <- SAT.solve solver + ret @?= True + +case_AtLeast_1 :: Assertion +case_AtLeast_1 = do + solver <- SAT.newSolver + x1 <- SAT.newVar solver + x2 <- SAT.newVar solver + x3 <- SAT.newVar solver + SAT.addAtLeast solver [x1,x2,x3] 2 + SAT.addAtLeast solver [-x1,-x2,-x3] 2 + ret <- SAT.solve solver -- unsat + ret @?= False + +case_AtLeast_2 :: Assertion +case_AtLeast_2 = do + solver <- SAT.newSolver + x1 <- SAT.newVar solver + x2 <- SAT.newVar solver + x3 <- SAT.newVar solver + x4 <- SAT.newVar solver + SAT.addAtLeast solver [x1,x2,x3,x4] 2 + SAT.addClause solver [-x1,-x2] + SAT.addClause solver [-x1,-x3] + ret <- SAT.solve solver + ret @?= True + +case_AtLeast_3 :: Assertion +case_AtLeast_3 = do + forM_ [(-1) .. 3] $ \n -> do + solver <- SAT.newSolver + x1 <- SAT.newVar solver + x2 <- SAT.newVar solver + SAT.addAtLeast solver [x1,x2] n + ret <- SAT.solve solver + assertEqual ("case_AtLeast3_" ++ show n) (n <= 2) ret + +-- from http://www.cril.univ-artois.fr/PB11/format.pdf +case_PB_sample1 :: Assertion +case_PB_sample1 = do + solver <- SAT.newSolver + + x1 <- SAT.newVar solver + x2 <- SAT.newVar solver + x3 <- SAT.newVar solver + x4 <- SAT.newVar solver + x5 <- SAT.newVar solver + + SAT.addPBAtLeast solver [(1,x1),(4,x2),(-2,x5)] 2 + SAT.addPBAtLeast solver [(-1,x1),(4,x2),(-2,x5)] 3 + SAT.addPBAtLeast solver [(12345678901234567890,x4),(4,x3)] 10 + SAT.addPBExactly solver [(2,x2),(3,x4),(2,x1),(3,x5)] 5 + + ret <- SAT.solve solver + ret @?= True + +-- 一部の変数を否定に置き換えたもの +case_PB_sample1' :: Assertion +case_PB_sample1' = do + solver <- SAT.newSolver + + x1 <- SAT.newVar solver + x2 <- SAT.newVar solver + x3 <- SAT.newVar solver + x4 <- SAT.newVar solver + x5 <- SAT.newVar solver + + SAT.addPBAtLeast solver [(1,x1),(4,-x2),(-2,x5)] 2 + SAT.addPBAtLeast solver [(-1,x1),(4,-x2),(-2,x5)] 3 + SAT.addPBAtLeast solver [(12345678901234567890,-x4),(4,x3)] 10 + SAT.addPBExactly solver [(2,-x2),(3,-x4),(2,x1),(3,x5)] 5 + + ret <- SAT.solve solver + ret @?= True + +-- いきなり矛盾したPB制約 +case_root_inconsistent_PB :: Assertion +case_root_inconsistent_PB = do + solver <- SAT.newSolver + x1 <- SAT.newVar solver + x2 <- SAT.newVar solver + SAT.addPBAtLeast solver [(2,x1),(3,x2)] 6 + ret <- SAT.solve solver + ret @?= False + +case_pb_propagate :: Assertion +case_pb_propagate = do + solver <- SAT.newSolver + x1 <- SAT.newVar solver + x2 <- SAT.newVar solver + SAT.addPBAtLeast solver [(1,x1),(3,x2)] 3 + SAT.addClause solver [-x1] + ret <- SAT.solve solver + ret @?= True + +case_solveWith_1 :: Assertion +case_solveWith_1 = do + solver <- SAT.newSolver + x1 <- SAT.newVar solver + x2 <- SAT.newVar solver + x3 <- SAT.newVar solver + SAT.addClause solver [x1, x2] -- x1 or x2 + SAT.addClause solver [x1, -x2] -- x1 or not x2 + SAT.addClause solver [-x1, -x2] -- not x1 or not x2 + SAT.addClause solver [-x3, -x1, x2] -- not x3 or not x1 or x2 + + ret <- SAT.solve solver -- sat + ret @?= True + + ret <- SAT.solveWith solver [x3] -- unsat + ret @?= False + + ret <- SAT.solve solver -- sat + ret @?= True + +case_solveWith_2 :: Assertion +case_solveWith_2 = do + solver <- SAT.newSolver + x1 <- SAT.newVar solver + x2 <- SAT.newVar solver + SAT.addClause solver [-x1, x2] -- -x1 or x2 + SAT.addClause solver [x1] -- x1 + + ret <- SAT.solveWith solver [x2] + ret @?= True + + ret <- SAT.solveWith solver [-x2] + ret @?= False + +case_getVarFixed :: Assertion +case_getVarFixed = do + solver <- SAT.newSolver + x1 <- SAT.newVar solver + x2 <- SAT.newVar solver + SAT.addClause solver [x1,x2] + + ret <- SAT.getVarFixed solver x1 + ret @?= lUndef + + SAT.addClause solver [-x1] + + ret <- SAT.getVarFixed solver x1 + ret @?= lFalse + + ret <- SAT.getLitFixed solver (-x1) + ret @?= lTrue + + ret <- SAT.getLitFixed solver x2 + ret @?= lTrue + +case_getAssumptionsImplications_case1 :: Assertion +case_getAssumptionsImplications_case1 = do + solver <- SAT.newSolver + x1 <- SAT.newVar solver + x2 <- SAT.newVar solver + x3 <- SAT.newVar solver + SAT.addClause solver [x1,x2,x3] + + SAT.addClause solver [-x1] + ret <- SAT.solveWith solver [-x2] + ret @?= True + xs <- SAT.getAssumptionsImplications solver + xs @?= [x3] + +prop_getAssumptionsImplications :: Property +prop_getAssumptionsImplications = QM.monadicIO $ do + cnf@(nv,cs) <- QM.pick arbitraryCNF + solver <- arbitrarySolver + ls <- QM.pick $ liftM concat $ mapM (\v -> elements [[],[-v],[v]]) [1..nv] + ret <- QM.run $ do + SAT.newVars_ solver nv + forM_ cs $ \c -> SAT.addClause solver c + SAT.solveWith solver ls + when ret $ do + xs <- QM.run $ SAT.getAssumptionsImplications solver + forM_ xs $ \x -> do + ret2 <- QM.run $ SAT.solveWith solver (-x : ls) + QM.assert $ not ret2 + +------------------------------------------------------------------------ + +-- -4*(not x1) + 3*x1 + 10*(not x2) +-- = -4*(1 - x1) + 3*x1 + 10*(not x2) +-- = -4 + 4*x1 + 3*x1 + 10*(not x2) +-- = 7*x1 + 10*(not x2) - 4 +case_normalizePBLinSum_1 :: Assertion +case_normalizePBLinSum_1 = do + sort e @?= sort [(7,x1),(10,-x2)] + c @?= -4 + where + x1 = 1 + x2 = 2 + (e,c) = SAT.normalizePBLinSum ([(-4,-x1),(3,x1),(10,-x2)], 0) + +prop_normalizePBLinSum :: Property +prop_normalizePBLinSum = forAll g $ \(nv, (s,n)) -> + let (s2,n2) = SAT.normalizePBLinSum (s,n) + in flip all (allAssignments nv) $ \m -> + SAT.evalPBLinSum m s + n == SAT.evalPBLinSum m s2 + n2 + where + g :: Gen (Int, (SAT.PBLinSum, Integer)) + g = do + nv <- choose (0, 10) + s <- forM [1..nv] $ \x -> do + c <- arbitrary + p <- arbitrary + return (c, SAT.literal x p) + n <- arbitrary + return (nv, (s,n)) + +-- -4*(not x1) + 3*x1 + 10*(not x2) >= 3 +-- ⇔ -4*(1 - x1) + 3*x1 + 10*(not x2) >= 3 +-- ⇔ -4 + 4*x1 + 3*x1 + 10*(not x2) >= 3 +-- ⇔ 7*x1 + 10*(not x2) >= 7 +-- ⇔ 7*x1 + 7*(not x2) >= 7 +-- ⇔ x1 + (not x2) >= 1 +case_normalizePBLinAtLeast_1 :: Assertion +case_normalizePBLinAtLeast_1 = (sort lhs, rhs) @?= (sort [(1,x1),(1,-x2)], 1) + where + x1 = 1 + x2 = 2 + (lhs,rhs) = SAT.normalizePBLinAtLeast ([(-4,-x1),(3,x1),(10,-x2)], 3) + +prop_normalizePBLinAtLeast :: Property +prop_normalizePBLinAtLeast = forAll g $ \(nv, c) -> + let c2 = SAT.normalizePBLinAtLeast c + in flip all (allAssignments nv) $ \m -> + SAT.evalPBLinAtLeast m c == SAT.evalPBLinAtLeast m c2 + where + g :: Gen (Int, SAT.PBLinAtLeast) + g = do + nv <- choose (0, 10) + lhs <- forM [1..nv] $ \x -> do + c <- arbitrary + p <- arbitrary + return (c, SAT.literal x p) + rhs <- arbitrary + return (nv, (lhs,rhs)) + +case_normalizePBLinExactly_1 :: Assertion +case_normalizePBLinExactly_1 = (sort lhs, rhs) @?= ([], 1) + where + x1 = 1 + x2 = 2 + (lhs,rhs) = SAT.normalizePBLinExactly ([(6,x1),(4,x2)], 2) + +case_normalizePBLinExactly_2 :: Assertion +case_normalizePBLinExactly_2 = (sort lhs, rhs) @?= ([], 1) + where + x1 = 1 + x2 = 2 + x3 = 3 + (lhs,rhs) = SAT.normalizePBLinExactly ([(2,x1),(2,x2),(2,x3)], 3) + +prop_normalizePBLinExactly :: Property +prop_normalizePBLinExactly = forAll g $ \(nv, c) -> + let c2 = SAT.normalizePBLinExactly c + in flip all (allAssignments nv) $ \m -> + SAT.evalPBLinExactly m c == SAT.evalPBLinExactly m c2 + where + g :: Gen (Int, SAT.PBLinExactly) + g = do + nv <- choose (0, 10) + lhs <- forM [1..nv] $ \x -> do + c <- arbitrary + p <- arbitrary + return (c, SAT.literal x p) + rhs <- arbitrary + return (nv, (lhs,rhs)) + +prop_cutResolve :: Property +prop_cutResolve = + forAll (choose (1, 10)) $ \nv -> + forAll (g nv True) $ \c1 -> + forAll (g nv False) $ \c2 -> + let c3 = SAT.cutResolve c1 c2 1 + in flip all (allAssignments nv) $ \m -> + not (SAT.evalPBLinExactly m c1 && SAT.evalPBLinExactly m c2) || SAT.evalPBLinExactly m c3 + where + g :: Int -> Bool -> Gen SAT.PBLinExactly + g nv b = do + lhs <- forM [1..nv] $ \x -> do + if x==1 then do + c <- liftM ((1+) . abs) arbitrary + return (c, SAT.literal x b) + else do + c <- arbitrary + p <- arbitrary + return (c, SAT.literal x p) + rhs <- arbitrary + return (lhs, rhs) + +case_cutResolve_1 :: Assertion +case_cutResolve_1 = (sort lhs, rhs) @?= (sort [(1,x3),(1,x4)], 1) + where + x1 = 1 + x2 = 2 + x3 = 3 + x4 = 4 + pb1 = ([(1,x1), (1,x2), (1,x3)], 1) + pb2 = ([(2,-x1), (2,-x2), (1,x4)], 3) + (lhs,rhs) = SAT.cutResolve pb1 pb2 x1 + +case_cutResolve_2 :: Assertion +case_cutResolve_2 = (sort lhs, rhs) @?= (sort lhs2, rhs2) + where + x1 = 1 + x2 = 2 + x3 = 3 + x4 = 4 + pb1 = ([(3,x1), (2,-x2), (1,x3), (1,x4)], 3) + pb2 = ([(1,-x3), (1,x4)], 1) + (lhs,rhs) = SAT.cutResolve pb1 pb2 x3 + (lhs2,rhs2) = ([(2,x1),(1,-x2),(1,x4)],2) -- ([(3,x1),(2,-x2),(2,x4)], 3) + +case_cardinalityReduction :: Assertion +case_cardinalityReduction = (sort lhs, rhs) @?= ([1,2,3,4,5],4) + where + (lhs, rhs) = SAT.cardinalityReduction ([(6,1),(5,2),(4,3),(3,4),(2,5),(1,6)], 17) + +case_pbSubsume_clause :: Assertion +case_pbSubsume_clause = SAT.pbSubsume ([(1,1),(1,-3)],1) ([(1,1),(1,2),(1,-3),(1,4)],1) @?= True + +case_pbSubsume_1 :: Assertion +case_pbSubsume_1 = SAT.pbSubsume ([(1,1),(1,2),(1,-3)],2) ([(1,1),(2,2),(1,-3),(1,4)],1) @?= True + +case_pbSubsume_2 :: Assertion +case_pbSubsume_2 = SAT.pbSubsume ([(1,1),(1,2),(1,-3)],2) ([(1,1),(2,2),(1,-3),(1,4)],3) @?= False + +------------------------------------------------------------------------ + +case_normalizeXORClause_False = + SAT.normalizeXORClause ([],True) @?= ([],True) + +case_normalizeXORClause_True = + SAT.normalizeXORClause ([],False) @?= ([],False) + +-- x ⊕ y ⊕ x = y +case_normalizeXORClause_case1 = + SAT.normalizeXORClause ([1,2,1],True) @?= ([2],True) + +-- x ⊕ ¬x = x ⊕ x ⊕ 1 = 1 +case_normalizeXORClause_case2 = + SAT.normalizeXORClause ([1,-1],True) @?= ([],False) + +prop_normalizeXORClause :: Property +prop_normalizeXORClause = forAll g $ \(nv, c) -> + let c2 = SAT.normalizeXORClause c + in flip all (allAssignments nv) $ \m -> + SAT.evalXORClause m c == SAT.evalXORClause m c2 + where + g :: Gen (Int, SAT.XORClause) + g = do + nv <- choose (0, 10) + len <- choose (0, nv) + lhs <- replicateM len $ choose (-nv, nv) `suchThat` (/= 0) + rhs <- arbitrary + return (nv, (lhs,rhs)) + +case_evalXORClause_case1 = + SAT.evalXORClause (array (1,2) [(1,True),(2,True)] :: Array Int Bool) ([1,2], True) @?= False + +case_evalXORClause_case2 = + SAT.evalXORClause (array (1,2) [(1,False),(2,True)] :: Array Int Bool) ([1,2], True) @?= True + +case_xor_case1 = do + solver <- SAT.newSolver + SAT.modifyConfig solver $ \config -> config{ SAT.configCheckModel = True } + x1 <- SAT.newVar solver + x2 <- SAT.newVar solver + x3 <- SAT.newVar solver + SAT.addXORClause solver [x1, x2] True -- x1 ⊕ x2 = True + SAT.addXORClause solver [x2, x3] True -- x2 ⊕ x3 = True + SAT.addXORClause solver [x3, x1] True -- x3 ⊕ x1 = True + ret <- SAT.solve solver + ret @?= False + +case_xor_case2 = do + solver <- SAT.newSolver + SAT.modifyConfig solver $ \config -> config{ SAT.configCheckModel = True } + x1 <- SAT.newVar solver + x2 <- SAT.newVar solver + x3 <- SAT.newVar solver + SAT.addXORClause solver [x1, x2] True -- x1 ⊕ x2 = True + SAT.addXORClause solver [x1, x3] True -- x1 ⊕ x3 = True + SAT.addClause solver [x2] + + ret <- SAT.solve solver + ret @?= True + m <- SAT.getModel solver + m ! x1 @?= False + m ! x2 @?= True + m ! x3 @?= True + +case_xor_case3 = do + solver <- SAT.newSolver + SAT.modifyConfig solver $ \config -> config{ SAT.configCheckModel = True } + x1 <- SAT.newVar solver + x2 <- SAT.newVar solver + x3 <- SAT.newVar solver + x4 <- SAT.newVar solver + SAT.addXORClause solver [x1,x2,x3,x4] True + SAT.addAtLeast solver [x1,x2,x3,x4] 2 + ret <- SAT.solve solver + ret @?= True + +------------------------------------------------------------------------ + +-- from "Pueblo: A Hybrid Pseudo-Boolean SAT Solver" +-- clauseがunitになるレベルで、PB制約が違反状態のままという例。 +case_hybridLearning_1 :: Assertion +case_hybridLearning_1 = do + solver <- SAT.newSolver + [x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11] <- replicateM 11 (SAT.newVar solver) + + SAT.addClause solver [x11, x10, x9] -- C1 + SAT.addClause solver [x8, x7, x6] -- C2 + SAT.addClause solver [x5, x4, x3] -- C3 + SAT.addAtLeast solver [-x2, -x5, -x8, -x11] 3 -- C4 + SAT.addAtLeast solver [-x1, -x4, -x7, -x10] 3 -- C5 + + replicateM 3 (SAT.varBumpActivity solver x3) + SAT.setVarPolarity solver x3 False + + replicateM 2 (SAT.varBumpActivity solver x6) + SAT.setVarPolarity solver x6 False + + replicateM 1 (SAT.varBumpActivity solver x9) + SAT.setVarPolarity solver x9 False + + SAT.setVarPolarity solver x1 True + + SAT.modifyConfig solver $ \config -> config{ SAT.configLearningStrategy = SAT.LearningHybrid } + ret <- SAT.solve solver + ret @?= True + +-- from "Pueblo: A Hybrid Pseudo-Boolean SAT Solver" +-- clauseがunitになるレベルで、PB制約が違反状態のままという例。 +-- さらに、学習したPB制約はunitにはならない。 +case_hybridLearning_2 :: Assertion +case_hybridLearning_2 = do + solver <- SAT.newSolver + [x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12] <- replicateM 12 (SAT.newVar solver) + + SAT.addClause solver [x11, x10, x9] -- C1 + SAT.addClause solver [x8, x7, x6] -- C2 + SAT.addClause solver [x5, x4, x3] -- C3 + SAT.addAtLeast solver [-x2, -x5, -x8, -x11] 3 -- C4 + SAT.addAtLeast solver [-x1, -x4, -x7, -x10] 3 -- C5 + + SAT.addClause solver [x12, -x3] + SAT.addClause solver [x12, -x6] + SAT.addClause solver [x12, -x9] + + SAT.varBumpActivity solver x12 + SAT.setVarPolarity solver x12 False + + SAT.modifyConfig solver $ \config -> config{ SAT.configLearningStrategy = SAT.LearningHybrid } + ret <- SAT.solve solver + ret @?= True + +-- regression test for the bug triggered by normalized-blast-floppy1-8.ucl.opb.bz2 +case_addPBAtLeast_regression :: Assertion +case_addPBAtLeast_regression = do + solver <- SAT.newSolver + [x1,x2,x3,x4] <- replicateM 4 (SAT.newVar solver) + SAT.addClause solver [-x1] + SAT.addClause solver [-x2, -x3] + SAT.addClause solver [-x2, -x4] + SAT.addPBAtLeast solver [(1,x1),(2,x2),(1,x3),(1,x4)] 3 + ret <- SAT.solve solver + ret @?= False + +------------------------------------------------------------------------ + +case_addFormula = do + solver <- SAT.newSolver + enc <- Tseitin.newEncoder solver + + [x1,x2,x3,x4,x5] <- replicateM 5 $ liftM Atom $ SAT.newVar solver + Tseitin.addFormula enc $ orB [x1 .=>. x3 .&&. x4, x2 .=>. x3 .&&. x5] + -- x6 = x3 ∧ x4 + -- x7 = x3 ∧ x5 + Tseitin.addFormula enc $ x1 .||. x2 + Tseitin.addFormula enc $ x4 .=>. notB x5 + ret <- SAT.solve solver + ret @?= True + + Tseitin.addFormula enc $ x2 .<=>. x4 + ret <- SAT.solve solver + ret @?= True + + Tseitin.addFormula enc $ x1 .<=>. x5 + ret <- SAT.solve solver + ret @?= True + + Tseitin.addFormula enc $ notB x1 .=>. x3 .&&. x5 + ret <- SAT.solve solver + ret @?= True + + Tseitin.addFormula enc $ notB x2 .=>. x3 .&&. x4 + ret <- SAT.solve solver + ret @?= False + +case_addFormula_Peirces_Law = do + solver <- SAT.newSolver + enc <- Tseitin.newEncoder solver + [x1,x2] <- replicateM 2 $ liftM Atom $ SAT.newVar solver + Tseitin.addFormula enc $ notB $ ((x1 .=>. x2) .=>. x1) .=>. x1 + ret <- SAT.solve solver + ret @?= False + +case_encodeConj = do + solver <- SAT.newSolver + enc <- Tseitin.newEncoder solver + x1 <- SAT.newVar solver + x2 <- SAT.newVar solver + x3 <- Tseitin.encodeConj enc [x1,x2] + + ret <- SAT.solveWith solver [x3] + ret @?= True + m <- SAT.getModel solver + SAT.evalLit m x1 @?= True + SAT.evalLit m x2 @?= True + SAT.evalLit m x3 @?= True + + ret <- SAT.solveWith solver [-x3] + ret @?= True + m <- SAT.getModel solver + (SAT.evalLit m x1 && SAT.evalLit m x2) @?= False + SAT.evalLit m x3 @?= False + +case_encodeDisj = do + solver <- SAT.newSolver + enc <- Tseitin.newEncoder solver + x1 <- SAT.newVar solver + x2 <- SAT.newVar solver + x3 <- Tseitin.encodeDisj enc [x1,x2] + + ret <- SAT.solveWith solver [x3] + ret @?= True + m <- SAT.getModel solver + (SAT.evalLit m x1 || SAT.evalLit m x2) @?= True + SAT.evalLit m x3 @?= True + + ret <- SAT.solveWith solver [-x3] + ret @?= True + m <- SAT.getModel solver + SAT.evalLit m x1 @?= False + SAT.evalLit m x2 @?= False + SAT.evalLit m x3 @?= False + +case_evalFormula = do + solver <- SAT.newSolver + xs <- SAT.newVars solver 5 + let f = (x1 .=>. x3 .&&. x4) .||. (x2 .=>. x3 .&&. x5) + where + [x1,x2,x3,x4,x5] = map Atom xs + g :: SAT.Model -> Bool + g m = (not x1 || (x3 && x4)) || (not x2 || (x3 && x5)) + where + [x1,x2,x3,x4,x5] = elems m + let ms :: [SAT.Model] + ms = liftM (array (1,5)) $ sequence [[(x,val) | val <- [False,True]] | x <- xs] + forM_ ms $ \m -> do + Tseitin.evalFormula m f @?= g m + +------------------------------------------------------------------------ + +case_MUS = do + solver <- SAT.newSolver + [x1,x2,x3] <- SAT.newVars solver 3 + sels@[y1,y2,y3,y4,y5,y6] <- SAT.newVars solver 6 + SAT.addClause solver [-y1, x1] + SAT.addClause solver [-y2, -x1] + SAT.addClause solver [-y3, -x1, x2] + SAT.addClause solver [-y4, -x2] + SAT.addClause solver [-y5, -x1, x3] + SAT.addClause solver [-y6, -x3] + + ret <- SAT.solveWith solver sels + ret @?= False + + actual <- MUS.findMUSAssumptions solver def + let actual' = IntSet.map (\x -> x-3) actual + expected = map IntSet.fromList [[1, 2], [1, 3, 4], [1, 5, 6]] + actual' `elem` expected @?= True + +case_MUS_QuickXplain = do + solver <- SAT.newSolver + [x1,x2,x3] <- SAT.newVars solver 3 + sels@[y1,y2,y3,y4,y5,y6] <- SAT.newVars solver 6 + SAT.addClause solver [-y1, x1] + SAT.addClause solver [-y2, -x1] + SAT.addClause solver [-y3, -x1, x2] + SAT.addClause solver [-y4, -x2] + SAT.addClause solver [-y5, -x1, x3] + SAT.addClause solver [-y6, -x3] + + ret <- SAT.solveWith solver sels + ret @?= False + + actual <- QuickXplain.findMUSAssumptions solver def + let actual' = IntSet.map (\x -> x-3) actual + expected = map IntSet.fromList [[1, 2], [1, 3, 4], [1, 5, 6]] + actual' `elem` expected @?= True + +------------------------------------------------------------------------ + +{- +c http://sun.iwu.edu/~mliffito/publications/jar_liffiton_CAMUS.pdf +c φ= (x1) ∧ (¬x1) ∧ (¬x1∨x2) ∧ (¬x2) ∧ (¬x1∨x3) ∧ (¬x3) +c MUSes(φ) = {{C1, C2}, {C1, C3, C4}, {C1, C5, C6}} +c MCSes(φ) = {{C1}, {C2, C3, C5}, {C2, C3, C6}, {C2, C4, C5}, {C2, C4, C6}} +p cnf 3 6 +1 0 +-1 0 +-1 2 0 +-2 0 +-1 3 0 +-3 0 +-} + +case_camus_allMCSAssumptions = do + solver <- SAT.newSolver + [x1,x2,x3] <- SAT.newVars solver 3 + sels@[y1,y2,y3,y4,y5,y6] <- SAT.newVars solver 6 + SAT.addClause solver [-y1, x1] + SAT.addClause solver [-y2, -x1] + SAT.addClause solver [-y3, -x1, x2] + SAT.addClause solver [-y4, -x2] + SAT.addClause solver [-y5, -x1, x3] + SAT.addClause solver [-y6, -x3] + actual <- CAMUS.allMCSAssumptions solver sels def + let actual' = Set.fromList actual + expected = map (IntSet.fromList . map (+3)) [[1], [2,3,5], [2,3,6], [2,4,5], [2,4,6]] + expected' = Set.fromList expected + actual' @?= expected' + +case_DAA_allMCSAssumptions = do + solver <- SAT.newSolver + [x1,x2,x3] <- SAT.newVars solver 3 + sels@[y1,y2,y3,y4,y5,y6] <- SAT.newVars solver 6 + SAT.addClause solver [-y1, x1] + SAT.addClause solver [-y2, -x1] + SAT.addClause solver [-y3, -x1, x2] + SAT.addClause solver [-y4, -x2] + SAT.addClause solver [-y5, -x1, x3] + SAT.addClause solver [-y6, -x3] + actual <- DAA.allMCSAssumptions solver sels def + let actual' = Set.fromList $ actual + expected = map (IntSet.fromList . map (+3)) [[1], [2,3,5], [2,3,6], [2,4,5], [2,4,6]] + expected' = Set.fromList $ expected + actual' @?= expected' + +case_camus_allMUSAssumptions = do + solver <- SAT.newSolver + [x1,x2,x3] <- SAT.newVars solver 3 + sels@[y1,y2,y3,y4,y5,y6] <- SAT.newVars solver 6 + SAT.addClause solver [-y1, x1] + SAT.addClause solver [-y2, -x1] + SAT.addClause solver [-y3, -x1, x2] + SAT.addClause solver [-y4, -x2] + SAT.addClause solver [-y5, -x1, x3] + SAT.addClause solver [-y6, -x3] + actual <- CAMUS.allMUSAssumptions solver sels def + let actual' = Set.fromList $ actual + expected = map (IntSet.fromList . map (+3)) [[1,2], [1,3,4], [1,5,6]] + expected' = Set.fromList $ expected + actual' @?= expected' + +case_DAA_allMUSAssumptions = do + solver <- SAT.newSolver + [x1,x2,x3] <- SAT.newVars solver 3 + sels@[y1,y2,y3,y4,y5,y6] <- SAT.newVars solver 6 + SAT.addClause solver [-y1, x1] + SAT.addClause solver [-y2, -x1] + SAT.addClause solver [-y3, -x1, x2] + SAT.addClause solver [-y4, -x2] + SAT.addClause solver [-y5, -x1, x3] + SAT.addClause solver [-y6, -x3] + actual <- DAA.allMUSAssumptions solver sels def + let actual' = Set.fromList $ actual + expected = map (IntSet.fromList . map (+3)) [[1,2], [1,3,4], [1,5,6]] + expected' = Set.fromList $ expected + actual' @?= expected' + +{- +Boosting a Complete Technique to Find MSS and MUS thanks to a Local Search Oracle +http://www.cril.univ-artois.fr/~piette/IJCAI07_HYCAM.pdf +Example 3. +C0 : (d) +C1 : (b ∨ c) +C2 : (a ∨ b) +C3 : (a ∨ ¬c) +C4 : (¬b ∨ ¬e) +C5 : (¬a ∨ ¬b) +C6 : (a ∨ e) +C7 : (¬a ∨ ¬e) +C8 : (b ∨ e) +C9 : (¬a ∨ b ∨ ¬c) +C10 : (¬a ∨ b ∨ ¬d) +C11 : (a ∨ ¬b ∨ c) +C12 : (a ∨ ¬b ∨ ¬d) +-} +case_camus_allMUSAssumptions_2 = do + solver <- SAT.newSolver + [a,b,c,d,e] <- SAT.newVars solver 5 + sels@[y0,y1,y2,y3,y4,y5,y6,y7,y8,y9,y10,y11,y12] <- SAT.newVars solver 13 + SAT.addClause solver [-y0, d] + SAT.addClause solver [-y1, b, c] + SAT.addClause solver [-y2, a, b] + SAT.addClause solver [-y3, a, -c] + SAT.addClause solver [-y4, -b, -e] + SAT.addClause solver [-y5, -a, -b] + SAT.addClause solver [-y6, a, e] + SAT.addClause solver [-y7, -a, -e] + SAT.addClause solver [-y8, b, e] + SAT.addClause solver [-y9, -a, b, -c] + SAT.addClause solver [-y10, -a, b, -d] + SAT.addClause solver [-y11, a, -b, c] + SAT.addClause solver [-y12, a, -b, -d] + + -- Only three of the MUSes (marked with asterisks) are on the paper. + let cores = + [ [y0,y1,y2,y5,y9,y12] + , [y0,y1,y3,y4,y5,y6,y10] + , [y0,y1,y3,y5,y7,y8,y12] + , [y0,y1,y3,y5,y9,y12] + , [y0,y1,y3,y5,y10,y11] + , [y0,y1,y3,y5,y10,y12] + , [y0,y2,y3,y5,y10,y11] + , [y0,y2,y4,y5,y6,y10] + , [y0,y2,y5,y7,y8,y12] + , [y0,y2,y5,y10,y12] -- (*) + , [y1,y2,y4,y5,y6,y9] + , [y1,y3,y4,y5,y6,y7,y8] + , [y1,y3,y4,y5,y6,y9] + , [y1,y3,y5,y7,y8,y11] + , [y1,y3,y5,y9,y11] -- (*) + , [y2,y3,y5,y7,y8,y11] + , [y2,y4,y5,y6,y7,y8] -- (*) + ] + + let remove1 :: [a] -> [[a]] + remove1 [] = [] + remove1 (x:xs) = xs : [x : ys | ys <- remove1 xs] + forM_ cores $ \core -> do + ret <- SAT.solveWith solver core + assertBool (show core ++ " should be a core") (not ret) + forM (remove1 core) $ \xs -> do + ret <- SAT.solveWith solver xs + assertBool (show core ++ " should be satisfiable") ret + + actual <- CAMUS.allMUSAssumptions solver sels def + let actual' = Set.fromList actual + expected' = Set.fromList $ map IntSet.fromList $ cores + actual' @?= expected' + +case_HYCAM_allMUSAssumptions = do + solver <- SAT.newSolver + [a,b,c,d,e] <- SAT.newVars solver 5 + sels@[y0,y1,y2,y3,y4,y5,y6,y7,y8,y9,y10,y11,y12] <- SAT.newVars solver 13 + SAT.addClause solver [-y0, d] + SAT.addClause solver [-y1, b, c] + SAT.addClause solver [-y2, a, b] + SAT.addClause solver [-y3, a, -c] + SAT.addClause solver [-y4, -b, -e] + SAT.addClause solver [-y5, -a, -b] + SAT.addClause solver [-y6, a, e] + SAT.addClause solver [-y7, -a, -e] + SAT.addClause solver [-y8, b, e] + SAT.addClause solver [-y9, -a, b, -c] + SAT.addClause solver [-y10, -a, b, -d] + SAT.addClause solver [-y11, a, -b, c] + SAT.addClause solver [-y12, a, -b, -d] + + -- Only three of the MUSes (marked with asterisks) are on the paper. + let cores = + [ [y0,y1,y2,y5,y9,y12] + , [y0,y1,y3,y4,y5,y6,y10] + , [y0,y1,y3,y5,y7,y8,y12] + , [y0,y1,y3,y5,y9,y12] + , [y0,y1,y3,y5,y10,y11] + , [y0,y1,y3,y5,y10,y12] + , [y0,y2,y3,y5,y10,y11] + , [y0,y2,y4,y5,y6,y10] + , [y0,y2,y5,y7,y8,y12] + , [y0,y2,y5,y10,y12] -- (*) + , [y1,y2,y4,y5,y6,y9] + , [y1,y3,y4,y5,y6,y7,y8] + , [y1,y3,y4,y5,y6,y9] + , [y1,y3,y5,y7,y8,y11] + , [y1,y3,y5,y9,y11] -- (*) + , [y2,y3,y5,y7,y8,y11] + , [y2,y4,y5,y6,y7,y8] -- (*) + ] + mcses = + [ [y0,y1,y7] + , [y0,y1,y8] + , [y0,y3,y4] + , [y0,y3,y6] + , [y0,y4,y11] + , [y0,y6,y11] + , [y0,y7,y9] + , [y0,y8,y9] + , [y1,y2] + , [y1,y7,y10] + , [y1,y8,y10] + , [y2,y3] + , [y3,y4,y12] + , [y3,y6,y12] + , [y4,y11,y12] + , [y5] + , [y6,y11,y12] + , [y7,y9,y10] + , [y8,y9,y10] + ] + + -- HYCAM paper wrongly treated {C3,C8,C10} as a candidate MCS (CoMSS). + -- Its complement {C0,C1,C2,C4,C5,C6,C7,C9,C11,C12} is unsatisfiable + -- and hence not MSS. + ret <- SAT.solveWith solver [y0,y1,y2,y4,y5,y6,y7,y9,y11,y12] + assertBool "failed to prove the bug of HYCAM paper" (not ret) + + let cand = map IntSet.fromList [[y5], [y3,y2], [y0,y1,y2]] + actual <- CAMUS.allMUSAssumptions solver sels def{ CAMUS.optKnownCSes = cand } + let actual' = Set.fromList $ actual + expected' = Set.fromList $ map IntSet.fromList cores + actual' @?= expected' + +case_DAA_allMUSAssumptions_2 = do + solver <- SAT.newSolver + [a,b,c,d,e] <- SAT.newVars solver 5 + sels@[y0,y1,y2,y3,y4,y5,y6,y7,y8,y9,y10,y11,y12] <- SAT.newVars solver 13 + SAT.addClause solver [-y0, d] + SAT.addClause solver [-y1, b, c] + SAT.addClause solver [-y2, a, b] + SAT.addClause solver [-y3, a, -c] + SAT.addClause solver [-y4, -b, -e] + SAT.addClause solver [-y5, -a, -b] + SAT.addClause solver [-y6, a, e] + SAT.addClause solver [-y7, -a, -e] + SAT.addClause solver [-y8, b, e] + SAT.addClause solver [-y9, -a, b, -c] + SAT.addClause solver [-y10, -a, b, -d] + SAT.addClause solver [-y11, a, -b, c] + SAT.addClause solver [-y12, a, -b, -d] + + -- Only three of the MUSes (marked with asterisks) are on the paper. + let cores = + [ [y0,y1,y2,y5,y9,y12] + , [y0,y1,y3,y4,y5,y6,y10] + , [y0,y1,y3,y5,y7,y8,y12] + , [y0,y1,y3,y5,y9,y12] + , [y0,y1,y3,y5,y10,y11] + , [y0,y1,y3,y5,y10,y12] + , [y0,y2,y3,y5,y10,y11] + , [y0,y2,y4,y5,y6,y10] + , [y0,y2,y5,y7,y8,y12] + , [y0,y2,y5,y10,y12] -- (*) + , [y1,y2,y4,y5,y6,y9] + , [y1,y3,y4,y5,y6,y7,y8] + , [y1,y3,y4,y5,y6,y9] + , [y1,y3,y5,y7,y8,y11] + , [y1,y3,y5,y9,y11] -- (*) + , [y2,y3,y5,y7,y8,y11] + , [y2,y4,y5,y6,y7,y8] -- (*) + ] + + let remove1 :: [a] -> [[a]] + remove1 [] = [] + remove1 (x:xs) = xs : [x : ys | ys <- remove1 xs] + forM_ cores $ \core -> do + ret <- SAT.solveWith solver core + assertBool (show core ++ " should be a core") (not ret) + forM (remove1 core) $ \xs -> do + ret <- SAT.solveWith solver xs + assertBool (show core ++ " should be satisfiable") ret + + actual <- DAA.allMUSAssumptions solver sels def + let actual' = Set.fromList actual + expected' = Set.fromList $ map IntSet.fromList cores + actual' @?= expected' + +------------------------------------------------------------------------ + +instance Arbitrary SAT.LearningStrategy where + arbitrary = arbitraryBoundedEnum + +instance Arbitrary SAT.RestartStrategy where + arbitrary = arbitraryBoundedEnum + +instance Arbitrary SAT.PBHandlerType where + arbitrary = arbitraryBoundedEnum + +instance Arbitrary SAT.Config where + arbitrary = do + restartStrategy <- arbitrary + restartFirst <- arbitrary + restartInc <- liftM ((1.01 +) . abs) arbitrary + learningStrategy <- arbitrary + learntSizeFirst <- arbitrary + learntSizeInc <- liftM ((1.01 +) . abs) arbitrary + pbhandler <- arbitrary + ccmin <- choose (0,2) + phaseSaving <- arbitrary + forwardSubsumptionRemoval <- arbitrary + backwardSubsumptionRemoval <- arbitrary + randomFreq <- choose (0,1) + splitClausePart <- arbitrary + return $ def + { SAT.configRestartStrategy = restartStrategy + , SAT.configRestartFirst = restartFirst + , SAT.configRestartInc = restartInc + , SAT.configLearningStrategy = learningStrategy + , SAT.configLearntSizeFirst = learntSizeFirst + , SAT.configLearntSizeInc = learntSizeInc + , SAT.configPBHandlerType = pbhandler + , SAT.configCCMin = ccmin + , SAT.configEnablePhaseSaving = phaseSaving + , SAT.configEnableForwardSubsumptionRemoval = forwardSubsumptionRemoval + , SAT.configEnableBackwardSubsumptionRemoval = backwardSubsumptionRemoval + , SAT.configRandomFreq = randomFreq + , SAT.configEnablePBSplitClausePart = splitClausePart + } + +arbitrarySolver :: QM.PropertyM IO SAT.Solver +arbitrarySolver = do + seed <- QM.pick arbitrary + config <- QM.pick arbitrary + QM.run $ do + solver <- SAT.newSolverWithConfig config{ SAT.configCheckModel = True } + SAT.setRandomGen solver =<< Rand.initialize (V.singleton seed) + return solver + +arbitraryOptimizer :: SAT.Solver -> SAT.PBLinSum -> QM.PropertyM IO PBO.Optimizer +arbitraryOptimizer solver obj = do + strategy <- QM.pick arbitrary + QM.run $ do + opt <- PBO.newOptimizer solver obj + PBO.setSearchStrategy opt strategy + return opt + +instance Arbitrary PBO.SearchStrategy where + arbitrary = arbitraryBoundedEnum + +------------------------------------------------------------------------ +-- Test harness + +satTestGroup :: TestTree +satTestGroup = $(testGroupGenerator) diff --git a/test/Test/SDPFile.hs b/test/Test/SDPFile.hs new file mode 100644 --- /dev/null +++ b/test/Test/SDPFile.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE TemplateHaskell #-} +module Test.SDPFile (sdpTestGroup) where + +import Control.Monad +import Data.List +import Data.Maybe +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.Tasty.HUnit +import Test.Tasty.TH +import ToySolver.Text.SDPFile + +------------------------------------------------------------------------ +-- Sample data + +example1 :: Problem +example1 + = Problem + { blockStruct = [2] + , costs = [48, -8, 20] + , matrices = map denseMatrix [f0,f1,f2,f3] + } + where + f0 = [[[-11,0], [0,23]]] + f1 = [[[10,4], [4,0]]] + f2 = [[[0,0], [0,-8]]] + f3 = [[[0,-8], [-8,-2]]] + +example2 :: Problem +example2 + = Problem + { blockStruct = [2,3,-2] + , costs = [1.1, -10, 6.6, 19, 4.1] + , matrices = map denseMatrix [f0,f1,f5] + } + where + f0 = [ [[-1.4, -3.2], [-3.2, -28]] + , [[15, -12, 2.1], [-12, 16, -3.8], [2.1, -3.8, 15]] + , [[1.8, 0], [0, -4.0]] + ] + f1 = [ [[0.5, 5.2], [5.2,-5.3]] + , [[7.8, -2.4, 6.0], [-2.4, 4.2, 6.5], [6.0, 6.5, 2.1]] + , [[-4.5, 0], [0, -3.5]] + ] + f5 = [ [[-6.5, -5.4], [-5.4, -6.6]] + , [[6.7, -7.2, -3.6], [-7.2, 7.3, -3.0], [-3.6, -3.0, -1.4]] + , [[6.1, 0],[0, -1.5]] + ] + +case_test1 = checkParsed example1b example1 + where + s = render example1 "" + example1b = parseDataString "" s + +case_test2 = checkParsed example1b example1 + where + s = renderSparse example1 "" + example1b = parseSparseDataString "" s + +case_test3 = checkParsed example2b example2 + where + s = render example2 "" + example2b = parseDataString "" s + +case_test4 = checkParsed example2b example2 + where + s = renderSparse example2 "" + example2b = parseSparseDataString "" s + +-- checkParsed :: Either ParseError Problem -> Problem -> Assertion +checkParsed actual expected = + case actual of + Left err -> assertFailure $ show err + Right prob -> prob @?= expected + +------------------------------------------------------------------------ +-- Test harness + +sdpTestGroup :: TestTree +sdpTestGroup = $(testGroupGenerator) diff --git a/test/Test/SMT.hs b/test/Test/SMT.hs new file mode 100644 --- /dev/null +++ b/test/Test/SMT.hs @@ -0,0 +1,340 @@ +{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-} +module Test.SMT (smtTestGroup) where + +import Control.Applicative((<$>)) +import Control.Exception (evaluate) +import Control.Monad +import Control.Monad.State.Strict +import Data.Map (Map) +import qualified Data.Map as Map + +import Test.Tasty +import Test.Tasty.QuickCheck hiding ((.&&.), (.||.)) +import Test.Tasty.HUnit +import Test.Tasty.TH +import qualified Test.QuickCheck.Monadic as QM + +import ToySolver.Data.Boolean +import ToySolver.Data.OrdRel +import ToySolver.SMT (Expr (..)) +import qualified ToySolver.SMT as SMT + +-- ------------------------------------------------------------------- + +case_QF_LRA :: Assertion +case_QF_LRA = do + solver <- SMT.newSolver + + a <- SMT.declareConst solver "a" SMT.sBool + x <- SMT.declareConst solver "x" SMT.sReal + y <- SMT.declareConst solver "y" SMT.sReal + let c1 = ite a (2*x + (1/3)*y .<=. -4) (1.5 * y .==. -2*x) + c2 = (x .>. y) .||. (a .<=>. (3*x .<. -1 + (1/5)*(x + y))) + SMT.assert solver c1 + SMT.assert solver c2 + + ret <- SMT.checkSAT solver + ret @?= True + + m <- SMT.getModel solver + SMT.eval m c1 @?= SMT.ValBool True + SMT.eval m c2 @?= SMT.ValBool True + +case_QF_EUF_1 :: Assertion +case_QF_EUF_1 = do + solver <- SMT.newSolver + x <- SMT.declareConst solver "x" SMT.sBool + f <- SMT.declareFun solver "f" [SMT.sBool] SMT.sBool + + let c1 = f true .==. true + c2 = notB (f x) + SMT.assert solver c1 + SMT.assert solver c2 + ret <- SMT.checkSAT solver + ret @?= True + + m <- SMT.getModel solver + SMT.eval m c1 @?= SMT.ValBool True + SMT.eval m c2 @?= SMT.ValBool True + + SMT.assert solver $ x + ret <- SMT.checkSAT solver + ret @?= False + +case_QF_EUF_2 :: Assertion +case_QF_EUF_2 = do + solver <- SMT.newSolver + sU <- SMT.declareSort solver "U" 0 + + a <- SMT.declareConst solver "a" SMT.sBool + x <- SMT.declareConst solver "x" sU + y <- SMT.declareConst solver "y" sU + f <- SMT.declareFun solver "f" [sU] sU + + let c1 = a .||. (x .==. y) + c2 = f x ./=. f y + SMT.assert solver c1 + SMT.assert solver c2 + ret <- SMT.checkSAT solver + ret @?= True + + m <- SMT.getModel solver + SMT.eval m c1 @?= SMT.ValBool True + SMT.eval m c2 @?= SMT.ValBool True + + SMT.assert solver $ notB a + ret <- SMT.checkSAT solver + ret @?= False + +case_QF_EUF_LRA :: Assertion +case_QF_EUF_LRA = do + solver <- SMT.newSolver + a <- SMT.declareConst solver "a" SMT.sReal + b <- SMT.declareConst solver "b" SMT.sReal + c <- SMT.declareConst solver "c" SMT.sReal + f <- SMT.declareFun solver "f" [SMT.sReal] SMT.sReal + g <- SMT.declareFun solver "g" [SMT.sReal] SMT.sReal + h <- SMT.declareFun solver "h" [SMT.sReal, SMT.sReal] SMT.sReal + + let cs = + [ 2*a .>=. b + f (g c) + , f b .==. c + , f c .==. a + , g a .<. h a a + , g b .>. h c b + ] + mapM_ (SMT.assert solver) cs + + ret <- SMT.checkSAT solver + ret @?= True + m <- SMT.getModel solver + forM_ cs $ \c -> do + SMT.eval m c @?= SMT.ValBool True + + SMT.assert solver $ b .==. c + ret <- SMT.checkSAT solver + ret @?= False + +case_QF_EUF_Bool :: Assertion +case_QF_EUF_Bool = do + solver <- SMT.newSolver + a <- SMT.declareConst solver "a" SMT.sBool + b <- SMT.declareConst solver "b" SMT.sBool + c <- SMT.declareConst solver "c" SMT.sBool + f <- SMT.declareFun solver "f" [SMT.sBool] SMT.sBool + g <- SMT.declareFun solver "g" [SMT.sBool] SMT.sBool + h <- SMT.declareFun solver "h" [SMT.sBool, SMT.sBool] SMT.sBool + + let cs = + [ f b .==. c + , f c .==. a + , g a .==. h a a + , g b ./=. h c b + ] + mapM_ (SMT.assert solver) cs + + ret <- SMT.checkSAT solver + ret @?= True + m <- SMT.getModel solver + forM_ cs $ \c -> do + SMT.eval m c @?= SMT.ValBool True + + SMT.assert solver $ b .==. c + ret <- SMT.checkSAT solver + ret @?= False + +case_push :: Assertion +case_push = do + solver <- SMT.newSolver + sU <- SMT.declareSort solver "U" 0 + + x <- SMT.declareConst solver "x" sU + y <- SMT.declareConst solver "y" sU + f <- SMT.declareFun solver "f" [sU] sU + + SMT.assert solver $ f x ./=. f y + ret <- SMT.checkSAT solver + ret @?= True + + SMT.push solver + SMT.assert solver $ x .==. y + ret <- SMT.checkSAT solver + ret @?= False + SMT.pop solver + + ret <- SMT.checkSAT solver + ret @?= True + +case_QF_LRA_division_by_zero :: Assertion +case_QF_LRA_division_by_zero = do + solver <- SMT.newSolver + + x1 <- SMT.declareConst solver "x1" SMT.sReal + x2 <- SMT.declareConst solver "x2" SMT.sReal + let y1 = x1 / 0 + y2 = x2 / 0 + + ret <- SMT.checkSAT solver + ret @?= True + m <- SMT.getModel solver + evaluate $ SMT.eval m y1 + evaluate $ SMT.eval m y2 + + SMT.assert solver $ y1 ./=. y2 + ret <- SMT.checkSAT solver + ret @?= True + m <- SMT.getModel solver + + SMT.assert solver $ x1 .==. x2 + ret <- SMT.checkSAT solver + ret @?= False + +case_LRA_model_construction_bug :: Assertion +case_LRA_model_construction_bug = do + solver <- SMT.newSolver + cond <- SMT.declareConst solver "cond" SMT.sBool + a <- SMT.declareConst solver "a" SMT.sReal + b <- SMT.declareConst solver "b" SMT.sReal + let cs = [ a .<. 10 + , b .<. 10 + , cond .=>. a+b .>. 14 + , cond .=>. a+b .<. 15 + ] + forM_ cs $ SMT.assert solver + ret <- SMT.checkSATAssuming solver [cond] + m <- SMT.getModel solver + forM_ cs $ \c -> do + let val = SMT.eval m c + -- unless (val == SMT.ValBool True) $ print val + val @?= SMT.ValBool True +{- +The solving process goes like the following. + + ASSERT: a <= 10 - delta + ASSERT: b <= 10 - delta + PUSH + ASSERT a+b <= 15 - delta + ASSERT a+b >= 14 + delta + +This produces assignment + + a+b = 14 + delta + a = 10 - delta + b = (a+b) - a = (14 + delta) - (10 - delta) = 4 + 2 delta + +OR alternatively + + a+b = 14 + delta + b = 10 - delta + a = (a+b) - b = (14 + delta) - (10 - delta) = 4 + 2 delta. + +The delta value should be in the range (0, min{(15-14)/2, (10-4)/3}] = (0, 1/2] +to satisfy the constraints. But if we were compute it after backtracking, the +range of delta becomes (0, (10-4)/3] = (0,2] and choosing delta=2 causes +violation of a+b < 15. +-} + +prop_getModel_eval :: Property +prop_getModel_eval = QM.monadicIO $ do + solver <- QM.run $ SMT.newSolver + + nsorts <- QM.pick $ choose ((0::Int), 3) + xs <- QM.run $ forM [(1::Int)..nsorts] $ \i -> do + s <- SMT.declareSort solver ("U" ++ show i) 0 + c <- SMT.declareFSym solver ("U" ++ show i ++ "const") [] s + return (s, (c, ([],s))) + let sorts = [SMT.sBool, SMT.sReal] ++ map fst xs + cs = map snd xs + fs1 <- QM.pick $ do + ts <- listOf (genFunType sorts) + return [("f" ++ show i, t) | (i,t) <- zip [1..] ts] + fs2 <- QM.run $ forM fs1 $ \(name, t@(argsSorts, resultSort)) -> do + f <- SMT.declareFSym solver name argsSorts resultSort + return (f, t) + + let sig = [("ite", ([SMT.sBool,s,s], s)) | s <- sorts] + ++ [("=", ([s,s], SMT.sBool)) | s <- sorts] + ++ [ ("true", ([], SMT.sBool)) + , ("and", ([SMT.sBool,SMT.sBool], SMT.sBool)) + , ("or", ([SMT.sBool,SMT.sBool], SMT.sBool)) + , ("not", ([SMT.sBool], SMT.sBool)) + , ("=>", ([SMT.sBool,SMT.sBool], SMT.sBool)) + , ("+", ([SMT.sReal,SMT.sReal], SMT.sReal)) + , ("-", ([SMT.sReal,SMT.sReal], SMT.sReal)) + , ("*", ([SMT.sReal,SMT.sReal], SMT.sReal)) + , ("/", ([SMT.sReal,SMT.sReal], SMT.sReal)) + , ("-", ([SMT.sReal], SMT.sReal)) + , (">=", ([SMT.sReal, SMT.sReal], SMT.sBool)) + , ("<=", ([SMT.sReal, SMT.sReal], SMT.sBool)) + , (">", ([SMT.sReal, SMT.sReal], SMT.sBool)) + , ("<", ([SMT.sReal, SMT.sReal], SMT.sBool)) + ] + ++ fs2 ++ cs + + constrs <- QM.pick $ do + nconstrs <- choose ((0::Int), 3) + replicateM nconstrs (genExpr sig SMT.sBool 10) + ret <- QM.run $ do + forM_ constrs $ \constr -> SMT.assert solver constr + SMT.checkSAT solver + when ret $ do + m <- QM.run $ SMT.getModel solver + forM_ constrs $ \constr -> do + QM.assert $ SMT.eval m constr == SMT.ValBool True + +genFunType :: [SMT.Sort] -> Gen SMT.FunType +genFunType sorts = do + resultSort <- elements sorts + argsSorts <- listOf $ elements sorts + return (argsSorts, resultSort) + +genExpr :: [(SMT.FSym, SMT.FunType)] -> SMT.Sort -> Int -> Gen SMT.Expr +genExpr sig s size = evalStateT (f s) size + where + sig' :: Map SMT.Sort [(SMT.FSym, [SMT.Sort])] + sig' = Map.fromListWith (++) [(resultSort, [(fsym, argsSorts)]) | (fsym, (argsSorts,resultSort)) <- sig] + + f :: SMT.Sort -> StateT Int Gen SMT.Expr + f s | s == SMT.sReal = do + modify (subtract 1) + size <- get + (e,size') <- lift $ oneof $ + [ do + r <- arbitrary + return (fromRational r, size - 1) + ] + ++ + [ flip runStateT size $ do + arg1 <- f SMT.sReal + arg2 <- lift $ fromRational <$> arbitrary + lift $ elements [ arg1 * arg2, arg2 * arg1, arg1 / arg2 ] + | size >= 2 + ] + ++ + [ flip runStateT size $ do + args <- mapM f argsSorts + return $ EAp op args + | (op, argsSorts) <- Map.findWithDefault [] s sig' + , op /= "*" && op /= "/" + , size >= length argsSorts || null argsSorts + ] + put size' + return e + f s = do + modify (subtract 1) + size <- get + (e,size') <- lift $ oneof $ + [ flip runStateT size $ do + args <- mapM f argsSorts + return $ EAp op args + | (op, argsSorts) <- Map.findWithDefault [] s sig' + , size >= length argsSorts || null argsSorts + ] + put size' + return e + +------------------------------------------------------------------------ +-- Test harness + +smtTestGroup :: TestTree +smtTestGroup = $(testGroupGenerator) diff --git a/test/Test/SMTLIB2Solver.hs b/test/Test/SMTLIB2Solver.hs new file mode 100644 --- /dev/null +++ b/test/Test/SMTLIB2Solver.hs @@ -0,0 +1,346 @@ +{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-} +module Test.SMTLIB2Solver (smtlib2SolverTestGroup) where + +import Control.Applicative((<$>)) +import Control.Exception (evaluate) +import Control.Monad +import Control.Monad.State.Strict +import Data.List +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Set (Set) +import qualified Data.Set as Set + +import Test.Tasty +import Test.Tasty.QuickCheck hiding ((.&&.), (.||.)) +import Test.Tasty.HUnit +import Test.Tasty.TH +import qualified Test.QuickCheck.Monadic as QM + +import ToySolver.SMT.SMTLIB2Solver as SMTLIB2 + +case_assertionStackLevels :: Assertion +case_assertionStackLevels = do + solver <- SMTLIB2.newSolver + SMTLIB2.setLogic solver "QF_UF" + lv1 <- SMTLIB2.getInfo solver AssertionStackLevels + lv1 @?= [ResponseAssertionStackLevels 0] + SMTLIB2.push solver 1 + lv2 <- SMTLIB2.getInfo solver AssertionStackLevels + lv2 @?= [ResponseAssertionStackLevels 1] + SMTLIB2.pop solver 1 + lv3 <- SMTLIB2.getInfo solver AssertionStackLevels + lv3 @?= [ResponseAssertionStackLevels 0] + +case_getUnsatAssumptions :: Assertion +case_getUnsatAssumptions = do + solver <- SMTLIB2.newSolver + SMTLIB2.setOption solver (ProduceUnsatAssumptions True) + o <- SMTLIB2.getOption solver ":produce-unsat-assumptions" + o @?= AttrValueSymbol "true" + SMTLIB2.setLogic solver "QF_UF" + SMTLIB2.declareFun solver "a" [] (SortId (ISymbol "Bool")) + SMTLIB2.declareFun solver "b" [] (SortId (ISymbol "Bool")) + SMTLIB2.runCommandString solver "(assert (or a b))" + r <- SMTLIB2.runCommandString solver "(check-sat-assuming ((not a) (not b)))" + r @?= CmdCheckSatResponse Unsat + r <- SMTLIB2.getUnsatAssumptions solver + let expected = + [ TermQualIdentifierT (QIdentifier (ISymbol "not")) [TermQualIdentifier (QIdentifier (ISymbol "a"))] + , TermQualIdentifierT (QIdentifier (ISymbol "not")) [TermQualIdentifier (QIdentifier (ISymbol "b"))] + ] + r @?= expected + +case_declareConst :: Assertion +case_declareConst = do + solver <- SMTLIB2.newSolver + SMTLIB2.setLogic solver "QF_LRA" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-const b Bool)" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-const x Bool)" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-const y Bool)" + +case_divisionByZero :: Assertion +case_divisionByZero = do + solver <- SMTLIB2.newSolver + SMTLIB2.setOption solver (ProduceUnsatAssumptions True) + SMTLIB2.setLogic solver "QF_LRA" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-const x1 Real)" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-const x2 Real)" + + assertSuccess =<< SMTLIB2.runCommandString solver "(define-fun y1 () Real (/ x1 0))" + assertSuccess =<< SMTLIB2.runCommandString solver "(define-fun y2 () Real (/ x2 0))" + r <- SMTLIB2.checkSat solver + r @?= Sat + + assertSuccess =<< SMTLIB2.runCommandString solver "(assert (not (= y1 y2)))" + r <- SMTLIB2.checkSat solver + r @?= Sat + + assertSuccess =<< SMTLIB2.runCommandString solver "(assert (= x1 x2))" + r <- SMTLIB2.checkSat solver + r @?= Unsat + +case_getAssertions :: Assertion +case_getAssertions = do + solver <- SMTLIB2.newSolver + SMTLIB2.setOption solver (ProduceAssertions True) + o <- SMTLIB2.getOption solver ":produce-assertions" + o @?= AttrValueSymbol "true" + SMTLIB2.setLogic solver "QF_UF" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-fun a () Bool)" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-fun b () Bool)" + assertSuccess =<< SMTLIB2.runCommandString solver "(assert (or (! a :named aa) (! b :named bb)))" + r <- SMTLIB2.runCommandString solver "(get-assertions)" + showSL r @?= "((or (! a :named aa) (! b :named bb)))" + SMTLIB2.push solver 1 + assertSuccess =<< SMTLIB2.runCommandString solver "(assert (not (and a bb)))" + r <- SMTLIB2.runCommandString solver "(get-assertions)" + showSL r @?= "((or (! a :named aa) (! b :named bb)) (not (and a bb)))" + SMTLIB2.pop solver 1 + r <- SMTLIB2.runCommandString solver "(get-assertions)" + showSL r @?= "((or (! a :named aa) (! b :named bb)))" + +case_getAssignment :: Assertion +case_getAssignment = do + solver <- SMTLIB2.newSolver + SMTLIB2.setOption solver (ProduceAssignments True) + o <- SMTLIB2.getOption solver ":produce-assignments" + o @?= AttrValueSymbol "true" + SMTLIB2.setLogic solver "QF_UFLRA" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-fun a () Bool)" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-fun b () Bool)" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-fun c () Real)" + assertSuccess =<< SMTLIB2.runCommandString solver "(assert (or (! a :named aa) (! b :named bb)))" + assertSuccess =<< SMTLIB2.runCommandString solver "(assert (>= (! c :named cc) 0))" + assertSuccess =<< SMTLIB2.runCommandString solver "(assert (not (and a bb)))" + SMTLIB2.checkSat solver + r <- SMTLIB2.getAssignment solver + let m = Map.fromList [(s, b) | TValuationPair s b <- r] + unless (m == Map.fromList [("aa",True), ("bb",False)] || m == Map.fromList [("aa",False), ("bb",True)]) $ do + assertFailure (show r) + +case_getModel :: Assertion +case_getModel = do + solver <- SMTLIB2.newSolver + SMTLIB2.setOption solver (ProduceModels True) + o <- SMTLIB2.getOption solver ":produce-models" + o @?= AttrValueSymbol "true" + SMTLIB2.setLogic solver "QF_UF" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-fun a () Bool)" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-fun b () Bool)" + assertSuccess =<< SMTLIB2.runCommandString solver "(assert (or a b))" + assertSuccess =<< SMTLIB2.runCommandString solver "(assert (not (and a b)))" + SMTLIB2.checkSat solver + r <- SMTLIB2.getModel solver + let m = sort $ map showSL r + unless (m == ["(define-fun a () Bool true)", "(define-fun b () Bool false)"] || + m == ["(define-fun a () Bool false)", "(define-fun b () Bool true)"]) $ do + assertFailure (show r) + +case_getValue :: Assertion +case_getValue = do + solver <- SMTLIB2.newSolver + SMTLIB2.setOption solver (ProduceModels True) + o <- SMTLIB2.getOption solver ":produce-models" + o @?= AttrValueSymbol "true" + SMTLIB2.setLogic solver "QF_UF" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-sort U 0)" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-fun f (U) U)" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-fun g (U) U)" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-fun A () Bool)" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-fun x () U)" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-fun y () U)" + SMTLIB2.checkSat solver + r <- SMTLIB2.runCommandString solver "(get-value (x A (f x) (g y)))" + case r of + CmdGetValueResponse xs -> return () -- fixme + _ -> assertFailure (show r) + +case_GlobalDeclarations :: Assertion +case_GlobalDeclarations = do + solver <- SMTLIB2.newSolver + + SMTLIB2.setOption solver (GlobalDeclarations False) + o <- SMTLIB2.getOption solver ":global-declarations" + o @?= AttrValueSymbol "false" + SMTLIB2.setLogic solver "QF_UFLRA" + SMTLIB2.push solver 1 + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-const x1 Bool)" + SMTLIB2.pop solver 1 + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-const x1 Real)" + + SMTLIB2.reset solver + + SMTLIB2.setOption solver (GlobalDeclarations True) + o <- SMTLIB2.getOption solver ":global-declarations" + o @?= AttrValueSymbol "true" + SMTLIB2.setLogic solver "QF_UFLRA" + SMTLIB2.push solver 1 + assertSuccess =<< SMTLIB2.runCommandString solver "(define-fun x2 () Real 1.0)" + SMTLIB2.pop solver 1 + assertSuccess =<< SMTLIB2.runCommandString solver "(assert (= x2 1.0))" + SMTLIB2.checkSat solver + + return () + +case_quoted_symbols :: Assertion +case_quoted_symbols = do + solver <- SMTLIB2.newSolver + SMTLIB2.setLogic solver "QF_LRA" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-fun abc () Real)" + assertSuccess =<< SMTLIB2.runCommandString solver "(assert (= abc 0))" + assertSuccess =<< SMTLIB2.runCommandString solver "(assert (= |abc| 1))" + r <- SMTLIB2.checkSat solver + r @?= Unsat + +case_reset :: Assertion +case_reset = do + solver <- SMTLIB2.newSolver + + SMTLIB2.setLogic solver "QF_UF" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-fun x1 () Bool)" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-fun x2 () Bool)" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-fun x3 () Bool)" + assertSuccess =<< SMTLIB2.runCommandString solver "(assert (! x1 :named C1))" + assertSuccess =<< SMTLIB2.runCommandString solver "(assert (! (not x1) :named C2))" + assertSuccess =<< SMTLIB2.runCommandString solver "(assert (! (or (not x1) x2) :named C3))" + assertSuccess =<< SMTLIB2.runCommandString solver "(assert (! (not x2) :named C4))" + assertSuccess =<< SMTLIB2.runCommandString solver "(assert (! (or (not x1) x3) :named C5))" + assertSuccess =<< SMTLIB2.runCommandString solver "(assert (! (not x3) :named C6))" + + r <- SMTLIB2.checkSat solver + r @?= Unsat + + SMTLIB2.reset solver + + r <- SMTLIB2.checkSat solver + r @?= Sat + +case_resetAssertions :: Assertion +case_resetAssertions = do + solver <- SMTLIB2.newSolver + + SMTLIB2.setLogic solver "QF_UF" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-fun x1 () Bool)" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-fun x2 () Bool)" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-fun x3 () Bool)" + SMTLIB2.push solver 1 + assertSuccess =<< SMTLIB2.runCommandString solver "(assert (! x1 :named C1))" + assertSuccess =<< SMTLIB2.runCommandString solver "(assert (! (not x1) :named C2))" + assertSuccess =<< SMTLIB2.runCommandString solver "(assert (! (or (not x1) x2) :named C3))" + assertSuccess =<< SMTLIB2.runCommandString solver "(assert (! (not x2) :named C4))" + assertSuccess =<< SMTLIB2.runCommandString solver "(assert (! (or (not x1) x3) :named C5))" + assertSuccess =<< SMTLIB2.runCommandString solver "(assert (! (not x3) :named C6))" + + r <- SMTLIB2.checkSat solver + r @?= Unsat + + SMTLIB2.resetAssertions solver + + r <- SMTLIB2.checkSat solver + r @?= Sat + +-- http://sun.iwu.edu/~mliffito/publications/jar_liffiton_CAMUS.pdf +-- φ= (x1) ∧ (¬x1) ∧ (¬x1∨x2) ∧ (¬x2) ∧ (¬x1∨x3) ∧ (¬x3) +-- MUSes(φ) = {{C1, C2}, {C1, C3, C4}, {C1, C5, C6}} +-- MCSes(φ) = {{C1}, {C2, C3, C5}, {C2, C3, C6}, {C2, C4, C5}, {C2, C4, C6}} +case_getUnsatCore :: Assertion +case_getUnsatCore = do + solver <- SMTLIB2.newSolver + + SMTLIB2.setOption solver (ProduceUnsatCores True) + o <- SMTLIB2.getOption solver ":produce-unsat-cores" + o @?= AttrValueSymbol "true" + + SMTLIB2.setLogic solver "QF_UF" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-fun x1 () Bool)" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-fun x2 () Bool)" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-fun x3 () Bool)" + assertSuccess =<< SMTLIB2.runCommandString solver "(assert (! x1 :named C1))" + assertSuccess =<< SMTLIB2.runCommandString solver "(assert (! (not x1) :named C2))" + assertSuccess =<< SMTLIB2.runCommandString solver "(assert (! (or (not x1) x2) :named C3))" + assertSuccess =<< SMTLIB2.runCommandString solver "(assert (! (not x2) :named C4))" + assertSuccess =<< SMTLIB2.runCommandString solver "(assert (! (or (not x1) x3) :named C5))" + assertSuccess =<< SMTLIB2.runCommandString solver "(assert (! (not x3) :named C6))" + r <- SMTLIB2.checkSat solver + r @?= Unsat + r <- SMTLIB2.getUnsatCore solver + let expected = map Set.fromList [["C1", "C2"], ["C1", "C3", "C4"], ["C1", "C5", "C6"]] + Set.fromList r `elem` expected @?= True + +case_echo :: Assertion +case_echo = do + solver <- SMTLIB2.newSolver + r <- SMTLIB2.runCommandString solver "(echo \"hello\")" + showSL r @?= "\"hello\"" + +case_let :: Assertion +case_let = do + solver <- SMTLIB2.newSolver + SMTLIB2.setLogic solver "QF_LRA" + assertSuccess =<< SMTLIB2.runCommandString solver "(define-fun x () Real (let ((y 1)) (+ y 2)))" + assertSuccess =<< SMTLIB2.runCommandString solver "(assert (not (= x 3)))" + r <- SMTLIB2.checkSat solver + r @?= Unsat + +case_delcareSort :: Assertion +case_delcareSort = do + solver <- SMTLIB2.newSolver + SMTLIB2.setLogic solver "QF_UFLRA" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-sort U 1)" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-const x1 (U Real))" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-const x2 (U Bool))" + +case_defineSort :: Assertion +case_defineSort = do + solver <- SMTLIB2.newSolver + SMTLIB2.setLogic solver "QF_UFLRA" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-sort U 1)" + assertSuccess =<< SMTLIB2.runCommandString solver "(define-sort T (X) (U X))" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-const x1 (T Real))" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-const x2 (T Bool))" + +case_defineFun :: Assertion +case_defineFun = do + solver <- SMTLIB2.newSolver + SMTLIB2.setOption solver (ProduceModels True) + SMTLIB2.setLogic solver "QF_UFLRA" + assertSuccess =<< SMTLIB2.runCommandString solver "(define-fun f ((b Bool) (x Real)) Bool (ite b (>= x 0) (>= 0 x)))" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-const bb Bool)" + assertSuccess =<< SMTLIB2.runCommandString solver "(declare-const xx Real)" + assertSuccess =<< SMTLIB2.runCommandString solver "(assert (>= xx 100))" + assertSuccess =<< SMTLIB2.runCommandString solver "(assert (f bb xx))" + r <- SMTLIB2.checkSat solver + r @?= Sat + r <- SMTLIB2.runCommandString solver "(get-value (bb))" + showSL r @?= "((bb true))" + +case_getInfo :: Assertion +case_getInfo = do + solver <- SMTLIB2.newSolver + _ <- SMTLIB2.getInfo solver ErrorBehavior + _ <- SMTLIB2.getInfo solver Name + _ <- SMTLIB2.getInfo solver Authors + _ <- SMTLIB2.getInfo solver Version + return () + +case_setInfo :: Assertion +case_setInfo = do + solver <- SMTLIB2.newSolver + assertSuccess =<< SMTLIB2.runCommandString solver "(set-info :status sat)" + assertSuccess =<< SMTLIB2.runCommandString solver "(set-info :status unsat)" + assertSuccess =<< SMTLIB2.runCommandString solver "(set-info :status unknown)" + return () + +-- --------------------------------------------------------------------- + +assertSuccess :: CmdResponse -> Assertion +assertSuccess (CmdGenResponse SMTLIB2.Success) = return () +assertSuccess (CmdGenResponse Unsupported) = assertFailure "unsupported" +assertSuccess (CmdGenResponse (Error str)) = assertFailure ("(error " ++ str ++ ")") + +-- --------------------------------------------------------------------- +-- Test harness + +smtlib2SolverTestGroup :: TestTree +smtlib2SolverTestGroup = $(testGroupGenerator) diff --git a/test/Test/Simplex.hs b/test/Test/Simplex.hs new file mode 100644 --- /dev/null +++ b/test/Test/Simplex.hs @@ -0,0 +1,177 @@ +{-# LANGUAGE TemplateHaskell #-} +module Test.Simplex (simplexTestGroup) where + +import Control.Monad +import Control.Monad.State +import Data.IntMap (IntMap) +import qualified Data.IntMap as IntMap +import Data.IntSet (IntSet) +import qualified Data.IntSet as IntSet +import Data.List +import Data.Ratio +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.TH +import Text.Printf + +import qualified ToySolver.Data.LA as LA +import ToySolver.Data.LA ((.<=.)) +import ToySolver.Arith.Simplex +import qualified ToySolver.Arith.LPSolver as LP + +example_3_2 :: Tableau Rational +example_3_2 = IntMap.fromList + [ (4, (IntMap.fromList [(1,2), (2,1), (3,1)], 2)) + , (5, (IntMap.fromList [(1,1), (2,2), (3,3)], 5)) + , (6, (IntMap.fromList [(1,2), (2,2), (3,1)], 6)) + , (objRowIndex, (IntMap.fromList [(1,-3), (2,-2), (3,-3)], 0)) + ] + +case_example_3_2_simplex :: Assertion +case_example_3_2_simplex = do + assertBool "simplex failed" ret + assertBool "invalid tableau" (isValidTableau result) + assertBool "infeasible tableau" (isFeasible result) + assertBool "unoptimal tableau" (isOptimal OptMax result) + currentObjValue result @?= 27/5 + where + ret :: Bool + result :: Tableau Rational + (ret,result) = simplex OptMax example_3_2 + +case_example_3_2_primalDualSimplex :: Assertion +case_example_3_2_primalDualSimplex = do + assertBool "simplex failed" ret + assertBool "invalid tableau" (isValidTableau result) + assertBool "infeasible tableau" (isFeasible result) + assertBool "unoptimal tableau" (isOptimal OptMax result) + currentObjValue result @?= 27/5 + where + ret :: Bool + result :: Tableau Rational + (ret,result) = primalDualSimplex OptMax example_3_2 + +-- from http://www.math.cuhk.edu.hk/~wei/lpch5.pdf +exampe_5_3_phase1 :: Tableau Rational +exampe_5_3_phase1 = IntMap.fromList + [ (6, (IntMap.fromList [(2,-1), (3,-1), (5,1), (6,1)], 1)) + , (7, (IntMap.fromList [(3,1), (4,-1), (5,1), (7,1)], 0)) + ] + +case_exampe_5_3_phase1 :: Assertion +case_exampe_5_3_phase1 = do + let (ret,result) = phaseI exampe_5_3_phase1 (IntSet.fromList [6,7]) + assertBool "phase1 failed" ret + assertBool "invalid tableau" (isValidTableau result) + assertBool "infeasible tableau" (isFeasible result) + +-- 退化して巡回の起こるKuhnの7変数3制約の例 +kuhn_7_3 :: Tableau Rational +kuhn_7_3 = IntMap.fromList + [ (1, (IntMap.fromList [(4,-2), (5,-9), (6,1), (7,9)], 0)) + , (2, (IntMap.fromList [(4,1/3), (5,1), (6,-1/3), (7,-2)], 0)) + , (3, (IntMap.fromList [(4,2), (5,3), (6,-1), (7,-12)], 2)) + , (objRowIndex, (IntMap.fromList [(4,2), (5,3), (6,-1), (7,-12)], 0)) + ] + +case_kuhn_7_3 :: Assertion +case_kuhn_7_3 = do + assertBool "simplex failed" ret + assertBool "invalid tableau" (isValidTableau result) + currentObjValue result @?= -2 + where + ret :: Bool + result :: Tableau Rational + (ret,result) = simplex OptMin kuhn_7_3 + +-- case_pd_kuhn_7_3 :: Assertion +-- case_pd_kuhn_7_3 = do +-- assertBool "simplex failed" ret +-- assertBool "invalid tableau" (isValidTableau result) +-- currentObjValue result @?= -2 +-- where +-- ret :: Bool +-- result :: Tableau Rational +-- (ret,result) = primalDualSimplex OptMin kuhn_7_3 + +-- from http://www.math.cuhk.edu.hk/~wei/lpch5.pdf +example_5_7 :: Tableau Rational +example_5_7 = IntMap.fromList + [ (4, (IntMap.fromList [(1,-1), (2,-2), (3,-3)], -5)) + , (5, (IntMap.fromList [(1,-2), (2,-2), (3,-1)], -6)) + , (objRowIndex, (IntMap.fromList [(1,3),(2,4),(3,5)], 0)) + ] + +case_example_5_7 :: Assertion +case_example_5_7 = do + assertBool "dual simplex failed" ret + assertBool "invalid tableau" (isValidTableau result) + currentObjValue result @?= -11 + where + ret :: Bool + result :: Tableau Rational + (ret,result) = dualSimplex OptMax example_5_7 + +case_pd_example_5_7 :: Assertion +case_pd_example_5_7 = do + assertBool "dual simplex failed" ret + assertBool "invalid tableau" (isValidTableau result) + currentObjValue result @?= -11 + where + ret :: Bool + result :: Tableau Rational + (ret,result) = primalDualSimplex OptMax example_5_7 + +------------------------------------------------------------------------ + +case_lp_example_5_7_twoPhaseSimplex :: Assertion +case_lp_example_5_7_twoPhaseSimplex = do + ret @?= LP.Optimum + oval @?= -11 + assertBool "invalid tableau" (isValidTableau tbl) + assertBool "infeasible tableau" (isFeasible tbl) + assertBool "non-optimal tableau" (isOptimal OptMax tbl) + where + oval :: Rational + ((ret,tbl,oval),result) = flip runState (LP.emptySolver IntSet.empty) $ do + _ <- LP.newVar + x1 <- LP.newVar + x2 <- LP.newVar + x3 <- LP.newVar + LP.addConstraint (LA.fromTerms [(-1,x1),(-2,x2),(-3,x3)] .<=. LA.constant (-5)) + LP.addConstraint (LA.fromTerms [(-2,x1),(-2,x2),(-1,x3)] .<=. LA.constant (-6)) + let obj = LA.fromTerms [(-3,x1), (-4,x2),(-5,x3)] + ret <- LP.twoPhaseSimplex OptMax obj + tbl <- LP.getTableau + m <- LP.getModel (IntSet.fromList [x1,x2,x3]) + let oval = LA.evalExpr m obj + return (ret,tbl,oval) + +case_lp_example_5_7_primalDualSimplex :: Assertion +case_lp_example_5_7_primalDualSimplex = do + ret @?= LP.Optimum + oval @?= -11 + assertBool "invalid tableau" (isValidTableau tbl) + assertBool "infeasible tableau" (isFeasible tbl) + assertBool "non-optimal tableau" (isOptimal OptMax tbl) + where + oval :: Rational + ((ret,tbl,oval),result) = flip runState (LP.emptySolver IntSet.empty) $ do + _ <- LP.newVar + x1 <- LP.newVar + x2 <- LP.newVar + x3 <- LP.newVar + LP.addConstraint (LA.fromTerms [(-1,x1),(-2,x2),(-3,x3)] .<=. LA.constant (-5)) + LP.addConstraint (LA.fromTerms [(-2,x1),(-2,x2),(-1,x3)] .<=. LA.constant (-6)) + let obj = LA.fromTerms [(-3,x1), (-4,x2),(-5,x3)] + ret <- LP.primalDualSimplex OptMax obj + tbl <- LP.getTableau + m <- LP.getModel (IntSet.fromList [x1,x2,x3]) + let oval = LA.evalExpr m obj + return (ret,tbl,oval) + +------------------------------------------------------------------------ +-- Test harness + +simplexTestGroup :: TestTree +simplexTestGroup = $(testGroupGenerator) diff --git a/test/Test/Simplex2.hs b/test/Test/Simplex2.hs new file mode 100644 --- /dev/null +++ b/test/Test/Simplex2.hs @@ -0,0 +1,408 @@ +{-# LANGUAGE TemplateHaskell #-} +module Test.Simplex2 (simplex2TestGroup) where + +import Control.Monad +import Data.Default.Class +import Data.List +import Data.Ratio +import Data.VectorSpace +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.TH +import Text.Printf +import qualified ToySolver.Data.LA as LA +import ToySolver.Arith.Simplex2 + +case_test1 :: Assertion +case_test1 = do + solver <- newSolver + x <- newVar solver + y <- newVar solver + z <- newVar solver + assertAtom solver (LA.fromTerms [(7,x), (12,y), (31,z)] .==. LA.constant 17) + assertAtom solver (LA.fromTerms [(3,x), (5,y), (14,z)] .==. LA.constant 7) + assertAtom solver (LA.var x .>=. LA.constant 1) + assertAtom solver (LA.var x .<=. LA.constant 40) + assertAtom solver (LA.var y .>=. LA.constant (-50)) + assertAtom solver (LA.var y .<=. LA.constant 50) + + ret <- check solver + ret @?= True + + vx <- getValue solver x + vy <- getValue solver y + vz <- getValue solver z + 7*vx + 12*vy + 31*vz @?= 17 + 3*vx + 5*vy + 14*vz @?= 7 + assertBool (printf "vx should be >=1 but %s" (show vx)) $ vx >= 1 + assertBool (printf "vx should be <=40 but %s" (show vx)) $ vx <= 40 + assertBool (printf "vx should be >=-50 but %s" (show vy)) $ vy >= -50 + assertBool (printf "vx should be <=50 but %s" (show vy)) $ vy <= 50 + +case_test2 :: Assertion +case_test2 = do + solver <- newSolver + x <- newVar solver + y <- newVar solver + assertAtom solver (LA.fromTerms [(11,x), (13,y)] .>=. LA.constant 27) + assertAtom solver (LA.fromTerms [(11,x), (13,y)] .<=. LA.constant 45) + assertAtom solver (LA.fromTerms [(7,x), (-9,y)] .>=. LA.constant (-10)) + assertAtom solver (LA.fromTerms [(7,x), (-9,y)] .<=. LA.constant 4) + + ret <- check solver + ret @?= True + + vx <- getValue solver x + vy <- getValue solver y + let v1 = 11*vx + 13*vy + v2 = 7*vx - 9*vy + assertBool (printf "11*vx + 13*vy should be >=27 but %s" (show v1)) $ 27 <= v1 + assertBool (printf "11*vx + 13*vy should be <=45 but %s" (show v1)) $ v1 <= 45 + assertBool (printf "7*vx - 9*vy should be >=-10 but %s" (show v2)) $ -10 <= v2 + assertBool (printf "7*vx - 9*vy should be >=-10 but %s" (show v2)) $ v2 <= 4 + + +{- +Minimize + obj: - x1 - 2 x2 - 3 x3 - x4 +Subject To + c1: - x1 + x2 + x3 + 10 x4 <= 20 + c2: x1 - 3 x2 + x3 <= 30 + c3: x2 - 3.5 x4 = 0 +Bounds + 0 <= x1 <= 40 + 2 <= x4 <= 3 +End +-} +case_test3 :: Assertion +case_test3 = do + solver <- newSolver + + _ <- newVar solver + x1 <- newVar solver + x2 <- newVar solver + x3 <- newVar solver + x4 <- newVar solver + + setObj solver (LA.fromTerms [(-1,x1), (-2,x2), (-3,x3), (-1,x4)]) + + assertAtom solver (LA.fromTerms [(-1,x1), (1,x2), (1,x3), (10,x4)] .<=. LA.constant 20) + assertAtom solver (LA.fromTerms [(1,x1), (-3,x2), (1,x3)] .<=. LA.constant 30) + assertAtom solver (LA.fromTerms [(1,x2), (-3.5,x4)] .==. LA.constant 0) + + assertAtom solver (LA.fromTerms [(1,x1)] .>=. LA.constant 0) + assertAtom solver (LA.fromTerms [(1,x1)] .<=. LA.constant 40) + assertAtom solver (LA.fromTerms [(1,x2)] .>=. LA.constant 0) + assertAtom solver (LA.fromTerms [(1,x3)] .>=. LA.constant 0) + assertAtom solver (LA.fromTerms [(1,x4)] .>=. LA.constant 2) + assertAtom solver (LA.fromTerms [(1,x4)] .<=. LA.constant 3) + + ret1 <- check solver + ret1 @?= True + + ret2 <- optimize solver def + ret2 @?= Optimum + +{- +http://www.math.cuhk.edu.hk/~wei/lpch5.pdf +example 5.7 + +minimize 3 x1 + 4 x2 + 5 x3 +subject to +1 x1 + 2 x2 + 3 x3 >= 5 +2 x1 + 2 x2 + 1 x3 >= 6 + +optimal value is 11 +-} +case_test6 :: Assertion +case_test6 = do + solver <- newSolver + + _ <- newVar solver + x1 <- newVar solver + x2 <- newVar solver + x3 <- newVar solver + + assertLower solver x1 0 + assertLower solver x2 0 + assertLower solver x3 0 + assertAtom solver (LA.fromTerms [(1,x1),(2,x2),(3,x3)] .>=. LA.constant 5) + assertAtom solver (LA.fromTerms [(2,x1),(2,x2),(1,x3)] .>=. LA.constant 6) + + setObj solver (LA.fromTerms [(3,x1),(4,x2),(5,x3)]) + setOptDir solver OptMin + b <- isOptimal solver + assertBool "should be optimal" $ b + + ret <- dualSimplex solver def + ret @?= Optimum + + val <- getObjValue solver + val @?= 11 + +{- +http://www.math.cuhk.edu.hk/~wei/lpch5.pdf +example 5.7 + +maximize -3 x1 -4 x2 -5 x3 +subject to +-1 x1 -2 x2 -3 x3 <= -5 +-2 x1 -2 x2 -1 x3 <= -6 + +optimal value should be -11 +-} +case_test7 :: Assertion +case_test7 = do + solver <- newSolver + + _ <- newVar solver + x1 <- newVar solver + x2 <- newVar solver + x3 <- newVar solver + + assertLower solver x1 0 + assertLower solver x2 0 + assertLower solver x3 0 + assertAtom solver (LA.fromTerms [(-1,x1),(-2,x2),(-3,x3)] .<=. LA.constant (-5)) + assertAtom solver (LA.fromTerms [(-2,x1),(-2,x2),(-1,x3)] .<=. LA.constant (-6)) + + setObj solver (LA.fromTerms [(-3,x1),(-4,x2),(-5,x3)]) + setOptDir solver OptMax + b <- isOptimal solver + assertBool "should be optimal" $ b + + ret <- dualSimplex solver def + ret @?= Optimum + + val <- getObjValue solver + val @?= -11 + +case_AssertAtom :: Assertion +case_AssertAtom = do + solver <- newSolver + x0 <- newVar solver + assertAtom solver (LA.constant 1 .<=. LA.var x0) + ret <- getLB solver x0 + boundValue ret @?= Just 1 + + solver <- newSolver + x0 <- newVar solver + assertAtom solver (LA.var x0 .>=. LA.constant 1) + ret <- getLB solver x0 + boundValue ret @?= Just 1 + + solver <- newSolver + x0 <- newVar solver + assertAtom solver (LA.constant 1 .>=. LA.var x0) + ret <- getUB solver x0 + boundValue ret @?= Just 1 + + solver <- newSolver + x0 <- newVar solver + assertAtom solver (LA.var x0 .<=. LA.constant 1) + ret <- getUB solver x0 + boundValue ret @?= Just 1 + +------------------------------------------------------------------------ + +case_example_3_2 = do + solver <- newSolver + [x1,x2,x3] <- replicateM 3 (newVar solver) + setOptDir solver OptMax + setObj solver $ LA.fromTerms [(3,x1), (2,x2), (3,x3)] + mapM_ (assertAtom solver) $ + [ LA.fromTerms [(2,x1), (1,x2), (1,x3)] .<=. LA.constant 2 + , LA.fromTerms [(1,x1), (2,x2), (3,x3)] .<=. LA.constant 5 + , LA.fromTerms [(2,x1), (2,x2), (1,x3)] .<=. LA.constant 6 + , LA.var x1 .>=. LA.constant 0 + , LA.var x2 .>=. LA.constant 0 + , LA.var x3 .>=. LA.constant 0 + ] + + ret <- optimize solver def + ret @?= Optimum + val <- getObjValue solver + val @?= 27/5 + + forM_ [(x1,1/5),(x2,0),(x3,8/5)] $ \(var,expected) -> do + val <- getValue solver var + val @?= expected + +case_example_3_5 = do + solver <- newSolver + [x1,x2,x3,x4,x5] <- replicateM 5 (newVar solver) + setOptDir solver OptMin + setObj solver $ LA.fromTerms [(-2,x1), (4,x2), (7,x3), (1,x4), (5,x5)] + mapM_ (assertAtom solver) $ + [ LA.fromTerms [(-1,x1), (1,x2), (2,x3), (1,x4), (2,x5)] .==. LA.constant 7 + , LA.fromTerms [(-1,x1), (2,x2), (3,x3), (1,x4), (1,x5)] .==. LA.constant 6 + , LA.fromTerms [(-1,x1), (1,x2), (1,x3), (2,x4), (1,x5)] .==. LA.constant 4 + , LA.var x2 .>=. LA.constant 0 + , LA.var x3 .>=. LA.constant 0 + , LA.var x4 .>=. LA.constant 0 + , LA.var x5 .>=. LA.constant 0 + ] + + ret <- optimize solver def + ret @?= Optimum + val <- getObjValue solver + val @?= 19 + + forM_ [(x1,-1),(x2,0),(x3,1),(x4,0),(x5,2)] $ \(var,expected) -> do + val <- getValue solver var + val @?= expected + +case_example_4_1 = do + solver <- newSolver + [x1,x2] <- replicateM 2 (newVar solver) + setOptDir solver OptMin + setObj solver $ LA.fromTerms [(2,x1), (1,x2)] + mapM_ (assertAtom solver) $ + [ LA.fromTerms [(-1,x1), (1,x2)] .>=. LA.constant 2 + , LA.fromTerms [( 1,x1), (1,x2)] .<=. LA.constant 1 + , LA.var x1 .>=. LA.constant 0 + , LA.var x2 .>=. LA.constant 0 + ] + ret <- optimize solver def + ret @?= Unsat + +case_example_4_2 = do + solver <- newSolver + [x1,x2] <- replicateM 2 (newVar solver) + setOptDir solver OptMax + setObj solver $ LA.fromTerms [(2,x1), (1,x2)] + mapM_ (assertAtom solver) $ + [ LA.fromTerms [(-1,x1), (-1,x2)] .<=. LA.constant 10 + , LA.fromTerms [( 2,x1), (-1,x2)] .<=. LA.constant 40 + , LA.var x1 .>=. LA.constant 0 + , LA.var x2 .>=. LA.constant 0 + ] + ret <- optimize solver def + ret @?= Unbounded + +case_example_4_3 = do + solver <- newSolver + [x1,x2] <- replicateM 2 (newVar solver) + setOptDir solver OptMax + setObj solver $ LA.fromTerms [(6,x1), (-2,x2)] + mapM_ (assertAtom solver) $ + [ LA.fromTerms [(2,x1), (-1,x2)] .<=. LA.constant 2 + , LA.var x1 .<=. LA.constant 4 + , LA.var x1 .>=. LA.constant 0 + , LA.var x2 .>=. LA.constant 0 + ] + + ret <- optimize solver def + ret @?= Optimum + val <- getObjValue solver + val @?= 12 + + forM_ [(x1,4),(x2,6)] $ \(var,expected) -> do + val <- getValue solver var + val @?= expected + +case_example_4_5 = do + solver <- newSolver + [x1,x2] <- replicateM 2 (newVar solver) + setOptDir solver OptMax + setObj solver $ LA.fromTerms [(2,x1), (1,x2)] + mapM_ (assertAtom solver) $ + [ LA.fromTerms [(4,x1), ( 3,x2)] .<=. LA.constant 12 + , LA.fromTerms [(4,x1), ( 1,x2)] .<=. LA.constant 8 + , LA.fromTerms [(4,x1), (-1,x2)] .<=. LA.constant 8 + , LA.var x1 .>=. LA.constant 0 + , LA.var x2 .>=. LA.constant 0 + ] + + ret <- optimize solver def + ret @?= Optimum + val <- getObjValue solver + val @?= 5 + + forM_ [(x1,3/2),(x2,2)] $ \(var,expected) -> do + val <- getValue solver var + val @?= expected + +case_example_4_6 = do + solver <- newSolver + [x1,x2,x3,x4] <- replicateM 4 (newVar solver) + setOptDir solver OptMax + setObj solver $ LA.fromTerms [(20,x1), (1/2,x2), (-6,x3), (3/4,x4)] + mapM_ (assertAtom solver) $ + [ LA.var x1 .<=. LA.constant 2 + , LA.fromTerms [( 8,x1), ( -1,x2), (9,x3), (1/4, x4)] .<=. LA.constant 16 + , LA.fromTerms [(12,x1), (-1/2,x2), (3,x3), (1/2, x4)] .<=. LA.constant 24 + , LA.var x2 .<=. LA.constant 1 + , LA.var x1 .>=. LA.constant 0 + , LA.var x2 .>=. LA.constant 0 + , LA.var x3 .>=. LA.constant 0 + , LA.var x4 .>=. LA.constant 0 + ] + + ret <- optimize solver def + ret @?= Optimum + val <- getObjValue solver + val @?= 165/4 + + forM_ [(x1,2),(x2,1),(x3,0),(x4,1)] $ \(var,expected) -> do + val <- getValue solver var + val @?= expected + +case_example_4_7 = do + solver <- newSolver + [x1,x2,x3,x4] <- replicateM 4 (newVar solver) + setOptDir solver OptMax + setObj solver $ LA.fromTerms [(1,x1), (1.5,x2), (5,x3), (2,x4)] + mapM_ (assertAtom solver) $ + [ LA.fromTerms [(3,x1), (2,x2), ( 1,x3), (4,x4)] .<=. LA.constant 6 + , LA.fromTerms [(2,x1), (1,x2), ( 5,x3), (1,x4)] .<=. LA.constant 4 + , LA.fromTerms [(2,x1), (6,x2), (-4,x3), (8,x4)] .==. LA.constant 0 + , LA.fromTerms [(1,x1), (3,x2), (-2,x3), (4,x4)] .==. LA.constant 0 + , LA.var x1 .>=. LA.constant 0 + , LA.var x2 .>=. LA.constant 0 + , LA.var x3 .>=. LA.constant 0 + , LA.var x4 .>=. LA.constant 0 + ] + + ret <- optimize solver def + ret @?= Optimum + val <- getObjValue solver + val @?= 48/11 + + forM_ [(x1,0),(x2,0),(x3,8/11),(x4,4/11)] $ \(var,expected) -> do + val <- getValue solver var + val @?= expected + +-- 退化して巡回の起こるKuhnの7変数3制約の例 +case_kuhn_7_3 = do + solver <- newSolver + [x1,x2,x3,x4,x5,x6,x7] <- replicateM 7 (newVar solver) + setOptDir solver OptMin + setObj solver $ LA.fromTerms [(-2,x4),(-3,x5),(1,x6),(12,x7)] + mapM_ (assertAtom solver) $ + [ LA.fromTerms [(1,x1), ( -2,x4), (-9,x5), ( 1,x6), ( 9,x7)] .==. LA.constant 0 + , LA.fromTerms [(1,x2), (1/3,x4), ( 1,x5), (-1/3,x6), ( -2,x7)] .==. LA.constant 0 + , LA.fromTerms [(1,x3), ( 2,x4), ( 3,x5), ( -1,x6), (-12,x7)] .==. LA.constant 2 + , LA.var x1 .>=. LA.constant 0 + , LA.var x2 .>=. LA.constant 0 + , LA.var x3 .>=. LA.constant 0 + , LA.var x4 .>=. LA.constant 0 + , LA.var x5 .>=. LA.constant 0 + , LA.var x6 .>=. LA.constant 0 + , LA.var x7 .>=. LA.constant 0 + ] + + ret <- optimize solver def + ret @?= Optimum + val <- getObjValue solver + val @?= -2 + + forM_ [(x1,2),(x2,0),(x3,0),(x4,2),(x5,0),(x6,2),(x7,0)] $ \(var,expected) -> do + val <- getValue solver var + val @?= expected + +------------------------------------------------------------------------ +-- Test harness + +simplex2TestGroup :: TestTree +simplex2TestGroup = $(testGroupGenerator) diff --git a/test/Test/SubsetSum.hs b/test/Test/SubsetSum.hs new file mode 100644 --- /dev/null +++ b/test/Test/SubsetSum.hs @@ -0,0 +1,101 @@ +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-} +module Test.SubsetSum (subsetSumTestGroup) where + +import Control.Monad +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as VU +import Test.Tasty +import Test.Tasty.QuickCheck hiding ((.&&.), (.||.)) +import Test.Tasty.HUnit +import Test.Tasty.TH +import qualified ToySolver.Combinatorial.Knapsack.BB as KnapsackBB +import qualified ToySolver.Combinatorial.SubsetSum as SubsetSum + +-- --------------------------------------------------------------------- +-- SubsetSum + +evalSubsetSum :: [Integer] -> [Bool] -> Integer +evalSubsetSum ws bs = sum [w | (w,b) <- zip ws bs, b] + +prop_maxSubsetSum_soundness :: Property +prop_maxSubsetSum_soundness = + forAll arbitrary $ \c -> + forAll arbitrary $ \ws -> + case SubsetSum.maxSubsetSum (V.fromList ws) c of + Just (obj, bs) -> obj == evalSubsetSum ws (VU.toList bs) && obj <= c + Nothing -> True + +prop_maxSubsetSum_completeness :: Property +prop_maxSubsetSum_completeness = + forAll arbitrary $ \c -> + forAll g $ \ws -> + case SubsetSum.maxSubsetSum (V.fromList ws) c of + Just (obj, bs) -> VU.length bs == length ws && obj == evalSubsetSum ws (VU.toList bs) && obj <= c + Nothing -> and [c < evalSubsetSum ws bs | bs <- replicateM (length ws) [False,True]] + where + g = do + n <- choose (0,10) + replicateM n arbitrary + +prop_maxSubsetSum_isEqualToKnapsackBBSolver :: Property +prop_maxSubsetSum_isEqualToKnapsackBBSolver = + forAll (liftM abs arbitrary) $ \c -> + forAll (liftM (map abs) arbitrary) $ \ws -> + let Just (obj1, _bs1) = SubsetSum.maxSubsetSum (V.fromList ws) c + (obj2, _, _bs2) = KnapsackBB.solve [(fromIntegral w, fromIntegral w) | w <- ws] (fromIntegral c) + in fromIntegral obj1 == obj2 + +case_maxSubsetSum_regression_test_1 :: Assertion +case_maxSubsetSum_regression_test_1 = + SubsetSum.maxSubsetSum (V.fromList [4,28,5,6,18]) 25 @?= Just (24, VU.fromList [False,False,False,True,True]) + +case_maxSubsetSum_regression_test_2 :: Assertion +case_maxSubsetSum_regression_test_2 = + SubsetSum.maxSubsetSum (V.fromList [10,15]) 18 @?= Just (15, VU.fromList [False,True]) + +prop_minSubsetSum_soundness :: Property +prop_minSubsetSum_soundness = + forAll arbitrary $ \c -> + forAll arbitrary $ \ws -> + case SubsetSum.minSubsetSum (V.fromList ws) c of + Just (obj, bs) -> obj == evalSubsetSum ws (VU.toList bs) && c <= obj + Nothing -> True + +prop_minSubsetSum_completeness :: Property +prop_minSubsetSum_completeness = + forAll arbitrary $ \c -> + forAll g $ \ws -> + case SubsetSum.minSubsetSum (V.fromList ws) c of + Just (obj, bs) -> VU.length bs == length ws && obj == evalSubsetSum ws (VU.toList bs) && c <= obj + Nothing -> and [evalSubsetSum ws bs < c | bs <- replicateM (length ws) [False,True]] + where + g = do + n <- choose (0,10) + replicateM n arbitrary + +prop_subsetSum_soundness :: Property +prop_subsetSum_soundness = + forAll arbitrary $ \c -> + forAll arbitrary $ \ws -> + case SubsetSum.subsetSum (V.fromList ws) c of + Just bs -> VU.length bs == length ws && evalSubsetSum ws (VU.toList bs) == c + Nothing -> True + +prop_subsetSum_completeness :: Property +prop_subsetSum_completeness = + forAll arbitrary $ \c -> + forAll g $ \ws -> + case SubsetSum.subsetSum (V.fromList ws) c of + Just bs -> VU.length bs == length ws && evalSubsetSum ws (VU.toList bs) == c + Nothing -> and [c /= evalSubsetSum ws bs | bs <- replicateM (length ws) [False,True]] + where + g = do + n <- choose (0,10) + replicateM n arbitrary + +------------------------------------------------------------------------ +-- Test harness + +subsetSumTestGroup :: TestTree +subsetSumTestGroup = $(testGroupGenerator) diff --git a/test/TestAReal.hs b/test/TestAReal.hs deleted file mode 100644 --- a/test/TestAReal.hs +++ /dev/null @@ -1,291 +0,0 @@ -{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-} - -import Data.Maybe -import Data.Ratio -import Test.Tasty -import Test.Tasty.QuickCheck -import Test.Tasty.HUnit -import Test.Tasty.TH - -import ToySolver.Data.Polynomial (UPolynomial, X (..)) -import qualified ToySolver.Data.Polynomial as P -import qualified ToySolver.Data.AlgebraicNumber.Sturm as Sturm -import ToySolver.Data.AlgebraicNumber.Real -import ToySolver.Data.AlgebraicNumber.Root - -import Data.Interval (Interval, Extended (..), (<=..<=), (<..<=), (<=..<), (<..<)) -import qualified Data.Interval as Interval - -import Control.Monad -import Control.Exception -import System.IO - -{-------------------------------------------------------------------- - sample values ---------------------------------------------------------------------} - --- ±√2 -sqrt2 :: AReal -[neg_sqrt2, sqrt2] = realRoots (x^2 - 2) - where - x = P.var X - --- ±√3 -sqrt3 :: AReal -[neg_sqrt3, sqrt3] = realRoots (x^2 - 3) - where - x = P.var X - -{-------------------------------------------------------------------- - root manipulation ---------------------------------------------------------------------} - -case_rootAdd_sqrt2_sqrt3 = assertBool "" $ abs valP <= 0.0001 - where - x = P.var X - - p :: UPolynomial Rational - p = rootAdd (x^2 - 2) (x^2 - 3) - - valP :: Double - valP = P.eval (\X -> sqrt 2 + sqrt 3) $ P.mapCoeff fromRational p - --- bug? -sample_rootAdd = p - where - x = P.var X - p :: UPolynomial Rational - p = rootAdd (x^2 - 2) (x^6 + 6*x^3 - 2*x^2 + 9) - -case_rootSub_sqrt2_sqrt3 = assertBool "" $ abs valP <= 0.0001 - where - x = P.var X - - p :: UPolynomial Rational - p = rootAdd (x^2 - 2) (rootScale (-1) (x^2 - 3)) - - valP :: Double - valP = P.eval (\X -> sqrt 2 - sqrt 3) $ P.mapCoeff fromRational p - -case_rootMul_sqrt2_sqrt3 = assertBool "" $ abs valP <= 0.0001 - where - x = P.var X - - p :: UPolynomial Rational - p = rootMul (x^2 - 2) (x^2 - 3) - - valP :: Double - valP = P.eval (\X -> sqrt 2 * sqrt 3) $ P.mapCoeff fromRational p - -case_rootNegate_test1 = assertBool "" $ abs valP <= 0.0001 - where - x = P.var X - - p :: UPolynomial Rational - p = rootScale (-1) (x^3 - 3) - - valP :: Double - valP = P.eval (\X -> - (3 ** (1/3))) $ P.mapCoeff fromRational p - -case_rootNegate_test2 = rootScale (-1) p @?= normalizePoly q - where - x :: UPolynomial Rational - x = P.var X - p = x^3 - 3 - q = x^3 + 3 - -case_rootNegate_test3 = rootScale (-1) p @?= normalizePoly q - where - x :: UPolynomial Rational - x = P.var X - p = (x-2)*(x-3)*(x-4) - q = (x+2)*(x+3)*(x+4) - -case_rootScale = rootScale 2 p @?= normalizePoly q - where - x :: UPolynomial Rational - x = P.var X - p = (x-2)*(x-3)*(x-4) - q = (x-4)*(x-6)*(x-8) - -case_rootScale_zero = rootScale 0 p @?= normalizePoly q - where - x :: UPolynomial Rational - x = P.var X - p = (x-2)*(x-3)*(x-4) - q = x - -case_rootRecip = assertBool "" $ abs valP <= 0.0001 - where - x = P.var X - - p :: UPolynomial Rational - p = rootRecip (x^3 - 3) - - valP :: Double - valP = P.eval (\X -> 1 / (3 ** (1/3))) $ P.mapCoeff fromRational p - -{-------------------------------------------------------------------- - algebraic reals ---------------------------------------------------------------------} - -case_realRoots_zero = realRoots (0 :: UPolynomial Rational) @?= [] - -case_realRoots_nonminimal = - realRoots ((x^2 - 1) * (x - 3)) @?= [-1,1,3] - where - x = P.var X - -case_realRoots_minus_one = realRoots (x^2 + 1) @?= [] - where - x = P.var X - -case_realRoots_two = length (realRoots (x^2 - 2)) @?= 2 - where - x = P.var X - -case_realRoots_multipleRoots = length (realRoots (x^2 + 2*x + 1)) @?= 1 - where - x = P.var X - -case_eq = sqrt2*sqrt2 - 2 @?= 0 - -case_eq_refl = assertBool "" $ sqrt2 == sqrt2 - -case_diseq_1 = assertBool "" $ sqrt2 /= sqrt3 - -case_diseq_2 = assertBool "" $ sqrt2 /= neg_sqrt2 - -case_cmp_1 = assertBool "" $ 0 < sqrt2 - -case_cmp_2 = assertBool "" $ neg_sqrt2 < 0 - -case_cmp_3 = assertBool "" $ 0 < neg_sqrt2 * neg_sqrt2 - -case_cmp_4 = assertBool "" $ neg_sqrt2 * neg_sqrt2 * neg_sqrt2 < 0 - -case_floor_sqrt2 = floor sqrt2 @?= 1 - -case_floor_neg_sqrt2 = floor neg_sqrt2 @?= -2 - -case_floor_1 = floor 1 @?= 1 - -case_floor_neg_1 = floor (-1) @?= -1 - -case_ceiling_sqrt2 = ceiling sqrt2 @?= 2 - -case_ceiling_neg_sqrt2 = ceiling neg_sqrt2 @?= -1 - -case_ceiling_1 = ceiling 1 @?= 1 - -case_ceiling_neg_1 = ceiling (-1) @?= -1 - -case_round_sqrt2 = round sqrt2 @?= 1 - -case_toRational = toRational r @?= 3/2 - where - x = P.var X - [r] = realRoots (2*x - 3) - -case_toRational_error = do - r <- try $ evaluate $ toRational sqrt2 - case r of - Left (e :: SomeException) -> return () - Right _ -> assertFailure "shuold be error" - --- 期待値は Wolfram Alpha で x^3 - Sqrt[2]*x + 3 を調べて Real root の exact form で得た -case_simpARealPoly = simpARealPoly p @?= q - where - x :: forall k. (Num k, Eq k) => UPolynomial k - x = P.var X - p = x^3 - P.constant sqrt2 * x + 3 - q = x^6 + 6*x^3 - 2*x^2 + 9 - -case_deg_sqrt2 = P.deg sqrt2 @?= 2 - -case_deg_neg_sqrt2 = P.deg neg_sqrt2 @?= 2 - -case_deg_sqrt2_minus_sqrt2 = P.deg (sqrt2 - sqrt2) @?= 1 - -case_deg_sqrt2_times_sqrt2 = P.deg (sqrt2 * sqrt2) @?= 1 - -case_isAlgebraicInteger_sqrt2 = isAlgebraicInteger sqrt2 @?= True - -case_isAlgebraicInteger_neg_sqrt2 = isAlgebraicInteger neg_sqrt2 @?= True - -case_isAlgebraicInteger_one_half = isAlgebraicInteger (1/2) @?= False - -case_isAlgebraicInteger_one_sqrt2 = isAlgebraicInteger (1 / sqrt2) @?= False - -case_height_sqrt2 = height sqrt2 @?= 2 - -case_height_10 = height 10 @?= 10 - -prop_approx_sqrt2 = - forAll epsilons $ \epsilon -> - abs (sqrt2 - fromRational (approx sqrt2 epsilon)) <= fromRational epsilon - -prop_approxInterval_sqrt2 = - forAll epsilons $ \epsilon -> - Interval.width (approxInterval sqrt2 epsilon) <= epsilon - -epsilons :: Gen Rational -epsilons = do - r <- liftM abs $ arbitrary `suchThat` (0/=) - if r > 0 - then return (1/r) - else return r - ------------------------------------------------------------------------- - --- http://mathworld.wolfram.com/SturmFunction.html -case_sturmChain = Sturm.sturmChain p0 @?= chain - where - x = P.var X - p0 = x^5 - 3*x - 1 - p1 = 5*x^4 - 3 - p2 = P.constant (1/5) * (12*x + 5) - p3 = P.constant (59083 / 20736) - chain = [p0, p1, p2, p3] - --- http://mathworld.wolfram.com/SturmFunction.html -case_numRoots_1 = - sequence_ - [ Sturm.numRoots p (Finite (-2) <=..<= Finite 0) @?= 2 - , Sturm.numRoots p (Finite 0 <=..<= Finite 2) @?= 1 - , Sturm.numRoots p (Finite (-1.5) <=..<= Finite (-1.0)) @?= 1 - , Sturm.numRoots p (Finite (-0.5) <=..<= Finite 0) @?= 1 - , Sturm.numRoots p (Finite 1 <=..<= Finite (1.5)) @?= 1 - ] - where - x = P.var X - p = x^5 - 3*x - 1 - --- check interpretation of intervals -case_numRoots_2 = - sequence_ - [ Sturm.numRoots p (Finite 2 <..<= Finite 3) @?= 0 - , Sturm.numRoots p (Finite 2 <=..<= Finite 3) @?= 1 - , Sturm.numRoots p (Finite 1 <..< Finite 2) @?= 0 - , Sturm.numRoots p (Finite 1 <..<= Finite 2) @?= 1 - ] - where - x = P.var X - p = x^2 - 4 - -case_separate = do - forM_ (zip vals intervals) $ \(v,ival) -> do - Interval.member v ival @?= True - forM_ (filter (v/=) vals) $ \v2 -> do - Interval.member v2 ival @?= False - where - x = P.var X - p = x^5 - 3*x - 1 - intervals = Sturm.separate p - vals = [-1.21465, -0.334734, 1.38879] - ------------------------------------------------------------------------- --- Test harness - -main :: IO () -main = $(defaultMainGenerator) diff --git a/test/TestAReal2.hs b/test/TestAReal2.hs deleted file mode 100644 --- a/test/TestAReal2.hs +++ /dev/null @@ -1,86 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -import Data.Maybe -import Data.Ratio -import Test.Tasty -import Test.Tasty.QuickCheck -import Test.Tasty.HUnit -import Test.Tasty.TH - -import Data.Polynomial (UPolynomial, X (..)) -import qualified Data.Polynomial as P -import Data.AlgebraicNumber.Real - -import Control.Monad -import System.IO - -{-------------------------------------------------------------------- - Num ---------------------------------------------------------------------} - -prop_add_comm = - forAll areals $ \a -> - forAll areals $ \b -> - a + b == b + a - -prop_add_assoc = - forAll areals $ \a -> - forAll areals $ \b -> - forAll areals $ \c -> - a + (b + c) == (a + b) + c - -prop_add_unitL = - forAll areals $ \a -> - 0 + a == a - -prop_add_unitR = - forAll areals $ \a -> - a + 0 == a - -prop_mult_comm = - forAll areals $ \a -> - forAll areals $ \b -> - a * b == b * a - -prop_mult_assoc = - forAll areals $ \a -> - forAll areals $ \b -> - forAll areals $ \c -> - a * (b * c) == (a * b) * c - -prop_mult_unitL = - forAll areals $ \a -> - 1 * a == a - -prop_mult_unitR = - forAll areals $ \a -> - a * 1 == a - -prop_mult_dist = - forAll areals $ \a -> - forAll areals $ \b -> - forAll areals $ \c -> - a * (b + c) == a * b + a * c - -prop_mult_zero = - forAll areals $ \a -> - 0 * a == 0 - -{-------------------------------------------------------------------- - Generators ---------------------------------------------------------------------} - -areals :: Gen AReal -areals = oneof $ map return $ samples - -samples :: [AReal] -samples = [0, 1, -1, 2, -2] ++ concatMap realRoots ps - where - x = P.var X - ps = [x^2 - 2, x^2 - 3 {- , x^3 - 2, x^6 + 6*x^3 - 2*x^2 + 9 -}] - ------------------------------------------------------------------------- --- Test harness - -main :: IO () -main = $(defaultMainGenerator) diff --git a/test/TestArith.hs b/test/TestArith.hs deleted file mode 100644 --- a/test/TestArith.hs +++ /dev/null @@ -1,472 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -module Main (main) where - -import Control.Monad -import Data.List -import qualified Data.IntMap as IM -import qualified Data.IntSet as IS -import qualified Data.Map as Map -import qualified Data.Set as Set -import Data.VectorSpace - -import Test.Tasty -import Test.Tasty.QuickCheck hiding ((.&&.), (.||.)) -import Test.Tasty.HUnit -import Test.Tasty.TH -import qualified Test.QuickCheck as QC -import qualified Test.QuickCheck.Monadic as QM - -import qualified Data.Interval as Interval -import Data.OptDir - -import ToySolver.Data.AlgebraicNumber.Real -import ToySolver.Data.ArithRel -import ToySolver.Data.FOL.Arith -import qualified ToySolver.Data.LA as LA -import qualified ToySolver.Data.Polynomial as P -import ToySolver.Data.Var - -import qualified ToySolver.Arith.FourierMotzkin as FourierMotzkin -import qualified ToySolver.Arith.FourierMotzkin.Optimization as FMOpt -import qualified ToySolver.Arith.OmegaTest as OmegaTest -import qualified ToySolver.Arith.OmegaTest.Base as OmegaTest -import qualified ToySolver.Arith.Cooper as Cooper -import qualified ToySolver.Arith.CAD as CAD -import qualified ToySolver.Arith.Simplex2 as Simplex2 -import qualified ToySolver.Arith.ContiTraverso as ContiTraverso -import qualified ToySolver.Arith.VirtualSubstitution as VirtualSubstitution - ------------------------------------------------------------------------- - -{- -Example from the OmegaTest paper - -7x + 12y + 31z = 17 -3x + 5y + 14z = 7 -1 ≤ x ≤ 40 --50 ≤ y ≤ 50 - -satisfiable in R -satisfiable in Z - -(declare-fun x () Int) -(declare-fun y () Int) -(declare-fun z () Int) -(assert (= (+ (* 7 x) (* 12 y) (* 31 z)) 17)) -(assert (= (+ (* 3 x) (* 5 y) (* 14 z)) 7)) -(assert (<= 1 x)) -(assert (<= x 40)) -(assert (<= (- 50) y)) -(assert (<= y 50)) -(check-sat) ; => sat -(get-model) - -Just (DNF {unDNF = [[Nonneg (fromTerms [(-17,-1),(7,0),(12,1),(31,2)]),Nonneg (fromTerms [(17,-1),(-7,0),(-12,1),(-31,2)]),Nonneg (fromTerms [(-7,-1),(3,0),(5,1),(14,2)]),Nonneg (fromTerms [(7,-1),(-3,0),(-5,1),(-14,2)]),Nonneg (fromTerms [(-1,-1),(1,0)]),Nonneg (fromTerms [(40,-1),(-1,0)]),Nonneg (fromTerms [(50,-1),(1,1)]),Nonneg (fromTerms [(50,-1),(-1,1)])]]}) - -7x+12y+31z - 17 >= 0 --7x-12y-31z + 17 >= 0 -3x+5y+14z - 7 >= 0 --3x-5y-14z + 7 >= 0 -x - 1 >= 0 --x + 40 >= 0 -y + 50 >= 0 --y + 50 >= 0 --} -test1 :: Formula (Atom Rational) -test1 = c1 .&&. c2 .&&. c3 .&&. c4 - where - x = Var 0 - y = Var 1 - z = Var 2 - c1 = 7*x + 12*y + 31*z .==. 17 - c2 = 3*x + 5*y + 14*z .==. 7 - c3 = 1 .<=. x .&&. x .<=. 40 - c4 = (-50) .<=. y .&&. y .<=. 50 - -test1' :: (VarSet, [LA.Atom Rational]) -test1' = (IS.fromList [0,1,2], [c1, c2] ++ c3 ++ c4) - where - x = LA.var 0 - y = LA.var 1 - z = LA.var 2 - c1 = 7*^x ^+^ 12*^y ^+^ 31*^z .==. LA.constant 17 - c2 = 3*^x ^+^ 5*^y ^+^ 14*^z .==. LA.constant 7 - c3 = [LA.constant 1 .<=. x, x .<=. LA.constant 40] - c4 = [LA.constant (-50) .<=. y, y .<=. LA.constant 50] - - -{- -Example from the OmegaTest paper - -27 ≤ 11x+13y ≤ 45 --10 ≤ 7x-9y ≤ 4 - -satisfiable in R -but unsatisfiable in Z - -(declare-fun x () Int) -(declare-fun y () Int) -(define-fun t1 () Int (+ (* 11 x) (* 13 y))) -(define-fun t2 () Int (- (* 7 x) (* 9 y))) -(assert (<= 27 t1)) -(assert (<= t1 45)) -(assert (<= (- 10) t2)) -(assert (<= t2 4)) -(check-sat) ; unsat -(get-model) --} -test2 :: Formula (Atom Rational) -test2 = c1 .&&. c2 - where - x = Var 0 - y = Var 1 - t1 = 11*x + 13*y - t2 = 7*x - 9*y - c1 = 27 .<=. t1 .&&. t1 .<=. 45 - c2 = (-10) .<=. t2 .&&. t2 .<=. 4 - -test2' :: (VarSet, [LA.Atom Rational]) -test2' = - ( IS.fromList [0,1] - , [ LA.constant 27 .<=. t1 - , t1 .<=. LA.constant 45 - , LA.constant (-10) .<=. t2 - , t2 .<=. LA.constant 4 - ] - ) - where - x = LA.var 0 - y = LA.var 1 - t1 = 11*^x ^+^ 13*^y - t2 = 7*^x ^-^ 9*^y - - -genLAExpr :: [Var] -> Gen (LA.Expr Rational) -genLAExpr vs = do - size <- choose (0,3) - liftM LA.fromTerms $ replicateM size $ do - x <- elements (LA.unitVar : vs) - c <- arbitrary - return (c,x) - -genLAExprSmallInt :: [Var] -> Gen (LA.Expr Rational) -genLAExprSmallInt vs = do - size <- choose (0,3) - liftM LA.fromTerms $ replicateM size $ do - x <- elements (LA.unitVar : vs) - c <- choose (-10,10) - return (fromInteger c,x) - -genQFLAConj :: Gen (VarSet, [LA.Atom Rational]) -genQFLAConj = do - nv <- choose (0, 5) - nc <- choose (0, 5) - let vs = IS.fromList [1..nv] - cs <- replicateM nc $ do - op <- elements [Lt, Le, Ge, Gt, Eql] -- , NEq - lhs <- genLAExpr [1..nv] - rhs <- genLAExpr [1..nv] - return $ arithRel op lhs rhs - return (vs, cs) - -genQFLAConjSmallInt :: Gen (VarSet, [LA.Atom Rational]) -genQFLAConjSmallInt = do - nv <- choose (0, 3) - nc <- choose (0, 3) - let vs = IS.fromList [1..nv] - cs <- replicateM nc $ do - op <- elements [Lt, Le, Ge, Gt, Eql] -- , NEq - lhs <- genLAExprSmallInt [1..nv] - rhs <- genLAExprSmallInt [1..nv] - return $ arithRel op lhs rhs - return (vs, cs) - -genModel :: Arbitrary a => VarSet -> Gen (Model a) -genModel xs = do - liftM IM.fromList $ forM (IS.toList xs) $ \x -> do - val <- arbitrary - return (x,val) - ------------------------------------------------------------------------- - -prop_FourierMotzkin_solve :: Property -prop_FourierMotzkin_solve = - forAll genQFLAConj $ \(vs,cs) -> - case FourierMotzkin.solve vs cs of - Nothing -> forAll (genModel vs) $ \m -> all (LA.evalAtom m) cs == False - Just m -> property $ all (LA.evalAtom m) cs - -case_FourierMotzkin_test1 :: IO () -case_FourierMotzkin_test1 = - case uncurry FourierMotzkin.solve test1' of - Nothing -> assertFailure "expected: Just\n but got: Nothing" - Just m -> - forM_ (snd test1') $ \a -> do - LA.evalAtom m a @?= True - -case_FourierMotzkin_test2 :: IO () -case_FourierMotzkin_test2 = - case uncurry FourierMotzkin.solve test2' of - Nothing -> assertFailure "expected: Just\n but got: Nothing" - Just m -> - forM_ (snd test2') $ \a -> do - LA.evalAtom m a @?= True - -{- -Maximize - obj: x1 + 2 x2 + 3 x3 + x4 -Subject To - c1: - x1 + x2 + x3 + 10 x4 <= 20 - c2: x1 - 3 x2 + x3 <= 30 - c3: x2 - 3.5 x4 = 0 -Bounds - 0 <= x1 <= 40 - 2 <= x4 <= 3 -End --} -case_FourierMotzkinOptimization_test1 :: IO () -case_FourierMotzkinOptimization_test1 = do - Interval.upperBound' i @?= (3005/24, True) - and [LA.evalAtom m c | c <- cs] @?= True - where - (i, f) = FMOpt.optimize (IS.fromList vs) OptMax obj cs - m = f (3005/24) - - vs@[x1,x2,x3,x4] = [1..4] - obj = LA.fromTerms [(1,x1), (2,x2), (3,x3), (1,x4)] - cs = [ LA.fromTerms [(-1,x1), (1,x2), (1,x3), (10,x4)] .<=. LA.constant 20 - , LA.fromTerms [(1,x1), (-3,x2), (1,x3)] .<=. LA.constant 30 - , LA.fromTerms [(1,x2), (-3.5,x4)] .==. LA.constant 0 - , LA.fromTerms [(1,x1)] .>=. LA.constant 0 - , LA.fromTerms [(1,x1)] .<=. LA.constant 40 - , LA.fromTerms [(1,x2)] .>=. LA.constant 0 - , LA.fromTerms [(1,x3)] .>=. LA.constant 0 - , LA.fromTerms [(1,x4)] .>=. LA.constant 2 - , LA.fromTerms [(1,x4)] .<=. LA.constant 3 - ] - ------------------------------------------------------------------------- - -prop_VirtualSubstitution_solve :: Property -prop_VirtualSubstitution_solve = - forAll genQFLAConj $ \(vs,cs) -> - case VirtualSubstitution.solve vs cs of - Nothing -> forAll (genModel vs) $ \m -> all (LA.evalAtom m) cs == False - Just m -> property $ all (LA.evalAtom m) cs - -case_VirtualSubstitution_test1 :: IO () -case_VirtualSubstitution_test1 = - case uncurry VirtualSubstitution.solve test1' of - Nothing -> assertFailure "expected: Just\n but got: Nothing" - Just m -> - forM_ (snd test1') $ \a -> do - LA.evalAtom m a @?= True - -case_VirtualSubstitution_test2 :: IO () -case_VirtualSubstitution_test2 = - case uncurry VirtualSubstitution.solve test2' of - Nothing -> assertFailure "expected: Just\n but got: Nothing" - Just m -> - forM_ (snd test2') $ \a -> do - LA.evalAtom m a @?= True - ------------------------------------------------------------------------- - --- too slow -disabled_prop_CAD_solve :: Property -disabled_prop_CAD_solve = - forAll genQFLAConj $ \(vs,cs) -> - let vs' = Set.fromAscList $ IS.toAscList vs - cs' = map toPRel cs - in case CAD.solve vs' cs' of - Nothing -> - forAll (genModel vs) $ \m -> - let m' = Map.fromAscList [(x, fromRational v) | (x,v) <- IM.toAscList m] - in all (evalPAtom m') cs' == False - Just m -> property $ all (evalPAtom m) cs' - -case_CAD_test1 :: IO () -case_CAD_test1 = - case CAD.solve vs cs of - Nothing -> assertFailure "expected: Just\n but got: Nothing" - Just m -> - forM_ cs $ \a -> do - evalPAtom m a @?= True - where - vs = Set.fromAscList $ IS.toAscList $ fst test1' - cs = map toPRel $ snd test1' - -case_CAD_test2 :: IO () -case_CAD_test2 = - case CAD.solve vs cs of - Nothing -> assertFailure "expected: Just\n but got: Nothing" - Just m -> - forM_ cs $ \a -> do - evalPAtom m a @?= True - where - vs = Set.fromAscList $ IS.toAscList $ fst test2' - cs = map toPRel $ snd test2' - -case_CAD_test_nonlinear_multivariate :: IO () -case_CAD_test_nonlinear_multivariate = - case CAD.solve vs cs of - Nothing -> assertFailure "expected: Just\n but got: Nothing" - Just m -> - forM_ cs $ \a -> do - evalPAtom m a @?= True - where - vs = Set.fromList [0,1] - cs = [x^2 - y^2 - 2 .==. 0, 2*y*x .==. 0] - x = P.var (0::Int) - y = P.var 1 - -toP :: LA.Expr Rational -> P.Polynomial Rational Int -toP e = P.fromTerms [(c, if x == LA.unitVar then P.mone else P.var x) | (c,x) <- LA.terms e] - -toPRel :: LA.Atom Rational -> ArithRel (P.Polynomial Rational Int) -toPRel = fmap toP - -evalP :: Map.Map Int AReal -> P.Polynomial Rational Int -> AReal -evalP m p = P.eval (m Map.!) $ P.mapCoeff fromRational p - -evalPAtom :: Map.Map Int AReal -> ArithRel (P.Polynomial Rational Int) -> Bool -evalPAtom m (ArithRel lhs op rhs) =　evalOp op (evalP m lhs) (evalP m rhs) - ------------------------------------------------------------------------- - -prop_OmegaTest_solve :: Property -prop_OmegaTest_solve = - forAll genQFLAConjSmallInt $ \(vs,cs) -> - case OmegaTest.solve OmegaTest.defaultOptions vs cs of - Nothing -> forAll (genModel vs) $ \m -> all (LA.evalAtom (fmap fromInteger m)) cs == False - Just m -> property $ all (LA.evalAtom (fmap fromInteger m)) cs - -case_OmegaTest_test1 :: IO () -case_OmegaTest_test1 = - case uncurry (OmegaTest.solve OmegaTest.defaultOptions) test1' of - Nothing -> assertFailure "expected: Just\n but got: Nothing" - Just m -> do - forM_ (snd test1') $ \a -> do - LA.evalAtom (IM.map fromInteger m) a @?= True - -case_OmegaTest_test2 :: IO () -case_OmegaTest_test2 = - case uncurry (OmegaTest.solve OmegaTest.defaultOptions) test2' of - Just _ -> assertFailure "expected: Nothing\n but got: Just" - Nothing -> return () - -prop_OmegaTest_zmod = - forAll arbitrary $ \a -> - forAll arbitrary $ \b -> - b /= 0 ==> - let c = a `OmegaTest.zmod` b - in (a - c) `mod` b == 0 && abs c <= abs b `div` 2 - ------------------------------------------------------------------------- - -prop_Cooper_solve :: Property -prop_Cooper_solve = - forAll genQFLAConjSmallInt $ \(vs,cs) -> - case Cooper.solve vs cs of - Nothing -> - (forAll (genModel vs) $ \m -> all (LA.evalAtom (fmap fromInteger m)) cs == False) QC..&&. - property (OmegaTest.solve OmegaTest.defaultOptions vs cs == Nothing) - Just m -> property $ all (LA.evalAtom (fmap fromInteger m)) cs - -case_Cooper_test1 :: IO () -case_Cooper_test1 = - case uncurry Cooper.solve test1' of - Nothing -> assertFailure "expected: Just\n but got: Nothing" - Just m -> do - forM_ (snd test1') $ \a -> do - LA.evalAtom (IM.map fromInteger m) a @?= True - -case_Cooper_test2 :: IO () -case_Cooper_test2 = - case uncurry Cooper.solve test2' of - Just _ -> assertFailure "expected: Nothing\n but got: Just" - Nothing -> return () - ------------------------------------------------------------------------- - -prop_Simplex2_solve :: Property -prop_Simplex2_solve = QM.monadicIO $ do - (vs,cs) <- QM.pick genQFLAConj - join $ QM.run $ do - solver <- Simplex2.newSolver - m <- liftM IM.fromList $ forM (IS.toList vs) $ \v -> do - v2 <- Simplex2.newVar solver - return (v, LA.var v2) - let cs' = map (LA.applySubstAtom m) cs - forM_ cs' $ \c -> do - Simplex2.assertAtomEx solver c - ret <- Simplex2.check solver - if ret then do - m <- Simplex2.getModel solver - return $ forM_ cs' $ \c -> QM.assert (LA.evalAtom m c) - else do - return $ return () - -case_Simplex2_test1 :: IO () -case_Simplex2_test1 = do - solver <- Simplex2.newSolver - forM_ (IS.toList (fst test1')) $ \_ -> Simplex2.newVar solver - mapM_ (Simplex2.assertAtomEx solver) (snd test1') - ret <- Simplex2.check solver - ret @?= True - -case_Simplex2_test2 :: IO () -case_Simplex2_test2 = do - solver <- Simplex2.newSolver - forM_ (IS.toList (fst test2')) $ \_ -> Simplex2.newVar solver - mapM_ (Simplex2.assertAtomEx solver) (snd test2') - ret <- Simplex2.check solver - ret @?= True - -prop_Simplex2_backtrack :: Property -prop_Simplex2_backtrack = QM.monadicIO $ do - (vs,cs) <- QM.pick genQFLAConj - (vs2,cs2) <- QM.pick genQFLAConj - - join $ QM.run $ do - solver <- Simplex2.newSolver - m <- liftM IM.fromList $ forM (IS.toList (vs `IS.union` vs2)) $ \v -> do - v2 <- Simplex2.newVar solver - return (v, LA.var v2) - forM_ cs $ \c -> do - Simplex2.assertAtomEx solver (LA.applySubstAtom m c) - ret <- Simplex2.check solver - if ret then do - Simplex2.pushBacktrackPoint solver - forM_ cs2 $ \c -> do - Simplex2.assertAtomEx solver (LA.applySubstAtom m c) - _ <- Simplex2.check solver - Simplex2.popBacktrackPoint solver - ret2 <- Simplex2.check solver - return $ QM.assert ret2 - else do - return $ return () - ------------------------------------------------------------------------- - --- Too slow - -disabled_case_ContiTraverso_test1 :: IO () -disabled_case_ContiTraverso_test1 = - case ContiTraverso.solve P.grlex (fst test1') OptMin (LA.constant 0) (snd test1') of - Nothing -> assertFailure "expected: Just\n but got: Nothing" - Just m -> do - forM_ (snd test1') $ \a -> do - LA.evalAtom (IM.map fromInteger m) a @?= True - -disabled_case_ContiTraverso_test2 :: IO () -disabled_case_ContiTraverso_test2 = - case ContiTraverso.solve P.grlex (fst test2') OptMin (LA.constant 0) (snd test2') of - Just _ -> assertFailure "expected: Nothing\n but got: Just" - Nothing -> return () - ------------------------------------------------------------------------- --- Test harness - -main :: IO () -main = $(defaultMainGenerator) diff --git a/test/TestCongruenceClosure.hs b/test/TestCongruenceClosure.hs deleted file mode 100644 --- a/test/TestCongruenceClosure.hs +++ /dev/null @@ -1,34 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -Wall #-} -module Main (main) where - -import Test.Tasty -import Test.Tasty.HUnit -import Test.Tasty.TH - -import ToySolver.CongruenceClosure - ------------------------------------------------------------------------- --- Test cases - -case_1 :: IO () -case_1 = do - solver <- newSolver - a <- newVar solver - b <- newVar solver - c <- newVar solver - d <- newVar solver - - merge solver (FTConst a, c) - ret <- areCongruent solver (FTApp a b) (FTApp c d) - ret @?= False - - merge solver (FTConst b, d) - ret <- areCongruent solver (FTApp a b) (FTApp c d) - ret @?= True - ------------------------------------------------------------------------- --- Test harness - -main :: IO () -main = $(defaultMainGenerator) diff --git a/test/TestContiTraverso.hs b/test/TestContiTraverso.hs deleted file mode 100644 --- a/test/TestContiTraverso.hs +++ /dev/null @@ -1,104 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -module Main (main) where - -import Control.Monad -import Data.List -import qualified Data.IntMap as IM -import qualified Data.IntSet as IS -import qualified Data.Map as Map -import Data.VectorSpace - -import Test.Tasty -import Test.Tasty.QuickCheck -import Test.Tasty.HUnit -import Test.Tasty.TH - -import Data.OptDir - -import ToySolver.Arith.ContiTraverso - -import ToySolver.Data.ArithRel -import qualified ToySolver.Data.LA as LA -import ToySolver.Data.Polynomial (Polynomial) -import qualified ToySolver.Data.Polynomial as P - --- http://madscientist.jp/~ikegami/articles/IntroSequencePolynomial.html --- optimum is (3,2,0) -case_ikegami = solve P.grlex (IS.fromList vs) OptMin obj cs @?= Just (IM.fromList [(1,3),(2,2),(3,0)]) - where - vs = [1..3] - [x,y,z] = map LA.var vs - cs = [ 2*^x ^+^ 2*^y ^+^ 2*^z .==. LA.constant 10 - , 3*^x ^+^ y ^+^ z .==. LA.constant 11 - , x .>=. LA.constant 0 - , y .>=. LA.constant 0 - , z .>=. LA.constant 0 - ] - obj = x ^+^ 2*^y ^+^ 3*^z - -case_ikegami' = solve' P.grlex (IS.fromList vs) obj cs @?= Just (IM.fromList [(1,3),(2,2),(3,0)]) - where - vs@[x,y,z] = [1..3] - cs = [ (LA.fromTerms [(2,x),(2,y),(2,z)], 10) - , (LA.fromTerms [(3,x),(1,y),(1,z)], 11) - ] - obj = LA.fromTerms [(1,x),(2,y),(3,z)] - --- http://posso.dm.unipi.it/users/traverso/conti-traverso-ip.ps --- optimum is (39, 75, 1, 8, 122) -disabled_case_test1 = solve P.grlex (IS.fromList vs) OptMin obj cs @?= Just (IM.fromList [(1,39), (2,75), (3,1), (4,8), (5,122)]) - where - vs = [1..5] - vs2@[x1,x2,x3,x4,x5] = map LA.var vs - cs = [ 2*^x1 ^+^ 5*^x2 ^-^ 3*^x3 ^+^ x4 ^-^ 2*^x5 .==. LA.constant 214 - , x1 ^+^ 7*^x2 ^+^ 2*^x3 ^+^ 3*^x4 ^+^ x5 .==. LA.constant 712 - , 4*^x1 ^-^ 2*^x2 ^-^ x3 ^-^ 5*^x4 ^+^ 3*^x5 .==. LA.constant 331 - ] ++ - [ v .>=. LA.constant 0 | v <- vs2 ] - obj = x1 ^+^ x2 ^+^ x3 ^+^ x4 ^+^ x5 - -disabled_case_test1' = solve' P.grlex (IS.fromList vs) obj cs @?= Just (IM.fromList [(1,39), (2,75), (3,1), (4,8), (5,122)]) - where - vs@[x1,x2,x3,x4,x5] = [1..5] - cs = [ (LA.fromTerms [(2, x1), ( 5, x2), (-3, x3), ( 1,x4), (-2, x5)], 214) - , (LA.fromTerms [(1, x1), ( 7, x2), ( 2, x3), ( 3,x4), ( 1, x5)], 712) - , (LA.fromTerms [(4, x1), (-2, x2), (-1, x3), (-5,x4), ( 3, x5)], 331) - ] - obj = LA.fromTerms [(1,x1),(1,x2),(1,x3),(1,x4),(1,x5)] - --- optimum is (0,2,2) -case_test2 = solve P.grlex (IS.fromList vs) OptMin obj cs @?= Just (IM.fromList [(1,0),(2,2),(3,2)]) - where - vs = [1..3] - vs2@[x1,x2,x3] = map LA.var vs - cs = [ 2*^x1 ^+^ 3*^x2 ^-^ x3 .==. LA.constant 4 ] ++ - [ v .>=. LA.constant 0 | v <- vs2 ] - obj = 2*^x1 ^+^ x2 - -case_test2' = solve' P.grlex (IS.fromList vs) obj cs @?= Just (IM.fromList [(1,0),(2,2),(3,2)]) - where - vs@[x1,x2,x3] = [1..3] - cs = [ (LA.fromTerms [(2, x1), (3, x2), (-1, x3)], 4) ] - obj = LA.fromTerms [(2,x1),(1,x2)] - --- infeasible -case_test3 = solve P.grlex (IS.fromList vs) OptMin obj cs @?= Nothing - where - vs = [1..3] - vs2@[x1,x2,x3] = map LA.var vs - cs = [ 2*^x1 ^+^ 2*^x2 ^+^ 2*^x3 .==. LA.constant 3 ] ++ - [ v .>=. LA.constant 0 | v <- vs2 ] - obj = x1 - -case_test3' = solve' P.grlex (IS.fromList vs) obj cs @?= Nothing - where - vs@[x1,x2,x3] = [1..3] - cs = [ (LA.fromTerms [(2, x1), (2, x2), (2, x3)], 3) ] - obj = LA.fromTerms [(1,x1)] - ------------------------------------------------------------------------- --- Test harness - -main :: IO () -main = $(defaultMainGenerator) - diff --git a/test/TestLPFile.hs b/test/TestLPFile.hs deleted file mode 100644 --- a/test/TestLPFile.hs +++ /dev/null @@ -1,66 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -module Main (main) where - -import Control.Monad -import Data.List -import Data.Maybe -import Test.Tasty -import Test.Tasty.QuickCheck -import Test.Tasty.HUnit -import Test.Tasty.TH -import ToySolver.Data.MIP.LPFile - -case_testdata = checkString "testdata" testdata -case_test_indicator = checkFile "samples/lp/test-indicator.lp" -case_test_qcp = checkFile "samples/lp/test-qcp.lp" -case_test_qcp2 = checkFile "samples/lp/test-qcp2.lp" -case_test_qp = checkFile "samples/lp/test-qp.lp" -case_empty_obj_1 = checkFile "samples/lp/empty_obj_1.lp" -case_empty_obj_2 = checkFile "samples/lp/empty_obj_2.lp" - ------------------------------------------------------------------------- --- Sample data - -testdata :: String -testdata = unlines - [ "Maximize" - , " obj: x1 + 2 x2 + 3 x3 + x4" - , "Subject To" - , " c1: - x1 + x2 + x3 + 10 x4 <= 20" - , " c2: x1 - 3 x2 + x3 <= 30" - , " c3: x2 - 3.5 x4 = 0" - , "Bounds" - , " 0 <= x1 <= 40" - , " 2 <= x4 <= 3" - , "General" - , " x4" - , "End" - ] - ------------------------------------------------------------------------- --- Utilities - -checkFile :: FilePath -> IO () -checkFile fname = do - r <- parseFile fname - case r of - Left err -> assertFailure $ show err - Right lp -> - case render lp of - Left err -> assertFailure ("render failure: " ++ err) - Right _ -> return () - -checkString :: String -> String -> IO () -checkString name str = do - case parseString name str of - Left err -> assertFailure $ show err - Right lp -> - case render lp of - Left err -> assertFailure ("render failure: " ++ err) - Right _ -> return () - ------------------------------------------------------------------------- --- Test harness - -main :: IO () -main = $(defaultMainGenerator) diff --git a/test/TestMIPSolver2.hs b/test/TestMIPSolver2.hs deleted file mode 100644 --- a/test/TestMIPSolver2.hs +++ /dev/null @@ -1,125 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -module Main (main) where - -import Control.Monad -import Data.List -import Data.Ratio -import qualified Data.IntMap as IM -import qualified Data.IntSet as IS -import Data.VectorSpace -import Test.Tasty -import Test.Tasty.HUnit -import Test.Tasty.TH -import Text.Printf - -import qualified ToySolver.Data.LA as LA -import qualified ToySolver.Arith.Simplex2 as Simplex2 -import ToySolver.Arith.Simplex2 -import qualified ToySolver.Arith.MIPSolver2 as MIPSolver2 - ------------------------------------------------------------------------- - -example1 :: (OptDir, LA.Expr Rational, [Atom Rational], IS.IntSet) -example1 = (optdir, obj, cs, ivs) - where - optdir = OptMax - x1 = LA.var 1 - x2 = LA.var 2 - x3 = LA.var 3 - x4 = LA.var 4 - obj = x1 ^+^ 2 *^ x2 ^+^ 3 *^ x3 ^+^ x4 - cs = - [ (-1) *^ x1 ^+^ x2 ^+^ x3 ^+^ 10*^x4 .<=. LA.constant 20 - , x1 ^-^ 3 *^ x2 ^+^ x3 .<=. LA.constant 30 - , x2 ^-^ 3.5 *^ x4 .==. LA.constant 0 - , LA.constant 0 .<=. x1 - , x1 .<=. LA.constant 40 - , LA.constant 0 .<=. x2 - , LA.constant 0 .<=. x3 - , LA.constant 2 .<=. x4 - , x4 .<=. LA.constant 3 - ] - ivs = IS.singleton 4 - -case_test1 = do - let (optdir, obj, cs, ivs) = example1 - lp <- Simplex2.newSolver - replicateM 5 (Simplex2.newVar lp) - setOptDir lp optdir - setObj lp obj - mapM_ (Simplex2.assertAtom lp) cs - mip <- MIPSolver2.newSolver lp ivs - ret <- MIPSolver2.optimize mip - - ret @?= Simplex2.Optimum - - Just m <- MIPSolver2.getBestModel mip - forM_ [(1,40),(2,21/2),(3,39/2),(4,3)] $ \(var, val) -> - m IM.! var @?= val - - Just v <- MIPSolver2.getBestValue mip - v @?= 245/2 - -case_test1' = do - let (optdir, obj, cs, ivs) = example1 - lp <- Simplex2.newSolver - replicateM 5 (Simplex2.newVar lp) - setOptDir lp (f optdir) - setObj lp (negateV obj) - mapM_ (Simplex2.assertAtom lp) cs - mip <- MIPSolver2.newSolver lp ivs - ret <- MIPSolver2.optimize mip - - ret @?= Simplex2.Optimum - - Just m <- MIPSolver2.getBestModel mip - forM_ [(1,40),(2,21/2),(3,39/2),(4,3)] $ \(var, val) -> - m IM.! var @?= val - - Just v <- MIPSolver2.getBestValue mip - v @?= -245/2 - - where - f OptMin = OptMax - f OptMax = OptMin - --- 『数理計画法の基礎』(坂和 正敏) p.109 例 3.8 -example2 = (optdir, obj, cs, ivs) - where - optdir = OptMin - [x1,x2,x3] = map LA.var [1..3] - obj = (-1) *^ x1 ^-^ 3 *^ x2 ^-^ 5 *^ x3 - cs = - [ 3 *^ x1 ^+^ 4 *^ x2 .<=. LA.constant 10 - , 2 *^ x1 ^+^ x2 ^+^ x3 .<=. LA.constant 7 - , 3 *^ x1 ^+^ x2 ^+^ 4 *^ x3 .==. LA.constant 12 - , LA.constant 0 .<=. x1 - , LA.constant 0 .<=. x2 - , LA.constant 0 .<=. x3 - ] - ivs = IS.fromList [1,2] - -case_test2 = do - let (optdir, obj, cs, ivs) = example2 - lp <- Simplex2.newSolver - replicateM 4 (Simplex2.newVar lp) - setOptDir lp optdir - setObj lp obj - mapM_ (Simplex2.assertAtom lp) cs - mip <- MIPSolver2.newSolver lp ivs - ret <- MIPSolver2.optimize mip - - ret @?= Simplex2.Optimum - - Just m <- MIPSolver2.getBestModel mip - forM_ [(1,0),(2,2),(3,5/2)] $ \(var, val) -> - m IM.! var @?= val - - Just v <- MIPSolver2.getBestValue mip - v @?= -37/2 - ------------------------------------------------------------------------- --- Test harness - -main :: IO () -main = $(defaultMainGenerator) diff --git a/test/TestMPSFile.hs b/test/TestMPSFile.hs deleted file mode 100644 --- a/test/TestMPSFile.hs +++ /dev/null @@ -1,68 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -module Main (main) where - -import Control.Monad -import Data.List -import Data.Maybe -import Test.Tasty -import Test.Tasty.QuickCheck -import Test.Tasty.HUnit -import Test.Tasty.TH -import ToySolver.Data.MIP.MPSFile - -case_testdata = checkString "testdata" testdata -case_example2 = checkFile "samples/mps/example2.mps" -case_ind1 = checkFile "samples/mps/ind1.mps" -case_intvar1 = checkFile "samples/mps/intvar1.mps" -case_intvar2 = checkFile "samples/mps/intvar2.mps" -case_quadobj1 = checkFile "samples/mps/quadobj1.mps" -case_quadobj2 = checkFile "samples/mps/quadobj2.mps" -case_ranges = checkFile "samples/mps/ranges.mps" -case_sos = checkFile "samples/mps/sos.mps" -case_sc = checkFile "samples/mps/sc.mps" - ------------------------------------------------------------------------- --- Sample data - -testdata :: String -testdata = unlines - [ "NAME example2.mps" - , "ROWS" - , " N obj " - , " L c1 " - , " L c2 " - , "COLUMNS" - , " x1 obj -1 c1 -1" - , " x1 c2 1" - , " x2 obj -2 c1 1" - , " x2 c2 -3" - , " x3 obj -3 c1 1" - , " x3 c2 1" - , "RHS" - , " rhs c1 20 c2 30" - , "BOUNDS" - , " UP BOUND x1 40" - , "ENDATA" - ] - ------------------------------------------------------------------------- --- Utilities - -checkFile :: FilePath -> IO () -checkFile fname = do - r <- parseFile fname - case r of - Left err -> assertFailure (show err) - Right lp -> return () - -checkString :: String -> String -> IO () -checkString name str = do - case parseString name str of - Left err -> assertFailure (show err) - Right lp -> return () - ------------------------------------------------------------------------- --- Test harness - -main :: IO () -main = $(defaultMainGenerator) diff --git a/test/TestPolynomial.hs b/test/TestPolynomial.hs --- a/test/TestPolynomial.hs +++ b/test/TestPolynomial.hs @@ -818,7 +818,7 @@ ------------------------------------------------------------------------ -- http://www14.in.tum.de/konferenzen/Jass07/courses/1/Bulwahn/Buhlwahn_Paper.pdf -case_Hensel_Lifting :: IO () +case_Hensel_Lifting :: Assertion case_Hensel_Lifting = do Hensel.hensel f fs 2 @?= [x^(2::Int) + 5*x + 18, x + 5] Hensel.hensel f fs 3 @?= [x^(2::Int) + 105*x + 43, x + 30] @@ -831,7 +831,7 @@ fs :: [UPolynomial $(FF.primeField 5)] fs = [x^(2::Int)+3, x] -case_cabook_proposition_5_10 :: IO () +case_cabook_proposition_5_10 :: Assertion case_cabook_proposition_5_10 = sum [ei * (product fs `P.div` fi) | (ei,fi) <- zip es fs] @?= 1 where @@ -840,7 +840,7 @@ fs = [x, x+1, x+2] es = Hensel.cabook_proposition_5_10 fs -case_cabook_proposition_5_11 :: IO () +case_cabook_proposition_5_11 :: Assertion case_cabook_proposition_5_11 = sum [ei * (product fs `P.div` fi) | (ei,fi) <- zip es fs] @?= g where @@ -852,7 +852,7 @@ ------------------------------------------------------------------------ -case_Zassenhaus_factor :: IO () +case_Zassenhaus_factor :: Assertion case_Zassenhaus_factor = actual @?= expected where x :: UPolynomial Integer @@ -862,7 +862,7 @@ actual = sort $ Zassenhaus.factor f expected = sort $ [(-1,1), (x^(2::Int)+x+1,1), (x^(3::Int)-x+2,1)] -case_Zassenhaus_zassenhaus_1 :: IO () +case_Zassenhaus_zassenhaus_1 :: Assertion case_Zassenhaus_zassenhaus_1 = actual @?= expected where x = P.var X @@ -871,7 +871,7 @@ actual = sort $ Zassenhaus.zassenhaus f expected = sort $ [x^(2::Int)+2*x+2, x^(2::Int)-2*x+2] -case_Zassenhaus_zassenhaus_2 :: IO () +case_Zassenhaus_zassenhaus_2 :: Assertion case_Zassenhaus_zassenhaus_2 = actual @?= expected where x = P.var X diff --git a/test/TestSAT.hs b/test/TestSAT.hs deleted file mode 100644 --- a/test/TestSAT.hs +++ /dev/null @@ -1,1238 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -module Main (main) where - -import Control.Monad -import Data.Array.IArray -import Data.IORef -import Data.List -import Data.Set (Set) -import qualified Data.Set as Set -import Data.IntSet (IntSet) -import qualified Data.IntSet as IntSet -import qualified System.Random as Rand - -import Test.Tasty -import Test.Tasty.QuickCheck hiding ((.&&.), (.||.)) -import Test.Tasty.HUnit -import Test.Tasty.TH -import qualified Test.QuickCheck.Monadic as QM - -import ToySolver.Data.LBool -import ToySolver.Data.BoolExpr -import ToySolver.Data.Boolean -import ToySolver.SAT -import ToySolver.SAT.Types -import ToySolver.SAT.TheorySolver -import qualified ToySolver.SAT.TseitinEncoder as Tseitin -import qualified ToySolver.SAT.MUS as MUS -import qualified ToySolver.SAT.MUS.QuickXplain as QuickXplain -import qualified ToySolver.SAT.MUS.CAMUS as CAMUS -import qualified ToySolver.SAT.MUS.DAA as DAA -import qualified ToySolver.SAT.PBO as PBO -import qualified ToySolver.SAT.PBNLC as PBNLC - -prop_solveCNF :: Property -prop_solveCNF = QM.monadicIO $ do - cnf@(nv,_) <- QM.pick arbitraryCNF - solver <- arbitrarySolver - ret <- QM.run $ solveCNF solver cnf - case ret of - Just m -> QM.assert $ evalCNF m cnf == True - Nothing -> do - forM_ [array (1,nv) (zip [1..nv] xs) | xs <- replicateM nv [True,False]] $ \m -> do - QM.assert $ evalCNF m cnf == False - -solveCNF :: Solver -> (Int,[Clause]) -> IO (Maybe Model) -solveCNF solver (nv,cs) = do - newVars_ solver nv - forM_ cs $ \c -> addClause solver c - ret <- solve solver - if ret then do - m <- getModel solver - return (Just m) - else do - return Nothing - -arbitraryCNF :: Gen (Int,[Clause]) -arbitraryCNF = do - nv <- choose (0,10) - nc <- choose (0,50) - cs <- replicateM nc $ do - len <- choose (0,10) - if nv == 0 then - return [] - else - replicateM len $ choose (-nv, nv) `suchThat` (/= 0) - return (nv, cs) - -evalCNF :: Model -> (Int,[Clause]) -> Bool -evalCNF m (_,cs) = all (evalClause m) cs - - -prop_solvePB :: Property -prop_solvePB = QM.monadicIO $ do - prob@(nv,_) <- QM.pick arbitraryPB - solver <- arbitrarySolver - ret <- QM.run $ solvePB solver prob - case ret of - Just m -> QM.assert $ evalPB m prob == True - Nothing -> do - forM_ [array (1,nv) (zip [1..nv] xs) | xs <- replicateM nv [True,False]] $ \m -> do - QM.assert $ evalPB m prob == False - -data PBRel = PBRelGE | PBRelEQ | PBRelLE deriving (Eq, Ord, Enum, Bounded, Show) - -instance Arbitrary PBRel where - arbitrary = arbitraryBoundedEnum - -evalPBRel :: Ord a => PBRel -> a -> a -> Bool -evalPBRel PBRelGE = (>=) -evalPBRel PBRelLE = (<=) -evalPBRel PBRelEQ = (==) - -solvePB :: Solver -> (Int,[(PBRel,PBLinSum,Integer)]) -> IO (Maybe Model) -solvePB solver (nv,cs) = do - newVars_ solver nv - forM_ cs $ \(o,lhs,rhs) -> do - case o of - PBRelGE -> addPBAtLeast solver lhs rhs - PBRelLE -> addPBAtMost solver lhs rhs - PBRelEQ -> addPBExactly solver lhs rhs - ret <- solve solver - if ret then do - m <- getModel solver - return (Just m) - else do - return Nothing - -arbitraryPB :: Gen (Int,[(PBRel,PBLinSum,Integer)]) -arbitraryPB = do - nv <- choose (0,10) - nc <- choose (0,50) - cs <- replicateM nc $ do - rel <- arbitrary - len <- choose (0,10) - lhs <- - if nv == 0 then - return [] - else - replicateM len $ do - l <- choose (-nv, nv) `suchThat` (/= 0) - c <- arbitrary - return (c,l) - rhs <- arbitrary - return $ (rel,lhs,rhs) - return (nv, cs) - -evalPB :: Model -> (Int,[(PBRel,PBLinSum,Integer)]) -> Bool -evalPB m (_,cs) = all (\(o,lhs,rhs) -> evalPBRel o (evalPBLinSum m lhs) rhs) cs - - -prop_solvePBNLC :: Property -prop_solvePBNLC = QM.monadicIO $ do - prob@(nv,_) <- QM.pick arbitraryPBNLC - solver <- arbitrarySolver - ret <- QM.run $ solvePBNLC solver prob - case ret of - Just m -> QM.assert $ evalPBNLC m prob == True - Nothing -> do - forM_ [array (1,nv) (zip [1..nv] xs) | xs <- replicateM nv [True,False]] $ \m -> do - QM.assert $ evalPBNLC m prob == False - -solvePBNLC :: Solver -> (Int,[(PBRel,PBNLC.PBSum,Integer)]) -> IO (Maybe Model) -solvePBNLC solver (nv,cs) = do - newVars_ solver nv - enc <- Tseitin.newEncoder solver - forM_ cs $ \(o,lhs,rhs) -> do - case o of - PBRelGE -> PBNLC.addPBAtLeast enc lhs rhs - PBRelLE -> PBNLC.addPBAtMost enc lhs rhs - PBRelEQ -> PBNLC.addPBExactly enc lhs rhs - ret <- solve solver - if ret then do - m <- getModel solver - return (Just m) - else do - return Nothing - -arbitraryPBNLC :: Gen (Int,[(PBRel,PBNLC.PBSum,Integer)]) -arbitraryPBNLC = do - nv <- choose (0,10) - nc <- choose (0,50) - cs <- replicateM nc $ do - rel <- arbitrary - len <- choose (0,10) - lhs <- - if nv == 0 then - return [] - else - replicateM len $ do - ls <- listOf $ choose (-nv, nv) `suchThat` (/= 0) - c <- arbitrary - return (c,ls) - rhs <- arbitrary - return $ (rel,lhs,rhs) - return (nv, cs) - -evalPBNLC :: Model -> (Int,[(PBRel,PBNLC.PBSum,Integer)]) -> Bool -evalPBNLC m (_,cs) = all (\(o,lhs,rhs) -> evalPBRel o (PBNLC.evalPBSum m lhs) rhs) cs - - -prop_solveXOR :: Property -prop_solveXOR = QM.monadicIO $ do - prob@(nv,_) <- QM.pick arbitraryXOR - solver <- arbitrarySolver - ret <- QM.run $ solveXOR solver prob - case ret of - Just m -> QM.assert $ evalXOR m prob == True - Nothing -> do - forM_ [array (1,nv) (zip [1..nv] xs) | xs <- replicateM nv [True,False]] $ \m -> do - QM.assert $ evalXOR m prob == False - -solveXOR :: Solver -> (Int,[XORClause]) -> IO (Maybe Model) -solveXOR solver (nv,cs) = do - setCheckModel solver True - newVars_ solver nv - forM_ cs $ \c -> addXORClause solver (fst c) (snd c) - ret <- solve solver - if ret then do - m <- getModel solver - return (Just m) - else do - return Nothing - -arbitraryXOR :: Gen (Int,[XORClause]) -arbitraryXOR = do - nv <- choose (0,10) - nc <- choose (0,50) - cs <- replicateM nc $ do - len <- choose (0,10) - lhs <- - if nv == 0 then - return [] - else - replicateM len $ choose (-nv, nv) `suchThat` (/= 0) - rhs <- arbitrary - return (lhs,rhs) - return (nv, cs) - -evalXOR :: Model -> (Int,[XORClause]) -> Bool -evalXOR m (_,cs) = all (evalXORClause m) cs - - -newTheorySolver :: (Int, [Clause]) -> IO TheorySolver -newTheorySolver cnf@(nv,cs) = do - solver <- newSolver - newVars_ solver nv - forM_ cs $ \c -> addClause solver c - - ref <- newIORef [] - let tsolver = - TheorySolver - { thAssertLit = \_ l -> do - if abs l > nv then - return True - else do - m <- readIORef ref - case m of - [] -> addClause solver [l] - xs : xss -> writeIORef ref ((l : xs) : xss) - return True - , thCheck = \_ -> do - xs <- liftM concat $ readIORef ref - solveWith solver xs - , thExplain = \m -> do - case m of - Nothing -> do - ls <- getFailedAssumptions solver - return [-l | l <- ls] - Just _ -> return [] - , thPushBacktrackPoint = modifyIORef ref ([] :) - , thPopBacktrackPoint = modifyIORef ref tail - } - return tsolver - -prop_solveCNF_using_BooleanTheory :: Property -prop_solveCNF_using_BooleanTheory = QM.monadicIO $ do - cnf@(nv,cs) <- QM.pick arbitraryCNF - let cnf1 = (nv, [c | (i,c) <- zip [0..] cs, i `mod` 2 == 0]) - cnf2 = (nv, [c | (i,c) <- zip [0..] cs, i `mod` 2 /= 0]) - - solver <- arbitrarySolver - - ret <- QM.run $ do - newVars_ solver nv - - tsolver <- newTheorySolver cnf1 - setTheory solver tsolver - - forM_ (snd cnf2) $ \c -> addClause solver c - ret <- solve solver - if ret then do - m <- getModel solver - return (Just m) - else do - return Nothing - - case ret of - Just m -> QM.assert $ evalCNF m cnf == True - Nothing -> do - forM_ [array (1,nv) (zip [1..nv] xs) | xs <- replicateM nv [True,False]] $ \m -> do - QM.assert $ evalCNF m cnf == False - --- should be SAT -case_solve_SAT :: IO () -case_solve_SAT = do - solver <- newSolver - x1 <- newVar solver - x2 <- newVar solver - addClause solver [literal x1 True, literal x2 True] -- x1 or x2 - addClause solver [literal x1 True, literal x2 False] -- x1 or not x2 - addClause solver [literal x1 False, literal x2 False] -- not x1 or not x2 - ret <- solve solver - ret @?= True - --- shuld be UNSAT -case_solve_UNSAT :: IO () -case_solve_UNSAT = do - solver <- newSolver - x1 <- newVar solver - x2 <- newVar solver - addClause solver [literal x1 True, literal x2 True] -- x1 or x2 - addClause solver [literal x1 False, literal x2 True] -- not x1 or x2 - addClause solver [literal x1 True, literal x2 False] -- x1 or not x2 - addClause solver [literal x1 False, literal x2 False] -- not x2 or not x2 - ret <- solve solver - ret @?= False - --- top level でいきなり矛盾 -case_root_inconsistent :: IO () -case_root_inconsistent = do - solver <- newSolver - x1 <- newVar solver - addClause solver [literal x1 True] - addClause solver [literal x1 False] - ret <- solve solver -- unsat - ret @?= False - --- incremental に制約を追加 -case_incremental_solving :: IO () -case_incremental_solving = do - solver <- newSolver - x1 <- newVar solver - x2 <- newVar solver - addClause solver [literal x1 True, literal x2 True] -- x1 or x2 - addClause solver [literal x1 True, literal x2 False] -- x1 or not x2 - addClause solver [literal x1 False, literal x2 False] -- not x1 or not x2 - ret <- solve solver -- sat - ret @?= True - - addClause solver [literal x1 False, literal x2 True] -- not x1 or x2 - ret <- solve solver -- unsat - ret @?= False - --- 制約なし -case_empty_constraint :: IO () -case_empty_constraint = do - solver <- newSolver - ret <- solve solver - ret @?= True - --- 空の節 -case_empty_claue :: IO () -case_empty_claue = do - solver <- newSolver - addClause solver [] - ret <- solve solver - ret @?= False - --- 自明に真な節 -case_excluded_middle_claue :: IO () -case_excluded_middle_claue = do - solver <- newSolver - x1 <- newVar solver - addClause solver [x1, -x1] -- x1 or not x1 - ret <- solve solver - ret @?= True - --- 冗長な節 -case_redundant_clause :: IO () -case_redundant_clause = do - solver <- newSolver - x1 <- newVar solver - addClause solver [x1,x1] -- x1 or x1 - ret <- solve solver - ret @?= True - -case_instantiateClause :: IO () -case_instantiateClause = do - solver <- newSolver - x1 <- newVar solver - x2 <- newVar solver - addClause solver [x1] - addClause solver [x1,x2] - addClause solver [-x1,x2] - ret <- solve solver - ret @?= True - -case_instantiateAtLeast :: IO () -case_instantiateAtLeast = do - solver <- newSolver - x1 <- newVar solver - x2 <- newVar solver - x3 <- newVar solver - x4 <- newVar solver - addClause solver [x1] - - addAtLeast solver [x1,x2,x3,x4] 2 - ret <- solve solver - ret @?= True - - addAtLeast solver [-x1,-x2,-x3,-x4] 2 - ret <- solve solver - ret @?= True - -case_inconsistent_AtLeast :: IO () -case_inconsistent_AtLeast = do - solver <- newSolver - x1 <- newVar solver - x2 <- newVar solver - addAtLeast solver [x1,x2] 3 - ret <- solve solver -- unsat - ret @?= False - -case_trivial_AtLeast :: IO () -case_trivial_AtLeast = do - solver <- newSolver - x1 <- newVar solver - x2 <- newVar solver - addAtLeast solver [x1,x2] 0 - ret <- solve solver - ret @?= True - - solver <- newSolver - x1 <- newVar solver - x2 <- newVar solver - addAtLeast solver [x1,x2] (-1) - ret <- solve solver - ret @?= True - -case_AtLeast_1 :: IO () -case_AtLeast_1 = do - solver <- newSolver - x1 <- newVar solver - x2 <- newVar solver - x3 <- newVar solver - addAtLeast solver [x1,x2,x3] 2 - addAtLeast solver [-x1,-x2,-x3] 2 - ret <- solve solver -- unsat - ret @?= False - -case_AtLeast_2 :: IO () -case_AtLeast_2 = do - solver <- newSolver - x1 <- newVar solver - x2 <- newVar solver - x3 <- newVar solver - x4 <- newVar solver - addAtLeast solver [x1,x2,x3,x4] 2 - addClause solver [-x1,-x2] - addClause solver [-x1,-x3] - ret <- solve solver - ret @?= True - -case_AtLeast_3 :: IO () -case_AtLeast_3 = do - forM_ [(-1) .. 3] $ \n -> do - solver <- newSolver - x1 <- newVar solver - x2 <- newVar solver - addAtLeast solver [x1,x2] n - ret <- solve solver - assertEqual ("case_AtLeast3_" ++ show n) (n <= 2) ret - --- from http://www.cril.univ-artois.fr/PB11/format.pdf -case_PB_sample1 :: IO () -case_PB_sample1 = do - solver <- newSolver - - x1 <- newVar solver - x2 <- newVar solver - x3 <- newVar solver - x4 <- newVar solver - x5 <- newVar solver - - addPBAtLeast solver [(1,x1),(4,x2),(-2,x5)] 2 - addPBAtLeast solver [(-1,x1),(4,x2),(-2,x5)] 3 - addPBAtLeast solver [(12345678901234567890,x4),(4,x3)] 10 - addPBExactly solver [(2,x2),(3,x4),(2,x1),(3,x5)] 5 - - ret <- solve solver - ret @?= True - --- 一部の変数を否定に置き換えたもの -case_PB_sample1' :: IO () -case_PB_sample1' = do - solver <- newSolver - - x1 <- newVar solver - x2 <- newVar solver - x3 <- newVar solver - x4 <- newVar solver - x5 <- newVar solver - - addPBAtLeast solver [(1,x1),(4,-x2),(-2,x5)] 2 - addPBAtLeast solver [(-1,x1),(4,-x2),(-2,x5)] 3 - addPBAtLeast solver [(12345678901234567890,-x4),(4,x3)] 10 - addPBExactly solver [(2,-x2),(3,-x4),(2,x1),(3,x5)] 5 - - ret <- solve solver - ret @?= True - --- いきなり矛盾したPB制約 -case_root_inconsistent_PB :: IO () -case_root_inconsistent_PB = do - solver <- newSolver - x1 <- newVar solver - x2 <- newVar solver - addPBAtLeast solver [(2,x1),(3,x2)] 6 - ret <- solve solver - ret @?= False - -case_pb_propagate :: IO () -case_pb_propagate = do - solver <- newSolver - x1 <- newVar solver - x2 <- newVar solver - addPBAtLeast solver [(1,x1),(3,x2)] 3 - addClause solver [-x1] - ret <- solve solver - ret @?= True - -case_solveWith_1 :: IO () -case_solveWith_1 = do - solver <- newSolver - x1 <- newVar solver - x2 <- newVar solver - x3 <- newVar solver - addClause solver [x1, x2] -- x1 or x2 - addClause solver [x1, -x2] -- x1 or not x2 - addClause solver [-x1, -x2] -- not x1 or not x2 - addClause solver [-x3, -x1, x2] -- not x3 or not x1 or x2 - - ret <- solve solver -- sat - ret @?= True - - ret <- solveWith solver [x3] -- unsat - ret @?= False - - ret <- solve solver -- sat - ret @?= True - -case_solveWith_2 :: IO () -case_solveWith_2 = do - solver <- newSolver - x1 <- newVar solver - x2 <- newVar solver - addClause solver [-x1, x2] -- -x1 or x2 - addClause solver [x1] -- x1 - - ret <- solveWith solver [x2] - ret @?= True - - ret <- solveWith solver [-x2] - ret @?= False - -case_getVarFixed :: IO () -case_getVarFixed = do - solver <- newSolver - x1 <- newVar solver - x2 <- newVar solver - addClause solver [x1,x2] - - ret <- getVarFixed solver x1 - ret @?= lUndef - - addClause solver [-x1] - - ret <- getVarFixed solver x1 - ret @?= lFalse - - ret <- getLitFixed solver (-x1) - ret @?= lTrue - - ret <- getLitFixed solver x2 - ret @?= lTrue - ------------------------------------------------------------------------- - --- -4*(not x1) + 3*x1 + 10*(not x2) --- = -4*(1 - x1) + 3*x1 + 10*(not x2) --- = -4 + 4*x1 + 3*x1 + 10*(not x2) --- = 7*x1 + 10*(not x2) - 4 -case_normalizePBLinSum :: Assertion -case_normalizePBLinSum = do - sort e @?= sort [(7,x1),(10,-x2)] - c @?= -4 - where - x1 = 1 - x2 = 2 - (e,c) = normalizePBLinSum ([(-4,-x1),(3,x1),(10,-x2)], 0) - --- -4*(not x1) + 3*x1 + 10*(not x2) >= 3 --- ⇔ -4*(1 - x1) + 3*x1 + 10*(not x2) >= 3 --- ⇔ -4 + 4*x1 + 3*x1 + 10*(not x2) >= 3 --- ⇔ 7*x1 + 10*(not x2) >= 7 --- ⇔ 7*x1 + 7*(not x2) >= 7 --- ⇔ x1 + (not x2) >= 1 -case_normalizePBLinAtLeast :: Assertion -case_normalizePBLinAtLeast = (sort lhs, rhs) @?= (sort [(1,x1),(1,-x2)], 1) - where - x1 = 1 - x2 = 2 - (lhs,rhs) = normalizePBLinAtLeast ([(-4,-x1),(3,x1),(10,-x2)], 3) - -case_normalizePBLinExactly_1 :: Assertion -case_normalizePBLinExactly_1 = (sort lhs, rhs) @?= (sort [(3,x1),(2,x2)], 1) - where - x1 = 1 - x2 = 2 - (lhs,rhs) = normalizePBLinExactly ([(6,x1),(4,x2)], 2) - -case_normalizePBLinExactly_2 :: Assertion -case_normalizePBLinExactly_2 = (sort lhs, rhs) @?= ([], 1) - where - x1 = 1 - x2 = 2 - x3 = 3 - (lhs,rhs) = normalizePBLinExactly ([(2,x1),(2,x2),(2,x3)], 3) - -case_cutResolve_1 :: Assertion -case_cutResolve_1 = (sort lhs, rhs) @?= (sort [(1,x3),(1,x4)], 1) - where - x1 = 1 - x2 = 2 - x3 = 3 - x4 = 4 - pb1 = ([(1,x1), (1,x2), (1,x3)], 1) - pb2 = ([(2,-x1), (2,-x2), (1,x4)], 3) - (lhs,rhs) = cutResolve pb1 pb2 x1 - -case_cutResolve_2 :: Assertion -case_cutResolve_2 = (sort lhs, rhs) @?= (sort [(3,x1),(2,-x2),(2,x4)], 3) - where - x1 = 1 - x2 = 2 - x3 = 3 - x4 = 4 - pb1 = ([(3,x1), (2,-x2), (1,x3), (1,x4)], 3) - pb2 = ([(1,-x3), (1,x4)], 1) - (lhs,rhs) = cutResolve pb1 pb2 x3 - -case_cardinalityReduction :: Assertion -case_cardinalityReduction = (sort lhs, rhs) @?= ([1,2,3,4,5],4) - where - (lhs, rhs) = cardinalityReduction ([(6,1),(5,2),(4,3),(3,4),(2,5),(1,6)], 17) - -case_pbSubsume_clause :: Assertion -case_pbSubsume_clause = pbSubsume ([(1,1),(1,-3)],1) ([(1,1),(1,2),(1,-3),(1,4)],1) @?= True - -case_pbSubsume_1 :: Assertion -case_pbSubsume_1 = pbSubsume ([(1,1),(1,2),(1,-3)],2) ([(1,1),(2,2),(1,-3),(1,4)],1) @?= True - -case_pbSubsume_2 :: Assertion -case_pbSubsume_2 = pbSubsume ([(1,1),(1,2),(1,-3)],2) ([(1,1),(2,2),(1,-3),(1,4)],3) @?= False - ------------------------------------------------------------------------- - -case_normalizeXORClause_False = - normalizeXORClause ([],True) @?= ([],True) - -case_normalizeXORClause_True = - normalizeXORClause ([],False) @?= ([],False) - --- x ⊕ y ⊕ x = y -case_normalizeXORClause_case1 = - normalizeXORClause ([1,2,1],True) @?= ([2],True) - --- x ⊕ ¬x = x ⊕ x ⊕ 1 = 1 -case_normalizeXORClause_case2 = - normalizeXORClause ([1,-1],True) @?= ([],False) - -case_evalXORClause_case1 = - evalXORClause (array (1,2) [(1,True),(2,True)] :: Array Int Bool) ([1,2], True) @?= False - -case_evalXORClause_case2 = - evalXORClause (array (1,2) [(1,False),(2,True)] :: Array Int Bool) ([1,2], True) @?= True - -case_xor_case1 = do - solver <- newSolver - setCheckModel solver True - x1 <- newVar solver - x2 <- newVar solver - x3 <- newVar solver - addXORClause solver [x1, x2] True -- x1 ⊕ x2 = True - addXORClause solver [x2, x3] True -- x2 ⊕ x3 = True - addXORClause solver [x3, x1] True -- x3 ⊕ x1 = True - ret <- solve solver - ret @?= False - -case_xor_case2 = do - solver <- newSolver - setCheckModel solver True - x1 <- newVar solver - x2 <- newVar solver - x3 <- newVar solver - addXORClause solver [x1, x2] True -- x1 ⊕ x2 = True - addXORClause solver [x1, x3] True -- x1 ⊕ x3 = True - addClause solver [x2] - - ret <- solve solver - ret @?= True - m <- getModel solver - m ! x1 @?= False - m ! x2 @?= True - m ! x3 @?= True - -case_xor_case3 = do - solver <- newSolver - setCheckModel solver True - x1 <- newVar solver - x2 <- newVar solver - x3 <- newVar solver - x4 <- newVar solver - addXORClause solver [x1,x2,x3,x4] True - addAtLeast solver [x1,x2,x3,x4] 2 - ret <- solve solver - ret @?= True - ------------------------------------------------------------------------- - --- from "Pueblo: A Hybrid Pseudo-Boolean SAT Solver" --- clauseがunitになるレベルで、PB制約が違反状態のままという例。 -case_hybridLearning_1 :: IO () -case_hybridLearning_1 = do - solver <- newSolver - [x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11] <- replicateM 11 (newVar solver) - - addClause solver [x11, x10, x9] -- C1 - addClause solver [x8, x7, x6] -- C2 - addClause solver [x5, x4, x3] -- C3 - addAtLeast solver [-x2, -x5, -x8, -x11] 3 -- C4 - addAtLeast solver [-x1, -x4, -x7, -x10] 3 -- C5 - - replicateM 3 (varBumpActivity solver x3) - setVarPolarity solver x3 False - - replicateM 2 (varBumpActivity solver x6) - setVarPolarity solver x6 False - - replicateM 1 (varBumpActivity solver x9) - setVarPolarity solver x9 False - - setVarPolarity solver x1 True - - setLearningStrategy solver LearningHybrid - ret <- solve solver - ret @?= True - --- from "Pueblo: A Hybrid Pseudo-Boolean SAT Solver" --- clauseがunitになるレベルで、PB制約が違反状態のままという例。 --- さらに、学習したPB制約はunitにはならない。 -case_hybridLearning_2 :: IO () -case_hybridLearning_2 = do - solver <- newSolver - [x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12] <- replicateM 12 (newVar solver) - - addClause solver [x11, x10, x9] -- C1 - addClause solver [x8, x7, x6] -- C2 - addClause solver [x5, x4, x3] -- C3 - addAtLeast solver [-x2, -x5, -x8, -x11] 3 -- C4 - addAtLeast solver [-x1, -x4, -x7, -x10] 3 -- C5 - - addClause solver [x12, -x3] - addClause solver [x12, -x6] - addClause solver [x12, -x9] - - varBumpActivity solver x12 - setVarPolarity solver x12 False - - setLearningStrategy solver LearningHybrid - ret <- solve solver - ret @?= True - --- regression test for the bug triggered by normalized-blast-floppy1-8.ucl.opb.bz2 -case_addPBAtLeast_regression :: IO () -case_addPBAtLeast_regression = do - solver <- newSolver - [x1,x2,x3,x4] <- replicateM 4 (newVar solver) - addClause solver [-x1] - addClause solver [-x2, -x3] - addClause solver [-x2, -x4] - addPBAtLeast solver [(1,x1),(2,x2),(1,x3),(1,x4)] 3 - ret <- solve solver - ret @?= False - ------------------------------------------------------------------------- - -case_addFormula = do - solver <- newSolver - enc <- Tseitin.newEncoder solver - - [x1,x2,x3,x4,x5] <- replicateM 5 $ liftM Atom $ newVar solver - Tseitin.addFormula enc $ orB [x1 .=>. x3 .&&. x4, x2 .=>. x3 .&&. x5] - -- x6 = x3 ∧ x4 - -- x7 = x3 ∧ x5 - Tseitin.addFormula enc $ x1 .||. x2 - Tseitin.addFormula enc $ x4 .=>. notB x5 - ret <- solve solver - ret @?= True - - Tseitin.addFormula enc $ x2 .<=>. x4 - ret <- solve solver - ret @?= True - - Tseitin.addFormula enc $ x1 .<=>. x5 - ret <- solve solver - ret @?= True - - Tseitin.addFormula enc $ notB x1 .=>. x3 .&&. x5 - ret <- solve solver - ret @?= True - - Tseitin.addFormula enc $ notB x2 .=>. x3 .&&. x4 - ret <- solve solver - ret @?= False - -case_addFormula_Peirces_Law = do - solver <- newSolver - enc <- Tseitin.newEncoder solver - [x1,x2] <- replicateM 2 $ liftM Atom $ newVar solver - Tseitin.addFormula enc $ notB $ ((x1 .=>. x2) .=>. x1) .=>. x1 - ret <- solve solver - ret @?= False - -case_encodeConj = do - solver <- newSolver - enc <- Tseitin.newEncoder solver - x1 <- newVar solver - x2 <- newVar solver - x3 <- Tseitin.encodeConj enc [x1,x2] - - ret <- solveWith solver [x3] - ret @?= True - m <- getModel solver - evalLit m x1 @?= True - evalLit m x2 @?= True - evalLit m x3 @?= True - - ret <- solveWith solver [-x3] - ret @?= True - m <- getModel solver - (evalLit m x1 && evalLit m x2) @?= False - evalLit m x3 @?= False - -case_encodeDisj = do - solver <- newSolver - enc <- Tseitin.newEncoder solver - x1 <- newVar solver - x2 <- newVar solver - x3 <- Tseitin.encodeDisj enc [x1,x2] - - ret <- solveWith solver [x3] - ret @?= True - m <- getModel solver - (evalLit m x1 || evalLit m x2) @?= True - evalLit m x3 @?= True - - ret <- solveWith solver [-x3] - ret @?= True - m <- getModel solver - evalLit m x1 @?= False - evalLit m x2 @?= False - evalLit m x3 @?= False - -case_evalFormula = do - solver <- newSolver - xs <- newVars solver 5 - let f = (x1 .=>. x3 .&&. x4) .||. (x2 .=>. x3 .&&. x5) - where - [x1,x2,x3,x4,x5] = map Atom xs - g :: Model -> Bool - g m = (not x1 || (x3 && x4)) || (not x2 || (x3 && x5)) - where - [x1,x2,x3,x4,x5] = elems m - let ms :: [Model] - ms = liftM (array (1,5)) $ sequence [[(x,val) | val <- [False,True]] | x <- xs] - forM_ ms $ \m -> do - Tseitin.evalFormula m f @?= g m - ------------------------------------------------------------------------- - -case_MUS = do - solver <- newSolver - [x1,x2,x3] <- newVars solver 3 - sels@[y1,y2,y3,y4,y5,y6] <- newVars solver 6 - addClause solver [-y1, x1] - addClause solver [-y2, -x1] - addClause solver [-y3, -x1, x2] - addClause solver [-y4, -x2] - addClause solver [-y5, -x1, x3] - addClause solver [-y6, -x3] - - ret <- solveWith solver sels - ret @?= False - - actual <- MUS.findMUSAssumptions solver MUS.defaultOptions - let actual' = IntSet.map (\x -> x-3) actual - expected = map IntSet.fromList [[1, 2], [1, 3, 4], [1, 5, 6]] - actual' `elem` expected @?= True - -case_MUS_QuickXplain = do - solver <- newSolver - [x1,x2,x3] <- newVars solver 3 - sels@[y1,y2,y3,y4,y5,y6] <- newVars solver 6 - addClause solver [-y1, x1] - addClause solver [-y2, -x1] - addClause solver [-y3, -x1, x2] - addClause solver [-y4, -x2] - addClause solver [-y5, -x1, x3] - addClause solver [-y6, -x3] - - ret <- solveWith solver sels - ret @?= False - - actual <- QuickXplain.findMUSAssumptions solver QuickXplain.defaultOptions - let actual' = IntSet.map (\x -> x-3) actual - expected = map IntSet.fromList [[1, 2], [1, 3, 4], [1, 5, 6]] - actual' `elem` expected @?= True - ------------------------------------------------------------------------- - -{- -c http://sun.iwu.edu/~mliffito/publications/jar_liffiton_CAMUS.pdf -c φ= (x1) ∧ (¬x1) ∧ (¬x1∨x2) ∧ (¬x2) ∧ (¬x1∨x3) ∧ (¬x3) -c MUSes(φ) = {{C1, C2}, {C1, C3, C4}, {C1, C5, C6}} -c MCSes(φ) = {{C1}, {C2, C3, C5}, {C2, C3, C6}, {C2, C4, C5}, {C2, C4, C6}} -p cnf 3 6 -1 0 --1 0 --1 2 0 --2 0 --1 3 0 --3 0 --} - -case_camus_allMCSAssumptions = do - solver <- newSolver - [x1,x2,x3] <- newVars solver 3 - sels@[y1,y2,y3,y4,y5,y6] <- newVars solver 6 - addClause solver [-y1, x1] - addClause solver [-y2, -x1] - addClause solver [-y3, -x1, x2] - addClause solver [-y4, -x2] - addClause solver [-y5, -x1, x3] - addClause solver [-y6, -x3] - actual <- CAMUS.allMCSAssumptions solver sels CAMUS.defaultOptions - let actual' = Set.fromList actual - expected = map (IntSet.fromList . map (+3)) [[1], [2,3,5], [2,3,6], [2,4,5], [2,4,6]] - expected' = Set.fromList expected - actual' @?= expected' - -case_DAA_allMCSAssumptions = do - solver <- newSolver - [x1,x2,x3] <- newVars solver 3 - sels@[y1,y2,y3,y4,y5,y6] <- newVars solver 6 - addClause solver [-y1, x1] - addClause solver [-y2, -x1] - addClause solver [-y3, -x1, x2] - addClause solver [-y4, -x2] - addClause solver [-y5, -x1, x3] - addClause solver [-y6, -x3] - actual <- DAA.allMCSAssumptions solver sels DAA.defaultOptions - let actual' = Set.fromList $ actual - expected = map (IntSet.fromList . map (+3)) [[1], [2,3,5], [2,3,6], [2,4,5], [2,4,6]] - expected' = Set.fromList $ expected - actual' @?= expected' - -case_camus_allMUSAssumptions = do - solver <- newSolver - [x1,x2,x3] <- newVars solver 3 - sels@[y1,y2,y3,y4,y5,y6] <- newVars solver 6 - addClause solver [-y1, x1] - addClause solver [-y2, -x1] - addClause solver [-y3, -x1, x2] - addClause solver [-y4, -x2] - addClause solver [-y5, -x1, x3] - addClause solver [-y6, -x3] - actual <- CAMUS.allMUSAssumptions solver sels CAMUS.defaultOptions - let actual' = Set.fromList $ actual - expected = map (IntSet.fromList . map (+3)) [[1,2], [1,3,4], [1,5,6]] - expected' = Set.fromList $ expected - actual' @?= expected' - -case_DAA_allMUSAssumptions = do - solver <- newSolver - [x1,x2,x3] <- newVars solver 3 - sels@[y1,y2,y3,y4,y5,y6] <- newVars solver 6 - addClause solver [-y1, x1] - addClause solver [-y2, -x1] - addClause solver [-y3, -x1, x2] - addClause solver [-y4, -x2] - addClause solver [-y5, -x1, x3] - addClause solver [-y6, -x3] - actual <- DAA.allMUSAssumptions solver sels DAA.defaultOptions - let actual' = Set.fromList $ actual - expected = map (IntSet.fromList . map (+3)) [[1,2], [1,3,4], [1,5,6]] - expected' = Set.fromList $ expected - actual' @?= expected' - -{- -Boosting a Complete Technique to Find MSS and MUS thanks to a Local Search Oracle -http://www.cril.univ-artois.fr/~piette/IJCAI07_HYCAM.pdf -Example 3. -C0 : (d) -C1 : (b ∨ c) -C2 : (a ∨ b) -C3 : (a ∨ ¬c) -C4 : (¬b ∨ ¬e) -C5 : (¬a ∨ ¬b) -C6 : (a ∨ e) -C7 : (¬a ∨ ¬e) -C8 : (b ∨ e) -C9 : (¬a ∨ b ∨ ¬c) -C10 : (¬a ∨ b ∨ ¬d) -C11 : (a ∨ ¬b ∨ c) -C12 : (a ∨ ¬b ∨ ¬d) --} -case_camus_allMUSAssumptions_2 = do - solver <- newSolver - [a,b,c,d,e] <- newVars solver 5 - sels@[y0,y1,y2,y3,y4,y5,y6,y7,y8,y9,y10,y11,y12] <- newVars solver 13 - addClause solver [-y0, d] - addClause solver [-y1, b, c] - addClause solver [-y2, a, b] - addClause solver [-y3, a, -c] - addClause solver [-y4, -b, -e] - addClause solver [-y5, -a, -b] - addClause solver [-y6, a, e] - addClause solver [-y7, -a, -e] - addClause solver [-y8, b, e] - addClause solver [-y9, -a, b, -c] - addClause solver [-y10, -a, b, -d] - addClause solver [-y11, a, -b, c] - addClause solver [-y12, a, -b, -d] - - -- Only three of the MUSes (marked with asterisks) are on the paper. - let cores = - [ [y0,y1,y2,y5,y9,y12] - , [y0,y1,y3,y4,y5,y6,y10] - , [y0,y1,y3,y5,y7,y8,y12] - , [y0,y1,y3,y5,y9,y12] - , [y0,y1,y3,y5,y10,y11] - , [y0,y1,y3,y5,y10,y12] - , [y0,y2,y3,y5,y10,y11] - , [y0,y2,y4,y5,y6,y10] - , [y0,y2,y5,y7,y8,y12] - , [y0,y2,y5,y10,y12] -- (*) - , [y1,y2,y4,y5,y6,y9] - , [y1,y3,y4,y5,y6,y7,y8] - , [y1,y3,y4,y5,y6,y9] - , [y1,y3,y5,y7,y8,y11] - , [y1,y3,y5,y9,y11] -- (*) - , [y2,y3,y5,y7,y8,y11] - , [y2,y4,y5,y6,y7,y8] -- (*) - ] - - let remove1 :: [a] -> [[a]] - remove1 [] = [] - remove1 (x:xs) = xs : [x : ys | ys <- remove1 xs] - forM_ cores $ \core -> do - ret <- solveWith solver core - assertBool (show core ++ " should be a core") (not ret) - forM (remove1 core) $ \xs -> do - ret <- solveWith solver xs - assertBool (show core ++ " should be satisfiable") ret - - actual <- CAMUS.allMUSAssumptions solver sels CAMUS.defaultOptions - let actual' = Set.fromList actual - expected' = Set.fromList $ map IntSet.fromList $ cores - actual' @?= expected' - -case_HYCAM_allMUSAssumptions = do - solver <- newSolver - [a,b,c,d,e] <- newVars solver 5 - sels@[y0,y1,y2,y3,y4,y5,y6,y7,y8,y9,y10,y11,y12] <- newVars solver 13 - addClause solver [-y0, d] - addClause solver [-y1, b, c] - addClause solver [-y2, a, b] - addClause solver [-y3, a, -c] - addClause solver [-y4, -b, -e] - addClause solver [-y5, -a, -b] - addClause solver [-y6, a, e] - addClause solver [-y7, -a, -e] - addClause solver [-y8, b, e] - addClause solver [-y9, -a, b, -c] - addClause solver [-y10, -a, b, -d] - addClause solver [-y11, a, -b, c] - addClause solver [-y12, a, -b, -d] - - -- Only three of the MUSes (marked with asterisks) are on the paper. - let cores = - [ [y0,y1,y2,y5,y9,y12] - , [y0,y1,y3,y4,y5,y6,y10] - , [y0,y1,y3,y5,y7,y8,y12] - , [y0,y1,y3,y5,y9,y12] - , [y0,y1,y3,y5,y10,y11] - , [y0,y1,y3,y5,y10,y12] - , [y0,y2,y3,y5,y10,y11] - , [y0,y2,y4,y5,y6,y10] - , [y0,y2,y5,y7,y8,y12] - , [y0,y2,y5,y10,y12] -- (*) - , [y1,y2,y4,y5,y6,y9] - , [y1,y3,y4,y5,y6,y7,y8] - , [y1,y3,y4,y5,y6,y9] - , [y1,y3,y5,y7,y8,y11] - , [y1,y3,y5,y9,y11] -- (*) - , [y2,y3,y5,y7,y8,y11] - , [y2,y4,y5,y6,y7,y8] -- (*) - ] - mcses = - [ [y0,y1,y7] - , [y0,y1,y8] - , [y0,y3,y4] - , [y0,y3,y6] - , [y0,y4,y11] - , [y0,y6,y11] - , [y0,y7,y9] - , [y0,y8,y9] - , [y1,y2] - , [y1,y7,y10] - , [y1,y8,y10] - , [y2,y3] - , [y3,y4,y12] - , [y3,y6,y12] - , [y4,y11,y12] - , [y5] - , [y6,y11,y12] - , [y7,y9,y10] - , [y8,y9,y10] - ] - - -- HYCAM paper wrongly treated {C3,C8,C10} as a candidate MCS (CoMSS). - -- Its complement {C0,C1,C2,C4,C5,C6,C7,C9,C11,C12} is unsatisfiable - -- and hence not MSS. - ret <- solveWith solver [y0,y1,y2,y4,y5,y6,y7,y9,y11,y12] - assertBool "failed to prove the bug of HYCAM paper" (not ret) - - let cand = map IntSet.fromList [[y5], [y3,y2], [y0,y1,y2]] - actual <- CAMUS.allMUSAssumptions solver sels CAMUS.defaultOptions{ CAMUS.optKnownCSes = cand } - let actual' = Set.fromList $ actual - expected' = Set.fromList $ map IntSet.fromList cores - actual' @?= expected' - -case_DAA_allMUSAssumptions_2 = do - solver <- newSolver - [a,b,c,d,e] <- newVars solver 5 - sels@[y0,y1,y2,y3,y4,y5,y6,y7,y8,y9,y10,y11,y12] <- newVars solver 13 - addClause solver [-y0, d] - addClause solver [-y1, b, c] - addClause solver [-y2, a, b] - addClause solver [-y3, a, -c] - addClause solver [-y4, -b, -e] - addClause solver [-y5, -a, -b] - addClause solver [-y6, a, e] - addClause solver [-y7, -a, -e] - addClause solver [-y8, b, e] - addClause solver [-y9, -a, b, -c] - addClause solver [-y10, -a, b, -d] - addClause solver [-y11, a, -b, c] - addClause solver [-y12, a, -b, -d] - - -- Only three of the MUSes (marked with asterisks) are on the paper. - let cores = - [ [y0,y1,y2,y5,y9,y12] - , [y0,y1,y3,y4,y5,y6,y10] - , [y0,y1,y3,y5,y7,y8,y12] - , [y0,y1,y3,y5,y9,y12] - , [y0,y1,y3,y5,y10,y11] - , [y0,y1,y3,y5,y10,y12] - , [y0,y2,y3,y5,y10,y11] - , [y0,y2,y4,y5,y6,y10] - , [y0,y2,y5,y7,y8,y12] - , [y0,y2,y5,y10,y12] -- (*) - , [y1,y2,y4,y5,y6,y9] - , [y1,y3,y4,y5,y6,y7,y8] - , [y1,y3,y4,y5,y6,y9] - , [y1,y3,y5,y7,y8,y11] - , [y1,y3,y5,y9,y11] -- (*) - , [y2,y3,y5,y7,y8,y11] - , [y2,y4,y5,y6,y7,y8] -- (*) - ] - - let remove1 :: [a] -> [[a]] - remove1 [] = [] - remove1 (x:xs) = xs : [x : ys | ys <- remove1 xs] - forM_ cores $ \core -> do - ret <- solveWith solver core - assertBool (show core ++ " should be a core") (not ret) - forM (remove1 core) $ \xs -> do - ret <- solveWith solver xs - assertBool (show core ++ " should be satisfiable") ret - - actual <- DAA.allMUSAssumptions solver sels DAA.defaultOptions - let actual' = Set.fromList actual - expected' = Set.fromList $ map IntSet.fromList cores - actual' @?= expected' - ------------------------------------------------------------------------- - -instance Arbitrary LearningStrategy where - arbitrary = arbitraryBoundedEnum - -instance Arbitrary RestartStrategy where - arbitrary = arbitraryBoundedEnum - -instance Arbitrary PBHandlerType where - arbitrary = arbitraryBoundedEnum - -arbitrarySolver :: QM.PropertyM IO Solver -arbitrarySolver = do - seed <- QM.pick arbitrary - learningStrategy <- QM.pick arbitrary - restartStrategy <- QM.pick arbitrary - restartFirst <- QM.pick arbitrary - restartInc <- QM.pick $ liftM ((1.01 +) . abs) arbitrary - learntSizeFirst <- QM.pick arbitrary - learntSizeInc <- QM.pick $ liftM ((1.01 +) . abs) arbitrary - pbhandler <- QM.pick arbitrary - ccmin <- QM.pick $ choose (0,2) - phaseSaving <- QM.pick arbitrary - forwardSubsumptionRemoval <- QM.pick arbitrary - backwardSubsumptionRemoval <- QM.pick arbitrary - randomFreq <- QM.pick $ choose (0,1) - splitClausePart <- QM.pick arbitrary - QM.run $ do - solver <- newSolver - setRandomGen solver (Rand.mkStdGen seed) - setCheckModel solver True - setLearningStrategy solver learningStrategy - setRestartStrategy solver restartStrategy - setRestartFirst solver restartFirst - setRestartInc solver restartInc - setLearntSizeFirst solver learntSizeFirst - setLearntSizeInc solver learntSizeInc - setPBHandlerType solver pbhandler - setCCMin solver ccmin - setEnablePhaseSaving solver phaseSaving - setEnableForwardSubsumptionRemoval solver forwardSubsumptionRemoval - setEnableBackwardSubsumptionRemoval solver backwardSubsumptionRemoval - setRandomFreq solver randomFreq - setPBSplitClausePart solver splitClausePart - return solver - ------------------------------------------------------------------------- --- Test harness - -main :: IO () -main = $(defaultMainGenerator) diff --git a/test/TestSDPFile.hs b/test/TestSDPFile.hs deleted file mode 100644 --- a/test/TestSDPFile.hs +++ /dev/null @@ -1,80 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -module Main (main) where - -import Control.Monad -import Data.List -import Data.Maybe -import Test.Tasty -import Test.Tasty.QuickCheck -import Test.Tasty.HUnit -import Test.Tasty.TH -import ToySolver.Text.SDPFile - ------------------------------------------------------------------------- --- Sample data - -example1 :: Problem -example1 - = Problem - { blockStruct = [2] - , costs = [48, -8, 20] - , matrices = map denseMatrix [f0,f1,f2,f3] - } - where - f0 = [[[-11,0], [0,23]]] - f1 = [[[10,4], [4,0]]] - f2 = [[[0,0], [0,-8]]] - f3 = [[[0,-8], [-8,-2]]] - -example2 :: Problem -example2 - = Problem - { blockStruct = [2,3,-2] - , costs = [1.1, -10, 6.6, 19, 4.1] - , matrices = map denseMatrix [f0,f1,f5] - } - where - f0 = [ [[-1.4, -3.2], [-3.2, -28]] - , [[15, -12, 2.1], [-12, 16, -3.8], [2.1, -3.8, 15]] - , [[1.8, 0], [0, -4.0]] - ] - f1 = [ [[0.5, 5.2], [5.2,-5.3]] - , [[7.8, -2.4, 6.0], [-2.4, 4.2, 6.5], [6.0, 6.5, 2.1]] - , [[-4.5, 0], [0, -3.5]] - ] - f5 = [ [[-6.5, -5.4], [-5.4, -6.6]] - , [[6.7, -7.2, -3.6], [-7.2, 7.3, -3.0], [-3.6, -3.0, -1.4]] - , [[6.1, 0],[0, -1.5]] - ] - -case_test1 = checkParsed example1b example1 - where - s = render example1 "" - example1b = parseDataString "" s - -case_test2 = checkParsed example1b example1 - where - s = renderSparse example1 "" - example1b = parseSparseDataString "" s - -case_test3 = checkParsed example2b example2 - where - s = render example2 "" - example2b = parseDataString "" s - -case_test4 = checkParsed example2b example2 - where - s = renderSparse example2 "" - example2b = parseSparseDataString "" s - --- checkParsed :: Either ParseError Problem -> Problem -> IO () -checkParsed actual expected = - case actual of - Left err -> assertFailure $ show err - Right prob -> prob @?= expected - ------------------------------------------------------------------------- --- Test harness - -main :: IO () -main = $(defaultMainGenerator) diff --git a/test/TestSimplex.hs b/test/TestSimplex.hs deleted file mode 100644 --- a/test/TestSimplex.hs +++ /dev/null @@ -1,177 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -module Main (main) where - -import Control.Monad -import Control.Monad.State -import Data.IntMap (IntMap) -import qualified Data.IntMap as IntMap -import Data.IntSet (IntSet) -import qualified Data.IntSet as IntSet -import Data.List -import Data.Ratio -import Test.Tasty -import Test.Tasty.HUnit -import Test.Tasty.TH -import Text.Printf - -import qualified ToySolver.Data.LA as LA -import ToySolver.Data.LA ((.<=.)) -import ToySolver.Arith.Simplex -import qualified ToySolver.Arith.LPSolver as LP - -example_3_2 :: Tableau Rational -example_3_2 = IntMap.fromList - [ (4, (IntMap.fromList [(1,2), (2,1), (3,1)], 2)) - , (5, (IntMap.fromList [(1,1), (2,2), (3,3)], 5)) - , (6, (IntMap.fromList [(1,2), (2,2), (3,1)], 6)) - , (objRowIndex, (IntMap.fromList [(1,-3), (2,-2), (3,-3)], 0)) - ] - -case_example_3_2_simplex :: IO () -case_example_3_2_simplex = do - assertBool "simplex failed" ret - assertBool "invalid tableau" (isValidTableau result) - assertBool "infeasible tableau" (isFeasible result) - assertBool "unoptimal tableau" (isOptimal OptMax result) - currentObjValue result @?= 27/5 - where - ret :: Bool - result :: Tableau Rational - (ret,result) = simplex OptMax example_3_2 - -case_example_3_2_primalDualSimplex :: IO () -case_example_3_2_primalDualSimplex = do - assertBool "simplex failed" ret - assertBool "invalid tableau" (isValidTableau result) - assertBool "infeasible tableau" (isFeasible result) - assertBool "unoptimal tableau" (isOptimal OptMax result) - currentObjValue result @?= 27/5 - where - ret :: Bool - result :: Tableau Rational - (ret,result) = primalDualSimplex OptMax example_3_2 - --- from http://www.math.cuhk.edu.hk/~wei/lpch5.pdf -exampe_5_3_phase1 :: Tableau Rational -exampe_5_3_phase1 = IntMap.fromList - [ (6, (IntMap.fromList [(2,-1), (3,-1), (5,1), (6,1)], 1)) - , (7, (IntMap.fromList [(3,1), (4,-1), (5,1), (7,1)], 0)) - ] - -case_exampe_5_3_phase1 :: IO () -case_exampe_5_3_phase1 = do - let (ret,result) = phaseI exampe_5_3_phase1 (IntSet.fromList [6,7]) - assertBool "phase1 failed" ret - assertBool "invalid tableau" (isValidTableau result) - assertBool "infeasible tableau" (isFeasible result) - --- 退化して巡回の起こるKuhnの7変数3制約の例 -kuhn_7_3 :: Tableau Rational -kuhn_7_3 = IntMap.fromList - [ (1, (IntMap.fromList [(4,-2), (5,-9), (6,1), (7,9)], 0)) - , (2, (IntMap.fromList [(4,1/3), (5,1), (6,-1/3), (7,-2)], 0)) - , (3, (IntMap.fromList [(4,2), (5,3), (6,-1), (7,-12)], 2)) - , (objRowIndex, (IntMap.fromList [(4,2), (5,3), (6,-1), (7,-12)], 0)) - ] - -case_kuhn_7_3 :: IO () -case_kuhn_7_3 = do - assertBool "simplex failed" ret - assertBool "invalid tableau" (isValidTableau result) - currentObjValue result @?= -2 - where - ret :: Bool - result :: Tableau Rational - (ret,result) = simplex OptMin kuhn_7_3 - --- case_pd_kuhn_7_3 :: IO () --- case_pd_kuhn_7_3 = do --- assertBool "simplex failed" ret --- assertBool "invalid tableau" (isValidTableau result) --- currentObjValue result @?= -2 --- where --- ret :: Bool --- result :: Tableau Rational --- (ret,result) = primalDualSimplex OptMin kuhn_7_3 - --- from http://www.math.cuhk.edu.hk/~wei/lpch5.pdf -example_5_7 :: Tableau Rational -example_5_7 = IntMap.fromList - [ (4, (IntMap.fromList [(1,-1), (2,-2), (3,-3)], -5)) - , (5, (IntMap.fromList [(1,-2), (2,-2), (3,-1)], -6)) - , (objRowIndex, (IntMap.fromList [(1,3),(2,4),(3,5)], 0)) - ] - -case_example_5_7 :: IO () -case_example_5_7 = do - assertBool "dual simplex failed" ret - assertBool "invalid tableau" (isValidTableau result) - currentObjValue result @?= -11 - where - ret :: Bool - result :: Tableau Rational - (ret,result) = dualSimplex OptMax example_5_7 - -case_pd_example_5_7 :: IO () -case_pd_example_5_7 = do - assertBool "dual simplex failed" ret - assertBool "invalid tableau" (isValidTableau result) - currentObjValue result @?= -11 - where - ret :: Bool - result :: Tableau Rational - (ret,result) = primalDualSimplex OptMax example_5_7 - ------------------------------------------------------------------------- - -case_lp_example_5_7_twoPhaseSimplex :: IO () -case_lp_example_5_7_twoPhaseSimplex = do - ret @?= LP.Optimum - oval @?= -11 - assertBool "invalid tableau" (isValidTableau tbl) - assertBool "infeasible tableau" (isFeasible tbl) - assertBool "non-optimal tableau" (isOptimal OptMax tbl) - where - oval :: Rational - ((ret,tbl,oval),result) = flip runState (LP.emptySolver IntSet.empty) $ do - _ <- LP.newVar - x1 <- LP.newVar - x2 <- LP.newVar - x3 <- LP.newVar - LP.addConstraint (LA.fromTerms [(-1,x1),(-2,x2),(-3,x3)] .<=. LA.constant (-5)) - LP.addConstraint (LA.fromTerms [(-2,x1),(-2,x2),(-1,x3)] .<=. LA.constant (-6)) - let obj = LA.fromTerms [(-3,x1), (-4,x2),(-5,x3)] - ret <- LP.twoPhaseSimplex OptMax obj - tbl <- LP.getTableau - m <- LP.getModel (IntSet.fromList [x1,x2,x3]) - let oval = LA.evalExpr m obj - return (ret,tbl,oval) - -case_lp_example_5_7_primalDualSimplex :: IO () -case_lp_example_5_7_primalDualSimplex = do - ret @?= LP.Optimum - oval @?= -11 - assertBool "invalid tableau" (isValidTableau tbl) - assertBool "infeasible tableau" (isFeasible tbl) - assertBool "non-optimal tableau" (isOptimal OptMax tbl) - where - oval :: Rational - ((ret,tbl,oval),result) = flip runState (LP.emptySolver IntSet.empty) $ do - _ <- LP.newVar - x1 <- LP.newVar - x2 <- LP.newVar - x3 <- LP.newVar - LP.addConstraint (LA.fromTerms [(-1,x1),(-2,x2),(-3,x3)] .<=. LA.constant (-5)) - LP.addConstraint (LA.fromTerms [(-2,x1),(-2,x2),(-1,x3)] .<=. LA.constant (-6)) - let obj = LA.fromTerms [(-3,x1), (-4,x2),(-5,x3)] - ret <- LP.primalDualSimplex OptMax obj - tbl <- LP.getTableau - m <- LP.getModel (IntSet.fromList [x1,x2,x3]) - let oval = LA.evalExpr m obj - return (ret,tbl,oval) - ------------------------------------------------------------------------- --- Test harness - -main :: IO () -main = $(defaultMainGenerator) diff --git a/test/TestSimplex2.hs b/test/TestSimplex2.hs deleted file mode 100644 --- a/test/TestSimplex2.hs +++ /dev/null @@ -1,407 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -module Main (main) where - -import Control.Monad -import Data.List -import Data.Ratio -import Data.VectorSpace -import Test.Tasty -import Test.Tasty.HUnit -import Test.Tasty.TH -import Text.Printf -import qualified ToySolver.Data.LA as LA -import ToySolver.Arith.Simplex2 - -case_test1 :: IO () -case_test1 = do - solver <- newSolver - x <- newVar solver - y <- newVar solver - z <- newVar solver - assertAtom solver (LA.fromTerms [(7,x), (12,y), (31,z)] .==. LA.constant 17) - assertAtom solver (LA.fromTerms [(3,x), (5,y), (14,z)] .==. LA.constant 7) - assertAtom solver (LA.var x .>=. LA.constant 1) - assertAtom solver (LA.var x .<=. LA.constant 40) - assertAtom solver (LA.var y .>=. LA.constant (-50)) - assertAtom solver (LA.var y .<=. LA.constant 50) - - ret <- check solver - ret @?= True - - vx <- getValue solver x - vy <- getValue solver y - vz <- getValue solver z - 7*vx + 12*vy + 31*vz @?= 17 - 3*vx + 5*vy + 14*vz @?= 7 - assertBool (printf "vx should be >=1 but %s" (show vx)) $ vx >= 1 - assertBool (printf "vx should be <=40 but %s" (show vx)) $ vx <= 40 - assertBool (printf "vx should be >=-50 but %s" (show vy)) $ vy >= -50 - assertBool (printf "vx should be <=50 but %s" (show vy)) $ vy <= 50 - -case_test2 :: IO () -case_test2 = do - solver <- newSolver - x <- newVar solver - y <- newVar solver - assertAtom solver (LA.fromTerms [(11,x), (13,y)] .>=. LA.constant 27) - assertAtom solver (LA.fromTerms [(11,x), (13,y)] .<=. LA.constant 45) - assertAtom solver (LA.fromTerms [(7,x), (-9,y)] .>=. LA.constant (-10)) - assertAtom solver (LA.fromTerms [(7,x), (-9,y)] .<=. LA.constant 4) - - ret <- check solver - ret @?= True - - vx <- getValue solver x - vy <- getValue solver y - let v1 = 11*vx + 13*vy - v2 = 7*vx - 9*vy - assertBool (printf "11*vx + 13*vy should be >=27 but %s" (show v1)) $ 27 <= v1 - assertBool (printf "11*vx + 13*vy should be <=45 but %s" (show v1)) $ v1 <= 45 - assertBool (printf "7*vx - 9*vy should be >=-10 but %s" (show v2)) $ -10 <= v2 - assertBool (printf "7*vx - 9*vy should be >=-10 but %s" (show v2)) $ v2 <= 4 - - -{- -Minimize - obj: - x1 - 2 x2 - 3 x3 - x4 -Subject To - c1: - x1 + x2 + x3 + 10 x4 <= 20 - c2: x1 - 3 x2 + x3 <= 30 - c3: x2 - 3.5 x4 = 0 -Bounds - 0 <= x1 <= 40 - 2 <= x4 <= 3 -End --} -case_test3 :: IO () -case_test3 = do - solver <- newSolver - - _ <- newVar solver - x1 <- newVar solver - x2 <- newVar solver - x3 <- newVar solver - x4 <- newVar solver - - setObj solver (LA.fromTerms [(-1,x1), (-2,x2), (-3,x3), (-1,x4)]) - - assertAtom solver (LA.fromTerms [(-1,x1), (1,x2), (1,x3), (10,x4)] .<=. LA.constant 20) - assertAtom solver (LA.fromTerms [(1,x1), (-3,x2), (1,x3)] .<=. LA.constant 30) - assertAtom solver (LA.fromTerms [(1,x2), (-3.5,x4)] .==. LA.constant 0) - - assertAtom solver (LA.fromTerms [(1,x1)] .>=. LA.constant 0) - assertAtom solver (LA.fromTerms [(1,x1)] .<=. LA.constant 40) - assertAtom solver (LA.fromTerms [(1,x2)] .>=. LA.constant 0) - assertAtom solver (LA.fromTerms [(1,x3)] .>=. LA.constant 0) - assertAtom solver (LA.fromTerms [(1,x4)] .>=. LA.constant 2) - assertAtom solver (LA.fromTerms [(1,x4)] .<=. LA.constant 3) - - ret1 <- check solver - ret1 @?= True - - ret2 <- optimize solver defaultOptions - ret2 @?= Optimum - -{- -http://www.math.cuhk.edu.hk/~wei/lpch5.pdf -example 5.7 - -minimize 3 x1 + 4 x2 + 5 x3 -subject to -1 x1 + 2 x2 + 3 x3 >= 5 -2 x1 + 2 x2 + 1 x3 >= 6 - -optimal value is 11 --} -case_test6 :: IO () -case_test6 = do - solver <- newSolver - - _ <- newVar solver - x1 <- newVar solver - x2 <- newVar solver - x3 <- newVar solver - - assertLower solver x1 0 - assertLower solver x2 0 - assertLower solver x3 0 - assertAtom solver (LA.fromTerms [(1,x1),(2,x2),(3,x3)] .>=. LA.constant 5) - assertAtom solver (LA.fromTerms [(2,x1),(2,x2),(1,x3)] .>=. LA.constant 6) - - setObj solver (LA.fromTerms [(3,x1),(4,x2),(5,x3)]) - setOptDir solver OptMin - b <- isOptimal solver - assertBool "should be optimal" $ b - - ret <- dualSimplex solver defaultOptions - ret @?= Optimum - - val <- getObjValue solver - val @?= 11 - -{- -http://www.math.cuhk.edu.hk/~wei/lpch5.pdf -example 5.7 - -maximize -3 x1 -4 x2 -5 x3 -subject to --1 x1 -2 x2 -3 x3 <= -5 --2 x1 -2 x2 -1 x3 <= -6 - -optimal value should be -11 --} -case_test7 :: IO () -case_test7 = do - solver <- newSolver - - _ <- newVar solver - x1 <- newVar solver - x2 <- newVar solver - x3 <- newVar solver - - assertLower solver x1 0 - assertLower solver x2 0 - assertLower solver x3 0 - assertAtom solver (LA.fromTerms [(-1,x1),(-2,x2),(-3,x3)] .<=. LA.constant (-5)) - assertAtom solver (LA.fromTerms [(-2,x1),(-2,x2),(-1,x3)] .<=. LA.constant (-6)) - - setObj solver (LA.fromTerms [(-3,x1),(-4,x2),(-5,x3)]) - setOptDir solver OptMax - b <- isOptimal solver - assertBool "should be optimal" $ b - - ret <- dualSimplex solver defaultOptions - ret @?= Optimum - - val <- getObjValue solver - val @?= -11 - -case_AssertAtom :: IO () -case_AssertAtom = do - solver <- newSolver - x0 <- newVar solver - assertAtom solver (LA.constant 1 .<=. LA.var x0) - ret <- getLB solver x0 - ret @?= Just 1 - - solver <- newSolver - x0 <- newVar solver - assertAtom solver (LA.var x0 .>=. LA.constant 1) - ret <- getLB solver x0 - ret @?= Just 1 - - solver <- newSolver - x0 <- newVar solver - assertAtom solver (LA.constant 1 .>=. LA.var x0) - ret <- getUB solver x0 - ret @?= Just 1 - - solver <- newSolver - x0 <- newVar solver - assertAtom solver (LA.var x0 .<=. LA.constant 1) - ret <- getUB solver x0 - ret @?= Just 1 - ------------------------------------------------------------------------- - -case_example_3_2 = do - solver <- newSolver - [x1,x2,x3] <- replicateM 3 (newVar solver) - setOptDir solver OptMax - setObj solver $ LA.fromTerms [(3,x1), (2,x2), (3,x3)] - mapM_ (assertAtom solver) $ - [ LA.fromTerms [(2,x1), (1,x2), (1,x3)] .<=. LA.constant 2 - , LA.fromTerms [(1,x1), (2,x2), (3,x3)] .<=. LA.constant 5 - , LA.fromTerms [(2,x1), (2,x2), (1,x3)] .<=. LA.constant 6 - , LA.var x1 .>=. LA.constant 0 - , LA.var x2 .>=. LA.constant 0 - , LA.var x3 .>=. LA.constant 0 - ] - - ret <- optimize solver defaultOptions - ret @?= Optimum - val <- getObjValue solver - val @?= 27/5 - - forM_ [(x1,1/5),(x2,0),(x3,8/5)] $ \(var,expected) -> do - val <- getValue solver var - val @?= expected - -case_example_3_5 = do - solver <- newSolver - [x1,x2,x3,x4,x5] <- replicateM 5 (newVar solver) - setOptDir solver OptMin - setObj solver $ LA.fromTerms [(-2,x1), (4,x2), (7,x3), (1,x4), (5,x5)] - mapM_ (assertAtom solver) $ - [ LA.fromTerms [(-1,x1), (1,x2), (2,x3), (1,x4), (2,x5)] .==. LA.constant 7 - , LA.fromTerms [(-1,x1), (2,x2), (3,x3), (1,x4), (1,x5)] .==. LA.constant 6 - , LA.fromTerms [(-1,x1), (1,x2), (1,x3), (2,x4), (1,x5)] .==. LA.constant 4 - , LA.var x2 .>=. LA.constant 0 - , LA.var x3 .>=. LA.constant 0 - , LA.var x4 .>=. LA.constant 0 - , LA.var x5 .>=. LA.constant 0 - ] - - ret <- optimize solver defaultOptions - ret @?= Optimum - val <- getObjValue solver - val @?= 19 - - forM_ [(x1,-1),(x2,0),(x3,1),(x4,0),(x5,2)] $ \(var,expected) -> do - val <- getValue solver var - val @?= expected - -case_example_4_1 = do - solver <- newSolver - [x1,x2] <- replicateM 2 (newVar solver) - setOptDir solver OptMin - setObj solver $ LA.fromTerms [(2,x1), (1,x2)] - mapM_ (assertAtom solver) $ - [ LA.fromTerms [(-1,x1), (1,x2)] .>=. LA.constant 2 - , LA.fromTerms [( 1,x1), (1,x2)] .<=. LA.constant 1 - , LA.var x1 .>=. LA.constant 0 - , LA.var x2 .>=. LA.constant 0 - ] - ret <- optimize solver defaultOptions - ret @?= Unsat - -case_example_4_2 = do - solver <- newSolver - [x1,x2] <- replicateM 2 (newVar solver) - setOptDir solver OptMax - setObj solver $ LA.fromTerms [(2,x1), (1,x2)] - mapM_ (assertAtom solver) $ - [ LA.fromTerms [(-1,x1), (-1,x2)] .<=. LA.constant 10 - , LA.fromTerms [( 2,x1), (-1,x2)] .<=. LA.constant 40 - , LA.var x1 .>=. LA.constant 0 - , LA.var x2 .>=. LA.constant 0 - ] - ret <- optimize solver defaultOptions - ret @?= Unbounded - -case_example_4_3 = do - solver <- newSolver - [x1,x2] <- replicateM 2 (newVar solver) - setOptDir solver OptMax - setObj solver $ LA.fromTerms [(6,x1), (-2,x2)] - mapM_ (assertAtom solver) $ - [ LA.fromTerms [(2,x1), (-1,x2)] .<=. LA.constant 2 - , LA.var x1 .<=. LA.constant 4 - , LA.var x1 .>=. LA.constant 0 - , LA.var x2 .>=. LA.constant 0 - ] - - ret <- optimize solver defaultOptions - ret @?= Optimum - val <- getObjValue solver - val @?= 12 - - forM_ [(x1,4),(x2,6)] $ \(var,expected) -> do - val <- getValue solver var - val @?= expected - -case_example_4_5 = do - solver <- newSolver - [x1,x2] <- replicateM 2 (newVar solver) - setOptDir solver OptMax - setObj solver $ LA.fromTerms [(2,x1), (1,x2)] - mapM_ (assertAtom solver) $ - [ LA.fromTerms [(4,x1), ( 3,x2)] .<=. LA.constant 12 - , LA.fromTerms [(4,x1), ( 1,x2)] .<=. LA.constant 8 - , LA.fromTerms [(4,x1), (-1,x2)] .<=. LA.constant 8 - , LA.var x1 .>=. LA.constant 0 - , LA.var x2 .>=. LA.constant 0 - ] - - ret <- optimize solver defaultOptions - ret @?= Optimum - val <- getObjValue solver - val @?= 5 - - forM_ [(x1,3/2),(x2,2)] $ \(var,expected) -> do - val <- getValue solver var - val @?= expected - -case_example_4_6 = do - solver <- newSolver - [x1,x2,x3,x4] <- replicateM 4 (newVar solver) - setOptDir solver OptMax - setObj solver $ LA.fromTerms [(20,x1), (1/2,x2), (-6,x3), (3/4,x4)] - mapM_ (assertAtom solver) $ - [ LA.var x1 .<=. LA.constant 2 - , LA.fromTerms [( 8,x1), ( -1,x2), (9,x3), (1/4, x4)] .<=. LA.constant 16 - , LA.fromTerms [(12,x1), (-1/2,x2), (3,x3), (1/2, x4)] .<=. LA.constant 24 - , LA.var x2 .<=. LA.constant 1 - , LA.var x1 .>=. LA.constant 0 - , LA.var x2 .>=. LA.constant 0 - , LA.var x3 .>=. LA.constant 0 - , LA.var x4 .>=. LA.constant 0 - ] - - ret <- optimize solver defaultOptions - ret @?= Optimum - val <- getObjValue solver - val @?= 165/4 - - forM_ [(x1,2),(x2,1),(x3,0),(x4,1)] $ \(var,expected) -> do - val <- getValue solver var - val @?= expected - -case_example_4_7 = do - solver <- newSolver - [x1,x2,x3,x4] <- replicateM 4 (newVar solver) - setOptDir solver OptMax - setObj solver $ LA.fromTerms [(1,x1), (1.5,x2), (5,x3), (2,x4)] - mapM_ (assertAtom solver) $ - [ LA.fromTerms [(3,x1), (2,x2), ( 1,x3), (4,x4)] .<=. LA.constant 6 - , LA.fromTerms [(2,x1), (1,x2), ( 5,x3), (1,x4)] .<=. LA.constant 4 - , LA.fromTerms [(2,x1), (6,x2), (-4,x3), (8,x4)] .==. LA.constant 0 - , LA.fromTerms [(1,x1), (3,x2), (-2,x3), (4,x4)] .==. LA.constant 0 - , LA.var x1 .>=. LA.constant 0 - , LA.var x2 .>=. LA.constant 0 - , LA.var x3 .>=. LA.constant 0 - , LA.var x4 .>=. LA.constant 0 - ] - - ret <- optimize solver defaultOptions - ret @?= Optimum - val <- getObjValue solver - val @?= 48/11 - - forM_ [(x1,0),(x2,0),(x3,8/11),(x4,4/11)] $ \(var,expected) -> do - val <- getValue solver var - val @?= expected - --- 退化して巡回の起こるKuhnの7変数3制約の例 -case_kuhn_7_3 = do - solver <- newSolver - [x1,x2,x3,x4,x5,x6,x7] <- replicateM 7 (newVar solver) - setOptDir solver OptMin - setObj solver $ LA.fromTerms [(-2,x4),(-3,x5),(1,x6),(12,x7)] - mapM_ (assertAtom solver) $ - [ LA.fromTerms [(1,x1), ( -2,x4), (-9,x5), ( 1,x6), ( 9,x7)] .==. LA.constant 0 - , LA.fromTerms [(1,x2), (1/3,x4), ( 1,x5), (-1/3,x6), ( -2,x7)] .==. LA.constant 0 - , LA.fromTerms [(1,x3), ( 2,x4), ( 3,x5), ( -1,x6), (-12,x7)] .==. LA.constant 2 - , LA.var x1 .>=. LA.constant 0 - , LA.var x2 .>=. LA.constant 0 - , LA.var x3 .>=. LA.constant 0 - , LA.var x4 .>=. LA.constant 0 - , LA.var x5 .>=. LA.constant 0 - , LA.var x6 .>=. LA.constant 0 - , LA.var x7 .>=. LA.constant 0 - ] - - ret <- optimize solver defaultOptions - ret @?= Optimum - val <- getObjValue solver - val @?= -2 - - forM_ [(x1,2),(x2,0),(x3,0),(x4,2),(x5,0),(x6,2),(x7,0)] $ \(var,expected) -> do - val <- getValue solver var - val @?= expected - ------------------------------------------------------------------------- --- Test harness - -main :: IO () -main = $(defaultMainGenerator) diff --git a/test/TestSuite.hs b/test/TestSuite.hs new file mode 100644 --- /dev/null +++ b/test/TestSuite.hs @@ -0,0 +1,52 @@ +module Main where + +import Test.Tasty (defaultMain, testGroup) + +import Test.AReal +import Test.AReal2 +import Test.Arith +import Test.BoolExpr +import Test.CongruenceClosure +import Test.ContiTraverso +import Test.Delta +import Test.FiniteModelFinder +import Test.HittingSets +import Test.Knapsack +import Test.LPFile +import Test.MIPSolver2 +import Test.MPSFile +import Test.SDPFile +import Test.Misc +import Test.SAT +import Test.Simplex +import Test.Simplex2 +import Test.SMT +import Test.SMTLIB2Solver +import Test.Smtlib +import Test.SubsetSum + +main :: IO () +main = defaultMain $ testGroup "ToySolver test suite" + [ arealTestGroup +-- , areal2TestGroup + , arithTestGroup + , boolExprTestGroup + , ccTestGroup + , ctTestGroup + , deltaTestGroup + , fmfTestGroup + , hittingSetsTestGroup + , knapsackTestGroup + , lpTestGroup + , miscTestGroup + , mipSolver2TestGroup + , mpsTestGroup + , satTestGroup + , sdpTestGroup + , simplexTestGroup + , simplex2TestGroup + , smtTestGroup + , smtlib2SolverTestGroup + , smtlibTestGroup + , subsetSumTestGroup + ] diff --git a/test/TestUtil.hs b/test/TestUtil.hs deleted file mode 100644 --- a/test/TestUtil.hs +++ /dev/null @@ -1,447 +0,0 @@ -{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-} -module Main (main) where - -import Prelude hiding (all) - -import Control.Applicative -import Control.Arrow -import Control.Monad -import Data.Foldable (all) -import Data.IntSet (IntSet) -import qualified Data.IntSet as IntSet -import Data.Ratio -import Data.Set (Set) -import qualified Data.Set as Set -import Test.QuickCheck.Function -import Test.Tasty -import Test.Tasty.QuickCheck hiding ((.&&.), (.||.)) -import Test.Tasty.HUnit -import Test.Tasty.TH -import ToySolver.Data.Boolean -import ToySolver.Data.BoolExpr -import qualified ToySolver.Internal.Data.Vec as Vec -import ToySolver.Internal.Util -import ToySolver.Internal.TextUtil -import qualified ToySolver.Combinatorial.Knapsack.BB as KnapsackBB -import qualified ToySolver.Combinatorial.Knapsack.DP as KnapsackDP -import qualified ToySolver.Combinatorial.HittingSet.Simple as HittingSet -import qualified ToySolver.Combinatorial.HittingSet.FredmanKhachiyan1996 as FredmanKhachiyan1996 -import qualified ToySolver.Combinatorial.HittingSet.GurvichKhachiyan1999 as GurvichKhachiyan1999 -import qualified ToySolver.Wang as Wang - -case_showRationalAsDecimal :: IO () -case_showRationalAsDecimal = do - showRationalAsFiniteDecimal 0 @?= Just "0.0" - showRationalAsFiniteDecimal 1 @?= Just "1.0" - showRationalAsFiniteDecimal (-1) @?= Just "-1.0" - showRationalAsFiniteDecimal 0.1 @?= Just "0.1" - showRationalAsFiniteDecimal (-0.1) @?= Just "-0.1" - showRationalAsFiniteDecimal 1.1 @?= Just "1.1" - showRationalAsFiniteDecimal (-1.1) @?= Just "-1.1" - showRationalAsFiniteDecimal (5/4) @?= Just "1.25" - showRationalAsFiniteDecimal (-5/4) @?= Just "-1.25" - showRationalAsFiniteDecimal (4/3) @?= Nothing - showRationalAsFiniteDecimal (-4/3) @?= Nothing - -case_readUnsignedInteger_maxBound_bug :: IO () -case_readUnsignedInteger_maxBound_bug = - readUnsignedInteger "006666666666666667" @?= 6666666666666667 - -prop_readUnsignedInteger = - forAll (choose (0, 2^(128::Int))) $ \i -> - readUnsignedInteger (show i) == i - --- --------------------------------------------------------------------- --- Knapsack problems - -case_knapsack_1 :: IO () -case_knapsack_1 = KnapsackBB.solve [(5,4), (6,5), (3,2)] 9 @?= (11, 9, [True,True,False]) - -case_knapsack_2 :: IO () -case_knapsack_2 = KnapsackBB.solve [(16,2), (19,3), (23,4), (28,5)] 7 @?= (44, 7, [True,False,False,True]) - -case_knapsack_DP_1 :: IO () -case_knapsack_DP_1 = KnapsackDP.solve [(5,4), (6,5), (3,2)] 9 @?= (11, 9, [True,True,False]) - -case_knapsack_DP_2 :: IO () -case_knapsack_DP_2 = KnapsackDP.solve [(16,2), (19,3), (23,4), (28,5)] 7 @?= (44, 7, [True,False,False,True]) - -prop_knapsack_DP_equals_BB = - forAll knapsackProblems $ \(items,lim) -> - let items' = [(v, fromIntegral w) | (v,w) <- items] - lim' = fromIntegral lim - (v1,_,_) = KnapsackBB.solve items' lim' - (v2,_,_) = KnapsackDP.solve items lim - in v1 == v2 - -knapsackProblems :: Gen ([(KnapsackDP.Value, KnapsackDP.Weight)], KnapsackDP.Weight) -knapsackProblems = do - lim <- choose (0,30) - items <- listOf $ do - v <- liftM abs arbitrary - w <- choose (1,30) - return (v,w) - return (items, lim) - --- --------------------------------------------------------------------- --- Hitting sets - -case_minimalHittingSets_1 = actual @?= expected - where - actual = HittingSet.minimalHittingSets $ Set.fromList $ map IntSet.fromList [[1], [2,3,5], [2,3,6], [2,4,5], [2,4,6]] - expected = Set.fromList $ map IntSet.fromList [[1,2], [1,3,4], [1,5,6]] - --- an example from http://kuma-san.net/htcbdd.html -case_minimalHittingSets_2 = actual @?= expected - where - actual = HittingSet.minimalHittingSets $ Set.fromList $ map IntSet.fromList [[2,4,7], [7,8], [9], [9,10]] - expected = Set.fromList $ map IntSet.fromList [[7,9], [4,8,9], [2,8,9]] - -hyperGraph :: Gen (Set IntSet) -hyperGraph = do - nv <- choose (0, 10) - ne <- if nv==0 then return 0 else choose (0, 20) - liftM Set.fromList $ replicateM ne $ do - n <- choose (1,nv) - liftM IntSet.fromList $ replicateM n $ choose (1, nv) - -isHittingSetOf :: IntSet -> Set IntSet -> Bool -isHittingSetOf s g = all (\e -> not (IntSet.null (s `IntSet.intersection` e))) g - -prop_minimalHittingSets_duality = - forAll hyperGraph $ \g -> - let h = HittingSet.minimalHittingSets g - in h == HittingSet.minimalHittingSets (HittingSet.minimalHittingSets h) - -prop_minimalHittingSets_isHittingSet = - forAll hyperGraph $ \g -> - all (`isHittingSetOf` g) (HittingSet.minimalHittingSets g) - -prop_minimalHittingSets_minimality = - forAll hyperGraph $ \g -> - forAll (elements (Set.toList (HittingSet.minimalHittingSets g))) $ \s -> - if IntSet.null s then - property True - else - forAll (elements (IntSet.toList s)) $ \v -> - not $ IntSet.delete v s `isHittingSetOf` g - -mutuallyDualHypergraphs :: Gen (Set IntSet, Set IntSet) -mutuallyDualHypergraphs = do - g <- liftM HittingSet.minimalHittingSets hyperGraph - let f = HittingSet.minimalHittingSets g - return (f,g) - -mutuallyDualDNFs :: Gen (Set IntSet, Set IntSet) -mutuallyDualDNFs = do - (f,g) <- mutuallyDualHypergraphs - let xs = IntSet.unions $ Set.toList $ f `Set.union` g - if IntSet.null xs then - return (f,g) - else do - let xs' = IntSet.toList xs - let mutate h = liftM Set.unions $ do - forM (Set.toList h) $ \is -> oneof $ - [ return $ Set.singleton is - , do i <- elements xs' - return $ Set.fromList [is, IntSet.insert i is] - ] - f' <- mutate f - g' <- mutate g - return (f',g') - --- Pair of DNFs that are nearly dual. -pairOfDNFs :: Gen (Set IntSet, Set IntSet) -pairOfDNFs = do - (f,g) <- mutuallyDualDNFs - let mutate h = liftM Set.unions $ do - forM (Set.toList h) $ \is -> oneof $ - [return Set.empty, return (Set.singleton is)] ++ - [ do x <- elements (IntSet.toList is) - return $ Set.singleton $ IntSet.delete x is - | not (IntSet.null is) - ] - return (f,g) - -prop_FredmanKhachiyan1996_checkDualityA_prop1 = - forAll mutuallyDualDNFs $ \(f,g) -> - FredmanKhachiyan1996.checkDualityA f g == Nothing - -prop_FredmanKhachiyan1996_checkDualityA_prop2 = - forAll pairOfDNFs $ \(f,g) -> - case FredmanKhachiyan1996.checkDualityA f g of - Nothing -> True - Just xs -> xs `FredmanKhachiyan1996.isCounterExampleOf` (f,g) - -prop_FredmanKhachiyan1996_checkDualityB_prop1 = - forAll mutuallyDualDNFs $ \(f,g) -> - FredmanKhachiyan1996.checkDualityA f g == Nothing - -prop_FredmanKhachiyan1996_checkDualityB_prop2 = - forAll pairOfDNFs $ \(f,g) -> - case FredmanKhachiyan1996.checkDualityB f g of - Nothing -> True - Just xs -> xs `FredmanKhachiyan1996.isCounterExampleOf` (f,g) - -prop_FredmanKhachiyan1996_lemma_1 = - forAll mutuallyDualHypergraphs $ \(f,g) -> - let e :: Rational - e = sum [1 % (2 ^ IntSet.size i) | i <- Set.toList f] + - sum [1 % (2 ^ IntSet.size j) | j <- Set.toList g] - in e >= 1 - -prop_FredmanKhachiyan1996_corollary_1 = - forAll mutuallyDualHypergraphs $ \(f,g) -> - let n = Set.size f + Set.size g - m = minimum [IntSet.size is | is <- Set.toList (f `Set.union` g)] - in fromIntegral m <= logBase 2 (fromIntegral n) - -prop_FredmanKhachiyan1996_lemma_2 = - forAll mutuallyDualHypergraphs $ \(f,g) -> - let n = Set.size f + Set.size g - epsilon :: Double - epsilon = 1 / logBase 2 (fromIntegral n) - vs = IntSet.unions $ Set.toList $ f `Set.union` g - in (Set.size f * Set.size g >= 1) - ==> any (\v -> FredmanKhachiyan1996.occurFreq v f >= epsilon || FredmanKhachiyan1996.occurFreq v g >= epsilon) (IntSet.toList vs) - -prop_FredmanKhachiyan1996_lemma_3_a = - forAll mutuallyDualHypergraphs $ \(f,g) -> - let vs = IntSet.unions $ Set.toList $ f `Set.union` g - x = IntSet.findMin vs - -- f = x f0 ∨ f1 - (f0, f1) = Set.map (IntSet.delete x) *** id $ Set.partition (x `IntSet.member`) f - -- g = x g0 ∨ g1 - (g0, g1) = Set.map (IntSet.delete x) *** id $ Set.partition (x `IntSet.member`) g - in not (IntSet.null vs) - ==> - HittingSet.minimalHittingSets f1 == FredmanKhachiyan1996.deleteRedundancy (g0 `Set.union` g1) && - HittingSet.minimalHittingSets g1 == FredmanKhachiyan1996.deleteRedundancy (f0 `Set.union` f1) - -prop_FredmanKhachiyan1996_to_selfDuality = - forAll mutuallyDualHypergraphs $ \(f,g) -> - let vs = IntSet.unions $ Set.toList $ f `Set.union` g - y = if IntSet.null vs then 0 else IntSet.findMax vs + 1 - z = y + 1 - h = FredmanKhachiyan1996.deleteRedundancy $ Set.unions - [ Set.map (IntSet.insert y) f - , Set.map (IntSet.insert z) g - , Set.singleton (IntSet.fromList [y,z]) - ] - in HittingSet.minimalHittingSets h == h - -prop_GurvichKhachiyan1999_generateCNFAndDNF = - forAll hyperGraph $ \g -> - let vs = IntSet.unions $ Set.toList g - f xs = any (\is -> not $ IntSet.null $ xs `IntSet.intersection` is) (Set.toList g) - dual f is = not $ f (vs `IntSet.difference` is) - is `isImplicantOf` f = f is - is `isImplicateOf` f = is `isImplicantOf` dual f - is `isPrimeImplicantOf` f = is `isImplicantOf` f && all (\i -> not (IntSet.delete i is `isImplicantOf` f)) (IntSet.toList is) - is `isPrimeImplicateOf` f = is `isImplicateOf` f && all (\i -> not (IntSet.delete i is `isImplicateOf` f)) (IntSet.toList is) - (cnf,dnf) = GurvichKhachiyan1999.generateCNFAndDNF vs f Set.empty Set.empty - in all (`isPrimeImplicantOf` f) (Set.toList dnf) && - all (`isPrimeImplicateOf` f) (Set.toList cnf) - -prop_GurvichKhachiyan1999_minimalHittingSets_duality = - forAll hyperGraph $ \g -> - let h = GurvichKhachiyan1999.minimalHittingSets g - in h == GurvichKhachiyan1999.minimalHittingSets (GurvichKhachiyan1999.minimalHittingSets h) - -prop_GurvichKhachiyan1999_minimalHittingSets_isHittingSet = - forAll hyperGraph $ \g -> - all (`isHittingSetOf` g) (GurvichKhachiyan1999.minimalHittingSets g) - -prop_GurvichKhachiyan1999_minimalHittingSets_minimality = - forAll hyperGraph $ \g -> - forAll (elements (Set.toList (GurvichKhachiyan1999.minimalHittingSets g))) $ \s -> - if IntSet.null s then - property True - else - forAll (elements (IntSet.toList s)) $ \v -> - not $ IntSet.delete v s `isHittingSetOf` g - --- --------------------------------------------------------------------- --- Vec - -case_Vec :: IO () -case_Vec = do - (v::Vec.UVec Int) <- Vec.new - let xs = [0..100] - forM_ xs $ \i -> Vec.push v i - ys <- Vec.getElems v - ys @?= xs - - Vec.resize v 4 - zs <- Vec.getElems v - zs @?= take 4 xs - - Vec.push v 1 - Vec.push v 2 - Vec.push v 3 - - ws <- Vec.getElems v - ws @?= take 4 xs ++ [1,2,3] - - x3 <- Vec.unsafePop v - x3 @?= 3 - s <- Vec.getSize v - s @?= 6 - ws <- Vec.getElems v - ws @?= take 4 xs ++ [1,2] - -case_Vec_clone :: IO () -case_Vec_clone = do - (v::Vec.UVec Int) <- Vec.new - Vec.push v 0 - v2 <- Vec.clone v - Vec.write v2 0 1 - - a <- Vec.read v 0 - a @?= 0 - - b <- Vec.read v2 0 - b @?= 1 - --- --------------------------------------------------------------------- --- BoolExpr - -instance Arbitrary a => Arbitrary (BoolExpr a) where - arbitrary = sized f - where - f n | n <= 0 = Atom <$> arbitrary - f n = - oneof - [ Atom <$> arbitrary - , And <$> list (n-1) - , Or <$> list (n-1) - , Not <$> (f (n-1)) - , uncurry Imply <$> pair (n-1) - , uncurry Equiv <$> pair (n-1) - , triple (n-1) >>= \(c,t,e) -> return (ITE c t e) - ] - - pair n | n <= 0 = do - a <- f 0 - b <- f 0 - return (a,b) - pair n = do - m <- choose (0,n) - a <- f m - b <- f (n-m) - return (a,b) - - triple n | n <= 0 = do - a <- f 0 - b <- f 0 - c <- f 0 - return (a,b,c) - triple n = do - m <- choose (0, n) - o <- choose (0, n-m) - a <- f m - b <- f o - c <- f (n - m - o) - return (a,b,c) - - list n | n <= 0 = return [] - list n = oneof $ - [ return [] - , do m <- choose (0,n) - x <- f m - xs <- list (n-m-1) - return (x:xs) - ] - -prop_BoolExpr_Functor_identity = - forAll arbitrary $ \(b :: BoolExpr Int) -> - fmap id b == b - -prop_BoolExpr_Functor_compsition = - forAll arbitrary $ \(b :: BoolExpr Int) -> - forAll arbitrary $ \(f :: Fun Int Int) -> - forAll arbitrary $ \(g :: Fun Int Int) -> - fmap (apply f . apply g) b == fmap (apply f) (fmap (apply g) b) - -prop_BoolExpr_Applicative_identity = - forAll arbitrary $ \(b :: BoolExpr Int) -> - (pure id <*> b) == b - -prop_BoolExpr_Applicative_composition = - forAll arbitrary $ \(w :: BoolExpr Int) -> - forAll arbitrary $ \(u :: BoolExpr (Fun Int Int)) -> - forAll arbitrary $ \(v :: BoolExpr (Fun Int Int)) -> - (pure (.) <*> fmap apply u <*> fmap apply v <*> w) == (fmap apply u <*> (fmap apply v <*> w)) - -prop_BoolExpr_Applicative_homomorphism = - forAll arbitrary $ \(x :: Int) -> - forAll arbitrary $ \(f :: Fun Int Int) -> - (pure (apply f) <*> pure x) == (pure (apply f x) :: BoolExpr Int) - -prop_BoolExpr_Applicative_interchange = - forAll arbitrary $ \(y :: Int) -> - forAll arbitrary $ \(u :: BoolExpr (Fun Int Int)) -> - (fmap apply u <*> pure y) == (pure ($ y) <*> fmap apply u) - -prop_BoolExpr_Monad_left_identity = - forAll arbitrary $ \(b :: BoolExpr Int) -> - forAll arbitrary $ \(f :: Fun Int (BoolExpr Int)) -> - (b >>= (\x -> return x >>= apply f)) == (b >>= apply f) - -prop_BoolExpr_Monad_bind_right_identity = - forAll arbitrary $ \(b :: BoolExpr Int) -> - forAll arbitrary $ \(f :: Fun Int (BoolExpr Int)) -> - (b >>= (\x -> apply f x >>= return)) == (b >>= apply f) - -prop_BoolExpr_Monad_bind_associativity = - forAll arbitrary $ \(b :: BoolExpr Int) -> - forAll arbitrary $ \(f :: Fun Int (BoolExpr Int)) -> - forAll arbitrary $ \(g :: Fun Int (BoolExpr Int)) -> - (b >>= apply f >>= apply g) == (b >>= (\x -> apply f x >>= apply g)) - - --- --------------------------------------------------------------------- --- Wang - --- (x1 ∨ x2) ∧ (x1 ∨ ¬x2) ∧ (¬x1 ∨ ¬x2) is satisfiable --- ¬((x1 ∨ x2) ∧ (x1 ∨ ¬x2) ∧ (¬x1 ∨ ¬x2)) is invalid -case_Wang_1 = - Wang.isValid ([], [phi]) @?= False - where - phi = notB $ andB [x1 .||. x2, x1 .||. notB x2, notB x1 .||. notB x2] - x1 = Atom 1 - x2 = Atom 2 - --- (x1 ∨ x2) ∧ (¬x1 ∨ x2) ∧ (x1 ∨ ¬x2) ∧ (¬x1 ∨ ¬x2) is unsatisfiable --- ¬((x1 ∨ x2) ∧ (¬x1 ∨ x2) ∧ (x1 ∨ ¬x2) ∧ (¬x1 ∨ ¬x2)) is valid -case_Wang_2 = - Wang.isValid ([], [phi]) @?= True - where - phi = notB $ andB [x1 .||. x2, notB x1 .||. x2, x1 .||. notB x2, notB x1 .||. notB x2] - x1 = Atom 1 - x2 = Atom 2 - -case_Wang_EM = - Wang.isValid ([], [phi]) @?= True - where - phi = x1 .||. notB x1 - x1 = Atom 1 - -case_Wang_DNE = - Wang.isValid ([], [phi]) @?= True - where - phi = notB (notB x1) .<=>. x1 - x1 = Atom 1 - -case_Wang_Peirces_Law = - Wang.isValid ([], [phi]) @?= True - where - phi = ((x1 .=>. x2) .=>. x1) .=>. x1 - x1 = Atom 1 - x2 = Atom 2 - ------------------------------------------------------------------------- --- Test harness - -main :: IO () -main = $(defaultMainGenerator) diff --git a/toyfmf/toyfmf.hs b/toyfmf/toyfmf.hs --- a/toyfmf/toyfmf.hs +++ b/toyfmf/toyfmf.hs @@ -21,7 +21,7 @@ import System.IO import qualified Codec.TPTP as TPTP import ToySolver.Data.Boolean -import qualified ToySolver.FOLModelFinder as MF +import qualified ToySolver.EUF.FiniteModelFinder as MF main :: IO () main = do diff --git a/toysat/toysat.hs b/toysat/toysat.hs --- a/toysat/toysat.hs +++ b/toysat/toysat.hs @@ -32,6 +32,8 @@ import Data.Maybe import Data.Ord import Data.Ratio +import Data.Word +import qualified Data.Vector.Unboxed as V import Data.VectorSpace import Data.Version import Data.Time @@ -45,7 +47,7 @@ import System.CPUTime import System.FilePath import qualified System.Info as SysInfo -import qualified System.Random as Rand +import qualified System.Random.MWC as Rand import qualified Language.CNF.Parse.ParseDIMACS as DIMACS import Text.Printf #ifdef __GLASGOW_HASKELL__ @@ -54,17 +56,16 @@ #ifdef FORCE_CHAR8 import GHC.IO.Encoding #endif -#if defined(__GLASGOW_HASKELL__) && MIN_VERSION_base(4,5,0) +#if defined(__GLASGOW_HASKELL__) import qualified GHC.Stats as Stats #endif import qualified Data.PseudoBoolean as PBFile import qualified Data.PseudoBoolean.Attoparsec as PBFileAttoparsec -import ToySolver.Data.ArithRel +import ToySolver.Data.OrdRel import qualified ToySolver.Data.MIP as MIP import qualified ToySolver.Converter.MaxSAT2WBO as MaxSAT2WBO import qualified ToySolver.SAT as SAT -import qualified ToySolver.SAT.Types as SAT import qualified ToySolver.SAT.PBO as PBO import qualified ToySolver.SAT.Integer as Integer import qualified ToySolver.SAT.TseitinEncoder as Tseitin @@ -93,21 +94,9 @@ data Options = Options { optMode :: Maybe Mode - , optRestartStrategy :: SAT.RestartStrategy - , optRestartFirst :: Int - , optRestartInc :: Double - , optLearningStrategy :: SAT.LearningStrategy - , optLearntSizeFirst :: Int - , optLearntSizeInc :: Double - , optCCMin :: Int - , optEnablePhaseSaving :: Bool - , optEnableForwardSubsumptionRemoval :: Bool - , optEnableBackwardSubsumptionRemoval :: Bool - , optRandomFreq :: Double - , optRandomGen :: Maybe Rand.StdGen + , optSATConfig :: SAT.Config + , optRandomSeed :: Maybe Rand.Seed , optLinearizerPB :: Bool - , optPBHandlerType :: SAT.PBHandlerType - , optPBSplitClausePart :: Bool , optSearchStrategy :: PBO.SearchStrategy , optObjFunVarsHeuristics :: Bool , optLocalSearchInitial :: Bool @@ -115,46 +104,29 @@ , optAllMUSes :: Bool , optAllMUSMethod :: AllMUSMethod , optPrintRational :: Bool - , optCheckModel :: Bool , optTimeout :: Integer , optWriteFile :: Maybe FilePath , optUBCSAT :: FilePath } instance Default Options where - def = defaultOptions - -defaultOptions :: Options -defaultOptions - = Options - { optMode = Nothing - , optRestartStrategy = SAT.defaultRestartStrategy - , optRestartFirst = SAT.defaultRestartFirst - , optRestartInc = SAT.defaultRestartInc - , optLearningStrategy = SAT.defaultLearningStrategy - , optLearntSizeFirst = SAT.defaultLearntSizeFirst - , optLearntSizeInc = SAT.defaultLearntSizeInc - , optCCMin = SAT.defaultCCMin - , optEnablePhaseSaving = SAT.defaultEnablePhaseSaving - , optEnableForwardSubsumptionRemoval = SAT.defaultEnableForwardSubsumptionRemoval - , optRandomFreq = SAT.defaultRandomFreq - , optRandomGen = Nothing - , optLinearizerPB = False - , optPBHandlerType = SAT.defaultPBHandlerType - , optPBSplitClausePart = SAT.defaultPBSplitClausePart - , optEnableBackwardSubsumptionRemoval = SAT.defaultEnableBackwardSubsumptionRemoval - , optSearchStrategy = PBO.defaultSearchStrategy - , optObjFunVarsHeuristics = PBO.defaultEnableObjFunVarsHeuristics - , optLocalSearchInitial = False - , optMUSMethod = MUSLinear - , optAllMUSes = False - , optAllMUSMethod = AllMUSCAMUS - , optPrintRational = False - , optCheckModel = False - , optTimeout = 0 - , optWriteFile = Nothing - , optUBCSAT = "ubcsat" - } + def = + Options + { optMode = Nothing + , optSATConfig = def + , optRandomSeed = Nothing + , optLinearizerPB = False + , optSearchStrategy = def + , optObjFunVarsHeuristics = PBO.defaultEnableObjFunVarsHeuristics + , optLocalSearchInitial = False + , optMUSMethod = MUSLinear + , optAllMUSes = False + , optAllMUSMethod = AllMUSCAMUS + , optPrintRational = False + , optTimeout = 0 + , optWriteFile = Nothing + , optUBCSAT = "ubcsat" + } options :: [OptDescr (Options -> Options)] options = @@ -169,53 +141,53 @@ , Option [] ["lp"] (NoArg (\opt -> opt{ optMode = Just ModeMIP })) "solve bounded integer programming problem in .lp or .mps file" , Option [] ["restart"] - (ReqArg (\val opt -> opt{ optRestartStrategy = parseRestartStrategy val }) "") + (ReqArg (\val opt -> opt{ optSATConfig = (optSATConfig opt){ SAT.configRestartStrategy = parseRestartStrategy val } }) "") "Restart startegy: MiniSAT (default), Armin, Luby." , Option [] ["restart-first"] - (ReqArg (\val opt -> opt{ optRestartFirst = read val }) "") - (printf "The initial restart limit. (default %d)" SAT.defaultRestartFirst) + (ReqArg (\val opt -> opt{ optSATConfig = (optSATConfig opt){ SAT.configRestartFirst = read val } }) "") + (printf "The initial restart limit. (default %d)" (SAT.configRestartFirst def)) , Option [] ["restart-inc"] - (ReqArg (\val opt -> opt{ optRestartInc = read val }) "") - (printf "The factor with which the restart limit is multiplied in each restart. (default %f)" SAT.defaultRestartInc) + (ReqArg (\val opt -> opt{ optSATConfig = (optSATConfig opt){ SAT.configRestartInc = read val } }) "") + (printf "The factor with which the restart limit is multiplied in each restart. (default %f)" (SAT.configRestartInc def)) , Option [] ["learning"] - (ReqArg (\val opt -> opt{ optLearningStrategy = parseLS val }) "") + (ReqArg (\val opt -> opt{ optSATConfig = (optSATConfig opt){ SAT.configLearningStrategy = parseLS val } }) "") "Leaning scheme: clause (default), hybrid" , Option [] ["learnt-size-first"] - (ReqArg (\val opt -> opt{ optLearntSizeFirst = read val }) "") + (ReqArg (\val opt -> opt{ optSATConfig = (optSATConfig opt){ SAT.configLearntSizeFirst = read val } }) "") "The initial limit for learnt clauses." , Option [] ["learnt-size-inc"] - (ReqArg (\val opt -> opt{ optLearntSizeInc = read val }) "") - (printf "The limit for learnt clauses is multiplied with this factor periodically. (default %f)" SAT.defaultLearntSizeInc) + (ReqArg (\val opt -> opt{ optSATConfig = (optSATConfig opt){ SAT.configLearntSizeInc = read val } }) "") + (printf "The limit for learnt clauses is multiplied with this factor periodically. (default %f)" (SAT.configLearntSizeInc def)) , Option [] ["ccmin"] - (ReqArg (\val opt -> opt{ optCCMin = read val }) "") - (printf "Conflict clause minimization (0=none, 1=local, 2=recursive; default %d)" SAT.defaultCCMin) + (ReqArg (\val opt -> opt{ optSATConfig = (optSATConfig opt){ SAT.configCCMin = read val } }) "") + (printf "Conflict clause minimization (0=none, 1=local, 2=recursive; default %d)" (SAT.configCCMin def)) , Option [] ["enable-phase-saving"] - (NoArg (\opt -> opt{ optEnablePhaseSaving = True })) - ("Enable phase saving" ++ (if SAT.defaultEnablePhaseSaving then " (default)" else "")) + (NoArg (\opt -> opt{ optSATConfig = (optSATConfig opt){ SAT.configEnablePhaseSaving = True } })) + ("Enable phase saving" ++ (if SAT.configEnablePhaseSaving def then " (default)" else "")) , Option [] ["disable-phase-saving"] - (NoArg (\opt -> opt{ optEnablePhaseSaving = False })) - ("Disable phase saving" ++ (if SAT.defaultEnablePhaseSaving then "" else " (default)")) + (NoArg (\opt -> opt{ optSATConfig = (optSATConfig opt){ SAT.configEnablePhaseSaving = False } })) + ("Disable phase saving" ++ (if SAT.configEnablePhaseSaving def then "" else " (default)")) , Option [] ["enable-forward-subsumption-removal"] - (NoArg (\opt -> opt{ optEnableForwardSubsumptionRemoval = True })) - ("Enable forward subumption removal (clauses only)" ++ (if SAT.defaultEnableForwardSubsumptionRemoval then " (default)" else "")) + (NoArg (\opt -> opt{ optSATConfig = (optSATConfig opt){ SAT.configEnableForwardSubsumptionRemoval = True } })) + ("Enable forward subumption removal (clauses only)" ++ (if SAT.configEnableForwardSubsumptionRemoval def then " (default)" else "")) , Option [] ["disable-forward-subsumption-removal"] - (NoArg (\opt -> opt{ optEnableForwardSubsumptionRemoval = False })) - ("Disable forward subsumption removal (clauses only)" ++ (if SAT.defaultEnableForwardSubsumptionRemoval then "" else " (default)")) + (NoArg (\opt -> opt{ optSATConfig = (optSATConfig opt){ SAT.configEnableForwardSubsumptionRemoval = False } })) + ("Disable forward subsumption removal (clauses only)" ++ (if SAT.configEnableForwardSubsumptionRemoval def then "" else " (default)")) , Option [] ["enable-backward-subsumption-removal"] - (NoArg (\opt -> opt{ optEnableBackwardSubsumptionRemoval = True })) - ("Enable backward subsumption removal." ++ (if SAT.defaultEnableBackwardSubsumptionRemoval then " (default)" else "")) + (NoArg (\opt -> opt{ optSATConfig = (optSATConfig opt){ SAT.configEnableBackwardSubsumptionRemoval = True } })) + ("Enable backward subsumption removal." ++ (if SAT.configEnableBackwardSubsumptionRemoval def then " (default)" else "")) , Option [] ["disable-backward-subsumption-removal"] - (NoArg (\opt -> opt{ optEnableBackwardSubsumptionRemoval = False })) - ("Disable backward subsumption removal." ++ (if SAT.defaultEnableBackwardSubsumptionRemoval then "" else " (default)")) + (NoArg (\opt -> opt{ optSATConfig = (optSATConfig opt){ SAT.configEnableBackwardSubsumptionRemoval = False } })) + ("Disable backward subsumption removal." ++ (if SAT.configEnableBackwardSubsumptionRemoval def then "" else " (default)")) , Option [] ["random-freq"] - (ReqArg (\val opt -> opt{ optRandomFreq = read val }) "<0..1>") - (printf "The frequency with which the decision heuristic tries to choose a random variable (default %f)" SAT.defaultRandomFreq) + (ReqArg (\val opt -> opt{ optSATConfig = (optSATConfig opt){ SAT.configRandomFreq = read val } }) "<0..1>") + (printf "The frequency with which the decision heuristic tries to choose a random variable (default %f)" (SAT.configRandomFreq def)) , Option [] ["random-seed"] - (ReqArg (\val opt -> opt{ optRandomGen = Just (Rand.mkStdGen (read val)) }) "") + (ReqArg (\val opt -> opt{ optRandomSeed = Just (Rand.toSeed (V.singleton (read val) :: V.Vector Word32)) }) "") "random seed used by the random variable selection" , Option [] ["random-gen"] - (ReqArg (\val opt -> opt{ optRandomGen = Just (read val) }) "") + (ReqArg (\val opt -> opt{ optRandomSeed = Just (Rand.toSeed (V.fromList (map read $ words $ val) :: V.Vector Word32)) }) "") "another way of specifying random seed used by the random variable selection" , Option [] ["linearizer-pb"] @@ -223,14 +195,14 @@ "Use PB constraint in linearization." , Option [] ["pb-handler"] - (ReqArg (\val opt -> opt{ optPBHandlerType = parsePBHandler val }) "") + (ReqArg (\val opt -> opt{ optSATConfig = (optSATConfig opt){ SAT.configPBHandlerType = parsePBHandler val } }) "") "PB constraint handler: counter (default), pueblo" , Option [] ["pb-split-clause-part"] - (NoArg (\opt -> opt{ optPBSplitClausePart = True })) - ("Split clause part of PB constraints." ++ (if SAT.defaultPBSplitClausePart then " (default)" else "")) + (NoArg (\opt -> opt{ optSATConfig = (optSATConfig opt){ SAT.configEnablePBSplitClausePart = True } })) + ("Split clause part of PB constraints." ++ (if SAT.configEnablePBSplitClausePart def then " (default)" else "")) , Option [] ["no-pb-split-clause-part"] - (NoArg (\opt -> opt{ optPBSplitClausePart = False })) - ("Do not split clause part of PB constraints." ++ (if SAT.defaultPBSplitClausePart then "" else " (default)")) + (NoArg (\opt -> opt{ optSATConfig = (optSATConfig opt){ SAT.configEnablePBSplitClausePart = False } })) + ("Do not split clause part of PB constraints." ++ (if SAT.configEnablePBSplitClausePart def then "" else " (default)")) , Option [] ["search"] (ReqArg (\val opt -> opt{ optSearchStrategy = parseSearch val }) "") @@ -263,7 +235,7 @@ "write model to filename in Gurobi .sol format" , Option [] ["check-model"] - (NoArg (\opt -> opt{ optCheckModel = True })) + (NoArg (\opt -> opt{ optSATConfig = (optSATConfig opt){ SAT.configCheckModel = True } })) "check model for debug" , Option [] ["timeout"] @@ -388,14 +360,10 @@ printGCStat printGCStat :: IO () -#if defined(__GLASGOW_HASKELL__) && MIN_VERSION_base(4,5,0) +#if defined(__GLASGOW_HASKELL__) printGCStat = do -#if MIN_VERSION_base(4,6,0) b <- Stats.getGCStatsEnabled when b $ do -#else - do -#endif stat <- Stats.getGCStats putCommentLine "GCStats:" putCommentLine $ printf " bytesAllocated = %d" $ Stats.bytesAllocated stat @@ -414,11 +382,7 @@ putCommentLine $ printf " gcWallSeconds = %5.2f" $ Stats.gcWallSeconds stat putCommentLine $ printf " cpuSeconds = %5.2f" $ Stats.cpuSeconds stat putCommentLine $ printf " wallSeconds = %5.2f" $ Stats.wallSeconds stat -#if MIN_VERSION_base(4,6,0) putCommentLine $ printf " parTotBytesCopied = %d" $ Stats.parTotBytesCopied stat -#else - putCommentLine $ printf " parAvgBytesCopied = %d" $ Stats.parAvgBytesCopied stat -#endif putCommentLine $ printf " parMaxBytesCopied = %d" $ Stats.parMaxBytesCopied stat #else printGCStat = return () @@ -444,6 +408,9 @@ printSysInfo = do tm <- getZonedTime putCommentLine $ printf "%s" (formatTime defaultTimeLocale "%FT%X%z" tm) + putCommentLine $ printf "version = %s" (showVersion version) + putCommentLine $ printf "githash = %s" (fromMaybe "" gitHash) + putCommentLine $ printf "compilationtime = %s" (show compilationTime) putCommentLine $ printf "arch = %s" SysInfo.arch putCommentLine $ printf "os = %s" SysInfo.os putCommentLine $ printf "compiler = %s %s" SysInfo.compilerName (showVersion SysInfo.compilerVersion) @@ -471,27 +438,14 @@ newSolver :: Options -> IO SAT.Solver newSolver opts = do - solver <- SAT.newSolver - SAT.setRestartStrategy solver (optRestartStrategy opts) - SAT.setRestartFirst solver (optRestartFirst opts) - SAT.setRestartInc solver (optRestartInc opts) - SAT.setLearntSizeFirst solver (optLearntSizeFirst opts) - SAT.setLearntSizeInc solver (optLearntSizeInc opts) - SAT.setCCMin solver (optCCMin opts) - SAT.setRandomFreq solver (optRandomFreq opts) - case optRandomGen opts of - Nothing -> return () - Just gen -> SAT.setRandomGen solver gen - do gen <- SAT.getRandomGen solver - putCommentLine $ "use --random-gen=" ++ show (show gen) ++ " option to reproduce the execution" - SAT.setLearningStrategy solver (optLearningStrategy opts) - SAT.setEnablePhaseSaving solver (optEnablePhaseSaving opts) - SAT.setEnableForwardSubsumptionRemoval solver (optEnableForwardSubsumptionRemoval opts) - SAT.setEnableBackwardSubsumptionRemoval solver (optEnableBackwardSubsumptionRemoval opts) - SAT.setPBHandlerType solver (optPBHandlerType opts) - SAT.setPBSplitClausePart solver (optPBSplitClausePart opts) + solver <- SAT.newSolverWithConfig (optSATConfig opts) SAT.setLogger solver putCommentLine - SAT.setCheckModel solver (optCheckModel opts) + case optRandomSeed opts of + Nothing -> SAT.setRandomGen solver =<< Rand.createSystemRandom + Just s -> SAT.setRandomGen solver =<< Rand.initialize (Rand.fromSeed s) + do gen <- SAT.getRandomGen solver + s <- Rand.save gen + putCommentLine $ "use --random-gen=" ++ show (unwords . map show . V.toList . Rand.fromSeed $ s) ++ " option to reproduce the execution" return solver -- ------------------------------------------------------------------------ @@ -639,8 +593,7 @@ writeSOLFile opt m Nothing nv Just obj' -> do - -- TODO: consider polarity - obj'' <- PBNLC.linearizePBSum enc obj' + obj'' <- PBNLC.linearizePBSumWithPolarity enc Tseitin.polarityNeg obj' nv' <- SAT.getNVars solver defs <- Tseitin.getDefinitions enc @@ -651,7 +604,7 @@ a :: Array SAT.Var Bool a = array (1,nv') $ assocs m ++ [(v, Tseitin.evalFormula a phi) | (v,phi) <- defs] - pbo <- PBO.newOptimizer solver obj'' + pbo <- PBO.newOptimizer2 solver obj'' (\m -> evalPBSum m obj') setupOptimizer pbo opt PBO.setOnUpdateBestSolution pbo $ \_ val -> putOLine (show val) PBO.setOnUpdateLowerBound pbo $ \lb -> do @@ -677,13 +630,16 @@ pbPrintModel stdout m nv writeSOLFile opt m (Just val) nv +evalPBSum :: SAT.IModel m => m -> PBFile.Sum -> Integer +evalPBSum m s = sum [if and [SAT.evalLit m lit | lit <- tm] then c else 0 | (c,tm) <- s] + evalPBConstraint :: SAT.IModel m => m -> PBFile.Constraint -> Bool evalPBConstraint m (lhs,op,rhs) = op' lhs' rhs where op' = case op of PBFile.Ge -> (>=) PBFile.Eq -> (==) - lhs' = sum [if and [SAT.evalLit m lit | lit <- tm] then c else 0 | (c,tm) <- lhs] + lhs' = evalPBSum m lhs setupOptimizer :: PBO.Optimizer -> Options -> IO () setupOptimizer pbo opt = do @@ -730,8 +686,7 @@ PBFile.Ge -> do case lhs of [(1,ls)] | rhs == 1 -> - -- TODO: consider polarity - Tseitin.encodeConj enc ls + Tseitin.encodeConjWithPolarity enc Tseitin.polarityPos ls _ -> do sel <- SAT.newVar solver PBNLC.addPBAtLeastSoft enc sel lhs rhs @@ -763,7 +718,11 @@ [(v, Tseitin.evalFormula a phi) | (v, phi) <- defs1] ++ [(v, evalPBConstraint a constr) | (v, constr) <- defs2] - pbo <- PBO.newOptimizer solver obj + let softConstrs = [(c, constr) | (Just c, constr) <- PBFile.wboConstraints formula] + + pbo <- PBO.newOptimizer2 solver obj $ \m -> + sum [if evalPBConstraint m constr then 0 else w | (w,constr) <- softConstrs] + setupOptimizer pbo opt PBO.setOnUpdateBestSolution pbo $ \_ val -> putOLine (show val) PBO.setOnUpdateLowerBound pbo $ \lb -> do @@ -785,7 +744,10 @@ b <- PBO.isOptimum pbo if b then do putSLine "OPTIMUM FOUND" - pbPrintModel stdout m nv + if isMaxSat then + satPrintModel stdout m nv + else + pbPrintModel stdout m nv writeSOLFile opt m (Just val) nv else if not isMaxSat then do putSLine "SATISFIABLE" @@ -864,28 +826,34 @@ putCommentLine "Loading constraints" forM_ (MIP.constraints mip) $ \c -> do - let indicator = MIP.constrIndicator c - (lhs, op, rhs) = MIP.constrBody c - let d = foldl' lcm 1 (map denominator (rhs:[r | MIP.Term r _ <- lhs])) - lhs' = sumV [asInteger (r * fromIntegral d) *^ product [vmap Map.! v | v <- vs] | MIP.Term r vs <- lhs] - rhs' = asInteger (rhs * fromIntegral d) - case indicator of - Nothing -> - case op of - MIP.Le -> Integer.addConstraint enc $ lhs' .<=. fromInteger rhs' - MIP.Ge -> Integer.addConstraint enc $ lhs' .>=. fromInteger rhs' - MIP.Eql -> Integer.addConstraint enc $ lhs' .==. fromInteger rhs' - Just (var, val) -> do - let var' = asBin (vmap Map.! var) - f sel = do - case op of - MIP.Le -> Integer.addConstraintSoft enc sel $ lhs' .<=. fromInteger rhs' - MIP.Ge -> Integer.addConstraintSoft enc sel $ lhs' .>=. fromInteger rhs' - MIP.Eql -> Integer.addConstraintSoft enc sel $ lhs' .==. fromInteger rhs' - case val of - 1 -> f var' - 0 -> f (SAT.litNot var') - _ -> return () + let lhs = MIP.constrExpr c + let f op rhs = do + let d = foldl' lcm 1 (map denominator (rhs:[r | MIP.Term r _ <- MIP.terms lhs])) + lhs' = sumV [asInteger (r * fromIntegral d) *^ product [vmap Map.! v | v <- vs] | MIP.Term r vs <- MIP.terms lhs] + rhs' = asInteger (rhs * fromIntegral d) + c2 = case op of + MIP.Le -> lhs' .<=. fromInteger rhs' + MIP.Ge -> lhs' .>=. fromInteger rhs' + MIP.Eql -> lhs' .==. fromInteger rhs' + case MIP.constrIndicator c of + Nothing -> Integer.addConstraint enc c2 + Just (var, val) -> do + let var' = asBin (vmap Map.! var) + case val of + 1 -> Integer.addConstraintSoft enc var' c2 + 0 -> Integer.addConstraintSoft enc (SAT.litNot var') c2 + _ -> return () + case (MIP.constrLB c, MIP.constrUB c) of + (MIP.Finite x1, MIP.Finite x2) | x1==x2 -> f MIP.Eql x2 + (lb, ub) -> do + case lb of + MIP.NegInf -> return () + MIP.Finite x -> f MIP.Ge x + MIP.PosInf -> SAT.addClause solver [] + case ub of + MIP.NegInf -> SAT.addClause solver [] + MIP.Finite x -> f MIP.Le x + MIP.PosInf -> return () putCommentLine "Loading SOS constraints" forM_ (MIP.sosConstraints mip) $ \MIP.SOSConstraint{ MIP.sosType = typ, MIP.sosBody = xs } -> do @@ -896,10 +864,10 @@ forM_ ps $ \(x1,x2) -> do SAT.addClause solver [SAT.litNot $ asBin $ vmap Map.! v | v <- [x1,x2]] - let (_label,obj) = MIP.objectiveFunction mip - d = foldl' lcm 1 [denominator r | MIP.Term r _ <- obj] * - (if MIP.dir mip == MIP.OptMin then 1 else -1) - obj2 = sumV [asInteger (r * fromIntegral d) *^ product [vmap Map.! v | v <- vs] | MIP.Term r vs <- obj] + let obj = MIP.objectiveFunction mip + d = foldl' lcm 1 [denominator r | MIP.Term r _ <- MIP.terms (MIP.objExpr obj)] * + (if MIP.objDir obj == MIP.OptMin then 1 else -1) + obj2 = sumV [asInteger (r * fromIntegral d) *^ product [vmap Map.! v | v <- vs] | MIP.Term r vs <- MIP.terms (MIP.objExpr obj)] (obj3,obj3_c) <- Integer.linearize enc obj2 let transformObjVal :: Integer -> Rational @@ -971,13 +939,3 @@ Just fname -> do let m2 = Map.fromList [("x" ++ show x, if b then 1 else 0) | (x,b) <- assocs m, x <= nbvar] writeFile fname (GurobiSol.render (Map.map fromInteger m2) (fmap fromInteger obj)) - - -#if !MIN_VERSION_base(4,6,0) - -modifyIORef' :: IORef a -> (a -> a) -> IO () -modifyIORef' ref f = do - x <- readIORef ref - writeIORef ref $! f x - -#endif diff --git a/toysmt/ToySolver/SMT/SMTLIB2Solver.hs b/toysmt/ToySolver/SMT/SMTLIB2Solver.hs new file mode 100644 --- /dev/null +++ b/toysmt/ToySolver/SMT/SMTLIB2Solver.hs @@ -0,0 +1,829 @@ +{-# OPTIONS_GHC -Wall #-} +----------------------------------------------------------------------------- +-- | +-- Module : ToySolver.SMT.SMTLIB2Solver +-- Copyright : (c) Masahiro Sakai 2015 +-- License : BSD-style +-- +-- Maintainer : masahiro.sakai@gmail.com +-- Stability : experimental +-- Portability : portable +-- +----------------------------------------------------------------------------- +module ToySolver.SMT.SMTLIB2Solver + ( module Smtlib.Syntax.Syntax + , ShowSL (..) + + -- * The solver type + , Solver + , newSolver + + -- * High-level API + , execCommand + , execCommandString + , runCommand + , runCommandString + , printResponse + + -- * Individual commands + + -- ** (Re)starting and terminating + , reset + , setLogic + , setOption + , exit + + -- ** Modifying the assertion stack + , push + , pop + , resetAssertions + + -- ** Introducing new symbols + , declareSort + , defineSort + , declareConst + , declareFun + , defineFun + , defineFunRec + , defineFunsRec + + -- ** Asserting and inspecting formulas + , assert + , getAssertions + + -- ** Checking for satisfiability + , checkSat + , checkSatAssuming + + -- ** Inspecting models + , getValue + , getAssignment + , getModel + + -- ** Inspecting proofs + , getProof + , getUnsatCore + , getUnsatAssumptions + + -- ** Inspecting settings + , getInfo + , getOption + + -- ** Script information + , setInfo + , echo + ) where + +import Control.Applicative +import qualified Control.Exception as E +import Control.Monad +import Data.IORef +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Maybe (catMaybes) +import Data.Ratio +import qualified Data.Version as V +import Numeric (readFloat, readHex) +import System.Exit +import System.IO +import qualified Text.Parsec as Parsec + +import qualified ToySolver.SMT as SMT +import ToySolver.Version +import Smtlib.Syntax.Syntax +import Smtlib.Syntax.ShowSL +import qualified Smtlib.Parsers.CommandsParsers as CommandsParsers +import qualified Smtlib.Parsers.CommonParsers as CommonParsers + +-- ---------------------------------------------------------------------- + +data Mode + = ModeStart + | ModeAssert + | ModeSat + | ModeUnsat + deriving (Eq, Ord, Show) + +type EEnv = Map String EEntry +type SortEnv = Map String SortEntry +type Env = (EEnv, SortEnv) + +data EEntry + = EFSymBuiltin SMT.FSym + | EFSymDeclared SMT.FSym [SMT.Sort] SMT.Sort + | EExpr SMT.Expr Bool + | EFunDef EEnv [(String, SMT.Sort)] SMT.Sort Term + +data SortEntry + = SortSym SMT.SSym + | SortExpr SMT.Sort + | SortDef SortEnv [String] Sort + +interpretSort :: SortEnv -> Sort -> SMT.Sort +interpretSort env s = + case s of + SortId ident -> f (idToName ident) [] + SortIdentifiers ident args -> f (idToName ident) args + where + f name args = + case Map.lookup name env of + Nothing -> error ("unknown sort: " ++ name) + Just (SortSym ssym) -> SMT.Sort ssym [] + Just (SortExpr s') -> s' + Just (SortDef env' params body) -> + interpretSort (Map.fromList (zip params (map (SortExpr . interpretSort env) args)) `Map.union` env') body + +interpretFun :: EEnv -> Term -> SMT.Expr +interpretFun env t = + case t of + TermSpecConstant (SpecConstantNumeral n) -> SMT.EFrac (fromInteger n) + TermSpecConstant (SpecConstantDecimal s) -> SMT.EFrac $ fst $ head $ readFloat s + TermSpecConstant (SpecConstantHexadecimal s) -> SMT.EFrac $ fst $ head $ readHex s + TermSpecConstant c@(SpecConstantBinary _s) -> error (show c) + TermSpecConstant c@(SpecConstantString _s) -> error (show c) + TermQualIdentifier qid -> f qid [] + TermQualIdentifierT qid args -> f qid args + TermLet bindings body -> + interpretFun (Map.fromList [(v, EExpr (interpretFun env t2) False) | VB v t2 <- bindings] `Map.union` env) body + TermForall _bindings _body -> error "universal quantifiers are not supported yet" + TermExists _bindings _body -> error "existential quantifiers are not supported yet" + TermAnnot t2 _ -> interpretFun env t2 -- annotations are not supported yet + where + getName :: QualIdentifier -> String + getName (QIdentifier ident) = idToName ident + getName (QIdentifierAs ident _sort) = idToName ident + + f qid args = + case Map.lookup (getName qid) env of + Nothing -> error ("unknown function symbol: " ++ getName qid) + Just (EExpr e _) -> e + Just (EFSymBuiltin fsym) -> SMT.EAp fsym (map (interpretFun env) args) + Just (EFSymDeclared fsym _ _) -> SMT.EAp fsym (map (interpretFun env) args) + Just (EFunDef env' params _y body) -> + interpretFun (Map.fromList [(p,a) | ((p,_s),a) <- zip params (map (\t -> EExpr (interpretFun env t) False) args) ] `Map.union` env') body + +valueToTerm :: SMT.Value -> Term +valueToTerm (SMT.ValRational v) = + case v `compare` 0 of + GT -> f v + EQ -> TermSpecConstant (SpecConstantNumeral 0) + LT -> TermQualIdentifierT (QIdentifier $ ISymbol "-") [ f (negate v) ] + where + f v = TermQualIdentifierT (QIdentifier $ ISymbol "/") + [ TermSpecConstant (SpecConstantNumeral (numerator v)) + , TermSpecConstant (SpecConstantNumeral (denominator v)) + ] +valueToTerm (SMT.ValBool b) = + TermQualIdentifier $ QIdentifier $ ISymbol $ if b then "true" else "false" +valueToTerm (SMT.ValUninterpreted n s) = + TermQualIdentifier $ QIdentifierAs (ISymbol $ "@" ++ show n) (sortToSortTerm s) + +sortToSortTerm :: SMT.Sort -> Sort +sortToSortTerm (SMT.Sort SMT.SSymBool []) = SortId (ISymbol "Bool") +sortToSortTerm (SMT.Sort SMT.SSymReal []) = SortId (ISymbol "Real") +sortToSortTerm (SMT.Sort (SMT.SSymUserDeclared name 0) []) = SortId (nameToId name) +sortToSortTerm (SMT.Sort (SMT.SSymUserDeclared name _arity) xs) = SortIdentifiers (nameToId name) (map sortToSortTerm xs) +sortToSortTerm s = error ("unknown sort: " ++ show s) + +idToName :: Identifier -> String +idToName = showSL + +nameToId :: String -> Identifier +nameToId s = + case Parsec.parse CommonParsers.parseIdentifier "" s of + Left e -> error (show e) + Right x -> x + +-- ---------------------------------------------------------------------- + +data Solver + = Solver + { svSMTSolverRef :: !(IORef SMT.Solver) + , svEnvRef :: !(IORef Env) + , svModeRef :: !(IORef Mode) + , svSavedContextsRef :: !(IORef [(Maybe (EEnv, SortEnv), [Term])]) + , svStatusRef :: IORef (Maybe Bool) + , svAssertionsRef :: IORef [Term] + , svRegularOutputChannelRef :: !(IORef (String, Handle)) + , svDiagnosticOutputChannelRef :: !(IORef (String, Handle)) + , svPrintSuccessRef :: !(IORef Bool) + , svProduceAssertionsRef :: !(IORef Bool) + , svProduceAssignmentRef :: !(IORef Bool) + , svProduceModelsRef :: !(IORef Bool) + , svProduceUnsatAssumptionsRef :: !(IORef Bool) + , svProduceUnsatCoresRef :: !(IORef Bool) + , svGlobalDeclarationsRef :: !(IORef Bool) + , svUnsatAssumptionsRef :: !(IORef [Term]) + } + +newSolver :: IO Solver +newSolver = do + solverRef <- newIORef =<< SMT.newSolver + envRef <- newIORef initialEnv + modeRef <- newIORef ModeStart + savedContextsRef <- newIORef [] + statusRef <- newIORef Nothing + assertionsRef <- newIORef ([] :: [Term]) + regOutputRef <- newIORef ("stdout", stdout) + diagOutputRef <- newIORef ("stderr", stderr) + printSuccessRef <- newIORef True + produceAssertionsRef <- newIORef False + produceAssignmentRef <- newIORef False + produceModelsRef <- newIORef False + produceUnsatAssumptionsRef <- newIORef False + produceUnsatCoresRef <- newIORef False + globalDeclarationsRef <- newIORef False + unsatAssumptionsRef <- newIORef undefined + return $ + Solver + { svSMTSolverRef = solverRef + , svEnvRef = envRef + , svModeRef = modeRef + , svUnsatAssumptionsRef = unsatAssumptionsRef + , svSavedContextsRef = savedContextsRef + , svStatusRef = statusRef + , svAssertionsRef = assertionsRef + , svRegularOutputChannelRef = regOutputRef + , svDiagnosticOutputChannelRef = diagOutputRef + , svPrintSuccessRef = printSuccessRef + , svProduceAssertionsRef = produceAssertionsRef + , svProduceAssignmentRef = produceAssignmentRef + , svProduceModelsRef = produceModelsRef + , svProduceUnsatCoresRef = produceUnsatCoresRef + , svProduceUnsatAssumptionsRef = produceUnsatAssumptionsRef + , svGlobalDeclarationsRef = globalDeclarationsRef + } + +initialEnv :: Env +initialEnv = (fenv, senv) + where + fenv = Map.fromList + [ (name, EFSymBuiltin name) + | name <- ["=", "true", "false", "not", "and", "or", "ite", "=>", "distinct", "+", "-", "*", "/", ">=", "<=", ">", "<"] + ] + senv = Map.fromList + [ ("Real", SortExpr SMT.sReal) + , ("Bool", SortExpr SMT.sBool) + ] + +execCommand :: Solver -> Command -> IO () +execCommand solver cmd = do + -- putStrLn $ showSL cmd + printResponse solver =<< runCommand solver cmd + +printResponse :: Solver -> CmdResponse -> IO () +printResponse solver rsp = do + b <- readIORef (svPrintSuccessRef solver) + unless (rsp == CmdGenResponse Success && not b) $ do + (_,h) <- readIORef (svRegularOutputChannelRef solver) + hPutStrLn h (showSL rsp) + +runCommand :: Solver -> Command -> IO CmdResponse +runCommand solver cmd = E.handle h $ do + case cmd of + SetLogic logic -> const (CmdGenResponse Success) <$> setLogic solver logic + SetOption opt -> const (CmdGenResponse Success) <$> setOption solver opt + GetOption s -> CmdGetOptionResponse <$> getOption solver s + SetInfo attr -> const (CmdGenResponse Success) <$> setInfo solver attr + GetInfo flags -> CmdGetInfoResponse <$> getInfo solver flags + Push n -> const (CmdGenResponse Success) <$> push solver n + Pop n -> const (CmdGenResponse Success) <$> pop solver n + DeclareSort name arity -> const (CmdGenResponse Success) <$> declareSort solver name arity + DefineSort name xs body -> const (CmdGenResponse Success) <$> defineSort solver name xs body + DeclareConst name y -> const (CmdGenResponse Success) <$> declareConst solver name y + DeclareFun name xs y -> const (CmdGenResponse Success) <$> declareFun solver name xs y + DefineFun name xs y body -> const (CmdGenResponse Success) <$> defineFun solver name xs y body + DefineFunRec name xs y body -> const (CmdGenResponse Success) <$> defineFunRec solver name xs y body + DefineFunsRec fundecs terms -> const (CmdGenResponse Success) <$> defineFunsRec solver fundecs terms + Assert tm -> const (CmdGenResponse Success) <$> assert solver tm + GetAssertions -> CmdGetAssertionsResponse <$> getAssertions solver + CheckSat -> CmdCheckSatResponse <$> checkSat solver + CheckSatAssuming ts -> CmdCheckSatResponse <$> checkSatAssuming solver ts + GetValue ts -> CmdGetValueResponse <$> getValue solver ts + GetAssignment -> CmdGetAssignmentResponse <$> getAssignment solver + GetModel -> CmdGetModelResponse <$> getModel solver + GetProof -> CmdGetProofResponse <$> getProof solver + GetUnsatCore -> CmdGetUnsatCoreResponse <$> getUnsatCore solver + GetUnsatAssumptions -> CmdGetUnsatAssumptionsResponse <$> getUnsatAssumptions solver + Reset -> const (CmdGenResponse Success) <$> reset solver + ResetAssertions -> const (CmdGenResponse Success) <$> resetAssertions solver + Echo s -> CmdEchoResponse <$> echo solver s + Exit -> const (CmdGenResponse Success) <$> exit solver + where + h SMT.Unsupported = return (CmdGenResponse Unsupported) + h (SMT.Error s) = return $ CmdGenResponse $ + -- GenResponse type uses strings in printed form. + Error $ "\"" ++ concat [if c == '"' then "\"\"" else [c] | c <- s] ++ "\"" + +execCommandString :: Solver -> String -> IO () +execCommandString solver cmd = do + printResponse solver =<< runCommandString solver cmd + +runCommandString :: Solver -> String -> IO CmdResponse +runCommandString solver cmd = + case Parsec.parse (Parsec.spaces >> CommandsParsers.parseCommand <* Parsec.eof) "" cmd of + Left err -> + -- GenResponse type uses strings in printed form. + return $ CmdGenResponse $ Error $ "\"" ++ concat [if c == '"' then "\"\"" else [c] | c <- show err] ++ "\"" + Right cmd -> + runCommand solver cmd + +-- ---------------------------------------------------------------------- + +reset :: Solver -> IO GenResponse +reset solver = do + writeIORef (svSMTSolverRef solver) =<< SMT.newSolver + writeIORef (svEnvRef solver) initialEnv + writeIORef (svModeRef solver) ModeStart + writeIORef (svSavedContextsRef solver) [] + writeIORef (svStatusRef solver) Nothing + writeIORef (svRegularOutputChannelRef solver) ("stdout",stdout) + writeIORef (svDiagnosticOutputChannelRef solver) ("stderr",stderr) + writeIORef (svPrintSuccessRef solver) True + writeIORef (svProduceAssertionsRef solver) False + writeIORef (svProduceAssignmentRef solver) False + writeIORef (svProduceModelsRef solver) False + writeIORef (svProduceUnsatAssumptionsRef solver) False + writeIORef (svProduceUnsatCoresRef solver) False + writeIORef (svUnsatAssumptionsRef solver) undefined + return Success + +setLogic :: Solver -> String -> IO () +setLogic solver logic = do + mode <- readIORef (svModeRef solver) + if mode /= ModeStart then do + E.throwIO $ SMT.Error "set-logic can only be used in start mode" + else do + writeIORef (svModeRef solver) ModeAssert + case logic of + "QF_UFLRA" -> return () + "QF_UFRDL" -> return () + "QF_UF" -> return () + "QF_RDL" -> return () + "QF_LRA" -> return () + "ALL" -> return () + _ -> E.throwIO SMT.Unsupported + +setOption :: Solver -> Option -> IO () +setOption solver opt = do + mode <- readIORef (svModeRef solver) + case opt of + PrintSuccess b -> do + writeIORef (svPrintSuccessRef solver) b + ExpandDefinitions _b -> do + -- expand-definitions has been removed in SMT-LIB 2.5. + E.throwIO SMT.Unsupported + InteractiveMode b -> do + -- interactive-mode is the old name for produce-assertions. Deprecated. + unless (mode == ModeStart) $ do + E.throwIO $ SMT.Error "interactive-mode option can be set only in start mode" + writeIORef (svProduceAssertionsRef solver) b + return () + ProduceProofs b -> do + if mode /= ModeStart then + E.throwIO $ SMT.Error "produce-proofs option can be set only in start mode" + else if b then + E.throwIO SMT.Unsupported + else + return () + ProduceUnsatCores b -> do + unless (mode == ModeStart) $ do + E.throwIO $ SMT.Error "produce-unsat-cores option can be set only in start mode" + writeIORef (svProduceUnsatCoresRef solver) b + return () + ProduceUnsatAssumptions b -> do + unless (mode == ModeStart) $ do + E.throwIO $ SMT.Error "produce-unsat-assumptions option can be set only in start mode" + writeIORef (svProduceUnsatAssumptionsRef solver) b + return () + ProduceModels b -> do + unless (mode == ModeStart) $ do + E.throwIO $ SMT.Error "produce-models option can be set only in start mode" + writeIORef (svProduceModelsRef solver) b + return () + ProduceAssignments b -> do + unless (mode == ModeStart) $ do + E.throwIO $ SMT.Error "produce-assignments option can be set only in start mode" + writeIORef (svProduceAssignmentRef solver) b + return () + ProduceAssertions b -> do + unless (mode == ModeStart) $ do + E.throwIO $ SMT.Error "produce-assertions option can be set only in start mode" + writeIORef (svProduceAssertionsRef solver) b + return () + GlobalDeclarations b -> do + unless (mode == ModeStart) $ do + E.throwIO $ SMT.Error "global-declarations option can be set only in start mode" + writeIORef (svGlobalDeclarationsRef solver) b + smt <- readIORef (svSMTSolverRef solver) + SMT.setGlobalDeclarations smt b + RegularOutputChannel fname -> do + h <- if fname == "stdout" then + return stdout + else + openFile fname AppendMode + writeIORef (svRegularOutputChannelRef solver) (fname, h) + return () + DiagnosticOutputChannel fname -> do + h <- if fname == "stderr" then + return stderr + else + openFile fname AppendMode + writeIORef (svDiagnosticOutputChannelRef solver) (fname, h) + return () + RandomSeed _i -> + if mode /= ModeStart then + E.throwIO $ SMT.Error "random-seed option can be set only in start mode" + else + E.throwIO SMT.Unsupported + Verbosity _lv -> E.throwIO SMT.Unsupported + ReproducibleResourceLimit _val -> do + if mode /= ModeStart then + E.throwIO $ SMT.Error "reproducible-resource-limit option can be set only in start mode" + else + E.throwIO SMT.Unsupported + OptionAttr _attr -> E.throwIO SMT.Unsupported + +getOption :: Solver -> String -> IO GetOptionResponse +getOption solver opt = + case opt of + ":expand-definitions" -> do + -- expand-definitions has been removed in SMT-LIB 2.5. + let b = False + return $ AttrValueSymbol (showSL b) + ":global-declarations" -> do + b <- readIORef (svGlobalDeclarationsRef solver) + return $ AttrValueSymbol (showSL b) + ":interactive-mode" -> do + -- interactive-mode is the old name for produce-assertions. Deprecated. + b <- readIORef (svProduceAssertionsRef solver) + return $ AttrValueSymbol (showSL b) + ":print-success" -> do + b <- readIORef (svPrintSuccessRef solver) + return $ AttrValueSymbol (showSL b) + ":produce-assertions" -> do + b <- readIORef (svProduceAssertionsRef solver) + return $ AttrValueSymbol (showSL b) + ":produce-assignments" -> do + b <- readIORef (svProduceAssignmentRef solver) + return $ AttrValueSymbol (showSL b) + ":produce-models" -> do + b <- readIORef (svProduceModelsRef solver) + return $ AttrValueSymbol (showSL b) + ":produce-proofs" -> do + let b = False -- default value + return $ AttrValueSymbol (showSL b) + ":produce-unsat-cores" -> do + b <- readIORef (svProduceUnsatCoresRef solver) + return $ AttrValueSymbol (showSL b) + ":produce-unsat-assumptions" -> do + b <- readIORef (svProduceUnsatAssumptionsRef solver) + return $ AttrValueSymbol (showSL b) + ":regular-output-channel" -> do + (fname,_) <- readIORef (svRegularOutputChannelRef solver) + return $ AttrValueConstant (SpecConstantString fname) + ":diagnostic-output-channel" -> do + (fname,_) <- readIORef (svDiagnosticOutputChannelRef solver) + return $ AttrValueConstant (SpecConstantString fname) + ":random-seed" -> do + return $ AttrValueConstant (SpecConstantNumeral 0) -- default value + ":reproducible-resource-limit" -> do + return $ AttrValueConstant (SpecConstantNumeral 0) -- default value + ":verbosity" -> do + return $ AttrValueConstant (SpecConstantNumeral 0) -- default value + _ -> do + E.throwIO SMT.Unsupported + +setInfo :: Solver -> Attribute -> IO () +setInfo solver (AttributeVal ":status" (AttrValueSymbol s)) = do + v <- case s of + "sat" -> return $ Just True + "unsat" -> return $ Just False + "unknown" -> return $ Nothing + _ -> E.throwIO $ SMT.Error $ "invalid status value: " ++ s + writeIORef (svStatusRef solver) v +setInfo _solver _ = return () + +getInfo :: Solver -> InfoFlags -> IO GetInfoResponse +getInfo solver flags = do + mode <- readIORef (svModeRef solver) + case flags of + ErrorBehavior -> return [ResponseErrorBehavior ContinuedExecution] + Name -> return [ResponseName "toysmt"] + Authors -> return [ResponseName "Masahiro Sakai"] + Version -> return [ResponseVersion (V.showVersion version)] + Status -> E.throwIO SMT.Unsupported + ReasonUnknown -> do + if mode /= ModeSat then + E.throwIO $ SMT.Error "Executions of get-info with :reason-unknown are allowed only when the solver is in sat mode following a check command whose response was unknown." + else + return [ResponseReasonUnknown Incomplete] + AllStatistics -> do + if not (mode == ModeSat || mode == ModeUnsat) then + E.throwIO $ SMT.Error "Executions of get-info with :all-statistics are allowed only when the solver is in sat or unsat mode." + else + E.throwIO SMT.Unsupported + AssertionStackLevels -> do + saved <- readIORef (svSavedContextsRef solver) + let n = length saved + n `seq` return [ResponseAssertionStackLevels n] + InfoFlags _s -> do + E.throwIO SMT.Unsupported + +push :: Solver -> Int -> IO () +push solver n = do + replicateM_ n $ do + (env,senv) <- readIORef (svEnvRef solver) + assertions <- readIORef (svAssertionsRef solver) + globalDeclarations <- readIORef (svGlobalDeclarationsRef solver) + if globalDeclarations then + modifyIORef (svSavedContextsRef solver) ((Nothing, assertions) :) + else + modifyIORef (svSavedContextsRef solver) ((Just (env,senv), assertions) :) + SMT.push =<< readIORef (svSMTSolverRef solver) + writeIORef (svModeRef solver) ModeAssert + +pop :: Solver -> Int -> IO () +pop solver n = do + replicateM_ n $ do + cs <- readIORef (svSavedContextsRef solver) + case cs of + [] -> E.throwIO $ SMT.Error "pop from empty context" + ((m,assertions) : cs) -> do + case m of + Just (env,senv) -> writeIORef (svEnvRef solver) (env,senv) + Nothing -> return () + writeIORef (svAssertionsRef solver) assertions + writeIORef (svSavedContextsRef solver) cs + SMT.pop =<< readIORef (svSMTSolverRef solver) + writeIORef (svModeRef solver) ModeAssert + +resetAssertions :: Solver -> IO () +resetAssertions solver = do + cs <- readIORef (svSavedContextsRef solver) + pop solver (length cs) + +echo :: Solver -> String -> IO String +echo _solver s = return s + +declareSort :: Solver -> String -> Int -> IO () +declareSort solver name arity = do + smt <- readIORef (svSMTSolverRef solver) + s <- SMT.declareSSym smt name arity + insertSort solver name (SortSym s) + writeIORef (svModeRef solver) ModeAssert + +defineSort :: Solver -> String -> [String] -> Sort -> IO () +defineSort solver name xs body = do + (_, senv) <- readIORef (svEnvRef solver) + insertSort solver name (SortDef senv xs body) + writeIORef (svModeRef solver) ModeAssert + +declareConst :: Solver -> String -> Sort -> IO () +declareConst solver name y = declareFun solver name [] y + +declareFun :: Solver -> String -> [Sort] -> Sort -> IO () +declareFun solver name xs y = do + smt <- readIORef (svSMTSolverRef solver) + (_, senv) <- readIORef (svEnvRef solver) + let argsSorts = map (interpretSort senv) xs + resultSort = interpretSort senv y + f <- SMT.declareFSym smt name argsSorts resultSort + insertFun solver name (EFSymDeclared f argsSorts resultSort) + writeIORef (svModeRef solver) ModeAssert + +defineFun :: Solver -> String -> [SortedVar] -> Sort -> Term -> IO () +defineFun solver name xs y body = do + writeIORef (svModeRef solver) ModeAssert + (_, senv) <- readIORef (svEnvRef solver) + let xs' = map (\(SV x s) -> (x, interpretSort senv s)) xs + y' = interpretSort senv y + if null xs' then do + body' <- processNamed solver body + (fenv, _) <- readIORef (svEnvRef solver) + -- use EExpr? + insertFun solver name (EFunDef fenv [] y' body') + else do + (fenv, _) <- readIORef (svEnvRef solver) + insertFun solver name (EFunDef fenv xs' y' body) + writeIORef (svModeRef solver) ModeAssert + +defineFunRec :: Solver -> String -> [SortedVar] -> Sort -> Term -> IO () +defineFunRec _solver _name _xs _y _body = do + E.throwIO SMT.Unsupported + +defineFunsRec :: Solver -> [FunDec] -> [Term] -> IO () +defineFunsRec _solver _fundecs _terms = do + E.throwIO SMT.Unsupported + +assert :: Solver -> Term -> IO () +assert solver tm = do + let mname = + case tm of + TermAnnot _body attrs + | name:_ <- [name | AttributeVal ":named" (AttrValueSymbol name) <- attrs] -> + Just name + _ -> Nothing + tm' <- processNamed solver tm + smt <- readIORef (svSMTSolverRef solver) + (env,_) <- readIORef (svEnvRef solver) + case mname of + Nothing -> SMT.assert smt (interpretFun env tm') + Just name -> SMT.assertNamed smt name (interpretFun env tm') + do b <- readIORef (svProduceAssertionsRef solver) + when b $ modifyIORef (svAssertionsRef solver) (tm :) + writeIORef (svModeRef solver) ModeAssert + +getAssertions :: Solver -> IO GetAssertionsResponse +getAssertions solver = do + mode <- readIORef (svModeRef solver) + when (mode == ModeStart) $ do + E.throwIO $ SMT.Error "get-assertions cannot be used in start mode" + b <- readIORef (svProduceAssertionsRef solver) + unless b $ do + E.throwIO $ SMT.Error ":produce-assertions is not enabled" + reverse <$> readIORef (svAssertionsRef solver) + +checkSat :: Solver -> IO CheckSatResponse +checkSat solver = checkSatAssuming solver [] + +checkSatAssuming :: Solver -> [Term] -> IO CheckSatResponse +checkSatAssuming solver xs = do + smt <- readIORef (svSMTSolverRef solver) + + (env,_) <- readIORef (svEnvRef solver) + ref <- newIORef Map.empty + ys <- forM xs $ \x -> do + let y = interpretFun env x + modifyIORef ref (Map.insert y x) + return y + + ret <- SMT.checkSATAssuming smt ys + + do expected <- readIORef (svStatusRef solver) + writeIORef (svStatusRef solver) Nothing -- I'm not sure if we should reset or not. + h <- snd <$> readIORef (svDiagnosticOutputChannelRef solver) + case expected of + Just True | not ret -> hPutStrLn h "WARNING: unexpected unsat; expecting sat" + Just False | ret -> hPutStrLn h "WARNING: unexpected sat; expecting unsat" + _ -> return () + hFlush h + + if ret then do + writeIORef (svModeRef solver) ModeSat + return Sat + else do + writeIORef (svModeRef solver) ModeUnsat + m <- readIORef ref + es <- SMT.getUnsatAssumptions smt + writeIORef (svUnsatAssumptionsRef solver) [m Map.! e | e <- es] + return Unsat + +getValue :: Solver -> [Term] -> IO GetValueResponse +getValue solver ts = do + ts <- mapM (processNamed solver) ts + mode <- readIORef (svModeRef solver) + unless (mode == ModeSat) $ do + E.throwIO $ SMT.Error "get-value can only be used in sat mode" + smt <- readIORef (svSMTSolverRef solver) + m <- SMT.getModel smt + (env,_) <- readIORef (svEnvRef solver) + forM ts $ \t -> do + let e = interpretFun env t + let v = SMT.eval m e + return $ ValuationPair t (valueToTerm v) + +getAssignment :: Solver -> IO GetAssignmentResponse +getAssignment solver = do + mode <- readIORef (svModeRef solver) + unless (mode == ModeSat) $ do + E.throwIO $ SMT.Error "get-assignment can only be used in sat mode" + smt <- readIORef (svSMTSolverRef solver) + m <- SMT.getModel smt + (env, _) <- readIORef (svEnvRef solver) + liftM concat $ forM (Map.toList env) $ \(name, entry) -> do + case entry of + EExpr e True -> do + s <- SMT.exprSort smt e + if s /= SMT.sBool then do + return [] + else do + let v = SMT.eval m e + case v of + (SMT.ValBool b) -> return [TValuationPair name b] + _ -> E.throwIO $ SMT.Error "get-assignment: should not happen" + _ -> return [] + +getModel :: Solver -> IO GetModelResponse +getModel solver = do + mode <- readIORef (svModeRef solver) + unless (mode == ModeSat) $ do + E.throwIO $ SMT.Error "get-model can only be used in sat mode" + smt <- readIORef (svSMTSolverRef solver) + m <- SMT.getModel smt + (env, _) <- readIORef (svEnvRef solver) + liftM catMaybes $ forM (Map.toList env) $ \(name, entry) -> do + case entry of + EFSymDeclared sym argsSorts resultSort -> do + case SMT.evalFSym m sym of + SMT.FunDef [] val -> do -- constant + return $ Just $ DefineFun name [] (sortToSortTerm resultSort) (valueToTerm val) + SMT.FunDef tbl defaultVal -> do -- proper function + let argsSV :: [SortedVar] + argsSV = [SV ("x!" ++ show i) (sortToSortTerm s) | (i,s) <- zip [(1::Int)..] argsSorts] + args :: [Term] + args = [TermQualIdentifier (QIdentifier (ISymbol x)) | SV x _ <- argsSV] + f :: ([SMT.Value], SMT.Value) -> Term -> Term + f (vals,val) tm = + TermQualIdentifierT (QIdentifier (ISymbol "ite")) [cond, valueToTerm val, tm] + where + cond = + case zipWith (\arg val -> TermQualIdentifierT (QIdentifier (ISymbol "=")) [arg, valueToTerm val]) args vals of + [c] -> c + cs -> TermQualIdentifierT (QIdentifier (ISymbol "and")) cs + return $ Just $ DefineFun name argsSV (sortToSortTerm resultSort) $ + foldr f (valueToTerm defaultVal) tbl + _ -> return Nothing + +getProof :: Solver -> IO GetProofResponse +getProof solver = do + mode <- readIORef (svModeRef solver) + if mode /= ModeUnsat then + E.throwIO $ SMT.Error "get-proof can only be used in unsat mode" + else + E.throwIO SMT.Unsupported + +getUnsatCore :: Solver -> IO GetUnsatCoreResponse +getUnsatCore solver = do + smt <- readIORef (svSMTSolverRef solver) + mode <- readIORef (svModeRef solver) + unless (mode == ModeUnsat) $ do + E.throwIO $ SMT.Error "get-unsat-core can only be used in unsat mode" + SMT.getUnsatCore smt + +getUnsatAssumptions :: Solver -> IO [Term] +getUnsatAssumptions solver = do + mode <- readIORef (svModeRef solver) + unless (mode == ModeUnsat) $ do + E.throwIO $ SMT.Error "get-unsat-assumptions can only be used in unsat mode" + readIORef (svUnsatAssumptionsRef solver) + +exit :: Solver -> IO () +exit _solver = exitSuccess + +-- ---------------------------------------------------------------------- + +insertSort :: Solver -> String -> SortEntry -> IO () +insertSort solver name sdef = do + (fenv, senv) <- readIORef (svEnvRef solver) + case Map.lookup name senv of + Nothing -> writeIORef (svEnvRef solver) (fenv, Map.insert name sdef senv) + Just _ -> E.throwIO $ SMT.Error (name ++ " is already used") + +insertFun :: Solver -> String -> EEntry -> IO () +insertFun solver name fdef = do + (fenv, senv) <- readIORef (svEnvRef solver) + case Map.lookup name fenv of + Nothing -> writeIORef (svEnvRef solver) (Map.insert name fdef fenv, senv) + Just _ -> E.throwIO $ SMT.Error (name ++ " is already used") + +-- TODO: check closedness of terms +processNamed :: Solver -> Term -> IO Term +processNamed solver = f + where + f t@(TermSpecConstant _) = return t + f t@(TermQualIdentifier _) = return t + f (TermQualIdentifierT qid args) = do + args' <- mapM f args + return $ TermQualIdentifierT qid args' + f (TermLet bindings body) = do + body' <- f body + return $ TermLet bindings body' + f (TermForall bindings body) = do + body' <- f body + return $ TermForall bindings body' + f (TermExists bindings body) = do + body' <- f body + return $ TermExists bindings body' + f (TermAnnot body attrs) = do + body' <- f body + forM_ attrs $ \attr -> do + case attr of + AttributeVal ":named" val -> + case val of + AttrValueSymbol name -> do + (env,_) <- readIORef (svEnvRef solver) + let e = interpretFun env body' + -- smt <- readIORef (svSMTSolverRef solver) + -- s <- SMT.exprSort smt e + insertFun solver name (EExpr e True) + _ -> E.throwIO $ SMT.Error ":named attribute value should be a symbol" + _ -> return () + let attrs' = [attr | attr <- attrs, attrName attr /= ":named"] + where + attrName (Attribute s) = s + attrName (AttributeVal s _v) = s + if null attrs' then + return body' + else + return $ TermAnnot body' attrs' diff --git a/toysmt/toysmt.hs b/toysmt/toysmt.hs new file mode 100644 --- /dev/null +++ b/toysmt/toysmt.hs @@ -0,0 +1,143 @@ +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE CPP #-} +----------------------------------------------------------------------------- +-- | +-- Module : toysmt +-- Copyright : (c) Masahiro Sakai 2015 +-- License : BSD-style +-- +-- Maintainer : masahiro.sakai@gmail.com +-- Stability : experimental +-- Portability : non-portable (CPP) +-- +----------------------------------------------------------------------------- +module Main where + +import Control.Applicative ((<*)) +import Control.Monad +import Control.Monad.Trans +import Data.Default.Class +import Data.Version +import System.Console.GetOpt +#ifdef USE_HASKELINE_PACKAGE +import qualified System.Console.Haskeline as Haskeline +#endif +import System.Environment +import System.Exit +import System.IO +import Text.Parsec +import Text.Parsec.String + +import Smtlib.Parsers.CommandsParsers + +import ToySolver.Version +import ToySolver.SMT.SMTLIB2Solver + +data Mode + = ModeHelp + | ModeVersion + | ModeInteractive + deriving (Eq, Ord, Bounded, Enum) + +data Options + = Options + { optMode :: Maybe Mode + , optInteractive :: Bool + } + +instance Default Options where + def = + Options + { optMode = Nothing + , optInteractive = False + } + +options :: [OptDescr (Options -> Options)] +options = + [ Option ['h'] ["help"] (NoArg (\opt -> opt{ optMode = Just ModeHelp })) "show help" + , Option [] ["version"] (NoArg (\opt -> opt{ optMode = Just ModeVersion})) "show version" + , Option [] ["interactive"] (NoArg (\opt -> opt{ optMode = Just ModeInteractive })) "force interactive mode" + ] + +main :: IO () +main = do + args <- getArgs + case getOpt Permute options args of + (_,_,errs@(_:_)) -> do + mapM_ putStrLn errs + exitFailure + + (o,args2,[]) -> do + let opt = foldl (flip id) def o + case optMode opt of + Just ModeHelp -> showHelp stdout + Just ModeVersion -> hPutStrLn stdout (showVersion version) + Just ModeInteractive -> do + solver <- newSolver + mapM_ (loadFile solver) args2 + repl solver + Nothing -> do + solver <- newSolver + if null args2 then + repl solver + else + mapM_ (loadFile solver) args2 + +loadFile :: Solver -> FilePath -> IO () +loadFile solver fname = do + ret <- parseFromFile (parseSource <* eof) fname + case ret of + Left err -> do + hPrint stderr err + exitFailure + Right source -> do + forM_ source $ \cmd -> do + execCommand solver cmd + +repl :: Solver -> IO () +repl solver = do +#ifdef USE_HASKELINE_PACKAGE + replHaskeline solver +#else + replSimple solver +#endif + +replSimple :: Solver -> IO () +replSimple solver = do + hSetBuffering stdin LineBuffering + forever $ do + putStr "toysmt> " + hFlush stdout + s <- getLine + case parse (spaces >> parseCommand <* eof) "" s of + Left err -> do + hPrint stderr err + Right cmd -> do + execCommand solver cmd + +#ifdef USE_HASKELINE_PACKAGE + +replHaskeline :: Solver -> IO () +replHaskeline solver = Haskeline.runInputT Haskeline.defaultSettings $ forever $ do + m <- Haskeline.getInputLine "toysmt> " + case m of + Nothing -> return () + Just s -> do + case parse (spaces >> parseCommand) "" s of + Left err -> do + lift $ hPrint stderr err + Right cmd -> do + lift $ execCommand solver cmd + +#endif + +showHelp :: Handle -> IO () +showHelp h = hPutStrLn h (usageInfo header options) + +header :: String +header = unlines + [ "Usage:" + , " toysmt [OPTION]... [file.smt2]" + , "" + , "Options:" + ] diff --git a/toysolver.cabal b/toysolver.cabal --- a/toysolver.cabal +++ b/toysolver.cabal @@ -1,5 +1,5 @@ Name: toysolver -Version: 0.3.0 +Version: 0.4.0 License: BSD3 License-File: COPYING Author: Masahiro Sakai (masahiro.sakai@gmail.com) @@ -12,17 +12,26 @@ Tested-With: GHC ==7.6.3 GHC ==7.8.3 - GHC ==7.10.1 + GHC ==7.10.3 Extra-Source-Files: README.md + CHANGELOG.markdown COPYING + COPYING-GPL .ghci .travis.yml - build_bdist_linux-i386.sh - build_bdist_linux-x86_64.sh + appveyor.yml + build_bdist_linux.sh build_bdist_macos.sh build_bdist_win32.sh build_bdist_win64.sh + build_bdist_maxsat_evaluation.sh + build_bdist_pb_evaluation.sh + misc/maxsat/toysat/README.md + misc/maxsat/toysat/toysat + misc/maxsat/toysat_ls/README.md + misc/maxsat/toysat_ls/toysat_ls + misc/pb/README.md src/TseitinEncode.hs src/ToySolver/Data/Polyhedron.hs samples/gcnf/*.cnf @@ -50,7 +59,9 @@ samples/programs/knapsack/*.txt samples/programs/htc/test1.dat samples/programs/htc/test2.dat - test/TestAReal2.hs + samples/programs/svm2lp/a1a + samples/programs/nonogram/*.cwd + samples/programs/nonogram/README.md benchmarks/UF250.1065.100/*.cnf benchmarks/UUF250.1065.100/*.cnf Build-Type: Simple @@ -60,6 +71,11 @@ Default: False Manual: True +Flag LinuxStatic + Description: build statically linked binaries + Default: False + Manual: True + Flag BuildToyFMF Description: build toyfmf command Default: False @@ -79,14 +95,19 @@ Description: use exceptions >=0.6 Manual: False -Flag Random1013 - Description: use random >=1.0.1.3 - Manual: False - Flag Time15 Description: use time >=1.5.0 Manual: False +Flag Transformers051 + Description: use transformers >=0.5.1 + Manual: False + +Flag UseHaskeline + Description: use haskeline package + Manual: True + Default: True + source-repository head type: git location: git://github.com/msakai/toysolver.git @@ -95,10 +116,13 @@ Exposed: True Hs-source-dirs: src Build-Depends: - base >=4 && <5, - -- mergeWithKey requires containers >=0.5.0 + base >=4.6 && <5, + template-haskell, + -- IntMap.mergeWithKey and IntMap.toDescList require containers >=0.5.0 containers >=0.5.0, unordered-containers >=0.2.3 && <0.3.0, + transformers >=0.2, + transformers-compat >=0.3, mtl >=2.1.2, array >=0.4.0.0, stm >=2.3, @@ -113,7 +137,7 @@ parse-dimacs, queue, heaps, - unbounded-delays, + vector, vector-space >=0.8.6, multiset, prettyclass >=1.0.0, @@ -122,22 +146,28 @@ intern >=0.9.1.2 && <1.0.0.0, loop >=0.2.0 && < 1.0.0, data-default-class, + -- createSystemRandom requires mwc-random >=0.13.1.0 + mwc-random >=0.13.1 && <0.14, + semigroups >=0.17, OptDir, extended-reals >=0.1 && <1.0, data-interval >=1.0.1 && <1.3.0, finite-field >=0.7.0 && <1.0.0, sign >=0.2.0 && <1.0.0, - pseudo-boolean >=0.1.0.0 && <0.1.1.0 + pseudo-boolean >=0.1.3.0 && <0.2.0.0 -- NOTE: temporary-1.2.0.2 does not work with exceptions-0.6 if flag(Exceptions06) Build-Depends: temporary >1.2.0.2, exceptions >=0.6 else Build-Depends: temporary >=1.2, exceptions ==0.5 - -- NOTE: random-1.0.1.3 uses atomicModifyIORef' which is provided by base >=4.6.0.0. - if flag(Random1013) - Build-Depends: base >=4.6.0.0, random >=1.0.1.3 + if impl(ghc <7.7) + Build-Depends: + -- vector-space depends on MemoTrie, but MemoTrie >=0.6.3 uses extensions that are not available on GHC 7.6. + MemoTrie <=0.6.2 + if flag(Transformers051) + Build-Depends: transformers >=0.5.1.0 else - Build-Depends: random <1.0.1.3 + Build-Depends: transformers <0.5.1.0 if impl(ghc) Build-Depends: ghc-prim Default-Language: Haskell2010 @@ -145,18 +175,22 @@ BangPatterns CPP DeriveDataTypeable - DeriveGeneric - DoRec FlexibleContexts FlexibleInstances FunctionalDependencies GeneralizedNewtypeDeriving MultiParamTypeClasses + OverloadedStrings + RecursiveDo Rank2Types ScopedTypeVariables + TemplateHaskell TypeFamilies TypeSynonymInstances - OverloadedStrings + if impl(ghc) + Other-Extensions: + MagicHash + UnboxedTuples Exposed-Modules: ToySolver.Arith.BoundsInference ToySolver.Arith.CAD @@ -178,15 +212,18 @@ ToySolver.Arith.Simplex ToySolver.Arith.Simplex2 ToySolver.Arith.VirtualSubstitution - ToySolver.CongruenceClosure - ToySolver.FOLModelFinder + ToySolver.EUF.CongruenceClosure + ToySolver.EUF.EUFSolver + ToySolver.EUF.FiniteModelFinder ToySolver.Combinatorial.HittingSet.Simple ToySolver.Combinatorial.HittingSet.HTCBDD ToySolver.Combinatorial.HittingSet.SHD ToySolver.Combinatorial.HittingSet.FredmanKhachiyan1996 ToySolver.Combinatorial.HittingSet.GurvichKhachiyan1999 ToySolver.Combinatorial.Knapsack.BB - ToySolver.Combinatorial.Knapsack.DP + ToySolver.Combinatorial.Knapsack.DPDense + ToySolver.Combinatorial.Knapsack.DPSparse + ToySolver.Combinatorial.SubsetSum ToySolver.Converter.ObjType ToySolver.Converter.MIP2SMT ToySolver.Converter.MaxSAT2IP @@ -204,7 +241,6 @@ ToySolver.Data.AlgebraicNumber.Real ToySolver.Data.AlgebraicNumber.Root ToySolver.Data.AlgebraicNumber.Sturm - ToySolver.Data.ArithRel ToySolver.Data.Boolean ToySolver.Data.BoolExpr ToySolver.Data.Delta @@ -218,6 +254,7 @@ ToySolver.Data.MIP.Base ToySolver.Data.MIP.LPFile ToySolver.Data.MIP.MPSFile + ToySolver.Data.OrdRel ToySolver.Data.Polynomial ToySolver.Data.Polynomial.Factorization.FiniteField ToySolver.Data.Polynomial.Factorization.Hensel @@ -249,6 +286,7 @@ ToySolver.SAT.TseitinEncoder ToySolver.SAT.Types ToySolver.SAT.Printer + ToySolver.SMT ToySolver.Text.GCNF ToySolver.Text.GurobiSol ToySolver.Text.MaxSAT @@ -266,6 +304,7 @@ Other-Modules: ToySolver.Data.AlgebraicNumber.Graeffe ToySolver.Data.Polynomial.Base + ToySolver.Version.TH Paths_toysolver -- GHC-Prof-Options: -auto-all @@ -273,21 +312,20 @@ Main-is: toysolver.hs HS-Source-Dirs: toysolver Build-Depends: - base >=4.4 && <5, + base, containers, array, data-default-class, filepath, - parsec, OptDir, parse-dimacs, pseudo-boolean, toysolver Default-Language: Haskell2010 if impl(ghc) - GHC-Options: -threaded - if impl(ghc >= 7) - GHC-Options: -rtsopts + GHC-Options: -rtsopts -threaded + if flag(LinuxStatic) + GHC-Options: -static -optl-static -optl-pthread -- GHC-Prof-Options: -auto-all Executable toysat @@ -295,10 +333,10 @@ Other-Modules: UBCSAT HS-Source-Dirs: toysat Build-Depends: - base >=4 && <5, + base, data-default-class, - random, - containers >= 0.4.2, + mwc-random, + containers, array, process >=1.1.0.2, parsec, @@ -306,7 +344,8 @@ filepath, parse-dimacs, unbounded-delays, - vector-space >=0.8.6, + vector, + vector-space, pseudo-boolean, toysolver if flag(Time15) @@ -315,12 +354,50 @@ Build-Depends: time <1.5.0, old-locale Default-Language: Haskell2010 Other-Extensions: ScopedTypeVariables, CPP + if impl(ghc) + GHC-Options: -rtsopts + -- GHC-Prof-Options: -auto-all + if flag(ForceChar8) && impl(ghc) + Build-Depends: base >=4.5 + CPP-OPtions: "-DFORCE_CHAR8" + if flag(LinuxStatic) + GHC-Options: -static -optl-static -optl-pthread + +Executable toysmt + HS-Source-Dirs: toysmt, Smtlib + Main-is: toysmt.hs + Other-Modules: + ToySolver.SMT.SMTLIB2Solver, + -- Following modules are copied from SmtLib package. + -- http://hackage.haskell.org/package/SmtLib + -- https://github.com/MfesGA/Smtlib + Smtlib.Parsers.CommonParsers, + Smtlib.Parsers.ResponseParsers, + Smtlib.Parsers.CommandsParsers, + Smtlib.Syntax.Syntax, + Smtlib.Syntax.ShowSL + Build-Depends: + base, + containers, + data-default-class, + mtl, + parsec, + transformers, + transformers-compat, + toysolver + if flag(UseHaskeline) + Build-Depends: haskeline >=0.7 && <0.8 + CPP-Options: "-DUSE_HASKELINE_PACKAGE" + Default-Language: Haskell2010 + Other-Extensions: ScopedTypeVariables, CPP if impl(ghc >= 7) GHC-Options: -rtsopts -- GHC-Prof-Options: -auto-all if flag(ForceChar8) && impl(ghc) Build-Depends: base >=4.5 CPP-OPtions: "-DFORCE_CHAR8" + if flag(LinuxStatic) + GHC-Options: -static -optl-static -optl-pthread Executable toyfmf If !flag(BuildToyFMF) @@ -329,13 +406,18 @@ HS-Source-Dirs: toyfmf If flag(BuildToyFMF) Build-Depends: - base >=4 && <5, - containers >= 0.4.2, + base, + containers, toysolver, logic-TPTP >=0.4.1 + -- logic-TPTP <=0.4.3 has build error on ghc <7.9 and transformers >=0.5.1. + if impl(ghc <7.9) && flag(Transformers051) + Build-Depends: logic-TPTP >=0.4.4.0 Default-Language: Haskell2010 - if impl(ghc >= 7) + if impl(ghc) GHC-Options: -rtsopts + if flag(LinuxStatic) + GHC-Options: -static -optl-static -optl-pthread -- GHC-Prof-Options: -auto-all -- Converters @@ -344,25 +426,29 @@ Main-is: lpconvert.hs HS-Source-Dirs: lpconvert Build-Depends: - base >=4 && <5, - containers, + base, filepath, + data-default-class, parse-dimacs, pseudo-boolean, toysolver Default-Language: Haskell2010 + if flag(LinuxStatic) + GHC-Options: -static -optl-static -optl-pthread Executable pbconvert Main-is: pbconvert.hs HS-Source-Dirs: pbconvert Build-Depends: base >=4 && <5, - containers, filepath, + data-default-class, parse-dimacs, pseudo-boolean, toysolver Default-Language: Haskell2010 + if flag(LinuxStatic) + GHC-Options: -static -optl-static -optl-pthread -- Sample Programs @@ -376,7 +462,23 @@ array, toysolver Default-Language: Haskell2010 + if flag(LinuxStatic) + GHC-Options: -static -optl-static -optl-pthread +Executable nonogram + If !flag(BuildSamplePrograms) + Buildable: False + Main-is: nonogram.hs + HS-Source-Dirs: samples/programs/nonogram + Build-Depends: + base, + array, + containers, + toysolver + Default-Language: Haskell2010 + if flag(LinuxStatic) + GHC-Options: -static -optl-static -optl-pthread + Executable nqueens If !flag(BuildSamplePrograms) Buildable: False @@ -387,6 +489,8 @@ array, toysolver Default-Language: Haskell2010 + if flag(LinuxStatic) + GHC-Options: -static -optl-static -optl-pthread Executable knapsack If !flag(BuildSamplePrograms) @@ -395,9 +499,10 @@ HS-Source-Dirs: samples/programs/knapsack Build-Depends: base, - array, toysolver Default-Language: Haskell2010 + if flag(LinuxStatic) + GHC-Options: -static -optl-static -optl-pthread Executable htc If !flag(BuildSamplePrograms) @@ -409,7 +514,24 @@ containers, toysolver Default-Language: Haskell2010 + if flag(LinuxStatic) + GHC-Options: -static -optl-static -optl-pthread +Executable svm2lp + If !flag(BuildSamplePrograms) + Buildable: False + Main-is: svm2lp.hs + HS-Source-Dirs: samples/programs/svm2lp + Build-Depends: + base, + containers, + data-default-class, + split, + toysolver + Default-Language: Haskell2010 + if flag(LinuxStatic) + GHC-Options: -static -optl-static -optl-pthread + -- Misc Programs Executable pigeonhole @@ -418,12 +540,13 @@ Main-is: pigeonhole.hs HS-Source-Dirs: pigeonhole Build-Depends: - base >=4 && <5, + base, containers, - filepath, pseudo-boolean, toysolver Default-Language: Haskell2010 + if flag(LinuxStatic) + GHC-Options: -static -optl-static -optl-pthread Executable maxsatverify If !flag(BuildMiscPrograms) @@ -431,12 +554,12 @@ Main-is: maxsatverify.hs HS-Source-Dirs: maxsatverify Build-Depends: - base >=4 && <5, + base, array, - containers, - filepath, toysolver Default-Language: Haskell2010 + if flag(LinuxStatic) + GHC-Options: -static -optl-static -optl-pthread Executable pbverify Main-is: pbverify.hs @@ -444,131 +567,78 @@ Buildable: False HS-Source-Dirs: pbverify Build-Depends: - base >=4 && <5, + base, array, - containers, - filepath, pseudo-boolean, toysolver Default-Language: Haskell2010 + if flag(LinuxStatic) + GHC-Options: -static -optl-static -optl-pthread -- Test suites and benchmarks -Test-suite TestSAT - Type: exitcode-stdio-1.0 - HS-Source-Dirs: test - Main-is: TestSAT.hs - Build-depends: - base >=4 && <5, - array, - containers, - random, - toysolver, - tasty >=0.10.1, - tasty-hunit ==0.9.*, - tasty-quickcheck ==0.8.*, - tasty-th, - HUnit, - QuickCheck >=2.5 && <3 - Default-Language: Haskell2010 - Other-Extensions: TemplateHaskell - -Test-suite TestSimplex - Type: exitcode-stdio-1.0 - HS-Source-Dirs: test - Main-is: TestSimplex.hs - Build-depends: - base >=4 && <5, - containers, - mtl, - toysolver, - tasty >=0.10.1, - tasty-hunit ==0.9.*, - tasty-th, - HUnit - Default-Language: Haskell2010 - Other-Extensions: TemplateHaskell - -Test-suite TestSimplex2 - Type: exitcode-stdio-1.0 - HS-Source-Dirs: test - Main-is: TestSimplex2.hs - Build-depends: - base >=4 && <5, - containers, - vector-space >=0.8.6, - toysolver, - tasty >=0.10.1, - tasty-hunit ==0.9.*, - tasty-th, - HUnit - Default-Language: Haskell2010 - Other-Extensions: TemplateHaskell - -Test-suite TestMIPSolver2 - Type: exitcode-stdio-1.0 - HS-Source-Dirs: test - Main-is: TestMIPSolver2.hs - Build-depends: - base >=4 && <5, - containers, - vector-space >=0.8.6, - toysolver, - tasty >=0.10.1, - tasty-hunit ==0.9.*, - tasty-th, - HUnit, - OptDir, - stm - Default-Language: Haskell2010 - Other-Extensions: TemplateHaskell - Test-suite TestPolynomial Type: exitcode-stdio-1.0 HS-Source-Dirs: test Main-is: TestPolynomial.hs Build-depends: - base >=4 && <5, + base, containers, toysolver, tasty >=0.10.1, tasty-hunit ==0.9.*, tasty-quickcheck ==0.8.*, tasty-th, - HUnit, - QuickCheck >=2.5 && <3, data-interval, finite-field >=0.7.0 && <1.0.0, prettyclass >=1.0.0 Default-Language: Haskell2010 Other-Extensions: TemplateHaskell -Test-suite TestAReal - Type: exitcode-stdio-1.0 - HS-Source-Dirs: test - Main-is: TestAReal.hs - Build-depends: - base >=4 && <5, - containers, - toysolver, - tasty >=0.10.1, - tasty-hunit ==0.9.*, - tasty-quickcheck ==0.8.*, - tasty-th, - HUnit, - QuickCheck >=2.5 && <3, - data-interval - Default-Language: Haskell2010 - Other-Extensions: TemplateHaskell, ScopedTypeVariables - -Test-suite TestArith +Test-suite TestSuite Type: exitcode-stdio-1.0 - HS-Source-Dirs: test - Main-is: TestArith.hs + HS-Source-Dirs: test Smtlib toysmt + Main-is: TestSuite.hs + Other-Modules: + Test.AReal + Test.AReal2 + Test.Arith + Test.BoolExpr + Test.CongruenceClosure + Test.ContiTraverso + Test.Delta + Test.FiniteModelFinder + Test.HittingSets + Test.Knapsack + Test.LPFile + Test.Misc + Test.MIPSolver2 + Test.MPSFile + Test.SAT + Test.SDPFile + Test.Simplex + Test.Simplex2 + Test.SMT + Test.SMTLIB2Solver + Test.SubsetSum + Smtlib.Parsers.CommonParsers, + Smtlib.Parsers.ResponseParsers, + Smtlib.Parsers.CommandsParsers, + Smtlib.Syntax.Syntax, + Smtlib.Syntax.ShowSL Build-depends: - base >=4 && <5, + base, + array, containers, - vector-space >=0.8.6, + data-default-class, + deepseq, + mtl, + mwc-random, + parsec, + transformers, + transformers-compat, + vector, + vector-space, toysolver, data-interval, OptDir, @@ -576,124 +646,40 @@ tasty-hunit ==0.9.*, tasty-quickcheck ==0.8.*, tasty-th, - HUnit, QuickCheck >=2.5 && <3 Default-Language: Haskell2010 - Other-Extensions: TemplateHaskell + Other-Extensions: TemplateHaskell, ScopedTypeVariables -Test-suite TestContiTraverso - Type: exitcode-stdio-1.0 - HS-Source-Dirs: test - Main-is: TestContiTraverso.hs - Build-depends: +Benchmark BenchmarkSATLIB + type: exitcode-stdio-1.0 + hs-source-dirs: benchmarks + main-is: BenchmarkSATLIB.hs + build-depends: base >=4 && <5, - containers, - vector-space >=0.8.6, + array, + data-default-class, + parse-dimacs, toysolver, - OptDir, - tasty >=0.10.1, - tasty-hunit ==0.9.*, - tasty-quickcheck ==0.8.*, - tasty-th, - HUnit, - QuickCheck >=2.5 && <3 + criterion >=1.0 && <1.2 Default-Language: Haskell2010 - Other-Extensions: TemplateHaskell -Test-suite TestCongruenceClosure - Type: exitcode-stdio-1.0 - HS-Source-Dirs: test - Main-is: TestCongruenceClosure.hs - Build-depends: +Benchmark BenchmarkKnapsack + type: exitcode-stdio-1.0 + hs-source-dirs: benchmarks + main-is: BenchmarkKnapsack.hs + build-depends: base >=4 && <5, - containers, toysolver, - tasty >=0.10.1, - tasty-hunit ==0.9.*, - tasty-quickcheck ==0.8.*, - tasty-th, - HUnit, - QuickCheck >=2.5 && <3 + criterion >=1.0 && <1.2 Default-Language: Haskell2010 - Other-Extensions: TemplateHaskell -Test-suite TestLPFile - Type: exitcode-stdio-1.0 - HS-Source-Dirs: test - Main-is: TestLPFile.hs - Build-depends: - base >=4 && <5, - containers, - toysolver, - tasty >=0.10.1, - tasty-hunit ==0.9.*, - tasty-quickcheck ==0.8.*, - tasty-th, - HUnit, - QuickCheck >=2.5 && <3 - Default-Language: Haskell2010 - Other-Extensions: TemplateHaskell - -Test-suite TestMPSFile - Type: exitcode-stdio-1.0 - HS-Source-Dirs: test - Main-is: TestMPSFile.hs - Build-depends: - base >=4 && <5, - containers, - toysolver, - tasty >=0.10.1, - tasty-hunit ==0.9.*, - tasty-quickcheck ==0.8.*, - tasty-th, - HUnit, - QuickCheck >=2.5 && <3 - Default-Language: Haskell2010 - Other-Extensions: TemplateHaskell - -Test-suite TestSDPFile - Type: exitcode-stdio-1.0 - HS-Source-Dirs: test - Main-is: TestSDPFile.hs - Build-depends: - base >=4 && <5, - toysolver, - tasty >=0.10.1, - tasty-hunit ==0.9.*, - tasty-quickcheck ==0.8.*, - tasty-th, - HUnit, - QuickCheck >=2.5 && <3 - Default-Language: Haskell2010 - Other-Extensions: TemplateHaskell - -Test-suite TestUtil - Type: exitcode-stdio-1.0 - HS-Source-Dirs: test - Main-is: TestUtil.hs - Build-depends: - base >=4 && <5, - containers, - toysolver, - tasty >=0.10.1, - tasty-hunit ==0.9.*, - tasty-quickcheck ==0.8.*, - tasty-th, - HUnit, - QuickCheck >=2.5 && <3 - Default-Language: Haskell2010 - Other-Extensions: TemplateHaskell, ScopedTypeVariables - -Benchmark BenchmarkSATLIB +Benchmark BenchmarkSubsetSum type: exitcode-stdio-1.0 hs-source-dirs: benchmarks - main-is: BenchmarkSATLIB.hs + main-is: BenchmarkSubsetSum.hs build-depends: base >=4 && <5, - array, - containers, - random, - parse-dimacs, + vector, toysolver, - criterion >=1.0 && <1.1 + criterion >=1.0 && <1.2 Default-Language: Haskell2010 diff --git a/toysolver/toysolver.hs b/toysolver/toysolver.hs --- a/toysolver/toysolver.hs +++ b/toysolver/toysolver.hs @@ -40,7 +40,7 @@ import qualified Data.PseudoBoolean as PBFile import qualified Data.PseudoBoolean.Attoparsec as PBFileAttoparsec -import ToySolver.Data.ArithRel +import ToySolver.Data.OrdRel import ToySolver.Data.FOL.Arith as FOL import qualified ToySolver.Data.LA as LA import qualified ToySolver.Data.LA.FOL as LAFOL @@ -132,13 +132,13 @@ varToName = IntMap.fromList [(v,name) | (name,v) <- vsAssoc] compileE :: MIP.Expr -> Expr Rational - compileE = foldr (+) (Const 0) . map compileT + compileE = foldr (+) (Const 0) . map compileT . MIP.terms compileT :: MIP.Term -> Expr Rational compileT (MIP.Term c vs) = foldr (*) (Const c) [Var (nameToVar Map.! v) | v <- vs] - obj = compileE $ snd $ MIP.objectiveFunction mip + obj = compileE $ MIP.objExpr $ MIP.objectiveFunction mip cs1 = do v <- Set.toList vs @@ -149,14 +149,23 @@ cs2 = do MIP.Constraint { MIP.constrIndicator = ind - , MIP.constrBody = (lhs, rel, rhs) + , MIP.constrExpr = e + , MIP.constrLB = lb + , MIP.constrUB = ub } <- MIP.constraints mip - let rel2 = case rel of - MIP.Ge -> Ge - MIP.Le -> Le - MIP.Eql -> Eql case ind of - Nothing -> return (ArithRel (compileE lhs) rel2 (Const rhs)) + Nothing -> do + let e2 = compileE e + msum + [ case lb of + MIP.NegInf -> [] + MIP.PosInf -> [OrdRel 1 Le 0] -- False + MIP.Finite x -> [OrdRel e2 Ge (Const x)] + , case ub of + MIP.NegInf -> [OrdRel 1 Le 0] -- False + MIP.PosInf -> [] + MIP.Finite x -> [OrdRel e2 Le (Const x)] + ] Just _ -> error "indicator constraint is not supported yet" ivs @@ -213,7 +222,7 @@ putSLine "UNKNOWN" exitFailure Just (cs',obj') -> - case MIPSolverHL.optimize (MIP.dir mip) obj' cs' ivs2 of + case MIPSolverHL.optimize (MIP.objDir $ MIP.objectiveFunction mip) obj' cs' ivs2 of MIPSolverHL.OptUnsat -> do putSLine "UNSATISFIABLE" exitFailure @@ -239,7 +248,7 @@ Simplex2.setLogger solver putCommentLine replicateM (length vsAssoc) (Simplex2.newVar solver) -- XXX - Simplex2.setOptDir solver (MIP.dir mip) + Simplex2.setOptDir solver $ MIP.objDir $ MIP.objectiveFunction mip Simplex2.setObj solver $ fromJust (LAFOL.fromFOLExpr obj) putCommentLine "Loading constraints... " forM_ (cs1 ++ cs2) $ \c -> do @@ -325,7 +334,7 @@ putCommentLine "non-linear expressions are not supported by Conti-Traverso algorithm" exitFailure Just (linObj, linCon) -> do - case ContiTraverso.solve P.grlex vs2 (MIP.dir mip) linObj linCon of + case ContiTraverso.solve P.grlex vs2 (MIP.objDir $ MIP.objectiveFunction mip) linObj linCon of Nothing -> do putSLine "UNSATISFIABLE" exitFailure