packages feed

toysolver 0.3.0 → 0.4.0

raw patch · 195 files changed

+17298/−8396 lines, 195 filesdep +MemoTriedep +haskelinedep +mwc-randomdep −HUnitdep −randomdep ~basedep ~containersdep ~criterionnew-component:exe:nonogramnew-component:exe:svm2lpnew-component:exe:toysmt

Dependencies added: MemoTrie, haskeline, mwc-random, semigroups, split, template-haskell, transformers, transformers-compat, vector

Dependencies removed: HUnit, random

Dependency ranges changed: base, containers, criterion, data-interval, finite-field, logic-TPTP, mtl, parsec, pseudo-boolean, stm, vector-space

Files

.travis.yml view
@@ -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
+ CHANGELOG.markdown view
@@ -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.+
COPYING view
@@ -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
+ COPYING-GPL view
@@ -0,0 +1,674 @@+                    GNU GENERAL PUBLIC LICENSE+                       Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++                            Preamble++  The GNU General Public License is a free, copyleft license for+software and other kinds of works.++  The licenses for most software and other practical works are designed+to take away your freedom to share and change the works.  By contrast,+the GNU General Public License is intended to guarantee your freedom to+share and change all versions of a program--to make sure it remains free+software for all its users.  We, the Free Software Foundation, use the+GNU General Public License for most of our software; it applies also to+any other work released this way by its authors.  You can apply it to+your programs, too.++  When we speak of free software, we are referring to freedom, not+price.  Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+them if you wish), that you receive source code or can get it if you+want it, that you can change the software or use pieces of it in new+free programs, and that you know you can do these things.++  To protect your rights, we need to prevent others from denying you+these rights or asking you to surrender the rights.  Therefore, you have+certain responsibilities if you distribute copies of the software, or if+you modify it: responsibilities to respect the freedom of others.++  For example, if you distribute copies of such a program, whether+gratis or for a fee, you must pass on to the recipients the same+freedoms that you received.  You must make sure that they, too, receive+or can get the source code.  And you must show them these terms so they+know their rights.++  Developers that use the GNU GPL protect your rights with two steps:+(1) assert copyright on the software, and (2) offer you this License+giving you legal permission to copy, distribute and/or modify it.++  For the developers' and authors' protection, the GPL clearly explains+that there is no warranty for this free software.  For both users' and+authors' sake, the GPL requires that modified versions be marked as+changed, so that their problems will not be attributed erroneously to+authors of previous versions.++  Some devices are designed to deny users access to install or run+modified versions of the software inside them, although the manufacturer+can do so.  This is fundamentally incompatible with the aim of+protecting users' freedom to change the software.  The systematic+pattern of such abuse occurs in the area of products for individuals to+use, which is precisely where it is most unacceptable.  Therefore, we+have designed this version of the GPL to prohibit the practice for those+products.  If such problems arise substantially in other domains, we+stand ready to extend this provision to those domains in future versions+of the GPL, as needed to protect the freedom of users.++  Finally, every program is threatened constantly by software patents.+States should not allow patents to restrict development and use of+software on general-purpose computers, but in those that do, we wish to+avoid the special danger that patents applied to a free program could+make it effectively proprietary.  To prevent this, the GPL assures that+patents cannot be used to render the program non-free.++  The precise terms and conditions for copying, distribution and+modification follow.++                       TERMS AND CONDITIONS++  0. Definitions.++  "This License" refers to version 3 of the GNU General Public License.++  "Copyright" also means copyright-like laws that apply to other kinds of+works, such as semiconductor masks.++  "The Program" refers to any copyrightable work licensed under this+License.  Each licensee is addressed as "you".  "Licensees" and+"recipients" may be individuals or organizations.++  To "modify" a work means to copy from or adapt all or part of the work+in a fashion requiring copyright permission, other than the making of an+exact copy.  The resulting work is called a "modified version" of the+earlier work or a work "based on" the earlier work.++  A "covered work" means either the unmodified Program or a work based+on the Program.++  To "propagate" a work means to do anything with it that, without+permission, would make you directly or secondarily liable for+infringement under applicable copyright law, except executing it on a+computer or modifying a private copy.  Propagation includes copying,+distribution (with or without modification), making available to the+public, and in some countries other activities as well.++  To "convey" a work means any kind of propagation that enables other+parties to make or receive copies.  Mere interaction with a user through+a computer network, with no transfer of a copy, is not conveying.++  An interactive user interface displays "Appropriate Legal Notices"+to the extent that it includes a convenient and prominently visible+feature that (1) displays an appropriate copyright notice, and (2)+tells the user that there is no warranty for the work (except to the+extent that warranties are provided), that licensees may convey the+work under this License, and how to view a copy of this License.  If+the interface presents a list of user commands or options, such as a+menu, a prominent item in the list meets this criterion.++  1. Source Code.++  The "source code" for a work means the preferred form of the work+for making modifications to it.  "Object code" means any non-source+form of a work.++  A "Standard Interface" means an interface that either is an official+standard defined by a recognized standards body, or, in the case of+interfaces specified for a particular programming language, one that+is widely used among developers working in that language.++  The "System Libraries" of an executable work include anything, other+than the work as a whole, that (a) is included in the normal form of+packaging a Major Component, but which is not part of that Major+Component, and (b) serves only to enable use of the work with that+Major Component, or to implement a Standard Interface for which an+implementation is available to the public in source code form.  A+"Major Component", in this context, means a major essential component+(kernel, window system, and so on) of the specific operating system+(if any) on which the executable work runs, or a compiler used to+produce the work, or an object code interpreter used to run it.++  The "Corresponding Source" for a work in object code form means all+the source code needed to generate, install, and (for an executable+work) run the object code and to modify the work, including scripts to+control those activities.  However, it does not include the work's+System Libraries, or general-purpose tools or generally available free+programs which are used unmodified in performing those activities but+which are not part of the work.  For example, Corresponding Source+includes interface definition files associated with source files for+the work, and the source code for shared libraries and dynamically+linked subprograms that the work is specifically designed to require,+such as by intimate data communication or control flow between those+subprograms and other parts of the work.++  The Corresponding Source need not include anything that users+can regenerate automatically from other parts of the Corresponding+Source.++  The Corresponding Source for a work in source code form is that+same work.++  2. Basic Permissions.++  All rights granted under this License are granted for the term of+copyright on the Program, and are irrevocable provided the stated+conditions are met.  This License explicitly affirms your unlimited+permission to run the unmodified Program.  The output from running a+covered work is covered by this License only if the output, given its+content, constitutes a covered work.  This License acknowledges your+rights of fair use or other equivalent, as provided by copyright law.++  You may make, run and propagate covered works that you do not+convey, without conditions so long as your license otherwise remains+in force.  You may convey covered works to others for the sole purpose+of having them make modifications exclusively for you, or provide you+with facilities for running those works, provided that you comply with+the terms of this License in conveying all material for which you do+not control copyright.  Those thus making or running the covered works+for you must do so exclusively on your behalf, under your direction+and control, on terms that prohibit them from making any copies of+your copyrighted material outside their relationship with you.++  Conveying under any other circumstances is permitted solely under+the conditions stated below.  Sublicensing is not allowed; section 10+makes it unnecessary.++  3. Protecting Users' Legal Rights From Anti-Circumvention Law.++  No covered work shall be deemed part of an effective technological+measure under any applicable law fulfilling obligations under article+11 of the WIPO copyright treaty adopted on 20 December 1996, or+similar laws prohibiting or restricting circumvention of such+measures.++  When you convey a covered work, you waive any legal power to forbid+circumvention of technological measures to the extent such circumvention+is effected by exercising rights under this License with respect to+the covered work, and you disclaim any intention to limit operation or+modification of the work as a means of enforcing, against the work's+users, your or third parties' legal rights to forbid circumvention of+technological measures.++  4. Conveying Verbatim Copies.++  You may convey verbatim copies of the Program's source code as you+receive it, in any medium, provided that you conspicuously and+appropriately publish on each copy an appropriate copyright notice;+keep intact all notices stating that this License and any+non-permissive terms added in accord with section 7 apply to the code;+keep intact all notices of the absence of any warranty; and give all+recipients a copy of this License along with the Program.++  You may charge any price or no price for each copy that you convey,+and you may offer support or warranty protection for a fee.++  5. Conveying Modified Source Versions.++  You may convey a work based on the Program, or the modifications to+produce it from the Program, in the form of source code under the+terms of section 4, provided that you also meet all of these conditions:++    a) The work must carry prominent notices stating that you modified+    it, and giving a relevant date.++    b) The work must carry prominent notices stating that it is+    released under this License and any conditions added under section+    7.  This requirement modifies the requirement in section 4 to+    "keep intact all notices".++    c) You must license the entire work, as a whole, under this+    License to anyone who comes into possession of a copy.  This+    License will therefore apply, along with any applicable section 7+    additional terms, to the whole of the work, and all its parts,+    regardless of how they are packaged.  This License gives no+    permission to license the work in any other way, but it does not+    invalidate such permission if you have separately received it.++    d) If the work has interactive user interfaces, each must display+    Appropriate Legal Notices; however, if the Program has interactive+    interfaces that do not display Appropriate Legal Notices, your+    work need not make them do so.++  A compilation of a covered work with other separate and independent+works, which are not by their nature extensions of the covered work,+and which are not combined with it such as to form a larger program,+in or on a volume of a storage or distribution medium, is called an+"aggregate" if the compilation and its resulting copyright are not+used to limit the access or legal rights of the compilation's users+beyond what the individual works permit.  Inclusion of a covered work+in an aggregate does not cause this License to apply to the other+parts of the aggregate.++  6. Conveying Non-Source Forms.++  You may convey a covered work in object code form under the terms+of sections 4 and 5, provided that you also convey the+machine-readable Corresponding Source under the terms of this License,+in one of these ways:++    a) Convey the object code in, or embodied in, a physical product+    (including a physical distribution medium), accompanied by the+    Corresponding Source fixed on a durable physical medium+    customarily used for software interchange.++    b) Convey the object code in, or embodied in, a physical product+    (including a physical distribution medium), accompanied by a+    written offer, valid for at least three years and valid for as+    long as you offer spare parts or customer support for that product+    model, to give anyone who possesses the object code either (1) a+    copy of the Corresponding Source for all the software in the+    product that is covered by this License, on a durable physical+    medium customarily used for software interchange, for a price no+    more than your reasonable cost of physically performing this+    conveying of source, or (2) access to copy the+    Corresponding Source from a network server at no charge.++    c) Convey individual copies of the object code with a copy of the+    written offer to provide the Corresponding Source.  This+    alternative is allowed only occasionally and noncommercially, and+    only if you received the object code with such an offer, in accord+    with subsection 6b.++    d) Convey the object code by offering access from a designated+    place (gratis or for a charge), and offer equivalent access to the+    Corresponding Source in the same way through the same place at no+    further charge.  You need not require recipients to copy the+    Corresponding Source along with the object code.  If the place to+    copy the object code is a network server, the Corresponding Source+    may be on a different server (operated by you or a third party)+    that supports equivalent copying facilities, provided you maintain+    clear directions next to the object code saying where to find the+    Corresponding Source.  Regardless of what server hosts the+    Corresponding Source, you remain obligated to ensure that it is+    available for as long as needed to satisfy these requirements.++    e) Convey the object code using peer-to-peer transmission, provided+    you inform other peers where the object code and Corresponding+    Source of the work are being offered to the general public at no+    charge under subsection 6d.++  A separable portion of the object code, whose source code is excluded+from the Corresponding Source as a System Library, need not be+included in conveying the object code work.++  A "User Product" is either (1) a "consumer product", which means any+tangible personal property which is normally used for personal, family,+or household purposes, or (2) anything designed or sold for incorporation+into a dwelling.  In determining whether a product is a consumer product,+doubtful cases shall be resolved in favor of coverage.  For a particular+product received by a particular user, "normally used" refers to a+typical or common use of that class of product, regardless of the status+of the particular user or of the way in which the particular user+actually uses, or expects or is expected to use, the product.  A product+is a consumer product regardless of whether the product has substantial+commercial, industrial or non-consumer uses, unless such uses represent+the only significant mode of use of the product.++  "Installation Information" for a User Product means any methods,+procedures, authorization keys, or other information required to install+and execute modified versions of a covered work in that User Product from+a modified version of its Corresponding Source.  The information must+suffice to ensure that the continued functioning of the modified object+code is in no case prevented or interfered with solely because+modification has been made.++  If you convey an object code work under this section in, or with, or+specifically for use in, a User Product, and the conveying occurs as+part of a transaction in which the right of possession and use of the+User Product is transferred to the recipient in perpetuity or for a+fixed term (regardless of how the transaction is characterized), the+Corresponding Source conveyed under this section must be accompanied+by the Installation Information.  But this requirement does not apply+if neither you nor any third party retains the ability to install+modified object code on the User Product (for example, the work has+been installed in ROM).++  The requirement to provide Installation Information does not include a+requirement to continue to provide support service, warranty, or updates+for a work that has been modified or installed by the recipient, or for+the User Product in which it has been modified or installed.  Access to a+network may be denied when the modification itself materially and+adversely affects the operation of the network or violates the rules and+protocols for communication across the network.++  Corresponding Source conveyed, and Installation Information provided,+in accord with this section must be in a format that is publicly+documented (and with an implementation available to the public in+source code form), and must require no special password or key for+unpacking, reading or copying.++  7. Additional Terms.++  "Additional permissions" are terms that supplement the terms of this+License by making exceptions from one or more of its conditions.+Additional permissions that are applicable to the entire Program shall+be treated as though they were included in this License, to the extent+that they are valid under applicable law.  If additional permissions+apply only to part of the Program, that part may be used separately+under those permissions, but the entire Program remains governed by+this License without regard to the additional permissions.++  When you convey a copy of a covered work, you may at your option+remove any additional permissions from that copy, or from any part of+it.  (Additional permissions may be written to require their own+removal in certain cases when you modify the work.)  You may place+additional permissions on material, added by you to a covered work,+for which you have or can give appropriate copyright permission.++  Notwithstanding any other provision of this License, for material you+add to a covered work, you may (if authorized by the copyright holders of+that material) supplement the terms of this License with terms:++    a) Disclaiming warranty or limiting liability differently from the+    terms of sections 15 and 16 of this License; or++    b) Requiring preservation of specified reasonable legal notices or+    author attributions in that material or in the Appropriate Legal+    Notices displayed by works containing it; or++    c) Prohibiting misrepresentation of the origin of that material, or+    requiring that modified versions of such material be marked in+    reasonable ways as different from the original version; or++    d) Limiting the use for publicity purposes of names of licensors or+    authors of the material; or++    e) Declining to grant rights under trademark law for use of some+    trade names, trademarks, or service marks; or++    f) Requiring indemnification of licensors and authors of that+    material by anyone who conveys the material (or modified versions of+    it) with contractual assumptions of liability to the recipient, for+    any liability that these contractual assumptions directly impose on+    those licensors and authors.++  All other non-permissive additional terms are considered "further+restrictions" within the meaning of section 10.  If the Program as you+received it, or any part of it, contains a notice stating that it is+governed by this License along with a term that is a further+restriction, you may remove that term.  If a license document contains+a further restriction but permits relicensing or conveying under this+License, you may add to a covered work material governed by the terms+of that license document, provided that the further restriction does+not survive such relicensing or conveying.++  If you add terms to a covered work in accord with this section, you+must place, in the relevant source files, a statement of the+additional terms that apply to those files, or a notice indicating+where to find the applicable terms.++  Additional terms, permissive or non-permissive, may be stated in the+form of a separately written license, or stated as exceptions;+the above requirements apply either way.++  8. Termination.++  You may not propagate or modify a covered work except as expressly+provided under this License.  Any attempt otherwise to propagate or+modify it is void, and will automatically terminate your rights under+this License (including any patent licenses granted under the third+paragraph of section 11).++  However, if you cease all violation of this License, then your+license from a particular copyright holder is reinstated (a)+provisionally, unless and until the copyright holder explicitly and+finally terminates your license, and (b) permanently, if the copyright+holder fails to notify you of the violation by some reasonable means+prior to 60 days after the cessation.++  Moreover, your license from a particular copyright holder is+reinstated permanently if the copyright holder notifies you of the+violation by some reasonable means, this is the first time you have+received notice of violation of this License (for any work) from that+copyright holder, and you cure the violation prior to 30 days after+your receipt of the notice.++  Termination of your rights under this section does not terminate the+licenses of parties who have received copies or rights from you under+this License.  If your rights have been terminated and not permanently+reinstated, you do not qualify to receive new licenses for the same+material under section 10.++  9. Acceptance Not Required for Having Copies.++  You are not required to accept this License in order to receive or+run a copy of the Program.  Ancillary propagation of a covered work+occurring solely as a consequence of using peer-to-peer transmission+to receive a copy likewise does not require acceptance.  However,+nothing other than this License grants you permission to propagate or+modify any covered work.  These actions infringe copyright if you do+not accept this License.  Therefore, by modifying or propagating a+covered work, you indicate your acceptance of this License to do so.++  10. Automatic Licensing of Downstream Recipients.++  Each time you convey a covered work, the recipient automatically+receives a license from the original licensors, to run, modify and+propagate that work, subject to this License.  You are not responsible+for enforcing compliance by third parties with this License.++  An "entity transaction" is a transaction transferring control of an+organization, or substantially all assets of one, or subdividing an+organization, or merging organizations.  If propagation of a covered+work results from an entity transaction, each party to that+transaction who receives a copy of the work also receives whatever+licenses to the work the party's predecessor in interest had or could+give under the previous paragraph, plus a right to possession of the+Corresponding Source of the work from the predecessor in interest, if+the predecessor has it or can get it with reasonable efforts.++  You may not impose any further restrictions on the exercise of the+rights granted or affirmed under this License.  For example, you may+not impose a license fee, royalty, or other charge for exercise of+rights granted under this License, and you may not initiate litigation+(including a cross-claim or counterclaim in a lawsuit) alleging that+any patent claim is infringed by making, using, selling, offering for+sale, or importing the Program or any portion of it.++  11. Patents.++  A "contributor" is a copyright holder who authorizes use under this+License of the Program or a work on which the Program is based.  The+work thus licensed is called the contributor's "contributor version".++  A contributor's "essential patent claims" are all patent claims+owned or controlled by the contributor, whether already acquired or+hereafter acquired, that would be infringed by some manner, permitted+by this License, of making, using, or selling its contributor version,+but do not include claims that would be infringed only as a+consequence of further modification of the contributor version.  For+purposes of this definition, "control" includes the right to grant+patent sublicenses in a manner consistent with the requirements of+this License.++  Each contributor grants you a non-exclusive, worldwide, royalty-free+patent license under the contributor's essential patent claims, to+make, use, sell, offer for sale, import and otherwise run, modify and+propagate the contents of its contributor version.++  In the following three paragraphs, a "patent license" is any express+agreement or commitment, however denominated, not to enforce a patent+(such as an express permission to practice a patent or covenant not to+sue for patent infringement).  To "grant" such a patent license to a+party means to make such an agreement or commitment not to enforce a+patent against the party.++  If you convey a covered work, knowingly relying on a patent license,+and the Corresponding Source of the work is not available for anyone+to copy, free of charge and under the terms of this License, through a+publicly available network server or other readily accessible means,+then you must either (1) cause the Corresponding Source to be so+available, or (2) arrange to deprive yourself of the benefit of the+patent license for this particular work, or (3) arrange, in a manner+consistent with the requirements of this License, to extend the patent+license to downstream recipients.  "Knowingly relying" means you have+actual knowledge that, but for the patent license, your conveying the+covered work in a country, or your recipient's use of the covered work+in a country, would infringe one or more identifiable patents in that+country that you have reason to believe are valid.++  If, pursuant to or in connection with a single transaction or+arrangement, you convey, or propagate by procuring conveyance of, a+covered work, and grant a patent license to some of the parties+receiving the covered work authorizing them to use, propagate, modify+or convey a specific copy of the covered work, then the patent license+you grant is automatically extended to all recipients of the covered+work and works based on it.++  A patent license is "discriminatory" if it does not include within+the scope of its coverage, prohibits the exercise of, or is+conditioned on the non-exercise of one or more of the rights that are+specifically granted under this License.  You may not convey a covered+work if you are a party to an arrangement with a third party that is+in the business of distributing software, under which you make payment+to the third party based on the extent of your activity of conveying+the work, and under which the third party grants, to any of the+parties who would receive the covered work from you, a discriminatory+patent license (a) in connection with copies of the covered work+conveyed by you (or copies made from those copies), or (b) primarily+for and in connection with specific products or compilations that+contain the covered work, unless you entered into that arrangement,+or that patent license was granted, prior to 28 March 2007.++  Nothing in this License shall be construed as excluding or limiting+any implied license or other defenses to infringement that may+otherwise be available to you under applicable patent law.++  12. No Surrender of Others' Freedom.++  If conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License.  If you cannot convey a+covered work so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you may+not convey it at all.  For example, if you agree to terms that obligate you+to collect a royalty for further conveying from those to whom you convey+the Program, the only way you could satisfy both those terms and this+License would be to refrain entirely from conveying the Program.++  13. Use with the GNU Affero General Public License.++  Notwithstanding any other provision of this License, you have+permission to link or combine any covered work with a work licensed+under version 3 of the GNU Affero General Public License into a single+combined work, and to convey the resulting work.  The terms of this+License will continue to apply to the part which is the covered work,+but the special requirements of the GNU Affero General Public License,+section 13, concerning interaction through a network will apply to the+combination as such.++  14. Revised Versions of this License.++  The Free Software Foundation may publish revised and/or new versions of+the GNU General Public License from time to time.  Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++  Each version is given a distinguishing version number.  If the+Program specifies that a certain numbered version of the GNU General+Public License "or any later version" applies to it, you have the+option of following the terms and conditions either of that numbered+version or of any later version published by the Free Software+Foundation.  If the Program does not specify a version number of the+GNU General Public License, you may choose any version ever published+by the Free Software Foundation.++  If the Program specifies that a proxy can decide which future+versions of the GNU General Public License can be used, that proxy's+public statement of acceptance of a version permanently authorizes you+to choose that version for the Program.++  Later license versions may give you additional or different+permissions.  However, no additional obligations are imposed on any+author or copyright holder as a result of your choosing to follow a+later version.++  15. Disclaimer of Warranty.++  THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY+APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM+IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.++  16. Limitation of Liability.++  IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF+SUCH DAMAGES.++  17. Interpretation of Sections 15 and 16.++  If the disclaimer of warranty and limitation of liability provided+above cannot be given local legal effect according to their terms,+reviewing courts shall apply local law that most closely approximates+an absolute waiver of all civil liability in connection with the+Program, unless a warranty or assumption of liability accompanies a+copy of the Program in return for a fee.++                     END OF TERMS AND CONDITIONS++            How to Apply These Terms to Your New Programs++  If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++  To do so, attach the following notices to the program.  It is safest+to attach them to the start of each source file to most effectively+state the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++    <one line to give the program's name and a brief idea of what it does.>+    Copyright (C) <year>  <name of author>++    This program is free software: you can redistribute it and/or modify+    it under the terms of the GNU General Public License as published by+    the Free Software Foundation, either version 3 of the License, or+    (at your option) any later version.++    This program is distributed in the hope that it will be useful,+    but WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+    GNU General Public License for more details.++    You should have received a copy of the GNU General Public License+    along with this program.  If not, see <http://www.gnu.org/licenses/>.++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:++    <program>  Copyright (C) <year>  <name of author>+    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+<http://www.gnu.org/licenses/>.++  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+<http://www.gnu.org/philosophy/why-not-lgpl.html>.
README.md view
@@ -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
+ Smtlib/Smtlib/Parsers/CommandsParsers.hs view
@@ -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
+ Smtlib/Smtlib/Parsers/CommonParsers.hs view
@@ -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
+ Smtlib/Smtlib/Parsers/ResponseParsers.hs view
@@ -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             #+   #                                                                       #+   #########################################################################+-}
+ Smtlib/Smtlib/Syntax/ShowSL.hs view
@@ -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 ++ ")"
+ Smtlib/Smtlib/Syntax/Syntax.hs view
@@ -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
+ appveyor.yml view
@@ -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
+ benchmarks/BenchmarkKnapsack.hs view
@@ -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)]
benchmarks/BenchmarkSATLIB.hs view
@@ -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)
+ benchmarks/BenchmarkSubsetSum.hs view
@@ -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]
− build_bdist_linux-i386.sh 
@@ -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
− build_bdist_linux-x86_64.sh 
@@ -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
+ build_bdist_linux.sh view
@@ -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
build_bdist_macos.sh view
@@ -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
+ build_bdist_maxsat_evaluation.sh view
@@ -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
+ build_bdist_pb_evaluation.sh view
@@ -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
build_bdist_win32.sh view
@@ -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
build_bdist_win64.sh view
@@ -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
lpconvert/lpconvert.hs view
@@ -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)
+ misc/maxsat/toysat/README.md view
@@ -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.+  <http://dx.doi.org/10.1007/978-3-642-31612-8_22>
+ misc/maxsat/toysat/toysat view
@@ -0,0 +1,2 @@+#!/bin/sh+./toysat_main +RTS -H1G -K1G -RTS --search=bcd2 --maxsat $@
+ misc/maxsat/toysat_ls/README.md view
@@ -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.+  <http://dx.doi.org/10.1007/978-3-642-31612-8_22>++* [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.+  <http://dx.doi.org/10.1007/11527695_24>
+ misc/maxsat/toysat_ls/toysat_ls view
@@ -0,0 +1,2 @@+#!/bin/sh+./toysat_main +RTS -H1G -K1G -RTS --maxsat --search=bcd2 --with-ubcsat=./ubcsat --ls-initial $@
+ misc/pb/README.md view
@@ -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.+  <http://dx.doi.org/10.1007/978-3-642-31612-8_22>++* [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.
pbconvert/pbconvert.hs view
@@ -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)
− samples/gcnf/example.cnf 
@@ -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
− samples/lp/hoge.lp 
@@ -1,7 +0,0 @@-Minimize- obj: x1 + x2-Subject To- c1: x1 + 2 x2 + x3 = 3-General- x1 x2 x3-End
− samples/lp/test-2.lp 
@@ -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
− samples/lp/test-lazy.lp 
@@ -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
− samples/lp/test-semiint-2.lp 
@@ -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
− samples/lp/test2.lp 
@@ -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
− samples/lp/test_utf-8.lp 
@@ -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
− samples/maxsat/FM06.cnf 
@@ -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
− samples/mps/enlight13-2.mps 
@@ -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
− samples/mps/example2-2.mps 
@@ -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
− samples/mps/factor35.mps 
@@ -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
− samples/mps/ind1-2.mps 
@@ -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
− samples/mps/intvar1-2.mps 
@@ -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
− samples/mps/intvar2-2.mps 
@@ -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
− samples/mps/quadobj1-2.mps 
@@ -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
− samples/mps/quadobj2-2.mps 
@@ -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
− samples/mps/ranges-2.mps 
@@ -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
− samples/mps/sc-2.mps 
@@ -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
− samples/mps/sos-2.mps 
@@ -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
− samples/mps/test-qcp-2.mps 
@@ -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
− samples/mps/test-semiint-gurobi-2.mps 
@@ -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
− samples/mps/test-semiint-lpsolve-2.mps 
@@ -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
+ samples/programs/nonogram/README.md view
@@ -0,0 +1,10 @@+nonogram+========++LICENSE+-------++`sample.cwd` is a nonogram problem made by Juraj Simlovic available at+<https://en.wikipedia.org/wiki/File:Paint_by_numbers_Animation.gif>+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).
+ samples/programs/nonogram/nonogram.hs view
@@ -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 }) "<int>")+        "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)
+ samples/programs/nonogram/sample.cwd view
@@ -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
samples/programs/nqueens/nqueens.hs view
@@ -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
+ samples/programs/svm2lp/a1a view
@@ -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
+ samples/programs/svm2lp/svm2lp.hs view
@@ -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 }) "<str>")+        "Kernel: linear (default), gaussian"+    , Option ['c'] []+        (ReqArg (\val opt -> opt{ optC = Just $! read val }) "<float>")+        "C parameter"+    , Option [] ["gamma"]+        (ReqArg (\val opt -> opt{ optGamma = Just $! read val }) "<float>")+        "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
+ samples/smt/QF_UFLRA.smt2 view
@@ -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)
+ samples/smt/assertion-stack-levels-2.smt2 view
@@ -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)
+ samples/smt/assertion-stack-levels.smt2 view
@@ -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)
+ samples/smt/assumptions.smt2 view
@@ -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)
+ samples/smt/declare-const.smt2 view
@@ -0,0 +1,5 @@+(set-logic QF_LRA)+(declare-const b Bool)+(declare-const x Real)+(declare-const y Real)+(check-sat)
+ samples/smt/define-fun-rec.smt2 view
@@ -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)
+ samples/smt/define-funs-rec.smt2 view
@@ -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)
+ samples/smt/division-by-zero.smt2 view
@@ -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
+ samples/smt/echo.smt2 view
@@ -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)
+ samples/smt/get-assertions.smt2 view
@@ -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)
+ samples/smt/get-assignment.smt2 view
@@ -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)
+ samples/smt/get-model.smt2 view
@@ -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)
+ samples/smt/get-value.smt2 view
@@ -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)))
+ samples/smt/global-declarations.smt2 view
@@ -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)
+ samples/smt/print-success.smt2 view
@@ -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)
+ samples/smt/quoted-symbol.smt2 view
@@ -0,0 +1,6 @@+(set-logic QF_LRA)+(set-info :status unsat)+(declare-fun abc () Real)+(assert (= abc 0))+(assert (= |abc| 1))+(check-sat)
+ samples/smt/reset-assertions.smt2 view
@@ -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)
+ samples/smt/reset.smt2 view
@@ -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)
+ samples/smt/set-info-status.smt2 view
@@ -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)
+ samples/smt/unicode-symbol.smt2 view
@@ -0,0 +1,4 @@+(set-logic QF_LRA)+(declare-fun あいうえお () Real)+(declare-fun café () Real)+(check-sat)
+ samples/smt/unsat-core.smt2 view
@@ -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)
src/ToySolver/Arith/BoundsInference.hs view
@@ -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
src/ToySolver/Arith/CAD.hs view
@@ -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]
src/ToySolver/Arith/ContiTraverso.hs view
@@ -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
src/ToySolver/Arith/Cooper/Base.hs view
@@ -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
src/ToySolver/Arith/Cooper/FOL.hs view
@@ -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)
src/ToySolver/Arith/FourierMotzkin/Base.hs view
@@ -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 =
src/ToySolver/Arith/FourierMotzkin/FOL.hs view
@@ -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)
src/ToySolver/Arith/LPSolver.hs view
@@ -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
src/ToySolver/Arith/LPSolverHL.hs view
@@ -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
src/ToySolver/Arith/LPUtil.hs view
@@ -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 ()
src/ToySolver/Arith/MIPSolver2.hs view
@@ -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)
src/ToySolver/Arith/MIPSolverHL.hs view
@@ -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
src/ToySolver/Arith/OmegaTest.hs view
@@ -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
src/ToySolver/Arith/OmegaTest/Base.hs view
@@ -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]]
src/ToySolver/Arith/Simplex.hs view
@@ -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
src/ToySolver/Arith/Simplex2.hs view
@@ -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) $
src/ToySolver/Arith/VirtualSubstitution.hs view
@@ -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))
src/ToySolver/Combinatorial/HittingSet/FredmanKhachiyan1996.hs view
@@ -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]]
src/ToySolver/Combinatorial/HittingSet/GurvichKhachiyan1999.hs view
@@ -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
src/ToySolver/Combinatorial/HittingSet/HTCBDD.hs view
@@ -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)
src/ToySolver/Combinatorial/HittingSet/SHD.hs view
@@ -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)
src/ToySolver/Combinatorial/Knapsack/BB.hs view
@@ -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
− src/ToySolver/Combinatorial/Knapsack/DP.hs 
@@ -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
+ src/ToySolver/Combinatorial/Knapsack/DPDense.hs view
@@ -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
+ src/ToySolver/Combinatorial/Knapsack/DPSparse.hs view
@@ -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)
+ src/ToySolver/Combinatorial/SubsetSum.hs view
@@ -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+--   <http://www.sciencedirect.com/science/article/pii/S0377221798001209>+--   <http://www.diku.dk/~pisinger/95-6.ps>+--+-----------------------------------------------------------------------------+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<wi && wi<=c) w = (w, c, id)+  | otherwise = (VG.filter (\wi -> 0<wi && wi<=c) w, c, trans)+  where+    trans (obj, bs) = (obj, bs2)+      where+        bs2 = VU.create $ do+          v <- VM.new (VG.length w)+          let loop !i !j =+                when (i < VG.length w) $ do+                  let wi = w ! i+                  if 0 < wi && wi <= c then do+                    VM.write v i (bs ! j)+                    loop (i+1) (j+1)+                  else do+                    VM.write v i False+                    loop (i+1) j+          loop 0 0+          return v++normalizeGCDLe+  :: (V.Vector Weight, Weight)+  -> (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)
− src/ToySolver/CongruenceClosure.hs 
@@ -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.---   <http://www.lsi.upc.edu/~oliveras/espai/papers/IC.pdf>----------------------------------------------------------------------------------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
src/ToySolver/Converter/MIP2SMT.hs view
@@ -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)                            ]                     ]
src/ToySolver/Converter/PB2IP.hs view
@@ -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 =
− src/ToySolver/Data/ArithRel.hs 
@@ -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---- ---------------------------------------------------------------------------
src/ToySolver/Data/BoolExpr.hs view
@@ -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
src/ToySolver/Data/Boolean.hs view
@@ -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+  (.<=>.) = (==)
src/ToySolver/Data/DNF.hs view
@@ -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)
src/ToySolver/Data/Delta.hs view
@@ -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
src/ToySolver/Data/FOL/Arith.hs view
@@ -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)  -- ---------------------------------------------------------------------------
src/ToySolver/Data/FOL/Formula.hs view
@@ -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
src/ToySolver/Data/LA.hs view
@@ -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
src/ToySolver/Data/LA/FOL.hs view
@@ -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
src/ToySolver/Data/MIP/Base.hs view
@@ -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)
src/ToySolver/Data/MIP/LPFile.hs view
@@ -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       }
src/ToySolver/Data/MIP/MPSFile.hs view
@@ -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
+ src/ToySolver/Data/OrdRel.hs view
@@ -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++-- ---------------------------------------------------------------------------
src/ToySolver/Data/Polyhedron.hs view
@@ -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
src/ToySolver/Data/Polynomial.hs view
@@ -114,7 +114,6 @@    -- * Pretty Printing   , PrintOptions (..)-  , defaultPrintOptions   , prettyPrint   , PrettyCoeff (..)   , PrettyVar (..)
src/ToySolver/Data/Polynomial/Base.hs view
@@ -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
src/ToySolver/Data/Polynomial/Factorization/FiniteField.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE ScopedTypeVariables, BangPatterns, TypeSynonymInstances, FlexibleInstances #-}-{-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_GHC -Wall -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- | -- Module      :  ToySolver.Data.Polynomial.Factorization.FiniteField
src/ToySolver/Data/Polynomial/GroebnerBasis.hs view
@@ -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
+ src/ToySolver/EUF/CongruenceClosure.hs view
@@ -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.+--   <http://www.lsi.upc.edu/~oliveras/espai/papers/IC.pdf>+--+-----------------------------------------------------------------------------+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 (<n) (+1) $ \a -> 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
+ src/ToySolver/EUF/EUFSolver.hs view
@@ -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
+ src/ToySolver/EUF/FiniteModelFinder.hs view
@@ -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.+--   <http://www.cs.miami.edu/~geoff/Conferences/CADE/Archive/CADE-19/WS4/04.pdf>+--+-----------------------------------------------------------------------------+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++-- ---------------------------------------------------------------------------
− src/ToySolver/FOLModelFinder.hs 
@@ -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.---   <http://www.cs.miami.edu/~geoff/Conferences/CADE/Archive/CADE-19/WS4/04.pdf>----------------------------------------------------------------------------------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---- ---------------------------------------------------------------------------
src/ToySolver/Internal/Data/PriorityQueue.hs view
@@ -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
src/ToySolver/Internal/Data/Vec.hs view
@@ -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
src/ToySolver/Internal/ProcessUtil.hs view
@@ -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__
src/ToySolver/SAT.hs view
@@ -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
src/ToySolver/SAT/Integer.hs view
@@ -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
src/ToySolver/SAT/MUS.hs view
@@ -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'.
src/ToySolver/SAT/MUS/CAMUS.hs view
@@ -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
src/ToySolver/SAT/MUS/DAA.hs view
@@ -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
src/ToySolver/SAT/MUS/QuickXplain.hs view
@@ -20,7 +20,6 @@ module ToySolver.SAT.MUS.QuickXplain   ( module ToySolver.SAT.MUS.Types   , Options (..)-  , defaultOptions   , findMUSAssumptions   ) where
src/ToySolver/SAT/PBO.hs view
@@ -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
src/ToySolver/SAT/PBO/BC.hs view
@@ -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
src/ToySolver/SAT/PBO/BCD.hs view
@@ -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
src/ToySolver/SAT/PBO/BCD2.hs view
@@ -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
src/ToySolver/SAT/PBO/Context.hs view
@@ -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)
src/ToySolver/SAT/PBO/MSU4.hs view
@@ -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
src/ToySolver/SAT/PBO/UnsatBased.hs view
@@ -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
src/ToySolver/SAT/TheorySolver.hs view
@@ -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 ()   }
src/ToySolver/SAT/TseitinEncoder.hs view
@@ -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.
src/ToySolver/SAT/Types.hs view
@@ -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
+ src/ToySolver/SMT.hs view
@@ -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
src/ToySolver/Text/SDPFile.hs view
@@ -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
src/ToySolver/Version.hs view
@@ -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)
+ src/ToySolver/Version/TH.hs view
@@ -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 |]
src/ToySolver/Wang.hs view
@@ -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
+ test/Test/AReal.hs view
@@ -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)
+ test/Test/AReal2.hs view
@@ -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)
+ test/Test/Arith.hs view
@@ -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)
+ test/Test/BoolExpr.hs view
@@ -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)
+ test/Test/CongruenceClosure.hs view
@@ -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)
+ test/Test/ContiTraverso.hs view
@@ -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)
+ test/Test/Delta.hs view
@@ -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)
+ test/Test/FiniteModelFinder.hs view
@@ -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)
+ test/Test/HittingSets.hs view
@@ -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)
+ test/Test/Knapsack.hs view
@@ -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)
+ test/Test/LPFile.hs view
@@ -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)
+ test/Test/MIPSolver2.hs view
@@ -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)
+ test/Test/MPSFile.hs view
@@ -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)
+ test/Test/Misc.hs view
@@ -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)
+ test/Test/SAT.hs view
@@ -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)
+ test/Test/SDPFile.hs view
@@ -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)
+ test/Test/SMT.hs view
@@ -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)
+ test/Test/SMTLIB2Solver.hs view
@@ -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)
+ test/Test/Simplex.hs view
@@ -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)
+ test/Test/Simplex2.hs view
@@ -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)
+ test/Test/SubsetSum.hs view
@@ -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)
− test/TestAReal.hs 
@@ -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)
− test/TestAReal2.hs 
@@ -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)
− test/TestArith.hs 
@@ -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)
− test/TestCongruenceClosure.hs 
@@ -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)
− test/TestContiTraverso.hs 
@@ -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)-
− test/TestLPFile.hs 
@@ -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)
− test/TestMIPSolver2.hs 
@@ -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)
− test/TestMPSFile.hs 
@@ -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)
test/TestPolynomial.hs view
@@ -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
− test/TestSAT.hs 
@@ -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)
− test/TestSDPFile.hs 
@@ -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)
− test/TestSimplex.hs 
@@ -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)
− test/TestSimplex2.hs 
@@ -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)
+ test/TestSuite.hs view
@@ -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+  ]
− test/TestUtil.hs 
@@ -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)
toyfmf/toyfmf.hs view
@@ -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
toysat/toysat.hs view
@@ -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 }) "<str>")+        (ReqArg (\val opt -> opt{ optSATConfig = (optSATConfig opt){ SAT.configRestartStrategy = parseRestartStrategy val } }) "<str>")         "Restart startegy: MiniSAT (default), Armin, Luby."     , Option [] ["restart-first"]-        (ReqArg (\val opt -> opt{ optRestartFirst = read val }) "<integer>")-        (printf "The initial restart limit. (default %d)" SAT.defaultRestartFirst)+        (ReqArg (\val opt -> opt{ optSATConfig = (optSATConfig opt){ SAT.configRestartFirst = read val } }) "<integer>")+        (printf "The initial restart limit. (default %d)" (SAT.configRestartFirst def))     , Option [] ["restart-inc"]-        (ReqArg (\val opt -> opt{ optRestartInc = read val }) "<real>")-        (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 } }) "<real>")+        (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 }) "<name>")+        (ReqArg (\val opt -> opt{ optSATConfig = (optSATConfig opt){ SAT.configLearningStrategy = parseLS val } }) "<name>")         "Leaning scheme: clause (default), hybrid"     , Option [] ["learnt-size-first"]-        (ReqArg (\val opt -> opt{ optLearntSizeFirst = read val }) "<int>")+        (ReqArg (\val opt -> opt{ optSATConfig = (optSATConfig opt){ SAT.configLearntSizeFirst = read val } }) "<int>")         "The initial limit for learnt clauses."     , Option [] ["learnt-size-inc"]-        (ReqArg (\val opt -> opt{ optLearntSizeInc = read val }) "<real>")-        (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 } }) "<real>")+        (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 }) "<int>")-        (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 } }) "<int>")+        (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)) }) "<int>")+        (ReqArg (\val opt -> opt{ optRandomSeed = Just (Rand.toSeed (V.singleton (read val) :: V.Vector Word32)) }) "<int>")         "random seed used by the random variable selection"     , Option [] ["random-gen"]-        (ReqArg (\val opt -> opt{ optRandomGen = Just (read val) }) "<str>")+        (ReqArg (\val opt -> opt{ optRandomSeed = Just (Rand.toSeed (V.fromList (map read $ words $ val) :: V.Vector Word32)) }) "<str>")         "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 }) "<name>")+        (ReqArg (\val opt -> opt{ optSATConfig = (optSATConfig opt){ SAT.configPBHandlerType = parsePBHandler val } }) "<name>")         "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 }) "<str>")@@ -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 "<unknown>" 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
+ toysmt/ToySolver/SMT/SMTLIB2Solver.hs view
@@ -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'
+ toysmt/toysmt.hs view
@@ -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) "<stdin>" 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) "<stdin>" 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:"+  ]
toysolver.cabal view
@@ -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
toysolver/toysolver.hs view
@@ -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